December 02, 2002

File Encode/Decode in VB6.0

Option Explicit

Function FileEncodeAndDecode(Inputfile As String, OutputFile As String, Passwordkey As String)
Dim Temp As Single
Dim Char As String * 1
Dim XORmask As Single
Dim Temp1 As Integer
Dim x As Variant, y As Integer, z As Integer
Dim Counter As Integer

Open Inputfile For Binary As #1
Open OutputFile For Binary As #2
For x = 1 To Len(Passwordkey)
Temp = Asc(Mid$(Passwordkey, x, 1))
For y = 1 To Temp
Temp1 = Rnd
Next y
Randomize Temp1
Next x
Counter = 0
For z = 1 To FileLen(Inputfile)
XORmask = Int(Rnd * 256)
Get 1, , Char
Char = Chr$((Asc(Char) Xor XORmask))
Put 2, , Char

Counter = Counter + 1
If Counter > Len(Passwordkey) Then
Counter = 1
End If
For x = 1 To (Asc(Mid$(Passwordkey, Counter, 1)) * 2)
Temp = Rnd
Next x
Next z
End Function

Private Sub cmd1_Click()
Dim Inputfile As String
Dim OutputFile As String
Dim Passwordkey As String
Dim M_FileObject As Object
Set M_FileObject = CreateObject("Scripting.FileSystemObject")

Inputfile = InputBox("Enter A Filename To Encode/Decode", "Enter File Name")
If Inputfile <> "" Then
If M_FileObject.FileExists(Inputfile) <> True Then
MsgBox "File Does Not Exists"
Exit Sub
End If
OutputFile = InputBox("Enter the New Filename this will become")
If M_FileObject.FileExists(Inputfile) = True Then
MsgBox "File Already Exists"
Exit Sub
End If
If Inputfile <> "" Then
Passwordkey = InputBox("Enter the Password (Key)")
If Inputfile <> "" Then
Call FileEncodeAndDecode(Inputfile, OutputFile, Passwordkey)
MsgBox "File Written To" & OutputFile
End If
End If
End If
End Sub
Private Sub Form_Load()
cmd1.Caption = "Code/Decode"
End Sub