Code Snippets

This is a collection of VB.Net code "snippets". A snippet is a short source code example of how to perform a specific task. Click on a entry to show the source code.

Database (ADO.Net)

+ How to Use DataColumn Expressions

Sub Expressions()
    Dim con As New System.Data.oledb.OleDbConnection
    Dim da As New System.Data.oledb.OleDbDataAdapter
    Dim cmd As New System.Data.oledb.OleDbCommand
    Dim dc As DataColumn
    Dim ds As New DataSet

    ' connect to the database
    con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=..\NorthWind.mdb"
    cmd.Connection = con
    da.SelectCommand = cmd

    ' fill the DataTable
    cmd.CommandText = "Select * from Products"
    da.Fill(ds, "Products")

    ' add on a few simple expression columns
    dc = New DataColumn("UnitPriceX2")
    dc.DataType = GetType(Double)
    dc.Expression = "UnitPrice * 2" ' column and numeric constant
    ds.Tables("Products").Columns.Add(dc)

    dc = New DataColumn("TotalStock")
    dc.DataType = GetType(Integer)
    dc.Expression = "UnitsInStock + UnitsOnOrder" ' two column types
    ds.Tables("Products").Columns.Add(dc)

    dc = New DataColumn("Hello")
    dc.DataType = GetType(String)
    dc.Expression = "ProductName + ' Hello'" ' column and string constant
    ds.Tables("Products").Columns.Add(dc)
End Sub

Active Directory (ADSI)

+ How to List All Users in an OU

Sub ListUsers(ByVal DOMAIN As String, ByVal OU As String)
    ' add a reference to System.DirectoryServices.dll
    Dim srch As System.DirectoryServices.DirectorySearcher
    Dim result As System.DirectoryServices.SearchResult
    Dim de, dir As System.DirectoryServices.DirectoryEntry

    de = New System.DirectoryServices.DirectoryEntry("LDAP://" & DOMAIN & "/" & OU)
    srch = New System.DirectoryServices.DirectorySearcher(de)
    ' users require both "user" and "person" filters
    srch.Filter = "(&(objectClass=user)(objectCategory=person))"

    For Each result In srch.FindAll()
        dir = result.GetDirectoryEntry
        ' Properties are case sensitive!
        Debug.WriteLine(dir.Properties("distinguishedName").Value)
    Next
End Sub

+ How to List All Computers in an OU

Sub ListComputers(ByVal DOMAIN As String, ByVal OU As String)
    ' add a reference to System.DirectoryServices.dll
    Dim srch As System.DirectoryServices.DirectorySearcher
    Dim result As System.DirectoryServices.SearchResult
    Dim de, dir As System.DirectoryServices.DirectoryEntry

    de = New System.DirectoryServices.DirectoryEntry("LDAP://" & DOMAIN & "/" & OU)
    srch = New System.DirectoryServices.DirectorySearcher(de)
    srch.Filter = "(ObjectCategory=computer)"

    For Each result In srch.FindAll()
        dir = result.GetDirectoryEntry
        ' Properties are case sensitive!
        Debug.WriteLine(dir.Properties("CN").Value)
    Next
End Sub

+ How to Find the Distinguish Name of an OU

Sub FindDNofOU(ByVal DOMAIN As String, ByVal OU As String)
    ' add a reference to System.DirectoryServices.dll
    Dim entry, de As System.DirectoryServices.DirectoryEntry
    Dim srch As System.DirectoryServices.DirectorySearcher
    Dim result As System.DirectoryServices.SearchResult
    Dim ldap As String
    Dim i As Integer

    ldap = "LDAP://" & DOMAIN

    ' is this already a fully qualified Distinguished Name?
    If OU.ToUpper.StartsWith("OU=") Then
        entry = New System.DirectoryServices.DirectoryEntry(ldap & "/" & OU)
        ldap = entry.Path
    Else
        ' if not, go find the full path
        entry = New System.DirectoryServices.DirectoryEntry(ldap)
        srch = New DirectoryServices.DirectorySearcher(entry)

        ' there may be more than one OU by that name!
        i = 0
        srch.Filter = "(OU=" & OU & ")"
        For Each result In srch.FindAll()
            ldap = result.Path
            i += 1
        Next

        ' how many did we find?
        If i = 0 Then
            Throw New Exception("Can't find OU '" & OU & "'")
        End If
        If i > 1 Then
            Throw New Exception("Ambiguous search pattern, found " & i & " OUs named '" & OU & "'")
        End If
    End If

    ' do it again with the full path in place
    entry = New System.DirectoryServices.DirectoryEntry(ldap)
    srch = New DirectoryServices.DirectorySearcher(entry)

    ' so something here...
End Sub

+ How to Find the NETBIOS Name of a Domain

Sub FindNetBIOSName()
    ' add a reference to System.DirectoryServices.dll
    Dim strDomain As String
    Dim rootds, root, part, parts As System.DirectoryServices.DirectoryEntry

    ' get the root namespace
    rootds = New System.DirectoryServices.DirectoryEntry("LDAP://rootDSE")
    ' get the name of the domain we're currently in
    strDomain = rootds.Properties("DefaultNamingContext")(0)
    parts = New System.DirectoryServices.DirectoryEntry("LDAP://CN=Partitions,CN=Configuration," _
     & strDomain)

    For Each part In parts.Children
        ' search the AD Configuration container for our domain name
        If part.Properties("nCName")(0) = strDomain Then
            ' Properties are case sensitive!
            MsgBox(part.Properties("nETBIOSName")(0))
            Exit For
        End If
    Next
End Sub

Files and File System

+ How to Return File Version Information

Sub FileVer(ByVal file As String)
    Dim fvi As FileVersionInfo
    Dim ans As String

    If System.IO.File.Exists(file) Then
        ' get the file version info
        fvi = FileVersionInfo.GetVersionInfo(file)
        If fvi.FileVersion <> "" Then
            ' we prefer this answer, if available
            ans = fvi.FileVersion
        Else
            ans = fvi.FileMajorPart & "." & fvi.FileMinorPart & "." & fvi.FileBuildPart & "." & fvi.FilePrivatePart
        End If
    End If

    MsgBox(ans)
End Sub

Security

+ How to Determine if the Current User in an Administrator

Imports System.Security.Principal

Function IsAdmin() As Boolean
    Dim MyPrincipal As WindowsPrincipal

    ' set the stage by picking type of security principal
    AppDomain.CurrentDomain.SetPrincipalPolicy(WindowsPrincipal)
    ' get the security principal for this thread
    MyPrincipal = CType(System.Threading.Thread.CurrentPrincipal, WindowsPrincipal)
    Try
        If MyPrincipal.IsInRole(WindowsBuiltInRole.Administrator) Then
            Return True
        Else
            Return False
        End If
    Catch
    End Try

    ' if the built-in role doesn't exist... then report false
    Return False
End Function

Windows Management Instrumentation (WMI)

+ How to Set the Default Printer

Sub SetDefaultPrinter(ByVal strPrinter As String)
    ' add a reference to System.Management
    Dim wmi As System.Management.ManagementClass
    Dim obj As System.Management.ManagementObject
    Dim gotit As Boolean = False

    wmi = New System.Management.ManagementClass("\root\cimv2:Win32_Printer")
    For Each obj In wmi.GetInstances
        If obj("Name") = strPrinter Then
            ' The SetDefaultPrinter method is new to WinXP/Win2003
            obj.InvokeMethod("SetDefaultPrinter", Nothing)
            gotit = True
        End If
    Next

    If Not gotit Then
        MsgBox("Hey, couldn't find a printer by that name!")
    End If
End Sub

Exceptions and Event Logs

+ How to Retrieve Nested Error Messages

Try
     ' do something here
Catch ex As Exception
     Dim msg As String = ""
     While Not (ex Is Nothing)
          msg &= ex.Message & vbCr
          ex = ex.InnerException
     End While
     MsgBox(msg)
End Try

+ How to Write to the Eventlog

Try
     ' Do something
Catch ex As Exception
     Dim el As New System.Diagnostics.EventLog
     el.Source = System.Reflection.Assembly.GetExecutingAssembly().GetName().Name
     el.WriteEntry("Yikes, couldn't open the log file!" & vbcr & ex.message, EventLogEntryType.Error)
     Exit Sub
End Try

Other

+ How to Use VBScript inside VB.Net

Sub RunVBScript()
    ' Included a COM reference to "Microsoft Script Control" (MSScriptControl)
    Dim host As New MSScriptControl.ScriptControlClass

    host.Language = "VBScript"
    host.AddCode("Sub main" & vbCr & "Msgbox(""Hello"")" & vbCr & "End Sub")
    host.Run("main")
End Sub