Hallo!
Code
' Quelle: https://stackoverflow.com/questions/75025085/2fa-of-the-google-authenticator-app-with-vba
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Declare Sub GetSystemTime Lib "Kernel32" (ByRef lpSystemTime As SYSTEMTIME)
Function otpOut()
Dim Key As String, Secret As String, Time As String, hmac As String, ch As String, p1 As String, p2 As String, otp As String
Dim offset As Long, d As Long, i As Long, n As Long, j As Long, a As Long
Secret = UCase("AWSD1F")
n = 0
j = 0
For i = 1 To Len(Secret)
ch = Mid$(Secret, i, 1)
If ch >= "A" And ch <= "Z" Then
d = asc(ch) - asc("A")
ElseIf ch >= "2" And ch <= "7" Then
d = asc(ch) - asc("0") + 24
End If
n = (ShiftLeft(n, 5)) + d
j = j + 5
If j >= 8 Then
j = j - 8
Key = Key & WorksheetFunction.Dec2Hex(ShiftRight((n And ShiftLeft(255, j)), j), 2)
End If
Next i
Time = Right("0000000000000000" & Hex(WorksheetFunction.Floor(CurrentTimeMillis() / 1000 / 30, 1)), 16)
hmac = HEX_HMACSHA1(Time, Key)
offset = Hex2UInt(Right(hmac, 1))
p2 = Hex2UInt("7fffffff")
If offset = 0 Then
p1 = Hex2UInt(Left(hmac, 8))
Else
p1 = Hex2UInt(Mid(hmac, offset * 2 + 1, 8))
End If
otpOut = Right(WorksheetFunction.Bitand(p1, p2), 6)
End Function
Function CurrentTimeMillis() As Double
Dim st As SYSTEMTIME
GetSystemTime st
Dim t_Start, t_Now
t_Start = DateSerial(1970, 1, 1) ' Starting time for Linux
t_Now = DateSerial(st.wYear, st.wMonth, st.wDay) + _
TimeSerial(st.wHour, st.wMinute, st.wSecond)
CurrentTimeMillis = DateDiff("s", t_Start, t_Now) * 1000 + st.wMilliseconds
End Function
Function Hex2UInt(h As String) As Double
Dim dbl As Double: dbl = CDbl("&h" & h)
If dbl < 0 Then
dbl = CDbl("&h1" & h) - 4294967296#
End If
Hex2UInt = dbl
End Function
Public Function HEX_HMACSHA1(ByVal sTextToHash As String, ByVal sSharedSecretKey As String) As String
Dim asc As Object
Dim enc As Object
Dim TextToHash() As Byte
Dim SharedSecretKey() As Byte
Dim Bytes() As Byte
Dim sHexString As String
Dim i As Long
Set asc = CreateObject("System.Text.UTF8Encoding")
Set enc = CreateObject("System.Security.Cryptography.HMACSHA1")
TextToHash = HexStringToByteArray(sTextToHash)
SharedSecretKey = HexStringToByteArray(sSharedSecretKey)
enc.Key = SharedSecretKey
Bytes = enc.ComputeHash_2((TextToHash))
HEX_HMACSHA1 = ByteArrayToHexStr(Bytes)
Set asc = Nothing
Set enc = Nothing
End Function
Function HexStringToByteArray(strInput As String) As Byte()
Dim rMatch As Object
Dim s As String
Dim arrayMatches() As Byte
Dim i As Long
With New RegExp
.Global = True
.IgnoreCase = True
.Pattern = "([A-F0-9]{2})"
If .Test(strInput) Then
For Each rMatch In .Execute(strInput)
ReDim Preserve arrayMatches(i)
arrayMatches(i) = Hex2UInt(rMatch.Value)
i = i + 1
Next
End If
End With
HexStringToByteArray = arrayMatches
End Function
Function ByteArrayToHexStr(b() As Byte) As String
Dim n As Long, i As Long
ByteArrayToHexStr = Space$(2 * (UBound(b) - LBound(b)) + 2)
n = 1
For i = LBound(b) To UBound(b)
Mid$(ByteArrayToHexStr, n, 2) = Right$("00" & Hex$(b(i)), 2)
n = n + 2
Next
End Function
Public Static Function ShiftLeft(ByVal Value As Long, ByVal ShiftCount As Long) As Long
Dim Pow2(0 To 31) As Long
Dim i As Long
Dim mask As Long
Select Case ShiftCount
Case 1 To 31
If i = 0 Then
Pow2(0) = 1
For i = 1 To 30
Pow2(i) = 2 * Pow2(i - 1)
Next i
End If
mask = Pow2(31 - ShiftCount)
If Value And mask Then
ShiftLeft = (Value And (mask - 1)) * Pow2(ShiftCount) Or &H80000000
Else
ShiftLeft = (Value And (mask - 1)) * Pow2(ShiftCount)
End If
Case 0
ShiftLeft = Value
End Select
End Function
Public Static Function ShiftRight(ByVal Value As Long, ByVal ShiftCount As Long) As Long
Dim lPow2(0 To 30) As Long
Dim i As Long
Select Case ShiftCount
Case 0 To 30
If i = 0 Then
lPow2(0) = 1
For i = 1 To 30
lPow2(i) = 2 * lPow2(i - 1)
Next
End If
If Value And &H80000000 Then
ShiftRight = Int(Value / lPow2(ShiftCount))
Else
ShiftRight = Value \ lPow2(ShiftCount)
End If
Case 31
If Value And &H80000000 Then
ShiftRight = -1
Else
ShiftRight = 0
End If
End Select
End Function
Alles anzeigen
1. Könnte mal bitte jemand schauen wie es in AutoIt aussehen könnte? Vielleicht ist es ja in AutoIt sogar leichter. ("WorksheetFunction" liese sich vielleicht sogar nutzen, mit der passenden Referenzierung. Stellt sich die Frage ob das nötig ist. ).
2. Gibt es irgendwo eine Seite, auf der man das lernen kann? Vielleicht sogar mit Vergleich zwischen VBA und AutoIt? Wie/wo habt ihr das gelernt?
Danke!
Gruß, René