Contributor: STEPHEN M. OBERHOLTZER
(*
> 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.