2017-12-15

Navigation

Skip Navigation Links

Hash algorithms

Asymmetric Algorithms

Symmetric Cipher Algorithms

Encoding Algorithms

Compression Algorithms

Pseudo Random Number Algorithms

Steganography

Library Wrappers

String Comparison

Others

Syntax highlighting by Prism
PBCrypto.com Mirror

MS CryptoAPI - One Time Pad using a CSPRNG

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

Mirror provided by Knuth Konrad