home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / VRAC / BUSTX.ZIP / BUSTX.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-14  |  4KB  |  129 lines
  1. PROGRAM ChopPCBoardDIRListings;
  2. USES Dos;
  3. CONST
  4.      ProgData = 'BUSTX- Free DOS utility: Xevious ALLFILES.LST separator.';
  5.      ProgDat2 = 'V1.00: July 14, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';
  6.  
  7.      Usage = 'Usage:  BUSTX source_file (must be in current directory)';
  8.  
  9.      File_Header = '====';
  10.      PgHd = '508-875-3618';
  11.      PgNo = 'Page Number:';
  12.      PgHe = 'Created by FILELIST';
  13.      FFeed = ' ';
  14.      LSpace = '                                     ';
  15. VAR
  16.    ValidLine                : Boolean;
  17.    InFilePath               : PathStr;
  18.    InFileDir                : DirStr;
  19.    InFileName               : NameStr;
  20.    InFileExt                : ExtStr;
  21.    HeaderCount              : Integer;
  22.    Line_Current             : String[80];
  23.    OutFileName              : String[8];
  24.    OutFileExt               : String[3];
  25.    OutFileName_Ext          : String[12];
  26.    Source_File,Dest_File    : Text;
  27.  
  28. PROCEDURE GetNewOutFileExt;
  29. VAR
  30.    OutFileInc,ErrCode : Integer;
  31. BEGIN
  32.      Val(OutFileExt,OutFileInc,ErrCode);
  33.      OutFileInc := Succ(OutFileInc);
  34.      Str(OutFileInc,OutFileExt);
  35.      WHILE Length(OutFileExt) < 3 DO
  36.           OutFileExt := '0' + OutFileExt;
  37. END;
  38.  
  39. PROCEDURE OpenOutFile;
  40. BEGIN
  41.      OutFileName_Ext := OutFileName + '.' + OutFileExt;
  42.      Assign(Dest_File,OutFileName_Ext);
  43.      Rewrite(Dest_File);
  44. END;
  45.  
  46. PROCEDURE GetValidLine;
  47. BEGIN
  48.      ValidLine := False;
  49.      WHILE ValidLine = False DO
  50.      BEGIN
  51.           ReadLn(Source_File,Line_Current);
  52.           ValidLine := True;
  53.  
  54.       IF (Pos(PgHd,Line_Current) <> 0)
  55.       OR (Pos(PgHe,Line_Current) <> 0)
  56.       OR (Pos(PgNo,Line_Current) = 1)
  57.       OR (Pos(FFeed,Line_Current) = 1) THEN
  58.              ValidLine := False;
  59.  
  60.       IF (Pos(LSpace,Line_Current) = 1)
  61.       OR (Line_Current = '') THEN
  62.              ValidLine := False;
  63.  
  64.       IF (Length(Line_Current) = 32)
  65.      AND (Pos('byte',Line_Current) = 0) THEN
  66.              ValidLine := False;
  67.  
  68.       IF (Length(Line_Current) < 34)
  69.      AND (Pos('byte',Line_Current) <> 0) THEN
  70.              ValidLine := False;
  71.  
  72.           IF Eof(Source_File) THEN
  73.              BEGIN
  74.                   ValidLine := True;
  75.                   HeaderCount := 3;
  76.              END;
  77.      END;
  78.      IF Pos(File_Header,Line_Current) = 1 THEN
  79.         HeaderCount := Succ(HeaderCount);
  80. END;
  81.  
  82. BEGIN
  83.      Writeln(ProgData);
  84.      Writeln(ProgDat2);
  85.      Writeln;
  86.      If ParamCount <> 1 THEN Begin
  87.         Writeln(Usage);
  88.         Halt;
  89.      End;
  90.  
  91.      InFilePath := ParamStr(1);
  92.      Assign(Source_File,InFilePath);
  93. {$I-} Reset(Source_File); {$I+}                         {Check if file exists.}
  94.      IF (IOResult <> 0) THEN                            {If it                }
  95.      BEGIN                                              {   doesn't, then     }
  96.          Writeln('Unable to open "', InFilePath, '".'); { quit with message.  }
  97.          Halt;
  98.      END;
  99.  
  100.  
  101.      FSplit(InFilePath, InFileDir, InFileName, InFileExt);
  102.      OutFileName := InFileName;   {Using same name, but different extensions.}
  103.      OutFileExt := '001';
  104.      OpenOutFile;
  105.      Writeln('Writing ',OutFileName_Ext);
  106.      HeaderCount := 0;
  107.      GetValidLine;
  108.  
  109.      WHILE NOT Eof(Source_File) DO
  110.      BEGIN
  111.           IF HeaderCount = 3 THEN
  112.              BEGIN
  113.                   GetNewOutFileExt;
  114.                   OpenOutFile;
  115.                   Writeln('Writing ',OutFileName_Ext);
  116.                   HeaderCount := 1;
  117.              END;
  118.  
  119.           WHILE HeaderCount <> 3 DO
  120.           BEGIN
  121.                WriteLn(Dest_File,Line_Current);
  122.                GetValidLine;
  123.           END;
  124.           Close(Dest_File);
  125.      END;
  126.      Close(Source_File);
  127.      Writeln('Done!');
  128. END.
  129.