VB加壳脱壳程序源码

VB加壳脱壳程序源码
1、窗体代码
Private Sub Check1_Click()
Text2.SetFocus
End Sub
Private Sub Image2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Image10.Visible = False
End Sub
Private Sub Image3_Click()
If Text1.Text = "" Then
MsgBox "Please Select A File First!", vbInformation
Else
List1.Visible = True
List2.Visible = False
Frame3.Visible = False
List1.Text = " UPX 1.24 "
Text2.SetFocus
End If
End Sub
Private Sub Command2_Click()
Dim path As String, back_path As String, file_t As String 'Dim's strings
Text2.SetFocus
CommonDialog1.ShowOpen
Text1.Text = CommonDialog1.FileName
path = Text1.Text
back_path = "Backupfile.exe"
If Check1.Value = 1 Then
i = FreeFile
Open path For Binary As #i
file_t = Space(LOF(i))
Get #i, , file_t
Close #i
Open back_path For Binary As #i
Put #i, , file_t
Close #i
MsgBox " A Backup of the file has been created in the same location as the original file", vbInformation
End If
End Sub
Private Sub Image3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Image8.Visible = True
End Sub
Private Sub Image3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Image8.Visible = False
Image3_Click
End Sub
Private Sub Image4_Click()
If Text1.Text = "" Then
MsgBox "Please Select A File First!", vbInformation
Else
Text2.SetFocus
List2.Visible = True
List1.Visible = False
Frame3.Visible = False
List2.Text = " Krypt "
End If
End Sub
Private Sub Image4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Image9.Visible = True
End Sub
Private Sub Image4_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Image9.Visible = False
Image4_Click
End Sub
Private Sub Image5_Click()
If Text1.Text = "" Then
MsgBox "Please Select A File First!", vbInformation
Else
Text2.SetFocus
List1.Visible = False
List2.Visible = False
Frame3.Visible = True
Frame4.Visible = True
End If
End Sub
Private Sub Image5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Image7.Visible = True
End Sub
Private Sub Image5_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Image7.Visible = False
Image5_Click
End Sub
Private Sub Image6_Click()
Text2.SetFocus
Frame3.Visible = True
List1.Visible = False
Frame4.Visible = False
End Sub
Private Sub Command7_Click()
Text2.SetFocus
If Text1.Text <> "" And Text3.Text > 0 Then
fsiz = ShowFileSize(Text1.Text)
PB1.Value = 0
PB1.Max = Text3.Text
PB1.Visible = True
Open Text1.Text For Binary As #1
For a = 1 To Text3.Text
Put #1, fsiz - 1 + a, 0
PB1.Value = a
Next
Close
End If
PB1.Visible = False
PB1.Value = 0
End Sub
Function ShowFileSize(file)
Dim fs, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(file)
ShowFileSize = f.Size
's = UCase() & " uses " & f.Size & " bytes."
'MsgBox s, 0, "Folder Size Info"
End Function
'94208
Private Sub exit_Click()
Unload Me
End Sub
Private Sub Form_Load()
Check1.Value = False
List1.AddItem " Double Click To Pack " List1.AddItem " " List1.AddItem " UPX 1.24 " List1.AddItem " FSG 1.33 " List1.AddItem " PEPack " List1.AddItem " ASPack " List1.AddItem " PECompact " List1.AddItem " PE-Diminisher " List1.AddItem " PeX v0.99 " List2.AddItem " Double Click To Protect "
List2.AddItem " " List2.AddItem " Krypt " List2.AddItem " UPX Scrambler 1.05 "
List2.AddItem " UPX Scrambler 1.06 "
List2.AddItem " tElock "
End Sub
Private Sub Image2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Image10.Visible = True
If Button = 1 Then
Dim link
link = ShellExecute(hWnd, "Open", "", &O0, &O0, SW_NORMAL)
End If
End Sub
Private Sub Image6_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Image2.Visible = True
End Sub
Private Sub Image6_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Image2.Visible = False
Image6_Click
End Sub
Private Sub Image7_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Image10.Visible = True
End Sub
Private Sub Image7_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Image10.Visible = False
End Sub
Private Sub Label5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Dim link
link = ShellExecute(hWnd, "Open", "", &O0, &O0, SW_NORMAL)
End If
End Sub
Private Sub Label9_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Dim link
link = ShellExecute(hWnd, "Open", "", &O0, &O0, SW_NORMAL)
End If
End Sub
Private Sub List1_DblClick()
If List1.Text = " UPX 1.24 " Then
Shell App.path & "\components\packers\upx124.exe " & Chr(34) & Text1.Text & Chr(34), vbNormalFocus
End If
If List1.Text = " FSG 1.33 " Then
Shell App.path & "\components\packers\fsg133.EXE " & Text1.Text, vbNormalFocus
End If
If List1.Text = " PEPack " Then
Shell App.path & "\components\packers\pepack.exe " & Chr(34) & Text1.Text & Chr(34), vbNormalFocus
End If
If List1.Text = " ASPack " Then
Shell App.path & "\components\packers\aspack.exe " & Text3.Text, vbNormalFocus
End If
End Sub
Private Sub List2_DblClick()
If List2.Text = " Krypt " Then
Shell App.path & "\components\protectors\client.exe ", vbNormalFocus
SendKeys "{TAB}"
SendKeys "{ENTER}"
SendKeys Text1.Text
SendKeys "{ENTER}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{ENTER}"
SendKeys App.path & "\components\protectors\stub.exe"
SendKeys "{ENTER}"
End If
If List2.Text = " UPX Scrambler 1.05 " Then
Shell App.path & "\components\protectors\scramble.exe " & Chr(34) & Text1.Text & Chr(34), vbNormalFocus
End If
If List2.Text = " UPX Scrambler 1.06 " Then
Shell App.path & "\components\protectors\scramble16.exe " & Chr(34) & Text1.Text & Chr(34), vbNormalFocus
End If
If List2.Text = " tElock " Then
Shell App.path & "\components\protectors\telock.exe " & Chr(34) & Text1.Text & Chr(34), vbNormalFocus
End If
End Sub
Private Sub open_Click()
CommonDialog1.ShowOpen
Text1.Text = CommonDialog1.FileName
End Sub
Private Sub Option1_Click()
Text2.SetFocus
End Sub
Private Sub Option2_Click()
Text2.SetFocus
End Sub
2、模块代码
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Const SW_NORMAL = 1。