08
Jul 09

Delphi: Utils :: AppRunningCount

:: articles :: by Gilberto Saraiva

Folks,

For everybody thats need to limit the instance number of your application:

 Delphi |  copy code |? 
01
uses SysUtils, TLHelp32;
02
 
03
function AppRunningCount(const AExeName: string): integer;
04
var
05
  hSnap: THandle;
06
  p32: TProcessEntry32;
07
begin
08
  Result := 0;
09
  hSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
10
  p32.dwSize := Sizeof(TProcessEntry32);
11
  Process32First(hSnap, p32);
12
  repeat
13
    if SameText(AExeName, ExtractFileName(p32.szExeFile)) then
14
      inc(Result);
15
  until not Process32Next(hSnap, p32);
16
  CloseHandle(hSnap);
17
end;

Use:

 Delphi |  copy code |? 
1
// On DPR
2
// Limit to 1 instance
3
begin 
4
  if AppRunningCount(ExtractFileName(ParamStr(0))) = 1 then
5
  begin
6
  // Application codes
7
  end;
8
end.
9


Explaining more about this approach:

In a situation of multiples logons at the same machine the Mutex cannot provide a correctly singleton structure because the mutex handle still only under the local scope of the user. So the way to control the instance number is counting the number of times the process appear on the process list of the machine.

          

          

          articles —   No comments

				

			

					

			  
03
Jul 08

				
Delphi: Utils :: WalkOnHandles

        
:: articles :: by Gilberto Saraiva


				

					
Folks,


A light for everybody. First of all, I’ll use two other usefull functions I posted on this site:


  • GetHwndClass
    • 

  • GetHwndText
    • 

    And now the magic:
    

     Delphi |  copy code |? 
    01
    uses Windows, TLHelp32;
    02
     
    03
    type
    04
      TWalkOnHandlesCallback = function(AHwnd, AParentHWnd: HWND;
    05
        AClass, AText: string; AFlag: Integer): boolean of object;
    06
     
    07
    function WalkOnHandles(AParent: HWND; AFlag: integer;
    08
      ACallback: TWalkOnHandlesCallback): Integer;
    09
    var
    10
      CurrHWnd: HWND;
    11
    begin
    12
      Result := 0;
    13
      CurrHWnd := GetTopWindow(AParent);
    14
      while CurrHWnd <> 0 do
    15
      begin
    16
        Result := Result + 1;
    17
        if Assigned(ACallback) then
    18
          if not ACallback(CurrHWnd, AParent,
    19
            GetHwndClass(CurrHWnd), GetHwndText(CurrHWnd), AFlag) then
    20
            Break;
    21
        CurrHWnd := GetNextWindow(CurrHWnd, GW_HWNDNEXT);
    22
      end;
    23
    end;
    24
     
    25
    function WalkOnHandlesOfExe(AExeName: string; AFlag: integer;
    26
      ACallback: TWalkOnHandlesCallback): Integer;
    27
    var
    28
      PID, CheckPID: DWord;
    29
      hSnapShot: THandle;
    30
      ProcessEntry: TProcessEntry32;
    31
      CurrHWnd: HWND;
    32
    begin
    33
      Result := 0;
    34
      PID := 0;
    35
      hSnapShot := CreateToolhelp32Snapshot((TH32CS_SNAPALL), 0);
    36
      ProcessEntry.dwSize := SizeOf(TProcessEntry32);
    37
      Process32First(hSnapShot, ProcessEntry);
    38
      repeat
    39
        if ProcessEntry.szExeFile = AExeName then
    40
        begin
    41
          PID := ProcessEntry.th32ProcessID;
    42
          Break;
    43
        end;
    44
      until Process32Next(hSnapShot, ProcessEntry) = false;
    45
      CloseHandle(hSnapShot);
    46
     
    47
      if PID > 0 then
    48
      begin
    49
        CurrHWnd := GetTopWindow(GetDesktopWindow);
    50
        while CurrHWnd <> 0 do
    51
        begin
    52
          Result := Result + 1;
    53
          GetWindowThreadProcessID(CurrHWnd, @CheckPID);
    54
          if CheckPID = PID then
    55
            if Assigned(ACallback) then
    56
              if not ACallback(CurrHWnd, 0,
    57
                GetHwndClass(CurrHWnd), GetHwndText(CurrHWnd), AFlag) then
    58
                Break;
    59
          CurrHWnd := GetNextWindow(CurrHWnd, GW_HWNDNEXT);
    60
        end;
    61
      end;
    62
    end;
    

    Now let me explain what this big code do.
    

    This code its only a light, a simple idea, about how you can navigate through the Windows Objects (Handle) from everywhere.
    

    A simple example:
    

  • Create a TMemo named mmoLog
    • 

  • Link OnCreate of the Main Form
    • 

  • Create a the callback on the Main Form class
    • 

     Delphi |  copy code |? 
    01
    02
      TForm1 = class(TForm)
    03
        mmoLog: TMemo;
    04
        procedure FormCreate(Sender: TObject);
    05
      private
    06
        { Private declarations }
    07
      public
    08
        function WalkCall(AHwnd, AParentHWnd: HWND;
    09
          AClass, AText: string; AFlag: Integer): boolean;
    10
      end;
    11

    
The rest of the code:
    

     Delphi |  copy code |? 
    01
    02
    procedure TForm1.FormCreate(Sender: TObject);
    03
    begin
    04
      WalkOnHandlesOfExe('delphi32.exe', 0, WalkCall);
    05
    end;
    06
     
    07
    function TForm1.WalkCall(AHwnd, AParentHWnd: HWND; AClass,
    08
      AText: string; AFlag: Integer): boolean;
    09
    begin
    10
      Result := True;
    11
      mmoLog.Lines.Add(stringofChar(' ', AFlag)  + Format('%d: [ %s ] %s', [AHwnd, AClass, AText]));
    12
      WalkOnHandles(AHwnd, AFlag + 2, WalkCall);
    13
    end;
    14
    

    This example will list all Windows Objects on the Delphi application and will result a idented log on the mmoLog. 
    

    Simple uhm?
    

  • WalkOnHandles
    
Walk on all handles by the Z-order of the specified Parent.

    • 

  • WalkOnHandlesOfExe
    
Walk on all handles by the Z-order that have DesktopWindow as parent and the Application as owner.

    • 
          
    
          
    
          articles —   3 comments