2017-10-20

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

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

Mirror provided by Knuth Konrad