Solved

Redirecting output when using exec command in Pascal

Posted on 2001-06-15
9
940 Views
Last Modified: 2013-11-18
I'm using a graphical interface in Pascal and I don't want the childprocesses to return ANYTHING back to screen

(so both 1 and 2 (error) should be redirected to nul or to a file when I specify > in my command-string)

Please help me and help me quickly ... This needs to be operational Wednesday 20th June.

Function ShellCommand(Command : String) : Integer;
Var
  Redirect        : Boolean;
  OutputTo        : String;
  Param          : String;

Begin
  Redirect := (Pos('>', Command) <> 0);
  If Redirect Then
    OutputTo := ''
  Else
    OutputTo := ' 1>nul';
  Param := Copy(Command, Pos(' ', Command) + 1, Length(Command) - Pos(' ', Command));
  Delete(Command, Pos(' ', Command), Length(Command) - Pos(' ', Command) + 1);
  SwapVectors;
  Exec(Command, param + OutputTo);
  SwapVectors;
  ShellCommand := DosExitCode;
End;
0
Comment
Question by:Rcm
  • 5
  • 4
9 Comments
 

Author Comment

by:Rcm
Comment Utility
The redirect works when I use the GetEnv('ComSpec') as command and the real command as parameter to it (with /c). This way I'm able to redirect it, BUT using command.com as command will reset dosexitcode and doserror ...
0
 
LVL 47

Expert Comment

by:dbrunton
Comment Utility
Q: How do I execute an MS-DOS command from within a TP program?

 A: The best way to answer this question is to give an example.
  {$M 2048, 0, 0}   (* <-- Important *)
  program outside;
  uses dos;
  begin
    write ('Directory call from within TP by Timo Salmi');
    SwapVectors;
    Exec (GetEnv('comspec'), '/c dir *.*');  (* Execution *)
    SwapVectors;
    (* Testing for errors is recommended *)
    if DosError <> 0 then
      writeln ('Dos error number from ' + GetEnv('comspec'), DosError)
    else
      writeln ('Mission accomplished, exit code ', DosExitCode);
    (* For DosError and DosExitCode details see the TP manual *)
  end.
   Alternatively, take a look at execdemo.pas from demos.arc which
should be on the disk accompanying Turbo Pascal.
   What the above Exec does is that it executes the command
processor (in fact, a new copy of the command processor.) The /c
specifies that the command interpreter is to perform the command,
and then close (not halt). Note that the command (in the example dir
*.*) can be an MS-DOS command, a program, or a batch file.
  Note that the DosError and DosExitCode are returned by the first
program in the Exec call, i.e. the command interpreter in the above
example, not by the item in the latter part.
  Somewhat surprisingly some users have had difficulties with
redirecting shelled output. It is straight-forward. In the above
code one would use, for example
     Exec (GetEnv('comspec'), '/c dir *.* > tmp');
  Calling a batch file from within a TP program via the command
interpreter is no different from calling an executable program via
it. Thus, you could use any of the examples below
     Exec (GetEnv('comspec'), '/c ' + 'mybatch.bat');
     Exec (GetEnv('comspec'), '/c ' + 'myprog.exe par1 par2 par3');
     Exec (GetEnv('comspec'), '/c ' + 'myprog2.com par');
     Exec (GetEnv('comspec'), '/c ' + 'dir *.*');
     Exec (GetEnv('comspec'), '/c type myfile.txt | more');
The extensions .bat, .exe and .com can be, and usually are omitted.
They are given here only for the clarity of the examples.
   What the above examples do is that they issue the commands via
the command interpreter. An executable program (but not a batch,
since it must be executed via the command interpreter) can also be
called directly:
     Exec ('c:\progdir\myprog.exe', 'par1 par2 par3');
For an example see item #75. A tip from Pedt Scragg: "When calling
the program directly, as in this example, then the extension .exe or
.com needs to be present."

 A2: I have also seen it asked how one can swap the Turbo Pascal
program to the disk when shelling. It is unnecessary to program that
separately because there is an excellent program to do that for you.
It is ftp://garbo.uwasa.fi/pc/sysutil/shrom24b.zip. Also of interest
to advanced programmers even if in C
0
 

Author Comment

by:Rcm
Comment Utility
To dbrunton:

I don't know if you noticed I removed the GetEnv('ComSpec') and call the program directly ... I did this ON PURPOSE ... because, like you explain ... the dosexitcode and doserror will only be the ones of the program that were executed (and command.com will handle all exceptions itself and by this will return doserror 0 and dosexitcode 0) I really need those codes of the programs that are executed and not the codes of command.com. (always 0). Now ... the redirection works fine when using command.com, but they don't when I call these programs directly. My question was how I could prevent these programs to return anything to screen (because I have a graphical interface and when these programs have output, my graphical interface is all messed up.)

ps. I use {$M 12288, 0, 40000}
I can't lower these values by much anymore ... I'm using an internal copy command (blockread and write), PCX-files, a huge list of variables, ... and I also do a getImage and putImage (when I use a "pop-up"-window) ...

I just don't want ANY output from the exec-command to mess-up my graphical interface. And I need the errorlevels and doserrors to check if the command was successfull (wich I cannot check when using exec(getenv('comspec'), ' /c ' + command);
0
 

Author Comment

by:Rcm
Comment Utility
Oh, btw ... the output of some programs need to be in a file ... wich I then can read so I can print it with the OutTextXY command or use it as a variable (like I have a program to read the serial number of a dell and compaq-computer ... the number normally will be reported to screen, but I redirect it to a file and then read it and use the number as parameter to some other commands)
0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 
LVL 47

Expert Comment

by:dbrunton
Comment Utility
OK

Here are some possible solutions.  There are about 9 small little code samples from the SWAG archive here and in the next postings to do with redirection and exec.

Unit dualout;

{ This Unit is designed to demonstrate directing all screen output to a File }
{ in addition to the normal display.  This means that any Write or Writeln   }
{ will display normally on the screen and also be Recorded in a Text File.   }
{ The File name For the output can be supplied by a command line parameter   }
{ in the Format -  dual=c:\test\output.dat or you can provide an environment }
{ Variable named dual that supplies the File name or it will default to the  }
{ current directory and output.dat.                                          }

Interface

Uses
  globals,  { contains the Function exist, which tests For the existence of  }
            { a File.  It also defines the Type str80 as String[80]          }
  Dos,
  tpString; { from TPro. Needed For StUpCase Function in Procedure initialise}

Const
  DualOn   : Boolean = False;
  DualOK   : Boolean = False;
  fname    : str80   = 'output.dat';  { The default File name For the output }
 
Type
  DriverFunc = Function(Var f: TextRec): Integer;

Var
  OldExitProc    : Pointer;                  { For saving old Exit Procedure }
  OldInOutOutput,                            { The old output InOut Function }
  OldFlushOutput : DriverFunc;               { The old output Flush Function }
  dualf          : Text;

Procedure  dual(status: Boolean);

{===========================================================================}
Implementation

Var
  cmdline : String;
 
Procedure DualWrite(Var f: TextRec);
  { Writes the output from stdout to a File }
  Var
    x : Word;
  begin
    For x := 0 to pred(f.BufPos) do
      Write(dualf, f.BufPtr^[x]);
  end;  { DualWrite }

{$F+}
Function InOutOutput(Var f: TextRec): Integer;
  begin
    DualWrite(f);                                        { Write to the File }
    InOutOutput := OldInOutOutput(f);                { Call the old Function }
  end; { InOutOutput }

Function FlushOutput(Var f: TextRec): Integer;
  begin
    DualWrite(f);                                        { Write to the File }
    FlushOutput := OldFlushOutput(f);                { Call the old Function }
  end; { FlushOutput }

Procedure DualExitProc;
  begin
    close(dualf);
    ExitProc := OldExitProc;                { Restore the old Exit Procedure }
    With TextRec(output) do begin
      InOutFunc := @OldInOutOutput;          { Restore the old output Record }
      FlushFunc := @OldFlushOutput;           { Restore the old flush Record }
    end; { With }
  end; { DualExitProc }

{$F-,I-}
Procedure dual(status: Boolean);
  Var
    ErrorCode : Integer;
  begin
    if status then begin
      assign(dualf,fname);
      if Exist(fname) then { open For writing }
        append(dualf)
      else { start new File }
        reWrite(dualf);
      ErrorCode := Ioresult;  
      if ErrorCode <> 0 then
        halt(ErrorCode);
      With TextRec(output) do begin
        { This is where the old output Functions are rerouted }
        OldInOutOutput := DriverFunc(InOutFunc);
        OldFlushOutput := DriverFunc(FlushFunc);
        InOutFunc := @InOutOutput;
        FlushFunc := @FlushOutput;
      end; { With }
      OldExitProc := ExitProc;            { Save the current Exit Procedure }
      ExitProc    := @DualExitProc;            { Install new Exit Procedure }
      DualOn      := True;
    end { if status }  
    else { switch dual output off } begin  
      if DualOn then begin
        close(dualf);  if Ioresult = 0 then;                   { dummy call }
        ExitProc := OldExitProc;           { Restore the old Exit Procedure }
        OldExitProc := nil;
        With TextRec(output) do begin
          InOutFunc := @OldInOutOutput;     { Restore the old output Record }
          FlushFunc := @OldFlushOutput;      { Restore the old flush Record }
        end; { With }
      end; { if DualOn }
    end; { else }
  end; { dual }
{$I+}  


Procedure Initialise;
  { Determines if a File name For the output has been provided. }
  begin
    if GetEnv('DUAL') <> '' then
      fname := GetEnv('DUAL')
    else begin
      if ParamCount <> 0 then begin
        cmdline := String(ptr(PrefixSeg,$80)^);
        cmdline := StUpCase(cmdline);
        if pos('DUAL=',cmdline) <> 0 then begin
          fname := copy(cmdline,pos('DUAL=',cmdline)+5,80);
          if pos(' ',fname) <> 0 then
            fname := copy(fname,1,pos(' ',fname)-1);
        end; { if pos('Dual... }
      end;  { if ParamCount... }
    end; { else }
  end; { Initialise }
 
begin
  Initialise;
end.  

*********

{
MARK LEWIS

>> Still need a bit of help here.  I can't redirect output from a
>> Program when executing it from a Pascal Program!  Is there any
>> this from Pascal? Any help would be greatly appreciated.
> if I understand you, you are using the Exec Procedure to run a
> Program.  if that is the Case you won't be ablr to redirect since
> this is a Function of Dos and not the Program you exec.  You will
> need to run the Program through a child process in order to
> perform the redirect, something like:
> Exec(GetEnv('COMSPEC'),'/C MyProg.exe>redirect');

one could also utilize duplicate File handles -=B-)

}
Unit Execute;

Interface

Procedure Exec(Path, CmdLine : String);

Implementation

Uses
  Dos;

Function ExtractFileName(Var Line : String; Index : Integer) : String;
Var
  Temp : String;
begin
  Delete(Line, Index, 1);
  While (Index <= Length(Line)) and (Line[Index] = ' ') Do
    Delete(Line, Index, 1);
  Temp := '';
  While (Index <= Length(Line)) and (Line[Index] <> ' ') Do
  begin
    Temp := Temp + Line[Index];
    Delete(Line, Index, 1);
  end;
  ExtractFileName := Temp;
end;

Procedure CloseHandle(Handle : Word);
Var
  Regs : Registers;
begin
  With Regs Do
  begin
    AH := $3E;
    BX := Handle;
    MsDos(Regs);
  end;
end;

Procedure Duplicate(SourceHandle : Word;Var TargetHandle : Word);
Var
  Regs : Registers;
begin
  With Regs Do
  begin
    AH := $45;
    BX := SourceHandle;
    MsDos(Regs);
    TargetHandle := AX;
  end;
end;

Procedure ForceDuplicate(SourceHandle : Word;Var TargetHandle : Word);
Var
  Regs : Registers;
begin
  With Regs Do
  begin
    AH := $46;
    BX := SourceHandle;
    CX := TargetHandle;
    MsDos(Regs);
    TargetHandle := AX;
  end;
end;

Procedure Exec(Path,CmdLine : String);
Var
  StdIn,
  Stdout    : Word;
  Index     : Integer;
  FName     : String[80];
  InFile,
  OutFile   : Text;
  InHandle,
  OutHandle : Word;
         { ===============>>>> }   { change below For STDERR }
begin
  StdIn  := 0;
  StdOut := 1;                    { change to 2 For StdErr       }
  Duplicate(StdIn, InHandle);      { duplicate standard input     }
  Duplicate(StdOut, OutHandle);    { duplicate standard output    }
  Index := Pos('>', CmdLine);
  if Index > 0 Then               { check For output redirection }
  begin
    FName := ExtractFileName(CmdLine, Index);  { get output File name  }
    Assign(OutFile, FName);                    { open a Text File      }
    ReWrite(OutFile);                         { .. For output         }
    ForceDuplicate(TextRec(OutFile).Handle, StdOut);{ make output same }
  end;
  Index := Pos('<', CmdLine);
  if Index > 0 Then               { check For input redirection }
  begin
    FName := ExtractFileName(CmdLine, Index);  { get input File name  }
    Assign(InFile, FName);                     { open a Text File     }
    Reset(InFile);                            { For input            }
    ForceDuplicate(TextRec(InFile).Handle, StdIn);  { make input same }
  end;
  Dos.Exec(Path, CmdLine);           { run EXEC }
  ForceDuplicate(InHandle, StdIn);   { put standard input back to keyboard }
  ForceDuplicate(OutHandle, StdOut); { put standard output back to screen  }
  CloseHandle(InHandle);            { close the redirected input File     }
  CloseHandle(OutHandle);           { close the redirected output File    }
end;

end.

{===============================================================}
{
Use it exactly as you would the normal EXEC Procedure:

  Exec('MAsm.EXE','mystuff.Asm');

To activate redirection simply add the redirection symbols, etc:

  Exec('MAsm.EXE','mystuff.Asm >err.lst');


One note of caution.  This routine temporarily Uses extra handles. It's
either two or four more.  The Various books I have are not clear as to
whether duplicated handles 'count' or not. My guess is yes.  if you don't
plan on redirecting STDIN then remove all the code For duplicating it to
cut your handle overhead in half.
}

0
 
LVL 47

Accepted Solution

by:
dbrunton earned 50 total points
Comment Utility
MARK LEWIS

>> Still need a bit of help here.  I can't redirect output from a
>> Program when executing it from a Pascal Program!  Is there any
>> this from Pascal? Any help would be greatly appreciated.
> if I understand you, you are using the Exec Procedure to run a
> Program.  if that is the Case you won't be ablr to redirect since
> this is a Function of Dos and not the Program you exec.  You will
> need to run the Program through a child process in order to
> perform the redirect, something like:
> Exec(GetEnv('COMSPEC'),'/C MyProg.exe>redirect');

one could also utilize duplicate File handles -=B-)

}
Unit Execute;

Interface

Procedure Exec(Path, CmdLine : String);

Implementation

Uses
  Dos;

Function ExtractFileName(Var Line : String; Index : Integer) : String;
Var
  Temp : String;
begin
  Delete(Line, Index, 1);
  While (Index <= Length(Line)) and (Line[Index] = ' ') Do
    Delete(Line, Index, 1);
  Temp := '';
  While (Index <= Length(Line)) and (Line[Index] <> ' ') Do
  begin
    Temp := Temp + Line[Index];
    Delete(Line, Index, 1);
  end;
  ExtractFileName := Temp;
end;

Procedure CloseHandle(Handle : Word);
Var
  Regs : Registers;
begin
  With Regs Do
  begin
    AH := $3E;
    BX := Handle;
    MsDos(Regs);
  end;
end;

Procedure Duplicate(SourceHandle : Word;Var TargetHandle : Word);
Var
  Regs : Registers;
begin
  With Regs Do
  begin
    AH := $45;
    BX := SourceHandle;
    MsDos(Regs);
    TargetHandle := AX;
  end;
end;

Procedure ForceDuplicate(SourceHandle : Word;Var TargetHandle : Word);
Var
  Regs : Registers;
begin
  With Regs Do
  begin
    AH := $46;
    BX := SourceHandle;
    CX := TargetHandle;
    MsDos(Regs);
    TargetHandle := AX;
  end;
end;

Procedure Exec(Path,CmdLine : String);
Var
  StdIn,
  Stdout    : Word;
  Index     : Integer;
  FName     : String[80];
  InFile,
  OutFile   : Text;
  InHandle,
  OutHandle : Word;
         { ===============>>>> }   { change below For STDERR }
begin
  StdIn  := 0;
  StdOut := 1;                    { change to 2 For StdErr       }
  Duplicate(StdIn, InHandle);      { duplicate standard input     }
  Duplicate(StdOut, OutHandle);    { duplicate standard output    }
  Index := Pos('>', CmdLine);
  if Index > 0 Then               { check For output redirection }
  begin
    FName := ExtractFileName(CmdLine, Index);  { get output File name  }
    Assign(OutFile, FName);                    { open a Text File      }
    ReWrite(OutFile);                         { .. For output         }
    ForceDuplicate(TextRec(OutFile).Handle, StdOut);{ make output same }
  end;
  Index := Pos('<', CmdLine);
  if Index > 0 Then               { check For input redirection }
  begin
    FName := ExtractFileName(CmdLine, Index);  { get input File name  }
    Assign(InFile, FName);                     { open a Text File     }
    Reset(InFile);                            { For input            }
    ForceDuplicate(TextRec(InFile).Handle, StdIn);  { make input same }
  end;
  Dos.Exec(Path, CmdLine);           { run EXEC }
  ForceDuplicate(InHandle, StdIn);   { put standard input back to keyboard }
  ForceDuplicate(OutHandle, StdOut); { put standard output back to screen  }
  CloseHandle(InHandle);            { close the redirected input File     }
  CloseHandle(OutHandle);           { close the redirected output File    }
end;

end.

{===============================================================}
{
Use it exactly as you would the normal EXEC Procedure:

  Exec('MAsm.EXE','mystuff.Asm');

To activate redirection simply add the redirection symbols, etc:

  Exec('MAsm.EXE','mystuff.Asm >err.lst');


One note of caution.  This routine temporarily Uses extra handles. It's
either two or four more.  The Various books I have are not clear as to
whether duplicated handles 'count' or not. My guess is yes.  if you don't
plan on redirecting STDIN then remove all the code For duplicating it to
cut your handle overhead in half.
}

**********

{
From: Matthew.Mastracci@matrix.cpubbs.cuug.ab.ca (Matthew Mastracci)

 tf> A simple example:
 tf> SwapVectors;
 tf> Exec (GetEnv('comspec'), '/c dir *.* > FileName');
 tf> SwapVectors;

This is a good way to do redirection for directory listings and the like,
but a better way is to use this unit:  (I wrote it from an idea given to me by
someone else posting the same sort of this, except this one includes error
checking and containm much more useful procedures)  From this, you can go:

SwapVectors;
RedirectOutput('\DIRLIST.TXT');
Exec(GetEnv('COMSPEC'), '/C DIR *.*');
StdOutput;
SwapVectors;

Same thing, but more control...

Here's my REDIR.PAS unit:

  Redirection unit

  - Original author unknown, rewritten by Matthew Mastracci
  - Added a bit of asm, pipe support, some better file handling ability, more
     flexibility
  - If you'd like some information on this program, E-Mail me at:
     madhacker@matrix.cpubbs.cuug.ab.ca
  - Feel free to distribute this source anywhere! (Public Domain)
}

unit Redir;

interface

{ Redirects standard input from a textfile/device  ie: command < filename }
procedure RedirectInput(TextFile : String);

{ Redirects standard output to a textfile/device  ie: command > filename }
procedure RedirectOutput(TextFile : String);

{ Redirects standard error to a textfile/device }
procedure RedirectError(TextFile : String);

{ Redirects standard output and error to a textfile/device }
procedure RedirectAllOutput(TextFile : String);

{ Redirects all I/O from a textfile  ie: ctty device }
procedure RedirectAll(TextFile : String);

{ Restores STDIN to CON }
procedure StdInput;

{ Restores STDOUT to CON }
procedure StdOutput;

{ Restores STDERR to CON }
procedure StdError;

{ Creates a unique file and returns its name (used for piping) }
function UniqueFile : String;

implementation

uses Dos;

var InFile, OutFile, ErrFile : Text;

const
  STDIN  = 0;       { Standard Input }
  STDOUT = 1;       { Standard Output }
  STDERR = 2;       { Standard Error }
  Redirected : array[0..2] of Boolean = (False, False, False);

{ Duplicates a file handle }
procedure ForceDup (Existing, Second : Word);
var f, Error : Word;
begin
  asm
    mov ah, $46
    mov bx, Existing
    mov cx, Second
    int $21
    pushf
    pop bx
    mov f, bx
    mov Error, ax
  end;
  if (f and FCarry) <> 0 then
    Writeln ('Error ', Error, ' changing handle ', Second);
end;

{ Redirects standard input from a textfile/device  ie: command < filename }
procedure RedirectInput(TextFile : String);
begin
  if Redirected[STDIN] then StdInput;
  Redirected[STDIN] := True;
  Assign(InFile, TextFile);
  Reset(InFile);
  ForceDup(TextRec(InFile).Handle, STDIN);
end;

{ Redirects standard output to a textfile/device  ie: command > filename }
procedure RedirectOutput(TextFile : String);
begin
  if Redirected[STDOUT] then StdOutput;
  Redirected[STDOUT] := True;
  Assign(OutFile, TextFile);
  Rewrite(OutFile);
  ForceDup(TextRec(OutFile).Handle, STDOUT);
end;

{ Redirects standard error to a textfile/device }
procedure RedirectError(TextFile : String);
begin
  if Redirected[STDERR] then StdError;
  Redirected[STDERR] := True;
  Assign(ErrFile, TextFile);
  Rewrite(ErrFile);
  ForceDup(TextRec(ErrFile).Handle, STDERR);
end;

{ Redirects standard output and error to a textfile/device }
procedure RedirectAllOutput(TextFile : String);
begin
  RedirectOutput(TextFile);
  RedirectError(TextFile);
end;

{ Redirects all I/O from a textfile  ie: ctty device }
procedure RedirectAll(TextFile : String);
begin
  RedirectInput(TextFile);
  RedirectOutput(TextFile);
  RedirectError(TextFile);
end;

{ Restores STDIN to CON }
procedure StdInput;
begin
  if Redirected[STDIN] then begin
    Redirected[STDIN] := False;
    RedirectInput('CON');
    Close(InFile);
  end;
end;

{ Restores STDOUT to CON }
procedure StdOutput;
begin
  if Redirected[STDOUT] then begin
    Redirected[STDOUT] := False;
    RedirectOutput('CON');
    Close(OutFile);
  end;
end;

{ Restores STDERR to CON }
procedure StdError;
begin
  if Redirected[STDERR] then begin
    Redirected[STDERR] := False;
    RedirectOutput('CON');
    Close(OutFile);
  end;
end;

function UniqueFile : String;
const FName : array[1..20] of Char = '\' + #0 + '                  ';
var FSeg, FOfs : Word;
    FileName : String;
begin
  FSeg := Seg(FName);
  FOfs := Ofs(FName) + 1;
  asm
    push ds
    mov ax, FSeg
    mov ds, ax
    mov dx, FOfs
    mov ah, $5a
    mov cx, 0
    int $21
    pop ds
  end;
  Move(FName, FileName[1], 9);
  FileName[0] := #9;
  UniqueFile := FileName;
end;

end.

{ This is how you can do piping.  It is equivilent to: }
{ type \autoexec.bat | find "ECHO" | sort /R }

{$M $1000,0,0}
program PipeDemo;
uses Redir, Dos;
var FName : String;

begin
  FName := UniqueFile;
  WriteLn('Temporary file: ', FName);
  WriteLn('Output from pipe:');
  RedirectInput('\AUTOEXEC.BAT');
  RedirectOutput(FName);
  Exec('C:\DOS\FIND.EXE', '"ECHO"');
  RedirectInput(FName);
  RedirectOutput('CON');
  Exec('C:\DOS\SORT.EXE', '/R');
end.

***************

{
All these solutions of using a shell to redirect output.

There are two Dos interrupts that allow Filehandles to be duplicated.

Redirec and unredirec allow easy access to dup and dup2 For standard in
and out (input and output are reserved TP Words) to a Text File that you
have previously opened (reset/reWrite/append as appropriate). It must be
opened - this allocates a File handle (a Byte - you declare this, you'll
need it later to get your output back). if you don't unredirec to the
right handle you could loose all your output to the File or a black hole -
be warned.

You could make similar Procedures to redirec/unredirec For redirection of
other standard handles (3 is Printer (LST), 4 I think is STDERR  and 5
is AUX aren't they?)

Here's the Unit:
}

{$O+ $F+}

Unit ReDIRECt;

Interface

Function dup (hand : Byte; Var error : Boolean) : Byte;
   { provides a new handle For an already opened device or File.
     if error, then the return is the error code - 4 no handles available or
     6, invalid handle.}

Procedure dup2 (source, destination : Byte;  Var err : Byte);
   { Makes two File handles refer to the same opened File at the same
     location. The destination is closed first.
     Err returns 0 if no error or error code as For dup.
     to redirect then return to normal - do as follows:
     1. Use DUP to save the handle to be directed (the source).
     2. Assign and reWrite/reset the destination.
     3. Redirect the handle using DUP2.
     4. Do the exec
     5. Use dup2 again restoring the saved handle.
     6. reset/reWrite the redirected items & close the destination}

Function Redirec (op : Boolean; Var f:Text; Var hand : Byte) : Boolean;
  {redirects standard out to (if op True) or standard in from File fn.
   returns handle in handle to be used by undirec, below, and True if
   successful.}

Procedure Undirec (op : Boolean; hand : Byte);
   {undoes the redirection from the previous redirec. Assumes File closed
    by caller.}

Function getFilehandle(Filename : String; Var error : Boolean) : Integer;

{////////////////////////////////////////////////////////////////////////}
Implementation

Uses
  Dos;

Function dup (hand : Byte; Var error : Boolean) : Byte;
Var
  regs : Registers;
begin
  With regs do
  begin
    AH := $45;
    BX := hand;

    MsDos (regs);

    error := flags and fcarry <> 0;  {error if carry set}

    dup := AX;
  end;
end;

Procedure dup2 (source, destination : Byte;  Var err : Byte);
Var
  regs : Registers;
begin
  With regs do
  begin
    AH := $46;
    BX := source;
    CX := destination ;

    MsDos (regs);

    if flags and fcarry <> 0 then {error if carry set}
      err := AX
    else
      err := 0;
  end;
end;

Function Redirec (op : Boolean; Var f:Text; Var hand : Byte) : Boolean;
  {redirects standard out to (if op True) or standard in from File fn.
   returns handle in handle to be used by undirec, below, and True if
   successful.}
Var
  err     : Byte;
  error   : Boolean;
begin
  redirec := False;
  err := 0;
  if op then
  begin
    flush (output);
    hand := dup (Textrec(output).handle, error)
  end
  else
  begin
    flush (input);
    hand := dup (Textrec(input).handle, error)
  end;
  if error then
    Exit;
  {$i-}
  if op then
    reWrite (f)
  else
    reset (f);
  {$i+}
  if ioresult <> 0 then
    Exit;
  if op then
    dup2 (Textrec(f).handle, Textrec(output).handle,err)
  else
    dup2 (Textrec(f).handle, Textrec(input).handle,err);

  redirec := (err = 0);
end;

Procedure Undirec (op : Boolean; hand : Byte);
   {undoes the redirection from the previous redirec. Assumes File closed
    by caller.}
Var
  err : Byte;
begin
  if op then
  begin
    dup2 (hand, Textrec(output).handle, err);
    reWrite (output)
  end
  else
  begin
    dup2 (hand, Textrec(input).handle, err);
    reset (input)
  end
end; {undirec}


Function getFilehandle( Filename : String; Var error : Boolean) : Integer;
Var
  regs : Registers;
  i : Integer;
begin
  Filename := Filename + #0;
  fillChar(regs, sizeof(regs), 0);

  With regs do
  begin
    ah := $3D;
    AL := $00;
    ds := seg(Filename);
    dx := ofs(Filename) + 1;
  end;

  MsDos(Regs);

  I := regs.ax;

  if (lo(regs.flags) and $01) > 0 then
  begin
    error := True;
    getFilehandle := 0;
    Exit
  end;

  getFilehandle := i;
end;

end.

{ Here's a demo }

Program dupdemo;

{$M 2000,0,0}
Uses
  Direc, Dos;


Var
  arcname : String;
  tempFile : Text;
  op : Boolean;
  handle : Byte;
  Handle2 : Byte;
  err : Boolean;
  Error : Byte;
  InFile : File;

begin
  Handle := 0;

  Handle2 := Dup(Handle,Err);

  if Err then
  begin
     Writeln('Error getting another handle');
     halt;
  end;

  arcname := 'C:\qmpro\download\qmpro102.ZIP';
  assign (tempFile, 'C:\qmpro\download\TEMP.FIL');
  ReWrite(TempFile);

  Dup2(Handle, Handle2, Error);
  if Error <> 0 then
  begin
     Writeln('ERRor: ',Error);
     Halt;
  end;


  if redirec(op, tempFile, handle2) then
  begin
    SwapVectors;
    Writeln('Running ZIP!');
    Exec('PKUNZIP',' -V ' + ArcName);
    SwapVectors;
    close (tempFile);
    undirec (op, handle2);
  end
  else
    Writeln('Error!');
end.

{
I wrote the DUPDEMO Program, but the Unit is the brainchild of an author that I
can't remember, but I use this regularly.  It will work up to TP 7.0, I've
never tested it With TP 7.0 because I don't own it.
}

**************

{
> When pkzip executes... it Writes to the screen and scrolls my
> screen up. Is there a way in which I can prevent pkzip from writing
> to the screen.

This thread comes up a bunch.  Here's a tried and tested solution :
}
Unit Redir;

{ Redirect input, output, and errors }

Interface

Procedure RedirectInput (TextFile : String);
Procedure RedirectOutput (TextFile : String);
Procedure StdInput;
Procedure StdOutput;

Implementation

Uses
  Dos;

Const
    STDin  = 0;
    STdoUT = 1;
    STDERR = 2;

Procedure Force_Dup (Existing,              { Existing handle         }
                     Second     : Word);    { Handle to place it to   }

Var
  R : Registers;

begin

    r.AH := $46;
    r.BX := Existing;
    r.CX := Second;

    MSDos (R);

    if (r.Flags and FCarry) <> 0 then
        Writeln ('Error ', r.AX, ' changing handle ', Second);
end;


Procedure RedirectInput (TextFile : String);

Var
    TF : Text;

begin
    Assign (TF, TextFile);
    Reset (TF);
    Force_Dup (TextRec (TF).Handle, STDin);
end;

Procedure RedirectOutput (TextFile : String);

Var
    TF : Text;

begin
    Assign (TF, TextFile);
    ReWrite (TF);
    Force_Dup (TextRec (TF).Handle, STdoUT);
    Force_Dup (TextRec (TF).Handle, STDERR);
end;

Procedure StdInput;

begin
    Assign (Input, '');
    Reset (Input);
end;

Procedure StdOutPut;

begin
    Assign (Output, '');
    ReWrite (Output);
end;

end.

{------ cut here ------}
{
In your Program :

Uses Redir;

begin
     RedirectOutput ('LOGFile.OUT');
     Exec ('PKZIP.EXE', '');
     StdOutPut;
end.
}

***************

{ From: tjacobs@clark.net (Todd A. Jacobs) }
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;
}

*********

{
Here's a neat little ditty I converted from a C++ tip I saw in a mag a few
years ago.  It tests to see if its own output has been redirected and
returns a 1 if TRUE (redirected) or a 0 if FALSE (not redirected). This
function includes a sample prog that demonstrates its use. SIDE NOTE: I
put this function in the U_FILE.pas.tpu for use with all of my home-grown
file related functions and procedures.

TEST WITH: Test_Red (enter)
   [you should see a NOT REDIRECTED msg, 10 lines and a FINISHED msg.]

TEST WITH: Test_Red > this.dat (enter)
   [you should see a REDIRECTED msg, (no lines) and a FINISHED msg
    and the output of the lines will be in the this.dat file]
}

program test_red;

{$A+,B-,D-,E-,F-,G-,I+,L-,N-,O-,P-,Q-,R-,S+,T-,V+,X-}
{$M 1024,0,655360}

{*******************************************************************!HDR**
** Function Name: fn_bRedirected()
** Description  : Determines if output has been redirected;
** Returns      : Integer to be treated as boolean;
** Calls        :
** Special considerations:
** Modification history:
** Created: 11/03/93 20:23
*********************************************************************!END}

function fn_bRedirected : Integer; Assembler; {Treated as BOOLEAN}
asm
  push  ds
  mov   ax,      prefixseg
  mov   ds,      ax
  xor   bx,      bx
  les   bx,      [bx + $34]
  mov   al,      es:[bx]
  mov   ah,      es:[bx +1]
  pop   ds
  cmp   al,      ah
  mov   ax,      1
  jne   @_exit
  xor   ax,      ax
 @_exit:
  {mov   @Result, AX}
end;

var
  Count    : Byte;
  hOutFile : text;

begin
  Assign(hOutFile, 'CON');
  ReWrite(hOutFile);
  if not (boolean(fn_bRedirected)) then
    writeln(hOutFile, 'Not Redirected')
  else
    writeln(hOutFile, 'Please wait while redirection is in progress');
  for Count := 1 to 10 do
    writeln('Line ', Count : 2);
  writeln(hOutFile, 'Finished!');
end.

********

{
>> Program windatest;
>> Uses Crt;
>> Begin
>> Window(1, 15, 80, 22);
>> ClrScr;
>> SwapVectors;
>> Exec('C:\PKUNZIP.EXE','-V ZIPPY.ZIP');
>> SwapVectors;
>> End.

>> Note that this may not work for some users: your command is an
>> explicit path/filename, and unless PKUNZIP were in the root

SR>   Although I agree about the comspec problem (and there's no $m
SR> directive), I think this won't work in any case. You probably know
SR> more about this than I, Mike, but I think that exec essentially sets
SR> the screen to 80 by 25 and clears it. Anyway, I've never had success
SR> doing this under normal TP. Gayle Davis (I think) posted a program in
SR> the FIDO Pascal echo that would work, as long as the program didn't
SR> use direct screen writes (which I think PKZIP does). I really can't
SR> think of a way to make it work with direct writes. Well, I can, but it
SR> means going into virtual 86 mode, something I wouldn't feel
SR> comfortable even discussing <g>. I guess that's what Windows and
SR> DesqView do.

SR>   Of course, if you can redirect the output to a file you can then
SR> print that file to the screen....  :)

    The problem is that Pkzip sends output through a different chanel than TP
uses for screen writes. Actually, if you set up a window as above, then hook
up Int29 and replace Normal Int29 code by simply using Write(register al),
then your output will go through TP's IO routines and will respect the window
coordinates. Here ya go! Written, Compiled and Tested using BP 7.x
}

{$A+ Word Align Data}
{$B+ Complete Boolean Eval}
{$D+ Debug Information}
{$E+ Numeric Processing Emulation}
{$F+ Force Far Calls}
{$G+ Generate 286 Instructions}
{$I+ Input/Output Checking}
{$L+ Local Symbol Information}
{$N+ Numeric Coprocessor}
{$O+ Overlay Code Generation}
{$P+ Open String Parameters}
{$Q+ Numerical Overflow Checking}
{$R+ Range Checking}
{$S+ Stack-Overflow Checking}
{$T+ Type-Checked Pointers}
{$V+ Var-String Checking}
{$X+ Extended Syntax}
{$Y+ Symbol Reference Imformation}
{$M 16384,0,0}
Program RedirExec;
uses
  dos,
  crt;

 {$F+}
 procedure NewInt29h(Flags, CS, IP, AX, BX, CX, DX, SI, DI, DS, ES, BP: Word);
  interrupt;

  begin
   asm
     cli
   end;
   write(char(lo(AX)));
   asm
     sti
   end;
  end;
 {$F-}

var
  OldInt29h : procedure;
  X,Y : byte;

begin
  {Save the old Int29 handler adress so we can restore it}
  getintvec($29, @OldInt29h);
  {Set our own Int29 handler}
  setintvec($29, @NewInt29h);
  {Create a fancy window with border}
  textcolor(Yellow);
  textbackground(Blue);
  clrscr;
  window(1,1,80,20);
  write('?');
  for x := 2 to 80-1 do
    write('?');
  write('?');
  for x := 2 to 20-1 do
  begin
    write('?');
    for y := 2 to 80-1 do
      write(' ');
    write('?');
  end;

  write('?');
  for x := 2 to 80-1 do
    write('?');

  inc(WindMax);
  write('?');
  dec(WindMax);
  textcolor(White);
  textbackground(Black);
  { Now that the border is drawn, just reduce the window by 1 caracters on
    each side so our writes don't mess the border }
  window(2,2,79,19);
  clrscr;
  swapvectors;
  exec('C:\UTIL\PKUNZIP.EXE', '-v G:\DOS\NU\NU8-1.ZIP');
  swapvectors;
  setintvec($29, @OldInt29h);    {Restore old Int 29h}
  window(1,1,80,25);
  gotoxy(1,21);
end.
0
 
LVL 47

Expert Comment

by:dbrunton
Comment Utility
Apologies here.  I've gone and done a very rough grab from the SWAG archive and grabbed what looked useful.  They discuss some of the problems you may have and various solutions.

I didn't have time to sort it out for usefulness.  I have broken it into sections by the use of

**********

to show where the breaks are.

You will find the solutions look like they use handles for redirections.  Note they don't cover the use of graphics windows.  You may have to shoot back to a text based window for some of these solutions to work and then recall your graphic window afterwards.
0
 

Author Comment

by:Rcm
Comment Utility
It is working, but now I have troubles with my memory again. It seems like when I try to include one functionality, I loose another.
I'm unable to load the network at this time.
And I can't lower the heap anymore neither the stack.

Aaaargh ... I'm really growing a deep sense of hatered towards dos programming.
0
 

Author Comment

by:Rcm
Comment Utility
I had to do some digging into the code myself, but the help was verry usefull.
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

What is Node.js? Node.js is a server side scripting language much like PHP or ASP but is used to implement the complete package of HTTP webserver and application framework. The difference is that Node.js’s execution engine is asynchronous and event…
Introduction Knockoutjs (Knockout) is a JavaScript framework (Model View ViewModel or MVVM framework).   The main ideology behind Knockout is to control from JavaScript how a page looks whilst creating an engaging user experience in the least …
Viewers will learn about arithmetic and Boolean expressions in Java and the logical operators used to create Boolean expressions. We will cover the symbols used for arithmetic expressions and define each logical operator and how to use them in Boole…
HTML5 has deprecated a few of the older ways of showing media as well as offering up a new way to create games and animations. Audio, video, and canvas are just a few of the adjustments made between XHTML and HTML5. As we learned in our last micr…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now