Attribute VB_Name = "basModExp"
Option Explicit
Option Base 0
' A VB6/VBA procedure to carry out modular exponentiation
' with examples of RSA encryption and Diffie-Hellman key exchange
' First published 23 September 2005.
' mpFromHex modified 13 October 2007.
' mpModExp fixed "0" issue 4 February 2009.
' Updated 16 March 2021 - changed license on this code to Apache-2.0.
' Added ElGamal Encryption by Frank Qin.
' ******************************* LICENSE ***********************************
' * Copyright (C) 2005-21 David Ireland, DI Management Services Pty Limited.
' * <www.di-mgt.com.au> <www.cryptosys.net>
' * Licensed under the Apache License, Version 2.0 (the "License");
' * you may not use this file except in compliance with the License.
' * You may obtain a copy of the License at
' * <http://www.apache.org/licenses/LICENSE-2.0>
' ***************************************************************************
' Comments and bug reports to https://di-mgt.com.au/contact.html
'
' USAGE:
' Example: strResult = mpModExp("3c", "03", "face")
' computes (0x3c)^3 mod 0xface = 0x5b56
' or, in decimal, 60^3 mod 64206 = 23382
' Parameters may be hex strings of any length subject to limitations
' of VB and your computer. May take a long time!
' *********
' * TESTS *
' *********
Public Function Test_mpModExp()
Dim strResult As String
strResult = mpModExp("3c", "03", "face")
Debug.Print strResult & " (expected 5b56)"
strResult = mpModExp("beef", "03", "1000000000000") ' beef^3 = beef cubed = OXO?
Debug.Print strResult & " (expected 6A35DDD3C9CF)"
strResult = mpModExp("beef", "03", "10000")
Debug.Print strResult & " (expected C9CF)"
' Do a mini-RSA encryption with 32-bit key:
' Public key (n, e) = (0x5518f65d, 0x11)
' Private key d = 0x2309cd31
' Message m = 0x35b9a3cb
' Encrypt c = m^e mod n = 35b9a3cb^11 mod 5518f65d = 528C41E5
' Decrypt m' = c^e mod n = 528C41E5^2309cd31 mod 5518f65d = 35B9A3CB
strResult = mpModExp("35b9a3cb", "11", "5518f65d")
Debug.Print strResult & " (expected 528C41E5)"
strResult = mpModExp("528C41E5", "2309cd31", "5518f65d")
Debug.Print strResult & " (expected 35B9A3CB)"
End Function
Public Function Test_RSA508()
' An example of an RSA calculation using mpModExp from
' "Some Examples of the PKCS Standards",
' An RSA Laboratories Technical Note,
' Burton S. Kaliski Jr., November 1, 1993.
' RSA key is 508 bits long.
' WARNING: this may take some time!
Dim strMod As String
Dim strExp As String
Dim strPri As String
Dim strMsg As String
Dim strSig As String
Dim strOK As String
Dim strVer As String
strMod = "0A66791DC6988168" & _
"DE7AB77419BB7FB0" & _
"C001C62710270075" & _
"142942E19A8D8C51" & _
"D053B3E3782A1DE5" & _
"DC5AF4EBE9946817" & _
"0114A1DFE67CDC9A" & _
"9AF55D655620BBAB"
strExp = "010001"
strPri = "0123C5B61BA36EDB" & _
"1D3679904199A89E" & _
"A80C09B9122E1400" & _
"C09ADCF7784676D0" & _
"1D23356A7D44D6BD" & _
"8BD50E94BFC723FA" & _
"87D8862B75177691" & _
"C11D757692DF8881"
strMsg = "1FFFFFFFFFFFF" & _
"FFFFFFFFFFFFFFFF" & _
"FFFFFFFFFFFFFFFF" & _
"FFFFFFFFFF003020" & _
"300C06082A864886" & _
"F70D020205000410" & _
"DCA9ECF1C15C1BD2" & _
"66AFF9C8799365CD"
strOK = "6DB36CB18D3475B" & _
"9C01DB3C78952808" & _
"0279BBAEFF2B7D55" & _
"8ED6615987C85186" & _
"3F8A6C2CFFBC89C3" & _
"F75A18D96B127C71" & _
"7D54D0D8048DA8A0" & _
"544626D17A2A8FBE"
' Sign, i.e. Encrypt with private key, s = m^d mod n
Debug.Print "Calculating signature (be patient)..."
strSig = mpModExp(strMsg, strPri, strMod)
Debug.Print strSig
If strSig = strOK Then
Debug.Print "Hooray! Signature matches."
Else
Debug.Print "BOO! Signature was wrong."
End If
' Verify, i.e. Decrypt with public key m' = s^e mod n
Debug.Print "Calculating verification (be patient)..."
strVer = mpModExp(strSig, strExp, strMod)
Debug.Print strVer
If strVer = strMsg Then
Debug.Print "Hooray! Verification was OK."
Else
Debug.Print "BOO! Verification failed."
End If
End Function
Public Function Test_Diffie_Hellman()
' A very simple example of Diffie-Hellman key exchange.
' CAUTION: Practical use requires numbers of 1000-2000+ bits in length
' and other checks on suitability of p and g.
' EXPLANATION OF SIMPLE DIFFIE-HELLMAN
' 1. Both parties agree to select and share a public generator, say, g = 3
' and public prime modulus p = 0xc773218c737ec8ee993b4f2ded30f48edace915f
' 2. Alice selects private key x = 0x849dbd59069bff80cf30d052b74beeefc285b46f
' 3. Alice's public key is Ya = g^x mod p. Alice sends this to Bob.
' 4. To send a concealed, shared secret key to Alice, Bob picks a secret random number
' say, y = 0x40a2cf7390f76c1f2eef39c33eb61fb11811d528
' 5. Bob computes Yb = g^y mod p and sends this to Alice.
' 6. Bob can computes the shared key k = Ya^y mod p,
' to use for further communications with Alice
' 7. Alice can compute the same shared key k = Yb^x mod p,
' to use for further communications with Bob.
' Note: k = Ya^y = (g^x)^y = g^(xy) = Yb^x = (g^y)^x = g^(xy) mod p
' An eavesdropper only sees g, p, Ya and Yb.
' It is easy to compute Y=g^x mod p but it is
' difficult to compute x given g^x mod p.
' This is the discrete logarithm problem.
Dim Ya As String
Dim Yb As String
Dim Ka As String
Dim Kb As String
' Alice computes Ya = g^x mod p
Ya = mpModExp("3", "849dbd59069bff80cf30d052b74beeefc285b46f", "c773218c737ec8ee993b4f2ded30f48edace915f")
Debug.Print "Ya = " & Ya
' Bob computes Yb = g^y mod p
Yb = mpModExp("3", "40a2cf7390f76c1f2eef39c33eb61fb11811d528", "c773218c737ec8ee993b4f2ded30f48edace915f")
Debug.Print "Yb = " & Yb
' Alice computes the secret key k = Yb^x mod p
Ka = mpModExp(Yb, "849dbd59069bff80cf30d052b74beeefc285b46f", "c773218c737ec8ee993b4f2ded30f48edace915f")
Debug.Print "Ka = " & Ka
' Bob computes the secret key k = Ya^y mod p
Kb = mpModExp(Ya, "40a2cf7390f76c1f2eef39c33eb61fb11811d528", "c773218c737ec8ee993b4f2ded30f48edace915f")
Debug.Print "Kb = " & Kb
If Ka <> Kb Then
Debug.Print "ERROR: keys do not match!"
Else
Debug.Print "Keys match OK."
End If
End Function
' *********************
' * EXPORTED FUNCTION *
' *********************
Public Function mpModExp(strBaseHex As String, strExponentHex As String, strModulusHex As String) As String
' Computes b^e mod m given input (b, e, m) in hex format.
' Returns result as a hex string with all leading zeroes removed.
' Store numbers as byte arrays with
' least-significant byte in x[len-1]
' and most-significant byte in x[1]
' x[0] is initially zero and is used for overflow
Dim abBase() As Byte
Dim abExponent() As Byte
Dim abModulus() As Byte
Dim abResult() As Byte
Dim nLen As Integer
Dim n As Integer
' Convert hex strings to arrays of bytes
abBase = mpFromHex(strBaseHex)
abExponent = mpFromHex(strExponentHex)
abModulus = mpFromHex(strModulusHex)
' We require all byte arrays to be the same length
' with the first byte left as zero
nLen = UBound(abModulus) + 1
n = UBound(abExponent) + 1
If n > nLen Then nLen = n
n = UBound(abBase) + 1
If n > nLen Then nLen = n
Call FixArrayDim(abModulus, nLen)
Call FixArrayDim(abExponent, nLen)
Call FixArrayDim(abBase, nLen)
'''Debug.Print "b=" & mpToHex(abBase)
'''Debug.Print "e=" & mpToHex(abExponent)
'''Debug.Print "m=" & mpToHex(abModulus)
' Do the business
abResult = aModExp(abBase, abExponent, abModulus, nLen)
' Convert result to hex
mpModExp = mpToHex(abResult)
'''Debug.Print "r=" & mpModExp
' Strip leading zeroes
For n = 1 To Len(mpModExp)
If Mid$(mpModExp, n, 1) <> "0" Then
Exit For
End If
Next
' FIX: [2009-02-04] Changed from >= to >
If n > Len(mpModExp) Then
' Answer is zero
mpModExp = "0"
ElseIf n > 1 Then
' Zeroes to strip
mpModExp = Mid$(mpModExp, n)
End If
End Function
' **********************
' * INTERNAL FUNCTIONS *
' **********************
Public Function aModExp(abBase() As Byte, abExponent() As Byte, abModulus() As Byte, nLen As Integer) As Variant
' Computes a = b^e mod m and returns the result in a byte array as a VARIANT
Dim a() As Byte
Dim e() As Byte
Dim s() As Byte
Dim nBits As Long
' Perform right-to-left binary exponentiation
' 1. Set A = 1, S = b
ReDim a(nLen - 1)
a(nLen - 1) = 1
' NB s and e are trashed so use copies
s = abBase
e = abExponent
' 2. While e != 0 do:
For nBits = nLen * 8 To 1 Step -1
' 2.1 if e is odd then A = A*S mod m
If (e(nLen - 1) And &H1) <> 0 Then
a = aModMult(a, s, abModulus, nLen)
End If
' 2.2 e = e / 2
Call DivideByTwo(e)
' 2.3 if e != 0 then S = S*S mod m
If aIsZero(e, nLen) Then Exit For
s = aModMult(s, s, abModulus, nLen)
DoEvents
Next
' 3. Return(A)
aModExp = a
End Function
Private Function aModMult(abX() As Byte, abY() As Byte, abMod() As Byte, nLen As Integer) As Variant
' Returns w = (x * y) mod m
Dim w() As Byte
Dim x() As Byte
Dim y() As Byte
Dim nBits As Integer
' 1. Set w = 0, and temps x = abX, y = abY
ReDim w(nLen - 1)
x = abX
y = abY
' 2. From LS bit to MS bit of X do:
For nBits = nLen * 8 To 1 Step -1
' 2.1 if x is odd then w = (w + y) mod m
If (x(nLen - 1) And &H1) <> 0 Then
Call aModAdd(w, y, abMod, nLen)
End If
' 2.2 x = x / 2
Call DivideByTwo(x)
' 2.3 if x != 0 then y = (y + y) mod m
If aIsZero(x, nLen) Then Exit For
Call aModAdd(y, y, abMod, nLen)
Next
aModMult = w
End Function
Private Function aIsZero(a() As Byte, ByVal nLen As Integer) As Boolean
' Returns true if a is zero
aIsZero = True
Do While nLen > 0
If a(nLen - 1) <> 0 Then
aIsZero = False
Exit Do
End If
nLen = nLen - 1
Loop
End Function
Private Sub aModAdd(a() As Byte, b() As Byte, m() As Byte, nLen As Integer)
' Computes a = (a + b) mod m
Dim i As Integer
Dim d As Long
' 1. Add a = a + b
d = 0
For i = nLen - 1 To 0 Step -1
d = CLng(a(i)) + CLng(b(i)) + d
a(i) = CByte(d And &HFF)
d = d \ &H100
Next
' 2. If a > m then a = a - m
For i = 0 To nLen - 2
If a(i) <> m(i) Then
Exit For
End If
Next
If a(i) >= m(i) Then
Call aSubtract(a, m, nLen)
End If
' 3. Return a in-situ
End Sub
Private Sub aSubtract(a() As Byte, b() As Byte, nLen As Integer)
' Computes a = a - b
Dim i As Integer
Dim borrow As Long
Dim d As Long ' NB d is signed
borrow = 0
For i = nLen - 1 To 0 Step -1
d = CLng(a(i)) - CLng(b(i)) - borrow
If d < 0 Then
d = d + &H100
borrow = 1
Else
borrow = 0
End If
a(i) = CByte(d And &HFF)
Next
End Sub
Private Sub DivideByTwo(ByRef x() As Byte)
' Divides multiple-precision integer x by 2 by shifting to right by one bit
Dim d As Long
Dim i As Integer
d = 0
For i = 0 To UBound(x)
d = d Or x(i)
x(i) = CByte((d \ 2) And &HFF)
If (d And &H1) Then
d = &H100
Else
d = 0
End If
Next
End Sub
Public Function mpToHex(abNum() As Byte) As String
' Returns a string containg the mp number abNum encoded in hex
' with leading zeroes trimmed.
Dim i As Integer
Dim sHex As String
sHex = ""
For i = 0 To UBound(abNum)
If abNum(i) < &H10 Then
sHex = sHex & "0" & Hex(abNum(i))
Else
sHex = sHex & Hex(abNum(i))
End If
Next
mpToHex = sHex
End Function
Public Function mpFromHex(ByVal strHex As String) As Variant
' Converts number encoded in hex in big-endian order to a multi-precision integer
' Returns an array of bytes as a VARIANT
' containing number in big-endian order
' but with the first byte always zero
' strHex must only contain valid hex digits [0-9A-Fa-f]
' [2007-10-13] Changed direct >= <= comparisons with strings.
Dim abData() As Byte
Dim ib As Long
Dim ic As Long
Dim ch As String
Dim nch As Long
Dim nLen As Long
Dim t As Long
Dim v As Long
Dim j As Integer
' Cope with odd # of digits, e.g. "fed" => "0fed"
If Len(strHex) Mod 2 > 0 Then
strHex = "0" & strHex
End If
nLen = Len(strHex) \ 2 + 1
ReDim abData(nLen - 1)
ib = 1
j = 0
For ic = 1 To Len(strHex)
ch = Mid$(strHex, ic, 1)
nch = Asc(ch)
''If ch >= "0" And ch <= "9" Then
If nch >= &H30 And nch <= &H39 Then
''t = Asc(ch) - Asc("0")
t = nch - &H30
''ElseIf ch >= "a" And ch <= "f" Then
ElseIf nch >= &H61 And nch <= &H66 Then
''t = Asc(ch) - Asc("a") + 10
t = nch - &H61 + 10
''ElseIf ch >= "A" And ch <= "F" Then
ElseIf nch >= &H41 And nch <= &H46 Then
''t = Asc(ch) - Asc("A") + 10
t = nch - &H41 + 10
Else
' Invalid digit
' Flag error?
Debug.Print "ERROR: Invalid Hex character found!"
Exit Function
End If
' Store byte value on every alternate digit
If j = 0 Then
' v = t << 8
v = t * &H10
j = 1
Else
' b[i] = (v | t) & 0xff
abData(ib) = CByte((v Or t) And &HFF)
ib = ib + 1
j = 0
End If
Next
mpFromHex = abData
End Function
Private Sub FixArrayDim(ByRef abData() As Byte, ByVal nLen As Long)
' Redim abData to be nLen bytes long with existing contents
' aligned at the RHS of the extended array
Dim oLen As Long
Dim i As Long
oLen = UBound(abData) + 1
If oLen > nLen Then
' Truncate
ReDim Preserve abData(nLen - 1)
ElseIf oLen < nLen Then
' Shift right
ReDim Preserve abData(nLen - 1)
For i = oLen - 1 To 0 Step -1
abData(i + nLen - oLen) = abData(i)
Next
For i = 0 To nLen - oLen - 1
abData(i) = 0
Next
End If
End Sub
Public Function TestConvFromHex()
Dim abData() As Byte
abData = mpFromHex("deadbeef")
Debug.Print mpToHex(abData)
abData = mpFromHex("FfeE01")
Debug.Print mpToHex(abData)
abData = mpFromHex("1")
Debug.Print mpToHex(abData)
End Function
'*********************************************************************************************
'* ElGamal Encryption *
'* *
'* For detailed information please see *
'* https://di-mgt.com.au/public-key-crypto-discrete-logs-3-elgamal.html *
'* *
'* Key genaration: *
'* B = g^b mod p *
'* *
'* Encryption: *
'* c1 = g^k mod p *
'* c2 = m*B^k mod p *
'* --> c2 = (B^k mod p)*m mode p *
'* *
'* Decryption: *
'* m = c1^(p-b-1) * c2 mod p *
'* --> m = (c1^(p-b-1) mod p) * c2 mod p *
'* *
'* Programmed/modified By Frank Qin, Mar 9, 2021, Canada *
'*********************************************************************************************
Public Function fElGamal_c2(strMsgHex As String, strBobPublicKeyHex As String, strRandomNum As String, strModulusHex As String) As String
'c2 = m*B^k mod p
'--> c2 = (B^k mod p)*m mode p
Dim abMsg() As Byte
Dim abBobPublicKey() As Byte
Dim abRandomNum() As Byte
Dim abModulus() As Byte
Dim abResult() As Byte
Dim nLen As Integer
' Convert hex strings to arrays of bytes
abMsg = mpFromHex(strMsgHex)
abBobPublicKey = mpFromHex(strBobPublicKeyHex)
abRandomNum = mpFromHex(strRandomNum)
abModulus = mpFromHex(strModulusHex)
' We require all byte arrays to be the same length
' with the first byte left as zero
nLen = UBound(abModulus) + 1
If UBound(abMsg) + 1 > nLen Then nLen = UBound(abMsg) + 1
If UBound(abBobPublicKey) + 1 > nLen Then nLen = UBound(abBobPublicKey) + 1
If UBound(abRandomNum) + 1 > nLen Then nLen = UBound(abRandomNum) + 1
Call FixArrayDim(abMsg, nLen)
Call FixArrayDim(abBobPublicKey, nLen)
Call FixArrayDim(abRandomNum, nLen)
Call FixArrayDim(abModulus, nLen)
'Debug.Print "m=" & mpToHex(abMsg)
'Debug.Print "B=" & mpToHex(abBobPublicKey)
'Debug.Print "k=" & mpToHex(abRandomNum)
'Debug.Print "p=" & mpToHex(abModulus)
' Do the business
'c2 = m*B^k mod p
'--> c2 = (B^k mod p)*m mode p
'Public Function aModExp(abBase() As Byte, abExponent() As Byte, abModulus() As Byte, nLen As Integer) As Variant
' Computes a = b^e mod m and returns the result in a byte array as a VARIANT
abResult = aModExp(abBobPublicKey, abRandomNum, abModulus, nLen)
'Private Function aModMult(abX() As Byte, abY() As Byte, abMod() As Byte, nLen As Integer) As Variant
' Returns w = (x * y) mod m
abResult = aModMult(abResult, abMsg, abModulus, nLen)
' Convert result to hex
fElGamal_c2 = mpToHex(abResult)
'Debug.Print "c2=" & fElGamal_c2
Dim n As Long
' Strip leading zeroes
For n = 1 To Len(fElGamal_c2)
If Mid$(fElGamal_c2, n, 1) <> "0" Then
Exit For
End If
Next
' FIX: [2009-02-04] Changed from >= to >
If n > Len(fElGamal_c2) Then
' Answer is zero
fElGamal_c2 = "0"
ElseIf n > 1 Then
' Zeroes to strip
fElGamal_c2 = Mid$(fElGamal_c2, n)
End If
End Function
Public Function fElGamal_m(strC1Hex As String, strC2Hex As String, strBobPrivateKeyHex As String, strModulusHex As String) As String
'm = c1^(p-b-1) * c2 mod p
'--> m = (c1^(p-b-1) mod p) * c2 mod p
Dim abC1() As Byte
Dim abC2() As Byte
Dim abOne() As Byte
Dim abBobPrivateKey() As Byte
Dim abModulus() As Byte
Dim abResult() As Byte
Dim nLen As Integer
' Convert hex strings to arrays of bytes
abC1 = mpFromHex(strC1Hex)
abC2 = mpFromHex(strC2Hex)
abOne = mpFromHex("1")
abBobPrivateKey = mpFromHex(strBobPrivateKeyHex)
abModulus = mpFromHex(strModulusHex)
' We require all byte arrays to be the same length
' with the first byte left as zero
nLen = UBound(abModulus) + 1
If UBound(abC1) + 1 > nLen Then nLen = UBound(abC1) + 1
If UBound(abC2) + 1 > nLen Then nLen = UBound(abC2) + 1
If UBound(abOne) + 1 > nLen Then nLen = UBound(abOne) + 1
If UBound(abBobPrivateKey) + 1 > nLen Then nLen = UBound(abBobPrivateKey) + 1
Call FixArrayDim(abC1, nLen)
Call FixArrayDim(abC2, nLen)
Call FixArrayDim(abOne, nLen)
Call FixArrayDim(abBobPrivateKey, nLen)
Call FixArrayDim(abModulus, nLen)
'Debug.Print "c1=" & mpToHex(abC1)
'Debug.Print "c2=" & mpToHex(abC2)
'Debug.Print "1=" & mpToHex(abOne)
'Debug.Print "b=" & mpToHex(abBobPrivateKey)
'Debug.Print "p=" & mpToHex(abModulus)
' Do the business
'm = c1^(p-b-1) * c2 mod p
'--> m = (c1^(p-b-1) mod p) * c2 mod p
'Private Sub aSubtract(a() As Byte, b() As Byte, nLen As Integer)
' Computes a = a - b
abResult = abModulus
aSubtract abResult, abBobPrivateKey, nLen
aSubtract abResult, abOne, nLen
'Public Function aModExp(abBase() As Byte, abExponent() As Byte, abModulus() As Byte, nLen As Integer) As Variant
' Computes a = b^e mod m and returns the result in a byte array as a VARIANT
abResult = aModExp(abC1, abResult, abModulus, nLen)
'Private Function aModMult(abX() As Byte, abY() As Byte, abMod() As Byte, nLen As Integer) As Variant
' Returns w = (x * y) mod m
abResult = aModMult(abResult, abC2, abModulus, nLen)
' Convert result to hex
fElGamal_m = mpToHex(abResult)
'Debug.Print "m=" & fElGamal_m
Dim n As Long
' Strip leading zeroes
For n = 1 To Len(fElGamal_m)
If Mid$(fElGamal_m, n, 1) <> "0" Then
Exit For
End If
Next
' FIX: [2009-02-04] Changed from >= to >
If n > Len(fElGamal_m) Then
' Answer is zero
fElGamal_m = "0"
ElseIf n > 1 Then
' Zeroes to strip
fElGamal_m = Mid$(fElGamal_m, n)
End If
End Function
Public Function fStringToBaseHex(sMessage As String) As String
'Turn a string into HEX using ASCII code
Dim i As Long
Dim ascii As Integer
Dim sOutput As String
sOutput = ""
For i = 1 To Len(sMessage)
ascii = Asc(Mid(sMessage, i, 1))
sOutput = sOutput & Hex(ascii)
Next
fStringToBaseHex = sOutput
End Function
Public Function fBaseHexToString(sHex As String) As String
'Turn a HEX string into readable string using ASCII code
Dim i As Integer
Dim ascii As Integer
Dim sOutput As String
sOutput = ""
For i = 1 To Len(sHex) Step 2
ascii = CLng("&h" & (Mid(sHex, i, 2)))
sOutput = sOutput & Chr(ascii)
Next
fBaseHexToString = sOutput
End Function
Public Function fDecToHex(sHex As String) As String
'Conver Dec string to Hex string
Dim i As Integer
Dim iMod As Integer
Dim sMod As String
Dim sOutput As String
sOutput = ""
Do While Len(sHex) > 0
DividedBy16 sHex, iMod
Select Case iMod
Case 0, 1, 2, 3, 4, 5, 6, 7, 8, 9
sMod = CStr(iMod)
Case 10
sMod = "a"
Case 11
sMod = "b"
Case 12
sMod = "c"
Case 13
sMod = "d"
Case 14
sMod = "e"
Case 15
sMod = "f"
End Select
sOutput = sOutput & sMod
Loop
fDecToHex = ""
For i = Len(sOutput) To 1 Step -1
fDecToHex = fDecToHex & Mid(sOutput, i, 1)
Next
End Function
Private Sub DividedBy16(ByRef strDec As String, ByRef iMod As Integer)
'Divided by 16, save result and mod
Dim sOutput As String
Dim i As Integer
Dim sNum As String
sOutput = ""
sNum = ""
For i = 1 To Len(strDec)
sNum = sNum & Mid(strDec, i, 1)
If CInt(sNum) >= 16 Then
sOutput = sOutput & Int(CInt(sNum) / 16)
sNum = CInt(sNum) Mod 16
Else
sOutput = sOutput & "0"
End If
Next
iMod = CInt(sNum)
For i = 1 To Len(sOutput)
If Mid(sOutput, i, 1) <> "0" Then Exit For
Next
strDec = Mid(sOutput, i)
End Sub
Public Sub ElGamalEncryptionTest1()
Dim sMsg As String
Dim sPublicKey As String
Dim sPrivateKey As String
Dim sElGamal_c1 As String
Dim sElGamal_c2 As String
Dim sElGamal_g As String
Dim sElGamal_k As String
Dim sElGamal_p As String
Dim sElGamal_m As String
sElGamal_p = "11b" '283 Prime number: a number greater than 1, and have only two factors, 1 and the number itself
'for more prime numbers please see:
'https://en.wikipedia.org/wiki/List_of_prime_numbers
'sElGamal_p = "3d7" '983
'sElGamal_p = "c34f" '49999
'sElGamal_p = "dee3" '57059
'sElGamal_p = fDecToHex("2147483647")
sElGamal_g = "3c" '60
sElGamal_k = "24" '36
'Note: Message in Hex (as a Big number) cannot be greater than sElGamal_p
sMsg = "65" '101
Debug.Print "Message to encrypt: " & sMsg & "(" & CLng("&h" & sMsg) & ")"
sPrivateKey = "7"
Debug.Print "Private key: " & sPrivateKey & "(" & CLng("&h" & sPrivateKey) & ")"
'B = g^b mod p
sPublicKey = mpModExp(sElGamal_g, sPrivateKey, sElGamal_p)
Debug.Print "Public key: " & sPublicKey & "(" & CLng("&h" & sPublicKey) & ")"
'c1=g^k mod p
sElGamal_c1 = mpModExp(sElGamal_g, sElGamal_k, sElGamal_p)
Debug.Print "c1: " & sElGamal_c1 & "(" & CLng("&h" & sElGamal_c1) & ")"
'c2=m*B^k mod p
'Public Function fElGamal_c2(strMsgHex As String, strBobPublicKeyHex As String, strRandomNum As String, strModulusHex As String) As String
sElGamal_c2 = fElGamal_c2(sMsg, sPublicKey, sElGamal_k, sElGamal_p)
Debug.Print "c2: " & sElGamal_c2 & "(" & CLng("&h" & sElGamal_c2) & ")"
'm = c1^(p-b-1) * c2 mod p
'Public Function fElGamal_m(strC1Hex As String, strC2Hex As String, strBobPrivateKeyHex As String, strModulusHex As String) As String
sElGamal_m = fElGamal_m(sElGamal_c1, sElGamal_c2, sPrivateKey, sElGamal_p)
Debug.Print "Message decrypted: " & sElGamal_m & "(" & CLng("&h" & sElGamal_m) & ")"
End Sub
Public Sub ElGamalEncryptionTest2()
Dim sMsg As String
Dim sPublicKey As String
Dim sPrivateKey As String
Dim sElGamal_c1 As String
Dim sElGamal_c2 As String
Dim sElGamal_g As String
Dim sElGamal_k As String
Dim sElGamal_p As String
Dim sElGamal_m As String
'sElGamal_p = "c773218c737ec8ee993b4f2ded30f48edace915f" ' Prime number: a number greater than 1, and have only two factors, 1 and the number itself
'for more prime numbers please see:
'https://en.wikipedia.org/wiki/List_of_prime_numbers
'sElGamal_p = fDecToHex("14693679385278593849609206715278070972733319459651094018859396328480215743184089660644531")
sElGamal_p = fDecToHex("85053461164796801949539541639542805770666392330682673302530819774105141531698707146930307290253537320447270457")
sElGamal_g = "3"
sElGamal_k = CStr(Int(100 * Rnd())) 'A random number
'Note: Message in Hex (as a Big number) cannot be greater than sElGamal_p
sMsg = fStringToBaseHex("Hello, world.")
'Dim str As String
'str = SHA256("Marry had a little lamb")
'sPrivateKey = mpModExp(sElGamal_g, str, sElGamal_p)
sPrivateKey = "6130293313D5BD81BF2D89323B2C2D686584494B"
Debug.Print ("Private key: " & sPrivateKey)
'B = g^b mod p
sPublicKey = mpModExp(sElGamal_g, sPrivateKey, sElGamal_p)
'"A041D00C4C7705A2CBE8472B1E96B2052BB1FB65"
Debug.Print ("Public key: " & sPublicKey)
'c1=g^k mod p
sElGamal_c1 = mpModExp(sElGamal_g, sElGamal_k, sElGamal_p)
Debug.Print "c1: " & sElGamal_c1
'c2=m*B^k mod p
'Public Function fElGamal_c2(strMsgHex As String, strBobPublicKeyHex As String, strRandomNum As String, strModulusHex As String) As String
sElGamal_c2 = fElGamal_c2(sMsg, sPublicKey, sElGamal_k, sElGamal_p)
Debug.Print "c2: " & sElGamal_c2
'm = c1^(p-b-1) * c2 mod p
'Public Function fElGamal_m(strC1Hex As String, strC2Hex As String, strBobPrivateKeyHex As String, strModulusHex As String) As String
sElGamal_m = fElGamal_m(sElGamal_c1, sElGamal_c2, sPrivateKey, sElGamal_p)
Debug.Print "Message decrypted: " & fBaseHexToString(sElGamal_m)
End Sub
'*************END OF ELGAMAL ENCRYPTION CODE***************