program merge ;

{-----------------------------------------------------------------------------}
{ MERGE -- utility to merge several text files to one                         }
{ Syntax: MERGE <source-1> [<source-2> ...] <destination>                     }
{ source names can contain wildcards                                          }
{-----------------------------------------------------------------------------}

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

uses Crt,Dos ;

const Version = '1.03' ;
      Date = '1 Mar 1992' ;
      BufSize = 65535 ; { size of character buffer }

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

var InFile, OutFile : file ;
    InFileName,OutFileName : PathStr ;
    BufPtr : ^Buffer ;
    DiskError : word ;
    Param : byte ;                     { command-line parameter index }
    FileDir,OldCurrentDir : DirStr ;
    FileName : NameStr ;
    FileExt : ExtStr ;
    SRec : SearchRec ;
    Answer : char ;                    { overwrite existing output file? }
    EF : char ;                        { end-of-file 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 ;

{-----------------------------------------------------------------------------}
{ Appends the contents of a given file to the output file, until the first    }
{ end-of-file character. The existence of the input file is not checked.      }
{-----------------------------------------------------------------------------}

procedure AppendFile (Name:PathStr) ;

var RealSize : longint ;
    BytesRead,Counter,BytesWritten : word ;
    InFile : file ;

begin
Write ('File "',Name,'" ... ') ;
Assign (InFile,Name) ;
Reset (InFile,1) ;
RealSize := 0 ;
repeat { read block from input file }
       BlockRead (InFile,BufPtr^,BufSize,BytesRead) ;
       CheckDiskError ;
       if DiskError = 0
          then begin
               Counter := 0 ;
               { check for presence of end-of-file characters in buffer }
               while (Counter < BytesRead) and (BufPtr^[Counter+1] <> EF) do
                     Inc (Counter) ;
               { write block to output file }
               BlockWrite (OutFile,BufPtr^,Counter,BytesWritten) ;
               CheckDiskError ;
               Inc (RealSize,BytesWritten) ;
               end ; { of if }
until (BytesRead <> BufSize) or (BufPtr^[Counter+1] = EF) or (DiskError <> 0) ;
Close (InFile) ;
Writeln (RealSize,' bytes read.') ;
end ;

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

begin
Writeln ('MERGE -- utility to merge several text files to one') ;
Writeln ('         version ',Version,'  ',Date) ;
Writeln ;
EF := #26 ;
if (ParamCount < 2)
   then begin
        { wrong number of parameters }
        Writeln ('Use: MERGE <source-1> [<source-2> ...] <destination>') ;
        Writeln ('(source names can contain wildcards)') ;
        Exit ;
        end ;
OutFileName := FExpand (ParamStr(ParamCount)) ;
if Exists(OutFileName)
   then begin
        Write ('File "',OutFileName,'" already exists. ') ;
        Write ('Overwrite? (Y/N) ') ;
        repeat Answer := UpCase(ReadKey) ;
               if Answer = Chr(0)
                  then Answer := ReadKey ;
        until Answer in ['Y','N'] ;
        Writeln (Answer) ;
        if Answer = 'N'
           then Exit ;
        end ;
Assign (OutFile,OutFileName) ;
Rewrite (OutFile,1) ;
CheckDiskError ;
GetMem (BufPtr,BufSize) ;
for Param := 1 to (ParamCount-1) do
    begin
    InFileName := FExpand (ParamStr(Param)) ;
    FSplit (InFileName,FileDir,FileName,FileExt) ;
    { save current directory }
    GetDir (0,OldCurrentDir) ;
    { change to directory of input file }
    if Length(FileDir) = 3
       then { FileDir is root directory }
            ChDir (FileDir)
       else { FileDir is not root: leave off last backslash }
            ChDir (Copy(FileDir,1,Length(FileDir)-1)) ;
    CheckDiskError ;
    FindFirst (FileName+FileExt,ReadOnly+Hidden+SysFile,SRec) ;
    if DosError <> 0
       then begin
            Writeln ('File "',InFileName,'" not found') ;
            end
       else begin
            { append file(s) to output file }
            repeat AppendFile (FileDir+SRec.Name) ;
                   FindNext (SRec) ;
            until DosError <> 0
            end ;
    ChDir (OldCurrentDir) ;
    end ; { of if }
{ write end-of-file char }
BlockWrite (OutFile,EF,1) ;
CheckDiskError ;
Writeln (FileSize(OutFile),' bytes written to file ',OutFileName) ;
Close (OutFile) ;
end.