VB加壳脱壳程序源码1、窗体代码Private Sub Check1_Click()Text2.SetFocusEnd SubPrivate Sub Image2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Image10.Visible = FalseEnd SubPrivate Sub Image3_Click()If Text1.Text = "" ThenMsgBox "Please Select A File First!", vbInformationElseList1.Visible = TrueList2.Visible = FalseFrame3.Visible = FalseList1.Text = " UPX 1.24 "Text2.SetFocusEnd IfEnd SubPrivate Sub Command2_Click()Dim path As String, back_path As String, file_t As String 'Dim's stringsText2.SetFocusCommonDialog1.ShowOpenText1.Text = CommonDialog1.FileNamepath = Text1.Textback_path = "Backupfile.exe"If Check1.Value = 1 Theni = FreeFileOpen path For Binary As #ifile_t = Space(LOF(i))Get #i, , file_tClose #iOpen back_path For Binary As #iPut #i, , file_tClose #iMsgBox " A Backup of the file has been created in the same location as the original file", vbInformationEnd IfEnd SubPrivate Sub Image3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Image8.Visible = TrueEnd SubPrivate Sub Image3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Image8.Visible = FalseImage3_ClickEnd SubPrivate Sub Image4_Click()If Text1.Text = "" ThenMsgBox "Please Select A File First!", vbInformationElseText2.SetFocusList2.Visible = TrueList1.Visible = FalseFrame3.Visible = FalseList2.Text = " Krypt "End IfEnd SubPrivate Sub Image4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Image9.Visible = TrueEnd SubPrivate Sub Image4_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Image9.Visible = FalseImage4_ClickEnd SubPrivate Sub Image5_Click()If Text1.Text = "" ThenMsgBox "Please Select A File First!", vbInformationElseText2.SetFocusList1.Visible = FalseList2.Visible = FalseFrame3.Visible = TrueFrame4.Visible = TrueEnd IfEnd SubPrivate Sub Image5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Image7.Visible = TrueEnd SubPrivate Sub Image5_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Image7.Visible = FalseImage5_ClickEnd SubPrivate Sub Image6_Click()Text2.SetFocusFrame3.Visible = TrueList1.Visible = FalseFrame4.Visible = FalseEnd SubPrivate Sub Command7_Click()Text2.SetFocusIf Text1.Text <> "" And Text3.Text > 0 Thenfsiz = ShowFileSize(Text1.Text)PB1.Value = 0PB1.Max = Text3.TextPB1.Visible = TrueOpen Text1.Text For Binary As #1For a = 1 To Text3.TextPut #1, fsiz - 1 + a, 0PB1.Value = aNextCloseEnd IfPB1.Visible = FalsePB1.Value = 0End SubFunction ShowFileSize(file)Dim fs, f, sSet 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'94208Private Sub exit_Click()Unload MeEnd SubPrivate Sub Form_Load()Check1.Value = FalseList1.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 SubPrivate Sub Image2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Image10.Visible = TrueIf Button = 1 ThenDim linklink = ShellExecute(hWnd, "Open", "", &O0, &O0, SW_NORMAL)End IfEnd SubPrivate Sub Image6_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Image2.Visible = TrueEnd SubPrivate Sub Image6_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Image2.Visible = FalseImage6_ClickEnd SubPrivate Sub Image7_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Image10.Visible = TrueEnd SubPrivate Sub Image7_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Image10.Visible = FalseEnd SubPrivate Sub Label5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button = 1 ThenDim linklink = ShellExecute(hWnd, "Open", "", &O0, &O0, SW_NORMAL)End IfEnd SubPrivate Sub Label9_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button = 1 ThenDim linklink = ShellExecute(hWnd, "Open", "", &O0, &O0, SW_NORMAL)End IfEnd SubPrivate Sub List1_DblClick()If List1.Text = " UPX 1.24 " ThenShell App.path & "\components\packers\upx124.exe " & Chr(34) & Text1.Text & Chr(34), vbNormalFocusEnd IfIf List1.Text = " FSG 1.33 " ThenShell App.path & "\components\packers\fsg133.EXE " & Text1.Text, vbNormalFocusEnd IfIf List1.Text = " PEPack " ThenShell App.path & "\components\packers\pepack.exe " & Chr(34) & Text1.Text & Chr(34), vbNormalFocusEnd IfIf List1.Text = " ASPack " ThenShell App.path & "\components\packers\aspack.exe " & Text3.Text, vbNormalFocusEnd IfEnd SubPrivate Sub List2_DblClick()If List2.Text = " Krypt " ThenShell App.path & "\components\protectors\client.exe ", vbNormalFocusSendKeys "{TAB}"SendKeys "{ENTER}"SendKeys Text1.TextSendKeys "{ENTER}"SendKeys "{TAB}"SendKeys "{TAB}"SendKeys "{ENTER}"SendKeys App.path & "\components\protectors\stub.exe"SendKeys "{ENTER}"End IfIf List2.Text = " UPX Scrambler 1.05 " ThenShell App.path & "\components\protectors\scramble.exe " & Chr(34) & Text1.Text & Chr(34), vbNormalFocusEnd IfIf List2.Text = " UPX Scrambler 1.06 " ThenShell App.path & "\components\protectors\scramble16.exe " & Chr(34) & Text1.Text & Chr(34), vbNormalFocusEnd IfIf List2.Text = " tElock " ThenShell App.path & "\components\protectors\telock.exe " & Chr(34) & Text1.Text & Chr(34), vbNormalFocusEnd IfEnd SubPrivate Sub open_Click()CommonDialog1.ShowOpenText1.Text = CommonDialog1.FileNameEnd SubPrivate Sub Option1_Click()Text2.SetFocusEnd SubPrivate Sub Option2_Click()Text2.SetFocusEnd Sub2、模块代码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 LongPublic Const SW_NORMAL = 1。