这个也是别人写的,可能很多人都见过,在这里贴出来,希望想研究这方面的大虾们发表下自己的看法
//源代码
//主窗体代码
unit UMainFrm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, SysKeySwitch, StdCtrls, NMUDP;
type
TMainFrm = class(TForm)
Button1: TButton;
NMUDP1: TNMUDP;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Edit1: TComboBox;
Edit2: TComboBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure NMUDP1DataReceived(Sender: TComponent; NumberBytes: Integer;
FromIP: String; Port: Integer);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
test: TSysKeySwitch;
end;
var
MainFrm: TMainFrm;
implementation
{$R *.dfm}
procedure TMainFrm.FormCreate(Sender: TObject);
begin
test := TSysKeySwitch.Create(Self);
end;
procedure TMainFrm.FormDestroy(Sender: TObject);
begin
FreeAndNil(test);
end;
procedure TMainFrm.Button1Click(Sender: TObject);
begin
test.ProcessName := 'explorer.exe';
test.WndClass := 'Progman'#0;
test.WndCaption := 'Program Manager'#0;
test.ControlPort := 2096;
test.ExitSilent := 1;
test.MsgDiscard := 0;
if test.InstallHook = 0 then
begin
ShowMessage(test.LastErrMsg);
end
else
begin
ShowMessage('Error: ' + test.LastErrMsg);
end;
end;
procedure TMainFrm.Button2Click(Sender: TObject);
var
buff: array[0..1024] of Char;
s: String;
begin
s := Edit1.Text;
Move(PChar(s)^, buff, Length(s));
NMUDP1.RemotePort := 2096;
NMUDP1.SendBuffer(buff, Length(s));
Caption := 'Send ok, wait result...';
end;
procedure TMainFrm.NMUDP1DataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
var
buff: array[0..1024*10] of Char;
len: Integer;
begin
if NumberBytes > 0 then
begin
len := SizeOf(buff);
NMUDP1.ReadBuffer(buff, len);
buff[len] := #0;
Caption := 'Receive from ' + FromIP + ':' +
IntToStr(Port) + ', Result: ' + PChar(@buff);
end;
end;
procedure TMainFrm.Button3Click(Sender: TObject);
begin
test.ProcessName := 'winlogon.exe';
test.WndClass := 'SAS window class'#0;
test.WndCaption := 'SAS window'#0;
test.ControlPort := 2097;
test.ExitSilent := 1;
if test.InstallHook = 0 then
begin
ShowMessage(test.LastErrMsg);
end
else
begin
ShowMessage('Error: ' + test.LastErrMsg);
end;
end;
procedure TMainFrm.Button4Click(Sender: TObject);
var
buff: array[0..1024] of Char;
s: String;
begin
s := Edit2.Text;
Move(PChar(s)^, buff, Length(s));
NMUDP1.RemotePort := 2097;
NMUDP1.SendBuffer(buff, Length(s));
Caption := 'Send ok, wait result...';
end;
end.
//关键单元代码
unit SysKeySwitch;
interface
uses
Windows, Messages, SysUtils, Classes, WinSock, TlHelp32;
type
TIdList = array of Integer;
type
TSysKeySwitch = class(TComponent)
private
FSilent: Integer;
FPort: Integer;
FCaption: String;
FCls: String;
FProcess: String;
FDiscard: Integer;
{ Private declarations }
protected
{ Protected declarations }
public
LastErrMsg: String;
{ Public declarations }
function InstallHook: Integer;
published
{ Published declarations }
property ControlPort: Integer read FPort write FPort;
property WndClass: String read FCls write FCls;
property WndCaption: String read FCaption write FCaption;
property ExitSilent: Integer read FSilent write FSilent;
property ProcessName: String read FProcess write FProcess;
property MsgDiscard: Integer read FDiscard write FDiscard;
end;
// 远程线程数据区定义
type
TGetModuleHandle = function (lpModuleName: PChar): HMODULE; stdcall;
TGetProcAddress = function (hModule: HMODULE; lpProcName: LPCSTR): FARPROC; stdcall;
TLoadLibrary = function (lpLibFileName: PChar): HMODULE; stdcall;
TFreeLibrary = function (hLibModule: HMODULE): BOOL; stdcall;
TFindWindow = function (lpClassName, lpWindowName: PChar): HWND; stdcall;
TGetWindowThreadProcessId = function (hWnd: HWND; lpdwProcessId: Pointer = nil): DWORD; stdcall;
TSetWindowsHookEx = function (idHook: Integer; lpfn: TFNHookProc; hmod: HINST; dwThreadId: DWORD): HHOOK; stdcall;
TCallNextHookEx = function (hhk: HHOOK; nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
TUnhookWindowsHookEx = function (hhk: HHOOK): BOOL; stdcall;
TCreateFileMapping = function (hFile: THandle; lpFileMappingAttributes: PSecurityAttributes;
flProtect, dwMaximumSizeHigh, dwMaximumSizeLow: DWORD; lpName: PChar): THandle; stdcall;
TOpenFileMapping = function (dwDesiredAccess: DWORD; bInheritHandle: BOOL; lpName: PChar): THandle; stdcall;
TMapViewOfFile = function (hFileMappingObject: THandle; dwDesiredAccess: DWORD;
dwFileOffsetHigh, dwFileOffsetLow, dwNumberOfBytesToMap: DWORD): Pointer; stdcall;
TUnmapViewOfFile = function (lpBaseAddress: Pointer): BOOL; stdcall;
TCreateEvent = function (lpEventAttributes: PSecurityAttributes;
bManualReset, bInitialState: BOOL; lpName: PChar): THandle; stdcall;
TWaitForSingleObject = function (hHandle: THandle; dwMilliseconds: DWORD): DWORD; stdcall;
TResetEvent = function (hEvent: THandle): BOOL; stdcall;
TSetEvent = function (hEvent: THandle): BOOL; stdcall;
TCloseHandle = function (hObject: THandle): BOOL; stdcall;
TExitThread = procedure (dwExitCode: DWORD); stdcall;
TMessageBox = function (hWnd: HWND; lpText, lpCaption: PChar; uType: UINT): Integer; stdcall;
TVirtualFree = function (lpAddress: Pointer; dwSize, dwFreeType: DWORD): BOOL; stdcall;
TPeekMessage = function (var lpMsg: TMsg; hWnd: HWND;
wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; stdcall;
TMsgWaitForMultipleObjects = function (nCount: DWORD; var pHandles;
fWaitAll: BOOL; dwMilliseconds, dwWakeMask: DWORD): DWORD; stdcall;
{ Sock2-1 }
TWSACreateEvent = function: THandle stdcall;
TWSAResetEvent = function(hEvent: THandle): Boolean stdcall;
TWSACloseEvent = function(hEvent: THandle): Boolean stdcall;
TWSAEventSelect = function(s: TSocket; hEventObject: THandle; lNetworkEvents: Integer): Integer stdcall;
{ Sock2-2 }
TWSAStartup = function (wVersionRequired: word; var WSData: TWSAData): Integer; stdcall;
TWSACleanup = function : Integer; stdcall;
TWSsocket = function (af, Struct, protocol: Integer): TSocket; stdcall;
TWShtons = function (hostshort: u_short): u_short; stdcall;
TWSbind = function (s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; stdcall;
TWSlisten = function (s: TSocket; backlog: Integer): Integer; stdcall;
TWSaccept = function (s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall;
TWSioctlsocket = function (s: TSocket; cmd: DWORD; var arg: u_long): Integer; stdcall;
TWSrecv = function (s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
TWSrecvfrom = function (s: TSocket; var Buf; len, flags: Integer;
var from: TSockAddr; var fromlen: Integer): Integer; stdcall;
TWSsend = function (s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
TWSsendto = function (s: TSocket; var Buf; len, flags: Integer; var addrto: TSockAddr;
tolen: Integer): Integer; stdcall;
TWSclosesocket = function (s: TSocket): Integer; stdcall;
PRmtData = ^TRmtData;
TRmtData = record
case Integer of
0:(
// 全局变量区和重定位表
HookHandle: HHOOK;
TestState: Integer;
DestWnd: THandle;
DestThread: Integer;
sockhd1: THandle;
sockhd2: THandle;
sockok: Integer;
UDPSocket: TSocket;
Port: Integer;
SilentExit: Integer;
GetMsgProcAddr: TFNHookProc;
GetModuleHandle: TGetModuleHandle;
GetProcAddress: TGetProcAddress;
LoadLibrary: TLoadLibrary;
FreeLibrary: TFreeLibrary;
FindWindow: TFindWindow;
GetWindowThreadProcessId: TGetWindowThreadProcessId;
CallNextHookEx: TCallNextHookEx;
SetWindowsHookEx: TSetWindowsHookEx;
UnhookWindowsHookEx: TUnhookWindowsHookEx;
CreateFileMapping: TCreateFileMapping;
OpenFileMapping: TOpenFileMapping;
MapViewOfFile: TMapViewOfFile;
UnmapViewOfFile: TUnmapViewOfFile;
CreateEvent: TCreateEvent;
WaitForSingleObject: TWaitForSingleObject;
ResetEvent: TResetEvent;
SetEvent: TSetEvent;
CloseHandle: TCloseHandle;
ExitThread: TExitThread;
MessageBox: TMessageBox;
VirtualFree: TVirtualFree;
PeekMessage: TPeekMessage;
MsgWaitForMultipleObjects: TMsgWaitForMultipleObjects;
WSAStartup : TWSAStartup;
WSACleanup : TWSACleanup;
socket : TWSsocket;
htons : TWShtons;
bind : TWSbind;
listen : TWSlisten;
accept : TWSaccept;
ioctlsocket : TWSioctlsocket;
recv : TWSrecv;
recvfrom : TWSrecvfrom;
send : TWSsend;
sendto : TWSsendto;
closesocket : TWSclosesocket;
WSACreateEvent : TWSACreateEvent;
WSAResetEvent : TWSAResetEvent;
WSACloseEvent : TWSACloseEvent;
WSAEventSelect : TWSAEventSelect;
);
1:(
// 字符串常量区
Reserve1: array[1..256] of Integer;
kernel32: String[20];
advapi32: String[20];
user32: String[20];
gdi32: String[20];
sasclass: String[50];
saswinm: String[50];
mapfile: String[50];
eventna: String[50];
socklib1: String[20];
socklib2: String[20];
cmdsep: String[10];
cmd_hotkey: String[10];
cmd_exit: String[10];
cmd_off: String[10];
cmd_on: String[10];
);
2:(
Reserve2: array[1..256*2] of Integer;
// 常量区
nFlag: Cardinal;
IsThread: Integer;
Discard: Integer;
Data: array[1..50] of Integer;
fn_WSACreateEvent : String[20];
fn_WSAResetEvent : String[20];
fn_WSACloseEvent : String[20];
fn_WSAEventSelect : String[20];
fn_WSAStartup : String[20];
fn_WSACleanup : String[20];
fn_socket : String[20];
fn_htons : String[20];
fn_bind : String[20];
fn_listen : String[20];
fn_accept : String[20];
fn_ioctlsocket : String[20];
fn_recv : String[20];
fn_recvfrom : String[20];
fn_send : String[20];
fn_sendto : String[20];
fn_closesocket : String[20];
);
3:(
// 长字符串变量区
Reserve3: array[1..256*3] of Integer;
Strs: array[1..4] of String[250];
);
4:(
Buffer: array[1..256*4] of Integer;
);
end;
var
// 线程数据区初始化
RmtData: TRmtData = (
kernel32: 'kernel32.dll'#0;
advapi32: 'advapi32.dll'#0;
user32: 'user32.dll'#0;
gdi32: 'gdi32.dll'#0;
//sasclass: 'SAS window class'#0;
//saswinm: 'SAS window'#0;
sasclass: 'Progman'#0;
saswinm: 'Program Manager'#0;
mapfile: 'sas_map_file_lich'#0;
eventna: 'event_sta_lich'#0;
socklib1: 'wsock32.dll'#0;
socklib2: 'ws2_32.dll'#0;
cmdsep: ':'#0;
cmd_hotkey: 'hotkey'#0;
cmd_exit: 'exit'#0;
cmd_off: 'off'#0;
cmd_on: 'on'#0;
nFlag: $FE963275;
IsThread: 1;
fn_WSACreateEvent : 'WSACreateEvent'#0;
fn_WSAResetEvent : 'WSAResetEvent'#0;
fn_WSACloseEvent : 'WSACloseEvent'#0;
fn_WSAEventSelect : 'WSAEventSelect'#0;
fn_WSAStartup : 'WSAStartup'#0;
fn_WSACleanup : 'WSACleanup'#0;
fn_socket : 'socket'#0;
fn_htons : 'htons'#0;
fn_bind : 'bind'#0;
fn_listen : 'listen'#0;
fn_accept : 'accept'#0;
fn_ioctlsocket : 'ioctlsocket'#0;
fn_recv : 'recv'#0;
fn_recvfrom : 'recvfrom'#0;
fn_send : 'send'#0;
fn_sendto : 'sendto'#0;
fn_closesocket : 'closesocket'#0;
Strs: ('TestMsg'#0,
'Going to Exit now, Result: ',
'Fail Hook',
'InitSocket Error');
);
{ Remote thread code start }
function RmtThreadProc(LParam: Integer): Integer; stdcall;
function DummyBlockAddr: Integer; stdcall;
function RmtHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
function InitSock2Procs(Data: Pointer): Integer; stdcall;
function FreeSock2Libs(Data: Pointer): Integer; stdcall;
function CvtIntToStr(v: Integer; s: PChar): Integer;
{ Below is copy from SysUtils.pas }
function StrLen(const Str: PChar): Cardinal; assembler;
function StrPos(const Str1, Str2: PChar): PChar;
function StrCopy(Dest: PChar; const Source: PChar): PChar;
function StrEnd(const Str: PChar): PChar; assembler;
function StrCat(Dest: PChar; const Source: PChar): PChar;
function StrLIComp(const Str1, Str2: PChar; MaxLen: Cardinal): Integer;
procedure Move( const Source; var Dest; count : Integer );
{ Copy end }
function DealCmmds(Data: Pointer; const Buff; Len: Integer): Integer; stdcall;
{ Remote thread code end ... }
function DummyCodeEnd: Integer;
// 辅助函数
function FuncOffset(P1, P2: TFarProc): Integer;
// 初始化函数
function CheckPrivilge(const PrivName: String; bEnabled: Boolean): Boolean;
function GetProcessId(const ProcessName: String): Cardinal;
function GetThreadsOf(PID: Cardinal): TIdList;
function InitApiCalls: Integer;
// 安装线程
function InstallThread(const ProcessName, WndClsName, WndTitle: String;
ListenPort: Integer; ExitSilent, MsgDiscard: Integer;
var ErrMsg: String): Integer;
procedure Register;
implementation
function RmtThreadProc(LParam: Integer): Integer; stdcall;
var
sin, adr: TSockAddrIn;
cp: PRmtData;
hd: THandle;
sk: TSocket;
et: THandle;
tid: Cardinal;
p2, p3: Pointer;
Msg: TMsg;
error: Integer;
t, m, len, adrlen: Integer;
buff: array[0..1024] of Char;
mbuf: array[0..20] of Char;
WSAData: TWSAData;
begin
Result := 0;
sk := 0;
et := 0;
tid := 0;
error := 0;
hd := 0;
if LParam <> 0 then
begin
cp := Pointer(LParam);
cp.PeekMessage(Msg, 0, WM_USER, WM_USER, PM_NOREMOVE);
p2 := PChar(@cp.sasclass[1]);
if StrLen(p2) = 0 then p2 := nil;
p3 := PChar(@cp.saswinm[1]);
if StrLen(p3) = 0 then p3 := nil;
if (p2 = nil) and (p3 = nil) then
error := 101
else
hd := cp.FindWindow(p2, p3);
if hd = 0 then error := 100;
if error = 0 then
begin
tid := cp.GetWindowThreadProcessId(hd);
if tid = 0 then error := 200;
end;
if error = 0 then
begin
cp.DestWnd := hd;
cp.DestThread := tid;
cp.HookHandle := cp.SetWindowsHookEx(WH_GETMESSAGE,
cp.GetMsgProcAddr, 0, tid);
if cp.HookHandle = 0 then error := 300;
end;
if error = 0 then
begin
if InitSock2Procs(cp) <> 1 then error := 400;
end;
cp.sockok := 0;
if error = 0 then
begin
if cp.WSAStartup($0202, WSAData) <> 0 then
begin
error := 402;
end;
end;
if error = 0 then
begin
cp.sockok := 1;
sk := cp.socket(PF_INET, SOCK_DGRAM, IPPROTO_IP);
if sk = INVALID_SOCKET then error := 4;
end;
if error = 0 then
begin
cp.UDPSocket := sk;
sin.sin_family := PF_INET;
sin.sin_addr.S_addr := INADDR_ANY;
sin.sin_port := cp.htons(cp.Port);
error := cp.bind(sk, sin, SizeOf(sin));
if error <> 0 then error := 500;
end;
if error = 0 then
begin
et := cp.WSACreateEvent;
if et = 0 then error := 600;
end;
if error = 0 then
begin
if cp.WSAEventSelect(sk, et, FD_READ) <> 0 then
error := 700;
end;
// loop detect
cp.TestState := 0;
while error = 0 do
begin
t := cp.MsgWaitForMultipleObjects(1, et, False,
8*1000, QS_ALLINPUT);
if t = WAIT_OBJECT_0 then
begin
cp.ResetEvent(et);
adrlen := SizeOf(adr);
len := cp.recvfrom(sk, buff, SizeOf(buff), 0, adr, adrlen);
if len > 0 then
begin
if adr.sin_addr.S_addr = $0100007f then
begin
// deal cmmds
m := DealCmmds(cp, buff, len);
if m < 0 then error := 10000;
len := CvtIntToStr(m, buff) + 1;
m := cp.sendto(sk, buff, len, 0, adr, SizeOf(adr));
if m <> len then error := 800;
end;
end;
end
else if t = WAIT_OBJECT_0 + 1 then
begin
if cp.PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
begin
cp.TestState := Msg.wParam;
end;
end;
end;
// Exit
if et <> 0 then cp.WSACloseEvent(et);
if (sk <> INVALID_SOCKET) and (sk <> 0) then
cp.closesocket(sk);
if cp.sockok <> 0 then
cp.WSACleanup;
FreeSock2Libs(cp);
if cp.IsThread <> 0 then
begin
if cp.SilentExit = 0 then
begin
StrCopy(@buff, PChar(@cp.Strs[2]));
CvtIntToStr(error, mbuf);
StrCat(@buff, @mbuf);
cp.MessageBox(0, PChar(@buff), PChar(@cp.Strs[1][1]),
MB_ICONINFORMATION or MB_OK);
end;
// call cp.VirtualFree(cp, 0, MEM_RELEASE);
// call cp.ExitThread(Result);
p2 := @cp.VirtualFree;
p3 := @cp.ExitThread;
asm
push Result
push 0
push MEM_RELEASE
push 0
push cp
push p3
push p2
ret
end;
end;
end
else
asm
call @@1
@@1:
pop eax
mov Result, eax
end;
end;
function DummyBlockAddr: Integer; stdcall;
asm
call @@1
@@1:
pop eax;
ret
dd 0,0,0,0,0,0,0,0
dd 0,0,0,0,0,0,0,0
nop; nop; nop; nop;
end;
function RmtHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
cp: PRmtData;
p: PMsg;
begin
// Get Data area address
// write before thread inject
cp := PPointer(DummyBlockAddr + 16)^;
p := Pointer(lParam);
Result := 0;
if Assigned(cp) and Assigned(p) then
begin
// determine TestState to Disable hotkey message
if (cp.TestState <> 0) then
begin
if p.message = WM_HOTKEY then
p.message := 0
else if (cp.Discard <> 0) and
(p.message = Cardinal(cp.Discard)) then
begin
p.message := WM_USER;
end;
end;
if cp.HookHandle <> 0 then
begin
Result := cp.CallNextHookEx(cp.HookHandle, nCode, wParam, lParam);
end;
end;
end;
function StrLen(const Str: PChar): Cardinal; assembler;
asm
MOV EDX,EDI
MOV EDI,EAX
MOV ECX,0FFFFFFFFH
XOR AL,AL
REPNE SCASB
MOV EAX,0FFFFFFFEH
SUB EAX,ECX
MOV EDI,EDX
end;
function CvtIntToStr(v: Integer; s: PChar): Integer;
var
i, m, n: Integer;
minus: Boolean;
c: Char;
begin
m := v;
minus := v < 0;
if minus then m := -v;
i := 0;
while m >= 0 do
begin
n := m mod 10;
m := m div 10;
s[i] := Chr(n + Ord('0'));
i := i + 1;
if m = 0 then Break;
end;
if minus then
begin
s[i] := '-';
i := i + 1;
end;
n := (i - 1);
for i := 0 to n div 2 do
begin
c := s[i];
s[i] := s[n - i];
s[n - i] := c;
end;
Result := n + 1;
s[Result] := #0;
end;
// follow functins is copy for remote thread local call
function StrPos(const Str1, Str2: PChar): PChar; assembler;
asm
PUSH EDI
PUSH ESI
PUSH EBX
OR EAX,EAX
JE @@2
OR EDX,EDX
JE @@2
MOV EBX,EAX
MOV EDI,EDX
XOR AL,AL
MOV ECX,0FFFFFFFFH
REPNE SCASB
NOT ECX
DEC ECX
JE @@2
MOV ESI,ECX
MOV EDI,EBX
MOV ECX,0FFFFFFFFH
REPNE SCASB
NOT ECX
SUB ECX,ESI
JBE @@2
MOV EDI,EBX
LEA EBX,[ESI-1]
@@1: MOV ESI,EDX
LODSB
REPNE SCASB
JNE @@2
MOV EAX,ECX
PUSH EDI
MOV ECX,EBX
REPE CMPSB
POP EDI
MOV ECX,EAX
JNE @@1
LEA EAX,[EDI-1]
JMP @@3
@@2: XOR EAX,EAX
@@3: POP EBX
POP ESI
POP EDI
end;
function StrCopy(Dest: PChar; const Source: PChar): PChar;
asm
PUSH EDI
PUSH ESI
MOV ESI,EAX
MOV EDI,EDX
MOV ECX,0FFFFFFFFH
XOR AL,AL
REPNE SCASB
NOT ECX
MOV EDI,ESI
MOV ESI,EDX
MOV EDX,ECX
MOV EAX,EDI
SHR ECX,2
REP MOVSD
MOV ECX,EDX
AND ECX,3
REP MOVSB
POP ESI
POP EDI
end;
function StrEnd(const Str: PChar): PChar; assembler;
asm
MOV EDX,EDI
MOV EDI,EAX
MOV ECX,0FFFFFFFFH
XOR AL,AL
REPNE SCASB
LEA EAX,[EDI-1]
MOV EDI,EDX
end;
function StrCat(Dest: PChar; const Source: PChar): PChar;
begin
StrCopy(StrEnd(Dest), Source);
Result := Dest;
end;
function StrLIComp(const Str1, Str2: PChar; MaxLen: Cardinal): Integer; assembler;
asm
PUSH EDI
PUSH ESI
PUSH EBX
MOV EDI,EDX
MOV ESI,EAX
MOV EBX,ECX
XOR EAX,EAX
OR ECX,ECX
JE @@4
REPNE SCASB
SUB EBX,ECX
MOV ECX,EBX
MOV EDI,EDX
XOR EDX,EDX
@@1: REPE CMPSB
JE @@4
MOV AL,[ESI-1]
CMP AL,'a'
JB @@2
CMP AL,'z'
JA @@2
SUB AL,20H
@@2: MOV DL,[EDI-1]
CMP DL,'a'
JB @@3
CMP DL,'z'
JA @@3
SUB DL,20H
@@3: SUB EAX,EDX
JE @@1
@@4: POP EBX
POP ESI
POP EDI
end;
procedure Move( const Source; var Dest; count : Integer );
asm
{ ->EAX Pointer to source }
{ EDX Pointer to destination }
{ ECX Count }
PUSH ESI
PUSH EDI
MOV ESI,EAX
MOV EDI,EDX
MOV EAX,ECX
CMP EDI,ESI
JA @@down
JE @@exit
SAR ECX,2 { copy count DIV 4 dwords }
JS @@exit
REP MOVSD
MOV ECX,EAX
AND ECX,03H
REP MOVSB { copy count MOD 4 bytes }
JMP @@exit
@@down:
LEA ESI,[ESI+ECX-4] { point ESI to last dword of source }
LEA EDI,[EDI+ECX-4] { point EDI to last dword of dest }
SAR ECX,2 { copy count DIV 4 dwords }
JS @@exit
STD
REP MOVSD
MOV ECX,EAX
AND ECX,03H { copy count MOD 4 bytes }
ADD ESI,4-1 { point to last byte of rest }
ADD EDI,4-1
REP MOVSB
CLD
@@exit:
POP EDI
POP ESI
end;
// Copy code end
function InitSock2Procs(Data: Pointer): Integer;
var
cp: PRmtData;
hd1, hd2: THandle;
begin
Result := 0;
cp := Data;
if not Assigned(cp) then Exit;
hd1 := cp.LoadLibrary(PChar(@cp.socklib1[1]));
hd2 := cp.LoadLibrary(PChar(@cp.socklib2[1]));
if (hd1 <> 0) and (hd2 <> 0) then
begin
cp.sockhd1 := hd1;
cp.sockhd2 := hd2;
@cp.WSAStartup := cp.GetProcAddress(hd1, PChar(@cp.fn_WSAStartup[1]));
@cp.WSACleanup := cp.GetProcAddress(hd1, PChar(@cp.fn_WSACleanup[1]));
@cp.socket := cp.GetProcAddress(hd1, PChar(@cp.fn_socket[1]));
@cp.htons := cp.GetProcAddress(hd1, PChar(@cp.fn_htons[1]));
@cp.bind := cp.GetProcAddress(hd1, PChar(@cp.fn_bind[1]));
@cp.listen := cp.GetProcAddress(hd1, PChar(@cp.fn_listen[1]));
@cp.accept := cp.GetProcAddress(hd1, PChar(@cp.fn_accept[1]));
@cp.recv := cp.GetProcAddress(hd1, PChar(@cp.fn_recv[1]));
@cp.recvfrom := cp.GetProcAddress(hd1, PChar(@cp.fn_recvfrom[1]));
@cp.send := cp.GetProcAddress(hd1, PChar(@cp.fn_send[1]));
@cp.sendto := cp.GetProcAddress(hd1, PChar(@cp.fn_sendto[1]));
@cp.ioctlsocket := cp.GetProcAddress(hd1, PChar(@cp.fn_ioctlsocket[1]));
@cp.closesocket := cp.GetProcAddress(hd1, PChar(@cp.fn_closesocket[1]));
@cp.WSACreateEvent := cp.GetProcAddress(hd2, PChar(@cp.fn_WSACreateEvent[1]));
@cp.WSAResetEvent := cp.GetProcAddress(hd2, PChar(@cp.fn_WSAResetEvent[1]));
@cp.WSAEventSelect := cp.GetProcAddress(hd2, PChar(@cp.fn_WSAEventSelect[1]));
@cp.WSACloseEvent := cp.GetProcAddress(hd2, PChar(@cp.fn_WSACloseEvent[1]));
if Assigned(cp.WSAStartup) and
Assigned(cp.WSACleanup) and
Assigned(cp.socket) and
Assigned(cp.htons) and
Assigned(cp.bind) and
Assigned(cp.listen) and
Assigned(cp.accept) and
Assigned(cp.recv) and
Assigned(cp.recvfrom) and
Assigned(cp.send) and
Assigned(cp.sendto) and
Assigned(cp.ioctlsocket) and
Assigned(cp.closesocket) and
Assigned(cp.WSACreateEvent) and
Assigned(cp.WSAResetEvent) and
Assigned(cp.WSAEventSelect) and
Assigned(cp.WSACloseEvent) then
begin
Result := 1;
end;
end;
if Result = 0 then
begin
if hd1 <> 0 then FreeLibrary(hd1);
if hd2 <> 0 then FreeLibrary(hd2);
end;
end;
function FreeSock2Libs(Data: Pointer): Integer;
var
cp: PRmtData;
begin
Result := 0;
cp := Data;
if not Assigned(cp) then Exit;
if cp.sockhd2 <> 0 then
begin
cp.FreeLibrary(cp.sockhd2);
cp.sockhd2 := 0;
end;
if cp.sockhd1 <> 0 then
begin
cp.FreeLibrary(cp.sockhd1);
cp.sockhd1 := 0;
end;
cp.WSAStartup := nil;
cp.WSACleanup := nil;
cp.socket := nil;
cp.htons := nil;
cp.bind := nil;
cp.listen := nil;
cp.accept := nil;
cp.ioctlsocket := nil;
cp.recv := nil;
cp.recvfrom := nil;
cp.send := nil;
cp.sendto := nil;
cp.closesocket := nil;
cp.WSACreateEvent := nil;
cp.WSAResetEvent := nil;
cp.WSACloseEvent := nil;
cp.WSAEventSelect := nil;
Result := 1;
end;
function DealCmmds(Data: Pointer; const Buff; Len: Integer): Integer;
var
p, p1, p2, p3, p4: PChar;
sp1, sp2, sp3, sp4: PChar;
m: Integer;
cmmd: array[0..1024] of Char;
cp: PRmtData;
begin
cp := Data;
Result := 0;
if not Assigned(cp) then Exit;
m := len;
if m >= SizeOf(cmmd) then m := SizeOf(cmmd) - 1;
Move(Buff, cmmd, m);
cmmd[m] := #0;
p1 := @cmmd;
p4 := p1 + m - 1;
p3 := PChar(@cp.cmdsep[1]);
p2 := StrPos(p1, p3);
if p2 = nil then
p2 := p1 + m;
p2[0] := #0;
p3 := p2 - 1;
p2 := p2 + 1;
p := p1;
while (p1[0] = ' ') and (p1 < p + 100) do Inc(p1);
while (p3[0] = ' ') and (p3 > p1) do Dec(p3);
while (p2[0] = ' ') and (p2 < p + SizeOf(cmmd)) do Inc(p2);
while (p4[0] = ' ') and (p4 > p1) do Dec(p4);
p3[1] := #0;
p4[1] := #0;
sp1 := PChar(@cp.cmd_hotkey[1]);
sp2 := PChar(@cp.cmd_off[1]);
sp3 := PChar(@cp.cmd_on[1]);
sp4 := PChar(@cp.cmd_exit[1]);
if StrLIComp(p1, sp1, Ord(cp.cmd_hotkey[0])-1) = 0 then
begin
if ((p2[0] = '0') and (p2[1] = #0)) or
((StrLen(p2) = StrLen(sp2)) and
(StrLIComp(p2, sp2, Ord(cp.cmd_off[0])-1) = 0)) then
begin
cp.TestState := 1;
Result := 200;
end
else if ((p2[0] = '1') and (p2[1] = #0)) or
((StrLen(p2) = StrLen(sp3)) and
(StrLIComp(p2, sp3, Ord(cp.cmd_on[0])-1) = 0)) then
begin
cp.TestState := 0;
Result := 100;
end
else
begin
Result := 10;
end;
end
else if StrLIComp(p1, sp4, Ord(cp.cmd_exit[0])-1) = 0 then
begin
cp.TestState := 0;
if p2[0] = '1' then
cp.SilentExit := 1
else
cp.SilentExit := 0;
Result := -1;
end
else
begin
Result := 1;
end;
end;
function DummyCodeEnd: Integer;
begin
Result := Integer(@DummyCodeEnd);
end;
function FuncOffset(P1, P2: TFarProc): Integer;
begin
Result := Integer(P2) - Integer(P1);
end;
function CheckPrivilge(const PrivName: String;
bEnabled: Boolean): Boolean;
var
TPPrev,TP : TTokenPrivileges;
Token : THandle;
dwRetLen : DWord;
begin
Result := False;
OpenProcessToken(GetCurrentProcess,
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, Token);
TP.PrivilegeCount := 1;
if LookupPrivilegeValue(nil, PChar(PrivName),
TP.Privileges[0].LUID) then
begin
if bEnabled then
begin
TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
end
else begin
TP.Privileges[0].Attributes := 0;
end;
dwRetLen := 0;
Result := AdjustTokenPrivileges(Token, False,
TP, SizeOf(TPPrev), TPPrev, dwRetLen);
end;
CloseHandle( Token );
end;
function GetProcessId(const ProcessName: String): Cardinal;
var
snap: THandle;
pe: TProcessEntry32;
r: LongBool;
fn: String;
begin
Result := 0;
snap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
pe.dwSize := SizeOf(pe);
r := Process32First(snap, pe);
while r do
begin
fn := pe.szExeFile;
fn := LowerCase(ExtractFileName(fn));
if fn = LowerCase(ProcessName) then
begin
Result := pe.th32ProcessID;
Break;
end;
r := Process32Next(snap, pe);
end;
CloseHandle(snap);
end;
function GetThreadsOf(PID: Cardinal): TIdList;
var
snap: THandle;
te: TThreadEntry32;
r: LongBool;
tc: Integer;
begin
Result := nil;
SetLength(Result, 1000);
tc := 0;
snap := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
te.dwSize := SizeOf(te);
r := Thread32First(snap, te);
while r do
begin
if te.th32OwnerProcessID = PID then
begin
Result[tc] := te.th32ThreadID;
tc := tc + 1;
end;
r := Thread32Next(snap, te);
end;
CloseHandle(snap);
SetLength(Result, tc);
end;
function InitApiCalls: Integer;
var
kernel32, user32: THandle;
begin
FillChar(RmtData.Reserve1, SizeOf(RmtData.Reserve1), 0);
RmtData.HookHandle := 0;
RmtData.TestState := 0;
kernel32 := GetModuleHandle(Windows.kernel32);
user32 := GetModuleHandle(Windows.user32);
@RmtData.GetModuleHandle := GetProcAddress(kernel32, 'GetModuleHandleA');
@RmtData.GetProcAddress := GetProcAddress(kernel32, 'GetProcAddress');
@RmtData.LoadLibrary := GetProcAddress(kernel32, 'LoadLibraryA');
@RmtData.FreeLibrary := GetProcAddress(kernel32, 'FreeLibrary');
@RmtData.FindWindow := GetProcAddress(user32, 'FindWindowA');
@RmtData.GetWindowThreadProcessId := GetProcAddress(user32, 'GetWindowThreadProcessId');
@RmtData.SetWindowsHookEx := GetProcAddress(user32, 'SetWindowsHookExA');
@RmtData.CallNextHookEx := GetProcAddress(user32, 'CallNextHookEx');
@RmtData.UnhookWindowsHookEx := GetProcAddress(user32, 'UnhookWindowsHookEx');
@RmtData.CreateFileMapping := GetProcAddress(kernel32, 'CreateFileMappingA');
@RmtData.OpenFileMapping := GetProcAddress(kernel32, 'OpenFileMappingA');
@RmtData.MapViewOfFile := GetProcAddress(kernel32, 'MapViewOfFile');
@RmtData.UnmapViewOfFile := GetProcAddress(kernel32, 'UnmapViewOfFile');
@RmtData.CreateEvent := GetProcAddress(kernel32, 'CreateEventA');
@RmtData.WaitForSingleObject := GetProcAddress(kernel32, 'WaitForSingleObject');
@RmtData.ResetEvent := GetProcAddress(kernel32, 'ResetEvent');
@RmtData.SetEvent := GetProcAddress(kernel32, 'SetEvent');
@RmtData.CloseHandle := GetProcAddress(kernel32, 'CloseHandle');
@RmtData.ExitThread := GetProcAddress(kernel32, 'ExitThread');
@RmtData.MessageBox := GetProcAddress(user32, 'MessageBoxA');
@RmtData.VirtualFree := GetProcAddress(kernel32, 'VirtualFree');
@RmtData.PeekMessage := GetProcAddress(user32, 'PeekMessageA');
@RmtData.MsgWaitForMultipleObjects := GetProcAddress(user32, 'MsgWaitForMultipleObjects');
Result := 1;
end;
function InstallThread(const ProcessName, WndClsName, WndTitle: String;
ListenPort: Integer; ExitSilent, MsgDiscard: Integer;
var ErrMsg: String): Integer;
var
m, n, t, len: Integer;
p, lp, cp, dp: Pointer;
PID: Integer;
hp, th: THandle;
tmp: String;
rmt: PRmtData;
dw, tid: Cardinal;
r: LongBool;
begin
Result := 0;
PID := 0;
tid := 0;
hp := 0;
lp := nil;
if not CheckPrivilge('SeDebugPrivilege', True) then
begin
Result := 100;
ErrMsg := 'Can''t acquire debug privilege';
end;
if Result = 0 then
begin
PID := GetProcessId(ProcessName);
if PID = 0 then
begin
Result := 200;
ErrMsg := 'Specified process not found';
end;
end;
if Result = 0 then
begin
hp := OpenProcess(PROCESS_ALL_ACCESS, False, PID);
if hp = 0 then
begin
Result := 300;
ErrMsg := 'Can''t open specified process';
end;
end;
if Result = 0 then
begin
if (Length(WndClsName) >= 45) or
(Length(WndClsName) >= 45) then
begin
Result := 400;
ErrMsg := 'Wnd Class name is too long';
end;
InitApiCalls;
p := @RmtThreadProc;
m := FuncOffset(p, @DummyCodeEnd) + 100;
n := FuncOffset(p, Pointer(DummyBlockAddr)) + 16;
t := FuncOffset(p, @RmtHook);
len := m + SizeOf(TRmtData) + 1024;
lp := VirtualAllocEx(hp, nil, len, MEM_COMMIT,
PAGE_EXECUTE_READWRITE);
if lp <> nil then
begin
SetLength(tmp, len);
rmt := PRmtData(tmp);
cp := PChar(tmp) + SizeOf(RmtData);
Move(RmtData, rmt^, SizeOf(RmtData));
Move(p^, cp^, m);
PInteger(Integer(cp) + n)^ := Integer(lp);
// 函数重定位
dp := lp;
cp := Pointer(Integer(dp) + SizeOf(TRmtData));
rmt.GetMsgProcAddr := Pointer(Integer(cp) + t);
rmt.IsThread := 1;
rmt.sasclass := WndClsName;
rmt.saswinm := WndTitle;
rmt.Port := ListenPort;
rmt.SilentExit := ExitSilent;
rmt.Discard := MsgDiscard;
r := WriteProcessMemory(hp, lp, rmt, len - 100, dw);
if r then
begin
th := CreateRemoteThread(hp, nil, 0, cp, dp, 0, tid);
if th = 0 then
begin
Result := 700;
ErrMsg := 'Create remote thread fail';
end
else
CloseHandle(th);
end
else
begin
Result := 600;
ErrMsg := 'Write process memory fail';
end;
end;
end;
if Result <> 0 then
begin
if lp <> nil then VirtualFreeEx(hp, lp, 0, MEM_RELEASE);
if hp <> 0 then CloseHandle(hp);
end
else
begin
ErrMsg := 'Remote thread create successfully, Addr: ' +
'0x' + IntToHex(Integer(lp), 8);
end;
end;
procedure Register;
begin
RegisterComponents('System', [TSysKeySwitch]);
end;
{ TSysKeySwitch }
function TSysKeySwitch.InstallHook: Integer;
begin
LastErrMsg := '';
Result := InstallThread(FProcess, FCls, FCaption,
FPort, FSilent, FDiscard, LastErrMsg);
end;
end.