home *** CD-ROM | disk | FTP | other *** search
/ ftp.wwiv.com / ftp.wwiv.com.zip / ftp.wwiv.com / pub / EVENTS / 20QS.ZIP / 20QS.PAS next >
Pascal/Delphi Source File  |  1988-03-10  |  6KB  |  195 lines
  1.  
  2.    PROGRAM Questions ( input, output, Title, Ansrs );
  3.       {This is a quetionair program designed for WWIV using
  4.       Turbo 3.1 A.  This questionair will allow to ask as many
  5.       questions as you want.  Consider it an improved voting
  6.       board.  It will allow for 75 char length answers.
  7.       Written By : White Knight (Rob Kelley)}
  8.          {$V-}  {$C-}
  9.          {$I-}
  10.          {$I Common.Pas}
  11.  
  12.       CONST
  13.          MustAnswer = 20;       {How many questions that the user must enter
  14.                                 answers for, and not skip.}
  15.          MaxQuestions = 20;    {Amount of Questions asked by questionair}
  16.          FileName = 'Ansrs.Msg';
  17.       TYPE
  18.          Storage = ARRAY [1..MaxQuestions] OF Str;
  19.  
  20.       VAR
  21.          Title,                 {Welcome Screen.}
  22.          Ansrs   : text;        {File into which answers are stored.}
  23.          Q,                     {Array stores Questions}
  24.          Answer  : Storage;     {Array stores Answers}
  25.          Again   : Boolean;     {Ask Question in main line}
  26.  
  27.       PROCEDURE RETURN;     {- - - Return to BBS - - -}
  28.          VAR
  29.             F: file;
  30.  
  31.          BEGIN
  32.             ASSIGN ( F, 'bbs.com' );
  33.             print ('Thank You so much, C-Ya .....');    {Returning Message}
  34.             remove_port;
  35.             IF ( HangUp ) THEN
  36.                term_ready( False );
  37.             execute ( F );
  38.          END;
  39.  
  40.  
  41.       PROCEDURE Welcome;
  42.          BEGIN
  43.             CLS;                         {Clears Screen}
  44.             PrintFile ('Title.Dat');       {Prints out file Title.Msg}
  45.             Nl; Nl; Nl;                  {Prints out three blank lines}
  46.             PauseScr;                    {Waits for key to be pressed to cont}
  47.             CLS;                         {Clears Screen}
  48.             Nl;Nl;Nl;Nl;Nl;              {Prints out five blank lines}
  49.          END;
  50.  
  51.  
  52.       PROCEDURE ReadyFile;
  53.          VAR
  54.             Buffer : char;
  55.  
  56.          BEGIN
  57.             assign (Ansrs, FileName);
  58.             if IOresult <> 0 then
  59.               Begin
  60.                 ReWrite(ansrs);
  61.                 WriteLn(ansrs,'');
  62.                 close(ansrs);
  63.               End;
  64.             Append(ansrs);
  65.             sysoplog( '- - Used The Questionairre. - -' );
  66.             writeln ( Ansrs, Nam );
  67.             {$I+}
  68.          END;
  69.  
  70.  
  71.       Function GetAnswer ( Number : integer ) : Str;
  72.          Const
  73.             AnswerLength = 75;
  74.  
  75.          VAR
  76.             Prefix,
  77.             Respond,
  78.             TryAgain, respond1  : Str;
  79.  
  80.          BEGIN
  81.             Prefix  := '?: ';
  82.             Respond := 'It is important that you answer this Question.';
  83.             TryAgain := 'Enter the Answer at this time.';
  84.             REPEAT
  85.                prompt (Prefix);
  86.                InputL ( Respond1, AnswerLength );
  87.                IF ( ( Number <= MustAnswer ) AND ( respond1 = '') ) THEN
  88.                BEGIN
  89.                   print (Respond);
  90.                   print (TryAgain);
  91.                END;
  92.             CheckHangUp;
  93.             UNTIL ( ( Number > MustAnswer ) OR ( respond1<> '' ) );
  94.             Nl;
  95.             GetAnswer:=respond1;
  96.          END;
  97.  
  98.       PROCEDURE Questions (VAR Q : Storage);
  99.       {Place your questions here.  If you desire more than 20 questions you
  100.        will have to add them.  Else, just enter the questions you will be
  101.        using and ignore the others.}
  102.  
  103.          BEGIN
  104.             Q [1]  := 'What is your FULL REAL name?';
  105.             Q [2]  := 'What is your VOICE PHONE #?';
  106.             Q [3]  := 'What is your DATA PHONE #?';
  107.             Q [4]  := 'What is your ADDRESS?';
  108.             Q [5]  := 'What is your CITY, STATE, ZIP CODE?';
  109.             Q [6]  := 'What is your MAX BAUD rate?';
  110.             Q [7]  := 'What COMM SOFTWARE are you useing?';
  111.             Q [8]  := 'Isn''t this fun, there''s still more?';
  112.             Q [9]  := 'What type of COMPUTER do you use?';
  113.             Q [10] := 'Do you run a BBS?';
  114.             Q [11] := 'If so, What''s the name and #?';
  115.             Q [12] := '8 more to go, can you make it?';
  116.             Q [13] := 'Why do you want access to the GAMEZONE, line 1 of 3';
  117.             Q [14] := 'Why do you want access to the GAMEZONE, line 2 of 3';
  118.             Q [15] := 'Why do you want access to the GAMEZONE, line 3 of 3';
  119.             Q [16] := 'Trick Question, What do you think ABC stands for?';
  120.             Q [17] := 'What do you want to get from this BBS?';
  121.             Q [18] := 'What BBS''s do you call and what hours?';
  122.             Q [19] := 'Comments to the SysOp go here???';
  123.             Q [20] := 'More Comments please??????????';
  124.          END;
  125.  
  126.  
  127.       PROCEDURE Ask ( VAR Q, Answer : Storage );
  128.          VAR
  129.             Loop    : integer;
  130.             Result  : Str;
  131.  
  132.          BEGIN
  133.             print ('INFO.msg');
  134.             nl;nl;nl;
  135.  
  136.             FOR Loop := 1 TO MaxQuestions DO BEGIN
  137.                Nl;
  138.                print ( Q [Loop] );
  139.                Answer[Loop] := GetAnswer ( Loop );
  140.                CheckHangUp;
  141.             END;
  142.          END;
  143.  
  144.  
  145.       PROCEDURE SendToFile (Answer : Storage);
  146.          VAR
  147.             Loop : integer;
  148.  
  149.          BEGIN
  150.             ReadyFile;
  151.             {writeln (Ansrs, Buffer);}
  152.             FOR Loop := 1 TO MaxQuestions DO BEGIN
  153.                IF ( Answer [Loop] = '' ) THEN
  154.                   Answer [Loop] := ' ';
  155.                writeln (Ansrs, Answer [Loop] );
  156.             END;
  157.             Close (Ansrs);
  158.          END;
  159.  
  160.  
  161.       PROCEDURE OnceMore (VAR Again : boolean);
  162.          VAR
  163.             Hmmm,
  164.             Mark : str;
  165.             What : char;
  166.  
  167.          BEGIN
  168.             Hmmm := 'Would you like to re-enter your Answers (Y/N)? ';
  169.             Mark:= '?: ';
  170.             Nl;Nl;Nl;
  171.             print  ( Hmmm );
  172.             Prompt ( Mark );
  173.             REPEAT
  174.                GetKey ( What );
  175.             UNTIL ( What IN ['Y', 'y', 'N', 'n'] );
  176.             IF ( ( What= 'Y' ) OR (What= 'y' ) ) THEN
  177.                Again := true
  178.             ELSE
  179.                Again := false;
  180.          END;
  181.  
  182.  
  183.       BEGIN {MainLine}
  184.          iport;
  185.          REPEAT
  186.             Welcome;
  187.             {writeln('going into questions');}
  188.             Questions ( Q );
  189.             Ask ( Q, Answer );
  190.             OnceMore ( Again );
  191.             CheckHangUp;
  192.          UNTIL ( Again = FALSE );
  193.          SendToFile ( Answer );
  194.          RETURN;
  195.       END.