I have no idea how accurate this is but I had Gemini Pro use my custom NotebookLM trained on QB64 PE v4.1.0 help files. I have not tested this. I had to do a minimal edit to some variable names as it wanted to use reserved keywords as variable names.
Code: (Select All)
' ==============================================================================
' QB64-PE TOTP (Time-based One-Time Password) Generator
' Implements RFC 6238
'
' This program generates 6-digit MFA codes compatible with Google Authenticator,
' Microsoft Authenticator, etc.
'
' Requirements: QB64-PE (Phoenix Edition) v3.1.0+ for _ROL, _SHL, _SHR
' ==============================================================================
$Console:Only
_Dest _Console
Dim secret__key As String
Dim totpCode As String
Dim lastCode As String
Dim unixTime As _Integer64
Dim remainingSeconds As Integer
Print "========================================"
Print " QB64-PE TOTP Generator"
Print "========================================"
Print "Enter your Base32 Secret Key (spaces are ignored):"
Input "> ", secret__key
' Clean the key (remove spaces, uppercase)
secret__key = CleanBase32$(secret__key)
If Len(secret__key) = 0 Then
Print "Error: Key cannot be empty."
End
End If
Print "Generating codes..."
Print "Press Ctrl+C to exit."
Print
Do
' 1. Get current time in Unix format (seconds since Jan 1 1970)
unixTime = GetUnixTime%%
' 2. Calculate TOTP Step (Time / 30)
Dim timeStep As _Integer64
timeStep = unixTime \ 30
' 3. Calculate remaining seconds in this window for display
remainingSeconds = 30 - (unixTime Mod 30)
' 4. Generate the HMAC-SHA1 Hash
' We need to treat the timeStep as an 8-byte big-endian integer
Dim msg As String
msg = Int64ToBytes$(timeStep)
' Decode the Base32 secret to raw bytes
Dim __keyBytes As String
__keyBytes = Base32Decode$(secret__key)
' Compute HMAC-SHA1
Dim hmac As String
hmac = HMAC_SHA1$(__keyBytes, msg)
' 5. Dynamic Truncation (RFC 4226)
' Get the last byte of the hash
Dim offset As Integer
offset = Asc(Right$(hmac, 1)) And &H0F
' Get 4 bytes starting at that offset
Dim binaryCode As _Integer64
Dim byte1 As _Integer64, byte2 As _Integer64, byte3 As _Integer64, byte4 As _Integer64
byte1 = Asc(Mid$(hmac, offset + 1, 1)) And &H7F ' Mask MSB
byte2 = Asc(Mid$(hmac, offset + 2, 1)) And &HFF
byte3 = Asc(Mid$(hmac, offset + 3, 1)) And &HFF
byte4 = Asc(Mid$(hmac, offset + 4, 1)) And &HFF
' Combine bytes into a 32-bit integer (using _INTEGER64 to avoid overflow issues)
binaryCode = _ShL(byte1, 24) Or _ShL(byte2, 16) Or _ShL(byte3, 8) Or byte4
' 6. Generate the 6-digit code
Dim otp As _Integer64
otp = binaryCode Mod 1000000
' Format as 6 digits with leading zeros
totpCode = Right$("000000" + _Trim$(Str$(otp)), 6)
' 7. Display
' Only redraw if the code changed or just to update the timer
Locate 8, 1
Print "Current Code: "; totpCode
Print "Next code in: "; remainingSeconds; "s "
_Limit 5 ' Update 5 times a second
Loop
' ==============================================================================
' FUNCTIONS & SUBS
' ==============================================================================
' ------------------------------------------------------------------------------
' Calculates HMAC-SHA1
' RFC 2104: HMAC(K, text) = H((K XOR opad) + H((K XOR ipad) + text))
' ------------------------------------------------------------------------------
Function HMAC_SHA1$ (__key As String, message As String)
Dim k As String
k = __key
' SHA1 Block size is 64 bytes
Const BLOCK_SIZE = 64
' If key is longer than block size, hash it first
If Len(k) > BLOCK_SIZE Then
k = HexToStr$(SHA1$(k))
End If
' Pad key with zeros if shorter than block size
If Len(k) < BLOCK_SIZE Then
k = k + String$(BLOCK_SIZE - Len(k), 0)
End If
' Create Inner and Outer pads
Dim ipad As String, opad As String
ipad = String$(BLOCK_SIZE, 0)
opad = String$(BLOCK_SIZE, 0)
Dim i As Integer
For i = 1 To BLOCK_SIZE
' ipad = 0x36, opad = 0x5c
Mid$(ipad, i, 1) = Chr$(Asc(Mid$(k, i, 1)) Xor &H36)
Mid$(opad, i, 1) = Chr$(Asc(Mid$(k, i, 1)) Xor &H5C)
Next i
' Perform Inner Hash: SHA1(ipad + message)
Dim innerHashStr As String
innerHashStr = HexToStr$(SHA1$(ipad + message))
' Perform Outer Hash: SHA1(opad + innerHash)
' This is the final result
HMAC_SHA1$ = HexToStr$(SHA1$(opad + innerHashStr))
End Function
' ------------------------------------------------------------------------------
' Custom SHA1 Implementation (Since _SHA1 is not available)
' Returns a 40-character Hex String
' ------------------------------------------------------------------------------
Function SHA1$ (text As String)
Dim h0 As _Unsigned Long, h1 As _Unsigned Long, h2 As _Unsigned Long, h3 As _Unsigned Long, h4 As _Unsigned Long
h0 = &H67452301: h1 = &HEFCDAB89: h2 = &H98BADCFE: h3 = &H10325476: h4 = &HC3D2E1F0
Dim message_len As _Unsigned _Integer64
message_len = Len(text) * 8 ' Length in bits
' Pre-processing: Append '1' bit (byte 0x80)
Dim processing As String
processing = text + Chr$(&H80)
' Append 0 bits until length = 448 mod 512
While (Len(processing) Mod 64) <> 56
processing = processing + Chr$(0)
Wend
' Append original length as 64-bit big-endian integer
Dim bits As _Unsigned _Integer64
bits = message_len
Dim lenStr As String
lenStr = String$(8, 0)
Dim i As Integer
For i = 8 To 1 Step -1
Mid$(lenStr, i, 1) = Chr$(bits And &HFF)
bits = _ShR(bits, 8)
Next i
processing = processing + lenStr
' Process in 512-bit (64-byte) chunks
Dim chunkCount As Long
chunkCount = Len(processing) \ 64
Dim w(0 To 79) As _Unsigned Long
Dim a As _Unsigned Long, b As _Unsigned Long, c As _Unsigned Long, d As _Unsigned Long, e As _Unsigned Long
Dim f As _Unsigned Long, k As _Unsigned Long, temp As _Unsigned Long
Dim chunkIndex As Long
For chunkIndex = 0 To chunkCount - 1
Dim chunk As String
chunk = Mid$(processing, (chunkIndex * 64) + 1, 64)
' Break chunk into sixteen 32-bit big-endian words
For i = 0 To 15
w(i) = CVL_BE(Mid$(chunk, (i * 4) + 1, 4))
Next i
' Extend into eighty 32-bit words
For i = 16 To 79
w(i) = _RoL(w(i - 3) Xor w(i - 8) Xor w(i - 14) Xor w(i - 16), 1)
Next i
a = h0: b = h1: c = h2: d = h3: e = h4
For i = 0 To 79
If i <= 19 Then
f = (b And c) Or ((Not b) And d)
k = &H5A827999
ElseIf i <= 39 Then
f = b Xor c Xor d
k = &H6ED9EBA1
ElseIf i <= 59 Then
f = (b And c) Or (b And d) Or (c And d)
k = &H8F1BBCDC
Else
f = b Xor c Xor d
k = &HCA62C1D6
End If
temp = _RoL(a, 5) + f + e + k + w(i)
e = d
d = c
c = _RoL(b, 30)
b = a
a = temp
Next i
h0 = h0 + a
h1 = h1 + b
h2 = h2 + c
h3 = h3 + d
h4 = h4 + e
Next chunkIndex
SHA1$ = Hex8$(h0) + Hex8$(h1) + Hex8$(h2) + Hex8$(h3) + Hex8$(h4)
End Function
' ------------------------------------------------------------------------------
' Helper: Convert 4-byte BE string to Unsigned Long
' ------------------------------------------------------------------------------
Function CVL_BE~& (s As String)
Dim b1 As _Unsigned Long, b2 As _Unsigned Long, b3 As _Unsigned Long, b4 As _Unsigned Long
b1 = Asc(Mid$(s, 1, 1))
b2 = Asc(Mid$(s, 2, 1))
b3 = Asc(Mid$(s, 3, 1))
b4 = Asc(Mid$(s, 4, 1))
CVL_BE~& = _ShL(b1, 24) Or _ShL(b2, 16) Or _ShL(b3, 8) Or b4
End Function
' ------------------------------------------------------------------------------
' Helper: Return 8-digit hex string from Unsigned Long
' ------------------------------------------------------------------------------
Function Hex8$ (n As _Unsigned Long)
Dim h As String
h = Hex$(n)
Hex8$ = Right$("00000000" + h, 8)
End Function
' ------------------------------------------------------------------------------
' Converts a Base32 string to Raw Bytes
' ------------------------------------------------------------------------------
Function Base32Decode$ (__inStr As String)
Dim chars As String
chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"
Dim bitBuffer As _Integer64
Dim bitCount As Integer
Dim outStr As String
Dim i As Integer, valIdx As Integer
Dim char As String
bitBuffer = 0
bitCount = 0
outStr = ""
For i = 1 To Len(__inStr)
char = Mid$(__inStr, i, 1)
' Find index in base32 charset
valIdx = InStr(chars, char) - 1
If valIdx >= 0 Then
' Shift buffer left 5 bits and add new value
bitBuffer = _ShL(bitBuffer, 5) Or valIdx
bitCount = bitCount + 5
' If we have at least 8 bits, extract a byte
If bitCount >= 8 Then
bitCount = bitCount - 8
Dim byteVal As Integer
byteVal = _ShR(bitBuffer, bitCount) And &HFF
outStr = outStr + Chr$(byteVal)
End If
End If
Next i
Base32Decode$ = outStr
End Function
' ------------------------------------------------------------------------------
' Cleans Base32 input (removes spaces, converts to uppercase)
' ------------------------------------------------------------------------------
Function CleanBase32$ (__inStr As String)
Dim outStr As String
Dim i As Integer
Dim c As String
outStr = ""
For i = 1 To Len(__inStr)
c = UCase$(Mid$(__inStr, i, 1))
If (c >= "A" And c <= "Z") Or (c >= "2" And c <= "7") Then
outStr = outStr + c
End If
Next i
CleanBase32$ = outStr
End Function
' ------------------------------------------------------------------------------
' Converts an _INTEGER64 to an 8-byte Big-Endian Binary String
' Required for the TOTP time counter
' ------------------------------------------------------------------------------
Function Int64ToBytes$ (value As _Integer64)
Dim s As String
Dim temp As _Integer64
temp = value
s = String$(8, 0)
Dim i As Integer
For i = 8 To 1 Step -1
Mid$(s, i, 1) = Chr$(temp And &HFF)
temp = _ShR(temp, 8)
Next i
Int64ToBytes$ = s
End Function
' ------------------------------------------------------------------------------
' Helper: Converts a Hex string (returned by SHA1$) to a Binary String
' ------------------------------------------------------------------------------
Function HexToStr$ (hexStr As String)
Dim s As String
Dim i As Integer
s = ""
For i = 1 To Len(hexStr) Step 2
s = s + Chr$(Val("&H" + Mid$(hexStr, i, 2)))
Next i
HexToStr$ = s
End Function
' ------------------------------------------------------------------------------
' Calculates Unix Timestamp (Seconds since 1970-01-01 00:00:00 UTC)
' Note: This uses the local computer time. TOTP requires accurate time.
' ------------------------------------------------------------------------------
Function GetUnixTime%%
' Use a known reference epoch
' QB64's TIMER is seconds since midnight.
' We need to calculate total days since 1970.
Dim currDate As String, currTime As String
currDate = Date$ ' MM-DD-YYYY
currTime = Time$ ' HH:MM:SS
Dim mm As Integer, dd As Integer, yyyy As Integer
mm = Val(Left$(currDate, 2))
dd = Val(Mid$(currDate, 4, 2))
yyyy = Val(Right$(currDate, 4))
' Basic algorithm to convert date to days since epoch
' 1. Calculate days for full years
Dim days As _Integer64
Dim y As Integer
days = 0
For y = 1970 To yyyy - 1
If (y Mod 4 = 0 And y Mod 100 <> 0) Or (y Mod 400 = 0) Then
days = days + 366
Else
days = days + 365
End If
Next y
' 2. Calculate days for full months in current year
Dim m As Integer
Dim daysInMonth(12) As Integer
daysInMonth(1) = 31: daysInMonth(2) = 28: daysInMonth(3) = 31
daysInMonth(4) = 30: daysInMonth(5) = 31: daysInMonth(6) = 30
daysInMonth(7) = 31: daysInMonth(8) = 31: daysInMonth(9) = 30
daysInMonth(10) = 31: daysInMonth(11) = 30: daysInMonth(12) = 31
' Leap year check for current year
If (yyyy Mod 4 = 0 And yyyy Mod 100 <> 0) Or (yyyy Mod 400 = 0) Then
daysInMonth(2) = 29
End If
For m = 1 To mm - 1
days = days + daysInMonth(m)
Next m
' 3. Add current day
days = days + (dd - 1)
' 4. Convert to seconds
Dim totalSeconds As _Integer64
totalSeconds = days * 86400
' 5. Add time from current day
Dim hh As Integer, min As Integer, ss As Integer
hh = Val(Left$(currTime, 2))
min = Val(Mid$(currTime, 4, 2))
ss = Val(Right$(currTime, 2))
totalSeconds = totalSeconds + (hh * 3600) + (min * 60) + ss
' Note: DATE$ and TIME$ are local. TOTP technically requires UTC.
' If your PC is not in UTC, you might need to adjust the offset here.
' For simplicity, we assume the user's system clock is appropriate or
' they can adjust the mental offset.
' A robust solution would read time zone info from OS APIs, but that
' requires DECLARE LIBRARY which is complex for a snippet.
' We will add a manual timezone offset variable if needed, set to 0 for now.
' e.g. If you are EST (-5), you need to ADD 5 hours to get UTC.
' You can hardcode your offset here in seconds if needed.
' DIM tzOffsetSeconds AS _INTEGER64
' tzOffsetSeconds = 5 * 3600
' totalSeconds = totalSeconds + tzOffsetSeconds
GetUnixTime%% = totalSeconds
End Function
