home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 11 Util / 11-Util.zip / runonce.zip / RunOnce.PAS < prev    next >
Pascal/Delphi Source File  |  1998-02-21  |  6KB  |  159 lines
  1. UNIT RunOnce;
  2.  
  3. (*                                                                      *)
  4. (* AUTHOR: Michael G. Slack                    DATE WRITTEN: 1998/02/20 *)
  5. (* ENVIRONMENT: Sibyl                                                   *)
  6. (*                                                                      *)
  7. (* RunOnce defines a non-visual component that will allow the program   *)
  8. (* it is dropped on to check that it is only ran once.  If the program  *)
  9. (* wants, it can determine if a previous instance is running and give   *)
  10. (* focus to the previous instance of the program.                       *)
  11. (*                                                                      *)
  12. (* Note: A good clean method could not be found to automatically check  *)
  13. (*  previous instances and halt subsequent instances, so the program    *)
  14. (*  needs to call the checkonly procedure to halt subsequent instances  *)
  15. (*  if that behavior is needed.  If not, a program can use the firstinst*)
  16. (*  property to determine if another instance is already running.       *)
  17. (*                                                                      *)
  18. (* This component is based on a similar one that was written for Delphi *)
  19. (* by S.L.Keyser and on hints from comp.os.os2.programmer.misc.         *)
  20. (*                                                                      *)
  21. (* -------------------------------------------------------------------- *)
  22. (*                                                                      *)
  23. (* REVISED: 1998/02/21 - Initial version completed.  (1.00)             *)
  24. (*                                                                      *)
  25.  
  26. INTERFACE
  27.  
  28.  USES Classes, Forms;
  29.  
  30.  CONST ro_MaxMsgLen = 80;
  31.  
  32.  {Declare TRunOnce class}
  33.  TYPE TRunOnce = CLASS(TComponent)
  34.                   PRIVATE
  35.                    pWnd : POINTER;
  36.                    FFirstInst : BOOLEAN;
  37.                    FUseNotifyMsg : BOOLEAN;
  38.                    FNotifyMsg : STRING[ro_MaxMsgLen];
  39.                   PROTECTED
  40.                    PROCEDURE SetupComponent; OVERRIDE;
  41.                    FUNCTION  GetNotifyMsg : STRING;
  42.                    PROCEDURE SetNotifyMsg(S : STRING);
  43.                    FUNCTION  GetVersion : STRING;
  44.                   PUBLIC
  45.                    DESTRUCTOR Destroy; OVERRIDE;
  46.                    PROCEDURE CheckOnly;
  47.                    PROPERTY FirstInst : BOOLEAN Read FFirstInst;
  48.                   PUBLISHED
  49.                    PROPERTY UseNotifyMsg : BOOLEAN Read FUseNotifyMsg
  50.                                                    Write FUseNotifyMsg;
  51.                    PROPERTY NotifyMsg : STRING Read GetNotifyMsg
  52.                                                Write SetNotifyMsg;
  53.                    PROPERTY Version : STRING Read GetVersion
  54.                                              Stored FALSE;
  55.                   END;
  56.  
  57. (************************************************************************)
  58.  
  59. {make trunonce available to sibyl, to change palette location}
  60. { change 'custom' to whatever tab you wish.                  }
  61.  EXPORTS TRunOnce,'Custom','RunOnce.BMP';
  62.  
  63. (************************************************************************)
  64.  
  65. IMPLEMENTATION
  66.  
  67.  USES OS2Def, BseDos, PMWin, Dialogs;
  68.  
  69.  CONST IVersion : STRING[20] = 'Version 1.00';
  70.  
  71. (************************************************************************)
  72.  
  73.  PROCEDURE TRunOnce.SetupComponent;
  74.     VAR TT  : STRING[250];
  75.         FNm : STRING[101];
  76.         I   : INTEGER;
  77.         Ret : APIRET;
  78.         pNm : CSTRING[100];
  79.   BEGIN
  80.    Inherited SetupComponent;
  81.    FFirstInst := TRUE; {assume not running}
  82.    FUseNotifyMsg := FALSE; {default is no message}
  83.    FNotifyMsg := 'Application already running!';
  84.    TT := Application.ExeName; I := Length(TT);
  85.    WHILE (I > 0) AND (TT[I] <> '\') DO
  86.     BEGIN {find beginning of exe name}
  87.      Dec(I);
  88.      IF TT[I] = '.' THEN TT[I] := 'x'; {replace '.' with 'x'}
  89.     END; {while}
  90.    FNm := '\SHAREMEM\' + Copy(TT,I+1,90);
  91.    Ret := DosGetNamedSharedMem(pWnd,FNm,pag_Read OR pag_Write);
  92.    IF Ret = 0
  93.     THEN FFirstInst := FALSE {program already running}
  94.    ELSE BEGIN {program not running currently}
  95.          pNm := FNm; {allocate space for mainform handle later}
  96.          DosAllocSharedMem(pWnd,pNm,SizeOf(HWND),
  97.                            pag_Read OR pag_Write OR pag_Commit);
  98.         END; {else}
  99.   END;
  100.  
  101. (************************************************************************)
  102.  
  103.  FUNCTION TRunOnce.GetNotifyMsg : STRING;
  104.      (* function returns value of notifymsg property *)
  105.  
  106.   BEGIN (*trunonce.getnotifymsg*)
  107.    Result := FNotifyMsg;
  108.   END; (*trunonce.getnotifymsg*)
  109.  
  110. (************************************************************************)
  111.  
  112.  PROCEDURE TRunOnce.SetNotifyMsg(S : STRING);
  113.      (* procedure used to set the notifymsg property *)
  114.  
  115.   BEGIN (*trunonce.setnotifymsg*)
  116.    FNotifyMsg := Copy(S,1,ro_MaxMsgLen);
  117.   END; (*trunonce.setnotifymsg*)
  118.  
  119. (************************************************************************)
  120.  
  121.  FUNCTION TRunOnce.GetVersion : STRING;
  122.      (* function to return version information to property *)
  123.  
  124.   BEGIN (*trunonce.getversion*)
  125.    Result := IVersion;
  126.   END; (*trunonce.getversion*)
  127.  
  128. (************************************************************************)
  129.  
  130.  PROCEDURE TRunOnce.CheckOnly;
  131.      (* procedure used by program to check if only copy and quit if not *)
  132.      (* - if used, should be called from main forms onshow method       *)
  133.  
  134.   BEGIN (*trunonce.checkonly*)
  135.    IF FFirstInst
  136.     THEN BEGIN {calling from first instance}
  137.           {save mainform handle in memory}
  138.           HWND(pWnd^) := Application.MainForm.Handle;
  139.           Exit;
  140.          END; {then}
  141.    IF FUseNotifyMsg THEN ShowMessage(FNotifyMsg);
  142.    WinSetActiveWindow(hwnd_Desktop,HWND(pWnd^)); {focus prev window}
  143.    Application.Terminate;
  144.   END; (*trunonce.checkonly*)
  145.  
  146. (************************************************************************)
  147.  
  148.  DESTRUCTOR TRunOnce.Destroy;
  149.   BEGIN
  150.    DosFreeMem(pWnd); {release memory object}
  151.    Inherited Destroy;
  152.   END;
  153.  
  154. (************************************************************************)
  155.  
  156. INITIALIZATION
  157.  RegisterClasses([TRunOnce]);
  158. END. (*of unit*)
  159.