by Craig Hillsdon (7 Submissions)
Category: Encryption
Compatability: Visual Basic 4.0 (32-bit)
Difficulty: Unknown Difficulty
Originally Published: Sun 9th January 2000
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
File encryption procedure.
VBcoders
'// Call cipher(filename, password)
'// Used on its own, the procedure will both encrypt and decrypt.
'// Use in conjunction with your own bit rotation and/or compression routines to
'// increase security.
'// This is not that fast, so best to use it only for small files (250k max) although
'// it will encrypt anysize file.
'// If anyone knows how to speed encryption up, please let me in on it.
'// Also, if anyone knows how to implement the fibinachi sequence without the numbers
'// getting so big that VB crashes, please let me in on that too.
'// [email protected] - http://members.tripod.co.uk/chillsdon
Private Sub cipher(filespec As String, strPwda As String)
Dim mybit As String * 1
Dim strPwd As String
Dim tmp1 As String, tmp2 As String, tmp3 As String, tmp4 As String
'// initialize variables
mybit = String(1, " ")
strPwd = ""
tmp1 = ""
tmp2 = ""
tmp3 = ""
tmp4 = ""
'// make password bigger and a little psuedo random
'// e.g. "password" becomes "PASSWORDpAsSwOrDpasswordPaSsWoRd"
tmp1 = UCase(strPwda)
tmp2 = LCase(strPwda)
For z = 1 To Len(strPwda)
If z Mod 2 = 0 Then
k = UCase(Mid(strPwda, z, 1))
j = LCase(Mid(strPwda, z, 1))
Else
k = LCase(Mid(strPwda, z, 1))
j = UCase(Mid(strPwda, z, 1))
End If
tmp3 = tmp3 & k
tmp4 = tmp4 & j
Next z
strPwda = tmp1 & tmp3 & tmp2 & tmp4
'// encrypt the password with itself
For i = 1 To Len(strPwda)
strPwd = strPwd & Chr(Asc(Mid(strPwda, i, 1)) Xor Asc(Mid(strPwda, (i Mod Len(strPwda)) + 1, 1)) And &HFF)
Next i
filelength = FileLen(filespec)
Open filespec For Binary As #1
'// encrypt file with encrypted password
For i = 1 To filelength
Get #1, i, mybit
mybit = Chr(Asc(mybit) Xor Asc(Mid(strPwd, (i Mod Len(strPwd)) + 1, 1)) And &HFF)
Put #1, i, mybit
'// percent_done equals just that, attach it to a progress bar
percent_done = Format((i / (filelength / 100)), "0.00")
Next i
Close #1
End Sub
