[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]

    unit previnst;
    {Copyright © 1997 Simon Carter.  All Rights Reserved.

    This component can be used as freeware in any commercial or private application
    the only request I make is that if it is modified in any way then I have a copy
    of the modifications.  If you do use this product then please drop me an E-Mail
     to sc4vb@geocities.com to let me know.

    Originally created by Simon Carter sc4vb@geocities.com
    Released to public domain on 18 June 1997
    No Warranty or liability can be taken by Simon Carter in respect of the use
    or inability to use this component under any circumstances

    HISTORY

    Date         Name                  Reason
    17-6-97      Simon Carter          Created

    Additional Information
    Properties
    AppName      -   Name of the application.  This will be used for the temporary file
    DupeMessage  -   Message to be displayed if duplicate found

    Usage
    Simply drop on the component on the form fill in the above properties
    and run program.
    }
    interface  { dcr for this unit is contained below !! }

    uses
      Windows, SysUtils, Classes, Forms;

    type
      TPrevInst = class(TComponent)
      private
          FFileHandle: HFile;
          FAppName: String;
          FTempLoc: String;
          FDupeMessage: String;
          MOFS: TOFStruct;  //my open file struct
      protected
          Function AppHasPrevious:Boolean;
          Procedure PrepFile;
      public
          constructor Create(Owner: TComponent); override;
          destructor Destroy; override;
          Function GetAppName: String;
          Procedure SetAppName(NewName: String);
          Function GetDupeMessage:String;
          Procedure SetDupeMessage(NewMessage: String);
     published
          Property AppName: String read GetAppName write SetAppName;
          Property DupeMessage: String read GetDupeMessage write SetDupeMessage;
      end;

    procedure Register;

    implementation
    Procedure TPrevInst.PrepFile;
    var
    I: Integer;
    S: String;
    Begin
         S := FTempLoc + FAppName + '.Tmp';
         For I := 1 to Length(FTempLoc + FAppName + '.Tmp') Do
             MOFS.szPathName[I] :=  S[I];
         MOFS.cBytes := SizeOf(MOFS);
    End;
    Procedure TPrevInst.SetDupeMessage(NewMessage: String);
    Begin
         FDupeMessage := NewMessage;
    End;

    Function TPrevInst.GetDupeMessage:String;
    Begin
         Result := FDupeMessage;
    End;

    Function TPrevInst.AppHasPrevious:Boolean;
    Begin
         If FileExists(FTempLoc + FAppName + '.Tmp') Then
             Begin
                  If DeleteFile(FTempLoc + FAppName + '.Tmp') Then
                     Begin
                          Result := False;
                          PrepFile;
                          FFileHandle := OpenFile(PChar(FTempLoc + FAppName + '.Tmp'),MOFS,OF_Create or OF_Share_Exclusive);
                     End
                  Else
                     Begin
                          Application.MessageBox(PChar(FDupeMessage),Pchar(AppName),mb_OK + mb_IconStop);
                          Application.Terminate;
                          Result := True;
                     End;
             End
         Else
             Begin
                  PrepFile;
                  FFileHandle := OpenFile(PChar(FTempLoc + FAppName + '.Tmp'),MOFS,OF_Create or OF_Share_Exclusive);
                  Result := False;
             End;
    End;
    constructor TPrevInst.Create(Owner: TComponent);
    Begin
         Inherited Create(Owner);
         If Application.Title = '' then
            FAppName := 'New Project'
         Else
            FAppName := Application.Title;
         FTempLoc := ExtractFilePath(ParamStr(0));
         FDupeMessage := 'Only One Instance Of This Program Can Be Run At Any One Time';
    End;

    destructor TPrevInst.Destroy;
    Begin
         CloseHandle(FFileHandle);
         //try and delete file if it won't then don't worry
         try
            DeleteFile(FTempLoc + FAppName + '.Tmp');
         Except
            //CloseFile
         End;
         inherited destroy;
    End;

    Function TPrevInst.GetAppName: String;
    Begin
        Result := FAppName;
    End;

    Procedure TPrevInst.SetAppName(NewName: String);
    Begin
        FAppName := NewName;
        If not (csDesigning in ComponentState) then
           AppHasPrevious;
    End;

    procedure Register;
    begin
      RegisterComponents('Additional', [TPrevInst]);
    end;

    end.

    { the following contains additional files that should be included with this
      file.  To extract, you need XX3402 available with the SWAG distribution.

      1.     Cut the text below out, and save to a file  ..  filename.xx
      2.     Use XX3402  :   xx3402 d filename.xx
      3.     The decoded file should be created in the same directory.
      4.     If the file is a archive file, use the proper archive program to
             extract the members.

    { ------------------            CUT              ----------------------}

    *XX3402-000472-180697--72--85-47113----PREVINST.DCR--1-OF--1
    +++++0++++1zzk++zzw+++++++++++++++++++++++06+E++A++++Dzz+U-I+3++IU-3+3M+
    GE-C+3A+J++++++++++E2+Y6+++++++++++c++++4++++-U++++-++E++++++0+-++++++++
    ++++++++++++++++++++++++U+++U++++60++6++++0++6++U6+++60+U+1+kA++++1z++1z
    ++++zzw+zk+++Dw+zk1zzk++zzzz+6U6W+W6W6W6W6W6W60+U606W6W6W6W6W6U6U6W6W6W6
    W6W6W60+U606W6W6W6W6W6U6W+W6W6W6W6W6W6W6W6aNaNaMW6W6W6W6W6aNaNaMW6W6W6W6
    W6aNaNaMW6W6WDRrRrRraNRrRrRrRzW6W6W6aNW6W6W6VzW6W6W6aNWDRrRrVzW6W6W6aNWD
    U605VzW6W6W6aNWDzzzzVzW6W6W6aNW6W6W6VzW6W6W6aNW6W6W6VzW6W6W6aNW6W6W6VzW6
    W6aNaNW6W6W6VzW6W6WNaNW6W6W6VzW6W6W7aNW6W6W6VzW6W6W6W6W6W6W6VzW6W6W6W6W6
    W6W6VznAnAnAnAnAnAnAlzzzzzzzzzzzzzzzxsW6W6W6W6W6W6W6W+++
    ***** END OF BLOCK 1 *****

[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]