vbLM - LM hash function in Visual Basic 6.0 and VB.Net 2010 - Programare

begood

Posted September 18, 2010

- Report
- Share

Posted September 18, 2010

VB.net 2010 :


Imports System.Security.Cryptography
Imports System.Text.ASCIIEncoding
Imports System.IO

...

    Public Function makeByteArray(ByVal ParamArray arr() As Byte) As Byte()
        Return arr
    End Function

    Public Function makeIntArray(ByVal ParamArray arr() As Integer) As Integer()
        Return arr
    End Function

    Public Function lmConvert(ByRef pw As String) As Byte()
        Dim a As Integer, b As Integer, ch As Integer
        Dim ret(13) As Byte, aPw() As Char
        Static map(0) As Integer, mapMap2() As Integer, map2() As Byte

        If map.Length = 1 Then
            map = makeIntArray(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
                               16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
                               32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47,
                               48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63,
                               64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79,
                               80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95,
                               96, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79,
                               80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 123, 124, 125, 126, 127,
                               -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
                               -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
                               255, 173, 155, 156, 15, 157, 221, 21, 34, 67, 166, 174, 170, 45, 82, 95,
                               248, 241, 253, 51, 39, 230, 20, 250, 44, 49, 167, 175, 172, 171, 95, 168,
                               65, 65, 65, 65, 142, 143, 146, 128, 69, 144, 69, 69, 73, 73, 73, 73,
                               68, 165, 79, 79, 79, 79, 153, 88, 79, 85, 85, 85, 154, 89, 95, 225,
                               65, 65, 65, 65, 142, 143, 146, 128, 69, 144, 69, 69, 73, 73, 73, 73,
                               68, 165, 79, 79, 79, 79, 153, 246, 79, 85, 85, 85, 154, 89, 95, 89)
            map2 = makeByteArray(44, 159, 44, 46, 43, 216, 94, 37, 83, 60, 79, 90, 96,
                                 39, 34, 34, 7, 45, 45, 126, 84, 83, 62, 79, 90, 89)
             mapMap2 = makeIntArray(&H201A, &H192, &H201E,  &H2026, &H2020, &H2021, &H2C6, &H2030, &H160,  &H2039, &H152, &H17D, &H2018,
                                    &H2019, &H201C, &H201D, &H2022, &H2013,  &H2014, &H2DC, &H2122, &H161, &H203A, &H153,  &H17E, &H178)
        End If
        If pw.Length = 0 Or pw.Length > 14 Then
            ReDim ret(0)
            Return ret
        End If
        aPw = pw.ToCharArray()
        For a = 0 To UBound(aPw)
            ch = AscW(aPw(a))
            If ch < 256 Then
                If map(ch) = -1 Then
                    ReDim ret(0)
                    Return ret
                End If
                ret(a) = CByte(map(ch))
            Else
                For b = 0 To UBound(mapMap2)
                    If mapMap2( = ch Then
                        ret(a) = map2(
                        Exit For
                    End If
                Next
                If b > UBound(mapMap2) Then
                    ReDim ret(0)
                    Return ret
                End If
            End If
        Next
        Return ret
    End Function

    Public Function lmPasswordToDesKey(ByRef pw() As Byte, ByVal offset As Integer) As Byte()
        Dim key(7) As Byte

        key(0) = pw(offset)
        key(1) = CByte(((CInt(pw(offset)) * 128) Or (CInt(pw(offset + 1)) \ 2)) And &HFF)
        key(2) = CByte(((CInt(pw(offset + 1)) * 64) Or (CInt(pw(offset + 2)) \ 4)) And &HFF)
        key(3) = CByte(((CInt(pw(offset + 2)) * 32) Or (CInt(pw(offset + 3)) \ 8)) And &HFF)
        key(4) = CByte(((CInt(pw(offset + 3)) * 16) Or (CInt(pw(offset + 4)) \ 16)) And &HFF)
        key(5) = CByte(((CInt(pw(offset + 4)) * 8) Or (CInt(pw(offset + 5)) \ 32)) And &HFF)
        key(6) = CByte(((CInt(pw(offset + 5)) * 4) Or (CInt(pw(offset + 6)) \ 64)) And &HFF)
        key(7) = CByte((CInt(pw(offset + 6)) * 2) And &HFF)
        Return key
    End Function

    Public Function lmHash(ByRef pw As String) As String
        Dim a As Integer
        Dim hash As String = "", tmp As String
        Dim aPw() As Byte, aHash() As Byte
        Dim des As New DESCryptoServiceProvider()

        aPw = lmConvert(pw)
        If aPw.Length <> 14 Then
            'System.Security.Cryptography doesn't encrypt with a key of all zeros
            hash = "AAD3B435B51404EEAAD3B435B51404EE"
        Else
            des.Mode = CipherMode.ECB
            des.Padding = PaddingMode.None
            des.Key = lmPasswordToDesKey(aPw, 0)
            aHash = des.CreateEncryptor().TransformFinalBlock(ASCII.GetBytes("KGS!@#$%"), 0, 8)
            For a = 0 To aHash.GetUpperBound(0)
                tmp = "0" + Hex(aHash(a))
                hash += tmp.Substring(tmp.Length - 2)
            Next
            If pw.Length <= 7 Then
                'System.Security.Cryptography doesn't encrypt with a key of all zeros
                hash += "AAD3B435B51404EE"
            Else
                des.Key = lmPasswordToDesKey(aPw, 7)
                aHash = des.CreateEncryptor().TransformFinalBlock(ASCII.GetBytes("KGS!@#$%"), 0, 8)
                For a = 0 To aHash.GetUpperBound(0)
                    tmp = "0" + Hex(aHash(a))
                    hash += tmp.Substring(tmp.Length - 2)
                Next
            End If
        End If
        Return hash
    End Function