home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FAQ-S.ZIP / CNVTUSER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-20  |  10.1 KB  |  384 lines
  1. {$R-,S+,I+,D+,F-,V-,B-,N-,L-}
  2. {$M 7000,0,0 }
  3.  
  4. program convert;
  5.  
  6. uses crt,gentypes,configrt,gensubs,statret;
  7.  
  8. type ouserrec=record
  9.        handle:mstr;
  10.        realname:string[41];
  11.        note:lstr;
  12.        macro1,macro2,macro3:lstr;
  13.        yesvote,novote,abstain:integer;
  14.        password:sstr;
  15.        sex:string[1];
  16.        age:integer;
  17.        citystate:string[34];
  18.        country:string[20];
  19.        zipcode:string[10];
  20.        phonenum:string[10];
  21.        laston:longint;
  22.        numon,timetoday,nup,ndn,nbu,uploads,downloads:integer;
  23.        totaltime:real;
  24.        voted:voteset;
  25.        udlevel,udpoints,level,emailannounce,beepedpwd,infoform1,infoform2,
  26.        infoform3,infoform4,infoform5:integer;
  27.        bstatuscolor,
  28.        bordercolor,regularcolor,promptcolor,statcolor,inputcolor,displaylen:byte;
  29.        lastmessages,lastups,lastgfiles,lastdbases,integer1:integer;
  30.        downk,upk:longint;
  31.        gflevel,gfuploads,gfdownloads:integer;
  32.        menutype,byte1:byte;
  33.        defproto,char1:char;
  34.        hack:byte;
  35.        config:set of configtype;
  36.        filelister:set of filelisttype;
  37.        newscanconfig,access1,access2:set of byte;
  38.        timeinstorage:word;
  39.        averagecps:integer;
  40.        lastread:array [0..255] of word;
  41.        newvoteyes,newvoteno:integer;
  42.        newvoteit:array [1..255] of integer;
  43.        defcon:array [0..5] of boolean;
  44.      end;
  45.  
  46. type newuserrec=record
  47.        handle:mstr;
  48.        realname:string[41];
  49.        note:lstr;
  50.        macro1,macro2,macro3:lstr;
  51.        yesvote,novote,abstain:integer;
  52.        password:sstr;
  53.        sex:string[1];
  54.        age:integer;
  55.        citystate:string[34];
  56.        country:string[20];
  57.        zipcode:string[10];
  58.        phonenum:string[10];
  59.        laston:longint;
  60.        numon,timetoday,nup,ndn,nbu,uploads,downloads:integer;
  61.        totaltime:real;
  62.        voted:voteset;
  63.        udlevel,udpoints,level,emailannounce,beepedpwd,infoform1,infoform2,
  64.        infoform3,infoform4,infoform5:integer;
  65.        bstatuscolor,
  66.        bordercolor,regularcolor,promptcolor,statcolor,inputcolor,displaylen:byte;
  67.        lastmessages,lastups,lastgfiles,lastdbases,integer1:integer;
  68.        downk,upk:longint;
  69.        gflevel,gfuploads,gfdownloads:integer;
  70.        menutype,byte1:byte;
  71.        defproto,char1:char;
  72.        hack:byte;
  73.        config:set of configtype;
  74.        filelister:set of filelisttype;
  75.        newscanconfig,access1,access2:set of byte;
  76.        timeinstorage:word;
  77.        averagecps:integer;
  78.        lastread:array [0..255] of word;
  79.        newvoteyes,newvoteno:integer;
  80.        newvoteit:array [1..255] of integer;
  81.        defcon:array [0..maxconf] of boolean;
  82.      end;
  83.  
  84. var windowx1,windowy1,windowx2,windowy2,scrnwidth,midpoint:integer;
  85.     when,shoulderase:boolean;
  86.  
  87. procedure killfile (newname:string);
  88. var f2:file;
  89.     x:integer;
  90. begin
  91.   assign (f2,newname);
  92.   {$I-} erase (f2); {$I+}
  93.   x:=ioresult
  94. end;
  95.  
  96. procedure window (x1,y1,x2,y2:integer);
  97. begin
  98.   windowx1:=x1;
  99.   windowy1:=y1;
  100.   windowx2:=x2;
  101.   windowy2:=y2;
  102.   scrnwidth:=x2-x1+1;
  103.   midpoint:=scrnwidth div 2;
  104.   crt.window (x1,y1,x2,y2)
  105. end;
  106.  
  107. procedure center (y:integer; l:string);
  108. begin
  109.   gotoxy (1,y);
  110.   clreol;
  111.   gotoxy (midpoint-length(l) div 2,y);
  112.   write (l)
  113. end;
  114.  
  115. procedure returntodos;
  116. begin
  117.   window (1,1,80,25);
  118.   textcolor (7);
  119.   textbackground (0);
  120.   gotoxy (1,25);
  121.   clreol;
  122.   gotoxy (1,24);
  123.   clreol;
  124.   halt
  125. end;
  126.  
  127. procedure topmessage (x:string; printalso:boolean);
  128. var xx,yy:integer;
  129. begin
  130.   xx:=wherex;
  131.   yy:=wherey;
  132.   window (1,1,80,25);
  133.   gotoxy (1,6);
  134.   textcolor (15);
  135.   textbackground (1);
  136.   clreol;
  137.   window (3,1,78,25);
  138.   textcolor (14);
  139.   textbackground (0);
  140.   center (4,x);
  141.   window (3,8,78,21);
  142.   gotoxy (xx,yy);
  143.   textcolor (12);
  144.   textbackground (0);
  145.   if printalso then writeln (^M^J,x,^M^J);
  146. end;
  147.  
  148. procedure divider;
  149. begin
  150.   writeln;
  151.   writeln ('────────────────────────────────────────────────────────────────────────────');
  152. end;
  153.  
  154. procedure init;
  155. var cnt:integer;
  156. begin
  157.   checksnow:=true;
  158.   textmode (CO80);
  159.   textcolor (15);
  160.   textbackground (1);
  161.   window (1,1,80,25);
  162.   for cnt:=1 to 46 do begin
  163.     gotoxy (1,cnt div 2);         write (' ');
  164.     gotoxy (80,cnt div 2);        write (' ');
  165.     gotoxy (cnt,1);               write ('  ');
  166.     gotoxy (79-cnt,1);            write ('  ');
  167.     gotoxy (cnt,23);              write ('  ');
  168.     gotoxy (79-cnt,23);           write ('  ');
  169.     delay (10);
  170.   end;
  171.   center (1,'FAQ User Conversion Utility');
  172.   center (2,'Version 1.01 to Version 1.02');
  173.   gotoxy (1,1);
  174.   textcolor (15);
  175.   textbackground (0);
  176.   topmessage ('',false);
  177.   clrscr;
  178. end;
  179.  
  180. procedure ensureconfigexists;
  181. var f:file;
  182. begin
  183.   topmessage ('Searching for SETUP.CFG',false);
  184.   assign (f,'SETUP.CFG');
  185.   {$I-} reset (f); {$I+}
  186.   if ioresult<>0 then begin
  187.     writeln ('Sorry!  I can''t seem to locate your SETUP.CFG file.');
  188.     writeln ('This means that either:');
  189.     writeln ('  1. You aren''t running CONVERT from your FAQ directory');
  190.     writeln ('  2. You haven''t been using an old version and you don''t need to convert');
  191.     writeln;
  192.     writeln ('If you have been running an old version, please change to your');
  193.     writeln ('FAQ directory and run this program again.');
  194.     writeln;
  195.     writeln ('If you haven''t been using an old version, then you don''t need this program!');
  196.     returntodos
  197.   end;
  198.   close (f)
  199. end;
  200.  
  201. procedure readconfig;        { Shouldn't check version code }
  202. var q:file of configsettype;
  203. begin
  204.   topmessage ('Reading SETUP.CFG',false);
  205.   assign (q,'SETUP.CFG');
  206.   reset (q);
  207.   read (q,configset);
  208.   close (q)
  209. end;
  210.  
  211. procedure writeconfig;
  212. var q:file of configsettype;
  213. begin
  214.   assign (q,'SETUP.CFG');
  215.   rewrite (q);
  216.   write (q,configset);
  217.   close (q)
  218. end;
  219.  
  220. procedure ensurenotsecondtime;
  221. begin
  222.   if versioncode=thisversioncode then begin
  223.     topmessage ('WARNING!  You may have already converted',false);
  224.     writeln ('It appears that you may have already converted.');
  225.     writeln ('It is important that you do not try to convert twice!');
  226.     writeln;
  227.     write ('Are you sure you wish to convert [y/n]: ');
  228.     if upcase(readkey)='Y'
  229.       then writeln ('Yes')
  230.       else returntodos
  231.   end;
  232.   divider
  233. end;
  234.  
  235. procedure shouldierase;
  236. var k:char;
  237. begin
  238.   topmessage ('Keep old disk files?',false);
  239.   writeln ('In the conversion process, I ordinarily simply remove the old USERS File');
  240.   writeln ('of FAQ various data files.  However, if you wish, I will keep');
  241.   writeln ('the old data files, with an extension of ".OLD".');
  242.   writeln;
  243.   write ('Should I KEEP the old data files [y/n]: ');
  244.   repeat
  245.     k:=upcase(readkey)
  246.   until k in ['Y','N'];
  247.   shoulderase:=k='N';
  248.   if shoulderase
  249.     then write ('No, erase')
  250.     else write ('Yes, keep');
  251.   writeln (' old disk files');
  252.   divider
  253. end;
  254.  
  255. procedure convertuserfile;
  256. var uf:file of userrec;
  257.     ouf:file of ouserrec;
  258.     ou:ouserrec;
  259.     u:userrec;
  260.     k:char;
  261.     cnt,i,ii:integer;
  262. begin
  263.   topmessage ('Converting user list',true);
  264.   assign (ouf,bbsdatadir+'users.dat');
  265.   killfile (bbsdatadir+'users.old');
  266.   {$I-} rename (ouf,bbsdatadir+'users.old'); {$I+}
  267.   if ioresult<>0 then begin
  268.     writeln ('I can''t find the user list!');
  269.     writeln ('Press any key to continue...');
  270.     k:=readkey;
  271.     divider;
  272.     exit
  273.   end;
  274.   reset (ouf);
  275.   assign (uf,bbsdatadir+'users.dat');
  276.   rewrite (uf);
  277.   cnt:=0;
  278.   while not eof(ouf) do begin
  279.     read (ouf,ou);
  280.     with u do begin
  281.        handle:=ou.handle;
  282.        realname:=ou.realname;
  283.        note:=ou.note;
  284.        macro1:=ou.macro1;
  285.        macro2:=ou.macro2;
  286.        macro3:=ou.macro3;
  287.        yesvote:=ou.yesvote;
  288.        novote:=ou.novote;
  289.        abstain:=ou.abstain;
  290.        password:=ou.password;
  291.        sex:=ou.sex;
  292.        age:=ou.age;
  293.        citystate:=ou.citystate;
  294.        country:=ou.country;
  295.        zipcode:=ou.zipcode;
  296.        phonenum:=ou.phonenum;
  297.        laston:=ou.laston;
  298.        numon:=ou.numon;
  299.        timetoday:=ou.timetoday;
  300.        nup:=ou.nup;
  301.        ndn:=ou.ndn;
  302.        nbu:=ou.nbu;
  303.        uploads:=ou.uploads;
  304.        downloads:=ou.downloads;
  305.        totaltime:=ou.totaltime;
  306.        voted:=ou.voted;
  307.        udlevel:=ou.udlevel;
  308.        udpoints:=ou.udpoints;
  309.        level:=ou.level;
  310.        emailannounce:=ou.emailannounce;
  311.        beepedpwd:=ou.beepedpwd;
  312.        infoform1:=ou.infoform1;
  313.        infoform2:=ou.infoform2;
  314.        infoform3:=ou.infoform3;
  315.        infoform4:=ou.infoform4;
  316.        infoform5:=ou.infoform5;
  317.        bstatuscolor:=ou.bstatuscolor;
  318.        bordercolor:=ou.bordercolor;
  319.        regularcolor:=ou.regularcolor;
  320.        promptcolor:=ou.promptcolor;
  321.        statcolor:=ou.statcolor;
  322.        inputcolor:=ou.inputcolor;
  323.        displaylen:=ou.displaylen;
  324.        lastmessages:=ou.lastmessages;
  325.        lastups:=ou.lastups;
  326.        lastgfiles:=ou.lastgfiles;
  327.        lastdbases:=ou.lastdbases;
  328.        integer1:=ou.integer1;
  329.        downk:=ou.downk;
  330.        upk:=ou.upk;
  331.        gflevel:=ou.gflevel;
  332.        gfuploads:=ou.gfuploads;
  333.        gfdownloads:=ou.gfdownloads;
  334.        menutype:=ou.menutype;
  335.        byte1:=ou.byte1;
  336.        defproto:=ou.defproto;
  337.        char1:=ou.char1;
  338.        hack:=ou.hack;
  339.        config:=ou.config;
  340.        filelister:=ou.filelister;
  341.        newscanconfig:=ou.newscanconfig;
  342.        access1:=ou.access1;
  343.        access2:=ou.access2;
  344.        timeinstorage:=ou.timeinstorage;
  345.        averagecps:=ou.averagecps;
  346.        for i:=1 to 255 do
  347.        lastread[i]:=ou.lastread[i];
  348.        newvoteyes:=ou.newvoteyes;
  349.        newvoteno:=ou.newvoteno;
  350.        for ii:=1 to 255 do
  351.        newvoteit[ii]:=ou.newvoteit[ii];
  352.        for i:=1 to 5 do begin
  353.        defcon[i]:=ou.defcon[i];
  354.        defcon[i+5]:=false;
  355.        end;
  356.     end;
  357.     write (uf,u);
  358.     cnt:=cnt+1;
  359.     if (cnt mod 10)=0 then write (cnt,'...  ')
  360.   end;
  361.   writeln ('Done!');
  362.   close (uf);
  363.   close (ouf);
  364.   if shoulderase then erase (ouf);
  365.   divider
  366. end;
  367.  
  368. procedure alldone;
  369. begin
  370.   topmessage ('Conversion is complete!',true);
  371.   returntodos
  372. end;
  373.  
  374. begin
  375.   {init;
  376.   readstatus;}
  377.   clrscr;
  378.   readconfig;
  379.   ensurenotsecondtime;
  380.   shouldierase;
  381.   convertuserfile;
  382.   alldone
  383. end.
  384.