SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00022 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.π
