makehtm.pp 3.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by the Free Pascal development team
  5. Convert .html to htm files, together with links.
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {$mode objfpc}
  13. {$h+}
  14. program makehtm;
  15. uses sysutils;
  16. Var
  17. Verbose : Boolean;
  18. FileCount : Boolean;
  19. DeleteHtml : Boolean;
  20. Procedure ConvertFile (FileName : String);
  21. Var
  22. OFileName : String;
  23. Infile,OutFile : Text;
  24. Line : String;
  25. begin
  26. Try
  27. OFileName:=ChangeFileExt(FileName,'.htm');
  28. If Verbose then
  29. Writeln('Converting ',FileName,' to ',OFileName)
  30. else
  31. Write('.');
  32. Assign(InFile,FileName);
  33. Assign(OutFile,OFileName);
  34. Reset(Infile);
  35. Try
  36. Rewrite(OutFile);
  37. Try
  38. While Not EOF(Infile) do
  39. begin
  40. ReadLn(Infile,Line);
  41. Line:=Stringreplace(Line,'.html','.htm',[rfReplaceAll]);
  42. Writeln(OutFile,Line);
  43. end
  44. Finally
  45. Close(OutFile);
  46. end;
  47. finally
  48. Close(InFile);
  49. end;
  50. If DeleteHtml then
  51. begin
  52. If Verbose then
  53. Writeln('Deleting input file : ',FileName);
  54. DeleteFile(FileName);
  55. end;
  56. except
  57. On E : Exception do
  58. Writeln('Error converting ',FileName,' to ',OFileName,' : ',E.Message);
  59. end;
  60. end;
  61. Function DoDirectory(DirName : String; Recurse : Boolean) : Integer;
  62. Var
  63. Info : TSearchRec;
  64. begin
  65. Result:=0;
  66. DirName:=IncludeTrailingPathDelimiter(DirName);
  67. If FindFirst(Dirname+'*.html',0,Info)=0 then
  68. Try
  69. Repeat
  70. ConvertFile(DirName+Info.Name);
  71. Inc(Result);
  72. Until (FindNext(Info)<>0);
  73. Finally
  74. FindClose(Info);
  75. end;
  76. If Recurse then
  77. If FindFirst(Dirname+'*',faDirectory,Info)=0 then
  78. Try
  79. Repeat
  80. With Info do
  81. If ((Attr and faDirectory)<>0) and (Name<>'.') and (Name<>'..') then
  82. Result:=Result+DoDirectory(DirName+Name,Recurse);
  83. Until (FindNext(Info)<>0);
  84. Finally
  85. FindClose(Info);
  86. end;
  87. end;
  88. Procedure DoDirs;
  89. Var
  90. I : integer;
  91. Count,Total : Integer;
  92. Dir : String;
  93. begin
  94. Total:=0;
  95. for I:=1 to ParamCount do
  96. begin
  97. Dir:=Paramstr(I);
  98. if (Dir<>'-v') then
  99. begin
  100. Count:=DoDirectory(Dir,True);
  101. if Not verbose then
  102. Writeln;
  103. Writeln('Directory ',Dir,' : ',Count,' files.');
  104. Total:=Total+Count;
  105. end;
  106. end;
  107. Writeln('Total files ',Total);
  108. end;
  109. Procedure DoParams;
  110. Var
  111. I : integer;
  112. begin
  113. Verbose:=False;
  114. DeleteHtml:=False;
  115. For I:=1 to ParamCount do
  116. If paramstr(i)='-v' then
  117. Verbose:=True
  118. else if paramstr(i)='-r' then
  119. DeleteHtml:=True;
  120. end;
  121. begin
  122. DoParams;
  123. DoDirs;
  124. end.