home *** CD-ROM | disk | FTP | other *** search
- program RdStdErr;
- { Redirects STDERR (standard error device) to a file }
- { R.J. Bartlett 21 Feb 88 }
-
- {$R-,S-,I+,D+,T-,F-,V-,B-,N-,L+ }
- {$M 8192,0,0}
-
- uses
- dos;
- const
- StdErr = 2;
- var
- regs : registers;
- CmdToExecute : string[255];
- FileHandle : word;
- W : word;
- Dummy : boolean;
-
-
- procedure WrtHalt(ErrMsg : string);
- begin
- writeln;
- writeln('RdStdErr - ',ErrMsg);
- halt(255);
- end;
-
-
- function FileHandleOpen(FileName : string; var fh : word) : boolean;
- begin
- FileName := FileName + #0; { make filename an ASCIIZ string }
- regs.ax := $3c00; { create file handle function call }
- regs.ds := seg(FileName[1]);
- regs.dx := ofs(FileName[1]);
- regs.cx := 0;
- msdos(regs);
- fh := regs.ax;
- FileHandleOpen := (regs.flags and fcarry) = 0;
- end;
-
-
- function FileHandleDuplicate(fh : word) : boolean;
- begin
- regs.ax := $4600; { force duplicate of file handle }
- regs.bx := fh;
- regs.cx := StdErr;
- msdos(regs);
- FileHandleDuplicate := (regs.flags and fcarry) = 0;
- end;
-
-
- function FileHandleClose(fh : word) : boolean;
- begin
- regs.ax := $3e00; { close file FileHandle }
- regs.bx := fh;
- msdos(regs);
- FileHandleClose := (regs.flags and fcarry) = 0;
- end;
-
-
- procedure Run(CmdToRun : string);
- var
- EnvSeg : word;
- ComSpecStr : string[80];
- begin
- EnvSeg:= memw[PrefixSeg:$2c];
- move(mem[EnvSeg : 0], ComSpecStr[1], 80); { move env to a string }
- ComSpecStr[0] := #80;
- ComSpecStr[0] := char(pos(#0, ComSpecStr) - 1);
- delete(ComSpecStr, 1, pos('COMSPEC=', ComSpecStr) + 7);
- exec(ComSpecStr, '/c ' + CmdToRun);
- end;
-
-
- begin
- if ParamCount < 2 then
- begin
- writeln(' Usage -> RDSTDERR FileName Cmd ');
- writeln(' FileName = name of file to send STDERR output to ');
- writeln(' Cmd = command to execute ');
- halt(255);
- end;
- CmdToExecute := ParamStr(2);
- for W:= 3 to ParamCount do CmdToExecute:= CmdToExecute + ' ' + ParamStr(W);
- if not FileHandleOpen(ParamStr(1), FileHandle) then
- WrtHalt('File FileHandle open error')
- else
- begin
- if not FileHandleDuplicate(FileHandle) then
- begin
- Dummy := FileHandleClose(FileHandle);
- WrtHalt('cannot force duplicate of StdErr');
- end
- else
- begin
- Run(CmdToExecute);
- if not FileHandleClose(FileHandle) then
- WrtHalt('File FileHandle close error');
- end;
- end;
- end.