SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00027 DOS & ENVIRONMENT ROUTINES 1 05-28-9313:38ALL SWAG SUPPORT TEAM Expand DOS File Handles 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 Assign New Environment 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 Warm and Cold Boot 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 Cold Boot in BASM 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 Edit DOS Environment 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.π 7 05-31-9308:06ALL SWAG SUPPORT TEAM Execute & Redirection IMPORT 148 π------------------------------------------------------------------------ππEcho Flag : Permanent: N Export: N Personal Read: Nππ BBS: IN-TECH Conference: PASCAL Imported: 11/14/1991π To: DAVID HICKEY Num: 1442 Date: 10/31/1991πFrom: MARK OUELLET Re: 0 Time: 10:51 pmπSubj: >NUL REDIRECTION Prvt: N Read: Nππ On 27 Oct 91, you, David Hickey, of 1:261/1108.0 wrote...ππ DH> From the DOS prompt, I can redirect things easily. But when I try it in π DH> my program, it doesn't work at all. Here's what I'm doing:π DH> π DH> EXEC ('C:\Pkzip.Exe', '-o c:\ra\ra.zip c:\ra\ralogs\ra.log >nul');π DH> π DH> The problem is that the information from Pkzip is not being redirected π DH> to NULπ DH> like I want it to. It's obviously got to be something I'm not doing π DH> right. Anyone know what it is? I've tried everything I can think of.ππDavid,π This might help you,ππMsg#:20994 *> PASCAL Echo <*π03/17/89 03:15:00πFrom: ROSS WENTWORTHπ To: NORBERT LANGEπSubj: REPLY TO MSG# 20986 (RE: REDIRECTING STDERR)π > I'd appreciate seeing some code. I've tried this before,π > using a couple different methods, and couldn't seem to getπ > DOS to like redirecting StdErr. I tried the $45 (Duplicateπ > File Handle) function as well with no success.ππOk, here's a routine that can be easily modified to do the job. It replaces πEXEC from the DOS unit and checks the "command line" for the redirection πsymbols ('>' and '<'). One minor change and it will redirect STDERR to the πfile (see comment below).π{=============================================================}πUnit Execute;ππInterfaceππProcedure Exec(Path,CmdLine : String);ππImplementationππUsesπ Dos;ππFunction ExtractFileName(Var Line : String;Index : Integer) : String;ππVarπ Temp : String;ππBeginπ Delete(Line,Index,1);π While (Index <= Length(Line)) AND (Line[Index] = ' ')π Do Delete(Line,Index,1);π Temp := '';π While (Index <= Length(Line)) AND (Line[Index] <> ' ') Doπ Beginπ Temp := Temp + Line[Index];π Delete(Line,Index,1);π End;π ExtractFileName := Temp;πEnd;ππProcedure CloseHandle(Handle : Word);ππVarπ Regs : Registers;ππBeginπ With Regs Doπ Beginπ AH := $3E;π BX := Handle;π MsDos(Regs);π End;πEnd;ππProcedure Duplicate(SourceHandle : Word;Var TargetHandle : Word);ππVarπ Regs : Registers;ππBeginπ With Regs Doπ Beginπ AH := $45;π BX := SourceHandle;π MsDos(Regs);π TargetHandle := AX;π End;πEnd;ππProcedure ForceDuplicate(SourceHandle : Word;Var TargetHandle : Word);ππVarπ Regs : Registers;ππBeginπ With Regs Doπ Beginπ AH := $46;π BX := SourceHandle;π CX := TargetHandle;π MsDos(Regs);π TargetHandle := AX;π End;πEnd;ππProcedure Exec(Path,CmdLine : String);ππVarπ StdIn : Word;π Stdout : Word;π Index : Integer;π FName : String[80];π InFile : Text;π OutFile : Text;ππ InHandle : Word;π OutHandle : Word;π { ===============>>>> } { change below for STDERR }πBeginπ StdIn := 0;π StdOut := 1; { change to 2 for StdErr }π Duplicate(StdIn,InHandle); { duplicate standard input }π Duplicate(StdOut,OutHandle); { duplicate standard output }π Index := Pos('>',CmdLine);π If Index > 0 Then { check for output redirection }π Beginπ FName := ExtractFileName(CmdLine,Index); { get output file name }π Assign(OutFile,FName); { open a text file }π Rewrite(OutFile); { .. for output }π ForceDuplicate(TextRec(OutFile).Handle,StdOut);{ make output same }π End;π Index := Pos('<',CmdLine);π If Index > 0 Then { check for input redirection }π Beginπ FName := ExtractFileName(CmdLine,Index); { get input file name }π Assign(InFile,FName); { open a text file }π Reset(InFile); { for input }π ForceDuplicate(TextRec(InFile).Handle,StdIn); { make input same }π End;π DOS.Exec(Path,CmdLine); { run EXEC }π ForceDuplicate(InHandle,StdIn); { put standard input back to keyboard }π ForceDuplicate(OutHandle,StdOut); { put standard output back to screen }π CloseHandle(InHandle); { close the redirected input file }π CloseHandle(OutHandle); { close the redirected output file }πEnd;ππEnd.ππ{===============================================================}ππUse it exactly as you would the normal EXEC procedure:ππ Exec('MASM.EXE','mystuff.asm');ππTo activate redirection simply add the redirection symbols, etc:ππ Exec('MASM.EXE',mystuff.asm >err.lst');πππOne note of caution. This routine temporarily uses extra handles. It'πs eitherπtwo or four more. The various books I have are not clear as two whether πduplicated handles 'count' or not. My guess is yes. If you don't plan on πredirecting STDIN then remove all the code for duplicating it to cut yourπhandle overhead in half.ππ Ross Wentworthππ+++ FD 2.00π Origin: St Dymphna's Retreat via Torrance BBS 213-370-9027 (1:102/345.1)ππ Best regards,π Mark Ouellet.πππ--- ME2π * Origin: The Doctor's Tardis, A point in time!! (Fidonet 1:240/1.4)π==============================================================================π BBS: «« The Information and Technology Exchanπ To: BUTCH ADAMS Date: 12-10─91 (18:00)πFrom: RUSS PARKS Number: 3982 [101] PASCALπSubj: EXEC() Status: Publicπ------------------------------------------------------------------------------π* In a bleating, agonizing plea to All, Butch Adams groaned:ππBA> I'm wondering if I can get some insight as to how toπBA>use the Exec() command in TP6. What I'm trying to do is this:πBA> Exec('Type Filename|sort > newfilename', '');πBA>I've even tried this:πBA> Exec('Type', 'filename|sort > newfilename');ππ Close, but no cigar :-) Try something like this:π Exec('command.com', '/c type filename | sort > newfilename');ππ The first parameter is the path to the program to be run. In thisπcase, 'TYPE' is an internal DOS command so you need to runπCOMMAND.COM. The second parameter is a string with the commandπline arguments you want to pass to the program.π P.S.: The '/c' part of the parameters tells COMMAND.COM to executeπthe command, then exit back to the program that originallyπcalled the COMMAND.COM. It's like loading COMMAND.COM, runningπa program, then typing 'EXIT'.πBesta'Luck,πRussππ---π * Origin: Objectively.Speak('Turbo Pascal 6.0, YEAH!'); (1:170/212)π==============================================================================π BBS: «« The Information and Technology Exchanπ To: BUTCH ADAMS Date: 12-10─91 (21:07)πFrom: MIKE COPELAND Number: 4000 [101] PASCALπSubj: EXEC() Status: Publicπ------------------------------------------------------------------------------π BA> I'm wondering if I can get some insight as to how to use theπ BA>Exec() command in TP6. What I'm trying to do is this:ππ BA> Exec('Type Filename|sort > newfilename', '');ππ BA>I've even tried this:ππ BA> Exec('Type', 'filename|sort > newfilename');ππ BA>But still no result. Are we able to execute internal commands fromπ BA>within a TP program? I've tried loading Command.Com first but all I getπ BA>is the shell to come up and sit there with a C> staring back at me. Iπ BA>would appreciate any help with this.ππ The process to execute any DOS-callable program/command is more thanπyou're doing/showing here. Try the following:ππ{$M 4096,0,0} { allocate space for the child process }ππ SwapVectors;π Exec (GetEnv('COMSPEC'),'/C Type filename|sort > newfile');π SwapVectors;π if DosError > 0 then { check the result of Exec }π You_Have_A_Problem;π if DosExitCode <> 0 thenπ You_Have_A_Different_Problem;π { If you get here, everything's okay... }ππ Read the manual about SwapVectors, DosError, DosExitCode, GetEnv,πExec, the $M parameter, and all the stuff you don't understand here...πππ--- msged 2.07π * Origin: Hello, Keyboard, my old friend... (1:114/18.10)π==============================================================================π BBS: «« The Information and Technology Exchanπ To: ANDREW PARK Date: 12-10─91 (21:15)πFrom: MIKE COPELAND Number: 4001 [101] PASCALπSubj: PASCAL Status: Publicπ------------------------------------------------------------------------------π AP>It's quite simple.π AP>Here's an exampleπ AP>{$M,1025,0,0} <-- I don't know what this means but you need anywaysππ Well, it's very important: it states how much Stack, Heap_Min, andπHeap_Max space you're reserving for the program to use (and howπmuch space you're leaving for the child process to execute in).πThe last (2nd 0) is the most important, since failing to reduceπthis from the default of ALL memory will PREVENT the Exec fromπhaving any memory to do its work within. So, setting it to 0πwill say "reserve ALL of available memory (except for what'sπused by my program itself) for the DOS call I'm going to makeπfrom within my program".π If you don't do this, it defaults to 640K - meaning "reserve NOπmemory for the exec".ππ AP>Program Copying;π AP>Uses dos;π AP>beginπ AP> exec ('Command.com','copy a:*.* b:');π Exec (GetEnv('COMSPEC'),'/C copy a:* b:*');π AP>end.π AP>Something like that. See the manual for Exec section.ππ You should also wrap that Exec call within a pair of SwapVectorsπstatements...before and after. Furthermore, it's a good idea toπcheck DosError and DosExitCode after the action, so see if anyπproblems occurred.π Exec is very useful, but it carries a lot of "baggage" when used...ππ--- msged 2.07π * Origin: Hello, Keyboard, my old friend... (1:114/18.10)π==============================================================================π BBS: «« The Information and Technology Exchanπ To: KEVIN HIGGINS Date: 01-04─92 (09:58)πFrom: MARK OUELLET Number: 4088 [101] PASCALπSubj: RE: HEAP KNOWLEDGE Status: Publicπ------------------------------------------------------------------------------π On 29 Dec 91, you, Kevin Higgins, of 1:128/74.0 wrote...ππ KH> I still don't understand full use of the {$M} compiler directive.π KH> The Pascal tome I have says nothing other than if you don't use New() orπ KH> GetMem() to set the HeapMin and HeapMax to 0. But it never says what toπ KH> set it to if you DO you New or GetMem. Nor could I find any reference onπ KH> ideal settings for a small program which Exec's another fairly smallπ KH> program....ππKevin,π New() and GetMem() are used to allocate spaceπ(memory) off the heap (That which is left of the 640 K ofπdos memory after your program is loaded and DOS and yourπTSRs ect...) for variables that are created AT RUNTIME.πVariables you declare in the usual way ie: Var X : Integer;πallready have space allocated to them.ππ The heap is used to allocate memory to dynamicπvariables ie: variables accessed through the use ofπpointers. These need to have memory allocated to themπ(Unless you are using the pointer to access a region ofπmemory that allready contains information such as theπkeyboard buffer etc... those allready have memory allocatedπto them so you need NO MORE MEMORY TO USE THEM.) Those thatπ*YOU* create such as linked lists need memory. Your programπwhen compiled will only allocate 4 bytes for each pointerπ(Pointers need 2 words, one for the segment, one for theπoffset in that segment) thus the 4 bytes.ππAs a rule of thumb, if you don't create dynamic variablesπthen you can set the $M to: {$M 16384, 0, 0} which is theπminimum.ππ{$MStack space, minimum heap required to run, Max heap needed}ππStack space is the memory needed to hold the stack of yourπprogram, each time you call a function or procedure fromπanother one, the old adress is pushed onto the stack, itπwill pulled off when the called procedure finishes to findπout where to go back and continue executing. Localπvariables, parameters are also saved on the stack so theyπare not lost or modified while the other procedure isπrunning.ππSo if you have recursive procedures (procedures that callπthemselfes) or use lots of parameters you could set a largeπstack. you will find this out through trial and error. If itπdoesn't run properly and halts with a *STACK OVERFLOW* errorπ(TP runtime error 202) then you know you need to increaseπthe stack space allocated to your program.ππThe second parameter is use IF you create dynamic variables,πit tells TP you need at least this much heap memory free toπrun correctly and that it should return to DOS with an errorπif at least that much is not free when you try to load yourπprogram.ππThe last paramater is the Maximum heap memory you expect toπuse, it can be calculated if you know how much you are goingπto use like a big array. If you are using linked lists,πwhich can not allways be evaluated as to how many items theπlist will contain, then you might decide to use it all.πSetting the 3rd parameter to 655360. This won't leave anyπroom to EXEC another program though.ππSo if you intend to run another program from yours, sayπrunning PKUNZIP from a TP program of yours, then you shouldπset Maximum Heap to a value lower than 655360. If you knowπPKUNZIP needs 55k to run without problems then you couldπsimply say:ππ 655360 - (55 * 1024) = 599040ππand set $M toππ{$M 16384, 0, 599040} this will ensure you have at least 55kπfree for PKUNZIP yet giving you the maximum heap space atπthe same time.ππAs allways if you don't use dynamic variables at all don'tπbother with it simply useππ{$M 16384, 0, 0} and you will allways have enough memory toπrun other programs from your TP programs (Unless you don'tπhave enough memory to run them from DOS to begin with ;-) )πππ Best regards,π and a very Happy New Yearπ Mark Ouellet.πππ--- ME2π * Origin: BaseBall for Windows, use the disks as bases ;-) (Fidonet 1:240/1.4)π==============================================================================π BBS: «« The Info-Tech BBS »»π To: SHANE RUSSO Date: 01-24─92 (15:00)πFrom: MIKE COPELAND Number: 5922 [101] $_PASCALπSubj: TP 6.0 -- MEMORY ALLOCATI Status: Publicπ------------------------------------------------------------------------------π SR> Could anyone inform me how to use the $M directive correctly, andπ SR> what it does exactly?ππ SR> Also, what the stack size, heap min and heap max are? (How do youπ SR> calculate the stack size, heap min and heap max)ππ There is no absolute, exact answer to this question, since every TPπprogram has different characteristics and requirements.πHowever, I will try to give you (and others) some basics, fromπwhich you can probably adjust and use as you learn what's rightπfor _you_ (every programmer has different styles, which alsoπaffect the way the $M is used):ππ {$M Stack,Heap_Min,Heap_Max}ππ The Stack is used within your program for calls to subprogramsπ(functions and procedures). Its size is dependent on (1) howπdeep your calls go (or recurse) and (2) how much parameter andπlocal data is referenced during these calls. The worst caseπI've encountered is a recursive sort of strings, where eachπlevel of call requires all the resident data of the routine andπthe parameters passed (string data being so big) are saved onπthe Stack - too many levels of such action will exceed the max.πavailable Stack value, 64K.π So, if you're not making heavily-nested (or recursive) calls in yourπprogram, you won't need much Stack space - 8192 is probably plenty.ππ Heap is data _you_ explicitly ask for (unlike the implicit data usedπby subprogram calls) - by New, GetMem (in TP), or by callingπlibrary routines which do (therefore, you're not always inπcontrol of this if you're using subroutine libraries you didn'tπcreate). The two parameters stated in the $M are for (1) theπminimum value you want to reserve and (2) the maximum you want to allow.π I don't know a good reason to ever use any value > 0 for theπHeap_Min parameter, since the runtime will allocate what'sπneeded (providing the Heap_Max still has something left) -πperhaps performance. So, it's the Heap_Max that's critical forπyour consideration.π I see 2 distinct things here, which are in conflict (and thusπrequire management of this parameter): dynamic memory use inπyour program, and use of the Exec procedure to spawn a childπprocess. If you don't ever do one of these things, then you haveπmaximum use of the other; it's that simple 8<}}.π However (!), doing this is not simple, if you're doing anythingπsophistocated with TP. For instance, if you must use data >64K,πyou've _got_ to use pointers - which implies dynamic memoryπallocation (and consumes the Heap. If, OTOH, you Exec to DOS toπrun other programs or DOS calls from within your program, youπmust leave sufficient memory for DOS to load that otherπprogram, etc. This, of course, depends on what you're Exec-ing.π In either case, your program logic and application must determineπhow much Heap_Max to reserve. The default is 640K (all ofπconventional memory), which prevents _any_ child processπExec-ing. This default will allow maximum possible use ofπdynamic memory (New, GetMem); any need to Exec will require aπreduced value for Heap_Max.π I often do a bit of both in my programs, and I typically use theπfollowing $M parameter:ππ {$M 8192,0,128000}ππand I change either Stack or Heap_Max as I encounter runtime errorsπduring development. Everyone must do the same, for the reasonsπI stated above.π Note that you _won't_ be able to play with this during developmentπin the IDE, since that's a program already consuming a LOT ofπavailable memory.π Hope I made some sense/cleared up some confusion/helped.πππ--- msged 2.07π * Origin: Hello, Keyboard, my old friend... (1:114/18.10)πππ------------------------------------------------------------------------ππEcho Flag : Permanent: N Export: N Personal Read: Nππ BBS: IN-TECH Conference: PASCAL Imported: 11/11/1991π To: ZAK SMITH Num: 1295 Date: 11/03/1991πFrom: TREVOR CARLSEN Re: 0 Time: 1:58 amπSubj: >NUL REDIRECTION Prvt: N Read: Nππ ZS> Change that toπ ZS> EXEC ('C:\COMMAND.COM','c:\pkzip.exe -o ..... >nul');ππI'd reckon that will not work on a majority of systems. Better is ...ππ exec(GetEnv('COMSPEC'),'c:\pkzip...etc');ππThat way it is not command.com specific.ππTeeCeeππ--- TC-ED v2.01 π * Origin: The Pilbara's Pascal Centre (+61 91 732569) (3:690/644)π π 8 06-08-9308:25ALL SWAG SUPPORT TEAM Kill DIR Routine IMPORT 13 (*π===========================================================================π BBS: The Beta ConnectionπDate: 06-05-93 (12:54) Number: 67πFrom: BRENDEN WALKER Refer#: NONEπ To: WAYNE DOYLE Recvd: NOπSubj: DIR. SEARCH Conf: (321) Pascal___Uπ---------------------------------------------------------------------------π WD│ Hi Everyone,π │ I'm interested in finding out how to have the computer search andπ │ find all of the available directories on a disk. I have a program whichπ │ deletes all of *.BAK files on a disk and I'd like to know how it findsπ │ all of the directories.ππ The below example code, will kill a directory and all of it'sπsub-directories. This could be modified to delete all of the .BAK files inπall directories on the hard-drive.ππ Of course, this may not help much, but I rarely use pseudo-code.π*)ππprocedure Kill_Dir(p : pathstr);πvar Od, Rd : pathstr;π Sr : SearchRec;π t : file;ππbeginπ getdir(0,Od);π ChDir(p);π if length(p) > 4 then p := p + '\';π FindFirst('*.*', anyfile, Sr);π while DosError = 0 doπ beginπ temp := p + Sr.Name;π if (Sr.Attr and Directory > 0) thenπ beginπ if (Sr.Name <> '.') and (Sr.Name <> '..') thenπ beginπ Rd := temp;π Kill_Dir(temp);π RmDir(Rd);π end;π endπ elseπ beginπ assign(t,sr.name);π erase(t);π end;π FindNext(Sr);π end;π ChDir(Od);πend;π 9 06-08-9308:26ALL SWAG SUPPORT TEAM National Language SupportIMPORT 32 {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─πMsg : 493 of 505πFrom : Andres Cvitkovich 2:310/36.9 28 Apr 93 22:59πTo : Jon Leosson 2:391/20.0πSubj : Reading the country infoπ────────────────────────────────────────────────────────────────────────────────πHi Jon,ππWednesday, April 14 1993, Jon Leosson wrote to All:ππ JL> Does anybody know how one can read the country info which is set byπ JL> COUNTRY.SYS in DOS 4.0 and 5.0? Any help would be appreciated...ππor DOS 6.0 or DOS 3.x or ... ;-)ππhere we go:ππ---------------------------------------------------------------}πUnit NLS;ππ{ NLS.PAS - National Language Support }π{ ─────────────────────────────────── }π{ (W) Written 1992 by A. Cvitkovich }ππINTERFACEππCONSTπ DATE_USA = 0;π DATE_EUROPE = 1;π DATE_JAPAN = 2;π TIME_12HOUR = 0;π TIME_24HOUR = 1;ππTYPEπ CountryInfo = Recordπ ciDateFormat : Word;π ciCurrency : Array [1..5] Of Char;π ciThousands : Char;π ciASCIIZ_1 : Byte;π ciDecimal : Char;π ciASCIIZ_2 : Byte;π ciDateSep : Char;π ciASCIIZ_3 : Byte;π ciTimeSep : Char;π ciASCIIZ_4 : Byte;π ciBitField : Byte;π ciCurrencyPlaces: Byte;π ciTimeFormat : Byte;π ciCaseMap : Procedure;π ciDataSep : Char;π ciASCIIZ_5 : Byte;π ciReserved : Array [1..10] Of Byteπ End;ππ DateString = String [10];π TimeString = String [10];ππVAR Country : CountryInfo;πππFUNCTION GetCountryInfo (Buf: Pointer): Boolean;πFUNCTION DateStr: DateString;πFUNCTION TimeStr: TimeString;πππIMPLEMENTATIONππUSES Dos;ππFUNCTION GetCountryInfo (Buf: Pointer): Boolean; Assembler;πAsmπ mov ax, 3800hπ push dsπ lds dx, Bufπ int 21hπ mov al, TRUEπ jnc @@1π xor al, alπ@@1:π pop dsπEnd;ππFUNCTION DateStr: DateString;πVAR Year, Month, Day, Weekday : Word;π dd, mm : String[2];π yy : String[4];πBEGINπ GetDate (Year, Month, Day, WeekDay);π Str (Day:2, dd); If dd[1] = ' ' Then dd[1] := '0';π Str (Month:2, mm); If mm[1] = ' ' Then mm[1] := '0';π Str (Year:4, yy);π Case Country.ciDateFormat Ofπ DATE_USA: DateStr := mm + Country.ciDateSep + dd +π Country.ciDateSep + yy;π DATE_EUROPE: DateStr := dd + Country.ciDateSep + mm +π Country.ciDateSep + yy;π DATE_JAPAN: DateStr := yy + Country.ciDateSep + mm +π Country.ciDateSep + dd;π Else DateStr := ''π End;πEND;πππFUNCTION TimeStr: TimeString;πVAR Hour, Min, Sec, Sec100 : Word;π hh, mm, ss : String[2];π ampm : Char;πBEGINπ GetTime (Hour, Min, Sec, Sec100);π Str (Min:2, mm); If mm[1] = ' ' Then mm[1] := '0';π Str (Sec:2, ss); If ss[1] = ' ' Then ss[1] := '0';π Case Country.ciTimeFormat Ofπ TIME_12HOUR: Beginπ If Hour < 12 Then ampm := 'a' Else ampm := 'p';π Hour := Hour MOD 12;π If Hour = 0 Then Hour := 12; Str (Hour:2, hh);π TimeStr := hh + Country.ciTimeSep + mm +π Country.ciTimeSep + ss + ampm + 'm'π End;π TIME_24HOUR: Beginπ Str (Hour:2, hh);π TimeStr := hh + Country.ciTimeSep + mm +π Country.ciTimeSep + ssπ End;π Else TimeStr := ''π End;πEND;πππBEGINπ If Not GetCountryInfo (@Country) Then Beginπ Country.ciDateFormat := DATE_USA;π Country.ciDateSep := '-';π Country.ciTimeFormat := TIME_12HOUR;π Country.ciTimeSep := ':';π End;πEND. 10 06-22-9307:51ALL SWAG SUPPORT TEAM Reboot System Warm/Cold IMPORT 24 ===========================================================================π BBS: Canada Remote SystemsπDate: 06-15-93 (11:09) Number: 8831πFrom: GREG ESTABROOKS Refer#: NONEπ To: KURT TAN Recvd: NO πSubj: REBOOT Conf: (58) PASCALπ---------------------------------------------------------------------------πKT>Can anybody tell me how to reboot with Turbo Pascal?ππ Below are the routines I use to reboot the system.π Hope they help ya.ππ{********************************************************************}πPROGRAM RebootSys; { June 15/93, Greg Estabrooks }πUSES CRT; { Writeln,Readkey,Clrscr }πVARπ CH :CHAR; { Hold Boot Choice }ππPROCEDURE WarmBoot;π { Routine to cause system to do a WARM Boot }πππBEGINπ Inline(π $FB/ { STI }π $B8/00/00/ { MOV AX,0000 }π $8E/$D8/ { MOV DS,AX }π $B8/$34/$12/ { MOV AX,1234 }π $A3/$72/$04/ { MOV [0472],AX }π $EA/$00/$00/$FF/$FF); { JMP FFFF:0000 }πEND;ππPROCEDURE ColdBoot;π { Routine to cause system to do a COLD Boot }πBEGINπ Inline(π $FB/ { STI }π $B8/01/00/ { MOV AX,0001 }π $8E/$D8/ { MOV DS,AX }π $B8/$34/$12/ { MOV AX,1234 }π $A3/$72/$04/ { MOV [0472],AX }π $EA/$00/$00/$FF/$FF); { JMP FFFF:0000 }πEND;ππBEGINπ Clrscr; { Clear the screen }π { Ask for which type of boot to be used }π Writeln('Would You like to do a [W]arm or [C]old Boot? ');π CH := Readkey; { Get Users Choice, }ππ CASE UpCase( CH ) OFπ 'W' : BEGINπ Writeln('Doing a Warm Boot ');π WarmBoot; { Call warm Reboot procedure }π END;π 'C' : BEGINπ Writeln('Doing a Cold Boot ');π ColdBoot; { Call cold reboot procedure }π END;π Else { Else don't reboot at all }π Writeln('Not Rebooting!');π END;πEND.π{***********************************************************************}ππGreg Estabrooks <<Message Entered on 06-15-93 at 09am>>π---π ■ OLX 2.1 TD ■ Beer. It's not just for breakfast anymore!π ■ RoseMail 2.10ß: NANET: VE1EI BBS, Halifax NS, (902)-868-2475π 11 06-22-9309:12ALL SWAG SUPPORT TEAM Another Warm/Cold BOOT IMPORT 19 ===========================================================================π BBS: Canada Remote SystemsπDate: 06-17-93 (20:44) Number: 8849πFrom: GREG VIGNEAULT Refer#: NONEπ To: KURT TAN Recvd: NO πSubj: WARM & COLD TP REBOOT... Conf: (58) PASCALπ---------------------------------------------------------------------------πKT> Can anybody tell me how to reboot with Turbo Pascal?ππ Hi Kurt,ππ You may find that using interrupt $19 doesn't work on many systems.ππ The following cold and warm boot procedures should work under mostπ PC/MS-DOS environments. It doesn't use either ASM or INLINE ...ππ(*******************************************************************)πPROGRAM DemoReboot; { force a Cold or Warm Reboot }ππUSES Crt, { import ClrScr, ReadKey }π Dos; { import Intr(), Registers }ππPROCEDURE Reboot; { <- only call from Cold & WarmBoot }π VAR dummy : Registers; { Intr() needs Register TYPE }π BEGINπ MemW[0:0] := 0; { modify an interrupt vector (eg.0) }π MemW[0:2] := $FFFF; { to point to $FFFF:$0000 }π Intr(0,dummy); { and force a call to it }π END {Reboot};ππPROCEDURE ColdBoot; { like a system power-up or reset }π BEGINπ MemW[0:$472] := $7F7F; { tell the system it's a Cold boot }π Reboot; { ...we don't return from here }π END {ColdBoot};ππPROCEDURE WarmBoot; { same as Ctrl-Alt-Del reboot }π BEGINπ MemW[0:$472] := $1234; { tell the system it's a Warm boot }π Reboot; { ...bye-bye }π END {WarmBoot};ππBEGINπ ClrScr;π Write('Do you want a Warm or Cold reboot (W/C) ? ');π IF UpCase(ReadKey) = 'W' THEN WarmBoot ELSE ColdBoot;ππEND {DemoReboot}.π(*******************************************************************)πππ Greg_ππ Jun.17.1993.Toronto UUCP greg.vigneault@bville.gts.org FIDO 1:250/304π---π ■ RoseMail 2.10ß: NANET 41-62-24 Baudeville -Toronto ON - 416-283-0114π 12 06-22-9309:23ALL SWAG SUPPORT TEAM Dealing with File Share IMPORT 29 ===========================================================================π BBS: Canada Remote SystemsπDate: 06-16-93 (16:14) Number: 26531πFrom: LARS HELLSTEN Refer#: NONEπ To: RITO SALOMONE Recvd: NO πSubj: Re: Novell/File Locking/S Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πRS> Does anyone have any samples of network file sharing/access code for TurboπRS> Pascal/Borland Pascal 6-7.ππ Here's some source that I use. I haven't had a chance to test it outπas much as I'd like to, but so far, it appears to work quite nicely:ππ--- 8< --------------------------------------------------------------------πUnit Share;ππINTERFACEππUses DOS;ππVarπ ShareInstalled : Boolean;ππFunction LockRec(Var Untyped; pos, size : LongInt) : Boolean;πFunction UnLockRec(Var Untyped; pos, size : LongInt) : Boolean;πProcedure FMode(Mode : Byte);πFunction Share : Boolean;ππIMPLEMENTATIONππFunction LockRec(Var Untyped; pos, size : LongInt) : Boolean;ππVarπ Regs : Registers;π f : File absolute Untyped;ππBeginπ pos := pos * FileRec(f).RecSize;π size := size * FileRec(f).RecSize;π Regs.AH := $5C;π Regs.AL := $00;π Regs.BX := FileRec(f).Handle;π Regs.CX := Hi(pos);π Regs.DX := Lo(pos);π Regs.SI := Hi(size);π Regs.DI := Lo(size);π Intr($21,Regs);π LockRec := (Regs.Flags AND FCarry) = 0;πEnd; { LockRec }ππFunction UnLockRec(Var Untyped; pos, size : LongInt) : Boolean;ππVarπ Regs : Registers;π f : File absolute Untyped;ππBeginπ pos := pos * FileRec(f).RecSize;π size := size * FileRec(f).RecSize;π Regs.AH := $5C;π Regs.AL := $01;π Regs.BX := FileRec(f).Handle;π Regs.CX := Hi(pos);π Regs.DX := Lo(pos);π Regs.SI := Hi(size);π Regs.DI := Lo(size);π Intr($21,Regs);π UnlockRec := (Regs.Flags AND FCarry) = 0;πEnd; { UnLockRec }ππProcedure FMode(Mode : Byte);ππBeginπ If ShareInstalled thenπ If (mode in [0..2,23..24,48..50,64..66]) thenπ FileMode := Mode;πEnd;ππfunction Share : boolean;πvar regs : registers;πbeginπ with regs doπ beginπ AH := 16;π AL := 0;π Intr($2f, regs);π Share := AL = 255;π end;πend; { IsShare }ππBeginπ ShareInstalled := Share;πEnd. { MyShare }π--- 8< ---------------------------------------------------------------------ππ By the way, the unit name should be "MyShare", there's duplicateπidentifiers in there by accident. All you do, is call the lock/unlockπroutines, passing the file variable, the record number, and the number ofπrecords (you'll see it determines the size itself, using the FileRec.RecSizeπvariable). The FMode procedure doesn't do much, I just use it instead ofπconstantly putting "If ShareInstalled then FileMode :=..." inside theπprogram(s). You should call this to set the FileMode variable to a sharingπmethod, before you reset the file. Here's a table of values you can pass:ππ Sharing MethodπAccess Method Compatibility Deny Write Deny Read Deny Noneπ-------------------------------------------------------------------πRead Only 0 32 48 64πWrite Only 1 33 49 65πRead/Write 2 34 50 66π-------------------------------------------------------------------ππ--- GEcho 1.00π * Origin: Access-PC BBS ■ Scarborough, ON ■ (416)491-9249 (1:250/320)π 13 07-16-9306:09ALL ROB GREEN DOS ICA Put/Get Routine IMPORT 24 ┤φ ===========================================================================π BBS: Canada Remote SystemsπDate: 06-30-93 (07:05) Number: 28694πFrom: ROB GREEN Refer#: NONEπ To: RAND NOWELL Recvd: NO πSubj: CODE FOR PROGRAM Conf: (1221) F-PASCALπ---------------------------------------------------------------------------π > Another way would be to, upon program startup, is create anπ > enviornment var refering to your program. Say the program isπ > RR.EXE, create a var as Set RR = INSTALLED! then when youπ > shell, search the enviornment for RR, if it equals INSTALLED!π > then present message, if the RR var not exists, then load theπ > program. Of course when the program quits you want to seet RR =π > (nothing).....ππHeres the way i do it...ππunit AmLoaded;ππinterfaceππtypeπ ICAType = recordπ Stext : string[13];π chksum: integer;π end;ππvarπ ica : icaType absolute $0000:$04f0;ππProcedure PutICA(sText:string);ππprocedure GetIca(var stext:string);ππfunction IcaSame(Stext:string):boolean;πππimplementationππProcedure PutICA(sText:string);πvarπ j:byte;πBeginπ fillchar(ica.stext,sizeof(ica.stext),0);π ica.stext:=copy(stext,1,13);π ica.stext[0]:=#13;π Ica.ChkSum:=0;π for j:=0 to 13 doπ Ica.ChkSum:=Ica.ChkSum+ord(ica.stext[j]);πEnd;πππProcedure GetIca(var stext:string);πBeginπ stext:=ica.stext;πEnd;ππfunction IcaSame:boolean;πvarπ j:byte;π k,m:integer;πbeginπ k:=0;π m:=0;π for j:=0 to 13 doπ Beginπ k:=k+ord(ica.stext[j]);π m:=m+ord(stext[j]);π end;π if k=m thenπ Beginπ if ica.chksum=m thenπ IcaSame:=trueπ elseπ IcaSame:=False;π endπ elseπ icasame:=false;πend;ππend.π-----------------------πTest program:ππuses AmLoaded;πBeginπ PutIca('ATEST');π Writeln('ATEST, should come back as same');π {Check to see if we can read it back without changing anything}π If IcaSame('ATEST') thenπ writeln('Same')π elseπ writeln('Not Same');π PutICA('Another Test');π Writeln('Another Test, should come back as not same');π {Change the lower case 'h' into an uppercase 'H'}π Ica.Stext[5]:='H';π If IcaSame('Another Test') thenπ writeln('Same')π elseπ writeln('Not same');π PutIca('hello world');π writeln('Hello world, should come back as not same');π {Change the chksum}π ica.chksum:=111;π If IcaSame('hello world'); thenπ writeln('Same')π elseπ writeln('Not same');πEnd.π-------------------------------------------ππBefore doing EXEC do this:πPutICA('Program name'); {up to 13 chars}πEXEC(getenv('COMSPEC'),'Whatever');πPutIca(' '); {Or null}ππThen when starting your program do this:πIf ICASame('Program name') thenπ writeln('Can''t load Program name on top of itself');πππRobππ--- FMail 0.94π * Origin: The Rush Room - We OWN Orlando - (407) 678 & 0749 (1:363/166)π 14 07-17-9307:28ALL GAYLE DAVIS DOS Critical Errors IMPORT 76 ┤φ {$S-,R-,V-,I-,N-,B-,F-}ππ{$IFNDEF Ver40}π {Allow overlays}π {$F+,O-,X+,A-}π{$ENDIF}ππUNIT CritErr;ππINTERFACEππUSES DOS;ππTYPEπ Str10 = STRING[10];π IOErrorRec = Recordπ RoutineName : PathStr;π ErrorAddr : Str10;π ErrorType : Str10;π TurboResult : Word; { TP Error number }π IOResult : Word; { DOS Extended number }π ErrMsg : PathStr;π End;πππ{}PROCEDURE IOResultTOErrorMessage (IOCode : WORD; VAR MSG : STRING);π{}PROCEDURE GetDOSErrorMessage (VAR Msg : STRING);π{}FUNCTION UserIOError(ErrNum : INTEGER; VAR IOErr : IOErrorRec) : BOOLEAN;π{}PROCEDURE CriticalErrorDOS;π{}PROCEDURE CriticalErrorTP;π{}PROCEDURE CriticalErrorOwn(ErrAddr: POINTER);ππIMPLEMENTATIONππVARπ TurboInt24: POINTER; { Holds address of TP's error handler }ππ function Hex(v: Longint; w: Integer): String;π varπ s : String;π i : Integer;π constπ hexc : array [0 .. 15] of Char= '0123456789abcdef';π beginπ s[0] := Chr(w);π for i := w downto 1 do beginπ s[i] := hexc[v and $F];π v := v shr 4π end;π Hex := s;π end {Hex};πππPROCEDURE CriticalErrorDOS;ππ BEGINπ SetIntVec($24,SaveInt24);π END;ππππPROCEDURE CriticalErrorTP;ππ BEGINπ SetIntVec($24,TurboInt24);π END;ππππPROCEDURE CriticalErrorOwn(ErrAddr: POINTER);ππ BEGINπ SetIntVec($24,ErrAddr);π END;ππππPROCEDURE GetDOSErrorMessage (VAR Msg : STRING);ππTYPE pointerwords =π RECORDπ ofspoint, segpoint : WORD;π END;ππVARπ breakdown : pointerwords ABSOLUTE erroraddr;ππBEGINπIOResultToErrorMessage (ExitCode, MSG);π WITH breakdown DOπ Msg := Msg + ' $' + hex (SegPoint, 4) + ':' + hex (OfsPoint, 4);πEND; {Exitprogram}ππPROCEDURE IOResultToErrorMessage (IOCode : WORD; VAR MSG : STRING);πBEGINπ CASE IOCode OFπ $01 : msg := 'Invalid DOS Function Number';π $02 : msg := 'File not found ';π $03 : msg := 'Path not found ';π $04 : msg := 'Too many open files ';π $05 : msg := 'File access denied ';π $06 : msg := 'Invalid file handle ';π $07 : msg := 'Memory Control Block Destroyed';π $08 : msg := 'Not Enough Memory';π $09 : msg := 'Invalid Memory Block Address';π $0A : msg := 'Environment Scrambled';π $0B : msg := 'Bad Program EXE File';π $0C : msg := 'Invalid file access mode';π $0D : msg := 'Invalid Data';π $0E : msg := 'Unknown Unit';π $0F : msg := 'Invalid drive number ';π $10 : msg := 'Cannot remove current directory';π $11 : msg := 'Cannot rename across drives';π $12 : msg := 'Disk Read/Write Error';π $13 : msg := 'Disk Write-Protected';π $14 : msg := 'Unknown Unit';π $15 : msg := 'Drive Not Ready';π $16 : msg := 'Unknown Command';π $17 : msg := 'Data CRC Error';π $18 : msg := 'Bad Request Structure Length';π $19 : msg := 'Seek Error';π $1A : msg := 'Unknown Media Type';π $1B : msg := 'Sector Not Found';π $1C : msg := 'Printer Out Of Paper';π $1D : msg := 'Disk Write Error';π $1E : msg := 'Disk Read Error';π $1F : msg := 'General Failure';π $20 : msg := 'Sharing Violation';π $21 : msg := 'Lock Violation';π $22 : msg := 'Invalid Disk Change';π $23 : msg := 'File Control Block Gone';π $24 : msg := 'Sharing Buffer Exceeded';π $32 : msg := 'Unsupported Network Request';π $33 : msg := 'Remote Machine Not Listening';π $34 : msg := 'Duplicate Network Name';π $35 : msg := 'Network Name NOT Found';π $36 : msg := 'Network BUSY';π $37 : msg := 'Device No Longer Exists On NETWORK';π $38 : msg := 'NetBIOS Command Limit Exceeded';π $39 : msg := 'Adapter Hardware ERROR';π $3A : msg := 'Incorrect Response From NETWORK';π $3B : msg := 'Unexpected NETWORK Error';π $3C : msg := 'Remote Adapter Incompatible';π $3D : msg := 'Print QUEUE FULL';π $3E : msg := 'No space For Print File';π $3F : msg := 'Print File Cancelled';π $40 : msg := 'Network Name Deleted';π $41 : msg := 'Network Access Denied';π $42 : msg := 'Incorrect Network Device Type';π $43 : msg := 'Network Name Not Found';π $44 : msg := 'Network Name Limit Exceeded';π $45 : msg := 'NetBIOS session limit exceeded';π $46 : msg := 'Filer Sharing temporarily paused';π $47 : msg := 'Network Request Not Accepted';π $48 : msg := 'Print or Disk File Paused';π $50 : msg := 'File Already Exists';π $52 : msg := 'Cannot Make Directory';π $53 : msg := 'Fail On Critical Error';π $54 : msg := 'Too Many Redirections';π $55 : msg := 'Duplicate Redirection';π $56 : msg := 'Invalid Password';π $57 : msg := 'Invalid Parameter';π $58 : msg := 'Network Device Fault';π $59 : msg := 'Function Not Supported By NETWORK';π $5A : msg := 'Required Component NOT Installed';ππ (* Pascal Errors *)π 94 : msg := 'EMS Memory Swap Error';π 98 : msg := 'Disk Full';π 100 : msg := 'Disk read error ';π 101 : msg := 'Disk write error ';π 102 : msg := 'File not assigned ';π 103 : msg := 'File not open ';π 104 : msg := 'File not open for input ';π 105 : msg := 'File not open for output ';π 106 : msg := 'Invalid numeric format ';π 150 : msg := 'Disk is write_protected';π 151 : msg := 'Unknown unit';π 152 : msg := 'Drive not ready';π 153 : msg := 'Unknown command';π 154 : msg := 'CRC error in data';π 155 : msg := 'Bad drive request structure length';π 156 : msg := 'Disk seek error';π 157 : msg := 'Unknown media type';π 158 : msg := 'Sector not found';π 159 : msg := 'Printer out of paper';π 160 : msg := 'Device write fault';π 161 : msg := 'Device read fault';π 162 : msg := 'Hardware Failure';π 163 : msg := 'Sharing Confilct';π 200 : msg := 'Division by zero ';π 201 : msg := 'Range check error ';π 202 : msg := 'Stack overflow error ';π 203 : msg := 'Heap overflow error ';π 204 : msg := 'Invalid pointer operation ';π 205 : msg := 'Floating point overflow ';π 206 : msg := 'Floating point underflow ';π 207 : msg := 'Invalid floating point operation ';π 390 : msg := 'Serial Port TIMEOUT';π 399 : msg := 'Serial Port NOT Responding';ππ 1008 : Msg := 'EMS Memory Swap Error 'π ELSEπ GetDosErrorMessage (Msg);π END;πEND;πππFUNCTION UserIOError(ErrNum : INTEGER; VAR IOErr : IOErrorRec) : BOOLEAN;π{ RETURN ALL INFO ABOUT THE ERROR IF IT OCCURED}πCONSTπ ErrTitles : ARRAY [1..5] OF STRING [10] =π ('System', 'Disk', 'Network', 'Serial', 'Memory');ππVARπ Msg : STRING;π Regs : REGISTERS;ππ BEGINππ UserIOError := FALSE;π FILLCHAR(IOErr,SizeOf(IOErr),#0);π IF ErrNum <=0 THEN EXIT;ππ { GET DOS Extended Error }π WITH Regs DOπ BEGINπ AH := $59;π BX := $00;π MSDOS (Regs);π END;ππ IOResultToErrorMessage (Regs.AX, Msg);ππ IOErr.RoutineName := PARAMSTR (0);π IOErr.ErrorAddr := Hex (SEG (ErrorAddr^), 4) + ':' + Hex (OFS (ErrorAddr^), 4);π IOErr.ErrorType := ErrTitles[Regs.CH];π IOErr.TurboResult := ErrNum;π IOErr.IOResult := Regs.AX;π IOErr.ErrMsg := Msg;ππ UserIOError := (ErrNum > 0);π END;ππBEGINπ GetIntVec($24,TurboInt24);π CriticalErrorDOS;πEND.ππ{ -------------------------- DEMO --------------------- }ππ{ EXAMPLE FOR CRITICAL ERROR HANDLER UNIT }π{ COMPILE AND RUN FROM DOS !!! WILL NOT WORK PROPERLY FROM THE IDE }π{$I-} { A MUST FOR THE CRITICAL HANDLER TO WORK !!!! }ππUSESπ CRT, CRITERR;ππVARπ f: TEXT;π i: INTEGER;π ErrMsg : STRING;π IOErr : IOErrorRec;ππBEGINπ ClrScr;π WriteLn(' EXAMPLE PROGRAM FOR CRITICAL ERROR HANDLER ');π WriteLn;π WriteLn('Turbo Pascal replaces the operating system''s critical-error');π WriteLn('handler with its own. For this demonstration we will generate');π WriteLn('a critical error by attempting to access a diskette that is not');π WriteLn('present. Please ensure that no diskette is in drive A, then');π WriteLn('press RETURN...');π ReadLn;π CriticalErrorTP;π Assign(f,'A:NOFILE.$$$');π WriteLn;π WriteLn('Now attempting to access drive...');π Reset(f);π IF UserIOError(IOResult,IOErr) THENπ BEGINπ WriteLn(IOErr.RoutineName);π WriteLn(IOErr.ErrorAddr);π WriteLn(IOErr.ErrorType);π WriteLn(IOErr.TurboResult);π WriteLn(IOErr.IOResult);π WriteLn(IOErr.ErrMsg);π END;π WriteLn;π Write('Press RETURN to continue...');π ReadLn;π WriteLn;π CriticalErrorDOS;π WriteLn('With the DOS error handler restored, you will be presented');π WriteLn('with the usual "Abort, Retry, Ignore?" prompt when such an');π WriteLn('error occurs. (Later DOS versions allow a "Fail" option.)');π WriteLn('Run this program several times and try different responses.');π Write('Press RETURN to continue...');π ReadLn;π WriteLn('Now attempting to access drive again...');π Reset(f);π IF UserIOError(IOResult,IOErr) THENπ BEGINπ WriteLn(IOErr.RoutineName);π WriteLn(IOErr.ErrorAddr);π WriteLn(IOErr.ErrorType);π WriteLn(IOErr.TurboResult);π WriteLn(IOErr.IOResult);π WriteLn(IOErr.ErrMsg);π END;π Readkey;πEND.ππ 15 08-17-9308:41ALL SWAG SUPPORT TEAM Demostrates EXEC Proc IMPORT 18 ┤φ {$M 8192,0,0}π{* This memory directive is used to makeπ certain there is enough memory leftπ to execute the DOS shell and anyπ other programs needed. *}ππProgram EXEC_Demo;ππ{*ππ EXEC.PASππ This program demonstrates the use ofπ Pascal's EXEC function to executeπ either an individual DOS command orπ to move into a DOS Shell.ππ You may enter any command you couldπ normally enter at a DOS prompt andπ it will execute. You may also hitπ RETURN without entering anything andπ you will enter into a DOS Shell, fromπ which you can exit by typing EXIT.ππ The program stops when you hit aπ 'Q', upper or lower case.π*}πππUses Crt, Dos;ππVarπ Command : String;ππ{**************************************}πProcedure Do_Exec; {*******************}ππ Varπ Ch : Char;ππ Beginπ If Command <> '' Thenπ Command := '/C' + Commandπ Elseπ Writeln('Type EXIT to return from the DOS Shell.');π {* The /C prefix is needed toπ execute any command other thanπ the complete DOS Shell. *}ππ SwapVectors;π Exec(GetEnv('COMSPEC'), Command);π {* GetEnv is used to read COMSPECπ from the DOS environment so theπ program knows the correct pathπ to COMMAND.COM. *}ππ SwapVectors;π Writeln;π Writeln('DOS Error = ',DosError);π If DosError <> 0 Thenπ Writeln('Could not execute COMMAND.COM');π {* We're assuming that the onlyπ reason DosError would be somethingπ other than 0 is if it couldn'tπ find the COMMAND.COM, but thereπ are other errors that can occur,π we just haven't provided for themπ here. *}ππ Writeln;π Writeln;π Writeln('Hit any key to continue...');π Ch := ReadKey;π End;πππFunction Get_Command : String;ππ Varπ Count : Integer;π Cmnd : String;ππ Beginπ Clrscr;π Write('Enter DOS Command (or Q to Quit): ');π Readln(Cmnd);π Get_Command := Cmndπ End;ππBeginπ Command := Get_Command;π While NOT ((Command = 'Q') OR (Command = 'q')) Doπ Beginπ Do_Exec;π Command := Get_Commandπ End;πEnd. 16 08-18-9312:22ALL JOSE ALMEIDA Get the program Name IMPORT 10 ┤φ { Gets the program name.π Part of the Heartware Toolkit v2.00 (HTfile.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Get_Prg_Name : String8;ππ{ DESCRIPTION:π Gets the program name.π SAMPLE CALL:π St := Get_Prg_Name;π RETURNS:π The program name, e.g., '12345678'π or '$$$$$$$$' if not available.π NOTES:π This function excludes the .EXE extension of the program. }ππvarπ St : string;π F : byte;π Found : boolean;ππBEGIN { Get_Prg_Name }π St := ParamStr(0);π Found := No;π F := Length(St);π while (F > 0) and (not Found) doπ beginπ if St[F] = '\' thenπ Found := Yesπ elseπ Dec(F);π end;π St := Copy(St,Succ(F),255);π F:= Pos('.',St);π Delete(St,F,255);π if St = '' thenπ St := '$$$$$$$$';π Get_Prg_Name := St;πEND; { Get_Prg_Name }π 17 08-18-9312:30ALL JOSE ALMEIDA Get the Country Code IMPORT 25 ┤φ { Gets the current country code number.π Part of the Heartware Toolkit v2.00 (HTelse.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππPROCEDURE Get_Country_Code(var CC : word;π var Error_Code : byte);π{ DESCRIPTION:π Gets the current country code number.π SAMPLE CALL:π Get_Country_Code(CC,Error_Code);π RETURNS:π CC : country code numberπ or $FFFF if Error_Code <> 0π Error_Code : see The Programmers PC Source Book 3.191π NOTES:π None. }ππvarπ TmpA : array[1..34] of byte;π HTregs : registers;ππBEGIN { Get_Country_Code }π FillChar(TmpA,SizeOf(TmpA),0);π HTregs.AX := $3800;π HTregs.DX := Ofs(TmpA);π HTregs.DS := Seg(TmpA);π MsDos(HTregs);π if HTregs.Flags and FCarry <> 0 thenπ beginπ CC := $FFFF; { on error set to $FFFF }π Error_Code := HTregs.AL;π endπ elseπ beginπ CC := HTregs.BX;π Error_Code := 0;π end;πEND; { Get_Country_Code }ππππFUNCTION Get_Country_Code_Text(CC : word) : String25;ππ{ DESCRIPTION:π Gets country code in string format.π SAMPLE CALL:π St := Get_Country_Code_Text(CC);π RETURNS:π Country code name.π NOTES:π None. }ππBEGIN { Get_Country_Code_Text }π case CC ofπ 001 : Get_Country_Code_Text := 'United States';π 002 : Get_Country_Code_Text := 'Canada (French)';π 003 : Get_Country_Code_Text := 'Latin America';π 031 : Get_Country_Code_Text := 'Netherlands';π 032 : Get_Country_Code_Text := 'Belgium';π 033 : Get_Country_Code_Text := 'France';π 034 : Get_Country_Code_Text := 'Spain';π 036 : Get_Country_Code_Text := 'Hungary';π 038 : Get_Country_Code_Text := 'Yugoslavia';π 039 : Get_Country_Code_Text := 'Italy';π 041 : Get_Country_Code_Text := 'Switzerland';π 042 : Get_Country_Code_Text := 'Czechoslovakia';π 044 : Get_Country_Code_Text := 'United Kingdom';π 045 : Get_Country_Code_Text := 'Denmark';π 046 : Get_Country_Code_Text := 'Sweden';π 047 : Get_Country_Code_Text := 'Norway';π 048 : Get_Country_Code_Text := 'Poland';π 049 : Get_Country_Code_Text := 'Germany';π 055 : Get_Country_Code_Text := 'Brazil';π 061 : Get_Country_Code_Text := 'International English';π 081 : Get_Country_Code_Text := 'Japan';π 082 : Get_Country_Code_Text := 'Korea';π 086 : Get_Country_Code_Text := 'Peoples Republic of China';π 088 : Get_Country_Code_Text := 'Taiwan';π 351 : Get_Country_Code_Text := 'Portugal';π 358 : Get_Country_Code_Text := 'Finland';π 785 : Get_Country_Code_Text := 'Middle East (Arabic)';π 972 : Get_Country_Code_Text := 'Israel (Hebrew)';π elseπ Get_Country_Code_Text := 'Unknown';π end;πEND; { Get_Country_Code_Text }π 18 08-27-9320:13ALL SEAN PALMER Batch Error Level IMPORT 7 ┤φ {πSEAN PALMERππ> How would I use this Variable after I Exit the pascal Program??ππYou wouldn't. It won't work. What you COULD do though is to have it return anπerrorlevel to Dos if you cancel...π}ππProgram ruSure;πUsesπ Crt;ππProcedure yes;πbeginπ TextAttr := 12;π Writeln('Okay.'); {no error here}πend;ππProcedure no;πbeginπ TextAttr := 26;π Writeln('Aborted.');π halt(1); {report an error to Dos}πend;ππbeginπ TextAttr := 13;π Write('Do you wish to continue? [Y/N]');π Case upcase(ReadKey) ofπ 'Y' : yes;π 'N' : no;π end;πend.π{ππ Now the batch file :ππrusureπREM check For an error from the Programπif errorlevel 1 Goto NOPEπgoto EXITπ:NOPEπcd ..πetc.π 19 08-27-9320:14ALL LARS FOSDAL Self-modifying Batch FileIMPORT 34 ┤φ LARS FOSDALππ> Hi all. I've got a little Program that brings up a Window and severalπ> buttons in TP 7. The buttons have the names of Various batch Files on themπ> which are executed when they are pressed. The batch Files start up Variousπ> other Programs. This launchpad requires about 100K of RAM as currentlyπ> written, and I'm wondering about ways to reduce this amount significantly.π> According to the BP 7 manual resource Files can be used to reduce RAM by 8-π> 10%. Right now the Various buttons' Labels and commands are stored inπ> simple Arrays, which are not the most efficient memory-wise, but I don'tπ> think that making them Records will significantly reduce RAM need. I'd likeπ> to reduce RAM usage an order of magnitude, to about 10K. Any chance ofπ> doing this?ππThere is a dirty way of doing this, and it works With every Dos /πcommand-interpreter that I've tried it under, including Dos 6.0πin a Window under Windows, and 4Dos.ππThe Really nice thing about this way to do it, is that you can evenπload TSR's etc. since the menu Program is not in memory at all and there isπno secondary command interpreter when the user executes his choice.ππThe trick is that you run your Program from a "self-modifying" batchFile.ππ--- MENU.BAT ---π:StartAgainπSET MENU=C:\Dos\MENU.BAT ; Check this environment Var from your menu-progπGOMENU.EXE ; and abort if it is not setπSET MENU=π----------------ππLets say you want to run another batchFile from a menu choice f.x MY.BAT.πLet your Program modify the MENU.BAT to:π---π:StartAgainπSET MENU=C:\Dos\MENU.BATπGOMENU.EXEπSET MENU=πCALL MY.BATπGOTO StartAgainπ---ππWhen you want to terminate your menu-loop, simply modify the MENU.BATπback to it's original state.ππThe menu Program can be shared from a network server. There is noπlimitations at all. You can do Dos commands from the menu Withoutπhaving to load a second shell.ππFollowing my .sig there is a short example Program. It can't be runπdirectly since it Uses some libraries of mine, but you'll get an ideaπof how to do it.πππProgram HitAndRun; {Menusystem}πUsesπ Dos, Crt, LFsystem, LFCrt, LFinput;π{π Written by Lars Fosdalπ May 5th, 1991ππ Released to the public domain, May 15th, 1993π}πConstπ HitAndRunMsg = 'Written by Lars Fosdal ';π Prog = 'HIT&RUN';ππVarπ path : String;ππ{----------------------------------------------------------------------------}ππProcedure Message(MessageIndex : Integer);πbeginπ Writeln(Output);π Writeln(Output, Prog, ' - ', HitAndRunMsg);π Write(Output, 'Error: ');π Case MessageIndex OFπ -1 :π beginπ Write(Output, Prog, ' must be started from ');π Writeln(Output,Path + 'MENU.BAT');π end;π end;π Write(Output,^G);πend;ππProcedure BuildBatchFile(Execute : String);πVarπ BatchFile : Text;πbeginπ Assign(BatchFile, Path + 'MENU.BAT');π ReWrite(BatchFile);π Writeln(BatchFile, '@ECHO OFF');π Writeln(BatchFile, 'REM ' + Prog + ' Menu Minder');π Writeln(BatchFile, 'REM ' + HitAndRunMsg);π Writeln(BatchFile, ':HitAgain');π Writeln(BatchFile, 'SET H&R=BATCH');π Writeln(BatchFile, path + 'HIT&RUN');π if Execute<>'' thenπ beginπ Writeln(BatchFile, Execute);π Writeln(BatchFile, 'GOTO HitAgain');π endπ elseπ Writeln(BatchFile, 'SET H&R=');π Close(BatchFile);πend;ππFunction InitOK : Boolean;πVarπ OK : Boolean;πbeginπ path := BeforeLast('\', ParamStr(0)) + '\';π OK := GetEnv('H&R') = 'BATCH';π InitOK := OK;πend;ππProcedure HitAndRunMenu;πVarπ Mnu : aMenu;π win : aWindow;πbeginπ wDef(Win, 70, 1, 80, 25, 1, Col(Blue, LightGray), Col(Blue, White));π ItemSeparator:= '`';π mBarDefault := Red * 16 + Yellow;π mNew(Mnu, 'Pick an item to run',π 'Quit Menu`COMMAND`DIR /P`D:\BIN\NI'π + '`D:\BIN\MAPMEM`D:\BIN\X3\XTG'π + '`D:\BIN\LIST C:\Dos\MENY.BAT');π Menu(Win, Mnu);π Case Mnu.Entry OFπ 1 : BuildBatchFile('');π elseπ BuildBatchFile(Mnu.Items[Mnu.Entry]^);π end;πend;{HitAndRunMenu}ππbeginπ if InitOK thenπ HitAndRunMenuπ elseπ beginπ Message(-1);π BuildBatchFile('');π end;π Writeln(OutPut);πend.π 20 08-27-9320:49ALL GUY MCLOUGHLIN Dos IPCA IMPORT 10 ┤φ {πGUY MCLOUGHLINππ Program to load data into 16 Byte area of RAM known asπ the Dos "Inter-Process Communication Area".π}ππProgram Load_Dos_IPCA;ππTypeπ arby16 = Array[1..16] of Byte;ππ{ "Absolute" Array Variable used to access the Dos IPCA. }πVarπ IPCA : arby16 Absolute $0000:$04F0;π Index : Byte;ππbeginπ{ Write data to the Dos IPCA. }π For Index := 1 to 16 doπ IPCA[Index] := (100 + Index)πend.ππ{ Program to read data from 16 Byte area of RAM known }π{ as the Dos "Inter-Process Communication Area". }πProgram Read_Dos_IPCA;ππTypeπ arby16 = Array[1..16] of Byte;ππ{ "Absolute" Array Variable used to access the Dos IPCA. }πVarπ IPCA : arby16 Absolute $0000:$04F0;π Index : Byte;ππbeginπ Writeln;π { Display the current data found in the Dos IPCA. }π For Index := 1 to 16 doπ Write(IPCA[Index] : 4);π Writelnπend.ππ{π NOTE:π if you plan on using this in any of your serious applications, I wouldπ recommend using the last 2 Bytes of the IPCA as a CRC-16 error-check. Asπ you have no guarantee that another Program won't use the IPCA too.π} 21 08-27-9320:54ALL SWAG SUPPORT TEAM Dos Environment Unit IMPORT 43 ┤φ {πSubject: Enviro.pas Unit to change Dos Vars permanentlyπππHad this floating round, hope it helps someone.πIt works under Dos 5, NDos 6.01, and should work For any other Dos as well,πno guarantees tho' .ππ}πUnit Enviro;ππInterfaceππVar EnvSeg,π EnvOfs,π EnvSize : Word;ππFunction FindEnv:Boolean;πFunction IsEnvVar(Variable : String;Var Value : String):Boolean;πProcedure ChangeEnvVar(Variable,NewVal : String);ππImplementationππUses Dos;ππType MemoryControlBlock = {MCB -- only needed fields are shown}π Recordπ Blocktag : Byte;π BlockOwner : Word;π BlockSize : Word;π misc : Array[1..3] of Byte;π ProgramName: Array[1..8] of Char;π end;ππ ProgramSegmentPrefix = {PSP -- only needed fields are shown}π Record { offset }π PSPtag : Word; { $20CD or $27CD if PSP} { 00 $00 }π misc : Array[1..21] of Word; { 02 $02 }π Environment: Word { 44 $2C }π end;ππVarπ MCB : ^MemoryControlBlock;π r : Registers;π Found : Boolean;π SegMent : Word;π EnvPtr : Word;π Startofs : Word;ππFunction FindEnvMCB:Boolean;πVarπ b : Char;π BlockType: String[12];π Bytes : LongInt;π i : Word;π last : Char;π MCBenv : ^MemoryControlBlock;π MCBowner : ^MemoryControlBlock;π psp : ^ProgramSegmentPrefix;ππbeginπFindEnvMCB := False;ππBytes := LongInt(MCB^.BlockSize) SHL 4; {size of MCB in Bytes}πif mcb^.blockowner = 0 then { free space }πelse beginπ psp := Ptr(MCB^.BlockOwner,0); {possible PSP}π if (psp^.PSPtag = $20CD) or (psp^.PSPtag = $27CD) then beginπ MCBenv := Ptr(psp^.Environment-1,0);π if MCB^.Blockowner <> (segment + 1) thenπ if psp^.Environment = (segment + 1) thenπ if MCB^.BlockOwner = MCBenv^.BlockOwner then beginπ EnvSize := MCBenv^.BlockSize SHL 4; {multiply by 16}π EnvSeg := PSP^.Environment;π EnvOfs := 0;π FindEnvMCB := True;π endπ endπ end;πend;ππFunction FindEnv:Boolean;πbeginπr.AH := $52; {undocumented Dos Function that returns a Pointer}πIntr ($21,r); {to the Dos 'list of lists' }πsegment := MemW[r.ES:r.BX-2]; {segment address of first MCB found at}π {offset -2 from List of List Pointer }πRepeatπMCB := Ptr(segment,0); {MCB^ points to first MCB}π Found := FindEnvMcb; {Look at each MCB}π segment := segment + MCB^.BlockSize + 1πUntil (Found) or (MCB^.Blocktag = $5A);πFindEnv := Found;πend;ππFunction IsEnvVar(Variable : String;Var Value : String):Boolean;πVar Temp : String;π ch : Char;π i : Word;π FoundIt : Boolean;πbeginπVariable := Variable + '=';πFoundIt := False;πi := EnvOfs;πRepeatπ Temp := '';π StartOfs := I;π Repeatπ ch := Char(Mem[EnvSeg:i]);π if Ch <> #0 then Temp := Temp + Ch;π inc(i);π Until (Ch = #0) or (I > EnvSize);π if Ch = #0 then beginπ FoundIt := (Pos(Variable,Temp) = 1);π if FoundIt then Value := Copy(Temp,Length(Variable)+1,255);π end;πUntil (FoundIt) or (I > EnvSize);πIsEnvVar := FoundIt;πend;ππProcedure ChangeEnvVar(Variable,NewVal : String);πVar OldVal : String;π p1,p2 : Pointer;π i,j : Word;π ch,π LastCh : Char;πbeginπif IsEnvVar(Variable,OldVal) then beginπ p1 := Ptr(EnvSeg,StartOfs + Length(Variable)+1);π if Length(OldVal) = Length(NewVal) thenπ Move(NewVal[1],p1^,Length(NewVal))π else if Length(OldVal) > Length(NewVal) then beginπ Move(NewVal[1],p1^,Length(NewVal));π p1 := ptr(EnvSeg,StartOfs + Length(Variable)+Length(OldVal)+1);π p2 := ptr(EnvSeg,StartOfs + Length(Variable)+Length(NewVal)+1);π Move(p1^,p2^,EnvSize - ofs(p1^));π endπ else begin { newVar is longer than oldVar }π p2 := ptr(EnvSeg,StartOfs + Length(Variable)+Length(NewVal)-length(OldVal)+1);π Move(p1^,p2^,EnvSize - ofs(p2^));π Move(NewVal[1],p1^,Length(NewVal));π end;π endπelse { creating a new Var }π beginπ i := EnvOfs;π ch := Char(Mem[EnvSeg:i]);π Repeatπ LastCh := Ch;π inc(i);π ch := Char(Mem[EnvSeg:i]);π Until (i > EnvSize) or ((LastCh = #0) and (Ch = #0));π if i < EnvSize then beginπ j := 1;π Variable := Variable + '=' + NewVal + #0 + #0;π While (J < Length(Variable)) and (I <= EnvSize) do beginπ Mem[EnvSeg:i] := ord(Variable[j]);π inc(i); Inc(j);π end;π end;π end;πend;ππbeginπend.ππ{ TEST Program }πUses Enviro;ππVar EnvVar : String;ππbeginπif FindEnv then beginπ Writeln('Found the Enviroment !!');π Writeln('Env is at address ',EnvSeg,':',EnvOfs);π Writeln('And is ',EnvSize,' Bytes long');ππ if IsEnvVar('COMSPEC',EnvVar) then Writeln('COMSPEC = ',EnvVar)π else Writeln('COMSPEC is not set');ππ if IsEnvVar('NewVar',EnvVar) then Writeln('NewVar = ',EnvVar)π else Writeln('NewVar is not set');ππ ChangeEnvVar('NewVar','This is a new Var');ππ if IsEnvVar('NewVar',EnvVar) then Writeln('NewVar = ',EnvVar)π else Writeln('NewVar is not set');ππ ChangeEnvVar('NewVar','NewVar is now this');ππ if IsEnvVar('NewVar',EnvVar) then Writeln('NewVar = ',EnvVar)π else Writeln('NewVar is not set');ππ end;πend.π 22 08-27-9321:02ALL MARK LEWIS Extend DOS to 255 Files IMPORT 23 ┤φ {πMARK LEWISππ> The problem is that Without allocating a new FCB For Dos, youπ> can't have more than 15 or so Files open at a time in TP, noπ> matter WHAT the CONFIG.SYS FileS= statement says. (By default,ππi cannot remember exactly what INT $21 Function $6700 is but here's a PD Unitπi got from borland's bbs the other day... i've trimmed the Text down forπposting... if anyone Really needs everything that comes With it, they shouldπlook For EXTend6.*π}ππUnit Extend;π{ This extends the number of File handles from 20 to 255 }π{ Dos requires 5 For itself. Applications can use up to 250 }ππInterfaceππImplementationπUsesπ Dos;ππConstπ Handles = 255;π { You can reduce the value passed to Handles if fewer Files are required. }ππVarπ Reg : Registers;π beginπ { Check the Dos Version - This technique only works For Dos 3.0 or later }π Reg.ah := $30;π MsDos(Reg);π if Reg.al<3 thenπ beginπ Writeln('Extend Unit Require Dos 3.0 or greater');π halt(1);π end;ππ {Reset the FreePtr - This reduces the heap space used by Turbo Pascal}π if HeapOrg <> HeapPtr thenπ {Checks to see if the Heap is empty}π beginπ Write('Heap must be empty before Extend Unit initializes');π Writeln;π halt(1);π end;π Heapend := ptr(Seg(Heapend^) - (Handles div 8 + 1), Ofs(Heapend^));ππ {Determine how much memory is allocated to Program}π {Reg.Bx will return how many paraGraphs used by Program}π Reg.ah := $4A;π Reg.es := PrefixSeg;π Reg.bx := $FFFF;π msDos(Reg);ππ {Set the Program size to the allow For new handles}π Reg.ah := $4A;π Reg.es := PrefixSeg;π Reg.bx := reg.bx - (Handles div 8 + 1);π msDos(Reg);ππ {Error when a Block Size is not appropriate}π if (Reg.flags and 1) = 1 thenπ beginπ Writeln('Runtime Error ', Reg.ax, ' in Extend.');π halt(1);π end;ππ {Allocate Space For Additional Handles}π reg.ah := $67;π reg.bx := Handles;π MsDos(reg);πend.ππ{πWrite the following Program to a separate File. This Program tests the EXTendπUnit. This test should be done on systems equipped With a hard disk.π}ππProgram TestEx;ππUsesπ EXTend;ππTypeπ FileArray = Array [1..250] of Text;ππVarπ f : ^FileArray;π i : Integer;π s : String;ππbeginπ {Allocate Space For fILE Variable Table}π new(f);π {oPEN 250 Files simultaneously}π For i:=1 to 250 doπ beginπ str(i,s);π Assign(f^[i],'Dum'+s+'.txt');π reWrite(f^[i]);π Writeln('Open #',s);π end;π {Write some Text to the Files}π For i:=1 to 250 doπ Write(f^[i],'This is a test File');π {Close the Files}π For i:=1 to 250 doπ beginπ close(f^[i]);π Writeln('Closing #',i);π end;π {Erase the Files}π For i:=1 to 250 doπ beginπ erase(f^[i]);π Writeln('Erasing #',i);π end;πend.ππ 23 08-27-9321:43ALL BJOERN JOENSSON Detect OS2 IMPORT 3 ┤φ {πBJOERN JOENSSONππBTW, OS/2 is easy to detect because the major Dosπversion # is greater than 10:π}ππFunction DetectOs2 : Boolean;πbeginπ { if you use Tpro, then Write Hi(TpDos.DosVersion) }π DetectOs2 := (Lo(Dos.DosVersion) > 10);πend;π 24 08-27-9321:50ALL EMMANUEL CECCHET Cold/Warm Boot IMPORT 3 ┤φ {πFreeWare by Emmanuel CECCHETπ(C) 1992 3D CONCEPT PRODUCTIONπ}ππProcedure Cold_Boot; Assembler;πAsmπ mov AX,1700hπ int 14hπend;ππProcedure Warm_Boot; Assembler;πAsmπ mov AX,1701hπ int 14hπend;π 25 08-27-9321:57ALL LARS HELLSTEN Detecting SHARE IMPORT 12 ┤φ {πLARS HELLSTENππ> I would like to open a few Files in READ, DENY Write mode. I can get the rπ> part (just a reset), but not the DENY Write. How can I accomplish this inπ> Turbo Pascal Without locking specific Records or parts of Files, or the whoπ> File... or is that what is required?ππYou can accomplish that by changing the FileMODE Variable. Iπdon't know if that's what you're looking for, or already know this,πbut, here's a table of FileMODE values:π Sharing MethodπAccess Method Compatibility Deny Write Deny Read Deny Noneπ--------------------------------------------------------------πRead Only 0 32 48 64πWrite Only 1 33 49 65πRead/Write 2 34 50 66π--------------------------------------------------------------ππ So, as you can see, all you need to do is set the FileMODE to 32. Justπput the satement "FileMode := 32;" in before you reset the File. This willπonly work With Dos' SHARE installed, or a compatible network BIOS. if youπneed a routine to detect SHARE, here's one:π}ππUsesπ Dos;ππFunction ShareInstalled : Boolean;πVarπ Regs : Registers;πbeginπ Regs.AH := $16;π Regs.AL := $00;π Intr($21, Regs);π ShareInstalled := (Regs.AL = $FF);πend;ππbeginπ Writeln('Share: ', ShareInstalled);πend. 26 08-27-9322:06ALL ALEXANDER KUGEL Trap DOS Error IMPORT 39 ┤φ {πAlexander Kugelππ There was a discussion about how to trap floating point errorsπin TP. Here is the solution that traps any kind of run-timeπerrors. The idea is not mine. I saw it in a russian book about TPπand OOP.ππ The idea is quite simple. Instead of trying to trap all kind ofπerrors, we can let TP to do the job For us. Whenever TP stopsπexecution of the Program ( because of a run time error or justπbecause the Program stops in a natural way ) it executes theπdefault Procedure of Exit : ExitProc. Then TP checks the status ofπtwo Variables from the SYSTEM Unit : ErrorAddr and ExitCode. Ifπthere was a run time error then ErrorAddr is not NIL and ExitCodeπcontaines the run time error code. Otherwise ExitCode containes theπerrorlevel that will be set For Dos and ErrorAddr is NIL.πFortunatly we can easily redefine the ExitProc, and thus toπovertake the control from TP. The problem is that we got to be ableπto get back or to jump to any point of the Program ( even to jumpπinside a Procedure / Function). The author of the book claimed thatπhe took his routines from Turbo Professional.ππ Well, there are two Files you are gonna need. Save the first oneπas JUMP.PAS Compile it as a Unit. The second one is a short Programπthat shows how to use it. It asks For two numbers, divides theπfirst by the second and takes a natural logarithm of the result.πTry to divide by zero, logarithm of a negative number. Try enteringπletters instead of numbers and see how the Program recovers.ππ The trapping works fine under Windows/Dos. To run it WithπWindowS recompile the JUMP Unit For Windows target. Then add WinCrtπto the Uses statement and remove Mark/Release lines ( because thereπis no Mark/Release For Windows ).ππ------------------------------jump.pas-----------------------------π}ππUnit Jump;ππInterfaceππTypeπ JumpRecord = Recordπ SpReg,π BpReg : Word;π JmpPt : Pointer;π end;ππProcedure SetJump(Var JumpDest : JumpRecord);π{Storing SP,BP and the address}πInline(π $5F/ {pop di }π $07/ {pop es }π $26/$89/$25/ {mov es:[di],sp }π $26/$89/$6D/$02/ {mov es:[di+2],bp }π $E8/$00/$00/ {call null }π {null: }π $58/ {pop ax }π $05/$0C/$00/ {add ax,12 }π $26/$89/$45/$04/ {mov es:[di+4],ax }π $26/$8C/$4D/$06); {mov es:[di+6],cs }π {next: }ππProcedure LongJump(Var JumpDest : JumpRecord);π{Restore everything and jump}πInline(π $5F/ {pop di }π $07/ {pop es }π $26/$8B/$25/ {mov sp,es:[di] }π $26/$8B/$6D/$02/ {mov bp,es:[di+2] }π $26/$FF/$6D/$04); {jmp far es:[di+4]}ππImplementationππend.ππ{ ------------------------------try.pas------------------------------ }ππProgram Try;πUsesπ Jump; {Uses Jump,WinCrt;}ππVarπ OldExit : Pointer;π MyAddr : JumpRecord;π MyHeap : Pointer;ππ a1,a2,π a3,a4 : Real;πππ{$F+}πProcedure MyExit;π{You can add your error handler here}πbeginπ if ErrorAddr <> Nil Thenπ beginπ Case ExitCode ofπ 106 : Writeln('Invalid numeric format');π 200 : Writeln('Division by zero');π 205 : Writeln('Floating point overflow');π 206 : Writeln('Floating point underflow');π 207 : Writeln('Invalid floating point operation');π else Writeln('Hmmm... How did you do that ?');π end;π ErrorAddr := Nil;π LongJump(MyAddr);π end;π ExitProc := OldExit;πend;π{$F-}ππbeginπ OldExit := ExitProc;π Mark(MyHeap);π {Just an example of how to restore the heap }π {Actually we don't have to do that in }π {this Program, because we dont use heap }π {at all. But anyway here it goes }ππ {Don't forget to remove when compiling this }π {for Windows }ππ SetJump(MyAddr);ππ {We'll get back here whenever a run time }π {error occurs }π {This line should always be before }π { ExitProc:=MyExit; }π {Don't ask me why... It's much easier For me}π {to follow the rule then to understand it :)}ππ ExitProc := @MyExit;ππ Release(MyHeap);π {restoring the heap after a run time error }π {Remove this if you are compiling it For }π {Windows }ππ {Try entering whatever you want at the }π {prompt. It should trap every runtime error}π {you could possibly get. }ππ Repeatπ Writeln;π Write('Enter a number a1=');π Readln(a1);π Write('Enter a number a2=');π Readln(a2);π a3 := a1 / a2;π Writeln('a1/a2=', a3 : 10 : 5);π a4 := ln(a3);π Writeln('ln(a1/a2)=', a4 : 10 : 5);π Until a3 = 1;πend.π 27 08-27-9322:10ALL SWAG SUPPORT TEAM DOS Volume Labels IMPORT 30 ┤φ {π> I need a way to find the volume Label of a drive. Any suggestions orπ> source code?π}π{$S-,R-,V-,I-,N-,B-,F-}ππUnit Volume;ππInterfaceππUsesπ Dos;ππTypeππ Drive = Byte;π VolumeName = String [11];ππ VolFCB = Recordπ FCB_Flag : Byte;π Reserved : Array [1..5] of Byte;π FileAttr : Byte;π Drive_ID : Byte;π FileName : Array [1..8] of Byte;π File_Ext : Array [1..3] of Byte;π Unused_A : Array [1..5] of Byte;π File_New : Array [1..8] of Byte;π fExt_New : Array [1..3] of Byte;π Unused_B : Array [1..9] of Byteπ end;ππFunction DelVol (D : Byte) : Boolean;πFunction AddVol (D : Byte; V : VolumeName) : Boolean;πFunction ChgVol (D : Byte; V : VolumeName) : Boolean;πFunction GetVol (D : Byte) : VolumeName;ππImplementationππProcedure Pad_Name (Var V : VolumeName);πbeginπ While LENGTH (V) <> 11 DOπ V := V + ' 'πend;ππFunction Fix_Ext_Sym (Var V : VolumeName) : Byte;πVarπ I : Byte;πbeginπ I := POS ('.', V);π if I > 0 thenπ DELETE (V, I, 1);π Fix_Ext_Sym := Iπend;ππFunction Extract_Name (S : SearchRec) : VolumeName;πVarπ H, I : Byte;πbeginπ I := Fix_Ext_Sym (S.Name);π if (I > 0) and (I < 9) thenπ For H := 1 to (9 - I) DOπ INSERT (' ', S.Name, I);π Extract_Name := S.Nameπend;ππProcedure Fix_Name (Var V : VolumeName);πVarπ I : Byte;πbeginπ Pad_Name (V);π For I := 1 to 11π do V [I] := UPCASE (V [I])πend;ππFunction Valid_Drive_Num (D : Byte) : Boolean;πbeginπ Valid_Drive_Num := (D >= 1) and (D <= 26)πend;ππFunction Find_Vol (D : Byte; Var S : SearchRec) : Boolean;πbeginπ FINDFIRST (CHR (D + 64) + ':\*.*', VolumeID, S);π Find_Vol := DosError = 0πend;ππProcedure Fix_FCB_NewFile (V : VolumeName; Var FCB : VolFCB);πVarπ I : Byte;πbeginπ For I := 1 to 8 DOπ FCB.File_New [I] := ORD (V [I]);π For I := 1 to 3 DOπ FCB.fExt_New [I] := ORD (V [I + 8])πend;ππProcedure Fix_FCB_FileName (V : VolumeName; Var FCB : VolFCB);πVarπ I : Byte;πbeginπ For I := 1 to 8 DOπ FCB.FileName [I] := ORD (V [I]);π For I := 1 to 3 DOπ FCB.File_Ext [I] := ORD (V [I + 8])πend;ππFunction Vol_Int21 (Fnxn : Word; D : Drive; Var FCB : VolFCB) : Boolean;πVarπ Regs : Registers;πbeginπ FCB.Drive_ID := D;π FCB.FCB_Flag := $FF;π FCB.FileAttr := $08;π Regs.DS := SEG (FCB);π Regs.DX := OFS (FCB);π Regs.AX := Fnxn;π MSDos (Regs);π Vol_Int21 := Regs.AL = 0πend;ππFunction DelVol (D : Byte) : Boolean;πVarπ sRec : SearchRec;π FCB : VolFCB;π V : VolumeName;πbeginπ DelVol := False;π if Valid_Drive_Num (D) thenπ beginπ if Find_Vol (D, sRec) thenπ beginπ V := Extract_Name (sRec);π Pad_Name (V);π Fix_FCB_FileName (V, FCB);π DelVol := Vol_Int21 ($1300, D, FCB)π endπ endπend;ππFunction AddVol (D : Byte; V : VolumeName) : Boolean;πVarπ sRec : SearchRec;π FCB : VolFCB;πbeginπ AddVol := False;π if Valid_Drive_Num (D) thenπ beginπ if not Find_Vol (D, sRec) thenπ beginπ Fix_Name (V);π Fix_FCB_FileName (V, FCB);π AddVol := Vol_Int21 ($1600, D, FCB)π endπ endπend;ππFunction ChgVol (D : Byte; V : VolumeName) : Boolean;πVarπ sRec : SearchRec;π FCB : VolFCB;π x : Byte;πbeginπ ChgVol := False;π if Valid_Drive_Num (D) thenπ beginπ if Find_Vol (D, sRec) thenπ beginπ x := Fix_Ext_Sym (V);π Fix_Name (V);π Fix_FCB_NewFile (V, FCB);π V := Extract_Name (sRec);π Pad_Name (V);π Fix_FCB_FileName (V, FCB);π ChgVol := Vol_Int21 ($1700, D, FCB)π endπ endπend;ππFunction GetVol (D : Byte) : VolumeName;πVarπ sRec : SearchRec;πbeginπ GetVol := '';π if Valid_Drive_Num (D) thenπ if Find_Vol (D, sRec) thenπ GetVol := Extract_Name (sRec)πend;ππend.π
