[Amin_Mansouri]

با سورس زیر میتونید نگ اسکرین ویژوال بیسیک 6 رو حذف کنید در واقع عمل پج کردن رو روی فایل اعمال میکند , این سورس بدرد کسانی میخوره که دوست دارن پچ بنویسن برای برنامه مورد نظر

یه سری توضیحات از زبان نویسنده

Used tools.

- W32Dasm 8.93 (Disassembler/Debugger)
- Hex Edit (to check if patch working)
- My Universal Patch Engine (to fix the patch)
- Visual Basic 6.0 (to compile my Universal Patch Engine and to remove nag ;-))


Actions.

First disassembe VB6.EXE with W32Dasm and load the process in the debug mode.
[Auto Step Over] until the nag-screen appears and toggle a breakpoint on the Call
istruction. Repeat the [Auto Step Over] until debugger stops over the breakpoint.
[Step Into] the Call and [Step Over] until the nag appears. Find the Call that
shows *ONLY* the nag (Call 00465A11). It is 10 bytes long and we must sobstitute
it with other 10 bytes. We use 5 NOP (No-Operation [&H90] 2 bytes long) instruction.
Open Hex Edit and go to Call offset (&H65A11) and put here 5 NOP; save VB6.EXE and
test if it working. The nag doesn't appear!
Now modify my Universal Patch Engine with VB6.EXE information, size, offset to patch
and compile it.

Const EXEFileName = "VB6.exe"
Const OriginalSize = 1880064
Const StartOffset = &H65A11
Const EndOffset = &H65A15

سورس کد :

کد:

'-----------------------------------------------'
'          **************************           '
'          * Universal Patch Engine *           '
'          **************************           '
' written by Rocky [a.k.a. Sangaletti Federico] '
'-----------------------------------------------'

Private Declare Function CharLower Lib "user32" Alias "CharLowerA" (ByVal lpsz As String) As String

'This constants need for patching
'----------------------------------------------------
Const EXEFileName = "VB6.exe" 'Name of file to patch
Const OriginalSize = 1880064  'Size of file
Const StartOffset = &H65A11   'First offset to patch
Const EndOffset = &H65A15     'Last offset to patch
'----------------------------------------------------

Dim BytesExtra As String

Private Sub Command1_Click()
   Label1.Caption = "Searching for EXE..."
   Bar 50 'Show the progress bar (only for fun ;-))
   If SearchFile = False Then
      'If file to patch doesn't exist exit
      MsgBox "Unable to find " & EXEFileName & "!", vbCritical
      Picture2.Cls
      Label1.Caption = "Ready to patch..."
      Exit Sub
   End If
   Label1.Caption = "Checking file size..."
   Bar 50 'Show the progress bar (only for fun ;-))
   If CheckSize = False Then
      'If size of file to patch is different, probably
      'it's a different version and the patch can't work
      MsgBox "Wrong file version (" & BytesExtra & ")", vbCritical
      Picture2.Cls
      Label1.Caption = "Ready to patch..."
      Exit Sub
   End If
   Label1.Caption = "Checking if already patched..."
   Bar 50 'Show the progress bar (only for fun ;-))
   If CheckAlreadyCracked = True Then
      'If file is already patched exit
      MsgBox "Already patched!", vbCritical
      Picture2.Cls
      Label1.Caption = "Ready to patch..."
      Exit Sub
   End If
   Label1.Caption = "Patching..."
   Bar 150 'Show the progress bar (only for fun ;-))
   If Crack = False Then
      'If there is an error during patching routine exit
      MsgBox "Patching error!" & vbCrLf & vbCrLf & Err.Description, vbCritical
      Picture2.Cls
      Label1.Caption = "Ready to patch..."
      Exit Sub
   End If
   Label1.Caption = "Patched complete!"
   'If patch have success show the message and show how many
   'bytes was changed
   MsgBox "Patched successfully!" & vbCrLf & vbCrLf & (EndOffset - StartOffset) + 1 & " bytes changed", vbExclamation
End Sub

Private Sub Bar(n As Long)
'Increasing progress bar

   Picture2.Cls
   i = Picture2.Width / n
   For n = 0 To n
      Picture2.Line (1, Picture2.Height)-(a, 1), 255, BF
      a = a + i
      DoEvents
      Delay
   Next n
End Sub
Private Sub Delay()
'Wait for a small time

   tm = Timer
   Do While Timer < tm + 0.01
      DoEvents
   Loop
End Sub

Private Function SearchFile() As Boolean
'This function check if file to patch exist

   If CharLower(Dir(EXEFileName)) = CharLower(EXEFileName) Then
      SearchFile = True
   Else
      SearchFile = False
   End If
End Function

Private Function CheckSize() As Boolean
'This function check the size of the original file

   If FileLen(EXEFileName) = OriginalSize Then
      CheckSize = True
   Else
      CheckSize = False
      If FileLen(EXEFileName) - OriginalSize > 0 Then
         BytesExtra = CStr(FileLen(EXEFileName) - OriginalSize) & " extra bytes"
      Else
         BytesExtra = CStr(Abs(FileLen(EXEFileName) - OriginalSize)) & " less bytes"
      End If
   End If
End Function

Private Function CheckAlreadyCracked() As Boolean
'This function chech if file is already patched

   Dim Buffer() As Byte
   Open EXEFileName For Binary As #1
      ReDim Buffer(LOF(1) - 1)
      Get #1, , Buffer
   Close #1
   If Buffer(StartOffset) = &H90 Then
      CheckAlreadyCracked = True
   Else
      CheckAlreadyCracked = False
   End If
   Erase Buffer
End Function

Private Function Crack() As Boolean
'This function put the original file in a byte array,
'modify the bytes to change and write the array over
'the original file

   On Error GoTo WARNING
  
   Dim Buffer() As Byte
   Open EXEFileName For Binary As #1
      ReDim Buffer(LOF(1) - 1)
      Get #1, , Buffer
   Close #1
   For i = StartOffset To EndOffset
      Buffer(i) = &H90
   Next i
   Open EXEFileName For Binary As #1
      Put #1, , Buffer
   Close #1
   Erase Buffer
   Crack = True
   Exit Function
  
WARNING:
   Crack = False
End Function

بدرود