*/
Stuck? Need help? Ask questions on our forums.
*/

View \CHATSTUF.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,FastTTT5,WinTTT5,MenuTTT5,PullTTT5;

function specialcommand:boolean;
procedure specialseries;
procedure chat (gotospecial,color:boolean);
Procedure BustChat;

implementation


  procedure write1 (l:lstr);
  begin
   gotoxy (25,5);
   textcolor (12);
   textbackground (0);
   write (usr,l);
  end;

  function getstring (t:anystr):anystr;
  var mm,lz:anystr;
  begin
    textbackground (0);
    textcolor (12);
    write (usr,t);
    readline (mm);
    getstring:=mm;
  end;

function specialcommand:boolean;


Const Right=#205;       (* Constants used to define the arrow keys *)
      Left=#203;
      Up=#200;
      Down=#208;
      NormFore=15;      (* Color Constants *)
      NormBack=1;
      HighFore=1;
      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;
    Main_Choice,Choice,Error:integer;
    ScanTop, ScanBot:byte;
    M1,MM:Menu_record;
    Ch:char;
    X,Y:Byte;
    Done:Boolean;

    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(Where:Byte);
    Var Cnt:Integer;
    Begin
      FillScreen(1,1,80,Where,blue,blue,chr(176)); Main_Choice:=1;
      TextColor(8);
      Textbackground(1);
      For CNT:=1 to 80 Do Begin
        Gotoxy(cnt,Where+1);
        Write(usr,'?');
      End;
      TextColor(15);
    End;

    Procedure DrawABox(Count:Integer; Msg:Lstr);
    Var Cnt:Integer;
    Begin
    TextColor(9);
    TextBackground(NormBack);
    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,'?');
     Textcolor(12);
     Write(Usr,'[ '+Msg+' ]');
     TextColor(9);
     While WhereX<80 Do Write(Usr,'?');
     Write(Usr,'?');
     TextBackground(0);
    End;

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

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

     Procedure DoTop;
     Var Cnt:Integer;
     Begin
     ClearTop(20);
     DrawABox(17,'ViSiON v0.82 Online 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;
     Procedure yel;
     Begin
     Textcolor(14);
     End;
    Begin
      TextBackGround(NormBack);
      TextColor(NormFore);
      WriteXy(33,2,'Editing User #'+Strr(Unum)+'   ');
      Case LastMinor of
           1:Begin
              WriteXy(3,3,' Handle ');yel;
              WriteXy(16,3,urec.handle+'         ');
             End;
           2:Begin
              WriteXy(3,4,' Name ');yel;
              WriteXy(16,4,Urec.RealName+'           ');
             End;
           3:Begin
              WriteXy(3,5,' Level ');yel;
              WriteXy(16,5,Strr(Urec.Level)+'    ');
             End;
           4:Begin
              WriteXy(3,6,' G-F Lvl ');yel;
              WriteXy(16,6,Strr(Urec.Glevel)+'    ');
             End;
           5:Begin
              WriteXy(3,7,' G-F Pts ');yel;
              WriteXy(16,7,strr(Urec.Gpoints)+'    ');
             End;
            6:Begin
               WriteXy(3,8,' File Lvl ');yel;
               WriteXy(16,8,Strr(Urec.UDLevel)+'    ');
              End;
            7:Begin
               WriteXy(3,9,' File Pts ');yel;
               WriteXy(16,9,strr(Urec.UDPoints)+'    ');
              End;
            8:Begin
               WriteXy(3,10,' Password ');yel;
               WriteXy(16,10,Urec.PassWord+'    ');
              End;
            9:Begin
               WriteXy(3,11,' Phone Num ');yel;
               WriteXy(16,11,Urec.PhoneNum+'    ');
              End;
            10:Begin
                WriteXy(3,12,' Daily Time ');yel;
                WriteXy(16,12,strr(Urec.TimeLimits)+'    ');
               End;
            11:Begin
                WriteXy(3,13,' User Note ');yel;
                WriteXy(16,13,Urec.UserNote+'     ');
               End;
            12:Begin
                WriteXy(3,14,' Macro 1 ');yel;
                WriteXy(16,14,Urec.Macro1+'     ');
               End;
            13:Begin
                WriteXy(3,15,' Macro 2 ');yel;
                WriteXy(16,15,Urec.Macro2+'      ');
               End;
            14:Begin
                WriteXy(3,16,' Macro 3 ');yel;
                WriteXy(16,16,urec.macro3+'       ');
               End;
            15:Begin
                WriteXy(3,17,' Sysop Note ');yel;
                WriteXy(16,17,Urec.SpecialSysopNote+'    ');
               End;
            16:Begin
                WriteXy(57,3,' UD K Ratio ');yel;
                WriteXy(70,3,strr(Urec.UDKRatio)+'    ');
               End;
            17:Begin
                WriteXy(57,4,' PCR ');yel;
                WriteXy(70,4,strr(Urec.PCRatio)+'    ');
               End;
            18:WriteXy(57,5,' Time Left ');
            19:Begin
                WriteXy(57,6,' U/D Ratio ');yel;
                WriteXy(70,6,Strr(Urec.UDRatio)+'    ');
               End;
            20:Begin
                WriteXy(57,7,' Posts ');yel;
                WriteXy(70,7,Strr(Urec.Nbu)+'    ');
               End;
            21:Begin
                WriteXy(57,8,' Uploads ');yel;
                WriteXy(70,8,Strr(Urec.Uploads)+'  ');
               End;
            22:Begin
                WriteXy(57,9,' Downloads ');yel;
                WriteXy(70,9,Strr(Urec.Downloads)+'  ');
               End;
            23:Begin
                WriteXy(57,10,' U/L KB ');yel;
                WriteXy(70,10,Strr(Urec.UpKay)+'k');
               End;
            24:Begin
                WriteXy(57,11,' D/L KB ');yel;
                WriteXy(70,11,Strr(Urec.Dnkay)+'k');
               End;
            25:Begin
                WriteXy(57,12,' Calls ');yel;
                WriteXy(70,12,Strr(Urec.NumOn));
               End;
            26:Begin
                WriteXy(57,13,' Exp Date ');yel;
                If DateStr(Urec.ExpDate)='0/0/80' then WriteXy(70,13,'N/A      ')
                  Else
                WriteXy(70,13,DateStr(Urec.ExpDate));
               End;
            27:Begin
                WriteXy(57,14,' Wanted Flag ');yel;
                WriteXy(70,14,YesNo(Wanted in Urec.Config)+' ');
                End;
            28:Begin
                WriteXy(57,15,' Time bank ');yel;
                WriteXy(70,15,Strr(Urec.TimeBank)+'    ');
               End;
            29:Begin
                WriteXy(57,16,' GFile Uls ');yel;
                WriteXy(70,16,Strr(Urec.Nup)+'    ');
               End;
            30:Begin
                WriteXy(57,17,' GFile Dls ');yel;
                WriteXy(70,17,Strr(Urec.Ndn)+'  ');
               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 ');
          12:Writexy(3,14,' Macro 1 ');
          13:writexy(3,15,' Macro 2 ');
          14:writexy(3,16,' Macro 3 ');       
          15:writexy(3,17,' SysOp Note ');
          16:WriteXy(57,3,' UD K Ratio ');
          17:WriteXy(57,4,' PCR ');
          18:WriteXy(57,5,' Time Left ');
          19:WriteXy(57,6,' U/D Ratio ');
          20:WriteXy(57,7,' Posts ');
          21:WriteXy(57,8,' Uploads ');
          22:WriteXy(57,9,' Downloads ');
          23:WriteXy(57,10,' U/L KB ');
          24:WriteXy(57,11,' D/L KB ');
          25:WriteXy(57,12,' Calls ');
          26:WriteXy(57,13,' Exp Date ');
          27:WriteXy(57,14,' Wanted Flag ');
          28:Writexy(57,15,' Time Bank');
          29:Writexy(57,16,' GFile ULs');
          30:writexy(57,17,' GFile DLs');
      End;
      LastMinor:=Minor;
      TextBackground(NormBack);
      TextColor(NormFore);
    End;

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

    Begin
      DoTop;
      LastMinor :=1;
      For Cnet:=1 to 30 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<16 then Minor:=Minor+15 Else Minor:=Minor-15;
           #13:Begin
               If Minor<16 Then Goty(16,Minor+2,35)
                 Else
                 Goty(70,Minor+2-15,5);
               OnCursor;
               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;
                12:Begin
                    T:=ReadStri;
                    If T<>'' then Urec.Macro1:=T;
                    SendMsg('Your macro #1 has been changed to '+T);
                   End;
                 13:Begin
                    t:=readstri;
                    if t<>'' then Urec.Macro2:=T;
                    SendMsg('Your Macro #2 has been changed to '+T);
                   End;
                 14:Begin
                    t:=ReadStri;
                    If T<>'' then Urec.Macro2:=T;
                    SendMsg('Your Macro #3 has been changed to '+T);
                   End;
                15:Begin
                    T:=ReadStri;
                    If T<>'' then Urec.SpecialSysopNote:=T;
                   End;
                19:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.UDRatio:=Tx;
                    SendMsg('Your minimum Upload/Download ratio has been set to '+Strr(Urec.UdRatio));
                   End;
                16:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.UDKRatio:=Tx;
                    SendMsg('Your minimum Upload/Download K Ratio has been set to '+Strr(urec.Udkratio));
                   End;
                17:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.PCRatio:=Tx;
                    SendMsg('Your minimum Post/Call Ratio has been set to '+Strr(Urec.PCRatio));
                   End;
                18:Begin
                    T:=ReadStri;
                    GotY(70,5,5);
                    SetTimeLeft(Valu(T));
                    bottomline;
                    SendMsg('You have been given '+Strr(Valu(T))+' Minutes for today.');
                   End;
                20:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.Nbu:=Tx;
                    SendMsg('Your POSTS have been set to '+Strr(Urec.Nbu));
                   End;
                21:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.Uploads:=Tx;
                    SendMsg('Your Uploads have been set to '+Strr(Urec.Uploads));
                   End;
                22:Begin
                   T:=ReadStri;
                   Tx:=Valu(T);
                   Urec.Downloads:=Tx;
                   SendMsg('Your Downloads have been set to '+Strr(Urec.Downloads));
                  End;
                23:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.UpKay:=Tx;
                    SendMsg('Your Upload K-Bytes have been set to '+Strr(Tx)+'k');
                   End;
                24:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.DnKay:=Tx;
                    SendMsg('Your Download K-Bytes have been set to '+Strr(Tx)+'k');
                   End;
                25:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.NumOn:=Tx;
                    SendMsg('Your total calls have been set to '+Strr(Tx));
                   End;
                26:Begin
                    T:=ReadStri;
                    If T<>'' then Begin
                      Urec.ExpDate:=DateVal(T);
                      SendMsg('Your Expiration Date has been set to '+DateStr(Urec.ExpDate));
                   End;
                End;
                27:If Wanted in Urec.Config then Urec.Config:=Urec.Config-[Wanted] Else
                    Urec.Config:=Urec.Config+[Wanted];
                28:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.TimeBank:=Tx;
                    SendMsg('Your time in your time bank has been set to '+Strr(Tx));
                   End;
                 29:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.Nup:=Tx;
                    SendMsg('Your G-File Uploads have been set to '+Strr(Tx));
                   End;
                 30:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.Ndn:=Tx;
                    SendMsg('Your G-File Downloads have been set to '+Strr(Tx));
                   End;
               End;
              OffCursor;
           End;
           End;
         If Minor=31 then Minor:=1;
         If Minor=0 then Minor:=30;
        DrawThem;
      Until C=#27;
      TextBackGround(0);
      FillScreen(1,1,80,24,white,blue,chr(176));
      Main_Choice:=1;
    End;

Procedure DoAccessFlags;
Var Quit:Boolean;
  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
     ClearTop(7);
     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;
      FillScreen(1,1,80,24,white,blue,chr(176));
      Main_Choice:=1;
   End;

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

  Procedure ShowSubs;
   Var Cnt:Integer;
   Begin
     ClearTop(7);
     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');
   End;

   Begin
     Repeat
       ShowSubs;
       Write(Usr,^M^J);
       Write(Usr,'Enter conference to change, or [Return] to exit:');
       T:=ReadStri;
       If T<>'' then Begin
         Tx:=Valu(T);
         If (Tx>0) and (TX<33) then
           If Urec.ConfSet[Tx]=0 then Urec.Confset[Tx]:=1 Else
           Urec.Confset[Tx]:=0;
         End;
       Until T='';
       FillScreen(1,1,80,24,white,blue,chr(176));
       Main_Choice:=1;