[Back to MAIL SWAG index]  [Back to Main SWAG index]  [Original]

{DAT2TXT v0.90- Free DOS utility: Converts .QWK MESSAGES.DAT to text.}
{$V-,S-}
program DAT2TXT ;
uses dos ;
const
   Seperator = '---------------------------------------------------------------------------' ;
   herald    = '===========================================================================' ;
type
   CharArray = array[1..6] of char ;  { to read in chunks }

   MSGDATHdr = record  { ALSO the format for SWAG files !!! }
      Status   : char ;
      MSGNum   : array [1..7] of char ;
      Date     : array [1..8] of char ;
      Time     : array [1..5] of char ;
      UpTO     : array [1..25] of char ;
      UpFROM   : array [1..25] of char ;
      Subject  : array [1..25] of char ;
      PassWord : array [1..12] of char ;
      ReferNum : array [1..8] of char ;
      NumChunk : CharArray ;
      Alive    : byte ;
      LeastSig : byte ;
      MostSig  : byte ;
      Reserved : array [1..3] of char ;
   end ;

var
   F           : file ;
   txtfile     : text ;

procedure showhelp(problem:byte); {if any *foreseen* errors arise, we are sent}
                             { here to give a little help and exit peacefully }
const
 progdata = 'DAT2TXT v0.90- Free DOS utility: Converts .QWK MESSAGES.DAT to text.';
 progdat2 = '(By SWAG contributors.)';
 usage    = 'Usage:  DAT2TXT infile(s) [/o]';
 usag2    = 'The "/o" causes DAT2TXT to overwrite (not append to) existing messages.txt.';
 note     = 'DOS * and ? wildcards ok with "infile(s)".  Output is always to MESSAGES.TXT.';
var
   message : string[80];
begin
   writeln(progdata);                  { just tell user what this program   }
   writeln(progdat2);                  { is and who wrote it                }
   writeln;
   writeln(usage);
   writeln(usag2);
   writeln(note);
   writeln;
   writeln('Error encountered:');
   case problem of
     1 : message := 'Incorrect number of parameters.';
     { plenty of room for other errors! }
   else
        message := 'Unknown error.';
   end;
   writeln(message);
   halt(problem);
end;

function converttoupper(w : string) : string;
var
   cp  : integer;        {the position of the character to change.}
begin
     for cp := 1 to length(w) do
         w[cp] := upcase(w[cp]);
     converttoupper := w;
end;

function ArrayTOInteger ( B : CharArray ; Len : byte ) : longint ;

var I : byte ;
    S : string ;
    E : integer ;
    T : integer ;

begin
   S := '' ;
   for I := 1 to Len do
      if B[i] <> #32 then S := S + B[i] ;

   Val ( S, T, E );

   if E = 0 then
      ArrayToInteger := T
   else
      ArrayToInteger := 0 ;
end ;

procedure ReadWriteHdr ( var HDR : MSGDatHdr );
begin
   BlockRead ( F, Hdr, 1 );
   if ArrayToInteger ( Hdr.NumChunk, 6 ) <> 0 then
      with Hdr do begin
         writeln ( txtfile, herald );
         write ( txtfile, 'Date: ', Date, ' (', Time, ')' );
         writeln ( txtfile, '' : 23, 'Number: ', MSGNum );
         write ( txtfile, 'From: ', UpFROM );
         writeln ( txtfile, '' : 14, 'Refer#: ', ReferNum );
         write ( txtfile, '  To: ', UpTO );
         write ( txtfile, '' : 15, 'Recvd: ' );
         if Status in ['-', '`', '^', '#'] then
            writeln ( txtfile, 'YES' )
         else
            writeln ( txtfile, 'NO' );
         write ( txtfile, 'Subj: ', Subject );
         writeln ( txtfile, '' : 16, 'Conf: ', '(', (MostSig * 256) + LeastSig, ')' );
         writeln ( txtfile, Seperator );
      end ;
end ;

procedure ReadMSG ( NumChunks : integer );
var
   Buff : array [1..128] of char ;
   J    : integer ;
   I    : byte ;

begin
   for J := 1 to PRED ( NumChunks ) do begin
      BlockRead ( F, Buff, 1 );
      for I := 1 to 128 do
         if Buff [I] = #$E3 then
            writeln ( txtfile )
         else
            write ( txtfile, Buff [I] );
   end ;
end ;

procedure ReadMessage ( HDR : MSGDatHdr ; RelNum : longint ; var Chunks : integer );
begin
   Seek ( F, RelNum - 1 );
   ReadWriteHdr ( HDR );
   Chunks := ArrayToInteger ( HDR.NumChunk, 6 );
   if Chunks <> 0 then begin
      ReadMsg ( Chunks );
      writeln ( txtfile );
   end
   else
      Chunks := 1 ;
end ;

var
   MSGHdr   : MSGDatHdr ;
   repordat : boolean ;
   ch       : char ;
   count    : integer ;
   chunks   : integer ;
   defsavefile : string ;
   fileinfo : searchrec ;
   fdt      : longint ;
   ps1,ps2  : string [2] ;
   fileexists,
   overwrite  : boolean ;
   response   : char ;

   dpath, tpath  : pathstr ;
   {epath & dpath are fully qualified pathnames of .dat & .txt files}

   ddir,  tdir   : dirstr ;
   dname, tname  : namestr ;
   d_ext, t_ext  : extstr ;
   txtfileinfo   : searchrec ;

begin
   if ( paramcount < 1) or ( paramcount > 2) then showhelp(1);
   ps1 := converttoupper ( paramstr (1));
   if (ps1 = '/H') or (ps1 = '/?') or
      (ps1 = '-H') or (ps1 = '-?') then showhelp(0);

   DefSaveFile := '' ;
   ps2 := '/A' ;
   if paramcount > 1 then ps2 := paramstr ( 2 );
   overwrite := (upcase ( ps2[2] ) = 'O');
   dpath := fexpand ( paramstr ( 1 ) );
   fsplit ( dpath, ddir, dname, d_ext );
   { break up path into components }
   findfirst ( dpath, anyfile, fileinfo );
   while doserror = 0 do begin
      fsplit ( fexpand ( fileinfo.name ), tdir, tname, t_ext );
      dpath := ddir + fileinfo.name ;
      tpath := ddir + tname + '.TXT' ;
      Assign ( F, dpath );
      { whatever file .. ( MESSAGES.DAT for .QWK ) }
      Reset ( F, SizeOf ( MsgHdr ) );

      assign ( txtfile, tpath );
{$i-} reset ( txtfile ); {$i+}
      fileexists := (ioresult = 0);

      if fileexists then close ( txtfile );
      if fileexists and ( not overwrite ) then
         append ( txtfile )
      else
         rewrite ( txtfile );

      write ( 'DAT2TXT: ', dpath, ' to: ', tpath );
      Count := 2 ;                     { start at RECORD #2 }
      while Count < FileSize ( F ) do begin
         ReadMessage ( MSGHdr, Count, Chunks );
         INC ( Count, Chunks );
      end ;

      getftime ( F, fdt );
      close ( F ); close ( txtfile ); reset ( txtfile );
      setftime ( txtfile , fdt );
      close ( txtfile );

      writeln ( ', done!' );
      findnext ( fileinfo );
   end ;
end.

[Back to MAIL SWAG index]  [Back to Main SWAG index]  [Original]