Registration End

A BBS (Bulletin Board System) script that handles user registration questionnaires. Reads questions from a file, displays them to users with color formatting, collects answers, and saves registration data. Supports conditional question skipping based on Yes/No answers, validates input, and increases user access level based on questions answered. Includes procedures for reading questions, saving answers, skipping questions conditionally, and writing user information to registration files. Written in a Pascal-like BBS scripting language.

Source Code:

//(c) A<S 1983-1999 dO nOT dISTRIBUTE...
Variables
  MsgIn, MsgOut, Def, Colq, Cola, Ch  : String
  Q, Fin, OldReg                      : Logical
  Lng, Type, i, ISecr, Num, Dig       : Number
End

Procedure Save
//Write("\14*Save*")
If Type = 1
   WriteLn("\" + Colq + MsgIn+ "\" + Cola); ReadVar(Def, Lng)
   FileWriteString (1, MsgOut + " " + Def)
Else
   WriteLn("\" + Colq + MsgIn + "\" + Cola)
   YesNo(Q)
   If Q
      FileWriteString (1, MsgOut + " Да")
   Else
      FileWriteString (1, MsgOut + " Нет")
   End
End
   ISecr=ISecr+1
End

Procedure Read
//Write("\14*Read*")
NewRead:
FileGetEOF (2, Fin)
If Fin
     Goto FinRead
Else
     FileReadString(2, Ch)
End
If Ch="[NewQwestion]"
     QRead
     SubString (Ch, Dig, Num-Dig+1, Ch)
     Val (Ch, Type)
     QRead
     SubString (Ch, Dig, Num-Dig+1, Ch)
     Val (Ch, Lng)
     QRead
     SubString (Ch, Dig, Num-Dig+1, MsgIn)
     QRead
     SubString (Ch, Dig, Num-Dig+1, MsgOut)
     QRead
     SubString (Ch, Dig, Num-Dig+1, Def)
     QRead
     SubString (Ch, Dig, Num-Dig+1, Colq)
     QRead
     SubString (Ch, Dig, Num-Dig+1, Cola)
Else
//     WriteLn ("\11Глюки: \03" + Ch)
     GoTo NewRead
End
FinRead:
End

Procedure QRead
     FileReadString (2,Ch)
     GetStringLength (Ch, Num)
     StrPos ("=", Ch, Dig)
     Dig=Dig+2
End

Procedure Skip
//Write("\14*Skip*")
i=Lng
If Q
     If type=3
Var1:
          If i > 0
               Read
               If Fin
                    GoTo FinSkip
               End
               i=i-1
               GoTo Var1
          End
     End
Else
     If type=4
Var2:
          If i > 0
               Read
               If Fin
                    GoTo FinSkip
               End
               i=i-1
               GoTo Var2
          End
     End
End
FinSkip:
End

Procedure Check
//Write("\14*Check*")
i=0
GetStringLength (MsgIn, Num)
i=i + Num
GetStringLength (MsgOut, Num)
i=i + Num
GetStringLength (Def, Num)
i=i + Num
If i > 300
   WriteLn("\04Избавь нас от лукавого!!!")
End
If (Type > 4) or (Type < 1)
   Type=1
End
If (Lng > 79) or (Lng < 1)
   Lng=70
End
Val (Colq,i)
If (i > 15) or (i < 1)
   Colq="10"
End
Val (Cola,i)
If (i > 15) or (i < 1)
   Cola="13"
End
End

Procedure ExitReg
//Write("\14*ExitReg*")
WriteLn ("\11Спасибо за ответы.")
If Not OldReg
   $SECR = $SECR + ISecr
   WriteLn ("\11Ваш уровень доступа поднят на " + ISecr + " и составляет " + $SECR + "...")
End
//WriteLn ("\10Хотите включить в анкету свои вопросы ?")
//NoYes (Q)
End

Procedure WriteInfo
//Write("\14*WriteInfo*")
FileWriteString (1, "***************************************************************************")
FileWriteString (1, "Основные сведения:")
FileWriteString (1, "Зарегистрирован на BBS как: " + $NAME)
FileWriteString (1, "Псевдоним: " + $ALAS + " ;) \08 Пароль: " + $PSWD)
FileWriteString (1, "Уровень доступа до регистрации: " + $SECR)
FileWriteString (1, "Телефон голосовой / модемный: "+$HPHN +" / "+ $BPHN )
FileWriteString (1, "Место звонка: "+$LOCA)
FileWriteString (1, "Дата рождения: "+$DAOB)
FileWriteString (1, "Место работы/учебы: "+$ORGZ)
FileWriteString (1, "***************************************************************************")
End

Procedure Welcome
Clear
FileExists ("C:\BBS\USERS\" + $FNAM + ".REG", OldReg)
If OldReg
     FileDisplay ("help2.txt")
     NoYes(Q)
     If Q
        FileDelete("C:\BBS\USERS\" + $FNAM + ".REG")
     End
Else
     FileDisplay ("help1.txt")
End
End

Program

Welcome

YesNo (Q)

If Not Q
   GoTo EndReg
End

FileAppend (1,"C:\BBS\USERS\" + $FNAM + ".REG")
FileOpen (2,"C:\BBS\USERS\QWEST.TXT)

WriteInfo
NewQwest:
Read
If Fin
     GoTo EndReg
End
Check
Save
Skip
If Fin
     GoTo EndReg
End
GoTo NewQwest
EndReg:
ExitReg
FileClose (1)
FileClose (2)
//If Q
//     Call sma.tsr
//     Exit
//Else
     Exit
//End
End