Программирование на Delphi

FAQ VCL
Windows

:: Меню ::

:: На главную ::

:: FAQ ::

:: Заметки ::

:: Практика ::

:: Win API ::

:: Проекты ::

:: Скачать ::

:: Секреты ::

:: Ссылки ::

:: Сервис ::

:: Написать ::

:: MVP ::

:: RSS ::

Как получить имя файла оболочки?


uses
  Winapi.TlHelp32, System.Win.Registry;

procedure TForm1.Button1Click(Sender: TObject);

 function ShellWindow: HWND;
 type
   TGetShellWindow = function(): HWND; stdcall;
 var
   hUser32: THandle;
   GetShellWindow: TGetShellWindow;
 begin
   Result := 0;
   hUser32 := GetModuleHandle('user32.dll');

   if hUser32 > 0 then
   begin
     @GetShellWindow := GetProcAddress(hUser32, 'GetShellWindow');
     if Assigned(GetShellWindow) then
       Result := GetShellWindow;
   end;
 end;

 function ReadFromRegistry: string;
 const
   szReg = 'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon';
   szKey = 'Shell';
 var
   Reg: TRegistry;
 begin
   Result := '';

   Reg := TRegistry.Create;
   try
     // Сначала ищем в HKEY_CURRENT_USER
     Reg.RootKey := HKEY_CURRENT_USER;
 
    if Reg.OpenKeyReadOnly(szReg) then
       Result := Reg.ReadString(szKey);

     if Result = '' then
     begin
       // Reg.CloseKey;
       // Посмотрим в HKEY_LOCAL_MACHINE
       Reg.RootKey := HKEY_LOCAL_MACHINE;
       if Reg.OpenKeyReadOnly(szReg) then
         Result := Reg.ReadString(szKey);
     end;
   finally
     Reg.CloseKey;
     Reg.Free;
   end;
 end;

var
  hWnd, hProc: Cardinal;
  hSnapshot: NativeUInt;
  pe32: TProcessEntry32;
begin
  // Недостаток FindWindow - ничто не мешает любому приложению создать
  // окно с классом "Progman", а при отсутствии запущенного штатного
  // шелла это гарантированно приведет к неверным результатам.
  // hWnd := FindWindow('Progman', nil);

  hWnd := ShellWindow;
  if hWnd > 0 then
  begin
    GetWindowThreadProcessId(hWnd, hProc);
    if hProc > 0 then
    begin
      hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
      if (hSnapshot = -1) then
        Exit;

      pe32.dwSize := SizeOf(TProcessEntry32);
      if Process32First(hSnapshot, pe32) then
      repeat
        if pe32.th32ProcessID = hProc then
          ShowMessage(pe32.szExeFile);
      until not Process32Next(hSnapshot, pe32);

      CloseHandle (hSnapshot);
    end;
  end
  else
    // Если функция GetShellWindow вернула ошибку, то скорее всего в системе
    // используется альтернативный шелл и придется заглянуть в реестр.
    ShowMessage(ReadFromRegistry);
end;

Как получить системный разделитель целой части числа от дробной?


function GetDecimalSeparator: Char;
var
  DefaultLCID: Integer;
begin
  if IsValidLocale(GetUserDefaultLCID, LCID_INSTALLED) then
    DefaultLCID := GetUserDefaultLCID
  else
    DefaultLCID := GetThreadLocale;

  Result := GetLocaleChar(DefaultLCID, LOCALE_SDECIMAL, '.');
end;

Как отловить перезапуск Explorer'а после аварийного завершения?


type
  TForm1 = class(TForm)
  protected
    procedure ClientWndProc(var Msg: TMessage); override;
  end;

implementation

var
  WM_TASKBARCREATED: Cardinal;

procedure TForm1.ClientWndProc(var Msg: TMessage);
begin
  inherited WndProc(Msg);

  if Msg.Msg = WM_TASKBARCREATED then
    {...};
end;

initialization
  WM_TASKBARCREATED := RegisterWindowMessage('TaskbarCreated');

Как узнать об изменении системных настроек?


// Способ первый (обработка сообщения в классе формы)
type
  TForm1 = class(TForm)
  private
    procedure WMSettingChange(var Msg: TWMSettingChange); message WM_SETTINGCHANGE;
  end;

implementation

procedure TForm1.WMSettingChange(var Msg: TWMSettingChange);
const
  CM_CHANGEFORMAT = WM_USER + 101;
begin
  // Приложению нужно реагировать на изменения настроек из вне, для чего нужно обрабатывать
  // сообщение WM_SETTINGCHANGE, которое пришло на замену устаревшему WM_WININICHANGE. Получив
  // его нужно обновить свои собственные настройки, для чего посылаем сами себе сообщение
  // CM_CHANGEFORMAT. А вот изменятся они или нет зависит от настройки Application.UpdateFormatSettings
  // (по умолчанию True, изменятся).
  PostMessage(Handle, CM_CHANGEFORMAT, 0, 0);
  Msg.Result := 0;
end;

// Способ второй (использование хука главного окна)
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    function SettingChangeHook(var Message: TMessage): Boolean;
  end;

implementation

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.HookMainWindow(SettingChangeHook);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Application.UnhookMainWindow(SettingChangeHook);
end;

function TForm1.SettingChangeHook(var Message: TMessage): Boolean;
const
  CM_CHANGEFORMAT = WM_USER + 101;
begin
  case Message.Msg of
    WM_SETTINGCHANGE:
    begin
      // Код обработчика
      PostMessage(Handle, CM_CHANGEFORMAT, 0, 0);
    end;
  end;
  Result := False; // Продолжить обработку сообщения
end;

// Способ третий (использование события OnSettingChange в классе TApplication)
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    procedure SettingChange(Sender: TObject; Flag: Integer; const Section: string; var Result: Integer);
  end;

implementation

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnSettingChange := SettingChange;
end;

procedure TForm1.SettingChange(Sender: TObject; Flag: Integer;
  const Section: string; var Result: Integer);
const
  CM_CHANGEFORMAT = WM_USER + 101;
begin
  PostMessage(Handle, CM_CHANGEFORMAT, 0, 0);
  Result := False; // Продолжить обработку сообщения
end;

Как уведомить все приложения об изменении системных настроек?


// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
begin
   // Меняем региональные настройки...
   // ...и уведомляем об этом все приложения
   SendNotifyMessage(HWND_BROADCAST, WM_WININICHANGE, SPI_SETNONCLIENTMETRICS, 0);
   // Фцнкции SendXXX отправляют сообщение другому окну немедленно, вызывая его
   // оконную процедуру, в то время как функции PostXXX посылают сообщение другому
   // окну постановкой сообщения в очередь потока, ассоциированного с этим самым
   // окном. Однако пользоваться функцией PostMessage не рекомендуется. Если вызвать
   // ее при запущенном экземпляре Excel, приложение может подвиснуть, ожидая обработки
   // отправленного собщения. А ждать этого можно ну оооочень долго, порой проще взять
   // да и "срубить" процесс Excel. Лучше воспользоваться функцией SendNotifyMessage,
   // которая не ждет обработки сообщения и возвращает управление сразу после отправки.
end;

// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
var
  Rv: DWORD;
begin
  SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, 0, LParam(PChar('Environment')),
                     SMTO_ABORTIFHUNG, 5000, Rv);
end;

Как скрыть кнопки меню по Ctrl+Alt+Del в Win7/Vista?


// Скрываем кнопки:
//  • Блокировать компьютер
//  • Сменить пользователя
//  • Выйти из системы
//  • Сменить пароль...
//  • Запустить диспетчер задач
//  • Отмена
// https://msdn.microsoft.com/en-us/library/ms815238.aspx?f=255&MSPPError=-2147217396

uses
  Registry;

/// 
///   Сокрытие кнопок
/// 
procedure TForm1.Button1Click(Sender: TObject);
var
  Reg: TRegistry;
begin
  try
    Reg := TRegIniFile.Create;

    try
      Reg.RootKey := HKEY_LOCAL_MACHINE;

      if Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Policies\System', True) then
      begin
        // Сменить пользователя
        Reg.WriteInteger('HideFastUserSwitching', 1);
        Reg.CloseKey;
      end;

      Reg.RootKey := HKEY_CURRENT_USER;

      if Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Policies\System', True) then
      begin
        // Блокировать компьютер
        Reg.WriteInteger('DisableLockWorkstation', 1);
        // Сменить пароль...
        Reg.WriteInteger('DisableChangePassword', 1);
        // Запустить диспетчер задач
        Reg.WriteInteger('DisableTaskMgr', 1);
        Reg.CloseKey;
      end;

      if Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer', True) then
      begin
        // Выйти из системы
        Reg.WriteInteger('NoLogoff', 1);
        // Выключить компьютер
        Reg.WriteInteger('NoClose', 1);
      end;
    finally
      Reg.Free;
    end;
  except
    ShowMessage('У Вас нет прав администратора.');
  end;
end;

/// 
///   Отображение кнопок
/// 
procedure TForm1.Button2Click(Sender: TObject); // отображение кнопок
var
  Reg: TRegistry;
begin
  try
    Reg := TRegIniFile.Create;
 
    try
      Reg.RootKey := HKEY_LOCAL_MACHINE;

      if Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Policies\System', True) then
      begin
         // Сменить пользователя
         Reg.WriteInteger('HideFastUserSwitching', 0);
         Reg.CloseKey;
      end;

      Reg.RootKey:=HKEY_CURRENT_USER;

      if Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Policies\System', True) then
      begin
        // Блокировать компьютер
        Reg.WriteInteger('DisableLockWorkstation', 0);
        // Сменить пароль...
        Reg.WriteInteger('DisableChangePassword', 0);
        // Запустить диспетчер задач
        Reg.WriteInteger('DisableTaskMgr', 0);
        Reg.CloseKey;
      end;

      if Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer', True) then
      begin
        // Выйти из системы
        Reg.WriteInteger('NoLogoff', 0);
        // Выключить компьютер
        Reg.WriteInteger('NoClose', 0);
      end;
    finally
      Reg.Free;
    end;
  except
    ShowMessage('У Вас нет прав администратора.');
  end;
end;

Как получить полный путь исполняемого файла по PID процесса?


// Способ первый
uses
  PsAPI;
  
// Результат работы функции зависит от разрядности компилируемого приложения.
// В 32-bit версии получится получить пути только к 32-bit приложениям,
// выполняемым в 64-bit версии Windows.
function GetFullPathFromPID(PID: Cardinal): string;
var
  hProcess: THandle;
  ModName: array[0..MAX_PATH+1] of Char;
begin
  Result := '';

  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, PID);
  try
    if hProcess <> 0 then
    begin
      if GetModuleFileNameEx(hProcess, 0, ModName, Sizeof(ModName)) <> 0 then
        Result := ModName;
//      else
//         ShowMessage(SysErrorMessage(GetLastError));
    end;
  finally
    CloseHandle(hProcess);
  end;
end;

// Способ второй
// Функция вернет путь в виде "C:\..."
function QueryFullProcessImageName(hProcess: THandle; dwFlags: DWORD;
  lpExeName: PChar; nSize: PDWORD): BOOL; stdcall; external kernel32
  name 'QueryFullProcessImageName' + {$IFDEF UNICODE}'W'{$ELSE}'A'{$ENDIF};

function GetProcImageName(PID: Cardinal): string;
const
  PROCESS_QUERY_LIMITED_INFORMATION = $1000;
var
  hProcess: THandle;
  MaxLen: DWORD;
begin
  Result := '';

  hProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, PID);

  if (hProcess <> 0) and (hProcess <> INVALID_HANDLE_VALUE) then
  try
    MaxLen := MAX_PATH;
    SetLength(Result, MaxLen);

    if not QueryFullProcessImageName(hProcess, 0, PChar(Result), @MaxLen) then
      Result := '';
  finally
    CloseHandle(hProcess);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetProcImageName(4864));
end;

// Способ третий
// Функция вернет путь в виде "\Device\HarddiskVolume1\..."
function GetProcessImageFileName(hProcess: THandle; lpImageFileName: PChar;
  nSize: DWORD): BOOL; stdcall; external 'psapi.dll'
  name 'GetProcessImageFileName' + {$IFDEF UNICODE}'W'{$ELSE}'A'{$ENDIF};

function GetProcImageFileName(PID: Cardinal): string;
const
  PROCESS_QUERY_LIMITED_INFORMATION = $1000;
var
  hProcess: THandle;
  MaxLen: DWORD;
begin
  Result := '';

  hProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, PID);

  if (hProcess <> 0) and (hProcess <> INVALID_HANDLE_VALUE) then
  try
    MaxLen := MAX_PATH;
    SetLength(Result, MaxLen);

    if not GetProcessImageFileName(hProcess, PChar(Result), MaxLen) then
      Result := '';
  finally
    CloseHandle(hProcess);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetProcImageFileName(4864));
end;

// Способ четвертый
// Функция вернет путь в виде "C:\..."
function GetModuleFileNameEx(hProcess: THandle; hModule: THandle;
  lpFileName: PChar; nSize: PDWORD): BOOL; stdcall; external kernel32
  name 'QueryFullProcessImageName' + {$IFDEF UNICODE}'W'{$ELSE}'A'{$ENDIF};

// Если hModule равен 0, функция возвращает путь к исполняемому файлу процесса,
// указанного в hProcess, иначе возвращает путь к загруженному модулю.
function GetProcImageName(PID, hModule: Cardinal): string;
const
  PROCESS_QUERY_LIMITED_INFORMATION = $1000;
var
  hProcess: THandle;
  MaxLen: DWORD;
begin
  Result := '';

  hProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, PID);

  if (hProcess <> 0) and (hProcess <> INVALID_HANDLE_VALUE) then
  try
    MaxLen := MAX_PATH;
    SetLength(Result, MaxLen);

    if not GetModuleFileNameEx(hProcess, 0, PChar(Result), @MaxLen) then
      Result := '';
  finally
    CloseHandle(hProcess);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetProcImageName(4864, 0));
end;

Как получить имя исполняемого файла по PID процесса?


uses
  PsAPI;

// Результат работы функции зависит от разрядности компилируемого приложения.
// В 32-bit версии получится получить имя только для 32-bit приложений,
// выполняемых в 64-bit версии Windows.
function GetFileNameFromPID(PID: Cardinal): string;
var
  hProcess: THandle;
  ModName: array[0..MAX_PATH+1] of Char;
begin
  Result := '';

  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, PID);

  try
    if hProcess <> 0 then
    begin
      if GetModuleBaseName(hProcess, 0, ModName, Sizeof(ModName)) <> 0 then
        Result := ModName;
//      else
//        ShowMessage(SysErrorMessage(GetLastError));
    end;
  finally
    CloseHandle(hProcess);
  end;
end;

Как получить разрядность запущенного процесса по его PID?


function DetectWow64Process(PID: Cardinal): Boolean;
const
  PROCESS_QUERY_LIMITED_INFORMATION = $1000;
var
  hProcess: THandle;
  IsWow64: LongBool;
begin
  Result := False;

  hProcess := OpenProcess(PROCESS_ALL_ACCESS, False, PID);

  if hProcess = 0 then
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ or
                            PROCESS_VM_OPERATION, False, PID);

  if hProcess = 0 then
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, False, PID);

  if hProcess = 0 then
    hProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, PID);

  if (hProcess <> INVALID_HANDLE_VALUE) and (hProcess <> 0) then
  try
    if IsWow64Process(hProcess, IsWow64) then
      Result := not IsWow64;
  finally
    CloseHandle(hProcess);
  end;
end;

Как получить командную строку процесса?


// Способ первый
const
  STATUS_SUCCESS = 0;

type
  NTStatus = Cardinal;
  PPPointer = ^PPointer;

  PROCESS_INFORMATION_CLASS = (
    ProcessBasicInformation,
    ProcessQuotaLimits,
    ProcessIoCounters,
    ProcessVmCounters,
    ProcessTimes,
    ProcessBasePriority,
    ProcessRaisePriority,
    ProcessDebugPort,
    ProcessExceptionPort,
    ProcessAccessToken,
    ProcessLdtInformation,
    ProcessLdtSize,
    ProcessDefaultHardErrorMode,
    ProcessIoPortHandlers,
    ProcessPooledUsageAndLimits,
    ProcessWorkingSetWatch,
    ProcessUserModeIOPL,
    ProcessEnableAlignmentFaultFixup,
    ProcessPriorityClass,
    ProcessWx86Information,
    ProcessHandleCount,
    ProcessAffinityMask,
    ProcessPriorityBoost,
    MaxProcessInfoClass);

  UNICODE_STRING = record
    Length:Word;
    MaximumLength:Word;
    Buffer:PWideChar;
  end;

  RTL_DRIVE_LETTER_CURDIR = record
    Flags:Word;
    Length:Word;
    TimeStamp:Cardinal;
    DosPath:UNICODE_STRING;
  end;

  PPEB_FREE_BLOCK=^PEB_FREE_BLOCK;
  PEB_FREE_BLOCK=record
    Next: PPEB_FREE_BLOCK;
    Size: Cardinal;
  end;

  PPEB_LDR_DATA = ^PEB_LDR_DATA;
  PEB_LDR_DATA = record
    Length: Cardinal ;
    Initialized: Boolean;
    SsHandle: Pointer;
    InLoadOrderModuleList: LIST_ENTRY;
    InMemoryOrderModuleList: LIST_ENTRY;
    InInitializationOrderModuleList: LIST_ENTRY;
    EntryInProgress: Pointer;
  end;

  PRTL_USER_PROCESS_PARAMETERS = ^RTL_USER_PROCESS_PARAMETERS;
  RTL_USER_PROCESS_PARAMETERS = record
    MaximumLength: Cardinal;
    Length: Cardinal;
    Flags: Cardinal;
    DebugFlags: Cardinal;
    ConsoleHandle: Pointer;
    ConsoleFlags: Cardinal;
    StdInputHandle: Cardinal;
    StdOutputHandle: Cardinal;
    StdErrorHandle: Cardinal;
    CurrentDirectoryPath: UNICODE_STRING;
    CurrentDirectoryHandle: Cardinal;
    DllPath: UNICODE_STRING;
    ImagePathName: UNICODE_STRING;
    CommandLine: UNICODE_STRING;
    Environment: Pointer;
    StartingPositionLeft: Cardinal;
    StartingPositionTop: Cardinal;
    Width: Cardinal;
    Height: Cardinal;
    CharWidth: Cardinal;
    CharHeight: Cardinal;
    ConsoleTextAttributes: Cardinal;
    WindowFlags: Cardinal;
    ShowWindowFlags: Cardinal;
    WindowTitle: UNICODE_STRING;
    DesktopName: UNICODE_STRING;
    ShellInfo: UNICODE_STRING;
    RuntimeData: UNICODE_STRING;
    DLCurrentDirectory: array [0..$1F] of RTL_DRIVE_LETTER_CURDIR
  end;

  PPEB = ^PEB;
  PEB = record
    InheritedAddressSpace: Boolean;
    ReadImageFileExecOptions: Boolean;
    BeingDebugged: Boolean;
    Spare: Boolean;
    Mutant: Cardinal;
    ImageBaseAddress: Pointer;
    LoaderData: PPEB_LDR_DATA;
    ProcessParameters: PRTL_USER_PROCESS_PARAMETERS;
    SubSystemData: Pointer;
    ProcessHeap: Pointer;
    FastPebLock: Pointer;
    FastPebLockRoutine: Pointer;
    FastPebUnlockRoutine: Pointer;
    EnvironmentUpdateCount: Cardinal;
    KernelCallbackTable: PPointer;
    EventLogSection: Pointer;
    EventLog: Pointer;
    FreeList: PPEB_FREE_BLOCK;
    TlsExpansionCounter: Cardinal;
    TlsBitmap: Pointer;
    TlsBitmapBits: array[0..1] of Cardinal;
    ReadOnlySharedMemoryBase: Pointer;
    ReadOnlySharedMemoryHeap: Pointer;
    ReadOnlyStaticServerData: PPointer;
    AnsiCodePageData: Pointer;
    OemCodePageData: Pointer;
    UnicodeCaseTableData: Pointer;
    NumberOfProcessors: Cardinal;
    NtGlobalFlag: Cardinal;
    Spare2: array[0..3] of byte;
    CriticalSectionTimeout: LARGE_INTEGER;
    HeapSegmentReserve: Cardinal;
    HeapSegmentCommit: Cardinal;
    HeapDeCommitTotalFreeThreshold: Cardinal;
    HeapDeCommitFreeBlockThreshold: Cardinal;
    NumberOfHeaps: Cardinal;
    MaximumNumberOfHeaps: Cardinal;
    ProcessHeaps: PPPointer;
    GdiSharedHandleTable: Pointer;
    ProcessStarterHelper: Pointer;
    GdiDCAttributeList: Pointer;
    LoaderLock: Pointer;
    OSMajorVersion: Cardinal;
    OSMinorVersion: Cardinal;
    OSBuildNumber: Cardinal;
    OSPlatformId: Cardinal;
    ImageSubSystem: Cardinal;
    ImageSubSystemMajorVersion: Cardinal;
    ImageSubSystemMinorVersion: Cardinal;
    GdiHandleBuffer: array [0..$21] of Cardinal;
    PostProcessInitRoutine: Cardinal;
    TlsExpansionBitmap: Cardinal;
    TlsExpansionBitmapBits: array [0..$7F] of byte;
    SessionId: Cardinal;
  end;

  PPROCESS_BASIC_INFORAMTION = ^PROCESS_BASIC_INFORMATION;
  PROCESS_BASIC_INFORMATION = record
    ExitStatus: NTStatus;
    PebBaseAddress: PPEB;
    AffinityMask: PCardinal;
    BasePriority: Cardinal;
    uUniqueProcessId: Cardinal;
    uInheritedFromUniqueProcessId: Cardinal;
  end;

function NtQueryInformationProcess(ProcessHandle: Cardinal;
  ProcessInformationClass: PROCESS_INFORMATION_CLASS;
  ProcessInformation: Pointer;
  ProcessInformationLength: Cardinal;
  ReturnLength: PCardinal): NTStatus; stdcall; external 'ntdll.dll';

function GetProcessCmdLine(pid: Cardinal): string;
var
  hProcess: Cardinal;
  pProcBasicInfo: PROCESS_BASIC_INFORMATION;
  ReturnLength: DWORD;
  aPeb: PEB;
  ProcessParameters: RTL_USER_PROCESS_PARAMETERS;
  cb: NativeUInt;
  ws: WideString;
begin
  Result := '';

  if pid = 0 then
    Exit;

  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, pid);

  if hProcess <> 0 then
    if NtQueryInformationProcess(hProcess,ProcessBasicInformation, @pProcBasicInfo,
      SizeOf(PROCESS_BASIC_INFORMATION),@ReturnLength) = STATUS_SUCCESS then
    begin
      if ReadProcessMemory(hProcess, pProcBasicInfo.PebBaseAddress, @aPeb,
        SizeOf(PEB), cb) then
        if ReadProcessMemory(hProcess, aPeb.ProcessParameters,
          @ProcessParameters, SizeOf(ProcessParameters), cb) then
        begin
          SetLength(ws, ProcessParameters.CommandLine.Length div 2);
          if ReadProcessMemory(hProcess, ProcessParameters.CommandLine.Buffer,
            PWideChar(ws), ProcessParameters.CommandLine.Length, cb) then
            Result := ws;
        end;
    end;
  Closehandle(hProcess);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetProcessCmdLine(9648));
end;

// Способ второй
type
  NTSTATUS = Integer;

  PROCESS_BASIC_INFORMATION = packed record
    Reserved1: UINT64;
    PebBaseAddress: UINT64;
    Reserved2: array [0..1] of UINT64;
    UniqueProcessId: UINT64;
    Reserved3: UINT64;
  end;

  PPROCESS_BASIC_INFORMATION = ^PROCESS_BASIC_INFORMATION;

  TNtQueryInformationProcess = function(ProcessHandle: THANDLE; ProcessInformationClass:
    ULONG; ProcessInformation: Pointer; ProcessInformationLength: ULONG;
    ReturnLength: Pointer): NTSTATUS; stdcall;
  TNtReadVirtualMemory = function(ProcessHandle: THANDLE; BaseAddress: UINT64;
    Buffer: Pointer; BufferLength: UINT64; ReturnLength: Pointer): NTSTATUS; stdcall;

var
  NtQueryInformationProcess: TNtQueryInformationProcess;
  NtReadVirtualMemory: TNtReadVirtualMemory;

//function AddCurrentProcessPrivilege(PrivilegeName: WideString): Boolean;
//var
//  TokenHandle: THandle;
//  TokenPrivileges: TTokenPrivileges;
//  ReturnLength: Cardinal;
//begin
//   Result := False;
//   if OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TokenHandle) then
//   try
//      LookupPrivilegeValueW(nil, PWideChar(PrivilegeName), TokenPrivileges.Privileges[0].Luid);
//      TokenPrivileges.PrivilegeCount := 1;
//      TokenPrivileges.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
//      if AdjustTokenPrivileges(TokenHandle, False, TokenPrivileges, 0, nil, ReturnLength) then
//         Result := True;
//   finally
//      CloseHandle(TokenHandle);
//   end;
//end;

function GetCommandLineFromPID(PID: Cardinal): string;
var
  hLibrary: HMODULE;
  ProcessHandle: THandle;
  PBI: PROCESS_BASIC_INFORMATION;
  ReturnLength: UINT64;
  Buffer: UINT64;
  Data: array [0..MAX_PATH-1] of Char;
begin
  Result := '';
//  AddCurrentProcessPrivilege('SeDebugPrivilege');

  hLibrary := LoadLibrary('ntdll.dll');

  if hLibrary <> 0 then
  begin
    @NtQueryInformationProcess := GetProcAddress(hLibrary, 'NtWow64QueryInformationProcess64');
    @NtReadVirtualMemory := GetProcAddress(hLibrary, 'NtWow64ReadVirtualMemory64');
  end;

  ProcessHandle:= OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, True, PID);

  if NtQueryInformationProcess(ProcessHandle, 0, @PBI, SizeOf(PBI), nil) = 0 then
  begin
    if NtReadVirtualMemory(ProcessHandle, PBI.PebBaseAddress + $20, @Buffer,
      SizeOf(Buffer), @ReturnLength) = 0 then
    begin
      if NtReadVirtualMemory(ProcessHandle, Buffer + $78, @Buffer, SizeOf(Buffer),
        @ReturnLength) = 0 then
      begin
        if NtReadVirtualMemory(ProcessHandle, Buffer, @Data, SizeOf(Data),
          @ReturnLength) = 0 then
          Result := String(Data);
      end;
    end;
  end;
end;

При использовании материала - ссылка на сайт обязательна