Add a unique id within exe

[timcs]

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:

Code: [Select]

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).

Thanks Engkin! , I did start working on finding and then getting the parameters myself, got as far as finding the process but the code I had tried to use for getting the parameters  didn't work so I will look at this code

** EDIT **

 just started reading this and it looks like it is trying to look for the mstsc process. Instead I need to look for my process with parameters it has. As there are going to be several of my processes open , I need to look through each one to see if the parameters they have match the newly started version of my process . Is this possible ?

My current find code does this:

Code: [Select]

var
  Form1: TForm1;
   i: integer;
  CPID: DWORD;
  CProcName: array[0..259] of char;
  S: HANDLE;
  PE: TProcessEntry32;


implementation




{$R *.lfm}

function FindInProcesses(const PName: string): DWord;
  // Looks for process with PName executable and return
var
  i: integer;
  CPID: DWORD;
  CProcName: array[0..259] of char;
  S: HANDLE;
  PE: TProcessEntry32;
begin
  Result := 0;
  CProcName := '';
  S := CreateToolHelp32Snapshot(TH32CS_SNAPALL, 0); // Create snapshot
  PE.DWSize := SizeOf(PE); // Set size before use
  I := 1;
  if Process32First(S, PE) then
    repeat
      CProcName := PE.szExeFile;
      CPID := PE.th32ProcessID;
      //if CProcName = '' then Writeln(IntToStr(i) + ' - (' + IntToStr(CPID) + ') Failed to get a process name')
      Inc(i);
      if UpperCase(CProcName) = UpperCase(PName) then
        { Found the name. Set Result to the PID of process found }
        Result := CPID;
    until not Process32Next(S, PE);
  CloseHandle(S);
end;                                     

This is then called as a test by a button :

Code: [Select]

procedure TForm1.Button1Click(Sender: TObject);

begin
     
      label1.caption := IntToStr(FindInProcesses('notepad.exe'));
     
end;                                                               
I  then found this code on the net :

Code: [Select]

function  GetCommandLineFromPid(ProcessId:DWORD): string;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
begin;
  Result:='';
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  //if the pid not exist a EOleException exception will be raised with the code $80041002 - Object Not Found
  FWbemObjectSet:= FWMIService.Get(Format('Win32_Process.Handle="%d"',[ProcessId]));
  Result:=FWbemObjectSet.CommandLine;
end;               
But on calling it it errors so as I do not know how this code works I am unsure of how to fix it

Thanks

TimCS

[engkin]

Thanks Engkin!

You mean GetMem!

[flamer0n]

looking at this

FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');

this [WbemScripting.SWbemLocator] seems like a ComObject/ActiveX and you must have it registered/installed on your machine in order to use it

[balazsszekely]

@timcs
 just started reading this and it looks like it is trying to look for the mstsc process.

Please at least take the minimal effort to study that code!
Each time your exe starts, it creates a memory mapped file. While the mstsc started by your exe is running, the memory mapped file is updated.
When a new instance of your program starts, all memory mapped files are scanned, if the programs find a memory mapped file that was not updated(one of your previous exe is not responding) it kills that exe. It also checks for mstsc, all you have to implement is a method to determine if the mstsc is not responding(the program checks if it's running).

Basically everything is implemented for you.

[timcs]

@timcs
 just started reading this and it looks like it is trying to look for the mstsc process.

Please at least take the minimal effort to study that code!
Each time your exe starts, it creates a memory mapped file. While the mstsc started by your exe is running, the memory mapped file is updated.
When a new instance of your program starts, all memory mapped files are scanned, if the programs find a memory mapped file that was not updated(one of your previous exe is not responding) it kills that exe. It also checks for mstsc, all you have to implement is a method to determine if the mstsc is not responding(the program checks if it's running).

Basically everything is implemented for you.

Hi GetMem first off all sorry I meant to say thank you to you .Secondly I did start reading the code but I have to say I was on a short break but it did confuse me not being that knowledgeable with this side of coding .

I think I would like to try and find my program with the parameters it starts with but I am struggling with that too ! Just to make you all aware I am appreciating the help you all are providing   However I will give you code another read later GetMem

Thanks

TimCS

[timcs]

Hi GetMem
   
 
One question on your code, how does it identify the different processes that could be running of my program and the mstsc ?

Thanks

TimCS

[balazsszekely]

I think I would like to try and find my program with the parameters it starts!

One question on your code, how does it identify the different processes that could be running of my program and the mstsc ?

You have a description field. You can rename it to whatever your like:

Code: [Select]

var
 I: Integer;
 Params: String; 
begin
   // ...
   for I := 1 to ParamCount do
      Params := Params + '  ' + ParamStr(I);         
    ProcessData.PID := CurPID;  //your processid
    ProcessData.Description := Params;    //params
    ProcessData.mstscPID := Proc.ProcessID; //mstsc processid started by your process
    ProcessData.hFileMap := hFileMap;  //handle to memory mapped file
    ProcessData.LastActive := GetTickCount; //last active

   //...
end.

So basically it looks like this(don't forget LastActive1, LastActive2 ,..is updated every second or so):

YourProcess1--->MemoryMappedFile1-->ProcessData1(PID1, Params1, mstscPID1, hFileMap1, LastActive1)
YourProcess2--->MemoryMappedFile2-->ProcessData2(PID2, Params2, mstscPID2, hFileMap2, LastActive2)
...

When  your bat file starts process i(  i = [1...n]  ), then process i will loop through MemoryMappedFile1, MemoryMappedFile2, ....
Now MemoryFile1 contains all info about YourProcess1(even your beloved parameters)

Hope this helps!

[timcs]

I think I would like to try and find my program with the parameters it starts!

One question on your code, how does it identify the different processes that could be running of my program and the mstsc ?

You have a description field. You can rename it to whatever your like:

Code: [Select]

var
 I: Integer;
 Params: String; 
begin
   // ...
   for I := 1 to ParamCount do
      Params := Params + '  ' + ParamStr(I);         
    ProcessData.PID := CurPID;  //your processid
    ProcessData.Description := Params;    //params
    ProcessData.mstscPID := Proc.ProcessID; //mstsc processid started by your process
    ProcessData.hFileMap := hFileMap;  //handle to memory mapped file
    ProcessData.LastActive := GetTickCount; //last active

   //...
end.

So basically it looks like this(don't forget LastActive1, LastActive2 ,..is updated every second or so):

YourProcess1--->MemoryMappedFile1-->ProcessData1(PID1, Params1, mstscPID1, hFileMap1, LastActive1)
YourProcess2--->MemoryMappedFile2-->ProcessData2(PID2, Params2, mstscPID2, hFileMap2, LastActive2)
...

When  your bat file starts process i(  i = [1...n]  ), then process i will loop through MemoryMappedFile1, MemoryMappedFile2, ....
Now MemoryFile1 contains all info about YourProcess1(even your beloved parameters)

Hope this helps!

Hi GetMem I think I understand that  will have to try and get my head around this all. If I have read the code correctly this time , does this mean I am not using the TProcess object to start the mstsc program?

Thanks

TimCS

[ausdigi]

I've read this thread and my head hurts because I still don't know exactly what is going on.

This is my understanding of it:

• TimCS' application is launched via web requests and thus there may be multiple instances running simultanously.
• TimCS' application launches Microsoft's mstsc.exe, which may take some time.
• TimCS only wants to call mstsc.exe one at a time.
• TimCS' and/or mstsc sometimes crash?

Why not just look for the presence of mstsc.exe before trying to start another one? There is the potential of a race condition, but that may be happening now with the database logging method anyway, so you need to be using some sort of cross-process synchronization mechanism (like Mutexes).

If you still think you need to get parameters from other instances of your app you have to make some API calls like the ones used in this C++ answer I just found quickly (Delphi code may already exist for this).

My understanding is you are just trying to lock/disable multiple instances of mstsc.exe so why not just look for such an exe running and use a Mutex? You can still log stuff in the database if you want and you won't care if the end time is blank or not. You can find parent/calling processes with API calls so you could determine if any mstsc.exe processes were called by one of your app instances.

[timcs]

I've read this thread and my head hurts because I still don't know exactly what is going on.

This is my understanding of it:

• TimCS' application is launched via web requests and thus there may be multiple instances running simultanously.
• TimCS' application launches Microsoft's mstsc.exe, which may take some time.
• TimCS only wants to call mstsc.exe one at a time.
• TimCS' and/or mstsc sometimes crash?

Why not just look for the presence of mstsc.exe before trying to start another one? There is the potential of a race condition, but that may be happening now with the database logging method anyway, so you need to be using some sort of cross-process synchronization mechanism (like Mutexes).

If you still think you need to get parameters from other instances of your app you have to make some API calls like the ones used in this C++ answer I just found quickly (Delphi code may already exist for this).

My understanding is you are just trying to lock/disable multiple instances of mstsc.exe so why not just look for such an exe running and use a Mutex? You can still log stuff in the database if you want and you won't care if the end time is blank or not. You can find parent/calling processes with API calls so you could determine if any mstsc.exe processes were called by one of your app instances.

Almost there ausdigi  with what I am after and my head still hurts from this all too .

For each site that the user can access they click on a internal web link which starts my program and inturn starts the mstsc with paramters to make the connection. Then the same user could click on another site link at the same time which also starts another instance of my program with another mstsc and the paramters for that link.

So what I would like to be able to do is if the user clicks on a link which they used earlier in the day and there is a stuck instances of mstsc with the same parameters, the new instance can find and close this program down. If you code you have provided a link for C++ does this then great but I would need to know how to convert that to delphi/lazarus .

** EDIT **

 Briefly read the link and some of the code looks a little like the code from the below link but I have tried this code and I get an error. On mentioning this here , it was suggested that as this uses activex , certain files would need registering :

https://theroadtodelphi.wordpress.com/2011/07/20/two-ways-to-get-the-command-line-of-another-process-using-delphi/

Thanks

TimCS

[timcs]

Reading the post from GetMem on dealing with the stuck processes, I noticed the mentioned of admin rights required for some of this code to work.

Does this mean that the user has to be a local admin ? if so this will cause an issue as due to control over our PCs and the network users generally do not have admin rights

Thanks

TimCS

[timcs]

Hi again

  Been doing some testing with just the Tprocess at the moment and reading ideas here and also examples on the lazarus wiki page on various ways of running and checking for a process I put together a simple program and it starts and checks fro notepad. When Notepad starts my program hides the form and when notepad finishes the form shows :

Code: [Select]

StartP := TProcess.create(nil);
     Startp.Executable := 'notepad.exe';
     startp.Options := [poUsePipes];
     startp.Execute;
     form1.Hide;

     while true do
     begin
            if startp.Running then
              begin
                sleep(1000)
              end
              else
              begin
                  break;
              end;

     end;
      form1.show;                 

This works fine but if I start mstsc my form shows before mstsc has been closed down. I stumbled across a web page stating that mstsc can then start an additional instance of itself or call another version when it begins. So if this is the case, how would my program know it has not finished and how did the waitonexit method work slightly better than the above ?

Thanks

TimCS