SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00006 DOS & ENVIRONMENT ROUTINES 1 05-28-9313:38ALL SWAG SUPPORT TEAM EXPFHT.PAS IMPORT 18 Unit expfht;ππ { Author: Trevor J Carlsen Released into the public domain }π { PO Box 568 }π { Port Hedland }π { Western Australia 6721 }π { Voice +61 91 732 026 }ππ { EXPFHT: This Unit allows an application to expand the number of File }π { handles in use. It is limited to the number permitted by Dos and }π { initialised in the FileS= of the config.sys File. }ππInterfaceππConstπ NumbFiles= 105;π { Set to the number of File handles needed. 99 will be the max With }π { Dos 2.x and 254 With Dos 3.x. (I don't know why not 255!) }πTypeπ fht = Array[1..NumbFiles] of Byte;πVarπ NewFHT : fht;π OldFHT : LongInt;π OldSize : Word;π πFunction MakeNewFHT: Boolean;πProcedure RestoreOldFHT;πππImplementationππConstπ Successful : Boolean = False;ππVarπ OldExitProc : Pointer;ππ{$R-}πFunction MakeNewFHT : Boolean;π { create a new expanded File handle table - True if successful }π Constπ AlreadyUsed : Boolean = False;π beginπ if not AlreadyUsed then beginπ AlreadyUsed := True;π MakeNewFHT := True;π Successful := True;π OldFHT := MemL[PrefixSeg:$34]; { Store the old FHT address }π FillChar(NewFHT,NumbFiles,$ff); { Fill new table With 255 }π Oldsize := MemW[PrefixSeg:$32]; { Store the old FHT size }π MemW[PrefixSeg:$32] := NumbFiles; { Put new size in the psp }π MemL[PrefixSeg:$34] := LongInt(@NewFHT); { new FHT address in psp }π move(Mem[PrefixSeg:$19],NewFHT,$15); { put contents of old to new }π end { if not AllreadyUsed }π else MakeNewFHT := False;π end; { MakeNewFHT }π{$R+}ππ{$F+}πProcedure RestoreOldFHT;π beginπ ExitProc := OldExitProc;π if Successful then beginπ MemW[PrefixSeg:$32] := OldSize;π MemL[PrefixSeg:$34] := OldFHT;π end; π end;π{$F-}ππbeginπ OldExitProc := ExitProc;π ExitProc := @RestoreOldFHT;πend.ππ 2 05-28-9313:38ALL SWAG SUPPORT TEAM NEWENV.PAS IMPORT 29 {π The following TP code assigns a new Environment to the COMMand.COMπ which is invoked by TP's EXEC Function. In this Case, it is usedπ to produce a Dos PROMPT which is different from the one in the Masterπ Environment. Control is returned when the user Types Exit ...π}ππ{ Reduce Retained Memory }ππ{$M 2048,0,0}ππProgram NewEnv;πUsesπ Dos;πTypeπ String128 = String[128];πConstπ NewPrompt =π 'PROMPT=$e[32mType Exit to Return to The Fitness Profiler$e[0m$_$_$p$g' + #0;πVarπ EnvironNew,π EnvironOld,π offsetN,π offsetO,π SegBytes : Word;π TextBuff : String128;π Found,π Okay : Boolean;π Reg : Registers;ππFunction AllocateSeg( BytesNeeded : Word ) : Word;πbeginπ Reg.AH := $48;π Reg.BX := BytesNeeded div 16;π MsDos( Reg );π if Reg.Flags and FCarry <> 0 thenπ AllocateSeg := 0π elseπ AllocateSeg := Reg.AX;πend {AllocateSeg};ππProcedure DeAllocateSeg( AllocSeg : Word; Var okay : Boolean );πbeginπ Reg.ES := AllocSeg;π Reg.AH := $49;π MsDos( Reg );π if Reg.Flags and FCarry <> 0 thenπ okay := Falseπ elseπ okay := True;πend {DeAllocateSeg};ππFunction EnvReadLn( EnvSeg : Word; Var Envoffset : Word ) : String128;πVarπ tempstr : String128;π loopc : Byte;πbeginπ loopc := 0;π Repeatπ inC( loopc );π tempstr[loopc] := CHR(Mem[EnvSeg:Envoffset]);π inC( Envoffset );π Until tempstr[loopc] = #0;π tempstr[0] := CHR(loopc); {set str length}π EnvReadLn := tempstrπend {ReadEnvLn};ππProcedure EnvWriteLn( EnvSeg : Word; Var Envoffset : Word;π AsciizStr : String );πVarπ loopc : Byte;πbeginπ For loopc := 1 to Length( AsciizStr ) doπ beginπ Mem[EnvSeg:Envoffset] := orD(AsciizStr[loopc]);π inC( Envoffset )π endπend {EnvWriteLn};ππbegin {main}π WriteLn(#10,'NewEnv v0.0 Dec.25.91 Greg Vigneault');π SegBytes := 1024; { size of new environment (up to 32k)}π EnvironNew := AllocateSeg( SegBytes );π if EnvironNew = 0 thenπ begin { asked For too much memory? }π WriteLn('Can''t allocate memory segment Bytes.',#7);π Halt(1)π end;π EnvironOld := MemW[ PrefixSeg:$002c ]; { current environ }π { copy orig env, but change the PROMPT command }π Found := False;π offsetO := 0;π offsetN := 0;π Repeat { copy one env Var at a time, old env to new env}π TextBuff := EnvReadLn( EnvironOld, offsetO );π if offsetO >= SegBytes thenπ begin { not enough space? }π WriteLn('not enough new Environment space',#7);π DeAllocateSeg( EnvironNew, okay );π Halt(2) { abort to Dos }π end;π { check For the PROMPT command String }π if Pos('PROMPT=',TextBuff) = 1 thenπ begin { prompt command? }π TextBuff := NewPrompt; { set new prompt }π Found := True;π end;π { now Write the Variable to new environ }π EnvWriteLn( EnvironNew, offsetN, TextBuff );π { loop Until all Variables checked/copied }π Until Mem[EnvironOld:offsetO] = 0;π { if no prompt command found, create one }π if not Found thenπ EnvWriteLn( EnvironNew, offsetN, NewPrompt );π Mem[EnvironNew:offsetN] := 0; { delimit new environ}π MemW[ PrefixSeg:$2c ] := EnvironNew; { activate new env }π WriteLn( #10, '....Type Exit to return to normal prompt...' );π SwapVectors;π Exec( GetEnv('COMSPEC'),'/S'); {shell to Dos w/ new prompt}π SwapVectors;π MemW[ PrefixSeg:$2c ] := EnvironOld; { restore original env}π DeAllocateSeg( EnvironNew, okay );π if not okay thenπ WriteLn( 'Could not release memory!',#7 );πend {NewEnv}.π(*******************************************************************)π 3 05-28-9313:38ALL SWAG SUPPORT TEAM REBOOT.PAS IMPORT 6 Procedure Warm_Boot;π Beginπ Inline($BB/$00/$01/$B8/$40/$00/$8E/$D8/π $89/$1E/$72/$00/$EA/$00/$00/$FF/$FF);π End;ππProcedure Cold_Boot;π Beginπ Inline($BB/$38/$12/$B8/$40/$00/$8E/$D8/π $89/$1E/$72/$00/$EA/$00/$00/$FF/$FF);π End;ππI saw that you were posting reboot procedures...I didn't catch what it was forπthough, but maybe these will help.πππ--- XANADU (1:124/7007)π * Origin: * XANADU * Grand Prairie, TX * (1:124/7007)π 4 05-28-9313:38ALL SWAG SUPPORT TEAM REBOOT2.PAS IMPORT 8 # Der User Chris Obee@1:234/26 musste am Donnerstag, dem 22.04.93 um 12:09 Uhrπ# in der Area PASCAL folgendes seiner Tastatur antun................ππ> I would like to write a program in pascal that will accomplish anπ> complete system reboot. The moral equivilent of pressing the big redπ> button. A program that simulates the Cntr-Alt-Del sequence is notπ> sufficient. Anyone who can advise me on if this is possible of not, willπ> receive many thanks.π>π> TTFN: chrisππThat's not as hard as it might seem to be at first glance:ππprogram coldboot;πbeginπ memw[0:$0472] := 0;π asmπ mov ax,$FFFFπ mov ds,axπ jmp far ptr ds:0π end;πend.ππHope you understand the assembler code... :-)πππMichael : [NICO] : [Whoo haz broquen mei brain-waschaer?]π~~~~~~~~~~~~~~~~ππ--- CrossPoint v2.1π * Origin: Send me ALL your money - IMMEDIATELY!! (2:2401/411.2)π 5 05-28-9313:38ALL SWAG SUPPORT TEAM TPENV.PAS IMPORT 107 {$R-,S-,V-,I-,B-,F-}ππ{Disable the following define if you don't have Turbo Professional}π{$DEFINE UseTpro}ππ{*********************************************************}π{* TPENV.PAS 1.02 *}π{* by TurboPower Software *}π{*********************************************************}ππ{π Version 1.01 11/7/88π Find master environment in Dos 3.3 and 4.0π Version 1.02 11/14/88π Correctly find master environment when runπ Within AUTOEXEC.BATπ}ππUnit TpEnv;π {-Manipulate the environment}ππInterfaceππUses Opus;ππTypeπ EnvArray = Array[0..32767] of Char;π EnvArrayPtr = ^EnvArray;π EnvRec =π Recordπ EnvSeg : Word; {Segment of the environment}π EnvLen : Word; {Usable length of the environment}π EnvPtr : Pointer; {Nil except when allocated on heap}π end;ππConstπ ShellUserProc : Pointer = nil; {Put address of ExecDos user proc here if desiππProcedure MasterEnv(Var Env : EnvRec);π {-Return master environment Record}ππProcedure CurrentEnv(Var Env : EnvRec);π {-Return current environment Record}ππProcedure NewEnv(Var Env : EnvRec; Size : Word);π {-Allocate a new environment on the heap}ππProcedure DisposeEnv(Var Env : EnvRec);π {-Deallocate an environment previously allocated on heap}ππProcedure SetCurrentEnv(Env : EnvRec);π {-Specify a different environment For the current Program}ππProcedure CopyEnv(Src, Dest : EnvRec);π {-Copy contents of Src environment to Dest environment}ππFunction EnvFree(Env : EnvRec) : Word;π {-Return Bytes free in environment}ππFunction GetEnvStr(Env : EnvRec; Search : String) : String;π {-Return a String from the environment}ππFunction SetEnvStr(Env : EnvRec; Search, Value : String) : Boolean;π {-Set environment String, returning True if successful}ππProcedure DumpEnv(Env : EnvRec);π {-Dump the environment to StdOut}ππFunction ProgramStr : String;π {-Return the complete path to the current Program, '' if Dos < 3.0}ππFunction SetProgramStr(Env : EnvRec; Path : String) : Boolean;π {-Add a Program name to the end of an environment if sufficient space}ππ {$IFDEF UseTpro}πFunction ShellWithPrompt(Prompt : String) : Integer;π {-Shell to Dos With a new prompt}π {$endIF}ππProcedure DisposeEnv(Var Env : EnvRec);π {-Deallocate an environment previously allocated on heap}πbeginπ With Env doπ if EnvPtr <> nil then beginπ FreeMem(EnvPtr, EnvLen+31);π ClearEnvRec(Env);π end;πend;ππProcedure SetCurrentEnv(Env : EnvRec);π {-Specify a different environment For the current Program}πbeginπ With Env doπ if EnvSeg <> 0 thenπ MemW[PrefixSeg:$2C] := EnvSeg;πend;ππProcedure CopyEnv(Src, Dest : EnvRec);π {-Copy contents of Src environment to Dest environment}πVarπ Size : Word;π SPtr : EnvArrayPtr;π DPtr : EnvArrayPtr;πbeginπ if (Src.EnvSeg = 0) or (Dest.EnvSeg = 0) thenπ Exit;ππ if Src.EnvLen <= Dest.EnvLen thenπ {Space For the whole thing}π Size := Src.EnvLenπ elseπ {Take what fits}π Size := Dest.EnvLen-1;ππ SPtr := Ptr(Src.EnvSeg, 0);π DPtr := Ptr(Dest.EnvSeg, 0);π Move(SPtr^, DPtr^, Size);π FillChar(DPtr^[Size], Dest.EnvLen-Size, 0);πend;ππProcedure SkipAsciiZ(EPtr : EnvArrayPtr; Var EOfs : Word);π {-Skip to end of current AsciiZ String}πbeginπ While EPtr^[EOfs] <> #0 doπ Inc(EOfs);πend;ππFunction EnvNext(EPtr : EnvArrayPtr) : Word;π {-Return the next available location in environment at EPtr^}πVarπ EOfs : Word;πbeginπ EOfs := 0;π if EPtr <> nil then beginπ While EPtr^[EOfs] <> #0 do beginπ SkipAsciiZ(EPtr, EOfs);π Inc(EOfs);π end;π end;π EnvNext := EOfs;πend;ππFunction EnvFree(Env : EnvRec) : Word;π {-Return Bytes free in environment}πbeginπ With Env doπ if EnvSeg <> 0 thenπ EnvFree := EnvLen-EnvNext(Ptr(EnvSeg, 0))-1π elseπ EnvFree := 0;πend;ππ{$IFNDEF UseTpro}πFunction StUpcase(S : String) : String;π {-Uppercase a String}πVarπ SLen : Byte Absolute S;π I : Integer;πbeginπ For I := 1 to SLen doπ S[I] := UpCase(S[I]);π StUpcase := S;πend;πFunction SearchEnv(EPtr : EnvArrayPtr;π Var Search : String) : Word;π {-Return the position of Search in environment, or $FFFF if not found.π Prior to calling SearchEnv, assure thatπ EPtr is not nil,π Search is not emptyπ }πVarπ SLen : Byte Absolute Search;π EOfs : Word;π MOfs : Word;π SOfs : Word;π Match : Boolean;πbeginπ {Force upper Case search}π Search := Upper(Search);ππ {Assure search String ends in =}π if Search[SLen] <> '=' then beginπ Inc(SLen);π Search[SLen] := '=';π end;ππ EOfs := 0;π While EPtr^[EOfs] <> #0 do beginπ {At the start of a new environment element}π SOfs := 1;π MOfs := EOfs;π Repeatπ Match := (EPtr^[EOfs] = Search[SOfs]);π if Match then beginπ Inc(EOfs);π Inc(SOfs);π end;π Until not Match or (SOfs > SLen);ππ if Match then beginπ {Found a match, return index of start of match}π SearchEnv := MOfs;π Exit;π end;ππ {Skip to end of this environment String}π SkipAsciiZ(EPtr, EOfs);ππ {Skip to start of next environment String}π Inc(EOfs);π end;ππ {No match}π SearchEnv := $FFFF;πend;ππProcedure GetAsciiZ(EPtr : EnvArrayPtr; Var EOfs : Word; Var EStr : String);π {-Collect AsciiZ String starting at EPtr^[EOfs]}πVarπ ELen : Byte Absolute EStr;πbeginπ ELen := 0;π While (EPtr^[EOfs] <> #0) and (ELen < 255) do beginπ Inc(ELen);π EStr[ELen] := EPtr^[EOfs];π Inc(EOfs);π end;πend;ππFunction GetEnvStr(Env : EnvRec; Search : String) : String;π {-Return a String from the environment}πVarπ SLen : Byte Absolute Search;π EPtr : EnvArrayPtr;π EOfs : Word;π EStr : String;π ELen : Byte Absolute EStr;πbeginπ With Env do beginπ ELen := 0;π if (EnvSeg <> 0) and (SLen <> 0) then beginπ {Find the search String}π EPtr := Ptr(EnvSeg, 0);π EOfs := SearchEnv(EPtr, Search);π if EOfs <> $FFFF then beginπ {Skip over the search String}π Inc(EOfs, SLen);π {Build the result String}π GetAsciiZ(EPtr, EOfs, EStr);π end;π end;π GetEnvStr := EStr;π end;πend;ππImplementationππTypeπSO =π Recordπ O : Word;π S : Word;π end;ππProcedure ClearEnvRec(Var Env : EnvRec);π {-Initialize an environment Record}πbeginπ FillChar(Env, SizeOf(Env), 0);πend;ππProcedure MasterEnv(Var Env : EnvRec);π {-Return master environment Record}πVarπ Owner : Word;π Mcb : Word;π Eseg : Word;π Done : Boolean;πbeginπ With Env do beginπ ClearEnvRec(Env);ππ {Interrupt $2E points into COMMAND.COM}π Owner := MemW[0:(2+4*$2E)];ππ {Mcb points to memory control block For COMMAND}π Mcb := Owner-1;π if (Mem[Mcb:0] <> Byte('M')) or (MemW[Mcb:1] <> Owner) thenπ Exit;ππ {Read segment of environment from PSP of COMMAND}π Eseg := MemW[Owner:$2C];ππ {Earlier versions of Dos don't store environment segment there}π if Eseg = 0 then beginπ {Master environment is next block past COMMAND}π Mcb := Owner+MemW[Mcb:3];π if (Mem[Mcb:0] <> Byte('M')) or (MemW[Mcb:1] <> Owner) thenπ {Not the right memory control block}π Exit;π Eseg := Mcb+1;π end elseπ Mcb := Eseg-1;ππ {Return segment and length of environment}π EnvSeg := Eseg;π EnvLen := MemW[Mcb:3] shl 4;π end;πend;ππProcedure CurrentEnv(Var Env : EnvRec);π {-Return current environment Record}πVarπ ESeg : Word;π Mcb : Word;πbeginπ With Env do beginπ ClearEnvRec(Env);π ESeg := MemW[PrefixSeg:$2C];π Mcb := ESeg-1;π if (Mem[Mcb:0] <> Byte('M')) or (MemW[Mcb:1] <> PrefixSeg) thenπ Exit;π EnvSeg := ESeg;π EnvLen := MemW[Mcb:3] shl 4;π end;πend;ππProcedure NewEnv(Var Env : EnvRec; Size : Word);π {-Allocate a new environment (on the heap)}πVarπ Mcb : Word;πbeginπ With Env doπ if MaxAvail < Size+31 thenπ {Insufficient space}π ClearEnvRec(Env)π else beginπ {31 extra Bytes For paraGraph alignment, fake MCB}π GetMem(EnvPtr, Size+31);π EnvSeg := SO(EnvPtr).S+1;π if SO(EnvPtr).O <> 0 thenπ Inc(EnvSeg);π EnvLen := Size;π {Fill it With nulls}π FillChar(EnvPtr^, Size+31, 0);π {Make a fake MCB below it}π Mcb := EnvSeg-1;π Mem[Mcb:0] := Byte('M');π MemW[Mcb:1] := PrefixSeg;π MemW[Mcb:3] := (Size+15) shr 4;π end;πend;ππFunction SetEnvStr(Env : EnvRec; Search, Value : String) : Boolean;π {-Set environment String, returning True if successful}πVarπ SLen : Byte Absolute Search;π VLen : Byte Absolute Value;π EPtr : EnvArrayPtr;π ENext : Word;π EOfs : Word;π MOfs : Word;π OldLen : Word;π NewLen : Word;π NulLen : Word;πbeginπ With Env do beginπ SetEnvStr := False;π if (EnvSeg = 0) or (SLen = 0) thenπ Exit;π EPtr := Ptr(EnvSeg, 0);ππ {Find the search String}π EOfs := SearchEnv(EPtr, Search);ππ {Get the index of the next available environment location}π ENext := EnvNext(EPtr);ππ {Get total length of new environment String}π NewLen := SLen+VLen;ππ if EOfs <> $FFFF then beginπ {Search String exists}π MOfs := EOfs+SLen;π {Scan to end of String}π SkipAsciiZ(EPtr, MOfs);π OldLen := MOfs-EOfs;π {No extra nulls to add}π NulLen := 0;π end else beginπ OldLen := 0;π {One extra null to add}π NulLen := 1;π end;ππ if VLen <> 0 thenπ {Not a pure deletion}π if ENext+NewLen+NulLen >= EnvLen+OldLen thenπ {New String won't fit}π Exit;ππ if OldLen <> 0 then beginπ {OverWrite previous environment String}π Move(EPtr^[MOfs+1], EPtr^[EOfs], ENext-MOfs-1);π {More space free now}π Dec(ENext, OldLen+1);π end;ππ {Append new String}π if VLen <> 0 then beginπ Move(Search[1], EPtr^[ENext], SLen);π Inc(ENext, SLen);π Move(Value[1], EPtr^[ENext], VLen);π Inc(ENext, VLen);π end;ππ {Clear out the rest of the environment}π FillChar(EPtr^[ENext], EnvLen-ENext, 0);ππ SetEnvStr := True;π end;πend;ππProcedure DumpEnv(Env : EnvRec);π {-Dump the environment to StdOut}πVarπ EOfs : Word;π EPtr : EnvArrayPtr;πbeginπ With Env do beginπ if EnvSeg = 0 thenπ Exit;π EPtr := Ptr(EnvSeg, 0);π EOfs := 0;π WriteLn;π While EPtr^[EOfs] <> #0 do beginπ While EPtr^[EOfs] <> #0 do beginπ Write(EPtr^[EOfs]);π Inc(EOfs);π end;π WriteLn;π Inc(EOfs);π end;π WriteLn('Bytes free: ', EnvFree(Env));π end;πend;π{$IFDEF UseTpro}πFunction ShellWithPrompt(Prompt : String) : Integer;π {-Shell to Dos With a new prompt}πConstπ PromptStr : String[7] = 'PROMPT=';πVarπ PLen : Byte Absolute Prompt;π NSize : Word;π Status : Integer;π CE : EnvRec;π NE : EnvRec;π OldP : String;π OldPLen : Byte Absolute OldP;πbeginπ {Point to current environment}π CurrentEnv(CE);π if CE.EnvSeg = 0 then beginπ {Error getting environment}π ShellWithPrompt := -5;π Exit;π end;ππ {Compute size of new environment}π OldP := GetEnvStr(CE, PromptStr);π NSize := CE.EnvLen;π if OldPLen < PLen thenπ Inc(NSize, PLen-OldPLen);ππ {Allocate and initialize a new environment}π NewEnv(NE, NSize);π if NE.EnvSeg = 0 then beginπ {Insufficient memory For new environment}π ShellWithPrompt := -6;π Exit;π end;π CopyEnv(CE, NE);ππ {Get the Program name from the current environment}π OldP := ProgramStr;ππ {Set the new prompt String}π if not SetEnvStr(NE, PromptStr, Prompt) then beginπ {Program error, should have enough space}π ShellWithPrompt := -7;π Exit;π end;ππ {Transfer Program name to new environment if possible}π if not SetProgramStr(NE, OldP) thenπ ;ππ {Point to new environment}π SetCurrentEnv(NE);ππ {Shell to Dos With new prompt in place}π {Status := Exec('', True, ShellUserProc);}ππ {Restore previous environment}π SetCurrentEnv(CE);ππ {Release the heap space}π if Status >= 0 thenπ DisposeEnv(NE);ππ {Return exec status}π ShellWithPrompt := Status;πend;π{$endIF}ππend.ππ{ EXAMPLE PROGRAM }ππFunction DosVersion : Word;π {-Return the Dos version, major part in AX}πInline(π $B4/$30/ {mov ah,$30}π $CD/$21/ {int $21}π $86/$C4); {xchg ah,al}ππFunction ProgramStr : String;π {-Return the name of the current Program, '' if Dos < 3.0}πVarπ EOfs : Word;π Env : EnvRec;π EPtr : EnvArrayPtr;π PStr : String;πbeginπ ProgramStr := '';π if DosVersion < $0300 thenπ Exit;π CurrentEnv(Env);π if Env.EnvSeg = 0 thenπ Exit;π {Find the end of the current environment}π EPtr := Ptr(Env.EnvSeg, 0);π EOfs := EnvNext(EPtr);π {Skip to start of path name}π Inc(EOfs, 3);π {Collect the path name}π GetAsciiZ(EPtr, EOfs, PStr);π ProgramStr := PStr;πend;ππFunction SetProgramStr(Env : EnvRec; Path : String) : Boolean;π {-Add a Program name to the end of an environment if sufficient space}πVarπ PLen : Byte Absolute Path;π EOfs : Word;π Numb : Word;π EPtr : EnvArrayPtr;πbeginπ SetProgramStr := False;π With Env do beginπ if EnvSeg = 0 thenπ Exit;π {Find the end of the current environment}π EPtr := Ptr(EnvSeg, 0);π EOfs := EnvNext(EPtr);π {Assure space For path}π if EnvLen < PLen+EOfs+4 thenπ Exit;π {Put in the count field}π Inc(EOfs);π Numb := 1;π Move(Numb, EPtr^[EOfs], 2);π {Skip to start of path name}π Inc(EOfs, 2);π {Move the path into place}π Path := Upper(Path);π Move(Path[1], EPtr^[EOfs], PLen);π {Null terminate}π Inc(EOfs, PLen);π EPtr^[EOfs] := #0;π SetProgramStr := True;π end;πend;π 6 05-29-9322:24ALL GAYLE DAVIS Read Environment String IMPORT 14 {$S-,R-,V-,I-,N-,B-,F-}ππ{$IFNDEF Ver40}π {Allow overlays}π {$F+,O-,X+,A-}π{$ENDIF}ππUNIT Self;ππINTERFACEππFUNCTION GetSelf : STRING;πFUNCTION GetSelfPath : STRING;ππIMPLEMENTATIONππFUNCTION GetSelf : STRING;ππ VARπ Temp : STRING;π I, EnvSeg : WORD;π BEGINπ I := 0;π Temp := '';π EnvSeg := memw [prefixseg : $2C]; { have to set this up like any variable! }π WHILE memw [EnvSeg : I] <> 0 DO { read through environment strings }π INC (I);π INC (I, 4); { jump around 2 null bytes & word count }π WHILE mem [EnvSeg : I] <> 0 DO { skim off path & filename }π BEGINπ Temp := Temp + UPCASE (CHR (mem [EnvSeg : I]) );π INC (I);π END;π GetSelf := Temp;πEND; { function GetSelf }πππFUNCTION GetSelfPath : STRING;ππ VARπ Temp : STRING;π I, EnvSeg : WORD;π Place : INTEGER;π BEGINπ I := 0;π Temp := '';π EnvSeg := memw [prefixseg : $2C]; { have to set this up like any variable! }π WHILE memw [EnvSeg : I] <> 0 DO { read through environment strings }π INC (I);π INC (I, 4); { jump around 2 null bytes & word count }π WHILE mem [EnvSeg : I] <> 0 DO { skim off path & filename }π BEGINπ Temp := Temp + UPCASE (CHR (mem [EnvSeg : I]) );π INC (I);π END;π Place := LENGTH (Temp);π WHILE (Place > 0) AND NOT (Temp [Place] IN [':', '\']) DOπ Place := PRED (Place);π IF Place > 0 THEN Temp [0] := CHR (Place);π GetSelfPath := Temp;πEND; { function SelfPath }ππEND.π