EXE JOINER (source code)

[Syahrani10]

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] for kesatu:




tahap pertama bikin dulu :

1 Form

2 CommanButton

3 TextBox

3 Label


[/quote]





kira kira wujudnya seperti ini



http://s19.postimage.org/nptivws0j/Cropper_Capture_1.png
















for kedua:






double klik pada form trus hapus semua kodenya

isikan semua kode berikut








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
















for ketiga:






buat sebuah modul yang diberi nama "mdlLoader"

lalu isikan kode berikut pada modul








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
















for keempat:






buat sebuah ClassModule yang didi ber nama "clsFileBinder"

lalu isikan kode berikut


[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 !!!

</div>