synchronize processes

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
alpiresAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Geert GOracle dbaCommented:
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
alpiresAuthor Commented:
Geert, can you show me some source code please ?
0
Geert GOracle dbaCommented:
um yeah, but it'll have to wait till tomorrow
i'll get back to you then with a sample :)
0
Geert GOracle dbaCommented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.