• Home
 · 
• Encryption
 · 
• Encrypt the entire contents of a directory (not hidden files), even encrypts the filenames. This wa

Encrypt the entire contents of a directory (not hidden files), even encrypts the filenames. This wa

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

Rate Encrypt the entire contents of a directory (not hidden files), even encrypts the filenames. This wa

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

    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