CryptDoc

Private fl As Long
Private myexit As Boolean
Private zz As Long
Private ttt$
Private MyWords

Private Sub Form_Unload(Cancel As Integer)
myexit = True
DoEvents
End Sub

Private Sub Command1_Click()
'stop the program

myexit = True
End Sub

Private Sub Command3_Click()
'do the complete file with given values of R,m,and n

R = Val(TextR.Text)
m = Val(TextM.Text)
n = Val(TextN.Text)
testIT ttt$, R, m, n, True
End Sub

Private Sub Command2_Click()
'start the decryption

Dim R As Long
Dim m As Long
Dim n As Long
Dim RR As Long
Dim MM As Long
Dim NN As Long
Dim X As Long
Dim pp As Long

pp = 0
' Number of letters of ciphertext to work with

X = Val(Text3.Text)
zz = 0
RichTextBox1.Text = ""
' Words to look for in ciphertext

' GIF98 = gif files

' rogram = exe files

' and,the = text files

' well you should get the idea

MyWords = Split(Text2.Text, ",")


myexit = False

'read the encrypted file


fl = FreeFile
Open App.Path & "\test.txt" For Input As #fl

While Not EOF(fl)
Line Input #fl, tta$
'check if the file has the password hash at the start

'not that we use it, just need to know if it is there

'so we can skip it

If Left(tta$, Len("[Secret]")) = "[Secret]" Then
Line Input #fl, tta$
End If
ttt$ = ttt$ & tta$ & vbCrLf
Wend
Close #fl
fl = FreeFile

'if x = 0 then you would like to check the complete file, very slow..

If X = 0 Then X = Len(ttt$)
RR = Val(TextR.Text)
MM = Val(TextM.Text)
NN = Val(TextN.Text)

'MM and NN should be odd, but i do not check for that here....

' you would only change the rr,mm, and nn values if you found

' the text and would like to see the complete file.

If RR < 1 Then RR = 1
If MM < 1 Then MM = 1
If NN < 1 Then NN = 1

For R = RR To 65
Label1.Caption = R
Label1.Refresh
DoEvents
For m = MM To 65 Step 2
For n = NN To 65 Step 2
If myexit = True Then
Close #fl
Exit Sub
End If
testIT Left(ttt$, X), R, m, n
Next n
Next m
Next R

End Sub
Sub testIT(Txt$, ByVal R As Long, ByVal m As Long, ByVal n As Long, Optional T As Boolean = False)
Const BigNum As Long = 32768
Dim i As Long, C As Long, d As Long
Static rrr As Long
Static tts$
Dim RR As Long
RR = R

ttxt$ = Txt$

For i = 1 To Len(Txt$)
C = Asc(Mid$(Txt$, i, 1))
Select Case C
Case 48 To 57 '
d = C - 48 '
Case e' To 90 '
d = C - 53 '
Case 97 To 122 '
d = C - 59 '
Case Else
d = -1
End Select
If d >= 0 Then
R = (R * m + n) Mod BigNum
d = (R And e') Xor d '
Select Case d '
Case 0 To 9 '
C = d + 48 '
Case 10 To 37 '
C = d + 53 '
Case 38 To e' '
C = d + 59 '
End Select '
Mid$(ttxt$, i, 1) = Chr$(C)
End If
Next i

If T = False Then
' check if we can find any of the words

For i = 0 To UBound(MyWords)
If InStr(1, ttxt$, CStr(MyWords(i))) <> 0 Then
zz = zz + 1
Label2.Caption = zz
Label2.Refresh
'add the text+R+M+N to the richtextbox

RichTextBox1.Text = RichTextBox1.Text & vbCrLf & ttxt$ & ", R=" & Str(RR) & ", " & "M=" & Str(m) & ", " & "N=" & Str(n)
RichTextBox1.Refresh
End If
Next i
Else
'this is a complete file, show file.

RichTextBox1.Text = ttxt$
End If
End Sub