I'm trying to get a Device Unique Identifier in vb.net code. I have tried with
Private Function SystemSerialNumber() As String
Dim value As String = ""
Dim baseBoard As ManagementClass = New ManagementClass("Win32_BaseBoard")
Dim board As ManagementObjectCollection = baseBoard.GetInstances()
If board.Count > 0 Then
value = board(0)("SerialNumber")
If value.Length > 0 Then value = value.Substring(2)
End If
Return value
End Function
Which works on some computers but of the board doesn't have a serial number it returns "Default String" or whatever they put in there. Even tried with Win32_Processor and some have it and others just return "To be filled by O.E.M" lol
Also tried with,
Private Function SystemSerialNumber() As String
Dim value As String
Dim q As New SelectQuery("Win32_bios")
Dim search As New ManagementObjectSearcher(q)
Dim info As New ManagementObject
For Each info In search.Get
value = info("SerialNumber").ToString
Return value
Next
End Function
But its the same some devices have it some don't and just returns default string.
So I'm now trying is:
Private Function SystemSerialNumber() As String
Dim value As String
value = Windows.System.Profile.SystemIdentification.GetSystemIdForPublisher()
End Function
But I'm having trouble referencing to it. I tried Imports Windows.System but it just gives the error it cant be found.
As a side note I'm using this program in tablets with windows10, laptops, and desktops.
UPDATE: I'll be using as suggested by Heinzi. Thanks!
Also changed variable names to be more accurate.
Private Function NetworkAdapterMacAddress() As String
Dim McAddress As String
Dim netadapter As ManagementClass = New ManagementClass("Win32_NetworkAdapterConfiguration")
Dim mo As ManagementObject
Dim adapter As ManagementObjectCollection = netadapter.GetInstances()
For Each mo In adapter
If mo.Item("IPEnabled") = True Then
McAddress = mo.Item("MacAddress").ToString()
Return McAddress
End If
Next
End Function
Well, there is no guaranteed ID that identifies every PC out there uniquely (fortunately, I might add. Privacy is a good thing).
You best bets are probably
the MAC of the network adapter (changes when the network adapter is replaced) or
the Windows Computer SID (changes when Windows is reinstalled).
Oh, and on a philosophical note, you might want to ponder on the Ship of Theseus.
I'm trying to find some code that I can use in vb.net 4.0 to query the our exchange 2013 server. It will be housed on a web server and that server does not have outlook installed on it. Looks like I need to use EWS to do this but I've tried a lot of code snippets and still have not been able to figure this out. The distribution list i'm trying to query is in the public folders/Office Contacts. I've tried examples that use nesting to go through the public folder seen there is no deep traversal but I'm not doing something right there. I am not posting code because i'm not sure it would help. I was hoping someone has already done this and would give me some nuggest of info to get me started.
The examples I've found do not query the distribution list but rather add to it. It's not that I haven't tried... I've got hundreds of lines of code from different places that I've tried and tried to learn from.. but i'm not getting it done. Anyway.. help would be great.
Sorry about not posting any code.. I actually thought I deleted this post.. but i'll post the code that is now working for me. This code does a query to the public folder and then grabs some of the data about each contact in that contact list.
Public Sub MS()
Dim oTheListS As New List(Of TheList)
Dim service As New ExchangeService(ExchangeVersion.Exchange2010_SP1)
service.Credentials = New WebCredentials("userid", "password")
service.AutodiscoverUrl("email#address")
'Get Public Folder
Dim sf As SearchFilter = New SearchFilter.IsEqualTo(FolderSchema.DisplayName, "Office Contacts")
Dim rrRes As FindFoldersResults = service.FindFolders(WellKnownFolderName.PublicFoldersRoot, sf, New FolderView(1))
Dim OfficeContacts As Folder = rrRes.Folders(0)
'Find the Distribution List
Dim dlSearch As SearchFilter = New SearchFilter.IsEqualTo(ContactGroupSchema.DisplayName, "Merit Board")
Dim ivItemView As New ItemView(1)
Dim fiResults As FindItemsResults(Of Item) = OfficeContacts.FindItems(dlSearch, ivItemView)
If fiResults.Items.Count = 1 Then
'Enumeate Members
Dim cg As ContactGroup = DirectCast(fiResults.Items(0), ContactGroup)
cg.Load()
For Each gm As GroupMember In cg.Members
Dim o As New TheList
o = MS2(gm.AddressInformation.Address)
oTheListS.Add(o)
'Dim o As New TheList
'Dim ncCol As NameResolutionCollection = service.ResolveName(gm.AddressInformation.Address, ResolveNameSearchLocation.ContactsOnly, True)
'With o
' .Name = gm.AddressInformation.Name
' .Email = gm.AddressInformation.Address
'End With
'oTheListS.Add(o)
Next
End If
End Sub
Public Function MS2(pEmail As String) As TheList
Dim o As New TheList
Dim service As New ExchangeService(ExchangeVersion.Exchange2010_SP1)
service.Credentials = New WebCredentials("userid", "password")
service.AutodiscoverUrl("email#address")
Dim sf As SearchFilter = New SearchFilter.IsEqualTo(FolderSchema.DisplayName, "Office Contacts")
Dim rrRes As FindFoldersResults = service.FindFolders(WellKnownFolderName.PublicFoldersRoot, sf, New FolderView(1))
Dim OfficeContacts As Folder = rrRes.Folders(0)
'Find the Distribution List
Dim dlSearch As SearchFilter = New SearchFilter.IsEqualTo(ContactSchema.EmailAddress1, pEmail)
Dim ivItemView As New ItemView(1)
Dim fiResults As FindItemsResults(Of Item) = OfficeContacts.FindItems(dlSearch, ivItemView)
If fiResults.Items.Count = 1 Then
Dim con As Contact = fiResults.Items(0)
'Dim ncCol As NameResolutionCollection = service.ResolveName(gm.AddressInformation.Address, ResolveNameSearchLocation.ContactsOnly, True)
With o
If con.DisplayName IsNot Nothing Then
.Name = con.DisplayName
End If
Dim em As New EmailAddress
If con.EmailAddresses.TryGetValue(EmailAddressKey.EmailAddress1, em) = True Then
.Email = con.EmailAddresses(EmailAddressKey.EmailAddress1).ToString
End If
If con.JobTitle IsNot Nothing Then
.Title = con.JobTitle
End If
Dim phy As New PhysicalAddressEntry
If con.PhysicalAddresses.TryGetValue(PhysicalAddressKey.Business, phy) = True Then
.Address = con.PhysicalAddresses(PhysicalAddressKey.Business)
End If
If con.PhoneNumbers.TryGetValue(PhoneNumberKey.BusinessPhone, String.Empty) = True Then
.PhoneBusiness = con.PhoneNumbers(PhoneNumberKey.BusinessPhone)
End If
If con.PhoneNumbers.TryGetValue(PhoneNumberKey.MobilePhone, String.Empty) = True Then
.PhoneMobile = con.PhoneNumbers(PhoneNumberKey.MobilePhone)
End If
If con.CompanyName IsNot Nothing Then
.Comapny = con.CompanyName
End If
End With
End If
Return o
End Function
Public Class TheList
Public Property Name As String
Public Property Email As String
Public Property PhoneMobile As String
Public Property PhoneBusiness As String
Public Property Comapny As String
Public Property Title As String
Public Property Address As PhysicalAddressEntry
End Class
I just got it working so I haven't started to refine it yet.. but hopefully this will help someone else as I didn't find any code that did this
My website uses adatabase for geoLocating the clients country.
Here is my error code:
System.IO.IOException
Inner Exception:
The process cannot access the file 'C:\*****\******\wwwroot\GEO2db\GeoLite2-Country.mmdb' because it is being used by another process.
And Here is the code that I run to get the country from the database (it is called in my master page):
Public Function GetGeoIPCountry() As String
If HttpContext.Current.Request.IsLocal Then
Return ""
End If
Dim ip As String = HttpContext.Current.Request.ServerVariables("REMOTE_ADDR")
Dim FileWithPath As String = HttpContext.Current.Server.MapPath("~") & "GEO2db\GeoLite2-Country.mmdb"
Dim reader = New DatabaseReader(FileWithPath)
Dim Om = reader.Omni(ip)
Dim country As String = Om.Country.Name
reader.Dispose()
Return country
End Function
I have a mechanism that downloads attachments from email messages sent into an inbox to a folder for processing by another service.
Originally this was done using some VBA that was triggered by a rule in Outlook. This wasn't build with large amounts of information going in originally however it has got to the point now that lots of data is being passed through and it is causing me headaches using this Outlook VBA and SSIS Package combination.
Therefore I am working on a new version built entirely in VB .NET, this obviously will mean its more robust and a lot easier to debug problems.
I have started using the EWS API and have managed to successfully connect to the Exchange and I am able to read the relevant messages and store their Subject etc. to variables.
I am struggling however to find ANY documentation / help regarding downloading of attachements with EWS with VB .NET code.
Everything seems to be in C# and I unfortunately have no experience with this. I am totally open to 3rd Party Solutions that may need to be purchased or even pointed in the right direction of a book or documentation, this is not being done on a shoe string and is quite important.
Try converters between C# and VB.
Regarding EWS, many VB examples contains "Exchange Web Services .NET". The same examples are in C# and VB
Hopefully this will get you started in the right direction. NOTE: I have not had a chance to test this VB code, since I do not have access to an Exchange 2007 server from home (as far as I know). However, I wrote this code carefully, basing it on C# code that I know works, because I used it at my workplace. See this link: http://www.sqlteam.com/forums/topic.asp?TOPIC_ID=105257. And this one: https://social.msdn.microsoft.com/Forums/sqlserver/en-US/dd2b465b-b1d2-4c0d-82ec-c36c6c482d5d/populating-sql-server-from-emails?forum=sqltools
FURTHER NOTE: This code will DELETE each email after saving the attachments from it. I think it will be a hard delete as well. In other words, you won't be able to pull the emails back out of the Deleted Items folder. You have been warned.
(It is possible to just mark each email as read instead of deleting it, but I don't have time to write the code for that just now. Hopefully this will be enough for your needs. If you still need this question answered.)
Namespace StephenGTuggy.Examples.SaveEWS2007Attachments
Public Module EWS2007ExampleMain
Enum AuthenticationMethod
Windows
Basic
End Enum
Private Const sUserName As String = "SampleUserName"
Private Const sPassword As String = "SamplePassword1"
Private Const sDomain As String = "mycompany.com"
Private Const eAuthenticationMethod As AuthenticationMethod = AuthenticationMethod.Basic
Private Const sEWS_URL As String = "https://mailserver.mycompany.com/EWS/Exchange.asmx"
'Private Const sEmailSender As String = "SampleUserName2#SomeOtherCompany.com"
Private Const sSaveAttachmentsToDirectory As String = "C:\"
Public Sub Main()
' Set up credentials to use to connect to the Exchange server.
Dim nc As System.Net.NetworkCredential = Nothing
Select Case eAuthenticationMethod
Case AuthenticationMethod.Windows
nc = System.Net.CredentialCache.DefaultNetworkCredentials
Case Else
nc = New System.Net.NetworkCredential(sUserName, sPassword, sDomain)
End Select
' Now bind to Exchange.
Dim esb As New ExchangeWebServices.ExchangeServiceBinding
esb.Url = sEWS_URL
esb.Credentials = nc
' Main code....
Dim findItemRequest As New ExchangeWebServices.FindItemType
findItemRequest.Traversal = ExchangeWebServices.ItemQueryTraversalType.Shallow
' Define which item properties Exchange should return for each email.
Dim itemProperties As New ExchangeWebServices.ItemResponseShapeType
itemProperties.BaseShape = ExchangeWebServices.DefaultShapeNamesType.AllProperties
findItemRequest.ItemShape = itemProperties
' Identify which folders to search to find items.
Dim folderIDInbox As New ExchangeWebServices.DistinguishedFolderIdType
folderIDInbox.Id = ExchangeWebServices.DistinguishedFolderIdNameType.inbox
Dim folderIDArray As ExchangeWebServices.DistinguishedFolderIdType() = {folderIDInbox}
findItemRequest.ParentFolderIds = folderIDArray
' Limit result set to unread emails only.
Dim restriction As New ExchangeWebServices.RestrictionType
Dim isEqualTo As New ExchangeWebServices.IsEqualToType
Dim pathToFieldType As New PathToUnindexedFieldType
pathToFieldType.FieldURI = ExchangeWebServices.UnindexedFieldURIType.messageIsRead '.messageFrom
Dim constantType As New ExchangeWebServices.FieldURIOrConstantType
Dim constantValueType As New ExchangeWebServices.ConstantValueType
constantValueType.Value = "0" 'sEmailSender
constantType.Item = constantValueType
isEqualTo.Item = pathToFieldType
isEqualTo.FieldURIOrConstant = constantType
restriction.Item = isEqualTo
findItemRequest.Restriction = restriction
' Send the request to Exchange and get the response back.
System.Diagnostics.Trace.TraceInformation("Sending FindItem request....")
Dim findItemResponse As ExchangeWebServices.FindItemResponseType = esb.FindItem(findItemRequest)
System.Diagnostics.Trace.TraceInformation("Received response to FindItem request.")
' Process response from Exchange server.
Dim folder As ExchangeWebServices.FindItemResponseMessageType = _
CType(findItemResponse.ResponseMessages.Items(0), ExchangeWebServices.FindItemResponseMessageType)
Dim folderContents As ExchangeWebServices.ArrayOfRealItemsType = _
CType(folder.RootFolder.Item, ExchangeWebServices.ArrayOfRealItemsType)
Dim items As ExchangeWebServices.ItemType() = folderContents.Items
For Each curItem As ExchangeWebServices.ItemType In items
Dim iAttCount As Integer = GetFileAttachmentsCount(esb, curItem.ItemId)
System.Diagnostics.Trace.TraceInformation("Subject: {0} DisplayTo: {1} DateTimeReceived: {2} ItemClass: {3} AttachmentCount: {4}", _
curItem.Subject.Trim(), _
curItem.DisplayTo.Trim(), _
curItem.DateTimeReceived.TimeOfDay.ToString(), _
curItem.ItemClass.Trim(), _
iAttCount)
If iAttCount > 0 Then
GetAttachmentsOnItem(esb, curItem.ItemId, sSaveAttachmentsToDirectory)
If Not MarkItemAsProcessed(esb, curItem.ItemId) Then
System.Diagnostics.Trace.TraceError("Unable to mark email as processed.")
End If
End If
Next
System.Diagnostics.Trace.TraceInformation("Finished processing emails and attachments.")
End Sub
Function GetFileAttachmentsCount(binding As ExchangeWebServices.ExchangeServiceBinding, _
id As ExchangeWebServices.ItemIdType) As Integer
Dim iAttachmentCount As Integer = 0
' Use GetItem on the Id to get the Attachments collection.
Dim getItemRequest As New ExchangeWebServices.GetItemType
getItemRequest.ItemIds = New ExchangeWebServices.ItemIdType() {id}
getItemRequest.ItemShape = New ExchangeWebServices.ItemResponseShapeType
getItemRequest.ItemShape.BaseShape = ExchangeWebServices.DefaultShapeNamesType.AllProperties
Dim hasAttachPath As New ExchangeWebServices.PathToUnindexedFieldType
hasAttachPath.FieldURI = ExchangeWebServices.UnindexedFieldURIType.itemHasAttachments
Dim attachmentsPath As New ExchangeWebServices.PathToUnindexedFieldType
attachmentsPath.FieldURI = ExchangeWebServices.UnindexedFieldURIType.itemAttachments
' Add additional properties?
getItemRequest.ItemShape.AdditionalProperties = New ExchangeWebServices.BasePathToElementType() { _
hasAttachPath, attachmentsPath}
Dim getItemResponse As ExchangeWebServices.GetItemResponseType = binding.GetItem(getItemRequest)
Dim getItemResponseMessage As ExchangeWebServices.ItemInfoResponseMessageType = TryCast( _
getItemResponse.ResponseMessages.Items(0), ExchangeWebServices.ItemInfoResponseMessageType)
If getItemResponseMessage.ResponseCode = ExchangeWebServices.ResponseCodeType.NoError Then
Dim item As ExchangeWebServices.ItemType = getItemResponseMessage.Items.Items(0)
' Don't rely on HasAttachments -- it does not mean what you think it would.
If (item.Attachments IsNot Nothing) AndAlso (item.Attachments.Length > 0) Then
For attachmentIndex As Integer = 0 To item.Attachments.Length - 1
Dim almostAnAttachment As ExchangeWebServices.FileAttachmentType = TryCast( _
item.Attachments(attachmentIndex), ExchangeWebServices.FileAttachmentType)
If almostAnAttachment IsNot Nothing Then
iAttachmentCount = iAttachmentCount + 1
End If
Next
End If
End If
Return iAttachmentCount
End Function
Function MarkItemAsProcessed(esb As ExchangeWebServices.ExchangeServiceBinding, _
id As ExchangeWebServices.ItemIdType) As Boolean
Dim bReturn As Boolean = False
' Create the DeleteItem request.
Dim dit As New ExchangeWebServices.DeleteItemType
dit.ItemIds = New ExchangeWebServices.BaseItemIdType() {id}
' Delete the message.
Dim diResponse As ExchangeWebServices.DeleteItemResponseType = esb.DeleteItem(dit)
' Check the result.
If (diResponse.ResponseMessages.Items.Length > 0) AndAlso _
(diResponse.ResponseMessages.Items(0).ResponseClass = _
ExchangeWebServices.ResponseClassType.Success) Then
bReturn = True
End If
Return bReturn
End Function
Sub GetAttachmentsOnItem(binding As ExchangeWebServices.ExchangeServiceBinding, _
id As ExchangeWebServices.ItemIdType, _
destinationPath As String)
' STEP 1: We need to call GetItem on the Id so that we can get the Attachments collection back.
Dim getItemRequest As New ExchangeWebServices.GetItemType
getItemRequest.ItemIds = New ExchangeWebServices.ItemIdType() {id}
getItemRequest.ItemShape = New ExchangeWebServices.ItemResponseShapeType
' For this example, all we really need is the HasAttachments property and the Attachment collection.
' As such, let's just request those properties to reduce network traffic.
getItemRequest.ItemShape.BaseShape = ExchangeWebServices.DefaultShapeNamesType.IdOnly
Dim hasAttachPath As New ExchangeWebServices.PathToUnindexedFieldType
hasAttachPath.FieldURI = ExchangeWebServices.UnindexedFieldURIType.itemHasAttachments
Dim attachmentsPath As New ExchangeWebServices.PathToUnindexedFieldType
attachmentsPath.FieldURI = ExchangeWebServices.UnindexedFieldURIType.itemAttachments
' Add these to the list of properties to fetch....
getItemRequest.ItemShape.AdditionalProperties = New ExchangeWebServices.BasePathToElementType() { _
hasAttachPath, attachmentsPath}
' Now make the call.
Dim getItemResponse As ExchangeWebServices.GetItemResponseType = binding.GetItem(getItemRequest)
' getItem returns ItemInfoResponseMessages. Since we only requested one item, we should only
' get back one response message.
Dim getItemResponseMessage As ExchangeWebServices.ItemInfoResponseMessageType = TryCast( _
getItemResponse.ResponseMessages.Items(0), ExchangeWebServices.ItemInfoResponseMessageType)
' Like all good, happy and compliant developers [sic], we should check our response code....
If getItemResponseMessage.ResponseCode = ExchangeWebServices.ResponseCodeType.NoError Then
' STEP 2: Grab the Attachment IDs from our item
Dim item As ExchangeWebServices.ItemType = getItemResponseMessage.Items.Items(0)
If item.HasAttachments AndAlso item.Attachments IsNot Nothing AndAlso item.Attachments.Length > 0 Then
Dim attachmentIds As New List(Of ExchangeWebServices.RequestAttachmentIdType)
For attachmentIndex As Integer = 0 To item.Attachments.Length - 1
' For now, let's only consider file attachments instead of item attachments.
Dim almostAnAttachment As ExchangeWebServices.FileAttachmentType = TryCast( _
item.Attachments(attachmentIndex), ExchangeWebServices.FileAttachmentType)
If almostAnAttachment IsNot Nothing Then
' VERY IMPORTANT! The attachment collection returned by GetItem only has meta data
' about the attachments, but DOES NOT INCLUDE THE ACTUAL CONTENT. We must use
' GetAttachment to get the actual attachment.
Dim requestId As New ExchangeWebServices.RequestAttachmentIdType
requestId.Id = almostAnAttachment.AttachmentId.Id
attachmentIds.Add(requestId)
End If
Next
' Now that we have all of the attachment IDs, let's make a single GetAttachment call to
' get them all in one shot.
Dim getAttachmentRequest As New ExchangeWebServices.GetAttachmentType
' Oddly enough, just create an EMPTY (non-null) attachment response shape.
getAttachmentRequest.AttachmentShape = New ExchangeWebServices.AttachmentResponseShapeType
getAttachmentRequest.AttachmentIds = attachmentIds.ToArray()
Dim getAttachmentResponse As ExchangeWebServices.GetAttachmentResponseType = _
binding.GetAttachment(getAttachmentRequest)
' Now, here we asked for multiple items. As such, we will get back multiple response
' messages.
For Each attachmentResponseMessage As ExchangeWebServices.AttachmentInfoResponseMessageType _
In getAttachmentResponse.ResponseMessages.Items
If attachmentResponseMessage.ResponseCode = ExchangeWebServices.ResponseCodeType.NoError Then
' We only asked for file attachments above, so we should only get FileAttachments.
' If you are really paranoid, you can check for null after this again.
Dim fileAttachment As ExchangeWebServices.FileAttachmentType = TryCast( _
attachmentResponseMessage.Attachments(0), ExchangeWebServices.FileAttachmentType)
' Now, just save out the file contents.
Using file As System.IO.FileStream = System.IO.File.Create(System.IO.Path.Combine(destinationPath, fileAttachment.Name))
file.Write(fileAttachment.Content, 0, fileAttachment.Content.Length)
file.Flush()
file.Close()
End Using
End If
Next
End If
End If
End Sub
End Module
End Namespace
One final note: You will use the same .asmx link both to create the web reference to EWS and to connect to the server to make the actual calls. This had me stumped for a bit.
Good luck!
I have textbox1.text and it has the user input text.
There are the main command and such. One of them is ip
If the user types ip local I want it to display the local ip, which I already have the code for
Another example would be ping google.com 1000 It would ping google for 1000MS, again I already have the code for it, but how would I get the 1000 or what if it wasn't there? it would just ping it once. I don't want an error to pop up.
code:
Dim text As String = TextBox1.Text
server.Start()
If text.StartsWith("ip") And text.EndsWith(" local") Then
response = System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName()).AddressList(0).ToString()
end if
I Believe you want something like this instead:
Dim array() As String = TextBox1.Text.Split(" ".ToCharArray(), StringSplitOptions.RemoveEmptyEntries)
Dim cmd as String = array(0).ToUpper()
If cmd = "IP" Then
IpConfig array
Else If cmd = "PING" Then
Ping array
End If
Next add each command as a Sub or Function or whatever....
Public Sub IpConfig( byVal array() as String)
' your code
End Sub
More commands.....