home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / w3_syst / rtfgen.arj / COMMAND.INC next >
Encoding:
Text File  |  1992-02-22  |  2.8 KB  |  131 lines
  1. {-------------UpCaseStr}
  2. PROCEDURE UpCaseStr(Var St : String);
  3. Var
  4.   I : Integer;
  5. begin
  6. for I:=1 to Ord(St[0]) do
  7.   St[I]:=UpCase(St[I]);
  8. end;
  9.  
  10. {-------------DefaultExtension}
  11. PROCEDURE DefaultExtension(Extension:Filestring;Var Infile,Name :Filestring);
  12. Var
  13.  I,J : Integer;
  14.  Temp : Filestring;
  15. begin
  16. I:=Pos('..',Infile);
  17. if I=0 then
  18.   Temp:=Infile
  19. else
  20.   begin   {a pathname starting with ..}
  21.   Temp:=Copy(Infile,I+2,64);
  22.   I:=I+1;
  23.   end;
  24. J:=Pos('.',Temp);
  25. if J=0 then
  26.   begin
  27.   Name := Infile;
  28.   Infile:=Infile+'.'+Extension;
  29.   end
  30. else Name:=Copy(Infile,1,I+J-1);
  31. end;
  32.  
  33. {-------------Chk_IOerror}
  34. FUNCTION Chk_IOerror(S : Filestring) : Integer;
  35. Var IOerr : Integer;
  36. begin
  37. IOerr := IOResult;
  38. if IOerr = 2 then WriteLn('Can''t find ', S)
  39. else if IOerr <> 0 then
  40.      WriteLn('I/O Error ', IOerr, ' in file ', S);
  41. Chk_IOerror := IOerr;
  42. end;
  43.  
  44. {-------------PromptForInput}
  45. PROCEDURE PromptForInput;
  46. Var
  47.   InName, Name : Filestring;
  48.   Err : Integer;
  49.   I : Integer;
  50. begin
  51. {$I-}
  52. repeat
  53.   Write('ASCII Source Filename: '); ReadLn(InName);
  54.   if InName = '' then Halt(0);
  55.   SourceName := InName;
  56.   I := Pos('.', SourceName);
  57.   if I > 0 then SourceName[0] := chr(I-1);
  58.   Assign(Inf, InName);
  59.   SetTextBuf(Inf, InBuff);
  60.   Reset(Inf);
  61.   Err := Chk_IOerror(InName);
  62.   if Err>1 then Halt(1);
  63. until Err = 0;
  64. UpCaseStr(SourceName);
  65.  
  66. Write('Filename for RTF File[', SourceName, '.RTF]: '); ReadLn(InName);
  67. if InName = '' then InName := SourceName;   {Use the same name}
  68. DefaultExtension('RTF', InName, Name);
  69. Assign(Outf, InName);
  70. SetTextBuf(Outf, OutBuff);
  71. Rewrite(Outf);
  72. if Chk_IOerror(InName) <> 0 then Halt(1);
  73. {$I+}
  74. end;
  75.  
  76. {-------------CommandInput}
  77. PROCEDURE CommandInput;
  78. Var
  79.   InName, Name : Filestring;
  80.   I : Integer;
  81. begin
  82. InName := ParamStr(1);
  83. SourceName := InName;  (*DefaultExtension('PAS', InName, SourceName); *)
  84. I := Pos('.', SourceName);
  85. if I > 0 then SourceName[0] := chr(I-1);
  86. {$I-}
  87. Assign(Inf, InName);
  88. SetTextBuf(Inf, InBuff);
  89. Reset(Inf);
  90. if Chk_IOerror(InName) <> 0 then Halt(1);
  91. UpCaseStr(SourceName);
  92.  
  93. if ParamCount >= 2 then InName := ParamStr(2)
  94.   else InName := SourceName;             {Use the old name}
  95. DefaultExtension('RTF', InName, Name);
  96. Assign(Outf, InName);
  97. SetTextBuf(Outf, OutBuff);
  98. Rewrite(Outf);
  99. if Chk_IOerror(InName) <> 0 then Halt(1);
  100. {$I+}
  101. end;
  102.  
  103.  
  104. {-------------ChkEOF}
  105. PROCEDURE ChkEOF;
  106. begin
  107. if EofInf then
  108.   begin
  109.   WriteLn('Unexpected EOF found');
  110.   Close(Outf);
  111.   Halt(1);
  112.   end;
  113. end;
  114.  
  115. {-------------ReadHeader}
  116. PROCEDURE ReadHeader;
  117. var
  118.   HFile : Text;
  119. begin
  120. {$I-}
  121. Assign(HFile, 'Heading');
  122. Reset(HFile);
  123. if Chk_IOerror('HEADING') <> 0 then Halt(1);
  124. {$I+}
  125. while not Eof(HFile) do
  126.   begin
  127.   ReadLn(HFile, St);
  128.   WriteLn(Outf, St);
  129.   end;
  130. end;
  131.