home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 9 / CD_ASCQ_09_1193.iso / news / 557 / anedit / merge.pas < prev    next >
Pascal/Delphi Source File  |  1992-03-01  |  7KB  |  186 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.03' ;
  16.       Date = '1 Mar 1992' ;
  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 access 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 (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 RealSize : longint ;
  96.     BytesRead,Counter,BytesWritten : word ;
  97.     InFile : file ;
  98.  
  99. begin
  100. Write ('File "',Name,'" ... ') ;
  101. Assign (InFile,Name) ;
  102. Reset (InFile,1) ;
  103. RealSize := 0 ;
  104. repeat { read block from input file }
  105.        BlockRead (InFile,BufPtr^,BufSize,BytesRead) ;
  106.        CheckDiskError ;
  107.        if DiskError = 0
  108.           then begin
  109.                Counter := 0 ;
  110.                { check for presence of end-of-file characters in buffer }
  111.                while (Counter < BytesRead) and (BufPtr^[Counter+1] <> EF) do
  112.                      Inc (Counter) ;
  113.                { write block to output file }
  114.                BlockWrite (OutFile,BufPtr^,Counter,BytesWritten) ;
  115.                CheckDiskError ;
  116.                Inc (RealSize,BytesWritten) ;
  117.                end ; { of if }
  118. until (BytesRead <> BufSize) or (BufPtr^[Counter+1] = EF) or (DiskError <> 0) ;
  119. Close (InFile) ;
  120. Writeln (RealSize,' bytes read.') ;
  121. end ;
  122.  
  123. {-----------------------------------------------------------------------------}
  124.  
  125. begin
  126. Writeln ('MERGE -- utility to merge several text files to one') ;
  127. Writeln ('         version ',Version,'  ',Date) ;
  128. Writeln ;
  129. EF := #26 ;
  130. if (ParamCount < 2)
  131.    then begin
  132.         { wrong number of parameters }
  133.         Writeln ('Use: MERGE <source-1> [<source-2> ...] <destination>') ;
  134.         Writeln ('(source names can contain wildcards)') ;
  135.         Exit ;
  136.         end ;
  137. OutFileName := FExpand (ParamStr(ParamCount)) ;
  138. if Exists(OutFileName)
  139.    then begin
  140.         Write ('File "',OutFileName,'" already exists. ') ;
  141.         Write ('Overwrite? (Y/N) ') ;
  142.         repeat Answer := UpCase(ReadKey) ;
  143.                if Answer = Chr(0)
  144.                   then Answer := ReadKey ;
  145.         until Answer in ['Y','N'] ;
  146.         Writeln (Answer) ;
  147.         if Answer = 'N'
  148.            then Exit ;
  149.         end ;
  150. Assign (OutFile,OutFileName) ;
  151. Rewrite (OutFile,1) ;
  152. CheckDiskError ;
  153. GetMem (BufPtr,BufSize) ;
  154. for Param := 1 to (ParamCount-1) do
  155.     begin
  156.     InFileName := FExpand (ParamStr(Param)) ;
  157.     FSplit (InFileName,FileDir,FileName,FileExt) ;
  158.     { save current directory }
  159.     GetDir (0,OldCurrentDir) ;
  160.     { change to directory of input file }
  161.     if Length(FileDir) = 3
  162.        then { FileDir is root directory }
  163.             ChDir (FileDir)
  164.        else { FileDir is not root: leave off last backslash }
  165.             ChDir (Copy(FileDir,1,Length(FileDir)-1)) ;
  166.     CheckDiskError ;
  167.     FindFirst (FileName+FileExt,ReadOnly+Hidden+SysFile,SRec) ;
  168.     if DosError <> 0
  169.        then begin
  170.             Writeln ('File "',InFileName,'" not found') ;
  171.             end
  172.        else begin
  173.             { append file(s) to output file }
  174.             repeat AppendFile (FileDir+SRec.Name) ;
  175.                    FindNext (SRec) ;
  176.             until DosError <> 0
  177.             end ;
  178.     ChDir (OldCurrentDir) ;
  179.     end ; { of if }
  180. { write end-of-file char }
  181. BlockWrite (OutFile,EF,1) ;
  182. CheckDiskError ;
  183. Writeln (FileSize(OutFile),' bytes written to file ',OutFileName) ;
  184. Close (OutFile) ;
  185. end.
  186.