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 *****