home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / EDITOR / AE_14.ZIP / MERGE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-03-12  |  6.4 KB  |  187 lines
  1. program merge ;
  2.  
  3. {-----------------------------------------------------------------------------}
  4. { MERGE -- utility to merge several text files to one                         }
  5. { Syntax: MERGE <source-1> [<source-2> ...] <destination>                     }
  6. { source names can contain wildcards                                          }
  7. {-----------------------------------------------------------------------------}
  8.  
  9. {$M 16348,65535,65535}
  10. {$B-}
  11. {$I-}
  12.  
  13. uses Crt,Dos ;
  14.  
  15. const Version = '1.0' ;
  16.       Date = '12 Mar 1991' ;
  17.       BufSize = 65535 ; { size of character buffer }
  18.  
  19. type Buffer = array[1..BufSize] of char ;
  20.  
  21. var InFile, OutFile : file ;
  22.     InFileName,OutFileName : PathStr ;
  23.     BufPtr : ^Buffer ;
  24.     DiskError : word ;
  25.     Param : byte ;                     { command-line parameter index }
  26.     FileDir,OldCurrentDir : DirStr ;
  27.     FileName : NameStr ;
  28.     FileExt : ExtStr ;
  29.     SRec : SearchRec ;
  30.     Answer : char ;                    { overwrite existing output file? }
  31.     EF : char ;                        { end-of-file char }
  32.  
  33. {-----------------------------------------------------------------------------}
  34. { Indicates whether a filename contains wildcard characters                   }
  35. {-----------------------------------------------------------------------------}
  36.  
  37. function Wildcarded (Name : PathStr) : boolean ;
  38.  
  39. begin
  40. Wildcarded := (Pos('*',Name) <> 0) or (Pos('?',Name) <> 0) ;
  41. end ;
  42.  
  43. {-----------------------------------------------------------------------------}
  44. { Returns True if the file <FileName> exists, False otherwise.                }
  45. {-----------------------------------------------------------------------------}
  46.  
  47. function Exists (FileName : PathStr) : boolean ;
  48.  
  49. var SR : SearchRec ;
  50.  
  51. begin
  52. FindFirst (FileName,ReadOnly + Hidden + SysFile,SR) ;
  53. Exists := (DosError = 0) and (not Wildcarded(Filename)) ;
  54. end ;
  55.  
  56. {-----------------------------------------------------------------------------}
  57. { Reads the result of the last I/O operation into the DiskError variable      }
  58. { and produces an error message if an error has occurred.                     }
  59. {-----------------------------------------------------------------------------}
  60.  
  61. procedure CheckDiskError ;
  62.  
  63. var ErrorText : string ;
  64.  
  65. begin
  66. DiskError := IOResult ;
  67. if DiskError <> 0
  68.    then begin
  69.         case DiskError of
  70.              2   : ErrorText := 'File not found' ;
  71.              3   : ErrorText := 'Path not found' ;
  72.              5   : ErrorText := 'File acces denied' ;
  73.              101 : ErrorText := 'Disk write error' ;
  74.              150 : ErrorText := 'Disk is write-protected' ;
  75.              152 : ErrorText := 'Drive not ready' ;
  76.              159 : ErrorText := 'Printer out of paper' ;
  77.              160 : ErrorText := 'Device write fault' ;
  78.              else  begin
  79.                    Str (DiskError,ErrorText) ;
  80.                    ErrorText := 'I/O error ' + ErrorText ;
  81.                    end ;
  82.              end ; { of case }
  83.         Writeln ;
  84.         Writeln (Chr(7),ErrorText) ;
  85.         end ; { of if }
  86. end ;
  87.  
  88. {-----------------------------------------------------------------------------}
  89. { Appends the contents of a given file to the output file, until the first    }
  90. { end-of-file character. The existence of the input file is not checked.      }
  91. {-----------------------------------------------------------------------------}
  92.  
  93. procedure AppendFile (Name:PathStr) ;
  94.  
  95. var Size,RealSize : longint ;
  96.     BytesRead,Counter,BytesWritten : integer ;
  97.     InFile : file ;
  98.  
  99. begin
  100. Write ('File "',Name,'" ... ') ;
  101. Assign (InFile,Name) ;
  102. Reset (InFile,1) ;
  103. Size := FileSize (InFile) ;
  104. RealSize := 0 ;
  105. repeat { read block from input file }
  106.        BlockRead (InFile,BufPtr^,BufSize,BytesRead) ;
  107.        CheckDiskError ;
  108.        if DiskError <> 0
  109.           then begin
  110.                Counter := 0 ;
  111.                { check for presence of end-of-file characters in buffer }
  112.                while (Counter < BytesRead) and (BufPtr^[Counter+1] <> EF) do
  113.                      Inc (Counter) ;
  114.                { write block to output file }
  115.                BlockWrite (OutFile,BufPtr^,Counter,BytesWritten) ;
  116.                CheckDiskError ;
  117.                Inc (RealSize,BytesWritten) ;
  118.                end ; { of if }
  119. until (BytesRead = BufSize) or (BufPtr^[Counter+1] = EF) or (DiskError <> 0) ;
  120. Close (InFile) ;
  121. Writeln (RealSize,' bytes read.') ;
  122. end ;
  123.  
  124. {-----------------------------------------------------------------------------}
  125.  
  126. begin
  127. Writeln ('MERGE -- utility to merge several text files to one') ;
  128. Writeln ('Version ',Version,'  ',Date) ;
  129. Writeln ;
  130. EF := #26 ;
  131. if (ParamCount < 2)
  132.    then begin
  133.         { wrong number of parameters }
  134.         Writeln ('Use: MERGE <source-1> [<source-2> ...] <destination>') ;
  135.         Writeln ('(source names can contain wildcards)') ;
  136.         Exit ;
  137.         end ;
  138. OutFileName := FExpand (ParamStr(ParamCount)) ;
  139. if Exists(OutFileName)
  140.    then begin
  141.         Write ('File "',OutFileName,'" already exists. ') ;
  142.         Write ('Overwrite? (Y/N) ') ;
  143.         repeat Answer := UpCase(ReadKey) ;
  144.                if Answer = Chr(0)
  145.                   then Answer := ReadKey ;
  146.         until Answer in ['Y','N'] ;
  147.         Writeln (Answer) ;
  148.         if Answer = 'N'
  149.            then Exit ;
  150.         end ;
  151. Assign (OutFile,OutFileName) ;
  152. Rewrite (OutFile,1) ;
  153. CheckDiskError ;
  154. GetMem (BufPtr,BufSize) ;
  155. for Param := 1 to (ParamCount-1) do
  156.     begin
  157.     InFileName := FExpand (ParamStr(Param)) ;
  158.     FSplit (InFileName,FileDir,FileName,FileExt) ;
  159.     { save current directory }
  160.     GetDir (0,OldCurrentDir) ;
  161.     { change to directory of input file }
  162.     if Length(FileDir) = 3
  163.        then { FileDir is root directory }
  164.             ChDir (FileDir)
  165.        else { FileDir is not root: leave off last backslash }
  166.             ChDir (Copy(FileDir,1,Length(FileDir)-1)) ;
  167.     CheckDiskError ;
  168.     FindFirst (FileName+FileExt,ReadOnly+Hidden+SysFile,SRec) ;
  169.     if DosError <> 0
  170.        then begin
  171.             Writeln ('File "',InFileName,'" not found') ;
  172.             end
  173.        else begin
  174.             { append file(s) to output file }
  175.             repeat AppendFile (FileDir+SRec.Name) ;
  176.                    FindNext (SRec) ;
  177.             until DosError <> 0
  178.             end ;
  179.     ChDir (OldCurrentDir) ;
  180.     end ; { of if }
  181. { write end-of-file char }
  182. BlockWrite (OutFile,EF,1) ;
  183. CheckDiskError ;
  184. Writeln (FileSize(OutFile),' bytes written to file ',OutFileName) ;
  185. Close (OutFile) ;
  186. end.
  187.