Computing One Time Passwords (aka Google Authenticator codes)

Set Library To LocFile("vfpencryption71.fll") Additive
? AuthenticatorCode('SECRETBASE32CODE')

Function AuthenticatorCode(tcSecret as String) as String
   Local lcKey, lcMessage, lcHash, lcTruncatedHash, lnCode, lcCode

   * Following comments contain the pseude code from Wikipedia
   * https://en.wikipedia.org/wiki/Google_Authenticator
   *
   * key := base32decode(secret)
   lcKey = Base32Decode(tcSecret)
   * message := floor(current Unix time / 30)
   lnMessage = Floor(UnixTime() / 30) && Note: UnixTime() can work beyond 19th January 2038, see below
   lcMessage = Replicate(Chr(0),4)+BinToC(lnMessage,'4S') && convert to 8 byte srtring
   * Note: This won't fail some day in 2038, but when Unixtime/30 hits the ceiling of the 32bit integer value range,
   *       which will be about 30*67 years from 1970, in 3980, if anybody is still using comnputers then.
   * hash := HMAC-SHA1(key, message)
   lcHash = HMAC(lcMessage, lcKey, 1)
   * offset := last nibble of hash
   lnOffset = Asc(Right(lcHash,1)) % 16
   * truncatedHash := hash[offset..offset+3]  //4 bytes starting at the offset
   lcTruncatedHash = SubStr(lcHash,lnOffset+1,4)
   * Set the first bit of truncatedHash to zero  //remove the most significant bit
   lnCode = BitAND(CtoBIN(lcTruncatedHash,'4S'),0x7fffffff)
   * code := truncatedHash mod 1000000
   * pad code with 0 until length of code is 6
   lcCode = PadL(lnCode % 1000000,6,'0')
   Return lcCode
EndFunc

* ..that almost 1:1 translated pseudo code was only possible
* by defining the following helper functions

Function UnixTime() as Double
   Return UTCDateTime()-Datetime(1970,1,1,0,0,0)
   * Note: since
   * a) the VFP date value range can go up to Year 9999 (GetSystemTime even up to 30827)
   * b) all numeric values are represented as double float in memory
   * In respect to integers that offers a precision of 53 bit unsigned ints. 
   * Not 64bit, but still large enough to compute the exact difference of 
   * DateTime(9999,12,31,23,59,59)-DateTime(1970,1,1) as 253402300799 seconds
   * which is a number needing 38 bits (unsigned) or 39 bits (signed) only.
EndFunc   
   
Function UTCDateTime() as DateTime
   Local lcBuffer, lcDate, lcTime
   lcBuffer = Space(16)
   =GetSystemTime(@lcBuffer)

   * typedef struct _SYSTEMTIME {
   *     WORD wYear;
   *     WORD wMonth;
   *     WORD wDayOfWeek;
   *     WORD wDay;
   *     WORD wHour;
   *     WORD wMinute;
   *     WORD wSecond;
   *     WORD wMilliseconds;
   * } SYSTEMTIME, *PSYSTEMTIME; -> 16 bytes
   lnYear   = CToBin(Substr(lcBuffer,  1, 2),'2RS')
   lnMonth  = CToBin(Substr(lcBuffer,  3, 2),'2RS')
   lnDay    = CToBin(Substr(lcBuffer,  7, 2),'2RS')
   lnHour   = CToBin(Substr(lcBuffer,  9, 2),'2RS')
   lnMinute = CToBin(Substr(lcBuffer, 11, 2),'2RS')
   lnSecond = CToBin(Substr(lcBuffer, 13, 2),'2RS')

   lcDate = Str(lnYear,4)+'-'+Padl(lnMonth,2,'0')+'-'+Padl(lnDay,2,'0')
   lcTime = Padl(lnHour,2,'0') + ':' + Padl(lnMinute,2,'0') +':' + Padl(lnSecond,2,'0')

   ltResult = Eval('{^'+lcDate + ' ' + lcTime+'}')
   Return  ltResult
EndFunc

Function GetSystemTime()
   Lparameters tcBuffer

   Declare GetSystemTime In kernel32.Dll String @cSystem16
   GetSystemTime(@tcBuffer)
EndFunc

Function Base32Decode(tcBase32Code as String) as String
   * accept lower case letters, too:
   tcBase32Code = Upper(Evl(tcBase32Code,''))

   Local lnCode, lnDecoded, lcDecoded, lnBits
   lcDecoded = ''
   lnDecoded = 0
   lnBits = 0
   * decoding iteration
   Do While !Empty(tcBase32Code)
      * care for A-Z
      lnCode = Asc(tcBase32Code)-65
      If lnCode<0 Or lnCode>25
         * care or 2-7
         lnCode = Asc(tcBase32Code)-24
      Endif
      If lnCode<0 Or lnCode>31
         Return ''
      Endif
      tcBase32Code = Substr(tcBase32Code,2)

      lnDecoded = BitLshift(lnDecoded,5)+lnCode
      lnBits = lnBits + 5
      If lnBits>=8
         * Take the highest 8 bits of the so far decoded value.
         lcDecoded = lcDecoded + Chr(BitRshift(lnDecoded,lnBits-8)%256)
         * remove some (surely) unnecessary bits to ensure
         * lnDecoded has some less dummy load of already converted bits
         lnDecoded = lnDecoded % 256
         lnBits = lnBits - 8
      Endif
   Enddo

   Return lcDecoded
EndFunc

Function Base32Encode(tcString as String) as String
   Local lnCode, lnEncoded, lcEncoded, lnBits, ln5Bits
   lcEncoded = ''
   lnEncoded = 0
   lnBits = 0
   Do While !Empty(tcString)
      lnCode = Asc(tcString)
      tcString = Substr(tcString,2)

      lnEncoded = BitLshift(lnEncoded,8)+lnCode
      lnBits = lnBits + 8
      Do While lnBits>=5
         * Take the highest 5 bits of the so far encoded value.
         ln5Bits = BitRshift(lnEncoded,lnBits-5)%32
         lcEncoded = lcEncoded + Chr(IIF(ln5Bits<26,65+ln5Bits,24+ln5Bits))
         * remove some (surely) unnecessary bits to ensure
         * lnDecoded has some less dummy load of already converted bits
         lnEncoded = lnEncoded % 128
         lnBits = lnBits - 5
      EndDo
   Enddo

   Return lcEncoded
EndFunc