createlst.pp 1.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172
  1. program createlst;
  2. uses
  3. SysUtils, Classes;
  4. var
  5. i, j, ioerror : LongInt;
  6. outfile : text;
  7. sr: TSearchRec;
  8. path, path2: String;
  9. sl: TStringList;
  10. begin
  11. if ParamCount < 2 then
  12. begin
  13. Writeln('createlst OUTPUTFILE PATH [PATH [...]]');
  14. Halt(1);
  15. end;
  16. sl := TStringList.Create;
  17. {$i-}
  18. assign(outfile,paramstr(1));
  19. rewrite(outfile);
  20. ioerror:=IOResult;
  21. if ioerror<>0 then
  22. begin
  23. Writeln('Rewrite(',ParamStr(1),') failed, IOResult=',ioerror);
  24. Halt(2);
  25. end;
  26. for i := 2 to ParamCount do
  27. begin
  28. path := IncludeTrailingPathDelimiter(ParamStr(i));
  29. { Generate path2, with all DirectorySeparators
  30. converted to / to get same output as with
  31. script before }
  32. path2:=path;
  33. if DirectorySeparator<>'/' then
  34. for j:=1 to length(path2) do
  35. if path2[j]=DirectorySeparator then
  36. path2[j]:='/';
  37. if FindFirst(path + 't*.pp', 0, sr) = 0 then
  38. begin
  39. repeat
  40. sl.Add(path2 + sr.Name);
  41. until FindNext(sr) <> 0;
  42. FindClose(sr);
  43. end;
  44. end;
  45. sl.Sort;
  46. for i := 0 to sl.Count - 1 do
  47. begin
  48. Writeln(outfile,sl[i]);
  49. ioerror:=IOResult;
  50. if ioerror<>0 then
  51. begin
  52. Writeln('write to file ',ParamStr(1),' failed, IOResult=',ioerror);
  53. Halt(3);
  54. end;
  55. end;
  56. close(outfile);
  57. ioerror:=IOResult;
  58. if ioerror<>0 then
  59. begin
  60. Writeln('Close(',ParamStr(1),') failed, IOResult=',ioerror);
  61. Halt(4);
  62. end;
  63. sl.Free;
  64. end.