Delphi, Asm, C, WinAPI, PHP, ..., FAQ Опции

[-=CHE@TER=-]

Delphi programs in API.
На английском.
Очень подробно всё описано, плюс есть исходные коды готовых юнитов.
Например SmallUtil, в котором есть все частоиспользуемые подпрограммы, и который в размере меньше, чем SysUtils (автор так утверждает - я не проверял).

[-=CHE@TER=-]

Вот код тру перезапускалки:

CODE

Program WHungApp;

Uses Windows;

Function IsHungAppWindow(Wnd: hWnd): BOOL; stdcall; external 'user32.dll' name 'IsHungAppWindow';
Function GetModuleFileNameEx(hProcess: THandle; hModule: HMODULE; lpFilename: PAnsiChar; nSize: DWORD): DWORD; stdcall; external 'psapi.dll' name 'GetModuleFileNameExA';
Function NtQueryInformationProcess(ProcessHandle: THandle; ProcessInformationClass: Byte; ProcessInformation: Pointer; ProcessInformationLength: ULONG; ReturnLength: PULONG): DWORD; stdcall; external 'ntdll.dll' name 'NtQueryInformationProcess';

// Как по PID процесса узнать CMDLINE?, то есть, командную строку?
// http://forum.sources.ru/index.php?showtopic=136611
// http://undocumented.ntinternals.net/

// http://forum.sources.ru/index.php?showtopic=243663
Type

  UNICODE_STRING = Packed Record
    Length       : Word;
    MaximumLength: Word;
    Buffer       : PWideString;
  end;

  PROCESS_BASIC_INFORMATION = Packed Record
    ExitStatus    : DWORD;
    PebBaseAddress: DWORD; // PPEB
    AffinityMask  : DWORD;
    BasePriority  : DWORD;
    uUniqueProcessId: ULong;
    uInheritedFromUniqueProcessId: ULong;
  End;

Function GetProcessCmdLine(hProcess: THandle): String;
Var
       PBI: PROCESS_BASIC_INFORMATION;
    pp, cb: DWORD;
        ws: WideString;
        uz: UNICODE_STRING;
Begin
  Result:='';
  If (NtQueryInformationProcess(hProcess, 0{ProcessBasicInformation},
                               @PBI, SizeOf(PROCESS_BASIC_INFORMATION),
                               @cb) = 0) Then
    Begin
      If ReadProcessMemory(hProcess, Ptr(PBI.PebBaseAddress+16), @pp, 4, cb) Then
        If ReadProcessMemory(hProcess, Ptr(pp+64), @uz, SizeOf(UNICODE_STRING), cb) Then
          Begin
            SetLength(ws, uz.Length Div 2);
            If ReadProcessMemory(hProcess, uz.Buffer, PWideChar(ws), uz.Length, cb) Then
              Result:=AnsiString(ws);
          End;
    End;
End;

Procedure WriteLog(S: String);
Var
    Fl: THandle;
    dw: DWORD;
Begin
  Fl:=CreateFile(PChar(ParamStr(0)+'.log'), GENERIC_WRITE Or GENERIC_READ, 0, Nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  If Fl <> INVALID_HANDLE_VALUE Then
    Begin
      SetFilePointer(Fl, 0, Nil, FILE_END);
      WriteFile(Fl, S[1], Length(S), dw, Nil);
      CloseHandle(Fl);
    End;
End;

Function GetDateTime: String;
Begin
  SetLength(result, 19);
  GetDateFormat(LOCALE_SYSTEM_DEFAULT, 0, Nil, 'yyyy.MM.dd', @result[1], 10);
  GetTimeFormat(LOCALE_SYSTEM_DEFAULT, 0, Nil, 'HH:mm:ss', @result[12], 8);
  result[11]:=#32;
End;

Function EnumWindowsProc(Wnd: hWnd; lparam: LPARAM): BOOL; stdcall;
Var
      pid: DWORD;
       ph: THandle;
     S, C: String;
    PInfo: TProcessInformation;
    SInfo: TStartupInfo;
Begin
  If IsHungAppWindow(Wnd) Then
    Begin
      GetWindowThreadProcessId(Wnd, @pid);
      ph:=OpenProcess(PROCESS_ALL_ACCESS, False, pid);
      If ph<>0 Then
        Begin
          SetLength(S, MAX_PATH);
          SetLength(S, GetModuleFileNameEx(ph, 0, @S[1], MAX_PATH));
          C:=GetProcessCmdLine(ph);
          If Pos('"', C)<>0 Then
            Begin
              C[1]:='_';
              Delete(C, 1, Pos('"', C)+1);
            End
          Else
            Begin
              If Pos('  ', C)<>0 Then
                Delete(C, 1, Pos('  ', C)+1);
            End;
          S:='"'+S+'" '+C;
          WriteLog(GetDateTime+#32+S+#13#10);
          // terminate process
          TerminateProcess(ph, 0);
          CloseHandle(ph);
          // restart process
          FillChar(SInfo, SizeOf(SInfo), 0);
          SInfo.cb:=SizeOf(SInfo);
          CreateProcess(Nil, PChar(S), Nil, Nil, False, 0, Nil, Nil, SInfo, PInfo);
          CloseHandle(PInfo.hThread);
          CloseHandle(PInfo.hProcess);
        End;
    End;
  Result:=True;
End;

Begin
  EnumWindows(@EnumWindowsProc, 0);
End.