UUMerge Command Line Text File Merge (Delphi)

BradTrupp.com -- Tags -- Code -- UUMerge Command Line Text File Merge (Delphi)

UUMerge Command Line Text File Merge (Delphi)
(2007/07/01)

UUMerge Command Line Text File Merge - Source Code
By Brad Trupp (c) 2007

uuMerge Freeware Edition was a command line utility that can be used either to combine multiple text files into a single text file with a separator line between the contents of each file; or alternatively to process a 'merged' file ( previously created by uuMerge or other processes ) and recreate the multiple files.

The original version of uuMerge being written back in 2002 when I could not find a quick and easy way to merge together a bunch of text files so I could edit them as a single file.

It is written in Borland Delphi and this final version was compiled with version 7.

Using uuMerge

Files are separated internally with special delimiter line prefixed by "./ ADD NAME=".

This odd choice of delimiters allows the file to be processed by the IBM mainframe utility IEBUPDTE.

Alternatively, you can use the '-nice' option to create a '>>>>>>>>>> ' delimiter line instead so it looks nicer for printing. You could also use any text editor to do a global replace of the delimiter text to any string you wish. However you will not be able to use uuMerge to extract files at a later point.

Usage:

1. Merge files in a directory to a single file.

uumerge -merge indir outfile
where indir is the source directory (with optional file masking)
and outfile is the target output file.

2. Restore files.

uumerge -extract infile outdir
where infile is a input file previously created by uuMerge
and outdir is the directory for the target destination

Notes: Use on text files only - results are unpredictable otherwise.

Here is the source code for your viewing pleasure.

uumerge.dpr


(******************************************************************************)
(*                                                                            *)
(*                                                                            *)
(*                                                                            *)
(******************************************************************************)
program uuMerge;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  code0001 in 'code0001.pas';

var
  s: string;

begin
  { -oUser -cConsole Main }
  try
    parseParms;
    if helpParm then
    begin
      writeln('uuMerge Freeware Edition v1.02 - usage is:');
      writeln('  1. Merge files in a directory to a single file.');
      writeln('     uumerge -merge indir outfile');
      writeln('     where indir is the source directory (with optional file masking),');
      writeln('       and outfile is the target output file.');
      writeln('  2. Restore files.');
      writeln('     uumerge -extract infile outdir');
      writeln('     where infile is a input file previously created by uuMerge,');
      writeln('       and outdir is the directory for the target destination.');
      writeln('  Notes: Use on text files only - otherwise results are unpredictable.');
      writeln('  Copyright (c) 2006 BradTrupp.com and Capella Systems Group, Inc.');
      writeln('    Please read uuMerge.txt file for License terms and Disclaimer of Warranty');
      writeln('');
      writeln('Press ENTER to continue...');
      readln(s);
    end
    else
    begin
      case packParm of
      0: begin
           writeln('uuMerge Freeware Edition v1.02 - Invalid parameters entered.');
           writeln('  Use "uuMerge ?" for extended usage description.');
           writeln('  Copyright (c) 2006 BradTrupp.com and Capella Systems Group, Inc.');
           writeln('');
           writeln('Press ENTER to continue...');
           readln(s);
         end;
      1: begin
           dir2file;
         end;
      2: begin
           file2dir;
         end;
      end;
    end;
  except
    on E: Exception do
      begin
        writeln( 'uuMerge Freeware Edition v1.02 - '+E.Message);
        writeln('');
        writeln('Press ENTER to continue...');
        readln(s);
      end;
  end;
end.

code0001.pas


(******************************************************************************)
(*                                                                            *)
(*                                                                            *)
(*                                                                            *)
(******************************************************************************)
unit code0001;

interface

uses SysUtils, Classes;

type
  myException = class(exception);

procedure parseParms;
procedure dir2file;
procedure file2dir;
function getPrompt(sMessage,sChoices: string):integer;

var
  packParm, delimParm: integer;
  helpParm, debugFlag: boolean;
  inParm, outParm: string;

implementation

(******************************************************************************)
(*                                                                            *)
(*                                                                            *)
(*                                                                            *)
(******************************************************************************)
procedure parseParms;
var
  i,j: Integer;
  ws, s1: string;
begin
  packParm := 0;
  delimParm := 0;
  helpParm := false;
  debugFlag := false;
  inParm := ''; outParm := '';

  if ( ParamCount < 1 ) then begin helpParm := true; exit; end;

  if ( ParamCount = 1 ) then
    if ( comparetext(ParamStr(1),'?') = 0 ) then begin helpParm := true; exit; end;

  j:=0;
  for i := 1 to ParamCount do
  begin
    ws := ParamStr(i);
    s1 := copy(ws, 0, 1 );
    if (s1 = '-') or (s1 = '/') then
    begin
      if ( comparetext(ws,'-?') = 0 ) or
         ( comparetext(ws,'/?') = 0 )
          then helpParm := true;
      if ( comparetext(ws,'-merge') = 0 ) or
         ( comparetext(ws,'/merge') = 0 )
         then packParm := 1;
      if ( comparetext(ws,'-extract') = 0 ) or
         ( comparetext(ws,'/extract') = 0 )
         then packParm := 2;
      if ( comparetext(ws,'-nice') = 0 ) or
         ( comparetext(ws,'/nice') = 0 )
         then delimParm := 1;
      if ( comparetext(ws,'-debug') = 0 ) or
         ( comparetext(ws,'/debug') = 0 )
         then debugFlag := true;

    end
    else
    begin
      inc(j);
      case j of
      1: begin
         inParm := ws;
         end;
      2: begin
         outParm := ws;
         end;
      end;
    end;
  end;

  if (packParm = 0) and (not helpParm) then
    packParm := getPrompt('Action not specified.(Merge/Extract/Cancel)?','mec');
  if (packParm = 3) then begin raise myException.Create('Operation Cancelled.'); exit; end;

end;

(******************************************************************************)
(*                                                                            *)
(*                                                                            *)
(*                                                                            *)
(******************************************************************************)
procedure dir2file;
var
  iii: integer;
  tf1, tf2: textfile;
  sList: tstringlist;
  s, rn, Path, outPath: string;
  Attr, Found: Integer;
  SearchRec: TSearchRec;
begin
  sList := tStringList.create;
  sList.sorted := true;

  if ( length(inParm) = 0 ) then
  begin
    path := GetCurrentDir;
    path := IncludeTrailingPathDelimiter(path);
    path := path + '*.*';
  end
  else
  begin
    path := ExpandFileName( inParm );
  end;
  writeln('Adding files from ' + path);
  writeln('...............to ' + ExpandFileName(outParm));

  attr:=0;
  Found := FindFirst(Path, Attr, SearchRec);
  while Found = 0 do
  begin
    sList.Add(SearchRec.name);
    Found := FindNext(SearchRec);
  end;
  FindClose(SearchRec);

  if ( sList.Count = 0 ) then
  begin
    raise myException.Create('No files matched.');
    exit;
  end;

  if ( fileExists(outParm) ) then
    begin
      iii:=getPrompt('Overwrite ' + outParm + '(Yes/No)?','yn');
      if (iii=2) then begin raise myException.Create('Operation Cancelled.'); exit; end;
  end;

  outPath := ExtractFilePath(path);
  outPath := IncludeTrailingPathDelimiter(outPath);
  try
  assignFile(tf2,outParm);
  rewrite(tf2);
  for iii := 0 to sList.Count - 1 do
  begin
        rn:=uppercase(sList.strings[iii]);
        writeln('Adding '+ rn);
        case delimParm of
        0: begin
           Writeln(tf2, './       ADD   NAME=' + rn );
           end;
        1: begin
           Writeln(tf2, '>>>>>>>>>> ' + rn );
           end;
        end;
        AssignFile(tf1, outPath + sList.strings[iii]);
        Reset(tf1);
        while not Eof(tf1) do
          begin
            Readln(tf1, s);
            Writeln(tf2, s);
          end;
        CloseFile(tf1);
  end;
  CloseFile(tf2);
  except
    on E: myException do begin raise end;
    on E: Exception do
    begin
      if debugFlag then writeln(E.Message);
      raise myException.Create('Error creating ' + outParm);
    end;
  end;

  sList.Free;
end;

(******************************************************************************)
(*                                                                            *)
(*                                                                            *)
(*                                                                            *)
(******************************************************************************)
procedure file2dir;
var
  tf1, tf2: textfile;
  rn,s,pathnam: string;
  isOutputActive: boolean;
  iii, delimFound: integer;
  bProcessFile, bOverwriteAllFiles: boolean;
  begin

  if ( not fileExists(inParm) ) then
  begin
    raise myException.create('File ' + inParm + ' does not exist.');
    exit;
  end;

  if ( length(outParm) = 0 ) then
  begin
    pathnam := GetCurrentDir;
    pathnam := IncludeTrailingPathDelimiter(pathnam);
  end
  else
  begin
    pathnam := outParm;
    if ( outParm[length(outParm)] <> '\') then pathnam := pathnam + '\';
    pathnam := ExtractFileDir( pathnam );
    pathnam := IncludeTrailingPathDelimiter(pathnam);
  end;
  writeln('Extracting files from ' + ExpandFileName(inParm));
  writeln('.................. to ' + pathnam);

  isOutputActive:=false;
  bOverwriteAllFiles := false;
  try
    assignFile(tf2,inParm);
    Reset(tf2);
    while not Eof(tf2) do
      begin
        Readln(tf2, s);

        delimFound := -1;
        if (pos('./',s) = 1) then delimFound := 0;
        if (pos('>>>>>>>>>>',s) = 1) then delimFound := 1;
        if ( delimFound > -1 )then
        begin
            if isOutputActive then begin CloseFile(tf1); isOutputActive:= false; end;
            case delimFound of
            0: begin
               iii := pos('NAME=',s);
               rn := copy (s, iii+5, 120 );
               end;
            1: begin
               rn := copy (s, 12, 120 );
               end;
            end;
            //
            bProcessFile:=true;
            if ( fileExists(pathnam + rn) ) and ( not bOverwriteAllFiles) then
            begin
              iii:=getPrompt('Overwrite  [' + pathnam + rn + '] (Yes/No/All/Cancel)?','ynac');
              case iii of
              1:  begin
                  bProcessFile:=true;
                  end;
              2:  begin
                  bProcessFile:=false;
                  end;
              3:  begin
                  bOverwriteAllFiles:=true;
                  end;
              4:  begin
                  raise myException.Create('Operation Cancelled.');
                  exit;
                  end;
              end;
            end;
            //
            if ( bProcessFile ) or ( bOverwriteAllFiles ) then
            begin
              writeln('Extracting '+ rn);
              AssignFile(tf1, pathnam + rn);
              rewrite(tf1);
              isOutputActive:=true;
              Readln(tf2, s);
            end;
            if ( not bProcessFile) then
            begin
              writeln('Skipping '+ rn);
            end;
        end;

        if isOutputActive then begin Writeln(tf1, s); end;

      end;

    if isOutputActive then begin CloseFile(tf1); end;
    CloseFile(tf2);
  except
    on E: myException do begin raise end;
    on E: Exception do
    begin
      if debugFlag then writeln(E.Message);
      raise myException.Create('Error while processing ' + inParm);
    end;
  end;
end;

function getPrompt(sMessage,sChoices: string):integer;
var
  iii, jjj: integer;
  s, s2, lsChoices: string;
begin
      lsChoices:= lowercase(sChoices);
      while( true ) do
      begin
        write(sMessage);
        readln(s);
        s := copy(s,1,1);
        for iii:= 1 to length(sChoices) do
        begin
          s2 := copy(sChoices,iii,1);
          jjj := pos(s2,s);
          if jjj > 0 then begin getPrompt := iii; exit; end;
        end;
      end;
end;

end.

Tags: Code