I commented the code as much as possible, you also have a small homework. Feel free to ask questions(if you have any).
Here you go:
program Project1;
{$mode objfpc}{$H+}
{$DEFINE UseCThreads}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes,
SysUtils,
JwaTlHelp32,
Windows,
Process;
const
UniqueString = 'ThisIsJustAUniqueString';
type
PProcessData = ^TProcessData;
TProcessData = packed record
PID : DWORD;
mstscPID: DWORD;
Description: String[100];
LastActive: DWORD;
hFileMap: HANDLE;
//you can add other data here
end;
function ReadData(const FileMapName: string; var ProcessData: TProcessData): Boolean;
var
hFileMap: HANDLE;
pPProcessData: PProcessData;
begin
Result := False;
hFileMap := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(FileMapName));
if (hFileMap = 0) then
Exit;
pPProcessData := MapViewOfFile(hFileMap, FILE_MAP_ALL_ACCESS, 0, 0, 0);
if (pPProcessData = nil) then
Exit;
ProcessData.PID := pPProcessData^.PID;
ProcessData.mstscPID := pPProcessData^.mstscPID;
ProcessData.Description := pPProcessData^.Description;
ProcessData.LastActive := pPProcessData^.LastActive;
ProcessData.hFileMap := pPProcessData^.hFileMap;
UnmapViewOfFile(pPProcessData);
Result := True;
end;
function WriteData(const hFileMap: HANDLE; const ProcessData: TProcessData): Boolean;
var
pPProcessData: PProcessData;
begin
Result := False;
if (hFileMap = 0) then
Exit;
pPProcessData := MapViewOfFile(hFileMap, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TProcessData));
if (pPProcessData = nil) then
Exit;
pPProcessData^.PID := ProcessData.PID;
pPProcessData^.mstscPID := ProcessData.mstscPID;
pPProcessData^.Description := ProcessData.Description;
pPProcessData^.LastActive := ProcessData.LastActive;
pPProcessData^.hFileMap := ProcessData.hFileMap;
UnmapViewOfFile(pPProcessData);
Result := True;
end;
function CheckMstscStatus(PID: DWORD): Boolean;
var
pProc: TProcessEntry32;
pSnap: THandle;
pBool: BOOL;
begin
Result := False;
pProc.dwSize := SizeOf(pProc);
pSnap := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
pBool := Process32First(pSnap, pProc);
while Integer(pBool) <> 0 do
begin
if pProc.th32ProcessID = PID then
begin
//HOMEWORK --> MSTSC is running, check if is alive...
//Result := IsMstscAlive;
Result := True;
Break;
end;
pBool := Process32Next(pSnap, pProc);
end;
CloseHandle(pSnap);
end;
function KillProcess(PID: DWORD): Boolean;
var
hProcess : HANDLE;
begin
Result := False;
hProcess := OpenProcess(PROCESS_TERMINATE, False, PID);
if hProcess > 0 then
try
Result := Win32Check(Windows.TerminateProcess(hProcess, 0));
finally
CloseHandle(hProcess);
end;
end;
function CheckIfProcessAlive(const FileMapName: string; const ProcessData: TProcessData): Boolean;
var
New_ProcessData: TProcessData;
IsMstscAlive: Boolean;
begin
Result := False;
Sleep(2000);//give a chance to the process to update itself
if ReadData(FileMapName, New_ProcessData) then
begin
//MessageBox(0, PChar(IntToStr(ProcessData.LastActive) + sLineBreak + IntToStr(New_ProcessData.LastActive)), PChar('test'), 0);
IsMstscAlive := CheckMstscStatus(ProcessData.mstscPID);
Result := (ProcessData.LastActive <> New_ProcessData.LastActive) and (IsMstscAlive)
end;
end;
procedure FindPreviouslyStartedProcesses(CurPID: DWord);
var
pProc: TProcessEntry32;
pSnap: THandle;
pBool: BOOL;
FileMapName: String;
ProcessData: TProcessData;
begin
pProc.dwSize := SizeOf(pProc);
pSnap := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
pBool := Process32First(pSnap, pProc);
while (Integer(pBool) <> 0) do
begin
FileMapName := UniqueString + IntToStr(pProc.th32ProcessID);
if (pProc.th32ProcessID <> CurPID) then
begin
FileMapName := UniqueString + IntToStr(pProc.th32ProcessID);
if ReadData(FileMapName, ProcessData) then //previously started process
begin
if not CheckIfProcessAlive(FileMapName, ProcessData) then //dead is in the air
begin
KillProcess(ProcessData.PID);
KillProcess(ProcessData.mstscPID);
//do whatever you have to do in case of process freeze(write to db... you got ProcessData.Description)
CloseHandle(ProcessData.hFileMap); //close handle of the memory mapp
end;
end;
end;
pBool := Process32Next(pSnap, pProc);
end;
end;
var
FileMapName: String;
hFileMap: HANDLE;
ProcessData: TProcessData;
Proc: TProcess;
CurPID: DWORD;
begin
//Current process id
CurPID := GetProcessID;
//This will uniquely identify your process memory mapped file
FileMapName := UniqueString + IntToStr(CurPID);
//find previous processes, kill them if necessary
FindPreviouslyStartedProcesses(CurPID);
//create a file mapp for this process
hFileMap := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(TProcessData), PChar(FileMapName));
if hFileMap <> 0 then
begin
//init then execute your TProcess
Proc := TProcess.Create(nil);
Proc.CommandLine := 'notepad.exe'; //I just start notepad for testing purposes, change this line
Proc.Execute;
//fill our process data
ProcessData.PID := CurPID;
ProcessData.Description := 'add connection data here';
ProcessData.mstscPID := Proc.ProcessID;
ProcessData.hFileMap := hFileMap;
while Proc.Active do
begin
Sleep(1000);
ProcessData.LastActive := GetTickCount;
WriteData(hFileMap, ProcessData);
end;
//cleanup
Proc.Free;
CloseHandle(hFileMap);
end;
end.
PS: Some of the functions needs elevated privileges(run your program as admin, if possible).
Recent
