form2.frm

VB做的内存补丁模板,可以制作出自己的内存补丁风格,类似KEYMAKE的功能

VERSION 5.00
Begin VB.Form FrmMain 
   BorderStyle     =   0  'None
   ClientHeight    =   1320
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4005
   Icon            =   "Form2.frx":0000
   LinkTopic       =   "Form2"
   Picture         =   "Form2.frx":030A
   ScaleHeight     =   1320
   ScaleWidth      =   4005
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Command1 
      Caption         =   "Patch"
      Height          =   375
      Left            =   3720
      TabIndex        =   0
      Top             =   120
      Visible         =   0   'False
      Width           =   1695
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1200
      Left            =   1920
      Top             =   480
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "www.viranti.cn"
      BeginProperty Font 
         Name            =   "Comic Sans MS"
         Size            =   11.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000E&
      Height          =   315
      Left            =   2160
      TabIndex        =   1
      Top             =   960
      Width           =   1575
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim RunPath As String '运行路径
Private Sub Command1_Click()
On Error GoTo n1:

Dim addr As Long '修补的内存地址
Dim FileName As String '程序标题

Dim RTN As Long



FileName = "无标题 - 记事本" '进程中的名字
Me.Caption = FileName & " 内存补丁"
lngHwnd = FindWindow(0&, FileName) '寻找窗口

If lngHwnd = 0 Then
RTN = SetWindowPos(Me.hWND, -2, 0, 0, 0, 0, 3)
Me.Hide
MsgBox "请检查  《 " & FileName & " 》  是否运行或本程序是否放在了 " & RunPath & " 的目录？", vbCritical, "错误提示"
End
End If

GetWindowThreadProcessId lngHwnd, pId

pHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0, pId)



RTN = SetWindowPos(Me.hWND, -2, 0, 0, 0, 0, 3)
addr = &H4050B2   '补丁地址

If ReadMem(addr) = &H74 Then '检测是否为修补的地方
WriteMem addr, &H90 '打补丁
Else
MsgBox "程序版本有错误!"
End
End If




Call SetWindowPos(lngHwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

End


n1:

RTN = SetWindowPos(Me.hWND, -2, 0, 0, 0, 0, 3)
Me.Hide
errno = Err.Number
If errno = 53 Then
MsgBox "文件 《 " & RunPath & " 》未找到", vbCritical, "错误提示"
Else
MsgBox Err.Description
End If


End
End Sub

Private Sub Form_Load()
If App.PrevInstance Then  '如果程序重复运行就退出
End
End If
Dim RTN As Long
RTN = SetWindowPos(Me.hWND, -1, 0, 0, 0, 0, 3)
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()

RunPath = "notepad.exe" '需要修补的程序的路径
'延长时间---------
ShellFile RunPath
For i = 1 To 2000
DoEvents    '释放控制权
'-----------------
Next
Call Command1_Click
Me.Hide
Timer1.Enabled = False


End Sub