How to guard against re-injecting processes in Delphi

Related to article about changing dialog boxes here

You may want some code to protect you system from injecting the same process more than once  this can cause your target application to die in a ball of flames.

One way of checking is to create a system directory called something like WindowsPIDS (windows process iDs) this allows you to keep a track of those processess that are executed every day. I think that Linux has some sort of system like this, you can even extend it to a jeornalling files system if you wanted.

firstly you can use the Delphi date command and create a directory with it. This use genEnvVar this get the environmental variable called SystemRoot which is the main root directory for system files on the computer. In the case of 2000 pro on my machine it is d:\winnt

dirstring := getenvvar('systemroot')+'\Windowpids\'+replacechars(datetostr(date),'/','A');
 

Note i replace the normal date slashes (/) with the A character this makes a correct directory name

ie 1/2/09  will become 1A2A09 so can be used as a string to create a directory with.(can't use slashes in dir paths)

Why is this necessary? Because we wand to delete the PIDS once a day and not create too many files on the hard

drive . Ok now we have a directory we need a file with the name of the process we can add some warning text to the

file to let the user know why its on the system. Ok now we check if the directory exists if it doesn't then clean any other old directory on system.

Heres a picture of the windowsPIDS directory with date created filename and pid files  ( to break up the text monotony)

Why use files instead of a INI file or something like the registry? because these can get locked by the program if it is being used by another process but the filesystem has inbuilt Mutex so we take advantage ot that (rest of this article is code fragments for Delphi related to this text) we can now check and inject the process even if the previous instance of the injecter is locked up in some way.

procedure writepid(pid: integer);

var
F1TextFile: textfile;
xyz ,dirstring: string ;

begin      // credits to delphi basics website for this code help notes
           // on basic file loading and writing techniques
           //http://www.delphibasics.co.uk/RTL.asp?Name=ReWrite

dirstring := getenvvar('systemroot')+'\Windowpids\'+replacechars(datetostr(date),'/','A');

if not directoryexists(getenvvar('systemroot')+'\Windowpids') then
     createdir(getenvvar('systemroot')+'\Windowpids');

if not directoryexists(dirstring) then
   begin
   cleanfiles(getenvvar('systemroot')+'\Windowpids');
   end;
createdir(dirstring);
xyz := inttostr(pid);
xyz := dirstring+'\'+xyz;
if not fileexists(xyz) then
   begin
        try
        assignfile(F1Textfile, xyz);
        ReWrite(F1Textfile);
        write(f1textfile,xyz);//+' = window handle this file is needed in this directory to ensure operation of the hookmanager program please dont delete unless you know why:)');
         finally
        closefile(f1textfile);
        end;
    end;

end;

//Once a day we want to clean the PIDS from the system we do this with the cleanfiles routine

// delete the previous dated directory after we remove all the PID files it contains

 

procedure cleanfiles(dir: string);
var
   searchResult : TSearchRec;
   deletedir: string;

begin

if FindFirst(dir+'\*',faDirectory,searchresult) = 0 then
begin
   repeat
//showmessage('dir found'+searchresult.Name);
if (searchresult.Name <> '.') and (searchresult.name <> '..') then
        begin
                deletedir := dir+'\'+searchresult.name;
                chdir(deletedir);
                 if FindFirst('*', faAnyFile, searchResult) = 0 then
                        begin
                                repeat
                                //ShowMessage('File name = '+searchResult.Name);
                                //ShowMessage('File size = '+IntToStr(searchResult.Size));
                                if (searchresult.Name <> '.') and (searchresult.name <> '..') then
                                  deletefile(searchresult.Name);
                                until FindNext(searchResult) <> 0;
                                 FindClose(searchResult);
                                end;
                     //   until FindNext(searchResult) <> 0;
    // Must free up resources used by these successful finds

                chdir('..');
                rmdir(deletedir);
                end;
          until FindNext(searchResult) <> 0;
        end;

   findclose(searchResult);
   end;


// check process ID if found return true

function checkPidIsFound(pid: integer): boolean;
var
searchResult : TSearchRec;
dirstring: string;
  begin
    result := false;
        dirstring := getenvvar('systemroot')+'\Windowpids\'+replacechars(datetostr(date),'/','A');
       if not directoryexists(dirstring) then
       exit
       else
       begin // start checking files for match
          if FindFirst(dirstring+'\*',faAnyFile,searchresult) = 0 then
             repeat
                                //ShowMessage('File name = '+searchResult.Name);
                                //ShowMessage('File size = '+IntToStr(searchResult.Size));
                                if (searchresult.Name = inttostr(pid))  then
                                                begin
                                                result := true;
                                                exit;
                                                end;
                                until FindNext(searchResult) <> 0;
                                 FindClose(searchResult);
       end;

      

end;