Browse Source

Amiga, AROS, MorphOS: SimpleIPC improvements (Error on reregister with same name, remove on error exit)

git-svn-id: trunk@30803 -
marcus 10 years ago
parent
commit
19f04e8a3b
1 changed files with 59 additions and 1 deletions
  1. 59 1
      packages/fcl-process/src/amicommon/simpleipc.inc

+ 59 - 1
packages/fcl-process/src/amicommon/simpleipc.inc

@@ -2,12 +2,64 @@
   Amiga style simpleipc.inc
   Amiga style simpleipc.inc
 }
 }
 
 
+{$DEFINE OSNEEDIPCINITDONE}
+
 uses
 uses
   Exec, dos;
   Exec, dos;
 
 
+ResourceString
+  SErrMsgPortExists = 'MsgPort already exists: %s';
+
 const
 const
   PORTNAMESTART = 'fpc_';
   PORTNAMESTART = 'fpc_';
 
 
+Var
+  MsgPorts: Classes.TList;
+
+procedure AddMsgPort(AMsgPort: PMsgPort);
+begin
+  if Assigned(MsgPorts) then
+  begin
+    MsgPorts.Add(AMsgPort);
+  end;
+end;
+
+procedure RemoveMsgPort(AMsgPort: PMsgPort);
+var
+  Idx: Integer;
+begin
+  if Assigned(MsgPorts) then
+  begin
+    Idx := MsgPorts.IndexOf(AMsgPort);
+    if Idx >= 0 then
+    begin
+      MsgPorts.Delete(Idx);
+      if Assigned(AMsgPort^.mp_Node.ln_Name) and (string(AMsgPort^.mp_Node.ln_Name) <> '') and Assigned(FindPort(AMsgPort^.mp_Node.ln_Name)) then
+        RemPort(AMsgPort);
+      DeleteMsgPort(AMsgPort);
+    end;  
+  end;
+end;
+
+
+procedure IPCInit;
+begin
+  MsgPorts := Classes.TList.Create;
+end;
+
+procedure IPCDone;
+var
+  I: integer;
+begin
+  try
+    for i := 0 to MsgPorts.Count - 1 do
+        RemoveMsgPort(PMsgPort(MsgPorts[i]));
+    finally  
+      FreeAndNil(MsgPorts);  
+    end;  
+end;
+
+
 Type
 Type
   TAmigaClientComm = Class(TIPCClientComm)
   TAmigaClientComm = Class(TIPCClientComm)
   Private
   Private
@@ -106,6 +158,7 @@ Constructor TAmigaServerComm.Create(AOwner: TSimpleIPCServer);
 begin
 begin
   inherited;
   inherited;
   FMsgPort := CreateMsgPort;
   FMsgPort := CreateMsgPort;
+  AddMsgPort(FMsgPort);
   MsgBody := nil;
   MsgBody := nil;
 end;
 end;
 
 
@@ -113,13 +166,18 @@ destructor TAmigaServerComm.Destroy;
 begin
 begin
   if Assigned(MsgBody) then
   if Assigned(MsgBody) then
     System.FreeMem(MsgBody);
     System.FreeMem(MsgBody);
-  DeleteMsgPort(FMsgPort);
+  RemoveMsgPort(FMsgPort);
   inherited;
   inherited;
 end;
 end;
 
 
 Procedure TAmigaServerComm.StartServer;
 Procedure TAmigaServerComm.StartServer;
 begin
 begin
   FPortName := PORTNAMESTART + Owner.ServerID + #0;
   FPortName := PORTNAMESTART + Owner.ServerID + #0;
+  if Assigned(FindPort(PChar(FPortName))) then
+  begin
+    DoError(SErrMsgPortExists,[FPortName]);
+    Exit;
+  end;
   FMsgPort^.mp_Node.ln_Name := PChar(FPortName);
   FMsgPort^.mp_Node.ln_Name := PChar(FPortName);
   FMsgPort^.mp_Node.ln_Pri := 0;
   FMsgPort^.mp_Node.ln_Pri := 0;
   AddPort(FMsgPort);
   AddPort(FMsgPort);