SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00025 EXECUTION ROUTINES 1 05-28-9313:45ALL SWAG SUPPORT TEAM EXECHILD.PAS IMPORT 35 U^á (* This unit lets you execute any child program and redirect theπ child program output to NUL / PRN / CON or file.π It's very simple to use (look at the EXAMPLE.PAS).π This source is completlly freeware but make sure to removeπ this remark if any changes are made I don't want anyone toπ spread his bugs with my source.π Of course any suggestions are welcome as well as questionsπ about the source.ππ Written by Schwartz Gabriel. 20/03/1993.π Anyone who has any question can leave me a message at π CompuServe to EliaShim address 100320,36π*)ππ{$A+,B-,D-,E-,F+,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y+}ππUnit Redir;ππInterfaceππVarπ IOStatus : Integer;π RedirError : Integer;π ExecuteResult : Word;ππ{------------------------------------------------------------------------------}πprocedure Execute (ProgName, ComLine, Redir: String);π{------------------------------------------------------------------------------}ππImplementationππUses DOS;ππTypeπ PMCB = ^TMCB;π TMCB = recordπ Typ : Char;π Owner : Word;π Size : Word;π end;ππ PtrRec = recordπ Ofs, Seg : Word;π end;ππ THeader = recordπ Signature : Word;π PartPag : Word;π PageCnt : Word;π ReloCnt : Word;π HdrSize : Word;π MinMem : Word;π MaxMem : Word;π ReloSS : Word;π ExeSP : Word;π ChkSum : Word;π ExeIP : Word;π ReloCS : Word;π TablOff : Word;π OverNo : Word;π end;ππVarπ PrefSeg : Word;π MinBlockSize : Word;π MCB : PMCB;π FName : PathStr;π F : File;π MyBlockSize : Word;π Header : THeader;ππ{------------------------------------------------------------------------------}ππprocedure Execute (ProgName, ComLine, Redir: String);ππtypeπ PHandles = ^THandles;π THandles = Array [Byte] of Byte;ππ PWord = ^Word;ππvarπ RedirChanged : Boolean;π Handles : PHandles;π OldHandle : Byte;ππ {............................................................................}ππ function ChangeRedir : Boolean;ππ beginπ ChangeRedir:=False;π If Redir = '' then Exit;π Assign (F, Redir);π Rewrite (F);π RedirError:=IOResult;π If IOStatus <> 0 then Exit;π Handles:=Ptr (PrefixSeg, PWord (Ptr (PrefixSeg, $34))^);π OldHandle:=Handles^[1];π Handles^[1]:=Handles^[FileRec (F).Handle];π ChangeRedir:=True;π end;ππ {............................................................................}ππ procedure CompactHeap;ππ varπ Regs : Registers;ππ beginπ Regs.AH:=$4A;π Regs.ES:=PrefSeg;π Regs.BX:=MinBlockSize + (PtrRec (HeapPtr).Seg - PtrRec (HeapOrg).Seg);π MsDos (Regs);π end;ππ {............................................................................}ππ procedure DosExecute;ππ Beginπ SwapVectors;π Exec (ProgName, ComLine);π IOStatus:=DosError;π ExecuteResult:=DosExitCode;π SwapVectors;π End;ππ {............................................................................}ππ procedure ExpandHeap;ππ varπ Regs : Registers;ππ beginπ Regs.AH:=$4A;π Regs.ES:=PrefSeg;π Regs.BX:=MyBlockSize;π MsDos (Regs);π end;ππ {............................................................................}ππ procedure RestoreRedir;ππ beginπ If not RedirChanged then Exit;π Handles^[1]:=OldHandle;π Close (F);π end;ππ {............................................................................}ππBeginπ RedirError:=0;π RedirChanged:=ChangeRedir;π CompactHeap;π DosExecute;π Expandheap;π RestoreRedir;πEnd;ππ{------------------------------------------------------------------------------}ππBeginπ SetCBreak (False);π FName:=ParamStr (0);π Assign (F, FName);π Reset (F, 1);π IOStatus:=IOResult;π If IOStatus = 0 thenπ beginπ BlockRead (F, Header, SizeOf (Header));π IOStatus:=IOResult;π If IOStatus = 0 then MinBlockSize:=Header.PageCnt * 32 + Header.MinMem + 1π Else MinBlockSize:=$8000;π Close (F);π endπ Else MinBlockSize:=$8000;π PtrRec (MCB).Seg:=PrefixSeg - 1;π PtrRec (MCB).Ofs:=$0000;π MyBlockSize:=MCB^.Size;π PrefSeg:=PrefixSeg;πEnd.π 2 05-28-9313:45ALL SWAG SUPPORT TEAM EXECINFO.PAS IMPORT 3 U!ô {$M 4096,0,4096}ππUsesπ Dos, Prompt;ππbeginπ ChangeShellPrompt('Hi There');π SwapVectors;π Exec(GetEnv('COMSPEC'),'');π SwapVectors;πend. 3 05-28-9313:45ALL SWAG SUPPORT TEAM PROMPT.PAS IMPORT 23 Uö' {$A+,B-,F-,L-,N-,O-,R-,S-,V-}ππUnit prompt;ππ{ππAuthor: Trevor J Carlsenπ PO Box 568π Port Hedlandπ Western Australia 6721π 61-[0]-91-73-2026 (voice)π 61-[0]-91-73-2930 (data )π πReleased into the public domain.ππThis Unit will automatically create a predefined prompt when shelling to Dos.πif you wish to create your own custom prompt, all that is required is to giveπthe Variable NewPrompt another value and call the Procedure ChangeShellPrompt.ππ}ππInterfaceππUses Dos;ππVarπ NewPrompt : String;ππProcedure ChangeShellPrompt(Nprompt: String);ππImplementationππ Typeπ EnvArray = Array[0..32767] of Byte;π EnvPtr = ^EnvArray;π Varπ EnvSize, EnvLen, EnvPos: Word;π NewEnv, OldEnv : EnvPtr;π TempStr : String;π x : Word;ππ Procedure ChangeShellPrompt(Nprompt: String);ππ Function MainEnvSize: Word;π Varπ x : Word;π found : Boolean;π beginπ found := False; x := 0;π Repeatπ if (OldEnv^[x] = 0) and (OldEnv^[x+1] = 0) thenπ found := Trueπ elseπ inc(x);π Until found;π MainEnvSize := x - 1;π end; { MainEnvSize}ππ Procedure AddEnvStr(Var s; Var offset: Word; len: Word);π Var st : EnvArray Absolute s;π beginπ move(st[1],NewEnv^[offset],len);π inc(offset,len+1);π end;ππ beginπ OldEnv := ptr(MemW[PrefixSeg:$2C],0);π { this gets the actual starting segment of the current Program's env }ππ EnvSize := MemW[seg(OldEnv^)-1:3] shl 4;π { Find the size of the current environment }ππ if MaxAvail < (EnvSize+256) then beginπ Writeln('Insufficient memory');π halt;π end;ππ GetMem(NewEnv, EnvSize + $100);π if ofs(NewEnv^) <> 0 then beginπ inc(LongInt(NewEnv),$10000 + ($10000 * (LongInt(NewEnv) div 16)));π LongInt(NewEnv) := LongInt(NewEnv) and $ffff0000;π end;π FillChar(NewEnv^,EnvSize + $100,0);π { Allocate heap memory For the new environment adding enough to allow }π { alignment to a paraGraph boundary or a longer prompt than the default }π { and initialise to nuls }π EnvPos := 0;ππ AddEnvStr(Nprompt,EnvPos,length(Nprompt));π For x := 1 to EnvCount do beginπ TempStr := EnvStr(x);π if TempStr <> GetEnv('PROMPT') thenπ AddEnvStr(TempStr,EnvPos,length(TempStr));π end; { For }π inc(EnvPos);π { Transfer old env Strings except the prompt to new environment }ππ if lo(DosVersion) > 2 thenπ AddEnvStr(OldEnv^[MainEnvSize + 2],EnvPos,EnvSize-(MainEnvSize + 2));π { Add the rest of the environment }ππ MemW[PrefixSeg:$2C] := seg(NewEnv^);π { let the Program know where the new environment is }π end; { ChangeShellPrompt }ππend. { prompt }π π 4 08-17-9308:51ALL SWAG SUPPORT TEAM Demonstrates DOS Exec IMPORT 18 Ud± {$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. 5 08-27-9321:37ALL KELD R. HANSEN Exec with Memory Shrink IMPORT 12 U⌐Θ (*πKELD R. HANSENππ> I need to *simulate* something like:π> {$M 16384,0,0} {reduce heap}π> Exec('c:\myprgm.exe',''); {run myprgm.exe}π> {$M 16384,110000,110000} {restore heap}ππEXECUTE shrinks your programs memory allocation to the smallest possible value,πthen runs the program and then expands it back up again. Works in TP 6.0 andπ7.0!π*)ππUSESπ DOS;ππTYPEπ STR127 = STRING[127];ππPROCEDURE ReallocateMemory(P : POINTER); ASSEMBLER;πASMπ MOV AX, PrefixSegπ MOV ES, AXπ MOV BX, WORD PTR P+2π CMP WORD PTR P,0π JE @OKπ INC BXππ @OK:π SUB BX, AXπ MOV AH, 4Ahπ INT 21hπ JC @Xπ LES DI, Pπ MOV WORD PTR HeapEnd,DIπ MOV WORD PTR HeapEnd+2,ESππ @X:πEND;ππFUNCTION EXECUTE(Name : PathStr ; Tail : STR127) : WORD; ASSEMBLER;πASMπ {$IFDEF CPU386}π DB 66hπ PUSH WORD PTR HeapEndπ DB 66hπ PUSH WORD PTR Nameπ DB 66hπ PUSH WORD PTR Tailπ DB 66hπ PUSH WORD PTR HeapPtrπ {$ELSE}π PUSH WORD PTR HeapEnd+2π PUSH WORD PTR HeapEndπ PUSH WORD PTR Name+2π PUSH WORD PTR Nameπ PUSH WORD PTR Tail+2π PUSH WORD PTR Tailπ PUSH WORD PTR HeapPtr+2π PUSH WORD PTR HeapPtrπ {$ENDIF}π CALL ReallocateMemoryπ CALL SwapVectorsπ CALL DOS.EXECπ CALL SwapVectorsπ CALL ReallocateMemoryπ MOV AX, DosErrorπ OR AX, AXπ JNZ @OUTπ MOV AH, 4Dhπ INT 21hππ @OUT:πEND;π 6 10-28-9311:30ALL MAYNARD PHILBROOK EXEC DOS in a Window IMPORT 10 Uv└ {===================================================================πDate: 10-19-93 (19:37)πFrom: MAYNARD PHILBROOKπSubj: Re: Execwindow graphicsπ----------------------------------------------------------------------}π{$F+,I-,S-,D-}π{$m 1024, 0, 3000}ππUses Crt, Dos;πVarπOLD_29H :Pointer;πC :Char; { Holds Charactor to Write }π{$F+}ππProcedure Patch1;πInterrupt;πBeginπ Write(C);πEnd;ππProcedure Patch; Assembler;π Asmπ Push DSπ Push Axπ Mov AX, Seg C;π Mov DS, AX;π Pop AX;π Mov C, Al;π Pop DSπ Jmp Patch1;π End;πBeginπ Clrscr;π GetINtVec($29, OLD_29H);π SetIntVec($29, @Patch);π Window(14, 10, 40, 22);π ClrScr;π Exec('C:\Command.com',' /c dir');π Readkey;π SetIntVec($29, OLD_29h);πEnd.ππThe Command.com is just an example..πNote:πIf your using ANSI.SYS in Dos, this will not use Anis..πTP uses its own screen writes, but this code directs all Dos Char Outputπto the TP window.πTo Stop echo of Dos functions or what ever, use theπ> NULL at the end of the parms when executing..ππ--- MsgToss 2.0bπ * Origin: Sherwood Forest RBBS 203-455-0646 (1:327/453)π 7 10-28-9311:31ALL GAYLE DAVIS FIND AND EXECUTE IMPORT 24 U╢f {$S-,R-,V-,I-,N-,B-,F-}ππ{$IFNDEF Ver40}π {Allow overlays}π {$F+,O-,X+,A-}π{$ENDIF}ππUNIT FINDEXEC;ππINTERFACEππUSES CRT,DOS;ππPROCEDURE FLUSHALLDOS;πPROCEDURE REBOOT;πFUNCTION EXECUTE (Name : PathStr ; Tail : STRING) : WORD;πPROCEDURE RunInWindow (FN, Cmd : STRING; PAUSE : BOOLEAN);ππIMPLEMENTATIONπVARπ cname : STRING;π Old_29H : POINTER;ππPROCEDURE FLUSHALLDOS; ASSEMBLER;πASMπ mov ah, 0Dhπ INT 21hπ XOR cx, cxπ@1 :π push cxπ INT 28hπ pop cxπ loop @1πEND;ππPROCEDURE Reboot; assembler;πasmπ CALL FLUSHALLDOSπ MOV ds, cxπ MOV WORD PTR [472h], 1234hπ DEC cxπ PUSH cxπ PUSH dsπEND;ππ{F+}πProcedure Int29Handler(AX, BX, CX, DX, SI, DI, DS, ES, BP : Word); Interrupt;πVarπ Dummy : Byte;πbeginπ Asmπ Stiπ end;π Write(Char(Lo(Ax)));π Asmπ Cliπ end;πend;π{$F-}ππ{ EXECUTE STUFF - SHRINK HEAP AND EXECUTE LIKE EXECDOS }ππPROCEDURE ReallocateMemory (P : POINTER); ASSEMBLER;πASMπ MOV AX, PrefixSegπ MOV ES, AXπ MOV BX, WORD PTR P + 2π CMP WORD PTR P, 0π JE @OKπ INC BXππ @OK :π SUB BX, AXπ MOV AH, 4Ahπ INT 21hπ JC @Xπ LES DI, Pπ MOV WORD PTR HeapEnd, DIπ MOV WORD PTR HeapEnd + 2, ESπ @X :πEND;ππ{ ZAP this DEFINE if NOT 386,486}π{..$DEFINE CPU386}ππFUNCTION EXEC (Name : PathStr ; Tail : STRING) : WORD; ASSEMBLER;πASMπ CALL FLUSHALLDOSπ {$IFDEF CPU386}π DB 66hπ PUSH WORD PTR HeapEndπ DB 66hπ PUSH WORD PTR Nameπ DB 66hπ PUSH WORD PTR Tailπ DB 66hπ PUSH WORD PTR HeapPtrπ {$ELSE}π PUSH WORD PTR HeapEnd + 2π PUSH WORD PTR HeapEndπ PUSH WORD PTR Name + 2π PUSH WORD PTR Nameπ PUSH WORD PTR Tail + 2π PUSH WORD PTR Tailπ PUSH WORD PTR HeapPtr + 2π PUSH WORD PTR HeapPtrππ {$ENDIF}ππ CALL ReallocateMemoryπ CALL SwapVectorsπ CALL DOS.EXECπ CALL SwapVectorsπ CALL ReallocateMemoryπ MOV AX, DosErrorπ OR AX, AXπ JNZ @OUTπ MOV AH, 4Dhπ INT 21hππ @OUT :ππEND;ππFUNCTION EXECUTE (Name : PathStr ; Tail : STRING) : WORD;πVAR W : PathStr;πBEGINπ DosError := 2;π W := FSEARCH (Name, GetEnv ('PATH') );π IF W = '' THEN EXIT;π EXECUTE := EXEC(W,Tail);πEND;ππPROCEDURE RunInWindow (FN, Cmd : STRING; PAUSE : BOOLEAN);ππVAR sa : BYTE;π w : pathstr;ππBEGINππ DosError := 2;π W := FSEARCH (fn, GetEnv ('PATH') );π IF W = '' THEN EXIT;π sa := Textattr;ππ GETINTVEC ($29, OLD_29H);π SETINTVEC ($29, @Int29Handler); { Install interrupt handler }π WINDOW (LO (WindMin) + 1, HI (WindMin) + 1, LO (WindMax) + 1, HI (WindMax) + 1);π EXEC (W, Cmd );π SETINTVEC ($29, OLD_29h);ππ IF PAUSE THENπ BEGINπ WRITELN;π WRITELN (' .. Any Key Continues .. ');π asmπ Mov AX, $0C00; { flush keyboard }π Int 21h;π end;π WHILE NOT KEYPRESSED DO;π asmπ Mov AX, $0C00;π Int 21h;π end;π END;π Textattr := sa;πEND;ππEND. 8 10-28-9311:38ALL MIKE DICKSON Search Execute IMPORT 14 U▒ε {===========================================================================πDate: 09-18-93 (23:25)πFrom: MIKE DICKSONπSubj: EXEC ()π---------------------------------------------------------------------------π[MM] ▒ I've written my own EXEC function that performs an FSearch() on theπ[MM] Well, that's great. (Why don't you post it!).ππOkay...here's an illustrative little program... }ππ{$M $4000,0,0 }πProgram JohnMajorHadBetterResignPrettyDamnedShortly;ππUses DOS;ππFUNCTION FileExists (FileName: String):Boolean;{ Checks if fileπexists } varπ Attr : Word;π f : file;πbeginπ Assign (f, Filename);π GetFAttr(f, attr);π FileExists := (DOSError = 0);πend;ππFUNCTION SearchExec (ProgramName, Parameters : String) : Integer;πvarπ Result : Integer;πbeginπ{ If the program doesn't exist then search on the %PATH for it }π If Not FileExists(ProgramName) thenπ ProgramName := FSearch(ProgramName, GetEnv('PATH'));ππ{ If it's a batch file then call it through the command processor }π If Pos('.BAT', ProgramName) <> 0 then beginπ Parameters := '/C '+ProgramName+' '+Parameters;π ProgramName := GetEnv('COMSPEC');π end;ππ{ Now call the program...if it didn't exist the set DOSError to 2 }π If ProgramName <> '' then beginπ SwapVectors;π Exec (ProgramName, Parameters);π Result := DOSError;π SwapVectors;π SearchExec := Result;π end else SearchExec := 2;ππend;ππbeginπ If SearchExec ('AUTOEXEC.BAT', '/?') <> 0π then writeln ('Execution was okay!')π else writeln ('Execution was NOT okay!');πend.π 9 11-02-9305:32ALL MARTIN AUSTERMEIER Redirection in DOS IMPORT 12 U├╥ {πMARTIN AUSTERMEIERππ> PKZIP Filename -Z < zipcommentπ> Is there any way to do this WithOUT calling COMSPEC For anothershell?ππyes, but much more complicated than leaving the job to %comspec..ππBefore executing PKZIP, you have toππ * open a Text Fileπ * get its handle (see TextRec); save it in - say - "newStdIn"π * then perform something likeπ if (newSTDIN <> 0) then beginπ saveHandle[STDIN]:=DosExt.DuplicateHandle (STDIN);π DosExt.ForceDuplicateHandle (newSTDIN, STDIN);π created[STDIN]:=True;π end;π (DosExt.xx Routines and STDIN Const explained below)ππ * Exec()π * Cancel redirections:π}ππProcedure CancelRedirections; { of ExecuteProgram }πVarπ redirCnt : Word;πbeginπ For redirCnt := STDIN to STDOUT doπ beginπ if created[redirCnt] thenπ beginπ DosExt.ForceDuplicateHandle(saveHandle[redirCnt], redirCnt);π DosExt.CloseHandle(saveHandle[redirCnt]);π end;π end;πend;ππConstπ STDIN = 0;π STDOUT = 1;π STDERR = 2;ππProcedure CallDos; Assembler;πAsmπ mov Dos.DosError, 0π Int 21hπ jnc @@Okπ mov Dos.DosError, axπ @@Ok:πend;ππFunction DuplicateHandle(handle : Word) : Word; Assembler;πAsmπ mov ah, 45hπ mov bx, handleπ call CallDosπ { DuplicateHandle := AX; }πend;ππProcedure ForceDuplicateHandle(h1, h2 : Word); Assembler;πAsmπ mov ah, 46hπ mov bx, h1π mov cx, h2π call CallDosπend;ππ 10 11-02-9306:30ALL TRISDARESA SUMARJOSO Trapping INT29 Output IMPORT 61 Us> {πTRISDARESA SUMARJOSOππ> I was wondering if anyone knew how to make a split screen Whileπ> making EXEC calls and not losing your Windows?ππ> Anyone got any ideas or routines that do this? I can do it easilyπ> using TTT when I just stay Within the Program, but the problems ariseπ> when I do the SwapVectors and do my Exec call, all hell breaks loose.π> Lynn.ππ Here is a Unit that I've created to trap Int 29h. the Function of thisπUnit is to trap the output that Dos spits through the Int 29h (such as XCopy,πPkZip, etc) and redirect it into a predefined Window.π Here is the stuff:π}ππUnit I29UnitA;ππ{ This Unit will trap Dos output which use Int 29h. Any otherπ method of writing the scren, such as Direct Write which bypassesπ Int 29h call, will not be trapped. }ππInterfaceππ{ Initialize the view that will be use to output the Dos output.π Will also draw basic Window frame. }πProcedure InitView(XX1, XY1, XX2, XY2 : Byte);π{ Clear the pre-defined view. }πProcedure ClearView;π{ Procedure to redirect the Turbo Pascal Write and WriteLn Procedure.π (standard OutPut only).π Do not call this Procedure twice in the row.π More than once call to this Procedure will result Pascal's standardπ output Procedure will not be restored properly. }πProcedure TrapWrite;π{ Restore Pascal's Write and WriteLn Procedure into its originalπ condition that was altered With TRAPWrite. (standard OutPut only). }πProcedure UnTrapWrite;ππImplementationππUsesπ Dos;ππTypeπ VioCharType = Recordπ Case Boolean Ofπ True : (Ch, Attr : Byte);π False : (Content : Word);π end;ππ DrvFunc = Function(Var F : TextRec) : Integer;π VioBufType = Array [0..24, 0..79] Of VioCharType;ππVarπ OldInt29 : Pointer;π OldExit : Pointer;π OldIOFunc : DrvFunc;π OldFlushFunc : DrvFunc;π TrapWriteVar : Boolean;π X1, Y1, X2,π Y2 : Byte;π XVio : Byte;π YVio : Byte;π VioBuffer : ^VioBufType;π VioCurLoc : Word Absolute $0040:$0050;ππ{$F+}πProcedure NewInt29(Flags, CS, IP, AX, BX, CX, DX, SI, DI, DS, ES, BP: Word);πInterrupt;πbeginπ VioBuffer^[YVio, XVio].Attr := VioBuffer^[YVio, XVio].Attr And Not 112;π if (Lo(AX) = 13) Thenπ beginπ XVio := X1;π AX := 0;π endπ elseπ if (Lo(AX) = 10) Thenπ beginπ Inc(YVio);π AX := 0;π end;π beginπ if (XVio > X2) Thenπ beginπ XVio := X1;π Inc(YVio);π end;π if (YVio > Y2) Thenπ beginπ Asmπ Mov AH, 06π Mov AL, YVioπ Sub AL, Y2π Mov CH, Y1π Mov CL, X1π Mov DH, Y2π Mov DL, X2π Mov BH, 07π Int 10hπ end;ππ YVio := Y2;π end;ππ if (Lo(AX) = 32) Thenπ beginπ if (Lo(VioCurLoc) < XVio) Thenπ beginπ XVio := Lo(VioCurLoc);π VioBuffer^[YVio, XVio].Ch := Lo(AX);π endπ elseπ beginπ VioBuffer^[YVio, XVio].Ch := Lo(AX);π Inc(XVio);π end;π endπ elseπ beginπ VioBuffer^[YVio, XVio].Ch := Lo(AX);π Inc(XVio);π end;π VioCurLoc := YVio Shl 8 + XVio;π end;π VioBuffer^[YVio, XVio].Attr := VioBuffer^[YVio, XVio].Attr Or 112;πend;π{$F-}ππ{$F+}πProcedure RestoreInt29;πbeginπ ExitProc := OldExit;π SetIntVec($29, OldInt29);π if TrapWriteVar Thenπ beginπ TextRec(OutPut).InOutFunc := @OldIOFunc;π TextRec(OutPut).FlushFunc := @OldFlushFunc;π end;πend;π{$F-}ππProcedure HookInt29;πbeginπ GetIntVec($29, OldInt29);π SetIntVec($29, @NewInt29);π OldExit := ExitProc;π ExitProc := @RestoreInt29;πend;ππProcedure InitView(XX1, XY1, XX2, XY2: Byte);πVarπ I : Byte;πbeginπ X1 := XX1+1;π Y1 := XY1+1;π X2 := XX2-1;π Y2 := XY2-1;π XVio := X1;π YVio := Y1;π For I := XX1 To XX2 Doπ beginπ VioBuffer^[XY1, I].Ch := 205;π VioBuffer^[XY2, I].Ch := 205;π end;π For I := XY1+1 To XY2-1 Doπ beginπ VioBuffer^[I, XX1].Ch := 179;π VioBuffer^[I, XX2].Ch := 179;π end;π VioBuffer^[XY1, XX1].Ch := 213;π VioBuffer^[XY2, XX1].Ch := 212;π VioBuffer^[XY1, XX2].Ch := 184;π VioBuffer^[XY2, XX2].Ch := 190;π VioCurLoc := YVio Shl 8 + XVio;πend;ππProcedure DoWriteStuff(F : TextRec);πVarπ I : Integer;π Regs : Registers;πbeginπ For I := 0 To F.BufPos-1 Doπ beginπ Regs.AL := Byte(F.BufPtr^[I]);π Intr($29, Regs);π end;πend;ππ{$F+}πFunction NewOutputFunc(Var F : TextRec) : Integer;πbeginπ DoWriteStuff(F);π F.BufPos := 0;π NewOutPutFunc := 0;πend;π{$F-}ππ{$F+}πFunction NewFlushFunc(Var F : TextRec) : Integer;πbeginπ DoWriteStuff(F);π F.BufPos := 0;π NewFlushFunc := 0;πend;π{$F-}ππProcedure TrapWrite;πbeginπ if Not TrapWriteVar Thenπ beginπ With TextRec(OutPut) Doπ beginπ OldIOFunc := DrvFunc(InOutFunc);π InOutFunc := @NewOutPutFunc;π OldFlushFunc := DrvFUnc(FlushFunc);π FlushFunc := @NewFlushFunc;π end;π TrapWriteVar := True;π end;πend;ππProcedure UnTrapWrite;πbeginπ if TrapWriteVar Thenπ beginπ TextRec(OutPut).InOutFunc := @OldIOFunc;π TextRec(OutPut).FlushFunc := @OldFlushFunc;π TrapWriteVar := False;π end;πend;ππProcedure ClearView;πbeginπ Asmπ Mov AH, 06π Mov AL, 0π Mov CH, Y1π Mov CL, X1π Mov DH, Y2π Mov DL, X2π Mov BH, 07π Int 10hπ end;π XVio := X1;π YVio := Y1;π VioCurLoc := YVio Shl 8 + XVio;πend;ππProcedure CheckMode;πVarπ MyRegs : Registers;πbeginπ MyRegs.AH := $F;π Intr($10, MyRegs);π Case MyRegs.AL Ofπ 0, 1, 2, 3 : VioBuffer := Ptr($B800, $0000);π 7 : VioBuffer := Ptr($B000, $0000);π end;πend;ππbeginπ X1 := 0;π Y1 := 0;π X2 := 79;π Y2 := 24;π XVio := 0;π YVio := 0;π VioCurLoc := YVio Shl 8 + XVio;π HookInt29;π TrapWriteVar := False;π CheckMode;πend.πππProgram Int29Testing;ππ{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+}π{$M $800,0,0}ππUsesπ Dos, Crt,π I29UnitA;ππVarπ CmdLine : String;π I : Byte;ππ{ Function to convert a String to upper case.π Return the upper-case String. }ππFunction Str2Upr(Str : String) : String; Assembler;πAsmπ Push DSπ CLDπ LDS SI, Strπ LES DI, @Resultπ LodSBπ Or AL, ALπ Jz @Doneπ StoSBπ Xor CH, CHπ Mov CL, ALπ @@1:π LodSBπ Cmp AL, 'a'π JB @@2π Cmp AL, 'z'π JA @@2π Sub AL, 20hπ @@2:π StoSBπ Loop @@1π @Done:π Pop DSπend;ππbeginπ ClrScr;π GotoXY(1,1);π WriteLn('Output interceptor.');π { Initialize redirector's area. }π InitView(0,2,79,24);π Repeatπ { Redirect Turbo's output into the predefined Window. }π TrapWrite;π Write(#0,' Please enter Dos command (Done to Exit): ');π ReadLn(CmdLine);π WriteLn;π { Restore Turbo's original Output routine. }π UnTrapWrite;π GotoXY(1,2);π WriteLn('Command executed : ', CmdLine);π CmdLine := Str2Upr(CmdLine);π if (CmdLine <> 'DONE') And (CmdLine <> '') Thenπ beginπ SwapVectors;π Exec('C:\Command.Com', '/C'+CmdLine);π SwapVectors;π end;π GotoXY(1,2);π WriteLn('Command execution done. Press anykey to continue...');π Repeat Until ReadKey <> #0;π ClearView;π GotoXY(1,2);π WriteLn(' ');π Until (CmdLine = 'DONE');π ClrScr;πend.ππ{πBoth the testing Program and the Unit itself (expecially the Unit), is by noπmean perfect. Use With caution. It might not wise to use such redirectorπ(my int 29 Unit) in a Program that swaps itself out of memory. The aboveπPrograms were not optimized in anyway (so it might slow your Program aπlittle). And I don't guarantee that this Program will work on your computerπ(it work Without a problem on mine). if you like this Unit, you can use itπanyway you desire. Just remember I can guarantee nothing For this method.π}π 11 11-02-9310:33ALL KELLY SMALL Change the MASTER Env IMPORT 14 U╨4 {πKELLY SMALLππ>Does anyone know how to change the "master" environment? I want to have myπ>program change the dos prompt and have it be there after my program ends.π>DOS's stupid little batch language can do it, so there must be a way.ππHere's a procedure that should do it from TeeCee:π}ππprocedure InitNewPrompt;π{-set up a new prompt for shelling to dos}πtypeπ _2karray = array[1..2048] of byte;π SegPtr = ^_2karray;πconstπ NewPrompt : string = ('PROMPT=Type EXIT to return to program$_$p$g'+#0);πvarπ EnvSegment,π NewEnvSeg : word;π PtrSeg,π NewEnv : SegPtr;πbeginπ EnvSegment := memw[prefixseg:$2C];π {-this gets the actual starting segment of the current program's env}ππ PtrSeg := ptr(pred(EnvSegment), 0);π {-The segment of the program's MCB - (Memory control block) }ππ getmem(NewEnv, 1072 + length(NewPrompt));π {-Allocate heap memory and allow enough room for a dummy mcb }ππ if ofs(NewEnv^) <> 0 thenπ NewEnvSeg := seg(NewEnv^) + 2π elseπ NewEnvSeg := succ(seg(NewEnv^));π {-Force the new environment to start at paragraph boundary}ππ move(PtrSeg^, mem[pred(NewEnvSeg) : 0], 16);π {-copy the old mcb and force to paragraph boundary}ππ memw[pred(NewEnvSeg) : 3] := (1072 + length(NewPrompt)) shr 4;π {-Alter the environment length by changing the dummy mcb}ππ move(NewPrompt[1], memw[NewEnvSeg : 0], length(NewPrompt));π {-install new prompt}ππ memw[prefixseg:$2C] := NewEnvSeg;π {-let the program know where the new env is}ππ move(mem[EnvSegment : 0], mem[NewEnvSeg : length(NewPrompt)], 1024);π {-shift the old env to the new area}πend;π 12 01-27-9411:58ALL TOM CARROLL Execution in a DOS WindowIMPORT 31 U▌ (*π Written by Tom Carroll, Nova 24, 1993 for TP 7.0.ππ Adapted from the example code posted by Kelly Small in the FidoNetπ Pascal echo 11/19/93.ππ Released to the Public Domain 11/24/93.ππ Please give credit where credit is dueππ This Program will execute a program within a text windowπ and all program scrolling will be maintained withinπ the window.ππ This would be better to put inside a unit, but I couldn't get theπ interrupt to work within the unit. If you're able to get it to workπ inside a unit, I would appreciate you posting the unit so I can seeπ how it was done.π*)ππProgram ExecInATextWindow;ππUSESπ Dos, { Used for the Exec call }π Crt; { For the GotoXY calls }ππVARπ ExitVal : WORD;π MyProg : STRING;π MyParams : STRING;π OldIntVect : POINTER;ππ{$F+}πPROCEDURE Int29Handler(AX, BX, CX, DX, SI, DI, DS, ES, BP : WORD);ππINTERRUPT;ππVARπ Dummy : BYTE;ππBEGINπ Write(Chr(Lo(AX))); { Writes each output character to the screen }π Asm Sti; END;πEND;π{$F-}ππPROCEDURE HookInt29;ππBEGINπ GetIntVec($29, OldIntVect); { Save the old vector }π SetIntVec($29, @Int29Handler); { Install interrupt handler }πEND;ππFUNCTION ExecWin(ProgName, Params : STRING; LeftCol, TopLine,π RightCol, BottomLine : WORD) : WORD;ππVARπ A : WORD;ππBEGINπ GotoXY(LeftCol, TopLine); { Puts cursor at the top left }π Write(Chr(201)); { hand corner of the window }ππ{ I use three FOR loops to write the actual window borders to the screen.ππ NOTE: The window size for the executed program will actually be twoπ rows and two columns smaller that what you call. This is becauseπ there is no error checking to see if the call will place theπ window borders outside the maximum row column range for theπ video. }ππ FOR A := 1 TO (RightCol-LeftCol) - 1 DOπ Write(Chr(205));π Write(Chr(187));π FOR A := 1 TO (BottomLine-TopLine) - 1 DOπ BEGINπ GotoXY(LeftCol, TopLine + A);π Write(Chr(186));π GotoXY(RightCol,TopLine + A);π Write(Chr(186));π END;π GotoXY(LeftCol, BottomLine);π Write(Chr(200));π FOR A := 1 TO (RightCol-LeftCol) - 1 DOπ Write(Chr(205));π Write(Chr(188));ππ{ Now set the text window so the program will not scroll the outline ofπ the window off the screen. }ππ Window(LeftCol + 1, TopLine + 1, RightCol - 1, BottomLine - 1);π GotoXY(1, 1); { Jumps to the upper left hand corner of the window }π HookInt29; { Hooks Interrupt 29 for video output }π {$M 10000, 0, 0} { This works good for Archive utilities }π SwapVectors;π Exec(ProgName, Params);π ExecWin := DOSExitCode; { Return the exit code for error trapping }π SwapVectors;π SetIntVec($29,OldIntVect); { Restore the interrupt }π Window(LeftCol, TopLine, RightCol, BottomLine); { Set the window to the }π ClrScr; { actual size of the }π Window(1, 1, 80, 25); { border so it can be }πEND; { cleared properly. }ππBEGINππClrScr;ππ{ Modify these two lines to suit your system }ππMyProg := 'C:\UTIL\PKUNZIP.EXE';πMyParams := '-t C:\QMPRO\DL\STORE\WAV\SEINWAV1.ZIP';ππExitVal := ExecWin(MyProg, MyParams, 5, 6, 75, 16);ππWriteLn('DOS exit code = ', ExitVal);ππReadLn;ππEND.ππ{ I would like to modify this code to allow for a screen save feature thatπ will restore the previous screen for the coordinates passed to the ExecWinπ function.π Other nice features would be to add a sideways scrolling effect,π exploding windows for the text window and then make it implode whenπ the previous video is restored. }ππ 13 01-27-9412:00ALL LARRY HADLEY Appending to EXE Files IMPORT 42 UY⌐ {π>Hmmm.... how about this.... I want to put a 75k MOD file into the EXE...π>I've heard that you use pointers and appending the MOD to end of yourπ>compiled program and stuff like that... I'm not too sure how to go aboutπ>it.ππIn short, the easiest way is to append to to your .EXE file. Theπfollowing code will search the current .exe for data appended toπthe end of the .exe file.π}ππUsesπ DOS;ππTYPE { .exe file header }π EXEH = RECORDπ id, { .exe signature }π Lpage, { .exe file size mod 512 bytes; < 512 bytes }π Fpages, { .exe file size div 512 bytes; + 1 if Lpage > 0 }π relocitems, { number of relocation table items }π size, { .exe header size in 16-byte paragraphs }π minalloc, { min heap required in additional to .exe image }π maxalloc, { extra heap desired beyond that requiredπ to hold .exe's image }π ss, { displacement of stack segment }π sp, { initial SP register value }π chk_sum, { complemented checksum }π ip, { initial IP register value }π cs, { displacement of code segment }π ofs_rtbl, { offset to first relocation item }π ovr_num : word; { overlay numbers }π END;ππCONSTπ MAX_BLOCK_SIZE = 65528; {maximum allowable size of data block inπ TP}πTYPEπ pdata = ^data_array;π data_array = array[0..MAX_BLOCK_SIZE] of byte;ππ pMODblock = ^MODblock;π MODblock = RECORDπ data :pdata;π datasize :word;π end;ππVARπ exefile : file;π exehdr : exeh;π blocks : word;ππ exesize,π imgsize : longint;ππ path : dirstr;π name : namestr;π ext : extstr;π EXEName : pathstr;π n : byte;ππ dirfile : searchrec;ππ M : pMODblock;ππ{Determines the exe filename, opens the file for read-only, andπ determines the actual .exe code image size by reading theπ standard .exe header that is in front of every .exe file. The .MODπ data will be in the file *after* the end of the code image.}πProcedure ReadHdr;ππ {this "finds" your exe filename}π Function CalcEXEName : string;π varπ Dir : DirStr;π Name : NameStr;π Ext : ExtStr;π beginπ if Lo(DosVersion) >= 3 thenπ EXEName := ParamStr(0)π elseπ EXEName := FSearch('progname.EXE', GetEnv('PATH'));π { ^^^^^^^^ } { change this to intended EXE name }π FSplit(EXEName, Dir, Name, Ext);π CalcEXEName := Name;π end;ππbeginπ Name := CalcEXEName;ππ findfirst(EXEName, anyfile, dirfile);π while (doserror=0) doπ BEGINπ Assign(exefile, EXEName);π Reset(exefile, 1); { reset for 1 byte records }π BlockRead(exefile, exehdr, SizeOf(exehdr), blocks);π if blocks<SizeOf(exehdr) thenπ beginπ Writeln('File read error!');π Halt(1);π end;π exesize := dirfile.size; { the total file size of exe+data }π with exehdr doπ beginπ imgsize := FPages; {exe img size div 512 bytes, +1 if Lpage>0}π if LPage > 0 thenπ dec(imgsize);π imgsize := (imgsize*512) + LPage; {final image size}π end;π END;πend;ππ{ this function reads the 64k-8 byte sized block, numberedπ "blocknum" from the end of the file exefile (already opened inπ ReadHdr proc above), allocates a new pMODblock structure andπ passes it back to the caller. "blocknum" is 0-based - ie, dataπ offset starts at 0. If the remaining data is less than 64k, theπ data record will be sized to the remaining data.}πFunction ReadBlockFromMOD(blocknum):pMODblock;πvarπ filepos : longint;π mod : pMODblock;πbeginπ filepos := imgsize + (blocknum*MAX_BLOCK_SIZE);π if filepos > exesize then {block position asked for exceeds filesize}π beginπ ReadBlockFromMOD := NIL; { return error signal }π EXIT; {...and return}π end;π New(mod);ππ if (filepos+MAX_BLOCK_SIZE>exesize) thenπ mod^.datasize := exesize-fileposπ { data left in this block is less than 64k }π elseπ mod^.datasize := MAX_BLOCK_SIZE;π { data block is a full 64k }π GetMem(mod^.data, mod^.datasize); {get the memory for the data buffer}ππ Seek(exefile, filepos); { position dos's filepointer to beginning of block}π BlockRead(exefile, mod^.data^, mod^.datasize, blocks);ππ if blocks<mod^.datasize then { make sure we got all the data }π beginπ Writeln('File read error!');π FreeMem(mod^.data, mod^.datasize);π Dispose(mod);π ReadBlockFromMOD := NIL;π EXIT;π end;ππ ReadBlockFromMOD := mod;πend;ππ{π This will read in the .MOD from the "back" of the .exe 64k-8π bytes at a time. As written, you manually have to pass a blockπ number to the "read" function.ππ A couple of caveats - doing it as written is error-prone. Usingπ this code "barebones" in a finished application is not advisable,π but it does demonstrate the concept and gives you a startingπ point. THIS CODE HAS NOT BEEN TESTED! If you have problems withπ it, let me know and I'll help you out.ππ After you have digest the code, ask some more questions and weπ can discuss streams and OOP techniques to do this in a lessπ dangerous manner.π} 14 01-27-9412:09ALL NORBERT IGL DOS Windowed Ouput IMPORT 19 U┼╟ {π Norbert Iglπ Fido : 2:243/8301.3π Gernet : 21:100/40.3π Internet: q3976866@fernuni-hagen.deππ> I seen some code posted here a few weeks ago. I meant to save it,π> but didn't. The code creates a windowed DOS shell.π> I would like to simply run a .BAT installation file in a windowπ> from my pascal program.ππ ...same question a few days ago here in our local echo ... (:-)π Its not only with windowed output ( easy possible )π but also stores the pgm's output in your pgm's buffer ....π have fun!π}ππprogram test29; {$M $1000,0,$FFF0}{ $C <Norbert Igl '93> }πuses crt, dos;πconst maxBufSize = 64000;π old29 : pointer = nil;πtype tVBuff = recordπ siz : word;π last: word;π txt : array[1..MaxBufSize] of char;π end;π pVBuff = ^tVBuff;πvar Buf : pVBuff;ππprocedure New29(Flags, CS, IP, AX,π BX,CX, DX, SI, DI,π DS, ES, BP: Word); interrupt;πbeginπ if Buf <> NIL thenπ with Buf^ doπ beginπ if last < siz then inc( Last );π txt[last] := CHAR(AX)π endπend;ππprocedure BeginCapture;πbeginπ if Old29 = NIL then getintvec($29, Old29);π SetIntVec($29, @New29 );πend;ππprocedure DoneCapture;πbeginπ if old29 <> Nil thenπ beginπ SetIntVec($29, old29);π old29 := NILπ endπend;ππprocedure InitBuffer;πbeginπ Buf := NILπend;ππprocedure BeginBuffer(Size:word);πbeginπ if Size > maxBufSize then size := maxBufSize;π GetMem( Buf, Size );π Buf^.siz := Size;π Buf^.last:= 0;π fillchar( Buf^.txt, size-4, 0);πend;ππprocedure DoneBuffer;πbeginπ if Buf <> NIL thenπ beginπ dispose(buf);π initBuffer;π endπend;ππprocedure ShowBuffer;πvar i, maxy : word;πbeginπ if buf = NIL then exit;π maxy := (WindMax - WindMin) shr 8;π clrscr;π for i := 1 to Buf^.last doπ beginπ if wherey = maxy thenπ beginπ write(' --- weiter mit Taste --- '); clreol;π readkey;π clrscr;π end;π write( buf^.txt[i] );π end;π write(#13#10' --- Ende, weiter mit Taste --- '); clreol;π readkey;π clrscr;πend;ππbeginπ InitBuffer;π BeginBuffer($4000); { 16k Buffer, max=64k }π BeginCapture;π swapvectors;π exec( getenv('comspec'),' /C DIR *.pas');π swapvectors;π DoneCapture;π ShowBuffer;π DoneBufferπend.π 15 01-27-9412:14ALL BJORN FELTEN Self-Modifying EXE Files IMPORT 22 Ux╦ {πOK. Maybe this isn't exactly what you were asking for, but I've seen quite aπnumber of variations on this peeka-boo-into-the-exe-file, so I felt I just hadπto write a comment to this matter.ππ Using some kind of a magic constant, which is then searched for in the exeπfile, probably is the most common approach to this kind of problem. But there'sπreally no need to do a search. You can calculate exactly where any const is (orπshould be) located.ππ The trick is to use a couple of simple facts:ππ 1/ The size of the exe header, in paragraphs, is located at byte 8 in theπheader (actually it's a word made up by bytes 8 and 9 but I still haven't seenπan exe header of more than 4k, so I make it simple for myself using only theπbyte).ππ 2/ After the exe header comes the code segment and then directly the dataπsegment. Thus the size of the code segment can be calculated by a simple dseg-πcseg. Still talking paragraphs.ππ 3/ Now we've reached the data segment in the exe file. The location in theπdata segment can be found with ofs. Here we're talking bytes.ππ Using these facts, here's a simple sample that let's you change a constπstring to whatever paramstr(1) you supply. Hope you'll be able to pick out theπstuff you may find any need for.ππ Since this code was extracted from a pretty small program I once wrote, itπuses the rather crude method to read the entire exe file into a buffer, andπthen creating a new file blockwriting the entire buffer. If your program isπlarger than 64k you obviously need to use some other method.π}ππprogram SelfModifier; (* Looks for a const and alters it *)π (* Puts paramstr(1) into Name *)ππconstπ Name : string = 'Fix me up'; {get 256 bytes to play with}πtypeπ Buffer = array[0..$3fff] of byte;πvarπ ExeFile : file;π P : ^Buffer;π N,I,O : word;π NStr : string;ππbeginπ beginπ new(P); {get mem for our buffer}π assign(ExeFile,paramstr(0)); {get myself}π reset(ExeFile,1);π blockread(ExeFile,P^,sizeof(Buffer),N);π close(ExeFile); {got it into Buf, now close it}π O:=(dseg-cseg+word(P^[8])) shl 4; {start of data seg in exe file}π writeln('Name: ',Name);π NStr := paramstr(1); {new string to put in Name}π inc(O,ofs(Name)); {where Name is located}π move(NStr[0],P^[O],length(NStr)+1); {move string incl. length byte}π rewrite(ExeFile,1); {create new version}π blockwrite(ExeFile,P^,N); {write it}π close(ExeFile); {close it...}π dispose(P) {...and release mem}π endπend.π 16 01-27-9412:17ALL FRED JOHNSON Operating Modes IMPORT 11 U0─ {πIf you ever wanted to tell what Operating System Mode you are using,πthis /ditty/ will do the trick. It sets a global integer to a valueπwhich represents the Mode being used. There is also a demo_prog at theπend of the unit.π}ππunit mode;ππinterfaceππvarπ OperatingMode : integer;ππ{ This integer holds a value of 0, 1, 2 or 3, which is an indicatorπ if the machine is in:π Dos Mode (0),π Windows Standard Mode (1),π Windows Enhanced Mode (2),π DESQview mode (3); }πimplementationππfunction wincheck : integer;πbeginπ asmπ mov ax, $4680π int $2fπ mov dl, $1π or ax, axπ jz @finishedπ mov ax, $1600π int $2fπ mov dl, $2π or al, alπ jz @Not_Winπ cmp al, $80π jne @finishedπ @Not_Win:π mov ax, $1022π mov bx, $0π int $15π mov dl, $3π cmp bx, $0a01π je @finishedπ xor dl, dlπ @finished:π xor ah, ahπ mov al, dlπ mov @Result, axπ end;πend;ππbeginπ OperatingMode := Wincheck;πend.ππprogram Use_Mode;ππusesπ mode;ππconstπ xModeStringArr : Array[0..3] of string[16] =π ('Dos Mode', 'Windows Standard', 'Windows Enhanced', 'DESQview Mode');πbeginπ Write(xModeStringArr[OperatingMode]);πend.π 17 01-27-9412:24ALL TOM CARROLL Yet Another Window Shell IMPORT 75 U╩ú {π-> I seen some code posted here a few weeks ago. I meant to save it,π-> but didn't. The code creates a windowed DOS shell. I would likeπ-> to simply run a .BAT installation file in a window from my pascalπ-> program.ππHere's some code that I posted. Maybe this is what you were talkingπabout:π}ππ(* Written by Tom Carroll, Nov 24, 1993.ππ Adapted from the example code posted by Kelly Small in the FidoNetπ Pascal echo 11/19/93.ππ Released to the Public Domain 11/24/93.ππ Please give credit where credit is dueππ This unit will execute a program within a text windowπ and all program scrolling will be maintained withinπ the window.ππ 11-24-93 - Initial release /twc/π 11-29-93 - Added code to allow for multiple border styles,π color usage, window titles, and screen save/restoreπ under the window. /twc/ππ FUTURE PLANS: To add a check for the video mode and adjust theπ window boundary checking accordingly.π*)ππUNIT ExecTWin;ππINTERFACEππFUNCTION ExecWin(ProgName, Params, Title : STRING;π LeftCol, TopLine, RightCol, BottomLine,π ForeColor, BackColor, ForeBorder, BackBorder,π Border, ForeTitle, BackTitle : WORD) : WORD;ππIMPLEMENTATIONππUSESπ Dos,π Crt,π ScrnCopy;ππVARπ OldIntVect : POINTER;ππ{$F+}πPROCEDURE Int29Handler(AX, BX, CX, DX, SI, DI, DS, ES, BP : WORD); INTERRUPT;ππVARπ Dummy : BYTE;ππBEGINπ Write(Chr(Lo(AX))); {write each character to screen}π Asm Sti; END;πEND;π{$F-}ππPROCEDURE HookInt29;ππBEGINπ GetIntVec($29, OldIntVect); { Save the old vector }π SetIntVec($29, @Int29Handler); { Install interrupt handler }πEND;ππFUNCTION ExecWin(ProgName, Params, Title : STRING;π LeftCol, TopLine, RightCol, BottomLine,π ForeColor, BackColor, ForeBorder, BackBorder,π Border, ForeTitle, BackTitle : WORD) : WORD;ππ{π ProgName = Program name to execute (must includes the full path)π Params = Program parameters passed to child processπ Title = Title assigned to the text window (unused if blank)π LeftCol = Left column of the window borderπ TopLine = Top line of the window borderπ RightCol = Right column of the window borderπ BottomLine = Bottom line of the window borderπ ForeColor = Foreground color of the windowπ BackColor = Background color of the windowπ ForeBorder = Foreground color of the window borderπ BackBorder = Background color of the window borderπ Border = Border type to use. Where type is:π 0 - None usedπ 1 - '+'π 2 - '+'π 3 - '#'π 4 - '+'π ForeTitle = Foreground color of the window titleπ BackTitle = Background color of the window titleππ If an error is encountered, the program will return the followingπ error codes in the ExecWin variable.ππ 97 - Title wider than the windowπ 98 - The left or right screen margins have been exceededπ 99 - The top or bottom screen margins have been exceededπ}ππLABELπ ExitExec;ππVARπ A : WORD;ππBEGINπ IF (LeftCol < 1) OR (RightCol > 80) THENπ BEGINπ ExecWin := 98;π GOTO ExitExec;π END;π IF (TopLine < 1) OR (BottomLine > 24) THENπ BEGINπ ExecWin := 99;π GOTO ExitExec;π END;π SaveScrn(0);π TextColor(ForeBorder);π TextBackground(BackBorder);π GotoXY(LeftCol, TopLine);π CASE Border OFπ 1 : BEGINπ Write('+');π FOR A := 1 TO (RightCol - LeftCol) - 1 DOπ Write('-');π Write('+');π FOR A := 1 TO (BottomLine - TopLine) - 1 DOπ BEGINπ GotoXY(LeftCol, TopLine + A);π Write('|');π GotoXY(RightCol, TopLine + A);π Write('|');π END;π GotoXY(LeftCol, BottomLine);π Write('+');π FOR A := 1 TO (RightCol - LeftCol) - 1 DOπ Write('-');π Write('+');π IF Ord(Title[0]) > 0 THENπ IF (Ord(Title[0])) <= (RightCol - LeftCol) THENπ BEGINπ A := Ord(Title[0]);π A := RightCol - LeftCol - A;π A := A DIV 2;π GotoXY(A - 2 + LeftCol, TopLine);π Write('+ ');π TextColor(ForeTitle);π TextBackground(BackTitle);π Write(Title);π TextColor(ForeBorder);π TextBackground(BackBorder);π Write(' +');π ENDπ ELSEπ BEGINπ ExecWin := 97;π GOTO ExitExec;π END;π END;π 2 : BEGINπ Write('+');π FOR A := 1 TO (RightCol - LeftCol) - 1 DOπ Write('-');π Write('+');π FOR A := 1 TO (BottomLine - TopLine) - 1 DOπ BEGINπ GotoXY(LeftCol, TopLine + A);π Write('|');π GotoXY(RightCol, TopLine + A);π Write('|');π END;π GotoXY(LeftCol, BottomLine);π Write('+');π FOR A := 1 TO (RightCol - LeftCol) - 1 DOπ Write('-');π Write('+');π IF Ord(Title[0]) > 0 THENπ IF (Ord(Title[0])) <= (RightCol - LeftCol) THENπ BEGINπ A := Ord(Title[0]);π A := RightCol - LeftCol - A;π A := A DIV 2;π GotoXY(A - 2 + LeftCol, TopLine);π Write('+ ');π TextColor(ForeTitle);π TextBackground(BackTitle);π Write(Title);π TextColor(ForeBorder);π TextBackground(BackBorder);π Write(' +');π ENDπ ELSEπ BEGINπ ExecWin := 97;π GOTO ExitExec;π END;π END;π 3 : BEGINπ Write('#');π FOR A := 1 TO (RightCol - LeftCol) - 1 DOπ Write('#');π Write('#');π FOR A := 1 TO (BottomLine - TopLine) - 1 DOπ BEGINπ GotoXY(LeftCol, TopLine + A);π Write('#');π GotoXY(RightCol, TopLine + A);π Write('#');π END;π GotoXY(LeftCol, BottomLine);π Write('#');π FOR A := 1 TO (RightCol - LeftCol) - 1 DOπ Write('#');π Write('#');π IF Ord(Title[0]) > 0 THENπ IF (Ord(Title[0])) <= (RightCol - LeftCol) THENπ BEGINπ A := Ord(Title[0]);π A := RightCol - LeftCol - A;π A := A DIV 2;π GotoXY(A - 2 + LeftCol, TopLine);π Write('# ');π TextColor(ForeTitle);π TextBackground(BackTitle);π Write(Title);π TextColor(ForeBorder);π TextBackground(BackBorder);π Write(' #');π ENDπ ELSEπ BEGINπ ExecWin := 97;π GOTO ExitExec;π END;π END;π 4 : BEGINπ Write('+');π FOR A := 1 TO (RightCol - LeftCol) - 1 DOπ Write('-');π Write('+');π FOR A := 1 TO (BottomLine - TopLine) - 1 DOπ BEGINπ GotoXY(LeftCol, TopLine + A);π Write('|');π GotoXY(RightCol, TopLine + A);π Write('|');π END;π GotoXY(LeftCol, BottomLine);π Write('+');π FOR A := 1 TO (RightCol - LeftCol) - 1 DOπ Write('-');π Write('+');π IF Ord(Title[0]) > 0 THENπ IF (Ord(Title[0])) <= (RightCol - LeftCol) THENπ BEGINπ A := Ord(Title[0]);π A := RightCol - LeftCol - A;π A := A DIV 2;π GotoXY(A - 2 + LeftCol, TopLine);π Write('| ');π TextColor(ForeTitle);π TextBackground(BackTitle);π Write(Title);π TextColor(ForeBorder);π TextBackground(BackBorder);π Write(' |');π ENDπ ELSEπ BEGINπ ExecWin := 97;π GOTO ExitExec;π END;π END;π END;π TextColor(ForeColor);π TextBackground(BackColor);π Window(LeftCol + 1, TopLine + 1, RightCol - 1, BottomLine - 1);π ClrScr;π HookInt29;π SwapVectors;π Exec(ProgName, Params);π SwapVectors;π ExecWin := DOSExitCode;π SetIntVec($29,OldIntVect); { Restore the interrupt }π Window(1, 1, 80, 25);π RestoreScrn(0);ππ ExitExec:ππEND;ππEND.ππ{πThe ScrnCopy unit may be found within the SWAG files or you can make upπyour own.ππTom CarrollπDataware Softwareπ}π 18 02-03-9410:49ALL CARL YORK Nice DOS Shell Unit IMPORT 48 U { A bit wordy - but easy to include in an application - three "hooks" in }π{ the form of the first three internal procedures to customize the code. }π{ NOTE! MaxHeap must be limited to allow the EXEC procedure to function. }π{ By Carl York with code by Neil J. Rubenking and Richard S. Sandowsky. }ππUNIT DOSShell;ππINTERFACEπprocedure ShellToDOS;ππIMPLEMENTATIONπUSES CRT, DOS;ππprocedure ShellToDOS;πconstπ SmallestAllowableRam = 5; { Set }π Normal = 7; { to }π Reverse = 112; { your }π ApplicationName = 'MY OWN PROGRAM'; { specs }πvarπ ProgramName,π CmdLineParam,π NewDirect,π HoldDirect : PathStr;π HoldAttr : byte;π HoldMin,π HoldMax : word;π SlashSpot,π BlankSpot : byte;ππ{+++++++++++++++++++++++++++++++}πprocedure PrintMessage;πbeginπ { Clever message to make your end user feel foolish }πend;π{-------------------------------}ππ{++++++++++++++++++++++}πprocedure SwapScreenOut;πbeginπ { Whatever routine you want to use to }π { save the contents on the active screen }πend;π{---------}ππ{++++++++++++++++++++++}πprocedure SwapScreenIn;πbeginπ { Whatever routine you want to use to }π { restore the contents on the screen }πend;π{---------}ππ{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}πfunction GetProgramToRun : PathStr;π{ Courtesy of Neil Rubenking, this code duplicates the way DOS normally }π{ searches the path for a file name typed in at the DOS level using the }π{ TP5 routines FSearch and FExpand (code published PC Magazine 1/17/89) }πvarπ Name : PathStr;πbeginπ Name := FSearch(ProgramName + '.COM',''); { Search }π If Name = '' then { the }π Name := FSearch(ProgramName + '.EXE',''); { active }π If Name = '' then { drive/ }π Name := FSearch(ProgramName + '.BAT',''); { directory }π If Name = '' thenπ Name := FSearch(ProgramName + '.COM',GetEnv('PATH'));π If Name = '' then { Search }π Name := FSearch(ProgramName + '.EXE',GetEnv('PATH')); { the }π If Name = '' then { path }π Name := FSearch(ProgramName + '.BAT',GetEnv('PATH'));π If Name <> '' thenπ Name := FExpand(Name);π GetProgramToRun := Name;πend;π{------------------------------------------------------------------------}ππ{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}πfunction RAMFreeInK : Word;π{ A tidy little chunk of Inline code from Rich Sandowsky }πInline(π $B8/$00/$48/ { mov AX,$4800 ; set for DOS function 48h}π $BB/$FF/$FF/ { mov BX,$FFFF ; try to allocate more RAM}π { ; than is possible}π $CD/$21/ { int $21 ; execute the DOS call}π $B1/$06/ { mov CL,6 ;}π $D3/$EB/ { shr BX,CL ; convert to 1K blocks}π $89/$D8); { mov AX,BX ; return number of 1K blocks}π { ; RAM free as function result}π{------------------------------------------------------------------------}ππ{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}πprocedure WritePrompt;π{ Create a DOS prompt for the user }πbeginπ TextAttr := Normal;π Write('Temporarily in DOS (',RAMFreeInK,'K available) ... Type ');π TextAttr := Reverse;π Write('EXIT');π TextAttr := Normal;π WriteLn(' to return to ',ApplicationName);π Write(NewDirect,'>');πend;π{------------------------------------------------------------------------}ππ{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}πprocedure RunTheShell;π{ The actual use of the EXEC procedure }πvarπ Index : integer;πbeginπ GetDir(0,NewDirect);π WritePrompt;π CmdLineParam := '';π ReadLn(ProgramName);π For Index := 1 to length(ProgramName) doπ ProgramName[index] := Upcase(ProgramName[Index]);π While ProgramName[length(ProgramName)] = #32 doπ Dec(ProgramName[0]);π While (length(ProgramName) > 0) and (ProgramName[1] = #32) doπ Delete(ProgramName,1,1);π If (ProgramName <> 'EXIT') thenπ beginπ EXEC(GetEnv('COMSPEC'),'/C '+ ProgramName + CmdLineParam);π { Brute force to see if we need to pursue any further }π If Lo(DOSExitCode) <> 0 thenπ beginπ BlankSpot := pos(' ',ProgramName);π SlashSpot := pos('/',ProgramName);π If SlashSpot > 0 thenπ If (SlashSpot < BlankSpot) or (BlankSpot = 0) thenπ BlankSpot := SlashSpot;π If BlankSpot > 0 thenπ beginπ CmdLineParam := copy(ProgramName,BlankSpot,Length(ProgramName));π ProgramName[0] := Chr(pred(BlankSpot));π end;π ProgramName := GetProgramToRun;π If ProgramName <> '' thenπ If pos('.BAT',ProgramName) > 0 thenπ EXEC(GetEnv('COMSPEC'),'/C '+ ProgramName + CmdLineParam)π else EXEC(ProgramName,CmdLineParam);π end;π end;π WriteLn;πend;π{------------------------------------------------------------------------}ππ{=================================}πbeginπ If RamFreeInK <= SmallestAllowableRam thenπ beginπ PrintMessage;π EXIT;π end;π HoldAttr := TextAttr; { Grab the current video attribute }π GetDir(0,HoldDirect); { Grab the current drive/path }π HoldMin := WindMin;π HoldMax := WindMax; { And the current window }π TextAttr := Normal;π SwapScreenOut;π Window(1,1,80,25);π ClrScr;π SwapVectors;π Repeatπ RunTheShell;π Until ProgramName = 'EXIT';π SwapVectors; { Restore all the original set up }π ChDir(HoldDirect);π TextAttr := HoldAttr;π Window(Lo(HoldMin),Hi(HoldMin),Lo(HoldMax),Hi(HoldMax));π ClrScr;π SwapScreenIn;πend;ππEND.π 19 02-03-9416:18ALL RADEK KADNER Hiding EXEC commands IMPORT 15 U {π RG> I am writing a simple program which executes other programs. I am usingπ RG> the functionππ RG> EXEC(ProgramName,CmdLine)ππ RG> which is working just fine. However, I would like to somehow prevent theπ RG> executed program from writing to the screen, rather I just want to displayπ RG> in my program something likeππ RG> Working...ππ RG> While still maintaining the screen which the program is using for output.π RG> So my questions is, how would I go about doing this?ππTry this unit! }ππunit Redir;ππinterfaceππusesπ Dos;ππfunction SetOutput(FileName: PathStr): Boolean;πprocedure CancelOutput;ππimplementationππconstπ OutRedir: Boolean = False;ππfunction SetOutput(FileName: PathStr): Boolean;πbeginπ FileName:=FileName+#0;π SetOutput:=False;π asmπ push dsπ mov ax, ssπ mov ds, axπ lea dx, FileName[1]π mov ah, 3Chπ int 21hπ pop dsπ jnc @@1π retπ@@1:π push axπ mov bx, axπ mov cx, Output.FileRec.Handleπ mov ah, 46hπ int 21hπ mov ah, 3Ehπ pop bxπ jnc @@2π retπ@@2:π int 21hπ end;π OutRedir:=True;π SetOutput:=True;πend;ππprocedure CancelOutput;πvarπ FileName: String[4];πbeginπ if not OutRedir then Exit;π FileName:='CON'#0;π asmπ push dsπ mov ax, ssπ mov ds, axπ lea dx, FileName[1]π mov ax, 3D01hπ int 21hπ pop dsπ jnc @@1π retπ@@1:π push axπ mov bx, axπ mov cx, Output.FileRec.Handleπ mov ah, 46hπ int 21hπ mov ah, 3Ehπ pop bxπ int 21hπ end;π OutRedir:=False;πend;ππend.ππ________________ππStandard output will be changed to FileName. The FileName can be NUL. When yourπexecuted program is using int $10, all is hardly. In your main program use:ππSetOutput('NUL');πExec(....);πCancelOutput;ππ 20 02-15-9408:06ALL GREG ESTABROOKS Shell to DOS with PROMPT IMPORT 27 U π {change the dos prompt when Shelling to DOS withoutπ having to change the current or master enviroment(It makes it's own).}ππ{***********************************************************************}πPROGRAM PromptDemo; { Feb 12/94, Greg Estabrooks. }π{$M 16840,0,0} { Reserved some memory for the shell. }πUSES CRT, { IMPORT Clrscr,Writeln. }π DOS; { IMPORT Exec. }ππPROCEDURE ShellWithPrompt( Prompt :STRING );π { Routine to allocate a temporary Enviroment }π { with our prompt and the execute COMMAND.COM. }π { NOTE: This does NO error checking. }πVARπ NewEnv :WORD; { Points to our newly allocated env. }π OldEnv :WORD; { Holds Old Env Segment. }π EnvPos :WORD; { Position inside our enviroment. }π EnvLp :WORD; { Variable to loop through ENVStrings. }π TempStr:STRING; { Holds temporary EnvString info. }πBEGINπ ASMπ Mov AH,$48 { Routine to allocate memory. }π Mov BX,1024 { Allocate 1024(1k) of memory. }π Int $21 { Call DOS to allocate memory. }π Mov NewEnv,AX { Save segment address of our memory. }π END;ππ EnvPos := 0; { Initiate pos within our Env. }π FOR EnvLp := 1 TO EnvCount DO { Loop through entire enviroment. }π BEGINπ TempStr := EnvStr(EnvLp); { Retrieve Envirment string. }π IF Pos('PROMPT=',TempStr) <> 0 THEN { If its our prompt THEN .... }π TempStr := 'PROMPT='+Prompt+#0 { Create our new prompt. }π ELSE { .... otherwise......... }π TempStr := TempStr + #0; { Add NUL to make it ASCIIZ compatible. }π Move(TempStr[1],Mem[NewEnv:EnvPos],Length(TempStr)); { Put in Env. }π INC(EnvPos,Length(TempStr)); { Point to new position in Enviroment. }π END;{For}ππ OldEnv := MemW[PrefixSeg:$2C];{ Save old enviroment segment. }π MemW[PrefixSeg:$2C] := NewEnv;{ Point to our new enviroment. }π SwapVectors; { Swap Int vectors in case of conflicts.}π Exec(GetEnv('COMSPEC'),''); { Call COMMAND.COM. }π SwapVectors; { Swap em back. }π MemW[PrefixSeg:$2C] := OldEnv;{ Point back to old enviroment. }ππ ASMπ Push ES { Save ES. }π Mov AH,$49 { Routine to deallocate memory. }π Mov ES,NewEnv { Point ES to area to deallocate. }π Int $21; { Call DOS to free memory. }π Pop ES { Restore ES. }π END;πEND;{ShellWithPrompt}ππBEGINπ Clrscr; { Clear the screen. }π Writeln('Type EXIT to return');{ Show message on how to exit shell. }π ShellWithPrompt('[PromptDemo] $P$G'); { shell to DOS with our prompt. }πEND.{PromptDemo}π 21 05-25-9408:09ALL BILL MULLEN DOS Shell SWAG9405 39 U {π ┌── GEORGE VAISEY ───────────────────────────────────────────────────┐π │ GV» I've read throught the book and even looked it up in the two │π │ GV» pascal books I've got and can't seem to get any help.I'm │π │ GV» trying (without luck) to get this this command: │π │ GV» trying (without luck) to get this this PROMPT $mTYPE "EXIT" TO │π │ GV» RETURN to be sent as a command before it shells. This is so │π │ GV» that the individual that shells out will always know that he │π │ GV» needs to type EXIT to return. If you can help or know of a │π │ GV» better way PLEASE let me know. Here is what I use to shell to │π │ GV» OS: │π │ │π │ GV» Begin │π │ GV» ClrScr; │π │ GV» TextColor(Yellow+Blink); │π │ GV» Writeln ('Type EXIT To Return To Program'); │π │ GV» SwapVectors; │π │ GV» Exec(GetEnv('Comspec'), ''); │π │ GV» SwapVectors; │π │ GV» NormVideo; │π │ GV» End. │π │ GV» I want it to be │π │ GV» TYPE "EXIT" TO RETURN │π │ GV» then the prompt command. Thanks again for your help. │π │ GV» George Vaisey │π └────────────────────────────────────────────────────────────────────┘ππGeorge,ππ You should get either Object Professional or Turbo Professional fromπ Turbo Power software (800) 333-4160 and use the xxDOS unit. It hasπ routines in it to change environment variables on the fly. Theseπ routines work really well.ππ In the mean time you can use the technique shown in the code below.π Beware however, that you MUST have enough environment space to dealπ with the extra space required and that there will actually be twoπ copies of COMMAND.COM running in addition to the master copy.ππ The technique shown in SHELLTODOS is not exactly what you asked for, butπ it does show you how to do what you want. SHELLTODOS1 is the code usedπ if you have either Object Pro or Turbo Pro.ππ P.S. Long lines of code may get truncated by my "QWK" mailer. Inspectπ the SHELLMESSAGE procedure as it appears it may get truncated. Alsoπ change all the WRITE commands in SHELLMESSAGE to WRITELN's.ππ[-------------------------------CUT HERE-----------------------------------]π}ππ{$M 4096, 0, 655360 }πProgram DosShell;πusesπ OpDos, { Needed only by SHELLTODOS1 }π Memory,π Dos,π CRT;πππProcedure ShellMessage ( ProgName : String );π Function Extend ( AStr : String; ML : byte ) : String;π beginπ while ord ( AStr[0] ) < ML doπ AStr := AStr + ' ';π Extend := AStr;π end;πbeginπ clrscr;π Change the following 6 lines to WRITELN's then delete this line entirely.π write(' ╔═════════════════════════════════════════════════════════════════╗');π write(' ║ ■ While in the DOS SHELL, do not execute any TSR programs like ║');π write(' ║ SideKick or DOS''s PRINT command. ║')π write(' ║ ■ Type EXIT and press ENTER to quit the SHELL and return to the ║');π write(Extend ( ' ║ ' + ProgName + ' program.', 67 ), '║' );π write(' ╚═════════════════════════════════════════════════════════════════╝');πend;πππProcedure ShellToDos ( ProgName : string );πvarπ T : text;π D : string;πbeginπ (* Save current directory *)π GetDir ( 0, D );ππ (* Create a DOS batch file with a PROMPT command *)π assign ( T, 'DOSSHELL.BAT' );π rewrite ( T );π writeln ( T, '@echo off' );π writeln ( T, 'Prompt [EXIT] $p$g' );π writeln ( T, GetEnv ( 'COMSPEC' ) );π close ( T );ππ (* Execute the batch file which in turn executes COMMAND.COM *)π ShellMessage ( ProgName );π DoneDosMem;π swapvectors;π exec ( GetEnv ( 'COMSPEC' ), '/c DOSSHELL.BAT' );π swapvectors;π InitDosMem;ππ (* Erase the batch file and restore the working directory *)π erase ( T );π chdir ( D );πend;πππProcedure ShellToDos1 ( ProgName : string );πvarπ NewPrompt : String;π D : string;πbeginπ getdir ( 0, D );π ShellMessage ( ProgName );π NewPrompt := 'Type "EXIT" and press ENTER to return to DOSSHELL'^M^J+π '[' + ProgName + '] ' + GetEnvironmentString ('PROMPT');π ShellWithPrompt ( NewPrompt, NoExecDosProc );π chdir ( D );πend;πππbeginπ InitMemory;π ShellToDos ( 'DosShell' );π ShellToDos1 ( 'DosShell' );π DoneMemory;πend.π 22 05-26-9408:32ALL GAYLE DAVIS Execute PKZIP IMPORT 67 U UNIT PKZExec;ππINTERFACEππUSES DOS;ππ{ Purpose : Execute PKZIP/PKUNZIP on archive files }π{ Uses specialized EXEC procedure so main program can use ALL of the memory }π{ Also shows how to take over INT29 to NOT display anything on the CRT }ππCONSTπ PKZIP : PathStr = 'PKZIP.EXE';π PKUNZIP : PathStr = 'PKUNZIP.EXE';ππVAR ZIPError : INTEGER;ππPROCEDURE CleanUpDir (WorkDir, FileMask : STRING);π {Erases files based on a mask }ππPROCEDURE DisplayZIPError;π { PKZip interface }ππPROCEDURE DefaultCleanup (WorkDir : STRING);π {Erases files *.BAK, *.MAP, temp*.*}ππPROCEDURE ShowEraseStats;π {shows count & bytes recovered}ππFUNCTION UnZIPFile (ZIPOpts, ZIPName, DPath, fspec : STRING; qt : BOOLEAN) : BOOLEAN;π {Uses PKUnZip to de-archive files }ππFUNCTION ZIPFile (ZIPOpts, ZIPName, fspec : STRING; qt : BOOLEAN) : BOOLEAN;π {Uses PKZip to archive files }ππIMPLEMENTATIONππVAR ZIPDefaultZIPOpts : STRING [16];πVAR ZIPFileName : STRING [50];πVAR ZIPDPath : STRING [50];ππVAR EraseCount : WORD; { files erased }π EraseSizeK : LONGINT; { kilobytes released by erasing files }π ShowOnWrite : BOOLEAN;π I29H : POINTER;ππ{ EXECUTE STUFF - SHRINK HEAP AND EXECUTE LIKE EXECDOS }ππ{$F+}πPROCEDURE Int29Handler (AX, BX, CX, DX, SI, DI, DS, ES, BP : WORD); INTERRUPT;πVARπ Dummy : BYTE;πBEGINπ Asmπ Stiπ END;π IF ShowOnWrite THEN WRITE (CHAR (LO (Ax) ) );π Asmπ Cliπ END;πEND;ππPROCEDURE ReallocateMemory (P : POINTER); ASSEMBLER;πASMπ MOV AX, PrefixSegπ MOV ES, AXπ MOV BX, WORD PTR P + 2π CMP WORD PTR P, 0π JE @OKπ INC BXππ @OK :π SUB BX, AXπ MOV AH, 4Ahπ INT 21hπ JC @Xπ LES DI, Pπ MOV WORD PTR HeapEnd, DIπ MOV WORD PTR HeapEnd + 2, ESπ @X :πEND;ππ{ ZAP this DEFINE if NOT 386,486}π{..$DEFINE CPU386}ππFUNCTION EXECUTE (Name : PathStr ; Tail : STRING) : WORD; ASSEMBLER;πASMπ {$IFDEF CPU386}π DB 66hπ PUSH WORD PTR HeapEndπ DB 66hπ PUSH WORD PTR Nameπ DB 66hπ PUSH WORD PTR Tailπ DB 66hπ PUSH WORD PTR HeapPtrπ {$ELSE}π PUSH WORD PTR HeapEnd + 2π PUSH WORD PTR HeapEndπ PUSH WORD PTR Name + 2π PUSH WORD PTR Nameπ PUSH WORD PTR Tail + 2π PUSH WORD PTR Tailπ PUSH WORD PTR HeapPtr + 2π PUSH WORD PTR HeapPtrπ {$ENDIF}ππ CALL ReallocateMemoryπ CALL SwapVectorsπ CALL DOS.EXECπ CALL SwapVectorsπ CALL ReallocateMemoryπ MOV AX, DosErrorπ OR AX, AXπ JNZ @OUTπ MOV AH, 4Dhπ INT 21hπ @OUT :πEND;π{$F-}ππFUNCTION ExecuteCommand(p,s : STRING; quiet : BOOLEAN) : INTEGER;πBEGINπShowOnWrite := NOT quiet; { turn off INT 29 }πGETINTVEC ($29, I29H);πSETINTVEC ($29, @Int29Handler); { Install interrupt handler }πExecute(p,s);πSETINTVEC ($29, I29h);πIF DosError = 0 THEN ExecuteCommand := DosExitCode ELSE ExecuteCommand := DosError;πEND;ππFUNCTION AddBackSlash (dName : STRING) : STRING;πBEGINπ IF dName [LENGTH (dName) ] IN ['\', ':', #0] THENπ AddBackSlash := dNameπ ELSEπ AddBackSlash := dName + '\';πEND;ππFUNCTION EraseFile ( S : PathStr ) : BOOLEAN ;ππVAR F : FILE;ππBEGINππEraseFile := FALSE;ππASSIGN (F, S);πRESET (F);ππIF IORESULT <> 0 THEN EXIT;ππ CLOSE (F);π ERASE (F);π EraseFile := (IORESULT = 0);ππEND;ππFUNCTION FileExists ( S : PathStr ) : BOOLEAN ;ππVAR F : FILE;ππBEGINππFileExists := FALSE;ππASSIGN (F, S);πRESET (F);ππIF IORESULT <> 0 THEN EXIT;ππ CLOSE (F);π FileExists := (IORESULT = 0);ππEND;ππPROCEDURE CleanUpFile (WorkDir : STRING; SR : searchRec);πVAR l : LONGINT;π BEGINπ WITH SR DOπ BEGINπ l := size DIV 512;π IF (attr AND 31) = 0 THENπ BEGINπ IF l = 0 THEN l := 1;π EraseSizeK := EraseSizeK + l;π WRITELN (' Removing: ', (AddBackSlash (WorkDir) + name),π ' ', l DIV 2, 'k');π EraseFile (AddBackSlash (WorkDir) + name);π INC (EraseCount);π ENDπ ELSE WRITELN (' ?? ', (AddBackSlash (WorkDir) + name), ' ', l DIV 2, 'k',π ' attr: ', attr);π END;π END;πππPROCEDURE CleanUpDir (WorkDir, FileMask : STRING);πVAR Frec : SearchRec;π s : STRING [64];π BEGINπ s := '';π FINDFIRST (AddBackSlash (WorkDir) + FileMask, anyfile, Frec);π WHILE doserror = 0 DOπ BEGINπ CleanUpFile (WorkDir, Frec);π FINDNEXT (Frec);π END;π END;πππPROCEDURE DefaultCleanup (WorkDir : STRING);π BEGINπ CleanUpDir (WorkDir, '*.BAK');π CleanUpDir (WorkDir, '*.MAP');π CleanUpDir (WorkDir, 'TEMP*.*');π END;πππPROCEDURE DisplayZIPError;π BEGINπ CASE ziperror OFπ 0 : WRITELN ('no error');π 2,3 : WRITELN (ziperror : 3, ' Error in ZIP file ');π 4..8 : WRITELN (ziperror : 3, ' Insufficient Memory');π 11,12 : WRITELN (ziperror : 3, ' No MORE files ');π 9,13 : WRITELN (ziperror : 3, ' File NOT found ');π 14,50 : WRITELN (ziperror : 3, ' Disk FULL !! ');π 51 : WRITELN (ziperror : 3, ' Unexpected EOF in ZIP file ');π 15 : WRITELN (ziperror : 3, ' Zip file is Read ONLY! ');π 10,16 : WRITELN (ziperror : 3, ' Bad or illegal parameters ');π 17 : WRITELN (ziperror : 3, ' Too many files ');π 18 : WRITELN (ziperror : 3, ' Could NOT open file ');π 1..90 : WRITELN (ziperror : 3, ' Exec DOS error ');π 98 : WRITELN (ziperror : 3, ' requested file not produced ');π 99 : WRITELN (ziperror : 3, ' archive file not found');π END;π END;πππPROCEDURE PKZIPInit;π BEGINπ PKZIP := FSearch('PKZIP.EXE',GetEnv('PATH'));π PKUNZIP := FSearch('PKUNZIP.EXE',GetEnv('PATH'));π ZIPError := 0;π ZIPDefaultZIPOpts := '-n';π ZIPFileName := '';π ZIPDPath := '';π EraseCount := 0;π EraseSizeK := 0;π END;πππPROCEDURE ShowEraseStats;π {-Show statistics at the end of run}π BEGINπ WRITELN ('Files Erased: ', EraseCount,π ' bytes used: ', EraseSizeK DIV 2, 'k');π END;πππFUNCTION UnZIPFile ( ZIPOpts, ZIPName, DPath, fspec : STRING; qt : BOOLEAN) : BOOLEAN;πVAR s, zname : STRING;π i, j : INTEGER;π BEGINπ ZIPError := 0;π UnZIPFile := TRUE;π s := '';π IF ZIPOpts <> '' THEN s := s + ZIPOptsπ ELSE s := s + ZIPDefaultZIPOpts;ππ IF ZIPName <> '' THEN zname := ZIPNameπ ELSE zname := ZIPFileName;π IF NOT FileExists (zname) THENπ BEGINπ WRITELN ('zname: [', zname, ']');π UnZIPFile := FALSE;π ZIPError := 99;π EXIT;π END;ππ s := s + ' ' + zname;ππ IF DPath <> '' THEN s := s + ' ' + DPathπ ELSE s := s + ' ' + ZIPDPath;π s := s + ' ' + fspec;π ZIPError := ExecuteCommand (PKUNZIP,s,qt);π IF ZIPError > 0 THENπ BEGINπ WRITELN ('PKUNZIP start failed ', ZIPError, ' [', s, ']');π UnZIPFile := FALSE;π ENDπ ELSE BEGINπ i := POS ('*', fspec);π j := POS ('?', fspec);π IF (i = 0) AND (j = 0) THENπ BEGINπ IF NOT FileExists (DPath + fspec) THENπ BEGINπ UnZIPFile := FALSE;π ZIPError := 98;π END;π END;π END;π END;ππFUNCTION ZIPFile ( ZIPOpts, ZIPName, fspec : STRING; qt : BOOLEAN) : BOOLEAN;πVAR s, zname : STRING;π i, j : INTEGER;π BEGINπ ZIPError := 0;π ZIPFile := TRUE;π s := '';π IF ZIPOpts <> '' THEN s := s + ZIPOptsπ ELSE s := s + ZIPDefaultZIPOpts;ππ IF ZIPName <> '' THEN zname := ZIPNameπ ELSE zname := ZIPFileName;π s := s + ' ' + zname;π s := s + ' ' + fspec;π ZIPError := ExecuteCommand (PKZIP,s,qt);π IF ZIPError > 0 THENπ BEGINπ WRITELN ('PKZIP start failed ', ZIPError, ' [', s, ']');π ZIPFile := FALSE;π ENDπ ELSE BEGINπ IF NOT FileExists (ZIPname + '.ZIP') THENπ BEGINπ ZIPFile := FALSE;π ZIPError := 98;π END;π END;π END;πππ BEGINπ PKZIPInit;π END.π 23 08-24-9413:36ALL DAVID ADAMSON EXE Menu System SWAG9408 ±Æk■ 180 U {πHere is a good scrolling menu bar program written in TP 5.5. Theπcode is very clean and well commented.π}ππprogram exemenu; { version 2.2 }ππππ(****************************************** 1991 J.C. Kessels ****ππThis is freeware. No guarantees whatsoever. You may change it, use it,πcopy it, anything you like.πππJ.C. KesselsπPhilips de Goedelaan 7π5615 PN EindhovenπNetherlandsπ********************************************************************)πππ{$M 3000,0,0} { No heap, or we can't use 'exec'. }πππuses dos;πππππconstπ(* English version: *)π StrCopyright = 'EXEMENU v2.2, 1991 J.C. Kessels';{ Name of program. }π StrBusy = 'Busy....'; { Program is busy message. }π StrHelp = 'Enter=Start ESC=Stop'; { Bottom-left help message.}π StrStart = 'Busy starting program: '; { Start a program message. }π { Wrong DOS version message. }π StrDos = 'Sorry, this program only works with DOS versions 3.xx and above.';π { Unrecognised error message. }π StrError = 'EXEMENU: unrecognised error caused program termination.';π StrExit = 'That''s it, folks!'; { Exit message. }π(* Dutch version: *)π(*π StrCopyright = 'EXEMENU v2.2, 1991 J.C. Kessels'; { Naam van het programma.}π StrHelp = 'Enter=Start ESC=Stop'; { Bodem-links hulp boodschap.}π StrBusy = 'Bezig....'; { Ik ben bezig boodschap.}π { Bij het starten van een programma. }π StrStart = 'Bezig met starten van: ';π { Foutboodschap als de DOS versie niet goed is. }π StrDos = 'Sorry, dit programma werkt slechts met DOS versie 3.xx en hoger.';π { Onbekende fout boodschap. }π StrError = 'EXEMENU: door onbekende fout voortijdig beëindigd.';π StrExit = 'Exemenu is geëindigd.'; { Stop EXEMENU boodschap. }π*)ππ DirMax = 1000; { Number of entries in directory array. }ππtypeπ Str90 = string[90]; { We don't need anything longer than this. }ππvarπ VidStore : array[0..3999] of char; { Video screen storage. }π Dir : array[1..DirMax] of record {The directory is loaded into this array.}π attr : byte; { 1: directory, 2: file.}π name : NameStr; { Name of file/directory. }π ext : ExtStr; { Extension of file. }π end;π DirTop : word; { Last active entry in Dir array. }π DirHere : word; { Current selection in Dir array. }π DirPath : pathstr; { The path of the Loaded directory. }π OldPath : PathStr; { The current directory at startup of EXEMENU. }π BasicPath : PathStr; { The path to the basic interpreter. }π OldCursor : word; { Saved cursor shape. }π xy : word; { Cursor on the screen. }π colour : byte; { Colour for the screen. }π vidseg : word; { Segment of the screen RAM. }π regs : registers; { Registers to call the BIOS. }π Inkey : word; { The last pressed key. }π keyflags : byte absolute $0040:$0017; { BIOS keyboard flags. }π ExitSave : pointer; { Address of exit procedure. }π ExitMsg : Str90; { Message to display when exiting. }π DTA : SearchRec; { FindFirst-FindNext buffer. }ππfunction Left(s : Str90; width : byte) : Str90;π{Return Width characters from input string. Add trailing spaces if necessary.}πbeginπif width > length(s) then Fillchar(s[length(s)+1],width-length(s),32);πs[0] := chr(width);πLeft := s;πend;ππprocedure FixupDir;π{ Fixup the DirPath string. }πvarπ drive : char;π i, j : word;πbeginπi := pos(':',DirPath); { Strip the drive from the path. }πif i = 0 thenπ beginπ if (length(Dirpath) > 0) and (Dirpath[1] = '\')π then DirPath := copy(OldPath,1,2) + DirPathπ else if OldPath[length(OldPath)] = '\'π then DirPath := OldPath + DirPathπ else DirPath := OldPath + '\' + DirPath;π i := pos(':',DirPath);π end;πdrive := DirPath[1];πdelete(DirPath,1,i);ππwhile pos('..',DirPath) <> 0 do { Remove embedded ".." }π beginπ i := pos('..',DirPath);π j := i + 2;π if i > 1 then dec(i);π if (i > 1) and (DirPath[i] = '\') then dec(i);π while (i > 1) and (DirPath[i] <> '\') do dec(i);π delete(DirPath,i,j-i);π end;ππ{ Remove embedded ".\" }πwhile pos('.\',DirPath) <> 0 do delete(DirPath,pos('.\',DirPath),2);ππif pos('\',DirPath) = 0 { If no subdirectories.... }π then DirPath := '\'π elseπ begin { Else strip filename from the path.... }π i := pos('.',DirPath);π if i > 0 thenπ beginπ while (i > 0) and (DirPath[i] <> '\') do dec(i);π if i > 0π then DirPath := copy(DirPath,1,i)π else DirPath := '\';π end;π if DirPath[length(DirPath)] <> '\' { maybe add '\' at the end.... }π then DirPath := DirPath + '\';π end;ππDirPath := drive + ':' + DirPath; { Add the drive back to the directory. }ππ{ Translate the Dirpath into all uppercase. }πfor i := 1 to length(DirPath) do DirPath[i] := upcase(DirPath[i]);πend;ππprocedure Show(s : Str90);π{ Display string "s" at "xy", using "colour". This routine uses DMA into theπ video memory. }πbeginπInline(π $8E/$06/>VIDSEG/ {mov es,[>vidseg] ; Fetch video segment in ES.}π $8B/$3E/>XY/ {mov di,[>xy] ; Fetch video offset in DI.}π $8A/$26/>COLOUR/ {mov ah,[>colour] ; Fetch video colour in AH.}π $1E/ {push ds ; Setup DS to stack segment.}π $8C/$D1/ {mov cx,ss}π $8E/$D9/ {mov ds,cx}π $8A/$8E/>S/ {mov cl,[bp+>s] ; Fetch string size in CX.}π $30/$ED/ {xor ch,ch}π $8D/$B6/>S+1/ {lea si,[bp+>s+1] ; Fetch string address in SI.}π $E3/$04/ {jcxz l2 ; Skip if zero length.}π {l1:}π $AC/ {lodsb ; Fetch character from string.}π $AB/ {stosw ; Show character.}π $E2/$FC/ {loop l1 ; Next character.}π {l2:}π $1F/ {pop ds ; Restore DS.}π $89/$3E/>XY); {mov [>xy],di ; Store new XY.}πend;ππprocedure ShowMenu(Message : Str90);π{ Display the screen, with borders, a "Message" in line 2, and the loadedπ directory in the rest of the screen. }πvarπ i : word; { Work variable. }π s : Str90; { Work variable. }π pagetop : word; { Top of the page in the Dir array. }π row : word; { The display row we are busy with. }πbeginπxy := 0; { First line. }πcolour := $13;πif length(StrCopyright) > 76π then i := 76π else i := length(StrCopyright);πs[0] := chr((76 - i) div 2);πFillchar(s[1],ord(s[0]),'═');πShow('╔'+s+'╡');πcolour := $1B;πShow(copy(StrCopyright,1,i));πcolour := $13;πs[0] := chr(76 - length(s) - length(StrCopyright));πFillchar(s[1],ord(s[0]),'═');πShow('╞'+s+'╗║ ');ππcolour := $1E; { Second line. }πShow(left(Message,76));ππcolour := $13; { Third line. }πShow(' ║╟──────────────────────────────────────────────────────────────────────────────╢');ππ{ Display all the directory entries, using the current cursor positionπ to calculate the top-left of the page. }πpagetop := DirHere - DirHere mod 105 + 1;πfor i := pagetop to pagetop + 20 doπ beginπ colour := $13;π Show('║ ');π colour := $1E;π row := 0;π while row <= 84 doπ beginπ if i+row <= DirTopπ then if Dir[i+row].attr = 1π then Show(left(Dir[i+row].name,14))π else Show(left(Dir[i+row].name,8) + '.' + left(Dir[i+row].ext,5))π else Show(' ');π row := row + 21;π end;π colour := $13;π Show(' ║');π end;ππcolour := $13; { Last line. }πShow('╚══╡');πcolour := $1B;πif length(StrHelp) > 74π then i := 74π else i := length(StrHelp);πShow(copy(StrHelp,1,i));πcolour := $13;πs[0] := chr(74-i);πFillchar(s[1],ord(s[0]),'═');πShow('╞'+s+'╝');πend;ππprocedure ShowBar(here : word; onoff : boolean);π{ Display (onoff = true) or remove (onoff = false) the cursor bar at the screenπ location that shows the "here" entry in the Dir array. Every entry has aπ fixed location on the screen. }πvarπ i : word;πbeginπi := Here mod 105 - 1; { Calculate position on screen. }πxy := 484 + (i div 21) * 28 + (i mod 21) * 160;πif onoff { Setup the proper colour. }π then colour := $70π else colour := $1E;πif Here <= DirTop { Display the Dir entry. }π then if Dir[Here].attr = 1π then Show(left(Dir[Here].name,12)) { Directories without a dot. }π else Show(left(Dir[Here].name,8) + '.' + left(Dir[Here].ext,3))π else Show(' '); { Empty entries. }πcolour := $1E; { Reset the colour. }πend;ππprocedure InitVideo;π{ Initialise the video. If not 80x25 then switch to it. Store the screen.π Hide the cursor. }πvarπ i : byte;πbeginπregs.ah := $0F; { If not text mode 3 or 7, then switch to it. }πintr($10,regs);πi := regs.al and $7F;πregs.ah := $03; { Save current cursor shape. BH is active page. }πintr($10,regs);πOldCursor := regs.cx;πif (i <> 3) and (i <> 7) thenπ beginπ regs.al := 3;π regs.ah := 0;π intr($10,regs);π i := 3;π end;ππif i <> 7 { Compute video segment. }π then vidseg := $B800 + (memw[$0040:$004E] shr 4)π else vidseg := $B000 + (memw[$0040:$004E] shr 4);ππmove(mem[vidseg:0],VidStore[0],4000); { Store current screen. }ππregs.cx := $2000; { Hide cursor. }πregs.ah := 1;πintr($10,regs);ππcolour := $1E; { Reset attribute. }πxy := 0; { Reset cursor. }πend;ππprocedure ResetVideo;π{ Reset the video back to it's original contents. Show the cursor. }πbeginπmove(VidStore[0],mem[vidseg:0],4000); { Restore screen. }ππregs.cx := OldCursor; { Reset original cursor chape. }πregs.ah := 1;πintr($10,regs);πend;ππ{$F+}πprocedure ExitCode;π{ Reset display upon exit. This also works for error exit's. }πbeginπResetVideo; { Reset the original display contents. }πif ExitMsg <> '' then writeln(ExitMsg); { Show exit message. }πChDir(OldPath); { Restore current path. }πExitProc := ExitSave; { Reset previous exit procedure. }πend;π{$F-}ππprocedure LoadDir;π{ Load the "DirPath" directory into memory. }πvarπ i : word; { Work variable. }π s : pathstr; { Work variable. }π name : NameStr; { Name of current file. }π ext : ExtStr; { Extension of current file. }π attr : byte; { Attribute of current file. }πbeginπcolour := $1E; { Show "busy" message. }πxy := 164;πShow(left(StrBusy,76));ππFixupDir; { Cleanup the DirPath string. }πDirTop := 0; { Reset pointers into the Dir array.}πDirHere := 1;ππFindFirst(DirPath+'*.*',AnyFile,DTA); { Find first file. }πwhile (DosError = 3) and (length(DirPath) > 3) do { If path not found....}π beginπ i := length(DirPath); { then strip last directory from path. }π if i > 3 then dec(i);π while (i > 3) and (DirPath[i] <> '\') do dec(i);π DirPath := copy(DirPath,1,i);π FindFirst(DirPath+'*.*',AnyFile,DTA); { And try again. }π end;ππwhile DosError = 0 do { For all the files. }π beginπ attr := 0;π if (DTA.attr and Directory) = Directoryπ thenπ begin { Setup for directories. }π name := DTA.name;π ext := '';π if DTA.name <> '.' then attr := 1; { Ignore '.' directory. }π if DTA.name = '..' then name := '..';π endπ elseπ beginπ for i := 1 to length(DTA.name) do { Translate filename to lowercase. }π if DTA.name[i] IN ['A'..'Z'] thenπ DTA.name[i] := chr(ord(DTA.name[i])+32);π i := pos('.',DTA.name); { Split filename in name and extension. }π if i > 0π thenπ beginπ name := copy(DTA.name,1,i-1);π ext := copy(DTA.name,i+1,length(DTA.name)-i);π endπ elseπ beginπ name := DTA.name;π ext := '';π end;π { Ignore unrecognised extensions. }π if (ext = 'com') and (DTA.name <> 'command.com') then attr := 2;π if (ext = 'exe') and (DTA.name <> 'exemenu.exe') then attr := 2;π if (ext = 'bat') and (DTA.name <> 'autoexec.bat') then attr := 2;π if (ext = 'bas') and (BasicPath <> '') then attr := 2;π end;π { If recognised extension or directory, then load into memory. }π if attr > 0 thenπ beginπ i := 1;π while (i <= DirTop) and { Find location where to insert (sort). }π ((attr > Dir[i].attr) orπ ((attr = Dir[i].attr) and (name > Dir[i].name)) orπ ((attr = Dir[i].attr) and (name = Dir[i].name) and (ext > Dir[i].ext)))π do inc(i);π if DirTop < DirMax then inc(DirTop);π if i < DirTop then { Move entries up, to create entry. }π move(Dir[i],Dir[i+1],sizeof(Dir[1]) * (DirTop - i));π if i <= DirMax then { Fill the entry. }π beginπ Dir[i].name := name;π Dir[i].ext := ext;π Dir[i].attr := attr;π end;π end;π FindNext(DTA); { Next item. }π end;ππ{ Analyse the results. If nothing found (maybe disk error), and if we are in aπ subdirectory, then at least add the parent directory. }πif (DirTop = 0) and (length(DirPath) > 3) thenπ beginπ Dir[1].name := '..';π Dir[1].ext := '';π Dir[1].attr := 1;π DirTop := 1;π end;ππend;ππprocedure ExecuteProgram;π{ Execute the program at "DirHere". }πvarπ ProgramPath : pathstr; { Path to the program to execute. }πbeginπ{ Return from this subroutine if there is no program at the cursor. }πif (DirHere < 1) or (DirHere > DirTop) or (Dir[DirHere].attr <> 2) then exit;ππcolour := $1E; { Show "busy" message. }πxy := 164;πShow(left(StrBusy,76));ππ{ Setup path to the program. }πProgramPath := DirPath + Dir[DirHere].name + '.' + Dir[DirHere].ext;ππFindFirst(ProgramPath,AnyFile,DTA); { Test if the path to the program exists. }πif DosError <> 0 then exit; { Exit if error. }πResetVideo; { Reset the video screen. }πwriteln(StrStart,ProgramPath); { Show startup message. }ππChDir(copy(DirPath,1,length(DirPath)-1)); { Change to the directory. }πSwapVectors; { Start program. }πif Dir[DirHere].ext = 'bat' { .BAT files trough the COMMAND.COM. }π then Exec(getenv('COMSPEC'),'/C '+ProgramPath)π else if Dir[DirHere].ext = 'bas' { .BAS trough the basic interpreter. }π then Exec(BasicPath,ProgramPath)π else Exec(ProgramPath,''); { Others directly. }πSwapVectors;ππInitVideo; { Initialise the video. }πShowMenu(StrBusy); { Draw screen with "busy" message. }ππ{ Reset keyboard flags. }πkeyflags := keyflags and $0F; {Capslock, Numlock, ScrollLock and Insert off.}πfillchar(regs,sizeof(regs),#0); { Clear registers. }πregs.ah := 1; { Activate new setting. }πintr($16,regs);ππregs.ah := 1; { Clear the keyboard buffer.}πintr($16,regs);πwhile (regs.flags and fzero) = 0 doπ beginπ regs.ah := 0;π intr($16,regs);π regs.ah := 1;π intr($16,regs);π end;ππInkey := 13;πend;ππvarπ i : word; { Workvariable. }π s : Str90; { Workvariable. }π OldHere, OldPageTop : word; { Determine if cursor has moved. }ππbeginπDirPath := ''; { No directory loaded right now. }πDirTop := 0; { No directory loaded right now. }πExitMsg := StrError; { Reset error message. }πgetdir(0,OldPath); { Save current directory. }πExitSave := ExitProc; { Setup exit procedure. }πExitProc := @ExitCode;πInitVideo; { Initialise the video. }πShowMenu(StrBusy); { Draw screen with "busy" message. }ππif lo(DosVersion) < 3 then { Test DOS version. }π beginπ ExitMsg := StrDos;π halt(1);π end;ππ{ Determine what directory to search for programs. Default is the currentπ directory. Otherwise the first argument after EXEMENU is used as startingπ path. }πif paramcount = 0π then DirPath := OldPathπ else DirPath := paramstr(1);ππ{ Find the basic interpreter somewhere in the path. If not found, then basicπ programs will not be listed. }πBasicPath := Fsearch('GWBASIC.EXE',GetEnv('PATH'));πif BasicPath = '' then BasicPath := Fsearch('GWBASIC.COM',GetEnv('PATH'));πif BasicPath = '' then BasicPath := Fsearch('BASIC.EXE',GetEnv('PATH'));πif BasicPath = '' then BasicPath := Fsearch('BASIC.COM',GetEnv('PATH'));πif BasicPath = '' then BasicPath := Fsearch('BASICA.EXE',GetEnv('PATH'));πif BasicPath = '' then BasicPath := Fsearch('BASICA.COM',GetEnv('PATH'));πif BasicPath <> '' then BasicPath := FExpand(BasicPath);ππLoadDir; { Load the directory into memory. }πShowMenu(DirPath); { Display the directory. }πShowBar(DirHere,true); { Highlight the current choice. }ππ{ The main loop, exited only when the user presses ESC. }πrepeatπ { Wait for a key to be pressed. Place the scancode in the Inkey variable. }π regs.ah := 0;π intr($16,regs);π Inkey := regs.ax;ππ if lo(Inkey) = 13 then { Process ENTER key. }π beginπ ShowBar(DirHere,false); { Remove cursor bar. }π s := ''; { No item stored. }π { If cursor points to a program....}π if DirHere <= DirTop then if Dir[DirHere].attr = 2π thenπ beginπ { Store the item to execute, so we can move the cursor back to it. }π s := Dir[DirHere].name + '.' + Dir[DirHere].ext;π ExecuteProgram; { Then execute the program....}π endπ else if Dir[DirHere].name <> '..' { Else goto the directory....}π then DirPath := fexpand(DirPath+Dir[DirHere].name) + '\'π elseπ begin { Or goto the parent directory. }π i := length(DirPath) - 1;π while (i >= 1) and (DirPath[i] <> '\') do dec(i);π {Store the directory we just left, so we can move the cursor to it.}π s := copy(DirPath,i+1,length(DirPath)-i-1);π if i > 0π then DirPath := copy(DirPath,1,i)π else DirPath := '\';π end;π LoadDir; { Reload the directory. }π { If an item was stored, then find it, and move the cursor to it. }π if s <> '' thenπ beginπ DirHere := 1;π if pos('.',s) = 0π then while (DirHere < DirTop) and (Dir[DirHere].name <> s) doπ inc(DirHere)π else while (DirHere < DirTop) andπ (Dir[DirHere].name + '.' + Dir[DirHere].ext <> s) do inc(DirHere);π if (DirHere <= DirTop) and (π ((pos('.',s) = 0) andπ (Dir[DirHere].name <> s)) orπ ((pos('.',s) > 0) andπ (Dir[DirHere].name + '.' + Dir[DirHere].ext <> s)) )π then DirHere := 1;π end;π ShowMenu(DirPath); { Show the menu. }π ShowBar(DirHere,true); { Show cursor bar. }π end;ππ { Process cursor movement keys. }π OldHere := DirHere; {Remember current cursor, to determine if it has moved.}π if (Inkey = $4800) and (DirHere > 1) then dec(DirHere); { arrow-up.}π if (Inkey = $5000) and (DirHere < DirTop) then inc(DirHere); {arrow-down.}π if (Inkey = $4D00) or (lo(Inkey) = 9) then {arrow-right or tab.}π if DirHere + 21 <= DirTopπ then DirHere := DirHere + 21π else DirHere := DirTop;π if (Inkey = $4B00) or (Inkey = $0F00) then { arrow-left or shift-tab. }π if DirHere > 21π then DirHere := DirHere - 21π else DirHere := 1;π if (Inkey = $5100) and (DirHere < DirTop) then { pgdn. }π if DirTop > 105π then if DirHere + 105 < DirTopπ then DirHere := DirHere + 105π else DirHere := DirTopπ else if (DirHere - 1) mod 21 = 20π then if DirHere + 21 <= DirTopπ then DirHere := DirHere + 21π else DirHere := DirTopπ else if DirHere - (DirHere - 1) mod 21 + 20 < DirTopπ then DirHere := DirHere - (DirHere - 1) mod 21 + 20π else DirHere := DirTop;π if (Inkey = $4900) and (DirHere > 1) then { pgup. }π if DirTop > 105π then if DirHere > 105π then DirHere := DirHere - 105π else DirHere := 1π else if (DirHere - 1) mod 21 = 0π then if DirHere > 21π then DirHere := DirHere - 21π else DirHere := 1π else DirHere := DirHere - (DirHere - 1) mod 21;π if Inkey = $4700 then DirHere := 1; { home. }π if Inkey = $4F00 then DirHere := DirTop; { end. }π if lo(Inkey) > 31 then {Process a character inkey. }π beginπ i := 1;π while (i <= DirTop) and (Dir[i].name[1] <> chr(lo(Inkey))) do inc(i);π if i <= DirTop then DirHere := i;π end;π if DirHere = 0 then DirHere := 1; { Correct for empty list. }π { If the cursor has moved off the screen, then redraw the menu. }π if OldHere - OldHere mod 105 + 1 <> DirHere - DirHere mod 105 + 1 thenπ beginπ ShowBar(OldHere,false);π ShowMenu(DirPath);π ShowBar(DirHere,true);π OldHere := DirHere;π end;π if OldHere <> DirHere then { If the cursor has moved, then redraw it. }π beginπ ShowBar(OldHere,false);π ShowBar(DirHere,true);π end;ππuntil lo(Inkey) = 27; { Until ESC key pressed. }ππExitMsg := StrExit; { Exit with message. }πend.π 24 08-24-9413:45ALL FRANK DIACHEYSN Multiple DOS Calls SWAG9408 ,t╪ 11 U {π Coded By Frank Diacheysn Of Gemini Softwareππ FUNCTION MASSEXECππ Input......: DOS Command Line(s)π :π :π :π :ππ Output.....: Logicalπ : TRUE = No Errors During Executionπ : FALSE = Error Occured During Executionπ :π :ππ Example....: IF MASSEXEC('DIR,PAUSE') THENπ : WriteLn('No Errors!')π : ELSEπ : WriteLn('DOS Error Occured!');π :ππ Description: Execute One Or More DOS Program Callsπ : (Seperate Calls With A Comma)π :π :π :ππ}πFUNCTION MASSEXEC( S:STRING ):BOOLEAN;π{$M $4000,0,0}πVAR nCount : INTEGER;πVAR ExS : STRING;πVAR Ch : CHAR;πBEGINπ REPEATπ nCount := 0;π ExS := '';π REPEATπ Inc(nCount);π Ch := S[nCount];π IF Ch <> ',' THENπ ExS := ExS + Ch;π UNTIL (Ch = ',') OR (nCount = Length(S));π IF POS(',',S)=0 THENπ S := ''π ELSEπ DELETE(S,1,POS(',',S));π SWAPVECTORS;π EXEC( GETENV('COMSPEC'), '/C '+ ExS );π SWAPVECTORS;π MASSEXEC := DOSERROR = 0;π UNTIL S = '';πEND;π 25 08-24-9413:47ALL MIKE PERRY Menu System SWAG9408 2Lm╖ 83 U {π GG> Could somebody post a message with the Pascal 6.0 source for someπ GG> sort of a scrolling menu system? I do NOT want TurboVision. Iπ GG> HATE OOP. I don't mind records and arrays, but i don't want OOP.π GG> I've done some programming for one myself....π}ππUNIT MPMENU;π{π Written and designed by Michael Perry, (c) 1990 Progressive Computer Serv.ππ A basic, flexible, user-definable menu system using only the most basicπ functions in Turbo Pascal. This unit is easily integratable into yourπ applications and gives you more versatility than most "pull down"-typeπ menu interfaces.ππ License: This unit should NOT be modified and redistributed in sourceπ or object/TPU form. You can modify and use this in any non-π commercial program free-of-charge provided that "Mike Perry"π if credited either in the program or documentation. Use ofπ these routines in a commercially-sold package requires aπ one-time registration fee of $30 to be sent to:ππ Progressive Computer Servicesπ P.O. Box 7638π Metairie, LA 70010ππ Non-commercial users are also invited to register the code.π This insures that updates and future revisions are madeπ available and users are kept informed via mail.πππ Usage: Implementing menus using the MPMENU unit involves just aπ few basic steps. At any point in your program, add codeπ to perform the following actions:ππ 1. Define the menu by assigning values to the MENU_DATAπ record.π 2. Call the procedure MENU(MENU_DATA,RETURNCODE);π 3. Implement a routine to evaluate the value ofπ RETURNCODE and act accordingly. The values ofπ RETURNCODE are as follows:π 0 = ESC pressed (menu aborted)π 1-x = The appropriate option was selected, with 1π being the first menu choice, 2 the second,π etc.ππ Example: Here is a sample main menu using the MENU procedure:π-----------------------------------------------------------------------------π Program DontDoMuch;π Uses Crt,MPMenu;ππ CONST HELL_FREEZES_OVER=FALSE;π VAR CHOICE:BYTE;ππ Beginπ REPEATππ With Menu_Data Do Beginπ Menu_Choices[1]:='1 - First Option '; - define menu choice onscreenπ Row[1]:=10; Column[1]:=30; - where on screen displayedπ Menu_Choices[2]:='2 - Second Option'; - same thing for 2nd choiceπ Row[2]:=12; Column[2]:=30; .π Menu_Choices[3]:='X - Exit Program '; .π Row[3]:=14; Column[3]:=30; .π Onekey:=TRUE; - enable 1-key executionπ Num_Choices:=3; - number of menu choicesπ HiLighted:=112; - highlighted attributeπ Normal:=7; - normal attributeπ End;ππ MENU(MENU_DATA,CHOICE); - call the menu now and wait for userππ Case Choice Of - evaluate user response and actπ 0:Halt; - ESC pressedπ 3:Halt; - option 3, Exit, selectedπ 1:Beginπ - put code here to do menu option 1π End;π 2:Beginπ - put code here to do menu option 2π End;π Endππ UNTIL HELL_FREEZES_OVER; - infinite loop - back to main menuπEnd.π-----------------------------------------------------------------------------π}πINTERFACEππ USES Crt;ππ CONSTπ MAX_CHOICES = 10; { MAX_CHOICES can be changedπ depending upon the highestπ number of options you willπ have on any given menu }ππ TYPEπ MENU_ARRAY = RECORD { record structure for menu }π MENU_CHOICES : ARRAY[1..MAX_CHOICES] OF STRING[50]; { displayed option }π COLUMN : ARRAY[1..MAX_CHOICES] OF BYTE; { column location }π ROW : ARRAY[1..MAX_CHOICES] OF BYTE; { row location }π NUM_CHOICES : BYTE; { # choices on menu }π HILIGHTED : WORD; { attribute for hilight }π NORMAL : WORD; { attributed for normal }π ONEKEY : BOOLEAN; { TRUE for 1-key executionπ}π END;ππ VARπ MENU_DATA : MENU_ARRAY; { global menu variable }ππ{π NOTE: You can define many menu variables simultaneously, but since youπ can generally use only one menu at a time, you can conserveπ memory and program space by re-defining this one MENU_DATA recordπ each time a menu is to be displayed.π}ππ{ internal procedures }π PROCEDURE SHOW_MENU(MENU_DATA:MENU_ARRAY);π PROCEDURE HILIGHT_CHOICE(MENU_DATA:MENU_ARRAY;CHOICENUM:BYTE);π PROCEDURE UNHILIGHT_CHOICE(MENU_DATA:MENU_ARRAY;CHOICENUM:BYTE);π FUNCTION GETKEY(VAR FUNCTIONKEY:BOOLEAN):CHAR;π FUNCTION FOUND_CHOICE(MENU_DATA:MENU_ARRAY;VAR EXITCODE:BYTE;CH:CHAR):BOOLEAN;ππ{ basically, the ONE callable procedure }π PROCEDURE MENU(MENU_DATA:MENU_ARRAY;VAR EXITCODE:BYTE);ππIMPLEMENTATIONπππ(*===========================================================================*)πPROCEDURE SHOW_MENU(MENU_DATA:MENU_ARRAY);π{ display defined menu array }πVAR I:BYTE;πBEGINπ TEXTATTR:=MENU_DATA.NORMAL;π FOR I:=0 TO (MENU_DATA.NUM_CHOICES-1) DO BEGINπ GOTOXY(MENU_DATA.COLUMN[I+1],MENU_DATA.ROW[I+1]);π WRITE(MENU_DATA.MENU_CHOICES[I+1]);π END;πEND;π(*===========================================================================*)πPROCEDURE HILIGHT_CHOICE(MENU_DATA:MENU_ARRAY;CHOICENUM:BYTE);π{ highlight the appropriate menu choice }πBEGINπ GOTOXY(MENU_DATA.COLUMN[CHOICENUM],MENU_DATA.ROW[CHOICENUM]);π TEXTATTR:=MENU_DATA.HILIGHTED;π WRITE(MENU_DATA.MENU_CHOICES[CHOICENUM]);π { below needed if direct screen writing not done }π GOTOXY(MENU_DATA.COLUMN[CHOICENUM],MENU_DATA.ROW[CHOICENUM]);πEND;π(*===========================================================================*)πPROCEDURE UNHILIGHT_CHOICE(MENU_DATA:MENU_ARRAY;CHOICENUM:BYTE);π{ highlight the appropriate menu choice }πBEGINπ GOTOXY(MENU_DATA.COLUMN[CHOICENUM],MENU_DATA.ROW[CHOICENUM]);π TEXTATTR:=MENU_DATA.NORMAL;π WRITE(MENU_DATA.MENU_CHOICES[CHOICENUM]);πEND;π(*===========================================================================*)πFUNCTION GETKEY(VAR FUNCTIONKEY:BOOLEAN):CHAR;π{ read keyboard and return character/function key }πVAR CH: CHAR;πBEGINπ CH:=ReadKey;π IF (CH=#0) THENπ BEGINπ CH:=ReadKey;π FUNCTIONKEY:=TRUE;π ENDπ ELSE FUNCTIONKEY:=FALSE;π GETKEY:=CH;πEND;π(*===========================================================================*)πFUNCTION FOUND_CHOICE(MENU_DATA:MENU_ARRAY;VAR EXITCODE:BYTE;CH:CHAR):BOOLEAN;π{ locate next occurance of menu choice starting with char CH }πVAR I:BYTE; TEMP:STRING;πBEGINπ CH:=UPCASE(CH);π IF EXITCODE=MENU_DATA.NUM_CHOICES THEN BEGINπ TEMP:=MENU_DATA.MENU_CHOICES[1];π IF UPCASE(TEMP[1])=CH THEN BEGINπ UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);π EXITCODE:=1;π HILIGHT_CHOICE(MENU_DATA,EXITCODE);π FOUND_CHOICE:=TRUE;π EXIT;π END;π END;ππ FOR I:=EXITCODE+1 TO MENU_DATA.NUM_CHOICES DO BEGINπ TEMP:=MENU_DATA.MENU_CHOICES[I];π IF UPCASE(TEMP[1])=CH THEN BEGINπ UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);π EXITCODE:=I;π HILIGHT_CHOICE(MENU_DATA,EXITCODE);π FOUND_CHOICE:=TRUE;π EXIT;π END;π END;ππ IF EXITCODE<>1 THEN BEGIN { KILLER RECURSION }π UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);π EXITCODE:=1;π IF FOUND_CHOICE(MENU_DATA,EXITCODE,CH) THEN BEGINπ HILIGHT_CHOICE(MENU_DATA,EXITCODE);π FOUND_CHOICE:=TRUE;π EXIT;π END ELSE HILIGHT_CHOICE(MENU_DATA,EXITCODE);π END ELSE BEGINπ TEMP:=MENU_DATA.MENU_CHOICES[1];π IF UPCASE(TEMP[1])=CH THEN BEGINπ FOUND_CHOICE:=TRUE;π EXIT;π END;π END;π FOUND_CHOICE:=FALSE;πEND;π(*===========================================================================*)πPROCEDURE MENU(MENU_DATA:MENU_ARRAY;VAR EXITCODE:BYTE);π{ display menu and return user's response:π 0 = ESC pressedπ 1-x = appropriate choice selectedππ during operation, variable EXITCODE holds number of currently-selectedπ menu choice.π}πVARπ FNC:BOOLEAN; TEMPATTR:WORD;π CH:CHAR;πBEGINπ TEMPATTR:=TEXTATTR;π IF (EXITCODE=0) OR (EXITCODE>MENU_DATA.NUM_CHOICES) THENπ EXITCODE:=1;π SHOW_MENU(MENU_DATA);π HILIGHT_CHOICE(MENU_DATA,EXITCODE);π REPEATπ CH:=GETKEY(FNC);π IF FNC THEN BEGINπ IF CH=#77 THEN CH:=#80 ELSEπ IF CH=#75 THEN CH:=#72;ππ CASE CH OFπ #72:IF EXITCODE>1 THEN BEGIN { UP }π UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);π EXITCODE:=EXITCODE-1;π END;π #80:IF EXITCODE<MENU_DATA.NUM_CHOICES THEN BEGIN { DOWN }π UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);π EXITCODE:=EXITCODE+1;π END;π #71:IF EXITCODE<>1 THEN BEGIN { HOME }π UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);π EXITCODE:=1;π END;π #79:IF EXITCODE<MENU_DATA.NUM_CHOICES THEN BEGIN { END }π UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);π EXITCODE:=MENU_DATA.NUM_CHOICES;π END;π END; { functionkey CASE }π HILIGHT_CHOICE(MENU_DATA,EXITCODE);π END { if FNC }ππ ELSEπ CASE CH OFπ #27:BEGINπ EXITCODE:=0;π TEXTATTR:=TEMPATTR;π EXIT;π END;π #13:BEGINπ TEXTATTR:=TEMPATTR;π EXIT;π END;π ELSEπ IF FOUND_CHOICE(MENU_DATA,EXITCODE,CH) THENπ IF (MENU_DATA.ONEKEY) THEN BEGINπ TEXTATTR:=TEMPATTR;π EXIT;π END ELSE { nothing }π ELSEπ{ BEGINπ GOTOXY(1,20); used for debuggingπ WRITELN('FNC=',FNC,' KEYVAL=',ORD(CH));π END;π }π END; {case}π UNTIL FALSE;πEND;π(*===========================================================================*)πEND. { of unit MPMENU }ππ
