[Back to DOS SWAG index] [Back to Main SWAG index] [Original]

    (*
    >          Hi, I am trying to write a program the writes to Standard output,
    > and reads from Standard input from windows console (win95 dosprmpt, winnt
    >  dosprmpt)... so the io can be redirected.  The program must be a windows
    > program for the project to work:
    >                  Using the program as a script for Microsoft Internet
    > Information Server on Winnt 3.51, the web server will not execute dos based stdio
    > programs.  I have tried using program script(input,output) which reports file not
    > open  for write, I have added rewrite(output) which causes an error because output
    not assigned.  I have assigned output to '' which outputs nothing to the
    console or the redirected file.
    >
    >                  If anyone understands my problem, and has an idea or
    > solution,
    >  please help me.  Thank you.
    >
    >
    Ok, here is the solution to your prob : you need to write a text file device
    driver. I just happen to have code. You want the StdOut things, i can't
    remember how it works =(
    p.s. the file's attached.
    (*)

    unit SimultIO;
    {$D-,F+,R-}
    (* Unit for simultaneous I/O.
       This will be useful for redirection - when you write to a
       file assigned to by AssignSimult, data written to it will write to
       the file AND the screen. *)
    interface
    {$F+} procedure AssignSimult(var f : text;n : string); far; {$F-}
    implementation
    uses Dos,CRT;
    var  R : Registers;
        OP : Text;
    {$F+} function WriteByteToFile(FileHandle : Word;var value) : integer;far; {$F-}
    var r : registers;
    begin
     r.ah := $40;
     r.bx := FileHandle;
     r.cx := 1;
     r.ds := seg(value);
     r.dx := ofs(value);
     MsDos(R);
     if (r.flags and fcarry)<>0 then
      begin
       r.ah := $59; (* Get extended error info *)
       msdos(R);
       WriteByteToFile := r.ax; (* IOResult returns the value in InOutRes *)
      end
     else WriteByteToFile := 0;
    end;
    (*
                INT 21,40 - Write To File or Device Using Handle
            AH =  40h
            BX =  file handle
            CX =  number of bytes to write, a zero value truncates/extends
                 the file to the current file position
            DS:DX =  pointer to write buffer

            on return:
            AX =  number of bytes written if CF not set
               =  error code if CF set  (see DOS ERROR CODES)

            - if AX is not equal to CX on return, a partial write occurred
            - this function can be used to truncate a file to the current
              file position by writing zero bytes                         *)
    {$F+} function StdOut(var f: textrec) : integer; far;  {$F-}
    var
      p,err : integer;
      r : registers;
    begin
     if f.mode=fmclosed then
      begin
       StdOut := 103;
       exit;
      end;
      with F do
       begin
        for P := 0 to bufpos-1 do
         begin
          r.ah := $02;
          r.dl := ord(bufptr^[p]);
          msdos(R);
         end;
       BufPos:=0;
      end;
      StdOut:=0;
    end;
    {$F+} function SimultWrite(var f: textrec): integer; far;  {$F-}
    var
      p,err : integer;
    begin
     if f.mode=fmclosed then
      begin
       SimultWrite := 103;
       exit;
      end;
      with F do
       begin
        for P := 0 to bufpos-1 do
         begin
          err := WriteByteToFile(Handle,BufPtr^[p]);
          if err<>0 then
           begin
            SimultWrite := Err;
            BufPos := P+1;
            exit;
           end;
          Write(OP,BufPtr^[p]);
         end;
       BufPos:=0;
      end;
      SimultWrite:=0;
    end;
    {$F+} function SimultOpen(var f: textrec): integer; far;  {$F-}
    var
      P: integer;
    begin;
      case F.Mode of
       FMOutput : begin (* Rewrite *)
                   if f.name[0]= #0 then
                    begin
                    F.InOutFunc:= @StdOut;
                    F.FlushFunc:= @StdOut;
                  end else begin
                   r.ah :=  $3C;
                   r.cx :=  $0000;
                   r.ds :=  Seg(F.Name);
                   r.dx :=  Ofs(F.Name);
                   MsDos(R);
                   if (R.flags and FCarry)<>0 then
                    begin
                     R.AH :=  $59;
                     MsDos(R);
                     SimultOpen :=  R.AX;
                     exit;
                    end;
                   F.Handle :=  r.ax;
                   (*
                      INT 21,3C - Create File Using Handle

            AH =  3C
            CX =  file attribute  (see FILE ATTRIBUTES)
            DS:DX =  pointer to ASCIIZ path name

            on return:
            CF =  0 if successful
               =  1 if error
            AX =  files handle if successful
               =  error code if failure  (see DOS ERROR CODES)

            - if file already exists, it is truncated to zero bytes on opening
    *)
                    F.InOutFunc:= @SimultWrite;
                    F.FlushFunc:= @SimultWrite;
                   end;
                   F.BufPos:= 0;
                   SimultOpen:= 0;
                  end;
       FMInOut  : begin (* Append *)
                   f.mode :=  fmOutput;
                   r.ah :=  $3d ;
                   r.al :=  $01;
                   r.cx :=  $0000;
                   r.ds :=  Seg(F.Name);
                   r.dx :=  Ofs(F.Name);
                   MsDos(R);
                   if (R.flags and FCarry)<>0 then
                    begin
                     R.AH :=  $59;
                     MsDos(R);
                     SimultOpen :=  R.ax;
                     exit;
                    end;
                   F.Handle :=  r.ax;
                   r.bx :=  r.ax;
                   r.al :=  $02;
                   R.ah :=  $42;
                   r.cx :=  $0000;
                   r.dx :=  $0001; (* Seek past EOF *)
                   MsDos(R);
                   if (r.flags and fcarry)<>0 then
                    begin
                     r.ah :=  $59;
                     msdos(R);
                     SimultOpen :=  R.AX;
                     exit;
                    end;
                   (*
                   INT 21,42 - Move File Pointer Using Handle

            AH =  42h
            AL =  origin of move:
                 00 =  beginning of file plus offset  (SEEK_SET)
                 01 =  current location plus offset  (SEEK_CUR)
                 02 =  end of file plus offset  (SEEK_END)
            BX =  file handle
            CX =  high order word of number of bytes to move
            DX =  low order word of number of bytes to move

            on return:
            AX =  error code if CF set  (see DOS ERROR CODES)
            DX:AX =  new pointer location if CF not set

            - seeks to specified location in file
                       INT 21,  - Open File Using Handle
            AH =
            AL =  open access mode
                 00  read only
                 01  write only
                 02  read/write
            DS:DX =  pointer to an ASCIIZ file name
     =

            on return:
            AX =  file handle if CF not set
               =  error code if CF set  (see DOS ERROR CODES)
            Access modes in AL:

            =B37=B36=B35=B34=B33=B32=B31=B30=B3  AL
             =B3 =B3 =B3 =B3 =B3 =C0=C4=C1=C4=C1=C4=C4=C4=C4 read/write/updat=
    e access mode
             =B3 =B3 =B3 =B3 =C0=C4=C4=C4=C4=C4=C4=C4=C4=C4 reserved, always =
    0
             =B3 =C0=C4=C1=C4=C1=C4=C4=C4=C4=C4=C4=C4=C4=C4=C4 sharing mode (=
    see below) (DOS 3.1+)
             =C0=C4=C4=C4=C4=C4=C4=C4=C4=C4=C4=C4=C4=C4=C4=C4 1 =  private, =
    0 =  inheritable (DOS 3.1+)
    =0D
            Sharing mode bits (DOS 3.1+):          Access mode bits:
            654                                    210
            000  compatibility mode (exclusive)    000  read access
            001  deny others read/write access     001  write access
            010  deny others write access          010  read/write access
            011  deny others read access
            100  full access permitted to all
    *)
                   F.InOutFunc :=  @SimultWrite;
                   F.FlushFunc :=  @SimultWrite;
                   F.BufPos:= 0;
                   SimultOpen:= 0;
                  end;
      else
       SimultOpen :=  12; (* Invalid file access code - you can only Rewrite=
     or Append this *)
      end;
    end;

    {$F+}function SimultClose(var F: textrec): integer; far;  {$F-}
    var
      P: integer;
    begin;
     if f.mode= fmclosed then
      begin
       SimultClose :=  103;
       exit;
      end;
    (*
                      INT 21,3E - Close File Using Handle

            AH =  3E
            BX =  file handle to close

            on return:
            AX =  error code if CF set  (see DOS ERROR CODES)

            - if file is opened for update, file time and date stamp
              as well as file size are updated in the directory
            - handle is freed
    =0D
     *)
      r.ah :=  $3E;
      r.bx :=  f.handle;
      MsDos(R);
      if (R.flags and fcarry)<>0 then
       begin
        r.ah :=  $59;
        MsDos(R);
        SimultClose :=  R.AX;
        exit;
       end;
      F.Mode :=  FMClosed;
      SimultClose:= 0;
    end;

    {$F+} procedure AssignSimult(var f : text;n : string); {$F-}
    begin
      with textrec(f) do begin
        Mode     :=  fmClosed;
        Handle   :=  $FFFF;
        Bufsize  :=  SizeOf(Buffer);
        Bufpos   :=  0;
        Bufptr   :=  @Buffer;
        OpenFunc :=  @SimultOpen;
        CloseFunc:=  @SimultClose;
        if n[0]>#79 then n[0] :=  #79; (* Truncate the name down to 79 chars=
     *)
        Move(N[1],Name[0],79);
        Name[Length(N)] := #0; (* Name is null-terminated *)
      end;
    end;
    begin
     AssignCRT(OP);
     Rewrite(OP);
    end.

[Back to DOS SWAG index] [Back to Main SWAG index] [Original]