?
Solved

synchronize processes

Posted on 2008-11-13
4
Medium Priority
?
272 Views
Last Modified: 2012-05-05
Hi Experts,

Is there any way to synchronize procedures in different processes ?

eg:

I have a program with a procedure MyProcedure, so I run this program 3 times, then in the Task Manager appears 3 times the name of the program.
I need execute MyProcedure in process 1, then execute MyProcedure in process 2 and then execute MyProcedure in process 3
      
MyProcedure of different processes can not be executed in the same time

Exist some way to do this in delphi 7 ?

Thx
Alexandre
Brazil
0
Comment
Question by:alpires
  • 3
4 Comments
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 22949399
you could use the registry (or some  file) to do this.

your app sets its processid in the registry
when starting the proc and clears when done.

you could keep a list in which order processid to see what process is next
at startup the program adds its processid to the end of the list

startup of 3 apps:

AppList
Item1: Processid: 123456780; FormHandle: 1234567890
Item2: Processid: 123456781; FormHandle: 1234567891
Item3: Processid: 123456782; FormHandle: 1234567892

ProcedureList
RunProc1: CurrentProcessId: 123456780;

When finished the program sends a Message to the next Process using the form handle
(this you don't need to constantly monitor the registry)



0
 

Author Comment

by:alpires
ID: 22951625
Geert, can you show me some source code please ?
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 22955019
um yeah, but it'll have to wait till tomorrow
i'll get back to you then with a sample :)
0
 
LVL 38

Accepted Solution

by:
Geert Gruwez earned 2000 total points
ID: 22958276
well, you had to wait a day, but here is the code:

I used a timer to simulate a procedure running
set panel to green when running, yellow when done

you can start the exe multiple times to see the effect

there is even a cleanup process included, just in case you need to restart all apps

Have fun,
G
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;
 
const
  BaseKey = 'Software\Test_From_EE\SyncedApp\';
  SemaphoreName = 'SyncedProcedures';
 
var WM_NEXTPROC: Cardinal;
 
type
  TProcSynchronizer = class(TWinControl)
  private
    fAppHandle: HWND;
    fProcOrder: Integer;
    fProcStart: TNotifyEvent;
    fProcDone: TNotifyEvent;
    fSemaphoreHandle: THandle;
  protected
    procedure DoProcDone; dynamic;
    procedure DoProcStart; dynamic;
    procedure AddProcess;
    procedure RemoveProcess;
    procedure CleanProcess;
  public
    constructor Create(AOwner: TComponent; aHandle: HWnd; aStart, aDone: TNotifyEvent); reintroduce;
    destructor Destroy; override;
    procedure Start;
    procedure Stop;
  end;
 
  TForm1 = class(TForm)
    pnlProcedure: TPanel;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    fSyncer: TProcSynchronizer;
    procedure ProcStart(Sender: TObject);
    procedure ProcDone(Sender: TObject);
    procedure WMNextProc(var msg: TMessage);
  protected
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses Registry, Math;
 
{$R *.dfm}
 
function SortInt(List: TStringList; Index1, Index2: Integer): Integer;
begin
  Result := CompareValue(StrToInt(List[Index1]), StrToInt(List[Index2]));
end;
 
{ TForm1 }
 
constructor TForm1.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  WM_NEXTPROC := RegisterWindowMessage('SYNC_NEXTPROC');
  fSyncer := TProcSynchronizer.Create(Self, Handle, ProcStart, ProcDone);
  pnlProcedure.Caption := 'Procedure ' + IntToStr(fSyncer.fProcOrder);
end;
 
procedure TForm1.ProcDone(Sender: TObject);
begin
  pnlProcedure.Color := clYellow;
  // Timer2 automatically tries to start the cycle again
  // Timer2.Enabled := True;
end;
 
procedure TForm1.ProcStart(Sender: TObject);
begin
  pnlProcedure.Color := clGreen;
  Timer1.Enabled := True;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  fSyncer.Stop;
end;
 
procedure TForm1.FormShow(Sender: TObject);
begin
  fSyncer.Start;
end;
 
procedure TForm1.WMNextProc(var msg: TMessage);
begin
  msg.Result := 1;
  fSyncer.Start;
end;
 
procedure TForm1.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_NEXTPROC then
    WMNextProc(Message)
  else
    inherited WndProc(Message);
end;
 
destructor TForm1.Destroy;
begin
  if Assigned(fSyncer) then
    fSyncer.Stop;
  inherited Destroy;
end;
 
{ TProcSynchronizer }
 
procedure TProcSynchronizer.AddProcess;
var Reg: TRegistry;
  List: TStringList;
  NewNum, I: Integer;
begin
  // Add Application handle to list
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey(BaseKey + 'processes', True) then
    try
      NewNum := 1;
      List := TStringList.Create;
      try
        Reg.GetValueNames(List);
        if List.Count > 0 then
        begin
          for I := List.Count - 1 downto 0 do
            if HWnd(StrToInt64(Reg.ReadString(List[I]))) = fAppHandle then
            begin
              Reg.DeleteValue(List[I]);
              List.Delete(I);
            end;
          List.CustomSort(SortInt);
          NewNum := StrToInt(List[List.Count-1])+1;
        end;
      finally
        FreeAndNil(List);
      end;
      Reg.WriteString(IntToStr(NewNum), IntToStr(fAppHandle));
      fProcOrder := NewNum;
    finally
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;
end;
 
procedure TProcSynchronizer.CleanProcess;
var Reg: TRegistry;
  List: TStringList;
  I: Integer;
begin
  FSemaphoreHandle := CreateSemaphore(nil, 0, 1, PCHAR(SemaphoreName));
  if (FSemaphoreHandle <> 0) and (GetLastError() = ERROR_ALREADY_EXISTS) then
  begin
    CloseHandle(FSemaphoreHandle);
    FSemaphoreHandle := 0;
  end
    else // First app starting, clean old values in registry
  begin
    // Remove all registry settings
    Reg := TRegistry.Create;
    try
      Reg.RootKey := HKEY_CURRENT_USER;
      if Reg.OpenKey(BaseKey + 'processes', False) then
      try
        List := TStringList.Create;
        try
          Reg.GetValueNames(List);
          for I := 0 to List.Count - 1 do
            Reg.DeleteValue(List[I]);
        finally
          FreeAndNil(List);
        end;
      finally
        Reg.CloseKey;
      end;
      if Reg.OpenKey(BaseKey + 'processes/current', False) then
      try
        Reg.WriteInteger('process', 0);
      finally
        Reg.CloseKey;
      end;
    finally
      Reg.Free;
    end;
  end;
end;
 
constructor TProcSynchronizer.Create(AOwner: TComponent; aHandle: HWnd;
  aStart, aDone: TNotifyEvent);
begin
  inherited Create(AOwner);
  fAppHandle := aHandle;
  fProcStart := aStart;
  fProcDone := aDone;
  CleanProcess;
  AddProcess;
end;
 
destructor TProcSynchronizer.Destroy;
begin
  RemoveProcess;
  if fSemaphoreHandle <> 0 then
    CloseHandle(FSemaphoreHandle);
  inherited Destroy;
end;
 
procedure TProcSynchronizer.DoProcDone;
begin
  if not (csDestroying	in ComponentState) and Assigned(fProcDone) then
    fProcDone(Self);
end;
 
procedure TProcSynchronizer.DoProcStart;
begin
  if not (csDestroying	in ComponentState) and Assigned(fProcStart) then
    fProcStart(Self);
end;
 
procedure TProcSynchronizer.RemoveProcess;
var Reg: TRegistry;
begin
  // if running then stop and send message to next process
  Stop;
  // Remove Application handle from list
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey(BaseKey + 'processes', False) then
    try
      Reg.DeleteValue(IntToStr(fProcOrder));
    finally
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;
end;
 
procedure TProcSynchronizer.Start;
var
  Reg: TRegistry;
  n: Integer;
begin
  // only run if there is a start handler and done handler assigned
  if Assigned(fProcStart) and Assigned(fProcDone) then
  begin
    // Set Application handle to this
    Reg := TRegistry.Create;
    try
      Reg.RootKey := HKEY_CURRENT_USER;
      if Reg.OpenKey(BaseKey + 'processes/current', True) then
      try
        n := 0;
        if Reg.ValueExists('process') then
          n := Reg.ReadInteger('process');
        if n = 0 then
        begin
          Reg.WriteInteger('process', fProcOrder);
          n := fProcOrder;
        end;
        if n = fProcOrder then
          DoProcStart;
      finally
        Reg.CloseKey;
      end;
    finally
      Reg.Free;
    end;
  end;
end;
 
procedure TProcSynchronizer.Stop;
var Reg: TRegistry;
  fNextApp: HWnd;
  ItsMe: Boolean;
  List: TStringList;
  n, m: Integer;
begin
  // only run if there is a start handler and done handler assigned
  if Assigned(fProcStart) and Assigned(fProcDone) then
  begin
    // Remove Application handle and send windows message to next app
    Reg := TRegistry.Create;
    try
      Reg.RootKey := HKEY_CURRENT_USER;
      // Am i running ?
      fNextApp := 0;
      ItsMe := False;
      if Reg.OpenKey(BaseKey + 'processes/current', False) then
      try
        if Reg.ValueExists('process') and (Reg.ReadInteger('process') = fProcOrder) then
          ItsMe := True;
      finally
        Reg.CloseKey;
      end;
      if ItsMe then // I am running and now find next app
      begin
        if Reg.OpenKey(BaseKey + 'processes', False) then
        try
          List := TStringList.Create;
          try
            Reg.GetValueNames(List);
            if List.Count = 1 then // its me and only me running !
              fNextApp := fAppHandle
            else
            begin
              List.CustomSort(SortInt);
              n := List.IndexOf(IntToStr(fProcOrder));
              if n = List.Count - 1 then
                m := StrToInt(List[0])
              else
                m := StrToInt(List[n+1]);
              fNextApp := HWnd(StrToInt64(Reg.ReadString(IntToStr(m))));
            end;
          finally
            FreeAndNil(List);
          end;
        finally
          Reg.CloseKey;
        end;
        if ItsMe then
        begin
          if Reg.OpenKey(BaseKey + 'processes/current', False) then
          try
            Reg.WriteInteger('process', 0);
          finally
            Reg.CloseKey;
          end;
        end;
        DoProcDone;
        PostMessage(fNextApp, WM_NEXTPROC, 0, 0);
      end;
    finally
      Reg.Free;
    end;
  end;
end;
 
end.

Open in new window

0

Featured Post

Upgrade your Question Security!

Add Premium security features to your question to ensure its privacy or anonymity. Learn more about your ability to control Question Security today.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Exchange organizations may use the Journaling Agent of the Transport Service to archive messages going through Exchange. However, if the Transport Service is integrated with some email content management application (such as an anti-spam), the admin…
Please read the paragraph below before following the instructions in the video — there are important caveats in the paragraph that I did not mention in the video. If your PaperPort 12 or PaperPort 14 is failing to start, or crashing, or hanging, …
Suggested Courses
Course of the Month14 days, 15 hours left to enroll

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question