GOST 28147-89
Algorithm creator(s)
Unknown Soviet cryptographers from KGB, 8th Department
PB author(s)
Balthasar Indermuehle
Description
GOST (its full name is Gosudarstvennyi Standard Soyuza SSR 28147-89) is a Soviet block cipher that appears to have played a role in the Soviet Union similar to that played by the U.S. Data Encryption Standard (FIPS 46).
Note
Ported to PBWin from VB source by Ásgeir Bjarni Ingvarsson
Source
https://forum.powerbasic.com/forum/user-to-user-discussions/source-code/24168-gost-encryption?t=23531
See also
n/a
Source Code
Download source code file gost.bas (Right-click -> "Save as ...")
'More information: http://www.jetico.com/index.htm#/gost.htm
' http://www.ryoohki.net/computer_books/algo/books/book10/9501M/9501M.HTM
'
'Ported to PB/Win 26.09.2002 by bi@inside.net
'From a VB source by Ásgeir Bjarni Ingvarsson
'
'Gosudarstvennyi Standard Soyuza SSR 28147-89
' (GOST 28147-89)
'
#Compile Exe
#Include "win32api.inc"
Declare Function DeHex(Inpt As String) As String
Declare Function GenKeyGOST() As String
Declare Function DeHex(Inpt As String) As String
Declare Function DeHex(Inpt As String) As String
Declare Function BigXOR(ByVal value1 As String, ByVal value2 As String) As String
Declare Function BigMod32Add(ByVal value1 As String, ByVal value2 As String) As String
Declare Function BigAdd(ByVal value1 As String, ByVal value2 As String) As String
Declare Function BigShiftLeft(value1 As String, shifts As Integer) As String
Declare Function F(R As String, k As String) As String
Declare Function EncryptGOST(ByVal Inpt As String, ByVal key As String) As String
Declare Function DecryptGOST(ByVal Inpt As String, ByVal key As String) As String
Declare Function Encrypt(ByVal Inpt As String, ByVal key As String) As String
Declare Function PadInpt(Inpt As String) As String
Global S1 As Dword Ptr
Global S2 As Dword Ptr
Global S3 As Dword Ptr
Global S4 As Dword Ptr
Global S5 As Dword Ptr
Global S6 As Dword Ptr
Global S7 As Dword Ptr
Global S8 As Dword Ptr
Sub InitGOST()
GoTo defs
AS1:
!DD &H6, &H5, &H1, &H7, &HE, &H0, &H4, &HA, &HB, &H9, &H3, &HD, &H8, &HC, &H2, &HF
AS2:
!DD &HE, &HD, &H9, &H0, &H8, &HA, &HC, &H4, &H7, &HF, &H6, &HB, &H3, &H1, &H5, &H2
AS3:
!DD &H6, &H5, &H1, &H7, &H2, &H4, &HA, &H0, &HB, &HD, &HE, &H3, &H8, &HC, &HF, &H9
AS4:
!DD &H8, &H7, &H3, &H9, &H6, &H4, &HE, &H5, &H2, &HD, &H0, &HC, &H1, &HB, &HA, &HF
AS5:
!DD &HA, &H9, &H6, &HB, &H5, &H1, &H8, &H4, &H0, &HD, &H7, &H2, &HE, &H3, &HF, &HC
AS6:
!DD &H5, &H3, &H0, &H6, &HB, &HD, &H4, &HE, &HA, &H7, &H1, &HC, &H2, &H8, &HF, &H9
AS7:
!DD &H2, &H1, &HC, &H3, &HB, &HD, &HF, &H7, &HA, &H6, &H9, &HE, &H0, &H8, &H4, &H5
AS8:
!DD &H6, &H5, &H1, &H7, &H8, &H9, &H4, &H2, &HF, &H3, &HD, &HC, &HA, &HE, &HB, &H0
defs:
S1 = CodePtr(AS1)
S2 = CodePtr(AS2)
S3 = CodePtr(AS3)
S4 = CodePtr(AS4)
S5 = CodePtr(AS5)
S6 = CodePtr(AS6)
S7 = CodePtr(AS7)
S8 = CodePtr(AS8)
End Sub
Function GenKeyGOST() As String
Dim i As Integer
Dim dat As String
Dim key As String
Randomize
For i = 1 To 32
dat = Hex$(Rnd(1,255))
If Len(dat) = 1 Then dat = "0" & dat
key = key & dat
Next i
Function = key
End Function
Function EnHex(X As String) As String
Dim i As Integer
Dim v As String
Dim inpt As String
For i = 1 To Len(X)
v = Hex$(Asc(Mid$(X, i, 1)))
If Len(v) = 1 Then v = "0" & v
Inpt = Inpt & v
Next i
EnHex = Inpt
End Function
Function DeHex(Inpt As String) As String
Dim i As Integer
Dim X As String
For i = 1 To Len(Inpt) Step 2
X = X & Chr$(Val("&H" & Mid$(Inpt, i, 2)))
Next i
DeHex = X
End Function
Function PadInpt(Inpt As String) As String
check1:
If Not (Len(Inpt) / 16) = (Len(Inpt) \ 16) Then
Inpt = Inpt & "0"
GoTo check1
End If
PadInpt = Inpt
End Function
Function BigXOR(ByVal value1 As String, ByVal value2 As String) As String
Dim valueans As String
Dim loopit As Integer, tempnum As Integer
tempnum = Len(value1) - Len(value2)
If tempnum < 0 Then
valueans = Left$(value2, Abs(tempnum))
value2 = Mid$(value2, Abs(tempnum) + 1)
ElseIf tempnum > 0 Then
valueans = Left$(value1, Abs(tempnum))
value1 = Mid$(value1, tempnum + 1)
End If
For loopit = 1 To Len(value1)
valueans = valueans + Hex$(Val("&H" + Mid$(value1, loopit, 1)) Xor Val("&H" + Mid$(value2, loopit, 1)))
Next loopit
BigXOR = Right$(valueans, 8)
End Function
Function BigMod32Add(ByVal value1 As String, ByVal value2 As String) As String
BigMod32Add = Right$(BigAdd(value1, value2), 8)
End Function
Function BigAdd(ByVal value1 As String, ByVal value2 As String) As String
Dim valueans As String
Dim loopit As Integer, tempnum As Integer
tempnum = Len(value1) - Len(value2)
If tempnum < 0 Then
value1 = Space$(Abs(tempnum)) + value1
ElseIf tempnum > 0 Then
value2 = Space$(Abs(tempnum)) + value2
End If
tempnum = 0
For loopit = Len(value1) To 1 Step -1
tempnum = tempnum + Val("&H" + Mid$(value1, loopit, 1)) + Val("&H" + Mid$(value2, loopit, 1))
valueans = Hex$(tempnum Mod 16) + valueans
tempnum = Int(tempnum / 16)
Next loopit
If tempnum <> 0 Then
valueans = Hex$(tempnum) + valueans
End If
BigAdd = Right$(valueans, 8)
End Function
Function BigShiftLeft(value1 As String, shifts As Integer) As String
Dim tempstr As String
Dim loopit As Integer, loopinner As Integer
Dim tempnum As Integer
Dim i As Integer, j As Integer
shifts = shifts Mod 32
If shifts = 0 Then
BigShiftLeft = value1
Exit Function
End If
value1 = Right$(value1, 8)
tempstr = String$(8 - Len(value1), "0") + value1
value1 = ""
' Convert to binary
For loopit = 1 To 8
tempnum = Val("&H" + Mid$(tempstr, loopit, 1))
For loopinner = 3 To 0 Step -1
If tempnum And 2 ^ loopinner Then
value1 = value1 + "1"
Else
value1 = value1 + "0"
End If
Next loopinner
Next loopit
For i = 1 To shifts
For j = 1 To 32
Mid$(value1, j, 1) = Mid$(value1, j + 1, 1)
If Not Mid$(value1, 1, 1) = "0" Then Mid$(value1, 1, 1) = "0"
Next j
Next i
tempstr = value1
' And convert back to hex
value1 = ""
For loopit = 0 To 7
tempnum = 0
For loopinner = 0 To 3
If Val(Mid$(tempstr, 4 * loopit + loopinner + 1, 1)) Then
tempnum = tempnum + 2 ^ (3 - loopinner)
End If
Next loopinner
value1 = value1 + Hex$(tempnum)
Next loopit
BigShiftLeft = Right$(value1, 8)
End Function
Function F(R As String, k As String) As String
Dim X As String
Dim A As Long, B As Long, C As Long, D As Long, E As Long, l As Long, G As Long, h As Long
X = BigMod32Add(R, k)
A = Val("&H" & Mid$(X, 1, 1))
B = Val("&H" & Mid$(X, 2, 1))
C = Val("&H" & Mid$(X, 3, 1))
D = Val("&H" & Mid$(X, 4, 1))
E = Val("&H" & Mid$(X, 5, 1))
l = Val("&H" & Mid$(X, 6, 1))
G = Val("&H" & Mid$(X, 7, 1))
h = Val("&H" & Mid$(X, 8, 1))
A = @S1[A]
B = @S2[B]
C = @S3[C]
D = @S4[D]
E = @S5[E]
l = @S6[l]
G = @S7[G]
h = @S8[h]
X = Str$(A) & Str$(B) & Str$(C) & Str$(D) & Str$(E) & Str$(l) & Str$(G) & Str$(h)
X = BigShiftLeft(X, 11)
F = X
End Function
Function Encrypt(ByVal Inpt As String, ByVal key As String) As String
Dim k(1 To 8) As String
Dim l As String
Dim R As String
Dim j As Integer, i As Integer
k(1) = Mid$(key, 1, 8)
k(2) = Mid$(key, 8, 8)
k(3) = Mid$(key, 16, 8)
k(4) = Mid$(key, 24, 8)
k(5) = Mid$(key, 32, 8)
k(6) = Mid$(key, 40, 8)
k(7) = Mid$(key, 48, 8)
k(8) = Mid$(key, 56, 8)
For j = 1 To Len(Inpt) Step 16
l = Mid$(Inpt, j, 8)
R = Mid$(Inpt, j + 8, 8)
For i = 1 To 3
R = BigXOR(R, F(l, k(1)))
l = BigXOR(l, F(R, k(2)))
R = BigXOR(R, F(l, k(3)))
l = BigXOR(l, F(R, k(4)))
R = BigXOR(R, F(l, k(5)))
l = BigXOR(l, F(R, k(6)))
R = BigXOR(R, F(l, k(7)))
l = BigXOR(l, F(R, k(8)))
Next i
R = BigXOR(R, F(l, k(8)))
l = BigXOR(l, F(R, k(7)))
R = BigXOR(R, F(l, k(6)))
l = BigXOR(l, F(R, k(5)))
R = BigXOR(R, F(l, k(4)))
l = BigXOR(l, F(R, k(3)))
R = BigXOR(R, F(l, k(2)))
l = BigXOR(l, F(R, k(1)))
Mid$(Inpt, j, 8) = R
Mid$(Inpt, j + 8, 8) = l
Next j
Encrypt = Inpt
End Function
Function EncryptGOST(ByVal Inpt As String, ByVal key As String) As String
Dim InptHex As String
InptHex = PadInpt(EnHex(Inpt))
EncryptGOST = Encrypt(InptHex, key)
End Function
Function DecryptGOST(ByVal Inpt As String, ByVal key As String) As String
Dim k(1 To 8) As String
Dim l As String
Dim R As String
Dim j As Integer, i As Integer
k(1) = Mid$(key, 1, 8)
k(2) = Mid$(key, 8, 8)
k(3) = Mid$(key, 16, 8)
k(4) = Mid$(key, 24, 8)
k(5) = Mid$(key, 32, 8)
k(6) = Mid$(key, 40, 8)
k(7) = Mid$(key, 48, 8)
k(8) = Mid$(key, 56, 8)
For j = 1 To Len(Inpt) Step 16
l = Mid$(Inpt, j, 8)
R = Mid$(Inpt, j + 8, 8)
R = BigXOR(R, F(l, k(1)))
l = BigXOR(l, F(R, k(2)))
R = BigXOR(R, F(l, k(3)))
l = BigXOR(l, F(R, k(4)))
R = BigXOR(R, F(l, k(5)))
l = BigXOR(l, F(R, k(6)))
R = BigXOR(R, F(l, k(7)))
l = BigXOR(l, F(R, k(8)))
For i = 1 To 3
R = BigXOR(R, F(l, k(8)))
l = BigXOR(l, F(R, k(7)))
R = BigXOR(R, F(l, k(6)))
l = BigXOR(l, F(R, k(5)))
R = BigXOR(R, F(l, k(4)))
l = BigXOR(l, F(R, k(3)))
R = BigXOR(R, F(l, k(2)))
l = BigXOR(l, F(R, k(1)))
Next i
Mid$(Inpt, j, 8) = R
Mid$(Inpt, j + 8, 8) = l
Next j
DecryptGOST = Inpt
End Function
Function PbMain
Dim key As String
Dim x As String
Dim L As String
Dim inpt As String
Dim inpt2 As String
Dim outmsg As String
InitGOST
inpt = "This string to be encrypted."
key = GenKeyGOST
x = PadInpt(EnHex(inpt))
L = Encrypt(x, key)
outmsg = "This string: " + inpt + $CrLf + "with this key: " + key + $CrLf + "results in this crypt string: " + L
inpt2 = DecryptGOST(L, key)
x = DeHex(inpt2)
outmsg = outmsg + $CrLf + "decrypts to: " + x
MsgBox outmsg, %MB_OK, "GOST for PB"
End Function