by Craig Hillsdon (7 Submissions)
Category: Encryption
Compatability: Visual Basic 4.0 (32-bit)
Difficulty: Unknown Difficulty
Originally Published: Fri 25th August 2000
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Encrypt the entire contents of a directory (not hidden files), even encrypts the filenames. This was written in Excel97 so you'll need to pull
VBcoders
Dim mybit As String * 1
strPwd = ""
mybit = String(1, " ")
strPwda = ""
tmp1 = ""
tmp2 = ""
tmp3 = ""
tmp4 = ""
newfile = ""
'get directory
files = Application.GetOpenFilename(Title:="Select any file within target directory")
If files = False Then Exit Sub
myfile = files
Do
pos = InStr(myfile, "\")
myfile = Right$(myfile, Len(myfile) - pos)
Loop Until pos = 0
mypath = Left$(files, Len(files) - Len(myfile))
'Get password
strPwda = InputBox("Password")
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
'encode the password
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
filecount = 0
myfile = Dir(mypath & "*.*")
Do
filecount = filecount + 1
myfile = Dir
Loop Until myfile = ""
myfile = Dir(mypath & "*.*")
sofar = 1
Do
For i = 1 To Len(myfile)
c = Chr(Asc(Mid(myfile, i, 1)) Xor Asc(Left(strPwd, 1)) + 128)
newfile = newfile & c
Next i
filelength = FileLen(mypath & myfile)
Open mypath & myfile For Binary As #1
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
Application.Caption = Format((i / (filelength / 100)), "0.00") & "% Done - " & sofar & " of " & filecount
Next i
Close #1
old_name = mypath & myfile
new_name = mypath & newfile
'MsgBox new_name
Name old_name As new_name
newfile = ""
myfile = Dir
sofar = sofar + 1
Loop Until myfile = ""
Application.Caption = ""
End Sub
No comments have been posted about Encrypt the entire contents of a directory (not hidden files), even encrypts the filenames. This wa. Why not be the first to post a comment about Encrypt the entire contents of a directory (not hidden files), even encrypts the filenames. This wa.
