我贴了动态启用禁用ctrl+alt+del的控件这里再发个不用控件的

这个也是别人写的,可能很多人都见过,在这里贴出来,希望想研究这方面的大虾们发表下自己的看法

//源代码

//主窗体代码

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.
 
 

 
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值