home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / P_REG120.ZIP / SOURCE.ZIP / P-REG.PAS
Encoding:
Pascal/Delphi Source File  |  1992-05-19  |  10.1 KB  |  344 lines
  1. (*
  2. ** Registration door for Remote Access
  3. **
  4. ** (c) 1991-1992 Hans Siemons
  5. **
  6. ** Last revision : May 19, 1992
  7. *)
  8.  
  9. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*)
  10.  
  11. Uses
  12.   RADU;
  13.  
  14. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*)
  15.  
  16. Const Regels=19;
  17.  
  18. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*)
  19.  
  20. type AntType=Array[1..regels] of String[42];
  21.      Antwoorden=Record
  22.                   Name:String[35];
  23.                   Ants:AntType;
  24.                 end;
  25.  
  26. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*)
  27.  
  28. Const CtlFile:Array[1..8] of String[80]=(
  29.   'Velden 1 t/m 6 moeten ingevuld worden! Druk op [Enter] om verder te gaan.',
  30.   'Escape=klaar',
  31.   'Prime BBS users registration door',
  32.   'Moment, wegschrijven van data!',
  33.   'Voorbeeld:',
  34.   '50',
  35.   'B3',
  36.   'A1A2A3A4A5A6A7A8');
  37.  
  38. Var
  39.   EntryCount  : Byte;
  40.   Entrys      : AntType;
  41.   Legals      : Array[1..regels] of CharSet;
  42.   Lens        : Array[1..regels] of Byte;
  43.   Voorbeeld   : Array[1..regels] of string[80];
  44.   Antw        : Array[1..regels] Of string[80];
  45.   AFile       : File of Antwoorden;
  46.   ARec        : Antwoorden;
  47.   Key         : Char;
  48.   f           : text;
  49.   s           : String;
  50.   i           : Integer;
  51.   ok          : Boolean;
  52.   NewOne      : Boolean;
  53.   RecNr       : Integer;
  54.   txtPath     : String;
  55.  
  56. Begin
  57.   DorInit;
  58.   DorAvatar:=False;  {Kill AVT and set ANSI on}
  59.   DorAnsi:=True;
  60.   DorStatLn[8,1]:='Gebruikers Registratie Door v1.20';
  61.   DorStatLn[8,2]:='Door Hans Siemons.';
  62.   DorFrozen:=true;
  63.  
  64.   DorExtKeys[132]:=DorExtKeys[72];                  { Move up-arrow to ^PgUp }
  65.   DorExtKeys[118]:=DorExtKeys[80];                { Move down-arrow to ^PgDn }
  66.   DorExtKeys[72]:=DorNullProc;                              { Clear up-arrow }
  67.   DorExtKeys[80]:=DorNullProc;                            { Clear down-arrow }
  68.  
  69.   DorStatLn[9,1]:='ALT: [C]hat [G]arbage [H]angup [L]ockOut [N]extOn [O]verride [Q]uit to BBS';
  70.   DorStatLn[9,2]:='     [S]ecurity  [^PgUp]-Inc Time  [^PgDn]-Dec Time  [F1]-[F8]=Extra Stats';
  71.  
  72.   Key:=DorDisplay ('reg-new.ans','',false);
  73.   DorCleanKeys;
  74.   Key:=Readkey;
  75.   DorCleanKeys;
  76.   ClrScr;
  77.   NewOne:=true;
  78.   s:=ForceBack(RaConfig.MsgBasePath)+'USERSINF.BBS';
  79.   FileMode:=$40;
  80.   Assign (AFile,s);
  81.   {$I-}
  82.   Reset(AFile);
  83.   {$I+}
  84.   if ioresult=0 then
  85.     begin
  86.       While not eof(AFile) do
  87.       begin
  88.         Read(AFile,ARec);
  89.         if ARec.Name=ExitInfo.UserInfo.Name then begin
  90.                                                    for i:=1 to regels do Entrys[i]:=ARec.Ants[i];
  91.                                                    NewOne:=false;
  92.                                                    RecNr:=Filepos(AFile)-1;
  93.                                                   end;
  94.       end;
  95.     end
  96.     else
  97.     begin
  98.       ReWrite(AFile);
  99.     end;
  100.  Close(AFile);
  101.  if NewOne then
  102.    begin
  103.      for i:=1 to regels do Entrys[i]:='';
  104.       Entrys[1]:=ExitInfo.UserInfo.Name;
  105.       Entrys[4]:=ExitInfo.UserInfo.Location;
  106.       Entrys[5]:=ExitInfo.UserInfo.VoicePhone;
  107.       Entrys[6]:=ExitInfo.UserXiInfo.Birthdate;
  108.     end;
  109.  
  110.   Legals[1]:=[#32..#255];                           { Setup legal characters }
  111.   Legals[2]:=Legals[1];
  112.   Legals[3]:=['0'..'9',' ','-','a'..'z','A'..'Z'];
  113.   Legals[4]:=Legals[1];
  114.   Legals[5]:=Legals[1];
  115.   Legals[6]:=['0'..'9','-','+'];
  116.   Legals[7]:=Legals[1];
  117.   Legals[8]:=Legals[1];
  118.   Legals[9]:=Legals[1];
  119.   Legals[10]:=Legals[1];
  120.   Legals[11]:=Legals[1];
  121.   Legals[12]:=Legals[1];
  122.   Legals[13]:=Legals[1];
  123.   Legals[14]:=Legals[1];
  124.   Legals[15]:=Legals[1];
  125.   Legals[16]:=Legals[1];
  126.   Legals[17]:=Legals[1];
  127.   Legals[18]:=Legals[1];
  128.   Legals[19]:=Legals[1];
  129.  
  130.   Voorbeeld[1]:='Hans Siemons';
  131.   Voorbeeld[2]:='Prime weg 15 (GEEN!!! Postbusnummers)';
  132.   Voorbeeld[3]:='4815 AD';
  133.   Voorbeeld[4]:='Breda';
  134.   Voorbeeld[5]:='076-715391';
  135.   Voorbeeld[6]:='11-26-1969 (MM/DD/YY)';
  136.   Voorbeeld[7]:='Innovator 286, 12mhz, 100mb';
  137.   Voorbeeld[8]:='USRobotics Courier HST Dual Standard';
  138.   Voorbeeld[9]:='Telix, Frontdoor, Telemate.';
  139.   Voorbeeld[10]:='Palingboer, Fietsenmaker, Systeembeheerder';
  140.   Voorbeeld[11]:='';
  141.   Voorbeeld[12]:='PCM / BBSLijst / Nodelist / Ander BBS (welk bbs)';
  142.   Voorbeeld[13]:='Een BBS om donateur te worden hihi';
  143.   Voorbeeld[14]:='Ziet er hier wel prachtig uit hoor ;-)';
  144.   Voorbeeld[15]:='';
  145.   Voorbeeld[16]:='Ja of nee';
  146.   Voorbeeld[17]:='Prime BBS';
  147.   Voorbeeld[18]:='076-715391 24 uur';
  148.   Voorbeeld[19]:='2:512/149 9:77/1000 2:512/149.1';
  149.  
  150.   TxtPath:=ForceBack(Language.TextPath);
  151.  
  152.   filemode:=$40;
  153.   Assign(f,TxtPath+'p-reg.vb');
  154.   {$I-}
  155.   Reset(f);
  156.   {$I+}
  157.   if ioresult=0 then
  158.     begin
  159.       For I:=1 to 19 do if not eof(f) then readln(f,Voorbeeld[i]);
  160.       Close(f);
  161.     end;
  162.  
  163.   Antw[01]:='Naam';
  164.   Antw[02]:='Adres';
  165.   Antw[03]:='Postcode';
  166.   Antw[04]:='Plaats';
  167.   Antw[05]:='Telefoonnummer';
  168.   Antw[06]:='Geboorte datum';
  169.   Antw[07]:='Soort/Merk computer';
  170.   Antw[08]:='Soort/Merk Modem';
  171.   Antw[09]:='Wat is je terminalprogramma';
  172.   Antw[10]:='Beroep, hobby''s? :';
  173.   Antw[11]:='';
  174.   Antw[12]:='Waar heb je dit nummer vandaan';
  175.   Antw[13]:='Wat hoop je hier te vinden';
  176.   Antw[14]:='Eventuele opmerkingen?';
  177.   Antw[15]:='';
  178.   Antw[16]:='Ben je zelf ook sysop?';
  179.   Antw[17]:='Zo ja, wat de naam van je bbs';
  180.   Antw[18]:='Tel. nr bbs en  Online tijden';
  181.   Antw[19]:='Nodenummer (ook voor points)';
  182.  
  183.   filemode:=$40;
  184.   Assign(f,TxtPath+'p-reg.vr');
  185.   {$I-}
  186.   Reset(f);
  187.   {$I+}
  188.   if ioresult=0 then
  189.     begin
  190.       For I:=1 to 19 do if not eof(f) then readln(f,Antw[i]);
  191.       Close(f);
  192.     end;
  193.   For i:=1 to 19 do
  194.     begin
  195.       Antw[i]:=RightJust(Antw[i],30)+' :';
  196.     end;
  197.  
  198.   Lens[1]:=42;                                        { Setup string lengths }
  199.   Lens[2]:=42;
  200.   Lens[3]:=7;
  201.   Lens[4]:=42;
  202.   Lens[5]:=42;
  203.   Lens[6]:=8;
  204.   Lens[7]:=42;
  205.   Lens[8]:=42;
  206.   Lens[9]:=42;
  207.   Lens[10]:=42;
  208.   Lens[11]:=0;
  209.   Lens[12]:=42;
  210.   Lens[13]:=42;
  211.   Lens[14]:=42;
  212.   Lens[15]:=0;
  213.   Lens[16]:=3;
  214.   Lens[17]:=42;
  215.   Lens[18]:=42;
  216.   Lens[19]:=42;
  217.  
  218.   filemode:=$40;
  219.   Assign(f,txtPath+'p-reg.ctl');
  220.   {$I-}
  221.   Reset(f);
  222.   {$I+}
  223.   if ioresult=0 then
  224.     begin
  225.       For I:=1 to 8 do if not eof(f) then readln(f,CtlFile[i]);
  226.       Close(f);
  227.     end;
  228.  
  229.   Write ('`A112:`G2,1: ',CtlFile[3],RightJust('(c) 1992 Hans Siemons ',77-length(CtlFile[3])));
  230.   Write ('`A15:`G2,2:'+dup ('▀',78)+'`G2,22:'+dup ('═',78));
  231.  
  232.   For I:=1 to regels do if i<>11 then
  233.     begin
  234.       GotoXY (3,2+i);
  235.       write ('`A7:'+Antw[i]+' `A112:'+dup('░',lens[i]));
  236.     end;
  237.  
  238.   GotoXY(78-Length(CtlFile[2]),23);Write ('`A15:[`A143:',CtlFile[2],'`A15:]');
  239.  
  240.     TextColor(0);
  241.   TextBackGround(7);
  242.  
  243.   For EntryCount:=1 to regels do
  244.   Begin
  245.     GotoXY (36,EntryCount+2);
  246.     Write (Entrys[EntryCount]);
  247.   End;  { For }
  248.  
  249.   EntryCount:=1;
  250.  
  251.   repeat
  252.   Repeat
  253.     Write ('`A15:`G2,23:',CtlFile[5],' '+LeftJust(voorbeeld[EntryCount],75-length(CtlFile[2])-Length(CtlFile[5])));
  254.     TextColor(0);
  255.     TextBackGround(7);
  256.     GotoXY (36,EntryCount+2);
  257.     s:=Entrys[EntryCount];
  258.     Key:=DorLineEdit(s,Lens[EntryCount],Legals[EntryCount],[#1,#2,#13,#27],'░');
  259.     Entrys[EntryCount]:=s;
  260.     Case Key of
  261.       #1 :  Begin                                         { Up-Arrow pressed }
  262.               If EntryCount>1 then
  263.                 Dec(EntryCount);
  264.                 if Lens[entryCount]=0 then Dec(EntryCount);
  265.             End;  { UpArrow }
  266.       #2 :  Begin                                       { Down-Arrow pressed }
  267.               If EntryCount<regels then
  268.                 Inc(EntryCount);
  269.                 if Lens[entryCount]=0 then Inc(EntryCount);
  270.             End;  { DownArrow }
  271.       #13 : Begin                                            { Enter pressed }
  272.               If Entrycount=16 then
  273.                 begin
  274.                    If (SupCase(Entrys[16])='NO') or
  275.                       (SupCase(Entrys[16])='N') or
  276.                       (Entrys[16]='') or
  277.                       (SupCase(Entrys[16])='NEE') then Key:=#27;
  278.                 end;
  279.               Inc (EntryCount);
  280.               If EntryCount=Regels+1 then
  281.                 Begin
  282.                   EntryCount:=1;
  283.                   Key:=#27;
  284.                 end;
  285.               If Lens[entryCount]=0 then Inc(EntryCount);
  286.  
  287.             End;  { Enter }
  288.     End;  { Case }
  289.   Until Key=#27;
  290.   ok:=true;
  291.   for i:=1 to 6 do if (Entrys[i]='') and (lens[i]<>0) then Ok:=false;
  292.   if not ok then begin
  293.                    GotoXY (1,23);
  294.                    TextBackGround(0);
  295.                    ClrEol;
  296.                    Write ('`C:`A15:`Y23:Velden 1 t/m 6 moeten ingevuld worden! Druk op [Enter] om verder te gaan.');
  297.                    Key:=Readkey;
  298.                    DorCleanKeys;
  299.                    GotoXY(78-Length(CtlFile[2]),23);Write ('`A15:[`A143:',CtlFile[2],'`A15:]');
  300.                  end;
  301.   Until Ok;
  302.  
  303.   TextBackGround(0);
  304.  
  305.   GotoXY(1,23);
  306.   ClrEol;
  307.   Write ('`C:`A142:',CtlFile[4]);
  308.   FileMode:=$11;
  309.   Assign(f,RaSystem+'NewUser.Asw');
  310.   {$I-}
  311.     Append(f);
  312.   {$I+}
  313.   if IOResult<>0 then ReWrite(f);
  314.   Writeln (f,'*** '+ExitInfo.UserInfo.Name+' completed questionnaire at '+
  315.                     TimeStr(false,false)+' on '+RAFormatDate(DateStr,4)+' ***');
  316.   Writeln (f,'Baudrate used by user : '+FStr(ExitInfo.Baud));
  317.   for i:=1 to Regels do writeln (f,Antw[i]+Entrys[i]);
  318.   Writeln (f,'Answers Collected by UserRegDoor by Hans Siemons');
  319.   Writeln (f);
  320.   close(f);
  321.  
  322.   FileMode:=$11;
  323.   Reset(AFile);
  324.   if newOne then
  325.               Seek(AFile,FileSize(AFile))
  326.              else
  327.               Seek(AFile,RecNR);
  328.    ARec.Name:=Exitinfo.UserInfo.Name;
  329.    ARec.Ants:=Entrys;
  330.    Write(AFile,ARec);
  331.    close(AFile);
  332.  
  333.   If ExitInfo.UserInfo.Security <FVal(CtlFile[6]) then RaSetSecurity(FVal(CtlFile[6]));
  334.   RaResetFlags(ExitInfo.UserInfo.Flags,CtlFile[7]);
  335.   RaSetFlags(ExitInfo.UserInfo.Flags,CtlFile[8]);
  336.  
  337.   ClrEol;
  338.   Key:=DorDisplay ('reg-end.ans','',false);
  339.    Key:=Readkey;
  340.    clrscr;
  341.    Writeln ('`A143:THANKS`A7: for using `F15:User Registration Door v1.20+');
  342.    Writeln ('`F7:(C)1991-1992 By Hans Siemons');
  343. End.
  344.