home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
utility
/
rtfgen.zip
/
COMMAND.INC
next >
Wrap
Text File
|
1992-02-22
|
3KB
|
131 lines
{-------------UpCaseStr}
PROCEDURE UpCaseStr(Var St : String);
Var
I : Integer;
begin
for I:=1 to Ord(St[0]) do
St[I]:=UpCase(St[I]);
end;
{-------------DefaultExtension}
PROCEDURE DefaultExtension(Extension:Filestring;Var Infile,Name :Filestring);
Var
I,J : Integer;
Temp : Filestring;
begin
I:=Pos('..',Infile);
if I=0 then
Temp:=Infile
else
begin {a pathname starting with ..}
Temp:=Copy(Infile,I+2,64);
I:=I+1;
end;
J:=Pos('.',Temp);
if J=0 then
begin
Name := Infile;
Infile:=Infile+'.'+Extension;
end
else Name:=Copy(Infile,1,I+J-1);
end;
{-------------Chk_IOerror}
FUNCTION Chk_IOerror(S : Filestring) : Integer;
Var IOerr : Integer;
begin
IOerr := IOResult;
if IOerr = 2 then WriteLn('Can''t find ', S)
else if IOerr <> 0 then
WriteLn('I/O Error ', IOerr, ' in file ', S);
Chk_IOerror := IOerr;
end;
{-------------PromptForInput}
PROCEDURE PromptForInput;
Var
InName, Name : Filestring;
Err : Integer;
I : Integer;
begin
{$I-}
repeat
Write('ASCII Source Filename: '); ReadLn(InName);
if InName = '' then Halt(0);
SourceName := InName;
I := Pos('.', SourceName);
if I > 0 then SourceName[0] := chr(I-1);
Assign(Inf, InName);
SetTextBuf(Inf, InBuff);
Reset(Inf);
Err := Chk_IOerror(InName);
if Err>1 then Halt(1);
until Err = 0;
UpCaseStr(SourceName);
Write('Filename for RTF File[', SourceName, '.RTF]: '); ReadLn(InName);
if InName = '' then InName := SourceName; {Use the same name}
DefaultExtension('RTF', InName, Name);
Assign(Outf, InName);
SetTextBuf(Outf, OutBuff);
Rewrite(Outf);
if Chk_IOerror(InName) <> 0 then Halt(1);
{$I+}
end;
{-------------CommandInput}
PROCEDURE CommandInput;
Var
InName, Name : Filestring;
I : Integer;
begin
InName := ParamStr(1);
SourceName := InName; (*DefaultExtension('PAS', InName, SourceName); *)
I := Pos('.', SourceName);
if I > 0 then SourceName[0] := chr(I-1);
{$I-}
Assign(Inf, InName);
SetTextBuf(Inf, InBuff);
Reset(Inf);
if Chk_IOerror(InName) <> 0 then Halt(1);
UpCaseStr(SourceName);
if ParamCount >= 2 then InName := ParamStr(2)
else InName := SourceName; {Use the old name}
DefaultExtension('RTF', InName, Name);
Assign(Outf, InName);
SetTextBuf(Outf, OutBuff);
Rewrite(Outf);
if Chk_IOerror(InName) <> 0 then Halt(1);
{$I+}
end;
{-------------ChkEOF}
PROCEDURE ChkEOF;
begin
if EofInf then
begin
WriteLn('Unexpected EOF found');
Close(Outf);
Halt(1);
end;
end;
{-------------ReadHeader}
PROCEDURE ReadHeader;
var
HFile : Text;
begin
{$I-}
Assign(HFile, 'Heading');
Reset(HFile);
if Chk_IOerror('HEADING') <> 0 then Halt(1);
{$I+}
while not Eof(HFile) do
begin
ReadLn(HFile, St);
WriteLn(Outf, St);
end;
end;