home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / vrac / o2spd102.zip / OLX2SPD.PAS < prev    next >
Pascal/Delphi Source File  |  1994-09-14  |  15KB  |  524 lines
  1. {$i-}PROGRAM convert_olx_folders_to_speed_folders;
  2. USES dos;
  3. CONST
  4.   progdesc = 'OLX2SPD - Free DOS utility: Converts folders from OLX to SPEED 1.40 format.';
  5.   author   = 'v1.02: September 14, 1994. (c) 1994 by David Daniel Anderson - Reign Ware.';
  6.   OLXHeader = '|OLX$SOM|';
  7.   colon = #58;
  8.   QWKField = 25;
  9.  
  10. TYPE
  11.   stringQWK = STRING[QWKField];
  12.   array6   = ARRAY[1..6] OF char;
  13.   array8   = ARRAY[1..8] OF char;
  14.  
  15.   OLX_rec=RECORD
  16.     BBSID      : stringQWK;
  17.     conf_numb  : word;
  18.     conf_name  : stringQWK;
  19.     msgnum     : ARRAY[1..7] OF char;
  20.     refernum   : array8;
  21.     private,
  22.     receipt,
  23.     ExHeader   : boolean;
  24.     msgdate    : array8;
  25.     msgtime    : array6;
  26.     whofrom,
  27.     whoto,
  28.     subject    : stringQWK;
  29.     readFlag   : boolean;
  30.     lsubject   : STRING[60]; { these are not in original, but added by me }
  31.     lsboole    : boolean;    { in order to deal with long subject lines   }
  32.   END;                       { lsboole=TRUE if subject line was >25 chars }
  33. (*
  34.   CNF_rec=RECORD
  35.     statusFlag,
  36.     letterA    : char;
  37.     conf_numb  : word;
  38.     conf_name,
  39.     BBSID      : stringQWK;
  40.     msgdate    : array8;
  41.     msgtime    : array6;
  42.     refernum   : array8;
  43.     msglines   : word;
  44.   END;
  45.  
  46.   IDX_rec=RECORD
  47.     msgoffset  : longint;
  48.     whofrom,
  49.     whoto      : stringQWK;
  50.     msgnum     : array[1..7]  of char;
  51.     subject    : stringQWK;
  52.     SPEEDread,
  53.     PermOrKill : char;
  54.   END;
  55. *)
  56.  
  57. PROCEDURE showhelp (problem :byte);
  58. {----
  59.  If any *foreseen* errors arise, we are sent
  60.   here to give a little help and exit (relatively) peacefully
  61. ----}
  62. CONST
  63.   usage    = 'Usage:  OLX2SPD folders(s)_to_convert[.SAV]';
  64. VAR
  65.   message : STRING[79];
  66. BEGIN
  67.   writeln;
  68.   IF (problem > 0) THEN BEGIN
  69.     CASE (problem) OF
  70.       3 : message:='No files found.  First parameter must be a valid file specification.';
  71.       4 : message:='Invalid first line of .IDX file.';
  72.       5 : message:='The current .TMP temporary file already exists.  Rename or delete it.';
  73.       6 : message:='You cannot just specify a path, add "*.*" or "\*.*" for all files.';
  74.       7 : message:='Error opening, closing, or renaming a file.  Original may be renamed!'
  75.     ELSE  message:='Undefined error.'
  76.     END;
  77.     writeln (#7,'Error encountered:'); writeln (message); writeln;
  78.   END;
  79.   writeln (usage);
  80.   halt (problem);
  81. END;
  82.  
  83. PROCEDURE iocheck (iores :byte);
  84. BEGIN
  85.   IF (iores <> 0) THEN showhelp (7);
  86. END;
  87.  
  88. FUNCTION nameof (fn :STRING):STRING;
  89. BEGIN
  90.   IF (pos ('.', fn) > 0) THEN
  91.     nameof:=copy (fn, 1, (pos ('.', fn)-1))
  92.   ELSE
  93.     nameof:=fn;
  94. END;
  95.  
  96. FUNCTION getfsize (filename :STRING) :longint;
  97. VAR
  98.   sr : searchrec;
  99. BEGIN
  100.   findfirst (filename, anyfile, sr);
  101.   IF (doserror = 0) THEN
  102.     getfsize:=sr.size
  103.   ELSE
  104.     getfsize:=-1;
  105. END;
  106.  
  107. PROCEDURE openolx (VAR olxf :text; fname :STRING);
  108. VAR
  109.   olxline   : STRING;
  110. BEGIN
  111.   assign (olxf, fname+'.sav');
  112.   reset (olxf);      iocheck (ioresult);
  113.   REPEAT                               { find the first OLXHeader }
  114.     readln (olxf, olxline);
  115.   UNTIL (eof (olxf) OR (olxline = OLXHeader)) ;
  116. END;
  117.  
  118. PROCEDURE openidx (VAR idxf :text; fname :STRING; VAR tmsgs :word);
  119. VAR
  120.   nummsgs : STRING;
  121.   valerr  : integer;
  122. BEGIN
  123.   assign (idxf, fname+'.idx');
  124.   reset (idxf);
  125.   IF (ioresult <> 0) THEN BEGIN
  126.     rewrite (idxf);  iocheck (ioresult);
  127.     tmsgs:=0;
  128.     writeln (idxf, '00000');
  129.     flush (idxf);
  130.   END
  131.   ELSE BEGIN
  132.     readln (idxf, nummsgs);
  133.     val (nummsgs, tmsgs, valerr);
  134.     IF ((length (nummsgs) <> 5) OR (valerr <> 0)) THEN
  135.       showhelp (4);
  136.     close (idxf);    iocheck (ioresult);
  137.     append (idxf);   iocheck (ioresult);
  138.   END;
  139. END;
  140.  
  141. PROCEDURE resetcnf (VAR cnff :text; fname :STRING; VAR fsize :longint);
  142. BEGIN
  143.   fsize:=(getfsize (fname+'.cnf'));
  144.   assign (cnff, fname+'.cnf');
  145.   IF (fsize =-1) THEN BEGIN 
  146.     rewrite (cnff);  iocheck (ioresult);
  147.     fsize:=0;
  148.   END
  149.   ELSE BEGIN
  150.     append (cnff);   iocheck (ioresult);
  151.   END;
  152. END;
  153.  
  154. PROCEDURE opentmp (VAR tfile :text; fname :STRING);
  155. BEGIN
  156.   assign (tfile, fname+'.tmp');
  157.   append (tfile);
  158.   IF (ioresult = 0) THEN
  159.     showhelp (5)
  160.   ELSE BEGIN 
  161.     rewrite (tfile); iocheck (ioresult);
  162.   END;
  163. END;
  164.  
  165. FUNCTION leadingzero (w :Word; l :byte) : STRING;
  166. VAR
  167.   s : STRING;
  168. BEGIN
  169.   Str (w :0, s);
  170.   WHILE (Length (s) < l) DO
  171.     s:='0'+s;
  172.   LeadingZero:=s;
  173. END;
  174.  
  175. FUNCTION yesno (yn :STRING) :boolean;
  176. BEGIN
  177.   IF (yn = 'No') THEN
  178.     yesno:=FALSE
  179.   ELSE
  180.     yesno:=TRUE;
  181. END;
  182.  
  183. FUNCTION olxdate (datestr :STRING):STRING;
  184. BEGIN
  185.   olxdate:=copy (datestr, 6, 2)+'-'+
  186.     copy (datestr, 9, 2)+'-'+
  187.     copy (datestr, 3, 2);
  188. END;
  189.  
  190. FUNCTION olxtime (timestr :STRING):STRING;
  191. VAR
  192.   ampm   : char;
  193.   hour   : byte;
  194.   valerr : integer;
  195.   temp   : byte;
  196. BEGIN
  197.   val (copy (timestr, 1, 2), temp, valerr);
  198.   IF (temp > 11)
  199.     THEN ampm:='p'
  200.     ELSE ampm:='a';
  201.   IF (temp > 12) THEN
  202.     temp:=temp MOD 12;
  203.   olxtime:=leadingzero (temp, 2)+colon+copy (timestr, 4, 2)+ampm;
  204. END;
  205.  
  206. PROCEDURE init_info (VAR olxr :olx_rec);
  207. BEGIN
  208.   WITH olxr DO BEGIN
  209.     fillchar (bbsid[1], sizeof (bbsid), 0);
  210.     conf_numb:=0;
  211.     fillchar (conf_name[1], sizeof (conf_name), 0);
  212.     fillchar (msgnum[1], sizeof (msgnum), 32);
  213.     fillchar (refernum[1], sizeof (refernum), 32);
  214.     private:=FALSE;
  215.     receipt:=FALSE;
  216.     ExHeader:=FALSE;
  217.     fillchar (msgdate[1], sizeof (msgdate), 32);
  218.     fillchar (msgtime[1], sizeof (msgtime), 32);
  219.     fillchar (whofrom[1], QWKField, 32);
  220.     fillchar (whoto[1], QWKField, 32);
  221.     fillchar (subject[1], QWKField, 32);
  222.     readFlag:=FALSE;
  223.     lsubject:='';
  224.     lsboole:=FALSE;
  225.   END;
  226. END;
  227.  
  228. FUNCTION fillstring (v :STRING) :stringQWK;
  229. VAR
  230.   count : byte;
  231.   s : stringQWK;
  232. BEGIN
  233.   s[0]:=chr (25);
  234.   fillchar (s[1], 25, 32);
  235.   FOR count:=1 TO length (v) DO
  236.     IF (count <= QWKField) THEN
  237.       s[count]:=v[count];
  238.   FillString:=s;
  239. END;
  240.  
  241. PROCEDURE read_info (VAR olxf :text; VAR olxr :olx_rec);
  242. CONST
  243.   comma=#44;
  244. VAR
  245.   current_line,
  246.   keyword,
  247.   varword,
  248.   tempstr      : STRING; { used to convert date & time strings to arrays }
  249.   count,
  250.   colonpos     : byte;
  251.   valerr       : integer;
  252. BEGIN
  253.   REPEAT
  254.     readln (olxf, current_line);
  255.     colonpos:=pos (colon, current_line);
  256.     IF (colonpos > 1) THEN BEGIN 
  257.       keyword:=copy (current_line, 1, colonpos-1);
  258.       varword:=copy (current_line, colonpos+2, 60-(colonpos+1));
  259.       WITH olxr DO
  260.         IF (keyword = 'BBS') THEN
  261.           BBSID:=varword
  262.         ELSE
  263.           IF (keyword = 'Conference') THEN BEGIN 
  264.             val (copy (varword, 1, (pos (comma, varword)-1)), conf_numb, valerr);
  265.             conf_name:=copy (varword, 
  266.               (pos (comma, varword)+1), length (varword)-pos (comma, varword));
  267.           END
  268.         ELSE
  269.           IF (keyword = 'Number') THEN
  270.             FOR count:=1 TO length (varword) DO
  271.               msgnum[count]:=varword[count]
  272.         ELSE
  273.           IF (keyword = 'Reply-to') THEN
  274.             FOR count:=1 TO length (varword) DO
  275.               refernum[count]:=varword[count]
  276.         ELSE
  277.           IF (keyword = 'Private') THEN
  278.             private:=yesno (varword)
  279.         ELSE
  280.           IF (keyword = 'Receipt') THEN
  281.             receipt:=yesno (varword)
  282.         ELSE
  283.           IF (keyword = 'ExHeader') THEN
  284.             ExHeader:=yesno (varword)
  285.         ELSE
  286.           IF (keyword = 'Date') THEN BEGIN 
  287.             tempstr:=olxdate (copy (varword, 1, (pos (comma, varword)-1)));
  288.             FOR count:=1 TO length (tempstr) DO
  289.               msgdate[count]:=tempstr[count];
  290.             tempstr:=olxtime (copy (varword, 
  291.               (pos (comma, varword)+1), length (varword)-pos (comma, varword)));
  292.             FOR count:=1 TO length (tempstr) DO
  293.               msgtime[count]:=tempstr[count];
  294.           END
  295.         ELSE
  296.           IF (keyword = 'From') THEN
  297.             whofrom:=FillString (varword)
  298.         ELSE
  299.           IF (keyword = 'To') THEN
  300.             whoto:=FillString (varword)
  301.         ELSE
  302.           IF (keyword = 'Subject') THEN BEGIN
  303.             subject:=FillString (varword);
  304.             IF (length (varword) > QWKField) THEN BEGIN
  305.               lsubject:=varword;
  306.               lsboole:=TRUE;
  307.             END
  308.           END
  309.         ELSE
  310.           IF (keyword = 'Flags') THEN
  311.             IF (copy (varword, 1, 4) = 'Read') THEN readFlag:=TRUE
  312.             ELSE readFlag:=FALSE
  313.     END;
  314.   UNTIL (eof (olxf) OR (current_line = '')) ;
  315. END;
  316.  
  317. PROCEDURE writemsg (VAR olxf, tmpf :text; VAR lines :word);
  318. VAR
  319.   nextline,
  320.   thisline : STRING;
  321. BEGIN
  322.   lines:=0;
  323.   readln (olxf, thisline);
  324.   readln (olxf, nextline);
  325.   WHILE ((NOT eof (olxf)) AND (nextline <> OLXHeader)) DO BEGIN
  326.     writeln (tmpf, thisline);
  327.     inc (lines);
  328.     thisline:=nextline;
  329.     readln (olxf, nextline);
  330.   END;
  331.   IF (eof (olxf)) THEN BEGIN 
  332.     writeln (tmpf, thisline);
  333.     inc (lines);
  334.   END;
  335. END;
  336.  
  337. PROCEDURE writecnf (VAR cfile, tfile :text; olxr :olx_rec; lines :word);
  338. VAR
  339.   lslen   : byte;
  340.   msgl    : STRING;
  341.   PubPriv : char;
  342. BEGIN
  343. (*
  344.   writeln (?file, receipt);
  345.   writeln (?file, ExHeader);  { I doubt that SPEED uses this OLX stuff }
  346. *)
  347. { QWK format settings, SPEED seems to have the private ones reversed ... }
  348. { ' ' = public, unread   - corresponds to (NOT private AND NOT readFlag) }
  349. { '-' = public, read     - corresponds to (NOT private AND     readFlag) }
  350. { '+' = private, unread  - corresponds to (    private AND NOT readFlag) }
  351. { '*' = private, read    - corresponds to (    private AND     readFlag) }
  352.  
  353.   WITH olxr DO BEGIN
  354.     IF ((NOT private) AND (NOT readFlag)) THEN
  355.       PubPriv:=#32
  356.     ELSE
  357.       IF ((NOT private) AND (readFlag)) THEN
  358.         PubPriv:='-'
  359.     ELSE
  360.       IF ((private) AND (NOT readFlag)) THEN
  361.         PubPriv:='*'  { I have kludged this for SPEED compatibility }
  362.     ELSE
  363.       { IF (private) and (readFlag) THEN }
  364.       PubPriv:='+';   { I have kludged this for SPEED compatibility }
  365.  
  366.     writeln (cfile, PubPriv+'A');
  367.     writeln (cfile, colon, conf_numb);
  368.     writeln (cfile, colon, conf_name);
  369.     writeln (cfile, colon, BBSID);
  370.     writeln (cfile, msgdate);
  371.     writeln (cfile, msgtime);
  372.     writeln (cfile, refernum);
  373.     IF (lsboole) THEN inc (lines);
  374.     writeln (cfile, lines);
  375.  
  376.     close (cfile);    iocheck (ioresult);
  377.     append (cfile);   iocheck (ioresult);
  378.     close (tfile);    iocheck (ioresult);
  379.     reset (tfile);    iocheck (ioresult);
  380.     IF (lsboole) THEN BEGIN
  381.       lslen:=length (lsubject);
  382.       lsubject[0]:=chr (60);
  383.       IF (lslen < 60) THEN
  384.         fillchar (lsubject[lslen+1], 60-lslen, #32);
  385.       writeln (cfile, #255, '@SUBJECT:', lsubject, 'N');
  386.     END;
  387.     WHILE (NOT eof (tfile)) DO BEGIN
  388.       readln (tfile, msgl);
  389.       writeln (cfile, msgl);
  390.     END;
  391.   END;
  392. END;
  393.  
  394. PROCEDURE writeidx (VAR ifile :text; olxr :olx_rec; cnf_filesize :longint);
  395. BEGIN
  396.   WITH olxr DO BEGIN
  397.     writeln (ifile, cnf_filesize);
  398.     writeln (ifile, whofrom);
  399.     writeln (ifile, whoto);
  400.     writeln (ifile, msgnum);
  401.     writeln (ifile, subject);
  402.     writeln (ifile, 'Y ');        { Y = read by SPEED, then permanent/kill }
  403.   END;              { "Read" and "normal" forced for simplicity and safety }
  404. END;
  405.  
  406. PROCEDURE fixidx (VAR ifile, tfile :text; tmsgs :word);
  407. VAR
  408.   msgl : STRING;
  409. BEGIN
  410.   reset (ifile);    iocheck (ioresult);
  411.   rewrite (tfile);  iocheck (ioresult);
  412.   readln (ifile, msgl);
  413.   writeln (tfile, leadingzero (tmsgs, 5));
  414.   WHILE (NOT eof (ifile)) DO BEGIN
  415.     readln (ifile, msgl);
  416.     writeln (tfile, msgl);
  417.   END;
  418.   close (ifile);    iocheck (ioresult);
  419.   close (tfile);    iocheck (ioresult);
  420. END;
  421.  
  422. PROCEDURE swapnames (VAR ifile, tfile :text; tname :pathstr);
  423. BEGIN
  424.   rename (ifile, tname+'.swp');  iocheck (ioresult);
  425.   rename (tfile, tname+'.idx');  iocheck (ioresult);
  426.   erase (ifile);                 iocheck (ioresult);
  427. END;
  428.  
  429. PROCEDURE matchdates (VAR cfile, tfile :text);
  430. VAR
  431.   filedt    : longint;    { file date and time, to match dates     }
  432. BEGIN
  433.   reset (cfile);    iocheck (ioresult);
  434.   reset (tfile);    iocheck (ioresult);
  435.   getftime (cfile, filedt);
  436.   setftime (tfile, filedt);
  437.   close (cfile);    iocheck (ioresult);
  438.   close (tfile);    iocheck (ioresult);
  439. END;
  440.  
  441. VAR
  442.   olx_file,
  443.   cnf_file,
  444.   idx_file,
  445.   tmp_file  : text;
  446.   info      : OLX_rec;
  447. (*
  448.   cnf       : CNF_rec;
  449.   idx       : IDX_rec;
  450. *)
  451.   fpath     : pathstr;    { source file path,          }
  452.   fdir      : dirstr;     {             directory,     }
  453.   folder    : namestr;    {             name,          }
  454.   fext      : extstr;     {             extension.     }
  455.   dirinfo   : searchrec;  { contains filespec info.    }
  456.  
  457.   textname,
  458.   fname     : STRING[8];  {             name, again    }
  459.  
  460.   cnf_size  : longint;
  461.   msglines,               { number of lines in the current message }
  462.   initmsgs,
  463.   totalmsgs,              { total number of messages per folder    }
  464.   numdone   : word;       { numdone is number of files processed   }
  465.  
  466. BEGIN
  467.   writeln (progdesc);
  468.   writeln (author);
  469.   IF (paramcount <> 1) THEN showhelp (0);
  470.   fpath:=paramstr (1);
  471.   IF (fpath[1] IN ['/', '-']) THEN showhelp (0);
  472.   fsplit (fexpand (fpath), fdir, folder, fext);
  473.   IF (folder = '') THEN showhelp (6);
  474.   
  475.   findfirst (fdir+folder+'.sav', archive, dirinfo);
  476.   IF (doserror <> 0) THEN showhelp (3);
  477.   writeln;
  478.   writeln ('Converting folders from OLX to SPEED in directory: ', fdir);
  479.   numdone:=0;
  480.   
  481.   WHILE (doserror = 0) DO BEGIN 
  482.     fname:=nameof (dirinfo.name);
  483.     textname:=fname;
  484.     textname[0]:=chr (8);
  485.     fillchar (textname[length (fname)+1], 8-length (fname), #46);
  486.     
  487.     write ('Converting folder: ', textname);
  488.     inc (numdone);
  489.     
  490.     openolx (olx_file, fdir+fname);
  491.     openidx (idx_file, fdir+fname, totalmsgs);
  492.     initmsgs:=totalmsgs;
  493.     
  494.     WHILE (NOT eof (olx_file)) DO BEGIN 
  495.       init_info (info);
  496.       read_info (olx_file, info);
  497.       opentmp (tmp_file, fdir+fname);
  498.       writemsg (olx_file, tmp_file, msglines);
  499.       resetcnf (cnf_file, fdir+fname, cnf_size);
  500.       writecnf (cnf_file, tmp_file, info, msglines);
  501.       
  502.       close (cnf_file);  iocheck (ioresult);
  503.       close (tmp_file);  iocheck (ioresult);
  504.       erase (tmp_file);  iocheck (ioresult);
  505.       
  506.       writeidx (idx_file, info, cnf_size);
  507.       inc (totalmsgs);
  508.     END;
  509.     
  510.     close (olx_file);    iocheck (ioresult);
  511.     close (idx_file);    iocheck (ioresult);
  512.     fixidx (idx_file, tmp_file, totalmsgs); { put num of msgs at start of IDX }
  513.     swapnames (idx_file, tmp_file, fdir+fname);
  514.  
  515.     matchdates (cnf_file, tmp_file);   { tmp_file is actually the .idx file }
  516.     writeln (', added ', totalmsgs-initmsgs :2,
  517.           ' message(s) to ', initmsgs :2,
  518.           ', for a total of ', totalmsgs :2, '.');
  519.     findnext (dirinfo);
  520.   END;
  521.   writeln ('Converted ', numdone, ' folder(s).');
  522. END.
  523.  
  524.