home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / BBSWALL.ZIP / WYWALL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-04-04  |  6.4 KB  |  201 lines
  1. program wywall;
  2. uses ddplus,crt,ddscott,ibbs5;
  3. type userdata=record
  4.       username:string[35];
  5.       mesgdate:string[8];
  6.       mesgtime:string[5];
  7.       wholocat:string[35];
  8.       text:array[1..5] of string[80];
  9. end;
  10. {$I d:\bp\ddplus\struct.250}
  11. var u,u2:userdata;f,f2:file of userdata;s:string;i,m:integer;ch,ch1:char;txtstr:array[1..5] of string;filepos:integer;
  12.     isold:boolean;c:char;str,str1:string;
  13.     FromF, ToF: file;isexit:boolean;
  14.     NumRead, NumWritten: Word;
  15.     Buf: array[1..2048] of Char;
  16.     posi:integer;
  17. procedure filecopy;
  18. begin
  19. if exist('temp.dat') then
  20. begin
  21. Assign(FromF,'temp.dat'); { Open input file }
  22. Reset(FromF, 1);  { Record size = 1 }
  23. Assign(ToF,'wywall.dat'); { Open output file }
  24. Rewrite(ToF, 1);  { Record size = 1 }
  25. repeat
  26.   BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
  27.   BlockWrite(ToF, Buf, NumRead, NumWritten);
  28. until (NumRead = 0) or (NumWritten <> NumRead);
  29. erase(fromf);
  30. Close(FromF);
  31. Close(ToF);
  32. end;
  33. end;
  34.  
  35. begin
  36.   initdoordriver('wywall.ctl');
  37.   i:=0;
  38.   if paramcount<>0 then if paramstr(1)='-r' then begin
  39.   sclrscr;
  40.   set_color(11,0);
  41.   sgoto_xy(1,24);
  42.   swrite('─·╧╓╘┌╧δ┐┤┤≤╝╥╡─┴⌠╤╘┬≡?(Y/n)');
  43.   sread_char(ch);
  44.   if (upcase(ch)='Y') or (ch=#13) then begin end else halt;
  45.   end;
  46.   begin
  47.   repeat
  48.   showmenu(ch,'wywall.ans');
  49.   case ch of
  50.  'r','R':begin
  51.   if exist('wywall.dat') then begin assign(f,'wywall.dat');reset(f);end
  52.    else begin halt;end;
  53.   displayfile2('hqwrbg.ans');
  54.   isexit:=false;
  55.   posi:=1;
  56.   while (not eof(f)) and (not isexit) do
  57.    begin
  58.   read(f,u);
  59.   set_color(14,1);
  60.   for i:=1 to 6 do begin sgoto_xy(7,13+i);
  61.   swrite('                                                                     ');end;
  62.   sgoto_xy(5,14);
  63.   str:=u.username;
  64.   str1:=namelocase(str);
  65.   swriteln('╘┌ '+u.mesgdate+' '+u.mesgtime+' ╡─╩▒║≥, '+str1+' ╦╡ ');;
  66.   set_color(11,1);
  67.   for i:=1 to 5 do begin sgoto_xy(7,14+i);swriteln(u.text[i]);end;
  68.   set_color(10,1);
  69.   swritexy(56,20,'╚╬╥Γ╝ⁿ╝╠╨°   ESC╝ⁿ╖╡╗╪');
  70.   sread_char(c);if c=#27 then isexit:=true;
  71. {  if (c='n') and (posi=1) then reset(f) else
  72.   begin
  73.   inc(posi);
  74.   if (c='n') and (posi<>1) then begin dec(posi,2);reset(f);seek(f,posi);
  75.     end else {begin inc(posi);reset(f);seek(f,posi);end;inc(posi);end;}
  76.   end;
  77.   close(f);
  78.   end;
  79.   'w','W':begin
  80.   displayfile2('hqwrbg.ans');
  81.     if exist('wywall.dat') then begin assign(f,'wywall.dat');reset(f);{seek(f,filesize(f));}end
  82.    else begin  assign(f,'wywall.dat'); rewrite(f);end;
  83.   str:=user_first_name+' '+user_last_name;
  84.   str:=namelocase(str);
  85.   filepos:=0;
  86.   isold:=true;
  87.   while (not eof(f)) and isold do
  88.     begin read(f,u);inc(filepos);if upstr(u.username)=upstr(str) then isold:=false;end;
  89.      if isold then begin
  90.            u.username:=str;
  91.            str:=user_first_name+' '+user_last_name;
  92.            str1:=namelocase(str);
  93.            u.mesgdate:=copy(Gettodaydate,1,8);
  94.            u.mesgtime:=copy(Gettodaytime,1,5);
  95.            sgoto_xy(5,14);
  96.            set_color(14,1);
  97.            swriteln('╘┌ '+u.mesgdate+' '+u.mesgtime+' ╡─╩▒║≥, '+str1+' ╦╡ ');;
  98.            seek(f,filesize(f));
  99.      for i:=1 to 5 do
  100.        begin
  101.            sgoto_xy(8,14+i);
  102.            set_color(14,1);
  103.            swrite('╨╨'+cstr(i)+': ');
  104.            sgoto_xy(12,14+i);
  105.            set_color(13,1);
  106.            sread(str);
  107.            txtstr[i]:=copy(str,1,80);
  108.        end;
  109.        repeat
  110.        set_color(10,1);
  111.        swritexy(12,20,'┤µ┼╠╖±(Y/N)?');
  112.        sread_char(c);
  113.        until c in['y','Y','n','N'];
  114.        if upcase(c)='Y' then
  115.           begin
  116.            for i:=1 to 5 do u.text[i]:=txtstr[i];
  117.            assign(f2,'temp.dat');
  118.            rewrite(f2);
  119.            write(f2,u);
  120.            reset(f);
  121.            for i:=1 to 19 do begin if not eof(f) then begin read(f,u);write(f2,u);end;end;
  122.            close(f);
  123.            close(f2);
  124.            filecopy;
  125.            assign(f3,'d:\fidonet\ra\text\goodbye.ans');
  126.            rewrite(f3);
  127.  
  128.            end;
  129.            end;
  130.   if not isold then
  131.   begin
  132.   seek(f,filepos-1);
  133.   u.mesgdate:=copy(Gettodaydate,1,8);
  134.   u.mesgtime:=copy(Gettodaytime,1,5);
  135.   u.wholocat:=copy('Guangdong Enping',1,35);
  136.   sgoto_xy(5,14);
  137.   str:=user_first_name+' '+user_last_name;
  138.   str1:=namelocase(str);
  139.   set_color(14,1);
  140.   swriteln('╘┌ '+u.mesgdate+' '+u.mesgtime+' ╡─╩▒║≥, '+str1+' ╦╡ ');;
  141.      for i:=1 to 5 do
  142.        begin
  143.            sgoto_xy(8,14+i);
  144.            set_color(14,1);
  145.            swrite('╨╨'+cstr(i)+': ');
  146.            sgoto_xy(12,14+i);
  147.            set_color(13,1);
  148.            sread(str);
  149.            txtstr[i]:=copy(str,1,80);
  150.        end;
  151.        repeat
  152.        set_color(10,1);
  153.        swritexy(12,20,'┤µ┼╠╖±(Y/N)?');
  154.        sread_char(c);
  155.        until c in['y','Y','n','N'];
  156.        if upcase(c)='Y' then
  157.           begin
  158.            for i:=1 to 5 do u.text[i]:=txtstr[i];
  159.   assign(f2,'temp.dat');
  160.   rewrite(f2);
  161.   write(f2,u);
  162.   reset(f);
  163.   for i:=1 to filepos-1 do begin read(f,u);write(f2,u);end;
  164.   read(f,u);
  165.   for i:=1 to 19 do begin if not eof(f) then begin read(f,u);write(f2,u);end;end;
  166.   close(f);
  167.   close(f2);
  168.   filecopy;
  169.   end;
  170.   end;
  171.   end;
  172.   'h','H':begin
  173.           sclrscr;
  174.           set_color(13,0);
  175.           swritexy(4,3,'╣╪╙┌▒╛╚φ╝■...');
  176.           swritexy(4,4,'-------------');
  177.           set_color(11,0);
  178.           swritexy(4,5,'    ▒╛╚φ╝■╫≈╬¬╕¿╓·╝▄╒╛╓«╙├,╙├╗º╫ε╢α┐╔╥╘┴⌠╤╘5╨╨,╟╥╫ε╢α╓╗▒ú┤µ20╠⌡╫ε╨┬┴⌠╤╘');
  179.           swritexy(4,6,'╒Γ╩╟╥≥╬¬╗╣┐╝┬╟╡╜╙├╗º╔╧╧▀╡─═ú┴⌠╩▒╝Σ╬╩╠Γ.╙├╗º┐╔╥╘░╤─·╔╧╒╛╩▒╧δ╡╜╡─┴Θ╕╨╗≡╗¿');
  180.           swritexy(4,7,'╖╜▒π╡╪╝╟╘┌┴⌠╤╘░σ╔╧,╚├╞Σ╦√╙├╗º┐╔╥╘╖╓╧φ─·╡─┴⌠╤╘╔⌡╓┴╞»┴┴╡─╟⌐├√.');
  181.           set_color(13,0);
  182.           swritexy(41,7,'─·╡─┴⌠╤╘');
  183.           set_color(14,0);
  184.           swritexy(53,7,'╞»┴┴╡─╟⌐├√');
  185.           set_color(11,0);
  186.           swritexy(4,8,'    ▒╛╚φ╝■╡─╫≈╒▀Xu Xiaoning(╨∞╧■─■),CFIDO╒╛║┼(6:655/808),YO!Net╒╛║┼(7:3');
  187.           swritexy(4,9,'030/1),╗╢╙¡─·╘┌╚╬║╬╥╗╕÷CFido╡─╒╛╠¿╔╧╘┌SUPPORT.CHINA╟°─┌╕° Xu Xiaoning╨┤');
  188.           swritexy(4,10,'╨┼,░╤─·╡─╥Γ╝√║═╜¿╥Θ╖┤└í╕°╬╥, ═¼╩▒╬╥╥▓╗ß░╤╫ε╨┬░µ╡─┴⌠╤╘░σ╛¡CFidoNet╖ó▓╝│÷');
  189.           swritexy(4,11,'╚Ñ╡─,─Γ╝╞╗«╫ε╨┬░µ▒╛╜½╩╡╧╓╢α╒╛╠¿┴⌠╤╘╡─╣ª─▄.');
  190.           set_color(15,0);
  191.           swritexy(4,13,'┴¬╧╡╡τ╗░:0750-7723594');
  192.           swritexy(4,14,'BB╗·:0750-7717888║⌠32000');
  193.           swritexy(4,15,'EMail:jmxxny@pub.jiangmen.gd.cn');
  194.           set_color(10,0);
  195.           swritexy(50,20,'Chance_online ╚φ╝■╣ñ╫≈╩╥');
  196.           sread_char(c);
  197.           end;
  198.   end;
  199.   until upcase(ch)='Q';
  200.   end;
  201. end.