Tuesday, April 7, 2009

Qbasic 4.5 - Encrypt/Decrypt File

'Encrypt

Dim r(1000) As Integer
Dim rev As String
Dim mik As String
Dim laba As Integer
file$ = txtfile.Text
Open file$ For Input As #1
laba = Len(file$)
file2$ = Mid(file$, 1, laba - 3) + "rev"
While Not EOF(1)
kim$ = ";" + " gzeus"
Input #1, k$
If k$ = kim$ Then
Close #1
Exit Sub
Else
Close #1
Open file$ For Input As #1
Open file2$ For Output As #2
Print #2, kim$
For X = 1 To 10
Randomize Timer
r(X) = Int(Rnd * 75) + 50
Print #2, r(X)
Next X
While Not EOF(1)
Line Input #1, j$
je$ = ""
For z = 1 To Len(j$)
m = 1000000000
mik = Mid(j$, z, 1)
m = Asc(mik)
If m = 1000000000 Then GoTo 1
q = q + 1
If q = 11 Then q = 1
m = m + r(q) - 48
If m > 999999999 Then m = m - 999999999
mik = Chr$(m)
1 je$ = je$ + mik
Next z
Print #2, je$
Wend
Close #1
Close #2
Open file2$ For Input As #1
Open file$ For Output As #2
Line Input #1, j$
Print #2, j$
While Not EOF(1)
Line Input #1, j$
rev = ""
For c = 1 To Len(j$)
rev = rev + Left$(Right$(j$, c), 1)
Next
Print #2, rev
Wend
Close #1
Close #2
Kill file2$
Exit Sub
End If
Wend

'Decrypt

Dim r(1000) As Integer
Dim rev As String
Dim mik As String
Dim lent As String
file$ = txtfile.Text
Open file$ For Input As #1
lent = Len(file$)
file2$ = UCase$(Mid$(file$, 1, lent - 3)) + "rev"
While Not EOF(1)
kim$ = ";" + " gzeus"
Input #1, k$
If k$ = kim$ Then
Close #1
Open file$ For Input As #1
Open file2$ For Output As #2
Line Input #1, j$
Print #2, j$
While Not EOF(1)
Line Input #1, j$
rev = ""
For c = Len(j$) To 1 Step -1
rev = rev + Right$(Left$(j$, c), 1)
Next
Print #2, rev
Wend
Close #1
Close #2
Open file2$ For Input As #1
Open file$ For Output As #2
Input #1, j$
For X = 1 To 10
Input #1, r(X)
Next X

While Not EOF(1)
Line Input #1, j$
je$ = ""
For z = 1 To Len(j$)
m = 1000000000
mik = Mid$(j$, z, 1)
m = Asc(mik)
If m = 1000000000 Then GoTo 2
q = q + 1
If q = 11 Then q = 1
m = m - r(q) + 48
If m > 999999999 Then m = m - 999999999
mik = Chr$(m)
2 je$ = je$ + mik
Next z
Print #2, je$
Wend
Close #1
Close #2
Kill file2$
Exit Sub
Else
Close #1
Exit Sub
End If
Wend

No comments:

Post a Comment

Followers