
24th October 2012
|
 |
Ceriwiser
|
|
Join Date: Oct 2012
Posts: 914
Rep Power: 14
|
|
EXE JOINER (source code)
maaf nih gan sebelumnya
waktu ane bikin thread " kaskus exe joiner" banyak yang PM minta source code exe joiner
jadi ane bikin thread ini
Keterangan :
exe joiner adalah tool untuk menggabungkan dua file exe menjadi satu
[/spoiler]
Spoiler for open this:
for kesatu:
tahap pertama bikin dulu :
1 Form
2 CommanButton
3 TextBox
3 Label
[/quote]
Quote:
kira kira wujudnya seperti ini
Spoiler for open this:
Quote:
Option Explicit
Dim MyFBF As New clsFileBinder
Private Sub cmdClose_Click()
End
End Sub
Private Sub cmdCompile_Click()
On Error Resume Next
MyFBF.FileToProperty txtEXE1, "EXE1"
MyFBF.FileToProperty txtEXE2, "EXE2"
FileCopy App.Path & "\Loader.exe", txtTarget
MyFBF.SavePackage txtTarget
MsgBox "Done! Click OK to test the file.", vbInformation
Shell txtTarget, vbNormalFocus
End
End Sub
Spoiler for open this:
Quote:
Option Explicit
Dim MyFBF As New clsFileBinder
Sub Main()
On Error Resume Next
MyFBF.OpenPackage IIf(Right(App.Path, "1") = "\", App.Path & App.EXEName & ".exe", _
App.Path & "\" & App.EXEName & ".exe")
MyFBF.PropertyToFile "EXE1", "c:\Windows\temp\exe1.exe"
MyFBF.PropertyToFile "EXE2", "c:\Windows\Temp\exe2.exe"
Shell "c:\Windows\Temp\exe1.exe", vbNormalFocus
Shell "c:\Windows\Temp\exe2.exe", vbNormalFocus
End
End Sub
Spoiler for open this:
[quote]
Option Explicit
Public MyFBF As New PropertyBag
Public Contents As Variant
Public Function ReadProperty(ByVal PropertyName As String) As Variant
On Error Resume Next
ReadProperty = MyFBF.ReadProperty(PropertyName)
End Function
Public Sub WriteProperty(ByVal PropertyName As String, ByVal PropertyValue$)
On Error Resume Next
MyFBF.WriteProperty PropertyName, PropertyValue$
End Sub
Public Function FileToProperty(ByVal FileName As String, ByVal PropertyName As String) As Boolean
On Error GoTo FBF_Err
Dim CurrentLine$, Full$
DoEvents
Open FileName For Binary As #1
Full$ = String(LOF(1), Chr(0))
Get #1, , Full$
Close #1
MyFBF.WriteProperty PropertyName, Full$
FileToProperty = True
Exit Function
FBF_Err:
FileToProperty = False
End Function
Public Function PropertyToFile(ByVal PropertyName As String, ByVal FileName As String) As Boolean
Dim Contents$
Contents$ = Me.ReadProperty(PropertyName)
On Error GoTo FBF_Err
Open FileName For Binary As #1
Put #1, , Contents$
Close #1
PropertyToFile = True
Exit Function
FBF_Err:
PropertyToFile = False
End Function
Public Function SavePackage(ToFile As String) As Boolean
Dim Temp As Variant
Temp = MyFBF.Contents
Dim Writing_Position As Long
On Error GoTo FBF_Err
Open ToFile For Binary Access Write As #1
Writing_Position = LOF(1)
If LOF(1) = 0 Then GoTo EmptyFile
Seek #1, LOF(1)
EmptyFile:
Put #1, , Temp
Put #1, , Writing_Position
Close #1
SavePackage = True
Exit Function
FBF_Err:
SavePackage = False
End Function
Public Function OpenPackage(ByVal FileBinderFile As String) As Boolean
Dim Extracted_Bag As New PropertyBag
Dim Reading_Position As Long
Dim Temp As Variant
Dim RealContents() As Byte
On Error GoTo FBF_Err
Open FileBinderFile For Binary Access Read As #1
Get #1, LOF(1) - 3, Reading_Position
Seek #1, Reading_Position
Get #1, , Temp
RealContents = Temp
Extracted_Bag.Contents = RealContents
MyFBF.Contents = Extracted_Bag.Contents
Close #1
OpenPackage = True
Exit Function
FBF_Err:
OpenPackage = False
End Function
[spoiler=open this] for kelima:
Tinggal compile ke exe
beresss !!!!!
kalo ada yg ga ngerti silahkan tanya !!!
|