Dim secretKey As String

Dim generatedTOTP As String



' Assign the Base32 encoded secret key (this is just an example key)

secretKey$ = "JBSWY3DPEHPK3PXP"

Dim i As Integer

For i = 1 To 10

    ' Call the TOTP$ function and store the result in `generatedTOTP$`

    generatedTOTP$ = TOTP$(secretKey$)



    ' Output the generated TOTP code

    Print "Your TOTP code is: "; generatedTOTP$

    Print

Next





Function GetTimeStep

    Dim unixTime As Long

    unixTime = TimeStamp(Date$, Timer + MyTimeZone)

    GetTimeStep = unixTime \ 30 ' Divide by 30 to get the time step

End Function



Function HMAC_SHA1$ (key$, message$)

    ' Step 1: Prepare the key

    If Len(key$) > 64 Then

        key$ = SHA1$(key$) ' Assuming you have an SHA1 function

    End If



    ' Pad key to 64 bytes

    key$ = Left$(key$ + String$(64, Chr$(0)), 64)



    ' Step 2: Create inner and outer padded keys

    Dim ipad As String

    Dim opad As String

    ipad$ = ""

    opad$ = ""



    For i = 1 To 64

        ipad$ = ipad$ + Chr$(Asc(Mid$(key$, i, 1)) Xor &H36)

        opad$ = opad$ + Chr$(Asc(Mid$(key$, i, 1)) Xor &H5C)

    Next i



    ' Step 3: Hash the inner padded key with the message

    innerHash$ = SHA1$(ipad$ + message$) ' First hash (ipad + message)



    ' Step 4: Hash the outer padded key with the result of the first hash

    HMAC_SHA1$ = SHA1$(opad$ + innerHash$) ' Final HMAC-SHA1 result

End Function



Function TOTP$ (secretKey$)

    Dim timeStep As Long

    Dim timeValue As String

    Dim hmac As String

    Dim offset As Integer

    Dim otp As Long

    Dim b32d As String



    ' Step 1: Get the current time step (current time divided by 30 seconds)

    timeStep = Int(TimeStamp(Date$, Timer + MyTimeZone) / 30)

    timeValue = Str$(timeStep) ' Convert time step to string



    ' Step 2: Calculate the HMAC-SHA1 hash using the secret key and time value

    hmac = HMAC_SHA1$(DecodeBase32$(secretKey$, ""), timeValue)



    ' Step 3: Extract the dynamic offset and truncate the hash

    offset = Asc(Mid$(hmac, Len(hmac), 1)) And 15

    otp = Val("&H" + Mid$(hmac, offset + 1, 8)) And &H7FFFFFFF

    otp = otp Mod 1000000 ' Generate a 6-digit OTP



    ' Step 4: Convert the OTP to a 6-digit string and return it

    TOTP$ = Right$("000000" + LTrim$(Str$(otp)), 6)

End Function







Function SHA1$ (message$)

    ' Step 1: Message Padding

    Dim paddedMessage As String

    Dim originalLength As Long



    originalLength = Len(message$) * 8 ' Original length in bits

    paddedMessage$ = message$ + Chr$(128) ' Append '1' bit as 0x80

    While (Len(paddedMessage$) Mod 64) <> 56

        paddedMessage$ = paddedMessage$ + Chr$(0) ' Append '0' bits

    Wend



    ' Append original length as 64-bit big-endian integer

    paddedMessage$ = paddedMessage$ + MKL$(0) + MKL$(originalLength)



    ' Step 2: Process each 512-bit block

    Dim h0 As Long, h1 As Long, h2 As Long, h3 As Long, h4 As Long

    Dim a As Long, b As Long, c As Long, d As Long, e As Long

    Dim temp As Long



    h0 = &H67452301: h1 = &HEFCDAB89: h2 = &H98BADCFE: h3 = &H10325476: h4 = &HC3D2E1F0



    ' Additional processing logic goes here...



    ' Step 3: Final Output

    SHA1$ = Hex$(h0) + Hex$(h1) + Hex$(h2) + Hex$(h3) + Hex$(h4)

End Function





Function GenerateTOTP$ (secretKey$)

    Dim timeStep As Long

    Dim decodedKey As String

    Dim hmacResult As String

    Dim offset As Integer

    Dim binaryCode As Long

    Dim otp As Integer

    Dim otpStr As String



    ' Step 1: Get the time step

    timeStep = GetTimeStep



    ' Step 2: Decode the Base32 secret key

    decodedKey$ = DecodeBase32$(secretKey$, "")



    ' Step 3: Generate HMAC-SHA1

    hmacResult$ = HMAC_SHA1$(decodedKey$, MKL$(timeStep))



    ' Step 4: Extract dynamic binary code

    offset = Asc(Mid$(hmacResult$, Len(hmacResult$), 1)) And &HF

    binaryCode = (Asc(Mid$(hmacResult$, offset + 1, 1)) And &H7F) * &H1000000

    binaryCode = binaryCode Or (Asc(Mid$(hmacResult$, offset + 2, 1)) * &H10000)

    binaryCode = binaryCode Or (Asc(Mid$(hmacResult$, offset + 3, 1)) * &H100)

    binaryCode = binaryCode Or (Asc(Mid$(hmacResult$, offset + 4, 1)))



    ' Step 5: Generate the OTP code

    otp = binaryCode Mod 1000000 ' 6-digit code

    otpStr = Right$("000000" + LTrim$(Str$(otp)), 6)



    GenerateTOTP$ = otpStr

End Function





Function TimeStamp## (d$, t##) 'date and timer

    'Based on Unix Epoch time, which starts at year 1970.

    Dim l As _Integer64, l1 As _Integer64, m As _Integer64

    Dim d As _Integer64, y As _Integer64, i As _Integer64

    Dim s As _Float



    l = InStr(d$, "-")

    l1 = InStr(l + 1, d$, "-")

    m = Val(Left$(d$, l))

    d = Val(Mid$(d$, l + 1))

    y = Val(Mid$(d$, l1 + 1))

    If y < 1970 Then 'calculate shit backwards

        Select Case m 'turn the day backwards for the month

            Case 1, 3, 5, 7, 8, 10, 12: d = 31 - d '31 days

            Case 2: d = 28 - d 'special 28 or 29.

            Case 4, 6, 9, 11: d = 30 - d '30 days

        End Select

        If y Mod 4 = 0 And m < 3 Then 'check for normal leap year, and we're before it...

            d = d + 1 'assume we had a leap year, subtract another day

            If y Mod 100 = 0 And y Mod 400 <> 0 Then d = d - 1 'not a leap year if year is divisible by 100 and not 400

        End If



        'then count the months that passed after the current month

        For i = m + 1 To 12

            Select Case i

                Case 2: d = d + 28

                Case 3, 5, 7, 8, 10, 12: d = d + 31

                Case 4, 6, 9, 11: d = d + 30

            End Select

        Next



        'we should now have the entered year calculated.  Now lets add in for each year from this point to 1970

        d = d + 365 * (1969 - y) '365 days per each standard year

        For i = 1968 To y + 1 Step -4 'from 1968 onwards,backwards, skipping the current year (which we handled previously in the FOR loop)

            d = d + 1 'subtract an extra day every leap year

            If (i Mod 100) = 0 And (i Mod 400) <> 0 Then d = d - 1 'but skipping every year divisible by 100, but not 400

        Next

        s## = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds

        TimeStamp## = -(s## + 24 * 60 * 60 - t##)

        Exit Function

    Else

        y = y - 1970

    End If



    For i = 1 To m 'for this year,

        Select Case i 'Add the number of days for each previous month passed

            Case 1: d = d 'January doestn't have any carry over days.

            Case 2, 4, 6, 8, 9, 11: d = d + 31

            Case 3 'Feb might be a leap year

                If (y Mod 4) = 2 Then 'if this year is divisible by 4 (starting in 1972)

                    d = d + 29 'its a leap year

                    If (y Mod 100) = 30 And (y Mod 400) <> 30 Then 'unless..

                        d = d - 1 'the year is divisible by 100, and not divisible by 400

                    End If

                Else 'year not divisible by 4, no worries

                    d = d + 28

                End If

            Case 5, 7, 10, 12: d = d + 30

        End Select

    Next

    d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year

    For i = 2 To y - 1 Step 4 'from 1972 onwards, skipping the current year (which we handled previously in the FOR loopp)

        d = d + 1 'add an extra day every leap year

        If (i Mod 100) = 30 And (i Mod 400) <> 30 Then d = d - 1 'but skiping every year divisible by 100, but not 400

    Next

    s## = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds

    TimeStamp## = (s## + t##)

End Function













Function EncodeBase32$ (text$)

    ' Step 1: Convert the string to binary representation

    binaryString$ = ""

    For i = 1 To Len(text$)

        char$ = Mid$(text$, i, 1)

        asciiCode = Asc(char$)

        binaryString$ = binaryString$ + Right$("00000000" + _Bin$(asciiCode), 8)

    Next



    ' Step 2: Separate every 5 bits and pad if necessary

    paddedBinaryString$ = binaryString$

    While Len(paddedBinaryString$) Mod 5 <> 0

        paddedBinaryString$ = paddedBinaryString$ + "0"

    Wend



    ' Step 3: Convert each 5-bit segment to the corresponding Base32 character

    base32Table$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"

    result$ = ""

    For i = 1 To Len(paddedBinaryString$) Step 5

        fiveBits$ = Mid$(paddedBinaryString$, i, 5)

        index = Val("&B" + fiveBits$) + 1 ' Convert binary to decimal

        result$ = result$ + Mid$(base32Table$, index, 1)

    Next



    ' Step 4: Pad the result to a multiple of 8 characters with "="

    While Len(result$) Mod 8 <> 0

        result$ = result$ + "="

    Wend



    EncodeBase32$ = result$

End Function



Function DecodeBase32$ (encoded$, decoded$)

    ' Step 1: Create a Base32 table for reverse lookup

    base32Table$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"



    ' Step 2: Remove any padding characters (=)

    encoded$ = Left$(encoded$, InStr(encoded$, "=") - 1)



    ' Step 3: Convert each Base32 character back to its 5-bit binary representation

    binaryString$ = ""

    For i = 1 To Len(encoded$)

        char$ = Mid$(encoded$, i, 1)

        index = InStr(base32Table$, char$) - 1

        binaryString$ = binaryString$ + Right$("00000" + _Bin$(index), 5)

    Next



    ' Step 4: Convert every 8 bits of the binary string back to its ASCII character

    decoded$ = ""

    For i = 1 To Len(binaryString$) Step 8

        eightBits$ = Mid$(binaryString$, i, 8)

        If Len(eightBits$) = 8 Then

            asciiCode = Val("&B" + eightBits$)

            decoded$ = decoded$ + Chr$(asciiCode)

        End If

    Next

    DecodeBase32$ = decoded$

End Function

(08-21-2024, 03:47 AM)SMcNeill Wrote: QB64PE now has MD5$.  Could you use it instead?

MD5

'SHA-1 uses five initial constants:

' not sure if these are the corectvalues

Dim A As _Unsigned Long

Dim B As _Unsigned Long

Dim C As _Unsigned Long

Dim D As _Unsigned Long

Dim E As _Unsigned Long

A = &H67452301

B = &HEFCDAB89

C = &H98BADCFE

D = &H10325476

E = &HC3D2E1F0





Print SHA1("The quick brown fox jumps over the lazy dog")

'for debug copying

Open "sha1.txt" For Output As #1

Print #1, SHA1("The quick brown fox jumps over the lazy dog")

Close

End





Function PadMessage$ (message As String)

    'SHA-1 requires that the input message be padded to a length that

    'is a multiple of 512 bits (64 bytes). The padding is done in two steps:

    'Append a single '1' bit followed by '0' bits until the message is 64 bits shy of being a multiple of 512 bits.

    'Append the original length of the message as a 64-bit integer.



    Dim messageLength As _Unsigned Long

    messageLength = Len(message) * 8 ' Length in bits



    ' Append a '1' bit (0x80 in hex, or 128 in decimal)

    message = message + Chr$(128)



    ' Append '0' bits until the length is 64 bits shy of a multiple of 512

    While (Len(message) * 8) Mod 512 <> 448

        message = message + Chr$(0)

    Wend



    ' Append the original length of the message as a 64-bit big-endian integer

    Dim lengthBytes As String

    For i = 7 To 0 Step -1

        lengthBytes = lengthBytes + Chr$(ShiftRight(messageLength, i * 8) And 255)

    Next

    message = message + lengthBytes

    PadMessage$ = message

End Function



'QB64 does'nt support a shift right function SHR so here is a simple function

Function ShiftRight (value As _Unsigned Long, positions As Integer)

    ShiftRight = Int(value / (2 ^ positions))

End Function



'QB64 NO rotate left. so here is a function that shold do it.

Function RotateLeft (value As _Unsigned Long, shift As Integer)

    RotateLeft = ((value * 2 ^ shift) Or (value \ 2 ^ (32 - shift))) And &HFFFFFFFF

End Function





Sub ProcessBlock (block As String, hA As _Unsigned Long, hB As _Unsigned Long, hC As _Unsigned Long, hD As _Unsigned Long, hE As _Unsigned Long)

    Dim W(79) As _Unsigned Long

    Dim tempValue As _Unsigned Long



    ' Break the block into 16 words (32 bits each)

    For i = 0 To 15

        W(i) = CVL(Mid$(block, i * 4 + 1, 4))

    Next



    ' Expand the 16 words into 80 words

    For i = 16 To 79

        tempValue = W(i - 3) Xor W(i - 8) Xor W(i - 14) Xor W(i - 16)

        W(i) = RotateLeft(tempValue, 1)

    Next



    ' Initialize the hash value for this block

    Dim aTemp As _Unsigned Long, bTemp As _Unsigned Long, cTemp As _Unsigned Long, dTemp As _Unsigned Long, eTemp As _Unsigned Long

    aTemp = hA: bTemp = hB: cTemp = hC: dTemp = hD: eTemp = hE



    ' Main loop

    For i = 0 To 79

        Select Case i

            Case 0 To 19

                tempValue = (RotateLeft(aTemp, 5) + ((bTemp And cTemp) Or ((Not bTemp) And dTemp)) + eTemp + W(i) + &H5A827999) And &HFFFFFFFF

            Case 20 To 39

                tempValue = (RotateLeft(aTemp, 5) + (bTemp Xor cTemp Xor dTemp) + eTemp + W(i) + &H6ED9EBA1) And &HFFFFFFFF

            Case 40 To 59

                tempValue = (RotateLeft(aTemp, 5) + ((bTemp And cTemp) Or (bTemp And dTemp) Or (cTemp And dTemp)) + eTemp + W(i) + &H8F1BBCDC) And &HFFFFFFFF

            Case 60 To 79

                tempValue = (RotateLeft(aTemp, 5) + (bTemp Xor cTemp Xor dTemp) + eTemp + W(i) + &HCA62C1D6) And &HFFFFFFFF

        End Select



        eTemp = dTemp

        dTemp = cTemp

        cTemp = RotateLeft(bTemp, 30)

        bTemp = aTemp

        aTemp = tempValue

    Next



    ' Add this block's hash to the result so far:

    hA = (hA + aTemp) And &HFFFFFFFF

    hB = (hB + bTemp) And &HFFFFFFFF

    hC = (hC + cTemp) And &HFFFFFFFF

    hD = (hD + dTemp) And &HFFFFFFFF

    hE = (hE + eTemp) And &HFFFFFFFF

End Sub



Function ToHexString$ (value As _Unsigned Long)

    Dim hexStr As String

    hexStr = Hex$(value)



    ' Pad with leading zeros if necessary to ensure 8 characters

    If Len(hexStr) < 8 Then

        hexStr = String$(8 - Len(hexStr), "0") + hexStr

    End If



    ToHexString$ = hexStr

End Function





Function SHA1$ (message As String)

    ' Initialize the hash constants

    Dim hA As _Unsigned Long

    Dim hB As _Unsigned Long

    Dim hC As _Unsigned Long

    Dim hD As _Unsigned Long

    Dim hE As _Unsigned Long

    hA = &H67452301

    hB = &HEFCDAB89

    hC = &H98BADCFE

    hD = &H10325476

    hE = &HC3D2E1F0



    ' Preprocess the message (pad it)

    message = PadMessage(message)



    ' Process each 512-bit block

    Dim i As Long

    For i = 1 To Len(message) Step 64

        ProcessBlock Mid$(message, i, 64), hA, hB, hC, hD, hE

    Next



    ' Produce the final hash value (concatenate A, B, C, D, E)

    SHA1$ = Hex$(hA) + Hex$(hB) + Hex$(hC) + Hex$(hD) + Hex$(hE)

End Function

    hA = &H67452301

    hB = &HEFCDAB89

    hC = &H98BADCFE

    hD = &H10325476

    hE = &HC3D2E1F0