DP Tool Club 9/CD_ASCQ_09_1193.iso/news/557/anedit/split.pas

Pascal/Delphi Source File | 1992-03-01 | 11KB | 259 lines

program split ;

{-----------------------------------------------------------------------------}
{ SPLIT -- utility to split text files into smaller chunks                    }
{ syntax: SPLIT <filename> [<chunksize>[k|l]]                                 }
{ chunksize can be given as number of bytes, kilobytes or in lines            }
{ file name of chunks is same as input file                                   }
{ file extension of chunks is '.000', '.001', '.002' etc.                     }
{ program tries to split at end of line (unless line longer than chunk size)  }
{-----------------------------------------------------------------------------}

{$M 16348,65535,65535}
{$B-}
{$I-}

uses Crt,Dos ;

const Version = '1.04' ;
      Date = '1 Mar 1992' ;
      DefaultChunkSize = 60000 ;
      BufSize = 65536 - 512 ;

type Buf = array[1..BufSize] of char ;

var InFile, OutFile : file ;
    InFileName, OutFileName : PathStr ;
    SizeInLines : boolean ;         { chunk size given as no. of lines? }
    DiskError : word ;
    ChunkSize, ChunkNr : longint ;
    ChunkSizeStr : string ;         { string representation of ChunkSize }
    ChunkNrStr : string[3] ;        { string representation of ChunkNr }
    code : integer ;                { result of string->number conversion }
    BufPtr : ^Buf ;
    FileDir : DirStr ;              { directory part of InFileName }
    FileName : NameStr ;            { file name part of InFileName }
    FileExt : ExtStr ;              { file extension part of InFileName }
    Ready : boolean ;
    ChunkFull : boolean ;
    Answer : char ;                 { overwrite existing output file? }
    BytesRead,BytesToWrite,BytesWritten : word ;
    LineCounter : longint ;
    i : word ;
    LF,EF : char ;

{-----------------------------------------------------------------------------}
{ Indicates whether a filename contains wildcard characters                   }
{-----------------------------------------------------------------------------}

function Wildcarded (Name : PathStr) : boolean ;

begin
Wildcarded := (Pos('*',Name) <> 0) or (Pos('?',Name) <> 0) ;
end ;

{-----------------------------------------------------------------------------}
{ Returns True if the file <FileName> exists, False otherwise.                }
{-----------------------------------------------------------------------------}

function Exists (FileName : PathStr) : boolean ;

var SR : SearchRec ;

begin
FindFirst (FileName,ReadOnly + Hidden + SysFile,SR) ;
Exists := (DosError = 0) and (not Wildcarded(Filename)) ;
end ;

{-----------------------------------------------------------------------------}
{ Reads the result of the last I/O operation into the DiskError variable      }
{ and produces an error message if an error has occurred.                     }
{-----------------------------------------------------------------------------}

procedure CheckDiskError ;

var ErrorText : string ;

begin
DiskError := IOResult ;
if DiskError <> 0
   then begin
        case DiskError of
             2   : ErrorText := 'File not found' ;
             3   : ErrorText := 'Path not found' ;
             5   : ErrorText := 'File access denied' ;
             101 : ErrorText := 'Disk write error' ;
             150 : ErrorText := 'Disk is write-protected' ;
             152 : ErrorText := 'Drive not ready' ;
             159 : ErrorText := 'Printer out of paper' ;
             160 : ErrorText := 'Device write fault' ;
             else  begin
                   Str (DiskError,ErrorText) ;
                   ErrorText := 'I/O error ' + ErrorText ;
                   end ;
             end ; { of case }
        Writeln ;
        Writeln (ErrorText) ;
        end ; { of if }
end ;

{-----------------------------------------------------------------------------}

begin
LF := #10 ; { line-feed character }
EF := #26 ; { end-of-file-character }
Writeln ('SPLIT -- utility to split text files into smaller chunks') ;
Writeln ('         version ',Version,'  ',Date) ;
Writeln ;
if (ParamCount < 1) or (ParamCount > 2)
   then begin
        { wrong number of parameters: give help then quit program }
        Writeln ('Usage: SPLIT <filename> [<chunksize> [k|l]]') ;
        Exit ; { not nice programming but to prevent huge nesting of ifs }
        end ;
if ParamCount = 1
   then begin
        { no chunk size given: use default }
        SizeInLines := false ;
        ChunkSize := DefaultChunkSize ;
        end
   else begin
        ChunkSizeStr := ParamStr(2) ;
        if UpCase(ChunkSizeStr[Length(ChunkSizeStr)]) = 'L'
           then begin
                { chunk size given in lines }
                SizeInLines := true ;
                Val (Copy(ChunkSizeStr,1,Length(ChunkSizeStr)-1),
                     ChunkSize,code) ;
                end
           else begin
                SizeInLines := false ;
                if UpCase(ChunkSizeStr[Length(ChunkSizeStr)]) = 'K'
                   then begin
                        { chunk size given in kilobytes }
                        Val (Copy(ChunkSizeStr,1,Length(ChunkSizeStr)-1),
                             ChunkSize,code) ;
                        ChunkSize := ChunkSize * 1024 ;
                        end
                   else { chunk size given in bytes }
                        Val (ChunkSizeStr,ChunkSize,code) ;
                        { decrease ChunkSize by 1 to allow for EOF char }
                        Dec (ChunkSize) ;
                end ;
        if (code <> 0) or (ChunkSize <= 0)
           then begin
                Writeln ('Invalid chunk size "',ParamStr(2),'"') ;
                Writeln ('Usage: SPLIT <filename> [<chunksize>[k|l]]') ;
                Exit ;
                end ;
        end ;
InFileName := FExpand (ParamStr(1)) ;
if not Exists(InFileName)
   then begin
        Writeln ('Input file "',InFileName,'" not found') ;
        Exit ;
        end
   else Writeln ('Splitting file "',InFileName,'"') ;
Assign (InFile,InFileName) ;
Reset (InFile,1) ;
CheckDiskError ;
{ allocate memory buffer for contents of file }
GetMem (BufPtr,BufSize) ;
ChunkNr := 0 ;
FSplit (InFileName,FileDir,FileName,FileExt) ;
Ready := (DiskError <> 0) ;
ChunkFull := true ;
while not Ready do
      begin
      if ChunkFull
         then begin
              { start writing new chunk: }
              { construct output file name }
              Str (ChunkNr,ChunkNrStr) ;
              while Length(ChunkNrStr) < 3 do
                    ChunkNrStr := '0' + ChunkNrStr ;
              OutFileName := FExpand (FileName + '.' + ChunkNrStr) ;
              if Exists (OutFileName)
                 then begin
                      Write ('File "',OutFileName,'" already exists. ') ;
                      Write ('Skip, Overwrite, Abort? (S/O/A) ') ;
                      repeat Answer := UpCase(ReadKey) ;
                      until Answer in ['S','O','A'] ;
                      Writeln (Answer) ;
                      end
                 else Answer := 'O' ;
              case Answer of
                   'S' : { skip }
                         Inc (ChunkNr) ;
                   'O' : begin
                         { open output file }
                         Write ('File "',OutFileName,'" ... ') ;
                         Assign (OutFile,OutFileName) ;
                         ReWrite (OutFile,1) ;
                         CheckDiskError ;
                         ChunkFull := (DiskError <> 0) ;
                         LineCounter := 1 ;
                         end ;
                   'A' : { abort }
                         Ready := True ;
                   end ; { of case }
              end ; { of if }
      if not ChunkFull
         then begin
              { write chunk }
              repeat BlockRead (InFile,BufPtr^,BufSize,BytesRead) ;
                     CheckDiskError ;
                     if (BytesRead = 0) or (DiskError <> 0)
                        then Ready := true
                        else begin
                             BytesToWrite := BytesRead ;
                             { scan block and check if chunk is full }
                             i := 0 ;
                             repeat
                                Inc(i) ;
                                if BufPtr^[i] = LF
                                   then begin
                                        Inc (LineCounter) ;
                                        if SizeInLines
                                           then begin
                                                ChunkFull := (LineCounter >
                                                              ChunkSize) ;
                                                BytesToWrite := i ;
                                                end
                                           else if (FileSize(OutFile)+i) <=
                                                                   ChunkSize
                                                   then BytesToWrite := i
                                                   else begin
                                                        ChunkFull := true ;
                                                        Dec (LineCounter) ;
                                                        end ;
                                        end ;
                             until ChunkFull or (i = BytesRead) ;
                             { to make sure last line is also written: }
                             if (not SizeInLines) and
                                ((FileSize(OutFile)+BytesRead) < ChunkSize)
                                then BytesToWrite := BytesRead ;
                             { write bytes to output file }
                             BlockWrite (OutFile,BufPtr^,BytesToWrite,
                                         BytesWritten) ;
                             { correct current position of input file }
                             Seek (InFile,FilePos(InFile)-
                                          (BytesRead-BytesWritten)) ;
                             if (not SizeInLines) and
                                (FileSize(OutFile) >= ChunkSize)
                                then ChunkFull := true ;
                             end ;
              until (ChunkFull or Ready) ;
              { close output file; write end-of-file char }
              if not Eof(InFile)
                 then BlockWrite (OutFile,EF,1) ;
              Writeln (LineCounter,' lines, ',
                       FileSize(OutFile),' bytes written.') ;
              Close (OutFile) ;
              CheckDiskError ;
              Inc (ChunkNr) ;
              end ; { of if }
      end ; { of while }
Close (InFile) ;
end.