home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
i
/
isres.zip
/
ISRES.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-10-19
|
6KB
|
201 lines
{$IFDEF Windows} {!!.20}
!! ERROR: This unit is not compatible with Windows applications !! {!!.20}
{$ENDIF} {!!.20}
{$IFDEF Dpmi} {!!.20}
!! This unit cannot be used in protected mode !! {!!.20}
{$ENDIF} {!!.20}
{$S-,R-,V-,I-,B-,F-}
{*********************************************************}
{* ISRES.PAS 1.00 *}
{* Copyright (c) TurboPower Software 1990. *}
{* All rights reserved. *}
{*********************************************************}
unit IsRes;
{-Routines that allow a program to determine if another copy of itself is
already resident in memory}
interface
type
ProgramName = string[8];
procedure Install(Name : ProgramName; UserHook : Pointer);
{-Install this program}
procedure Uninstall;
{-Uninstall this program}
function IsLoaded(Name : String; var UserHook : Pointer) : Boolean;
{-Returns True if Name is loaded}
procedure Init16;
{-Install interrupt handler. Called automatically when program begins}
procedure Restore16;
{-Restore INT $16 vector. Called automatically when program ends}
{==========================================================================}
implementation
type
IfcPtr = ^IfcRecord;
IfcRecord = {*** do not change!! ***}
record
NamePtr : ^String;
Version : Word;
UserPtr : Pointer;
PrevIfc : IfcPtr;
NextIfc : IfcPtr;
PrgName : ProgramName;
end;
const
IfcSignature1 = $0F0F0; {*** do not change!! ***}
IfcSignature2 = $0E0E0; {*** do not change!! ***}
var
SaveExitProc : Pointer;
ThisIfcPtr : IfcPtr;
IfcInstalledPtr : ^Boolean;
{$L ISRES.OBJ}
procedure Init16; external;
procedure Restore16; external;
procedure ThisIfc; external;
function GetLastModulePtr : IfcPtr;
{-Return a pointer to the last module loaded before us}
var
FoundIfc : Boolean;
P : IfcPtr;
IACAptr : Pointer absolute $40:$F0;
SaveIACA : Pointer;
begin
{assume failure}
P := nil;
SaveIACA := IACAptr;
IACAptr := nil;
inline(
$B8/>IfcSignature1/ {mov ax,>IfcSignature1 ;standard interface function code}
$31/$FF/ {xor di,di ;es:di = nil}
$8E/$C7/ {mov es,di}
$CD/$16/ {int $16 ;call INT 16}
$F7/$D0/ {not ax ;flip bits}
$3D/>IfcSignature1/ {cmp ax,>IfcSignature1 ;AX = IfcSignature1 only if INT 16 flipped bits}
$75/$1E/ {jne Done ;Ifc handler not found?}
$8C/$C0/ {mov ax,es ;use second method if es:di = nil}
$09/$F8/ {or ax,di}
$74/$08/ {jz NotFound}
$89/$7E/<P/ {mov [bp+<P],di ;offset of list pointer in P}
$8C/$46/<P+2/ {mov [bp+<P+2],es ;segment of list pointer in P}
$EB/$0C/ {jmp short Found}
{NotFound: ;try second method - SuperKey can defeat the first}
$B8/>IfcSignature2/ {mov ax,>IfcSignature2 ;secondary function code}
$CD/$16/ {int $16 ;call INT 16}
$F7/$D0/ {not ax ;AX = not AX}
$3D/>IfcSignature2/ {cmp ax,>IfcSignature2 ;AX = IfcSignature2?}
$75/$04/ {jne Done ;Ifc handler not found?}
{Found:}
$C6/$46/<FoundIfc/$01);{mov [bp+<FoundIfc],1 ;set Found flag}
{Done:}
if not FoundIfc then
GetLastModulePtr := nil
else if P <> nil then
GetLastModulePtr := P
else
GetLastModulePtr := IACAptr;
{restore intra-applications comm. area}
IACAptr := SaveIACA;
end;
procedure Install(Name : ProgramName; UserHook : Pointer);
{-Install this program}
var
P : IfcPtr;
begin
if (Name <> '') and not IfcInstalledPtr^ then
with ThisIfcPtr^ do begin
{see if anyone else is home}
P := GetLastModulePtr;
if P <> nil then begin
P^.NextIfc := ThisIfcPtr;
PrevIfc := P;
end
else
PrevIfc := nil;
{initialize the other fields in the record}
PrgName := Name;
NextIfc := nil;
UserPtr := UserHook;
IfcInstalledPtr^ := True;
end;
end;
procedure Uninstall;
{-Uninstall this program}
begin
if IfcInstalledPtr^ then
with ThisIfcPtr^ do begin
{fix the linked list of modules}
if PrevIfc <> nil then
PrevIfc^.NextIfc := NextIfc;
if NextIfc <> nil then
NextIfc^.PrevIfc := PrevIfc;
IfcInstalledPtr^ := False;
end;
end;
function IsLoaded(Name : String; var UserHook : Pointer) : Boolean;
{-Returns True if Name is loaded}
var
P : IfcPtr;
begin
{search backward through the list}
P := GetLastModulePtr;
while (P <> nil) do begin
if P^.NamePtr^ = Name then begin
UserHook := P^.UserPtr;
IsLoaded := True;
Exit;
end;
P := P^.PrevIfc;
end;
{search failed}
IsLoaded := False;
end;
{$F+}
procedure OurExitProc;
{-Error/exit handler}
begin
{restore previous exit handler}
ExitProc := SaveExitProc;
{remove the program from the list}
Uninstall;
{restore INT $16}
Restore16;
end;
{$F-}
begin
{take over INT $16 and initialize pointers}
Init16;
{set up exit handler}
SaveExitProc := ExitProc;
ExitProc := @OurExitProc;
end.