Dim sStub As String
Dim sFile As String
Dim sOutput As String
Dim sKey As String
Dim sInfo As String * 100
Dim FileLen As Long
Dim FileStart As Long
Dim sBuffer As String
Dim sBuffer2 As String
Dim iFF As Integer
Public Function RC4(ByVal Expression As String, ByVal Password As String) As String
On Error Resume Next
Dim RB(0 To 255) As Integer, X As Long, Y As Long, Z As Long, Key() As Byte, ByteArray() As Byte, Temp As Byte
If Len(Password) = 0 Then
Exit Function
End If
If Len(Expression) = 0 Then
Exit Function
End If
If Len(Password) > 256 Then
Key() = StrConv(Left$(Password, 256), vbFromUnicode)
Else
Key() = StrConv(Password, vbFromUnicode)
End If
For X = 0 To 255
RB(X) = X
Next X
X = 0
Y = 0
Z = 0
For X = 0 To 255
Y = (Y + RB(X) + Key(X Mod Len(Password))) Mod 256
Temp = RB(X)
RB(X) = RB(Y)
RB(Y) = Temp
Next X
X = 0
Y = 0
Z = 0
ByteArray() = StrConv(Expression, vbFromUnicode)
For X = 0 To Len(Expression)
Y = (Y + 1) Mod 256
Z = (Z + RB(Y)) Mod 256
Temp = RB(Y)
RB(Y) = RB(Z)
RB(Z) = Temp
ByteArray(X) = ByteArray(X) Xor (RB((RB(Y) + RB(Z)) Mod 256))
Next X
RC4 = StrConv(ByteArray, vbUnicode)
End Function
Private Sub Command1_Click()
sStub = App.Path & "\Stub\Stub.exe"
sFile = txt.File.Text
sKey = "RandomString"
sOutput = App.Path & "\CryptedbySn0opY.exe"
iFF = FreeFile
Open sStub For Binary As #iFF
sBuffer = Space(LOF(iFF))
FileStart = LOF(iFF) + 1
Get #iFF, , sBuffer
Close iFF
iFF = FreeFile
Open sFile For Binary As #iFF
sBuffer2 = Space(LOF(iFF))
FileLen = LOF(iFF)
Get #iFF, , sBuffer2
sBuffer2 = ENC(sBuffer2, sKey)
Close iFF
sInfo = Str(FileStart) & "#" & Str(sFileLen) & "#" & sKey & "#"
iFF = FreeFile
Open sOutput For Binary As #iFF
Put #iFF, , sBuffer
Put #iFF, FileStart, sBuffer2
Put #iFF, LOF(iFF) + 1, sInfo
Close
MsgBox "Fertig :P !Das is ne Beta hoffentlich klappt auchnoch alles! ;)"
End Sub
Private Sub Command2_Click()
MsgBox "Coded by Sn0opY Beta 0.0000000000000001 :) "
End Sub
Private Sub Image1_Click()
End Sub
Private Sub txtFile_Change()
End Sub