Delphi World - Получить сведения о процессе
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Получить сведения о процессе

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

// Der Quellcode wurde von NicoDE (nico@bendlins.de) geschrieben. 

{ 
  Diese Funktion schreibt alle Informationen uber den in Edit1.text angegeneben NT 
  Prozess (ProzessID) in das Feld Memo1. 
}

 { 
  This function write all nt process informations into memo1. In Edit1 you can 
  specify the processID. 
}


 type
   PDebugModule = ^TDebugModule;
   TDebugModule = packed record
     Reserved: array [0..1] of Cardinal;
     Base: Cardinal;
     Size: Cardinal;
     Flags: Cardinal;
     Index: Word;
     Unknown: Word;
     LoadCount: Word;
     ModuleNameOffset: Word;
     ImageName: array [0..$FF] of Char;
   end;

 type
   PDebugModuleInformation = ^TDebugModuleInformation;
   TDebugModuleInformation = record
     Count: Cardinal;
     Modules: array [0..0] of TDebugModule;
   end;
   PDebugBuffer = ^TDebugBuffer;
   TDebugBuffer = record
     SectionHandle: THandle;
     SectionBase: Pointer;
     RemoteSectionBase: Pointer;
     SectionBaseDelta: Cardinal;
     EventPairHandle: THandle;
     Unknown: array [0..1] of Cardinal;
     RemoteThreadHandle: THandle;
     InfoClassMask: Cardinal;
     SizeOfInfo: Cardinal;
     AllocatedSize: Cardinal;
     SectionSize: Cardinal;
     ModuleInformation: PDebugModuleInformation;
     BackTraceInformation: Pointer;
     HeapInformation: Pointer;
     LockInformation: Pointer;
     Reserved: array [0..7] of Pointer;
   end;

 const
   PDI_MODULES = $01;
   ntdll = 'ntdll.dll';

 var
   HNtDll: HMODULE;

 type
   TFNRtlCreateQueryDebugBuffer = function(Size: Cardinal;
     EventPair: Boolean): PDebugBuffer;
    stdcall;
   TFNRtlQueryProcessDebugInformation = function(ProcessId,
     DebugInfoClassMask: Cardinal; var DebugBuffer: TDebugBuffer): Integer;
    stdcall;
   TFNRtlDestroyQueryDebugBuffer = function(DebugBuffer: PDebugBuffer): Integer;
    stdcall;

 var
   RtlCreateQueryDebugBuffer: TFNRtlCreateQueryDebugBuffer;
   RtlQueryProcessDebugInformation: TFNRtlQueryProcessDebugInformation;
   RtlDestroyQueryDebugBuffer: TFNRtlDestroyQueryDebugBuffer;

 function LoadRtlQueryDebug: LongBool;
 begin
   if HNtDll = 0 then
   begin
     HNtDll := LoadLibrary(ntdll);
     if HNtDll <> 0 then
     begin
       RtlCreateQueryDebugBuffer       := GetProcAddress(HNtDll, 'RtlCreateQueryDebugBuffer');
       RtlQueryProcessDebugInformation := GetProcAddress(HNtDll,
         'RtlQueryProcessDebugInformation');
       RtlDestroyQueryDebugBuffer      := GetProcAddress(HNtDll,
         'RtlDestroyQueryDebugBuffer');
     end;
   end;
   Result := Assigned(RtlCreateQueryDebugBuffer) and
     Assigned(RtlQueryProcessDebugInformation) and
     Assigned(RtlQueryProcessDebugInformation);
 end;

 procedure TForm1.Button1Click(Sender: TObject);
 var
   DbgBuffer: PDebugBuffer;
   Loop: Integer;
 begin
   if not LoadRtlQueryDebug then Exit;

   Memo1.Clear;
   Memo1.Lines.BeginUpdate;
   DbgBuffer := RtlCreateQueryDebugBuffer(0, False);
   if Assigned(DbgBuffer) then
     try
       if RtlQueryProcessDebugInformation(StrToIntDef(Edit1.Text, GetCurrentProcessId),
         PDI_MODULES, DbgBuffer^) >= 0 then
       begin
         for Loop := 0 to DbgBuffer.ModuleInformation.Count - 1 do
           with DbgBuffer.ModuleInformation.Modules[Loop], Memo1.Lines do
           begin
             Add('ImageName: ' + ImageName);
             Add('  Reserved0: ' + IntToHex(Reserved[0], 8));
             Add('  Reserved1: ' + IntToHex(Reserved[1], 8));
             Add('  Base: ' + IntToHex(Base, 8));
             Add('  Size: ' + IntToHex(Size, 8));
             Add('  Flags: ' + IntToHex(Flags, 8));
             Add('  Index: ' + IntToHex(Index, 4));
             Add('  Unknown: ' + IntToHex(Unknown, 4));
             Add('  LoadCount: ' + IntToHex(LoadCount, 4));
             Add('  ModuleNameOffset: ' + IntToHex(ModuleNameOffset, 4));
           end;
       end;
     finally
       RtlDestroyQueryDebugBuffer(DbgBuffer);
     end;
   Memo1.Lines.EndUpdate;
 end;
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования