Advanced

Simple

Advanced

Simple

Algorithm creator(s)

Microsoft Corporation

PB author(s)

Mike Doty

Description

Create a One Time Pad (OTP) utilizing MS CryptoAPI's CSPRNG.

Note

Often called perfect encryption. Most of the code here is to get a random pad using a CSPRNG The pad can be created manually with a more limited character set.. Required PB #Include: WinCrypt.inc

Source

https://forum.powerbasic.com/forum/user-to-user-discussions/source-code/755534-otp-uncrackable-encryption

See also

n/a

Source Code

Download source code file OTP_CSPRNG.bas (Right-click -> "Save as ...")

' One-Time Pad using a CSPRNG

' Often called perfect encryption
' Most of the code here is to get a random pad using a CSPRNG
' The pad can be created manually with a more limited character set.

' Comments/suggestions:
' http://forum.powerbasic.com/forum/us...e-pad-comments


$MS_DEF_PROV = "Microsoft Base Cryptographic Provider v1.0" 'required
%PROV_RSA_FULL = 1
%FALSE=0
%CRYPT_VERIFYCONTEXT = &HF0000000???
DECLARE FUNCTION CryptAcquireContext LIB "AdvAPI32.dll" _
   ALIAS "CryptAcquireContextA" (phProv AS DWORD, szContainer AS ASCIIZ, _
    szProvider AS ASCIIZ, BYVAL dwProvType AS DWORD, BYVAL dwFlags AS DWORD) AS LONG

DECLARE FUNCTION CryptGenRandom LIB "AdvAPI32.dll" ALIAS "CryptGenRandom" _
    (BYVAL hProv AS DWORD, BYVAL dwLen AS DWORD, BYVAL pbBuffer AS BYTE PTR) _
    AS LONG

DECLARE FUNCTION CryptReleaseContext LIB "AdvAPI32.dll" _
    ALIAS "CryptReleaseContext" (BYVAL hProv AS DWORD, BYVAL dwFlags AS DWORD) _
    AS LONG

FUNCTION csprng(dwLen AS DWORD) AS STRING
  LOCAL hCrypt AS DWORD, SbUF AS STRING
    IF CryptAcquireContext (hCrypt, BYVAL 0, BYVAL 0, %PROV_RSA_FULL, 0) = %FALSE THEN
    IF CryptAcquireContext (BYVAL hCrypt, BYVAL 0, $MS_DEF_PROV, %PROV_RSA_FULL, %CRYPT_VERIFYCONTEXT) = %FALSE THEN EXIT FUNCTION
  END IF
  sBuf = STRING$(dwLen, 0)
  IF CryptGenRandom(BYVAL hCrypt, BYVAL dwLen, BYVAL STRPTR(sBuf)) = 1 THEN
    FUNCTION = sBuf
  END IF
  CryptReleaseContext(hCrypt, 0)
END FUNCTION

FUNCTION Encrypt(sInput AS STRING, sPad AS STRING) AS STRING

  LOCAL p1,p2,p3 AS BYTE PTR
  LOCAL x,thelen AS LONG
  LOCAL sEncrypt AS STRING
  IF LEN(sPad) < LEN(sInput) THEN ? "pad too short -end program" ,,FUNCNAME$:END

  thelen = LEN(sInput)
  sEncrypt=SPACE$(thelen)

  p1=STRPTR(sInput)
  p2=STRPTR(sPad)
  p3=STRPTR(sEncrypt)

  FOR x=1 TO thelen
    @p3=(@p1+@p2) MOD 256
    INCR p1
    INCR p2
    INCR p3
  NEXT
  FUNCTION = sEncrypt
END FUNCTION

FUNCTION Decrypt(sInput AS STRING, sPad AS STRING) AS STRING

  LOCAL p1,p2,p3  AS BYTE PTR
  LOCAL x,thelen,temp AS LONG
  LOCAL sDecrypt AS STRING

  thelen=LEN(sInput)
  sDecrypt= SPACE$(thelen)

  p1=STRPTR(sInput)
  p2=STRPTR(sPad)
  p3=STRPTR(sDecrypt)

  FOR x = 1 TO thelen
    temp = @p1-@p2 'temp used in case value goes under 0
    IF temp < 0 THEN temp+= 256
    @p3 = temp
    INCR p1
    INCR p2
    INCR p3
  NEXT
  DECR p3
  FUNCTION = sDecrypt
END FUNCTION

FUNCTION HexDump(sBuf AS STRING) AS STRING
  LOCAL sb AS ISTRINGBUILDERA
  sb = CLASS "STRINGBUILDERA"
  LOCAL x AS LONG, sOut AS STRING
  FOR x = 1 TO LEN(sBuf)
    sb.add  HEX$(ASC(MID$(sBuf,x,1)),2)
    sb.add  " "
  NEXT
FUNCTION = sb.string
END FUNCTION

FUNCTION PBMAIN () AS LONG
  LOCAL sinput   AS STRING
  LOCAL spad     AS STRING
  LOCAL scipher  AS STRING
  sInput = "A"
  DO
    sPad = csprng(LEN(sInput))
    scipher = encrypt(sinput ,spad)
    sInput  = INPUTBOX$("Encrypt: " + HexDump(sCipher),"  Decrypt: " + decrypt(scipher,spad),sInput)
  LOOP WHILE LEN(sInput)
END FUNCTION