*/
Know a good article or link that we're missing? Submit it!
*/

View \CHATOLD.PAS

Full Source Code To Vision Bbs System

Submitted By: WEBMASTER
Rating: (Not rated) (Rate It)


{$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }

unit chatstuf;        (* Chat Mode and F2 Keys *)

interface

uses crt,dos,
     gentypes,gensubs,subs1,userret,flags,mainr1,modem,windows,statret,
     configrt,ExecSwap;

function specialcommand:boolean;
procedure specialseries;
procedure chat (gotospecial:boolean);
procedure regchat;

implementation

function specialcommand:boolean;


Const Right=#205;       (* Constants used to define the arrow keys *)
      Left=#203;
      Up=#200;
      Down=#208;
      NormFore=10;      (* Color Constants *)
      NormBack=1;
      HighFore=4;
      HighBack=7;
      SwapLoc:Array[Boolean] of String[7]=('on disk','in EMS')(* Full Mem
                                                                     Swaps *)


Var C:Char;
    Quit:Boolean;
    Major,Minor,Mainx,Mainy:Integer;

    Function ReadStri:Mstr;
    Var MM:Mstr;
    Begin
      ReadLine(MM);
      ReadStri:=MM;
    End;

    Procedure SendMsg(M:Lstr);
    Begin
      ClearBreak;
      GotoXy(MainX,MainY);
      ClrEol;
      WriteLn(M);
    End;

    Procedure SplitEm;
    Var Cnt:Integer;
    Begin
      If SplitMode then Unsplit;
      GotoXy(1,15);
      TextColor(9);
      For Cnt:=1 to 80 Do Write(Usr,'?');
    End;

    Procedure ClearTop;
    Var Cnt:Integer;
    Begin
      For Cnt:=1 to 14 Do
      Begin
        GotoXy(1,Cnt);
        ClrEol;
      End;
    End;

    Procedure DrawABox(Count:Integer; Msg:Lstr); (* DrawABox(Rows,Message); *)
    Var Cnt:Integer;
    Begin
    TextColor(NormFore);
    TextBackground(NormBack);
    ClearTop;
    GotoXy(1,1);
    Write(Usr,'?');
    For Cnt:=1 to 78 Do Write(Usr,'?');
    Write(Usr,'?');
    For Cnt:=1 to Count Do
      Begin
      GotoXy(1,1+Cnt);
      Write(Usr,'?');
      GotoXy(80,1+Cnt);
      Write(Usr,'?');
      End;
    GotoXy(1,Count+2);
    Write(Usr,'?');
    For Cnt:=1 to (38-(Length(Msg) div 2)) Do
     Write(Usr,'?');
     Write(Usr,'[ '+Msg+' ]');
     While WhereX<80 Do Write(Usr,'?');
     Write(Usr,'?');
    End;

    Procedure DrawMain;
    Begin
      ClearTop;
      GotoXy(22,2);
      TextBackground(NormBack);
      TextColor(NormFore);
      WriteLn(Usr,'ViSiON Online Editing Commands');
      GotoXy(15,4);
      WriteLn(Usr,'[Ret] To accept [Esc] to Exit [Arrows] to Move');
      Major:=1;
      Minor:=1;
    End;

    Procedure WriteXy(A,B:Integer; M:String);
    Begin
      GotoXy(A,B);
      Write(Usr,M);
    End;

    Procedure UpdateMajor;
    Begin
      TextBackground(NormBack);
      TextColor(NormFore);
      WriteXy(8,6,' User Editing ');
      WriteXy(22,6,' Access Flags ');
      WriteXy(36,6,' Other Commands ');
      WriteXy(52,6,' External Commands ');
      TextBackground(HighBack);
      TextColor(HighFore);
      Case Major of
        1:WriteXy(8,6,' User Editing ');
        2:WriteXy(22,6,' Access Flags ');
        3:WriteXy(36,6,' Other Commands ');
        4:WriteXy(52,6,' External Commands ');
      End;
      TextBackground(0);
      TextColor(15);
    End;

    Procedure DoUserEditing;
    Var T:Mstr;
        Tx:Integer;
        LastMinor,Cnet:Integer;

     Procedure DoTop;
     Var Cnt:Integer;
     Begin
     DrawABox(12,'ViSiON User Editing');
     Minor:=1;
    End;

    Procedure ClearBytes(Byt:Integer);
    Var X,Y,Cnt:Integer;
    Begin
      X:=WhereX;
      Y:=WhereY;
      For Cnt:=1 to Byt Do Write(Usr,' ');
      GotoXy(X,Y);
    End;

    Procedure DrawThem;
    Begin
      TextBackGround(NormBack);
      TextColor(NormFore);
      WriteXy(4,2,'[ User #'+Strr(Unum)+' ]  ');
      WriteXy(50,2,'[ PgDn for More ]');
      Case LastMinor of
           1:Begin
              WriteXy(3,3,' Handle ');
              WriteXy(16,3,urec.handle+'         ');
             End;
           2:Begin
              WriteXy(3,4,' Name ');
              WriteXy(16,4,Urec.RealName+'           ');
             End;
           3:Begin
              WriteXy(3,5,' Level ');
              WriteXy(16,5,Strr(Urec.Level)+'    ');
             End;
           4:Begin
              WriteXy(3,6,' G-F Lvl ');
              WriteXy(16,6,Strr(Urec.Glevel)+'    ');
             End;
           5:Begin
              WriteXy(3,7,' G-F Pts ');
              WriteXy(16,7,strr(Urec.Gpoints)+'    ');
             End;
            6:Begin
               WriteXy(3,8,' File Lvl ');
               WriteXy(16,8,Strr(Urec.UDLevel)+'    ');
              End;
            7:Begin
               WriteXy(3,9,' File Pts ');
               WriteXy(16,9,strr(Urec.UDPoints)+'    ');
              End;
            8:Begin
               WriteXy(3,10,' Password ');
               WriteXy(16,10,Urec.PassWord+'    ');
              End;
            9:Begin
               WriteXy(3,11,' Phone Num ');
               WriteXy(16,11,Urec.PhoneNum+'    ');
              End;
            10:Begin
                WriteXy(3,12,' Daily Time ');
                WriteXy(16,12,strr(Urec.TimeLimits)+'    ');
               End;
            11:Begin
                WriteXy(3,13,' User Note ');
                WriteXy(16,13,Urec.UserNote);
               End;
            15:Begin
                WriteXy(57,6,' U/D Ratio ');
                WriteXy(70,6,Strr(Urec.UDRatio)+'    ');
               End;
            12:Begin
                WriteXy(57,3,' U/D K Ratio ');
                WriteXy(70,3,strr(Urec.UDKRatio)+'    ');
               End;
            13:Begin
                WriteXy(57,4,' PCR ');
                WriteXy(70,4,strr(Urec.PCRatio)+'    ');
               End;
            14:WriteXy(57,5,' Time Left ');
            16:Begin
                WriteXy(57,7,' Posts ');
                WriteXy(70,7,Strr(Urec.Nbu));
               End;
            17:Begin
                WriteXy(57,8,' Uploads ');
                WriteXy(70,8,Strr(Urec.Uploads));
               End;
            18:Begin
                WriteXy(57,9,' Downloads ');
                WriteXy(70,9,Strr(Urec.Downloads));
               End;
            19:Begin
                WriteXy(57,10,' U/L KB ');
                WriteXy(70,10,Strr(Urec.UpKay)+'k');
               End;
            20:Begin
                WriteXy(57,11,' D/L KB ');
                WriteXy(70,11,Strr(Urec.Dnkay)+'k');
               End;
            21:Begin
                WriteXy(57,12,' Calls ');
                WriteXy(70,12,Strr(Urec.NumOn));
               End;
            22:Begin
                WriteXy(57,13,' Exp Date ');
                If DateStr(Urec.ExpDate)='0/0/80' then WriteXy(70,13,'N/A      ')
                  Else
                WriteXy(70,13,DateStr(Urec.ExpDate));
               End;
            End; (* End Case *)
      TextBackGround(HighBack);
      TextColor(HighFore);
      Case Minor of
          1:WriteXy(3,3,' Handle ');
          2:WriteXy(3,4,' Name ');
          3:WriteXy(3,5,' Level ');
          4:WriteXy(3,6,' G-F Lvl ');
          5:WriteXy(3,7,' G-F Pts ');
          6:WriteXy(3,8,' File Lvl ');
          7:WriteXy(3,9,' File Pts ');
          8:WriteXy(3,10,' Password ');
          9:WriteXy(3,11,' Phone Num ');
          10:WriteXy(3,12,' Daily Time ');
          11:WriteXy(3,13,' User Note ');
          15:WriteXy(57,6,' U/D Ratio ');
          12:WriteXy(57,3,' U/D K Ratio ');
          13:WriteXy(57,4,' PCR ');
          14:WriteXy(57,5,' Time Left ');
          16:WriteXy(57,7,' Posts ');
          17:WriteXy(57,8,' Uploads ');
          18:WriteXy(57,9,' Downloads ');
          19:WriteXy(57,10,' U/L KB ');
          20:WriteXy(57,11,' D/L KB ');
          21:WriteXy(57,12,' Calls ');
          22:WriteXy(57,13,' Exp Date ');
      End;
      LastMinor:=Minor;
      TextBackground(NormBack);
      TextColor(NormFore);
    End;

    Procedure Goty(X,Y,B:Integer);
    Begin
    GotoXy(X,Y);
    ClearBytes(b);
    End;

    Procedure DoSecondPage;

      Procedure DoT;
      Begin
       DrawABox(9,'ViSiON User Editing Page 2');
       Minor:=1;
      End;

      Procedure DrawSome;
      Begin
       TextColor(NormFore);
       TextBackground(NormBack);
       WriteXy(3,2,'[ User # '+Strr(Unum)+' ]');
       WriteXy(50,2,'[ PgUp for More ]');
       WriteXy(3,3,' Time in bank ');
       WriteXy(19,3,Strr(Urec.TimeBank));
       WriteXy(3,4,' G-File Uls ');
       WriteXy(19,4,Strr(Urec.Nup));
       WriteXy(3,5,' G-File Dls ');
       WriteXy(19,5,Strr(Urec.Ndn));
       WriteXy(3,6,' Sysop Note ');
       WriteXy(19,6,Urec.SpecialSysopNote);
       WriteXy(3,7,' Wanted Flag ');
       WriteXy(19,7,YesNo(Wanted in Urec.Config)+' ');
       WriteXy(3,8,' Macro 1 ');
       WriteXy(19,8,Urec.Macro1);
       WriteXy(3,9,' Macro 2 ');
       WriteXy(19,9,Urec.Macro2);
       WriteXy(3,10,' Macro 3 ');
       WriteXy(19,10,urec.macro3);
       TextColor(HighFore);
       TextBackground(HighBack);
       Case Minor of
         1:WriteXy(3,3,' Time in bank ');
         2:WriteXy(3,4,' G-File Uls ');
         3:WriteXy(3,5,' G-File Dls ');
         4:WriteXy(3,6,' Sysop Note ');
         5:WriteXy(3,7,' Wanted Flag ');
         6:WriteXy(3,8,' Macro 1 ');
         7:WriteXy(3,9,' Macro 2 ');
         8:WriteXy(3,10,' Macro 3 ');
       End;
       TextColor(NormFore);
       TextBackground(NormBack);
      End;

      Begin
        DoT;
        Repeat
          DrawSome;
          C:=BiosKey;
          Case C of
            Left,Up:Dec(Minor);
            Right,Down:Inc(Minor);
            #13:Begin
                GotY(19,Minor+2,37);
                Case Minor of
                 1:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.TimeBank:=Tx;
                    SendMsg('Your time in your time bank has been set to '+Strr(Tx));
                   End;
                 2:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.Nup:=Tx;
                    SendMsg('Your G-File Uploads have been set to '+Strr(Tx));
                   End;
                 3:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.Ndn:=Tx;
                    SendMsg('Your G-File Downloads have been set to '+Strr(Tx));
                   End;
                 4:Begin
                    T:=ReadStri;
                    If T<>'' then Urec.SpecialSysopNote:=T;
                   End;
                 5:If Wanted in Urec.Config then Urec.Config:=Urec.Config-[Wanted] Else
                    Urec.Config:=Urec.Config+[Wanted];
                 6:Begin
                    T:=ReadStri;
                    If T<>'' then Urec.Macro1:=T;
                    SendMsg('Your macro #1 has been changed to '+T);
                   End;
                 7:Begin
                    t:=readstri;
                    if t<>'' then Urec.Macro2:=T;
                    SendMsg('Your Macro #2 has been changed to '+T);
                   End;
                 8:Begin
                    t:=ReadStri;
                    If T<>'' then Urec.Macro2:=T;
                    SendMsg('Your Macro #3 has been changed to '+T);
                   End;
            End;
            c:=#0;
          End;
          End;
            If Minor=0 then Minor:=8;
            If Minor=9 then Minor:=1;
        Until C in [#27,#201];
      End;

    Begin
      DoTop;
      LastMinor :=1;
      For Cnet:=1 to 22 Do
      Begin
        Minor:=Cnet;
        Drawthem;
        End;
      Minor:=1;
      DrawThem;
      Repeat
        C:=BiosKey;
         Case C Of
           Up:Dec(Minor);
           Down:Inc(Minor);
           Right,Left:If Minor<12 then Minor:=Minor+11 Else Minor:=Minor-11;
           #209:Begin
                DoSecondPage;
                If C<>#27 then Begin
                DoTop;
                LastMinor:=1;
                For Cnet:=1 to 22 do
                 Begin
                   Minor:=Cnet;
                   DrawThem;
                   End;
                 Minor:=1;
                 DrawThem;
                 End;
           End;
           #13:Begin
               If Minor<12 Then Goty(16,Minor+2,35)
                 Else
                 Goty(70,Minor+2-11,5);
               Case Minor Of
                1:Begin
                   T:=ReadStri;
                   If T<>'' then Urec.Handle:=T;
                   SendMsg('Your Handle has been changed to '+Urec.Handle);
                  End;
                2:Begin
                   T:=ReadStri;
                   If T<>'' then Urec.RealName:=T;
                   SendMsg('Your Real Name has been Changed to '+Urec.RealName);
                  End;
                3:Begin
                   T:=ReadStri;
                   Tx:=Valu(T);
                   Urec.Level:=Tx;
                   Ulvl:=Tx;
                   SendMsg('You have been granted '+Strr(Urec.Level)+' Access.');
                  End;
                4:Begin
                   T:=ReadStri;
                   Tx:=Valu(T);
                   Urec.Glevel:=Tx;
                   SendMsg('Your G-File Level has been changed to '+Strr(Urec.Glevel));
                  End;
                5:Begin
                   T:=ReadStri;
                   Tx:=Valu(T);
                   Urec.Gpoints:=Tx;
                   SendMsg('You have been given '+Strr(Urec.Gpoints)+' G-File Points');
                  End;
                6:Begin
                   T:=ReadStri;
                   Tx:=Valu(T);
                   Urec.Udlevel:=Tx;
                   SendMsg('Your Upload/Download Level has been set to '+Strr(Urec.UdLevel));
                  End;
                7:Begin
                   T:=ReadStri;
                   Tx:=Valu(T);
                   Urec.UdPoints:=Tx;
                   SendMsg('You now have '+strr(Urec.UdPoints)+' file points.');
                  End;
                8:Begin
                   T:=ReadStri;
                   If T<>'' then Urec.Password:=T;
                   SendMsg('Your password has been changed to '+Urec.Password);
                  End;
                9:Begin
                   T:=ReadStri;
                   If T<>'' then Urec.PhoneNum:=T;
                   SendMsg('Your Phone Number has been changed to '+Urec.PhoneNum);
                  End;
                10:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.TimeLimits:=Tx;
                    SendMsg('Your daily time limit has been set to '+Strr(Urec.TimeLimits));
                   End;
                11:Begin
                    T:=ReadStri;
                    If T<>'' then
                      Urec.UserNote:=T;
                    SendMsg('Your Account Note has been Changed to '+Urec.UserNote);
                   End;
                15:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.UDRatio:=Tx;
                    SendMsg('Your minimum Upload/Download ratio has been set to '+Strr(Urec.UdRatio));
                   End;
                12:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.UDKRatio:=Tx;
                    SendMsg('Your minimum Upload/Download K Ratio has been set to '+Strr(urec.Udkratio));
                   End;
                13:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.PCRatio:=Tx;
                    SendMsg('Your minimum Post/Call Ratio has been set to '+Strr(Urec.PCRatio));
                   End;
                14:Begin
                    T:=ReadStri;
                    GotY(70,5,5);
                    SetTimeLeft(Valu(T));
                    bottomline;
                    SendMsg('You have been given '+Strr(Valu(T))+' Minutes for today.');
                   End;
                16:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.Nbu:=Tx;
                    SendMsg('Your POSTS have been set to '+Strr(Urec.Nbu));
                   End;
                17:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.Uploads:=Tx;
                    SendMsg('Your Uploads have been set to '+Strr(Urec.Uploads));
                   End;
                18:Begin
                   T:=ReadStri;
                   Tx:=Valu(T);
                   Urec.Downloads:=Tx;
                   SendMsg('Your Downloads have been set to '+Strr(Urec.Downloads));
                  End;
                19:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.UpKay:=Tx;
                    SendMsg('Your Upload K-Bytes have been set to '+Strr(Tx)+'k');
                   End;
                20:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.DnKay:=Tx;
                    SendMsg('Your Download K-Bytes have been set to '+Strr(Tx)+'k');
                   End;
                21:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.NumOn:=Tx;
                    SendMsg('Your total calls have been set to '+Strr(Tx));
                   End;
                22:Begin
                    T:=ReadStri;
                    If T<>'' then Begin
                      Urec.ExpDate:=DateVal(T);
                      SendMsg('Your Expiration Date has been set to '+DateStr(Urec.ExpDate));
                   End;
                End;
               End;
           End;
         End;
         If Minor=23 then Minor:=1;
         If Minor=0 then Minor:=22;
        DrawThem;
      Until C=#27;
    End;

  Procedure DoAccessFlags;

  Procedure DrawTop;
  Var Cnt:Integer;
  Begin
   DrawABox(4,'Access Flag Editing Commands');
   Minor:=1;
  End;

  Procedure GetMainConferences;

     Procedure DrawT;
     Var Cnt:Integer;
     Begin
       DrawABox(5,'Access to Main Conferences');
       Minor:=1;
     End;

   Procedure Choices;
   Var CountMe:Integer;
   Begin
    TextBackground(NormBack);
    TextColor(NormFore);
    for countme:=1 to 5 do
    Begin
      GotoXy(31,1+CountMe);
      Write(Usr,' Conference ',countme,' - ');
      if Urec.Conf[CountMe] then Write(Usr,'Yes ') else
       Write(Usr,'No  ');
    End;
    GotoXy(31,1+Minor);
    TextColor(HighFore);
    TextBackground(HighBack);
    Write(Usr,' Conference ',Minor,' - ');
    If Urec.Conf[Minor] then Write(Usr,'Yes ') else Write(Usr,'No  ');
    TextColor(NormFore);
    TextBackground(NormBack);
    End;


   Begin
     DrawT;
     Repeat
      Choices;
      C:=BiosKey;
      Case C Of
        Left,Up:Dec(Minor);
        Down,Right:Inc(Minor);
        #13:Begin
            Urec.Conf[Minor]:=Not Urec.Conf[Minor];
            If Urec.Conf[Minor] then SendMsg('You have been granted access to main conference #'+Strr(Minor))
            Else SendMsg('You have been denied access to Main Conference #'+Strr(Minor));
          End;
       End;
       If Minor>5 then Minor:=1;
       If Minor<1 then Minor:=5;
      Until C=#27;
   End;

  Procedure GetSubConferences;
  Var T:Mstr;
      Tx:Integer;

  Procedure ShowSubs;
   Var Cnt:Integer;
   Begin
     ClearTop;
     GotoXy(1,1);
     WriteLn(Usr,'                       Sub Conference Access Flags');
     Write(Usr,^M^J);
     Write(Usr,'         ');
     For Cnt:=1 to 18 do
      If Urec.Confset[Cnt]>0 then Write(Usr,Cnt,',') Else
      Write(Usr,'0,');
     Write(Usr,^M^J);
     Write(Usr,'         ');
     For Cnt:=19 to 31 Do
       If Urec.Confset[Cnt]>0 then Write(Usr,Cnt,',') Else
       Write(Usr,'0,');
     If Urec.ConfSet[32]>0 then WriteLn(Usr,'32') else writeLn(Usr,'0')<