vsprocess.pas

delphi process unit to convert and get handle,pid,write process,read,...

// Coded By Arash Veyskarami
// a part of VsCollection
unit VsProcess;

interface
uses windows, tlhelp32;

function ProcessCountByPath(Path:string): integer; stdcall;
function PHandleToPath(hProcess: cardinal) : string; stdcall;
function PHandleToPid(hProcess: cardinal) : Cardinal;stdcall;
function NameToPid(ExeNames: PChar): Cardinal; stdcall;  //
function PidToName(dwProcessID: DWord): string; stdcall;
function PidToPath(dwProcessID: DWord): string; stdcall;
function PathToPid(Path:string):Dword; stdcall;
function GetModulesByPid(ProcessID: DWord): string; stdcall;
function GetModulesByName(ExeName: PChar): string; stdcall;
function GetAllProcess: string; stdcall;
function IsProcessByName(Name:string):Boolean;stdcall;
function IsProcessByPath(Path:string):Boolean;stdcall;
function FindModulesInProcess(ProcessID: DWord): string; stdcall; overload;
function FindModulesInProcess(ExecutableName: PChar): string; stdcall; overload;
function IsModuleFound(ProcessID: DWord;Module:string): Boolean; stdcall;
function PidToParent(Pid:Dword):Dword;
function ReadIntMemory(const lpBase:integer;PID:Cardinal):integer;stdcall;
function ReadStrMemory(const lpBase:integer;PID:Cardinal):String;stdcall;
procedure WriteIntMemory(const lpBase:integer;PID:Cardinal;lpinteger:integer);stdcall;
procedure WriteStrMemory(const lpBase:integer;PID:Cardinal;lpString:string);stdcall;


procedure SetTokenPrivileges;

implementation
  type
  TNtProcessBasicInfo = record
    exitStatus     : cardinal;
    pebBaseAddress : cardinal;
    affinityMask   : cardinal;
    basePriority   : cardinal;
    pid            : cardinal;
    parentPid      : cardinal;
  end;
  TPCardinal     = ^cardinal;
   TNtProcessInfoClass = (ProcessBasicInformation,
                         ProcessQuotaLimits,
                         ProcessIoCounters,
                         ProcessVmCounters,
                         ProcessTimes,
                         ProcessBasePriority,
                         ProcessRaisePriority,
                         ProcessDebugPort,
                         ProcessExceptionPort,
                         ProcessAccessToken,
                         ProcessLdtInformation,
                         ProcessLdtSize,
                         ProcessDefaultHardErrorMode,
                         ProcessIoPortHandlers,
                         ProcessPooledUsageAndLimits,
                         ProcessWorkingSetWatch,
                         ProcessUserModeIOPL,
                         ProcessEnableAlignmentFaultFixup,
                         ProcessPriorityClass,
                         ProcessWx86Information,
                         ProcessHandleCount,
                         ProcessAffinityMask,
                         ProcessPriorityBoost,
                         ProcessDeviceMap,
                         ProcessSessionInformation,
                         ProcessForegroundInformation,
                         ProcessWow64Information,
                         ProcessImageFileName,
                         ProcessLUIDDeviceMapsEnabled,
                         ProcessBreakOnTermination,
                         ProcessDebugObjectHandle,
                         ProcessDebugFlags,
                         ProcessHandleTracing,
                         ProcessIoPriority,
                         ProcessExecuteFlags,
                         ProcessResourceManagement,
                         ProcessCookie,
                         ProcessImageInformation,
                         MaxProcessInfoClass);
     var
  NtQueryInformationProcess : function (processHandle : cardinal;
                                        infoClass     : TNtProcessInfoClass;
                                        buffer        : pointer;
                                        bufSize       : cardinal;
                                        returnSize    : TPCardinal) : cardinal stdcall = nil;

function LowerCase(const S: string): string;
var
  Ch: Char;
  L: Integer;
  Source, Dest: PChar;
begin
  L := Length(S);
  SetLength(Result, L);
  Source := Pointer(S);
  Dest := Pointer(Result);
  while L <> 0 do
  begin
    Ch := Source^;
    if (Ch >= 'A') and (Ch <= 'Z') then Inc(Ch, 32);
    Dest^ := Ch;
    Inc(Source);
    Inc(Dest);
    Dec(L);
  end;
end;




function UpperCase(sString: String): String; stdcall;
var
  Ch    : Char;
  L     : Integer;
  Source: PChar;
  Dest  : PChar;
begin
  L := Length(sString);
  SetLength(Result, L);
  Source := Pointer(sString);
  Dest := Pointer(Result);
  while L <> 0 do
  begin
    Ch := Source^;
    if (Ch >= 'a') and (Ch <= 'z') then Dec(Ch, 32);
    Dest^ := Ch;
    Inc(Source);
    Inc(Dest);
    Dec(L);
  end;
end;

function ExtractFileName(sFile: String): String; stdcall;
var
  i: Integer;
  j: Integer;
begin
  j := 0;
  for i := 1 to length(sFile) do
    if (sFile[i] = '\') then j := i;
  sFile := Copy(sFile,j+1,length(sFile));
  j := 0;
  for i := 1 to length(sFile) do
    if (sFile[i] = '.') then j := i;
  if j = 0 then j := length(sFile)+1;
  Result := Copy(sFile,1,j-1);
end;

function PidToPath(dwProcessID: DWord): string; stdcall;
var FSnapshotHandle: THandle;
    FModuleEntry32 : TModuleEntry32;
begin
  Result := '';
  if (dwProcessID <> 0) then
  begin
    FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,dwProcessID);
    FModuleEntry32.dwSize := Sizeof(FModuleEntry32);
    Module32First(FSnapshotHandle,FModuleEntry32);
    result := FModuleEntry32.szExePath;
    CloseHandle(FSnapshotHandle);
  end;
end;

function PathToPid(Path:string):Cardinal;
 Var
  cLoop          :Boolean;
  SnapShot       :THandle;
  L              :TProcessEntry32;
  Begin
 Result:=0;
  SnapShot := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS or TH32CS_SNAPMODULE, 0);
  L.dwSize := SizeOf(L);
  cLoop := Process32First(SnapShot, L);
  while (Integer(cLoop) <> 0) do begin

    if LowerCase(PidToPath(L.th32ProcessID)) = LowerCase(Path) then
  Result:=L.th32ProcessID ;
  cLoop := Process32Next(SnapShot, L);
  end;
  CloseHandle(SnapShot);
end;

function PHandleToPath(hProcess: cardinal) : string; stdcall;
var pbi  : TNtProcessBasicInfo;
    c1   : cardinal;
    pp   : pointer;
    ws   : wideString;
    ustr : packed record
    len, maxLen : word;
    str         : PWideChar;
           end;
begin
  result := '?';
  if @NtQueryInformationProcess = nil then
    NtQueryInformationProcess := GetProcAddress(GetModuleHandle('ntdll.dll'), 'NtQueryInformationProcess');
  if (NtQueryInformationProcess(hProcess, ProcessBasicInformation, @pbi, sizeOf(TNtProcessBasicInfo), nil) = 0) and
     ReadProcessMemory(hProcess, pointer(dword(pbi.pebBaseAddress) + $10), @pp, 4, c1) and (c1 = 4) and
     ReadProcessMemory(hProcess, pointer(dword(pp) + 14 * 4), @ustr, 8, c1) and (c1 = 8) then begin
    SetLength(ws, ustr.len div 2);
    if ReadProcessMemory(hProcess, ustr.str, pointer(ws), ustr.len, c1) and (c1 = ustr.len) then
      result := ws;
  end;
end;


function PHandleToPID(hProcess: cardinal) : Cardinal;
var pbi  : TNtProcessBasicInfo;
    c1   : cardinal;
    pp   : pointer;
    ws   : wideString;
    ustr : packed record
    len, maxLen : word;
    str         : PWideChar;
           end;
begin
  if @NtQueryInformationProcess = nil then
    NtQueryInformationProcess := GetProcAddress(GetModuleHandle('ntdll.dll'), 'NtQueryInformationProcess');
   NtQueryInformationProcess(hProcess, ProcessBasicInformation, @pbi, sizeOf(TNtProcessBasicInfo), nil);
   Result:=pbi.pid;
end;



function PidToName(dwProcessID: DWord): string; stdcall;
begin

Result:=ExtractFileName(PidToPath(dwProcessID)+'.exe');
end;

function GetModulesByPid(ProcessID: DWord): string; stdcall;
var sFoundModules  : String;
    FSnapshotHandle: THandle;
    FModuleEntry32 : TModuleEntry32;
    ContinueLoop   : Boolean;
begin
  Result := '';
  sFoundModules := '';
  if (ProcessID <> 0) then
  begin
    FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,ProcessID);
    FModuleEntry32.dwSize := Sizeof(FModuleEntry32);
    ContinueLoop := Module32First(FSnapshotHandle,FModuleEntry32);
    while ContinueLoop do
    begin
      sFoundModules := sFoundModules+FModuleEntry32.szModule+#13#10;
      ContinueLoop := Module32Next(FSnapshotHandle,FModuleEntry32);
    end;
    result := sFoundModules;
    CloseHandle(FSnapshotHandle);
  end;
end;

function ProcessCountByPath(Path:string): integer; stdcall;
var
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
  ContinueLoop   : Boolean;
begin
  Result:=0;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);
  while ContinueLoop do
  begin
  if LowerCase(PidToPath(FProcessEntry32.th32ProcessID)) = LowerCase(Path) then