Function IsPrime(lngNumber as double) As Boolean
Dim lngCount As Long
Dim lngSqr As Long
Dim X As Long
lngSqr = Sqr(lngNumber)
If lngNumber < 2 Then
IsPrime = False
Exit Function
End If
lngCount = 2
IsPrime = True
If lngNumber Mod lngCount = 0& Then
IsPrime = False
Exit Function
End If
lngCount = 3
For X = lngCount To lngSqr Step 2
If lngNumber Mod X = 0 Then
IsPrime = False
Exit Function
End If
Next
End Function
Function RndPrime(Min As Long, Max As Long) As Long
Dim RP As Long
LoopBig:
RP = Int((Max * Rnd) + Min)
loopSmall:
RP = RP + 1
If RP > Max Then GoTo LoopBig
If IsPrime(RP) = False Then GoTo loopSmall
If RP = 0 Or RP = 1 Then GoTo LoopBig
RndPrime = RP
End Function
Function Encrypt(m As Long) As Long
Dim n As Long
Dim PubI As Long
Dim Pub As Long
Dim ValueIndex As Long
Encrypt = ((m + PubI) * Pub) Mod n
PubI = (PubI * (ValueIndex * m + 1)) Mod n
End Function
Function Decrypt(C As Long) As Long
Dim n As Long
Dim PrvI As Long
Dim Prv As Long
Dim ValueIndex As Long
Dim D As Long
D = ((C * Prv) + PrvI) Mod n
Decrypt = D
PrvI = (PrvI * (ValueIndex * D + 1)) Mod n
ValueIndex = ValueIndex Mod n
End Function
Function EncryptBt(b As String) As String
EncryptBt = Hex(Encrypt(Asc(Mid(b, 1, 1))))
End Function
Function DecryptBt(b As String) As String
DecryptBt = Chr(Decrypt(Val("&H" + b)))
End Function
Function EncryptBk(Block As String) As String
Dim Length As Long
Dim iDX As Long
Dim EB As String
Length = Len(Block) + 1
iDX = 1
EB = ""
Do Until iDX = Length
EB = EB+ EncryptBt(Mid(Block, iDX, 1)) + " "
iDX = iDX + 1
Loop
EncryptBk = EB
End Function
Function DecryptBk(Block As String) As String
Dim temp As String
Dim iDX As Long
Dim DB As String
temp = Block
iDX = 1
DB = ""
Do Until InStr(1, temp, " ") = 0
DB = DB + DecryptBt(Mid(temp, 1, InStr(1, temp, " ")))
temp = Mid(temp, InStr(1, temp, " ") + 1, Len(temp) - InStr(1, temp, " "))
iDX = iDX + 1
Loop
DecryptBk = DB
End Function
Sub GenKey(ByVal NMin As Long, ByVal NMax As Long)
Dim n As Long
Dim PrvI As Long
Dim PubI As Long
Dim Prv As Long
Dim Pub As Long
Dim ValueIndex As Long
Dim tPub As Long
Randomize
Top:
n = Int((NMax * Rnd) + NMax)
Prv = RndPrime(1, n)
Pub = Int((n * Rnd) + 1)
tPub = Pub
Do Until Pub * Prv Mod n = 1
Pub = Pub + 1
If Pub = tPub Then GoTo Top
If Pub > n Then Pub = 1
Loop
PrvI = 1
PubI = n - PrvI
ValueIndex = 1
End Sub
Dim Shared n As Long
Dim Shared PrvI As Long
Dim Shared PubI As Long
Dim Shared Prv As Long
Dim Shared Pub As Long
Dim Shared ValueIndex As Long
Private Function IsPrime(lngNumber As Long) As Boolean
Dim lngCount As Long
Dim lngSqr As Long
Dim X As Long
lngSqr = Sqr(lngNumber)
If lngNumber < 2 Then
IsPrime = False
Exit Function
End If
lngCount = 2
IsPrime = True
If lngNumber Mod lngCount = 0& Then
IsPrime = False
Exit Function
End If
lngCount = 3
For X = lngCount To lngSqr Step 2
If lngNumber Mod X = 0 Then
IsPrime = False
Exit Function
End If
Next
End Function
Function RndPrime(Min As Long, Max As Long) As Long
Dim RP As Long
LoopBig:
RP = Int((Max * Rnd) + Min)
loopSmall:
RP = RP + 1
If RP > Max Then GoTo LoopBig
If IsPrime(RP) = False Then GoTo loopSmall
If RP = 0 Or RP = 1 Then GoTo LoopBig
RndPrime = RP
End Function
Function Encrypt(m As Long) As Long
Encrypt = ((m + PubI) * Pub) Mod n
PubI = (PubI * (ValueIndex * m + 1)) Mod n
End Function
Function Decrypt(C As Long) As Long
Dim D As Long
D = ((C * Prv) + PrvI) Mod n
Decrypt = D
PrvI = (PrvI * (ValueIndex * D + 1)) Mod n
ValueIndex = ValueIndex Mod n
End Function
Function EncryptBt(b As String) As String
EncryptBt = Hex(Encrypt(Asc(Mid(b, 1, 1))))
End Function
Function DecryptBt(b As String) As String
DecryptBt = Chr(Decrypt(Val("&H" + b)))
End Function
Sub GenKey(ByVal NMin As Long, ByVal NMax As Long)
Dim tPub As Long
Randomize
Top:
n = Int((NMax * Rnd) + NMax)
Prv = RndPrime(1, n)
Pub = Int((n * Rnd) + 1)
tPub = Pub
Do Until Pub * Prv Mod n = 1
Pub = Pub + 1
If Pub = tPub Then GoTo Top
If Pub > n Then Pub = 1
Loop
PrvI = 1
PubI = n - PrvI
ValueIndex = 1
End Sub
Function EncryptBk(Block As String) As String
Dim Length As Long
Dim iDX As Long
Dim EB As String
Length = Len(Block) + 1
iDX = 1
EB = ""
Do Until iDX = Length
EB = EB+ EncryptBt(Mid(Block, iDX, 1)) + " "
iDX = iDX + 1
Loop
EncryptBk = EB
End Function
Function DecryptBk(Block As String) As String
Dim temp As String
Dim iDX As Long
Dim DB As String
temp = Block
iDX = 1
DB = ""
Do Until InStr(1, temp, " ") = 0
DB = DB + DecryptBt(Mid(temp, 1, InStr(1, temp, " ")))
temp = Mid(temp, InStr(1, temp, " ") + 1, Len(temp) - InStr(1, temp, " "))
iDX = iDX + 1
Loop
DecryptBk = DB
End Function
'---------------------------------------------------------------------------------
GenKey(1000, 10000)
Dim s0 As String = "FreeBASIC 1.09"
Dim s1 As String
Dim s2 As String
Print s0
s1 = EncryptBk(s0)
Print s1
s2 = DecryptBk(s1)
Print s2
Sleep
Remark:
In 'GenKey()': n = Int(((NMax - Nmin) * Rnd) + NMin)
would seem more logical to me than: n = Int((NMax * Rnd) + NMax)
(otherwise, 'NMin' is never used)
About your code in first post above, you cannot replace a global variable with a local variable in every procedure where it is referenced !
Dim Shared n As Long
Dim Shared PrvI As Long
Dim Shared PubI As Long
Dim Shared Prv As Long
Dim Shared Pub As Long
Dim Shared ValueIndex As Long
Private Function IsPrime(lngNumber As Long) As Boolean
Dim lngCount As Long
Dim lngSqr As Long
Dim X As Long
lngSqr = Sqr(lngNumber)
If lngNumber < 2 Then
IsPrime = False
Exit Function
End If
lngCount = 2
IsPrime = True
If lngNumber Mod lngCount = 0& Then
IsPrime = False
Exit Function
End If
lngCount = 3
For X = lngCount To lngSqr Step 2
If lngNumber Mod X = 0 Then
IsPrime = False
Exit Function
End If
Next
End Function
Function RndPrime(Min As Long, Max As Long) As Long
Dim RP As Long
LoopBig:
RP = Int((Max * Rnd) + Min)
loopSmall:
RP = RP + 1
If RP > Max Then GoTo LoopBig
If IsPrime(RP) = False Then GoTo loopSmall
If RP = 0 Or RP = 1 Then GoTo LoopBig
RndPrime = RP
End Function
Function Encrypt(m As Long) As Long
Encrypt = ((m + PubI) * Pub) Mod n
PubI = (PubI * (ValueIndex * m + 1)) Mod n
End Function
Function Decrypt(C As Long) As Long
Dim D As Long
D = ((C * Prv) + PrvI) Mod n
Decrypt = D
PrvI = (PrvI * (ValueIndex * D + 1)) Mod n
ValueIndex = ValueIndex Mod n
End Function
Function EncryptBt(b As String) As String
EncryptBt = Hex(Encrypt(Asc(Mid(b, 1, 1))))
End Function
Function DecryptBt(b As String) As String
DecryptBt = Chr(Decrypt(Val("&H" + b)))
End Function
Sub GenKey(ByVal NMin As Long, ByVal NMax As Long)
Dim tPub As Long
Randomize
Top:
n = Int((NMax * Rnd) + NMax)
Prv = RndPrime(1, n)
Pub = Int((n * Rnd) + 1)
tPub = Pub
Do Until Pub * Prv Mod n = 1
Pub = Pub + 1
If Pub = tPub Then GoTo Top
If Pub > n Then Pub = 1
Loop
PrvI = 1
PubI = n - PrvI
ValueIndex = 1
End Sub
Function EncryptBk(Block As String) As String
Dim Length As Long
Dim iDX As Long
Dim EB As String
Length = Len(Block) + 1
iDX = 1
EB = ""
Do Until iDX = Length
EB = EB+ EncryptBt(Mid(Block, iDX, 1)) + " "
iDX = iDX + 1
Loop
EncryptBk = EB
End Function
Function DecryptBk(Block As String) As String
Dim temp As String
Dim iDX As Long
Dim DB As String
temp = Block
iDX = 1
DB = ""
Do Until InStr(1, temp, " ") = 0
DB = DB + DecryptBt(Mid(temp, 1, InStr(1, temp, " ")))
temp = Mid(temp, InStr(1, temp, " ") + 1, Len(temp) - InStr(1, temp, " "))
iDX = iDX + 1
Loop
DecryptBk = DB
End Function
'---------------------------------------------------------------------------------
GenKey(1000, 10000)
Dim s0 As String = "FreeBASIC 1.09"
Dim s1 As String
Dim s2 As String
Print s0
s1 = EncryptBk(s0)
Print s1
s2 = DecryptBk(s1)
Print s2
Sleep
Remark:
In 'GenKey()': n = Int(((NMax - Nmin) * Rnd) + NMin)
would seem more logical to me than: n = Int((NMax * Rnd) + NMax)
(otherwise, 'NMin' is never used)
About your code in first post above, you cannot replace a global variable with a local variable in every procedure where it is referenced !