' Author Eddie Jackson
' Data 3/10/2014
' Written to decode text files
On error resume next
'VARIABLES
Dim arrayKey, output
Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
'FILE TO DECODE
file1 = "text1.dat"
'UNIQUE ENCRYPTION CODE
arrayKey = ReturnKey( "encryption code ""code""" )
'DECODE FILE HERE
output = Encode( file1, "text1.txt", arrayKey )
'DELETE ENCODED FILE
objShell.Run "%comspec% /c text1.dat",0,true
''''' DO NOT EDIT BELOW THIS LINE
Function Encode( myFileIn, myFileOut, arrayCode )
Dim i, objFSO, objFileIn, objFileOut, objStreamIn
Const ForAppending = 8
Const ForReading = 1
Const ForWriting = 2
Const TristateFalse = 0
Const TristateMixed = -2
Const TristateTrue = -1
Const TristateUseDefault = -2
On Error Resume Next
If Not IsArray( arrayCode ) Then
arrayCode = Array( arrayCode )
End If
For i = 0 To UBound( arrayCode )
If Not IsNumeric( arrayCode(i) ) Then
Encode = 1032
Exit Function
End If
If arrayCode(i) < 0 Or arrayCode(i) > 255 Then
Encode = 1031
Exit Function
End If
Next
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
If objFSO.FileExists( myFileIn ) Then
Set objFileIn = objFSO.GetFile( myFileIn )
Set objStreamIn = objFileIn.OpenAsTextStream( ForReading, TriStateFalse )
Else
Encode = 53
objStreamIn.Close
Set objStreamIn = Nothing
Set objFileIn = Nothing
Set objFSO = Nothing
Exit Function
End If
If objFSO.FileExists( myFileOut ) Then
Encode = 58
objStreamIn.Close
Set objStreamIn = Nothing
Set objFileIn = Nothing
Set objFSO = Nothing
Exit Function
Else
Set objFileOut = objFSO.CreateTextFile( myFileOut, True, False )
End If
i = 0
Do Until objStreamIn.AtEndOfStream
i = ( i + 1 ) \ ( UBound( arrayCode ) + 1 )
objFileOut.Write Chr( Asc( objStreamIn.Read( 1 ) ) Xor arrayCode(i) )
Loop
objFileOut.Close
objStreamIn.Close
Set objStreamIn = Nothing
Set objFileIn = Nothing
Set objFileOut = Nothing
Set objFSO = Nothing
Encode = Err.Number
Err.Clear
On Error Goto 0
End Function
Function ReturnKey( encryptionCode )
Dim i, arrayCode( )
ReDim arrayCode( Len( encryptionCode ) - 1 )
For i = 0 To UBound( arrayCode )
arrayCode(i) = Asc( Mid( encryptionCode, i + 1, 1 ) )
Next
ReturnKey = arrayCode
End Function