PSC1 Encrypt, Decrypt

New to FreeBASIC? Post your questions here.
Post Reply
gerry
Posts: 70
Joined: Oct 04, 2021 7:29

PSC1 Encrypt, Decrypt

Post by gerry »

Help me figure out how this code works?

Code: Select all

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
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: PSC1 Encrypt, Decrypt

Post by grindstone »

I'm afraid it doesn't work at all. Here it crashes with a segmentation fault.
gerry
Posts: 70
Joined: Oct 04, 2021 7:29

Re: PSC1 Encrypt, Decrypt

Post by gerry »

grindstone wrote: Jun 28, 2022 10:56 I'm afraid it doesn't work at all. Here it crashes with a segmentation fault.
Are there any solutions?
fxm
Moderator
Posts: 12107
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: PSC1 Encrypt, Decrypt

Post by fxm »

The previous version (from PSC1 Errors) corrected for syntax errors seems to give a more consistent result :

Code: Select all

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

Code: Select all

FreeBASIC 1.09
1DB4 30F0 2464 1113 1BF4 2008 2925 11E7 226C 3FEF 225A 1D9D 13F4 165A
FreeBASIC 1.09
  • 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 !
gerry
Posts: 70
Joined: Oct 04, 2021 7:29

Re: PSC1 Encrypt, Decrypt

Post by gerry »

fxm wrote: Jun 28, 2022 12:28 The previous version (from PSC1 Errors) corrected for syntax errors seems to give a more consistent result :

Code: Select all

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

Code: Select all

FreeBASIC 1.09
1DB4 30F0 2464 1113 1BF4 2008 2925 11E7 226C 3FEF 225A 1D9D 13F4 165A
FreeBASIC 1.09
  • 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 !
Thanks!!! :) +rep
Post Reply