home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / txt2coma.zip / TXT2COMA.PAS < prev   
Pascal/Delphi Source File  |  1994-06-03  |  8KB  |  249 lines

  1. program txt2coma;
  2. { program to convert a text file with one record per line
  3.   into a comma delimited text file.  user may specify fields
  4.   by indicating field positions for each field below an actual
  5.   record from the file.  may also specify various delimter characters.
  6.   allows skipping of beginning records by displaying each record and
  7.   asking if you want to skip it until you say no.  then converts the
  8.   rest of the file.  this is useful for skipping headings, "rulers",
  9.   etc. which appear at the beginning of a file, e.g. a text file
  10.   containing a report output from a program. }
  11.  
  12. uses dos, crt;
  13. const
  14.  bell = #7;
  15. var
  16.   ch      : char;
  17.   fd      : string[255];
  18.   fldno   : integer;
  19.   numflds : word;
  20.   infile  : text;
  21.   infname : string[255];
  22.   outfname: string[255];
  23.   outfile : text;
  24.   inpline  : string[255];
  25.   ruler   : string[255];
  26.   delim   : string[255];
  27.   fldstrt : array [ 1..36 ] of integer;
  28.   fldlen  : array [ 1..36 ] of integer;
  29.   oqdelim : array [ 1..36 ] of string[1];
  30.   cqdelim : array [ 1..36 ] of string[1];
  31.   fldsep  : string[255];
  32.   recsep  : string[255];
  33.   lineno  : longint;
  34.  
  35.   procedure instructions;
  36.   begin { instructions }
  37.     writeln('TXT2COMA - a program to convert ASCII text files to');
  38.     writeln('           comma delimited files, a format used for');
  39.     writeln('           input to many programs.');
  40.     writeln('You will be asked for an input and output file name.');
  41.     writeln('The input file will be opened and each line will be ');
  42.     writeln('displayed followed by Skip (Y,N)? until you answer N.');
  43.     writeln('This allows skipping the first few lines in the file');
  44.     writeln('which are often headings.  When you answer N, the line');
  45.     writeln('will be redisplayed with instructions allowing you to');
  46.     writeln('indicate the positions of each "field" to be delimited,');
  47.     writeln('the opening and closing delimiter for each field, the');
  48.     writeln('field separator delimiter, and the record separator');
  49.     writeln('delimiter.  TXT2COMMA then displays each records as');
  50.     writeln('it does the conversion.  NOTE: when specifying field');
  51.     writeln('markers, fields are output in 0..9,A..Z order so you');
  52.     writeln('can change the order of the fields in the output file.');
  53.     writeln;
  54.   end; { instructions }
  55.  
  56.   procedure getparms;
  57.   var
  58.     skipover : boolean;
  59.     ch       : char;
  60.     ior      : integer;
  61.     i        : integer;
  62.     fldno    : integer;
  63.   begin { getparms }
  64.  
  65.     repeat
  66.       write('Input file name ([RET] for instructions or to quit): ');
  67.       readln(infname);
  68.       if infname = ''
  69.         then begin
  70.           instructions;
  71.           halt;
  72.         end;
  73.       assign(infile,infname);
  74.       {$I-}
  75.       reset(infile);
  76.       {$I+}
  77.       ior := ioresult;
  78.       if ior <> 0
  79.         then writeln('I/O Error opening file. [',ior,']');
  80.     until ior = 0;
  81.  
  82.     repeat
  83.       write('Output file name: ');
  84.       readln(outfname);
  85.       assign(outfile,outfname);
  86.       {$I-}
  87.       rewrite(outfile);
  88.       {$I+}
  89.       ior := ioresult;
  90.       if ior <> 0
  91.         then writeln('I/O Error opening output file. [',ior,']');
  92.     until ior = 0;
  93.  
  94.  
  95.     { read/show each line of infile and ask if skip }
  96.     skipover := true;
  97.     lineno := 0;
  98.     while (not eof(infile)) and (skipover) do begin
  99.       readln(infile,inpline);
  100.       inc(lineno);
  101.       writeln(lineno:2,':',inpline);
  102.       write('Skip (Y,N)? ');
  103.       ch := readkey;
  104.       if ch in ['Y','y']
  105.         then writeln(ch)
  106.         else if ch in ['N','n']
  107.           then begin skipover := false; writeln(ch); end
  108.           else write(bell);
  109.     end; { while }
  110.  
  111.  
  112.     if skipover
  113.       then begin
  114.         writeln('All records skipped.  Ending.');
  115.         close(infile);
  116.         halt;
  117.       end;
  118.  
  119.     { initialize field start positions }
  120.     for fldno := 1 to 36 do fldstrt[fldno] := -1;
  121.  
  122.     { show 1st data line and ask for field marks 0..9,A..Z }
  123.     clrscr;
  124.     writeln('Indicate positions of fields below with contiguous string of field');
  125.     writeln('  markers [0..9,A..Z] to indicate field numbers.  Example:');
  126.     writeln('xx:Johnson   Arnold  C.   077-39-7768   (401) 233-7809  27.5');
  127.     writeln('FL:111111111 2222222 33   AAAAAAAAAAA   BBBBBBBBBBBBBB  4444');
  128.     writeln;
  129.     writeln(lineno:2,':',inpline);
  130.     write  ('FL:');
  131.     readln (ruler);
  132.  
  133.     { convert ruler to field number data }
  134.     numflds := 0;
  135.     for i := 1 to length (ruler) do begin
  136.       { convert ruler to upper case }
  137.       ruler[i] := upcase(ruler[i]);
  138.       { determine if position i is in a field }
  139.       fldno := pos(copy(ruler,i,1),'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ');
  140.       if fldno > 0
  141.         then begin { determine whether this position is start, contin, or err }
  142.           if (fldstrt[fldno] < 0) { first occurrence of field }
  143.             then begin
  144.               fldstrt[fldno] := i;
  145.               fldlen[fldno] := 1;
  146.               inc(numflds);
  147.             end
  148.             else if (fldstrt[fldno]+fldlen[fldno] = i) { fld continues }
  149.               then inc(fldlen[fldno])
  150.               else ruler[i] := ' ';
  151.                 { fld number was found non-consecutive, ignore }
  152.         end
  153.         else ruler[i] := ' '; { make it blank if non-field }
  154.     end; { for i }
  155.  
  156.     { ask for delims for each field }
  157.     if ruler = ''
  158.       then begin
  159.         writeln('No Fields.  Ending.');
  160.         close(infile);
  161.       end;
  162.     clrscr;
  163.     writeln('Enter the Open/Close Quote delimiter below the beginning and end');
  164.     writeln('  of each field.  Use Blank for no delimiter. Example:');
  165.     writeln;
  166.     writeln('xx:Johnson   Arnold  C.   077-39-7768   (401) 233-7809  27.5');
  167.     writeln('FL:111111111 2222222 33   AAAAAAAAAAA   BBBBBBBBBBBBBB  4444');
  168.     writeln('QU:"       " "     " ""   "         "   "            "');
  169.     writeln;
  170.     writeln(lineno:2,':',inpline);
  171.     writeln('FL:',ruler);
  172.     write  ('QU:');
  173.     readln (delim);
  174.  
  175.  
  176.     for fldno := 1 to 36 do
  177.       if fldstrt[fldno] > 0
  178.         then begin
  179.           oqdelim[fldno] := copy(delim,fldstrt[fldno],1);
  180.           if oqdelim[fldno] = ' '
  181.             then oqdelim[fldno] := '';
  182.           cqdelim[fldno] := copy(delim,fldstrt[fldno]+fldlen[fldno]-1,1);
  183.           if cqdelim[fldno] = ' '
  184.             then cqdelim[fldno] := '';
  185.         end
  186.         else begin
  187.           oqdelim[fldno] := '';
  188.           cqdelim[fldno] := '';
  189.         end;
  190.  
  191.     { get field separator }
  192.     writeln;
  193.     write('Enter field separator string (usually ,): ');
  194.     readln(fldsep);
  195.     writeln;
  196.     writeln('Enter record separator string (usually nothing): ');
  197.     readln(recsep);
  198.   end; { getparms }
  199.  
  200.  
  201. begin { txt2coma }
  202.  
  203.   getparms;
  204.   clrscr;
  205.  
  206.   { read each line and output as fields }
  207.   lineno := 1; { reset lineno to indicate data lines }
  208.   repeat
  209.     clrscr;
  210.     writeln;
  211.     if keypressed
  212.       then begin
  213.         clrscr;
  214.         writeln('Exit program (Y,N)? ');
  215.         ch := readkey;
  216.         if ch in ['Y','y']
  217.           then begin
  218.             close(infile);
  219.             close(outfile);
  220.             halt;
  221.           end
  222.           else clrscr;
  223.       end;
  224.     writeln('Line Number: ',lineno);
  225.     writeln(inpline);
  226.     fd := '';
  227.     for fldno := 1 to 36 do begin
  228.       if fldstrt[fldno] > 0
  229.         then begin
  230.           write(outfile,fd,oqdelim[fldno],
  231.                          copy(inpline,fldstrt[fldno],fldlen[fldno]),
  232.                          cqdelim[fldno]);
  233.           write(fd,oqdelim[fldno],
  234.                 copy(inpline,fldstrt[fldno],fldlen[fldno]),
  235.                 cqdelim[fldno]);
  236.           fd := fldsep; { set field separator after 1st fld is written }
  237.         end;
  238.     end; { for fldno }
  239.     writeln(outfile);
  240.     writeln;
  241.     readln(infile,inpline);
  242.     inc(lineno);
  243.   until eof(infile);
  244.  
  245.   close(infile);
  246.   close(outfile);
  247.   writeln(pred(lineno), ' Records converted.');
  248.  
  249. end. { txt2coma }