Stuck? Need help? Ask questions on our forums.

View \VISNET01.PAS

Full Source Code To Vision Bbs System

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


{ Ok Doug, I just throw it all together.. }

     boardrec=record     (* Bulletin Records.. so you don't get lost
       boardname:mstr;      in this mess! *)

       sponsor:string[34];
       echo:Byte;
       level,autodel:integer;
       shortname:sstr;
       conference:byte
     end;

     Newsrec=Record
        Location:Integer;
        Level:Integer;
        From:mstr;
        When:longint;
        Title:String[28];
        MaxLevel:Integer;
      End;

     BulRec=record                (* Message Header Record *)
        leftby,leftto:String[30];
        title,status:String[30];
        when:longint;
        where:lstr;
        where2:lstr;
        version:byte;
        anon,recieved:boolean;
        line,plevel:integer;
        id:word;
        cnet,fidonet,flag3,flag4,flag5,flag6,flag7,flag8:boolean;
        realname:String[30];
     end;

     NodeNetRec=Record                 (* Node List Record *)
         Pass:Mstr;
         Name:Mstr;
         Phone:string[12];
         Baud:Word;
         LastDate:Longint;
         Celerity,Fido,Cnet,Flag4,Flag5,Flag6:Boolean;
         Node:string[10];
         BaseSelection:Array[1..255] of boolean;
     end;



(* This is from the WFC side when Net-Mail is forced *)

Procedure Do_Net_Mail;               (* ViSiON NetMail Version 1.01 *)
Var NodeRec:NodeNetRec;
    CurrentNodeNumber,NumMsgs:Integer;
    Fnode:File of NodeNetRec;
    chrr:Char;
    simplex:boolean;
    jo:integer;
    finished:boolean;
    oktosend:BooLean;

  Function FindBaseName(BaseId:Byte):SStr;
  Var Board:BoardRec;
      Fbd:File of BoardRec;
      Sek:Integer;
  Begin           (* Echo should equal baseId *)
      Assign(Fbd,ConfigSet.BoardDi+'BoardDir');
      Reset(Fbd);
      Sek:=0;
      FindBaseName:='';
      Repeat
        Seek(Fbd,Sek);
        Read(Fbd,Board);
        Inc(Sek);
        If Board.Echo=BaseId then FindBaseName:=Board.ShortName;
      Until (Board.Echo=BaseId) or Eof(Fbd);
      Close(Fbd);
  End;             (* End FindBaseName *)

  Procedure SendString(S:Lstr);
  Var I:Integer;
  Begin
       For I:=1 to Length(S) Do SendChar(S[I]);
  End;     (* End Send String *)

  procedure UpDateStory(Nums:Integer; Sent,Upgraded:Boolean);
  Var T:Text;
  Begin
                appendfile(configset.forumdi+'Notices.BBS',t);
                WriteLn(T,^M^S'????????????????????????????????????????????????????????????????????????');
    WriteLn(T,^R'             On '+DateStr(Now)+' at '+TimeStr(Now)+' The Following Happened');
    if not Sent then WriteLn(T,^R'('+Strr(Nums)+') Messages were sent to '+NodeRec.Name)
    else WriteLn(T,^R'('+Strr(Nums)+') Messages were received from '+NodeRec.Name);
    If Upgraded then WriteLn(T,^R'An Upgrade was received with this packet!');
    WriteLn(T,^S'????????????????????????????????????????????????????????????????????????'^M);
    TextClose(T);
  End;      (* End UpdateStory *)

  Procedure GetItAll;
  Var C:Char;
  Begin
   While NumChars>0 do
   write(usr,getchar);
  End;                    (* End GetItAll *)


  Procedure SetUpForNetMail;
  Begin
    ClrScr;
    WriteLn(Usr,'ViSiON Netmail version 1.01 (c) 1991 Ruthless Enterprises.');
    If Not Exist(ConfigSet.ForumDi+'NodeList.BBS') then
       Begin
         WriteLn(Usr,'We WOULD send NetMail, BUT there seems to be no one to net with. MAKE');
         WriteLn(Usr,'your NODELIST.BBS file BEFORE trying to attempt netmail!');
         EnsureClosed;
         Halt(0);
       End;      (* End If then Begin *)
    WriteLn(Usr,'First we must disable Auto-Answer!');
    SendString('ATZ'+#13);
    Delay(1500);
    GetItAll;
    SendString('ATS0=0'+#13);
    Delay(500);
    GetItAll;
    WriteLn(Usr,'Now we will go ahead and set the Extended Registers to recognize everything.');
    SendString('ATX6'+#13);
    Delay(500);
    GetItAll;
    WriteLn(Usr,'Now we will open up the Node List file.');
    Assign(Fnode,Configset.ForumDi+'NodeList.BBS');
    Reset(Fnode);
    CurrentNodeNumber:=0;
    WriteLn(Usr,'There. All done.');
  End;                  (* End SetUpForNetMail *)

  Procedure DialNodes;
  Var Packaged:Boolean;


       Function Connected:Boolean;
       Var C:Char;
           S:String;
       Begin
         Delay(9000);
         S:='';
                                 While NumChars>0 Do
                                 Begin
                                         S:=S+getchar;
           If C=#13 then S:='';
           If Pos('[Hit Return]',S)>0 Then
           Begin
             WriteLn(Usr,'We MUST hit return!');
             SendString(#13+#13+#13+#13);
             S:='';
           End;    (* End If then *)
         End;      (* End Repeat Loop *)
         If Carrier then Connected:=True;
       End;         (* End Connected *)

   Procedure DialNode;

       Procedure PrepNetMail;
       Var Ct,Loper:Integer;
       NetPost:NetPostRec;
       FNP:File of NetPostRec;
       Bul:BulRec;
       M:Message;
       Bfile:File of BulRec;
       BaseName:SStr;
       CurBase:Byte;

       Procedure Package;
       Begin
       ClrScr;
       WriteLn(Usr,'Making NetMail Package as per request.');
       CurBase:=0;
       NumMsgs:=0;
       Assign(Fnp,Configset.NetDir+'NetMail.Pkg');
       ReWrite(Fnp);
       Loper:=0;
       While Loper<255 Do
        Begin
           Inc(Loper);
           If NodeRec.BaseSelection[Loper] Then Begin
           BaseName:=FindBaseName(Loper);
           If BaseName<>'' then Begin
           Assign(Bfile,ConfigSet.BoardDi+BaseName+'.BUL');
           Reset(Bfile);
           Ct:=0;
         While Not Eof(Bfile) Do
           Begin
             Seek(Bfile,Ct);
             Read(Bfile,Bul);
             If Bul.When>NodeRec.LastDate Then
               Begin
               Inc(NumMsgs);
               NetPost.NetIdNum:=Loper;
               NetPost.BulletinRec:=Bul;
               ReloadText(Bul.Line,M);
               NetPost.MessageRec:=M;
               Seek(Fnp,FileSize(Fnp));
               Write(Fnp,NetPost);
               End; (* If Bul.When>NodeRec.LastDate *)
             Inc(Ct);
           End(* End While Not Eof *)
         Close(Bfile);
         End;         (* End if basename<>'' *)
         End;         (* End if basethingie *)
       End;           (* End Loper *)
       Close(Fnp);
      End;            (* End Package *)

      Procedure ZipPackage;
      Var F:File;
      Begin
           Exec('PKZIP.EXE',Configset.NetDir+'Net.Zip '+ConfigSet.NetDir+'NetMail.Pkg');
           Assign(F,ConfigSet.NetDir+'NetMail.Pkg');
           Erase(F);
           Close(F);
      End;          (* End ZipPackage *)


      Begin
        Package;
        If NumMsgs>0 Then Begin
        ZipPackage;
        Packaged:=True;
        End;
      End;                    (* End SendOutGoing *)

       Function Call(X:Lstr):Boolean;
       Var Pre,Suf:Lstr;
           Jo:Integer;
           Finished:Boolean;

           Function Busy:Boolean;
           Var K:String;
               C:Char;
           Begin
                K:='';
                                                                While NumChars>0 do k:=k+getchar;
                Busy:=False;
                If Pos('BUSY',K)>0 then Busy:=True;
                If Pos('NO CARRIER',K)>0 Then Busy:=True;
                If Pos('NO DIAL',K)>0 Then Busy:=True;
           End;    (* End Busy *)


       Begin
            ClrScr;
            WriteLn(Usr,'Dialing Number...');
            If X='' then Exit;
            dontanswer;
            Delay(1500);
            Pre:='';
            Suf:='';
            If Length(X)>7 then
               Begin
                    Pre:=ConfigSet.CoPre;
                    Suf:=ConfigSet.CoSuf;
               End;
            If KeyPressed then Chrr:=ReadKey;
            DoAnswer;
            Delay(1200);
            SendString('     ');
            Delay(1600);
            GetItAll;
            SendString('ATDT'+Pre+X+Suf+#13);
            Finished:=False;
            delay(1500);
            GetItAll;
            Jo:=0;
            Repeat
                  Inc(Jo);
                  Delay(10);
                  If Busy then Finished:=True;
                  If Finished then WriteLn(Usr,'Line was busy!'^M);
                  If KeyPressed then Finished:=True;
                  If KeyPressed then WriteLn(Usr,'User Abort!');
                  If Carrier then Finished:=True;
            Until Finished or (Jo>15000);
            SendString(^M);
            Call:=Carrier;
       End;         (* End Call *)


    Begin
       PrepNetMail;
       Window(1,1,80,25);
       ClrScr;
       TextColor(15);
       WriteLn(Usr,'ViSiON NetMail Dialing '+NodeRec.Name+' @'+NodeRec.Phone);
       TextColor(11);
       WriteLn(Usr,'??????????????????????????????????????????????????????????????????????????');
       TextColor(7);
       Window(1,3,80,25);
       Repeat
        delay(2500);
       Until Call(NodeRec.Phone) or
         (Not WithinTime(ConfigSet.NetStc,Configset.NetEnc));
    End; (* End DialNode *)

  Function SuccessfulNetMail:Boolean;
  Var T:Text;
      Received:Boolean;
      F:File;
      I:Integer;

  Procedure SendViaDSZ;
  Begin
  Delay(3000);
  Exec('Dsz.Com',' port '+Strr(Configset.UseCo)+' ha slow speed '+strlong(baudrate)+' sz -m '+Configset.NetDir+'Net.Zip');
    Assign(F,ConfigSet.NetDir+'Net.Zip');
    Erase(F);
    updatestory(NumMsgs,False,False);
    NumMsgs:=0;
  End;                   (* End SendViaDSZ *)

        Function ExecDsz:Boolean;
        var ken:char;
        Begin
                         If Exist(ConfigSet.WorkDir+'Net.Zip') then
                                 Begin
                                         Assign(F,ConfigSet.WorkDir+'Net.Zip');
                                         Erase(F);
                                 End;       (* End If Then *)
                         Delay(500);
                         GetItAll;
                         Repeat
                         Until (NumChars>0) or (Not Carrier);
  Exec('Dsz.Com',' port '+Strr(ConfigSet.UseCo)+' ha slow speed '+strlong(baudrate)+' rz -m '+ConfigSet.WorkDir+'Net.Zip');
       ExecDsz:=True;
  End;

  Procedure ProcessIncomming;
  Var Fnp:File of NetPostRec;
      NetPost:NetPostRec;
      M:Message;
      B:BulRec;
      Bfile:File of BulRec;
      Upgrade,oktosend:Boolean;

      Procedure UnZipNet;
      Var F:File;
      Begin
           SwapVectors;
           Exec(GetEnv('Comspec'),'/C Pkunzip '+ConfigSet.WorkDir+'Net.Zip -o '+ConfigSet.WorkDir);
           Assign(F,Configset.WorkDir+'Net.Zip');
           Erase(F);
           Close(F);
      End;          (* End UnZipNet *)

      Procedure PostMsgs;
      Var F:File;
          TId:Word;
          Current:Byte;
          BaseName:Sstr;
      Begin
           ClrScr;
           Upgrade:=False;
           WriteLn(Usr,'Posting NetMail Messages.');
           If Exist(ConfigSet.WorkDir+'Upgrade.Zip') then
           Begin
             Upgrade:=true;
             Exec(GetEnv('ComSpec'),'/C Copy '+ConfigSet.WorkDir+'Upgrade.Zip '+
             ConfigSet.NetType1Path+'Upgrade.Zip > NUL');
             Assign(F,ConfigSet.WorkDir+'Upgrade.Zip');
             Erase(F);
             Close(F);
           End;
           If Exist(ConfigSet.WorkDir+'NetMail.Pkg') Then
              Begin
                 Assign(Fnp,Configset.WorkDir+'NetMail.Pkg');
                 Reset(Fnp);
                 NumMsgs:=0;
                 Current:=0;
                 While Not Eof(Fnp) Do
                   Begin
                     Read(Fnp,NetPost);
                     If Current<>NetPost.NetIdNum Then Begin
                        BaseName:=FindBaseName(NetPost.NetIdNum);
                        Close(Bfile);
                        If BaseName<>'' Then Begin
                           Assign(Bfile,ConfigSet.BoardDi+BaseName+'.Bul');
                           Reset(Bfile);
                        End;   (* End if basename<>'' *)
                     End;      (* End if current<>netpost.netidnum *)
                   If NetPost.BulletinRec.Where=ConfigSet.Origin1 Then Else
                      Begin
                        Seek(Bfile,FileSize(BFile)-1);
                        Read(Bfile,B);
                        If B.Id=65535 then NetPost.BulletinRec.Id:=1 Else
                            NetPost.BulletinRec.Id:=B.Id+1;
                        B:=NetPost.BulletinRec;
                        M:=NetPost.MessageRec;
                        B.Line:=MakeText(M);
                        B.When:=Now;
                        Seek(Bfile,FileSize(Bfile));
                        Write(Bfile,B);
                        Inc(NumMsgs);
                      End;           (* End if origin is here *)
                   End;              (* End While Not Eof Do Begin *)
                 Close(Fnp);
                 Assign(F,ConfigSet.WorkDir+'NetMail.Pkg');
                 Erase(F);
                NewPosts:=NewPosts+NumMsgs;
                Gnup:=Gnup+NumMsgs;
                WriteStatus;
              End;        (* End If Exist Msgs *)
      End;                (* End PostMsgs *)


      Begin         (* Main ProcessIncomming *)
           UnZipNet;
           PostMsgs;
           UpDateStory(NumMsgs,True,Upgrade);
      End;           (* End ProcessIncomming *)

  Procedure UpDateNode;
  Begin
       NodeRec.LastDate:=Now;
       Seek(Fnode,CurrentNodeNumber);
       Write(Fnode,NodeRec);
  End;                      (* End UpDateNode *)

  Begin
       If Not Carrier And Not WithinTime(ConfigSet.NetStc,ConfigSet.NetEnc) then
          Begin
               SuccessfulNetMail:=True;
               Exit;
          End;
       If Not Connected Then
          Begin
            SuccessfulNetMail:=False;
            WriteLn(Usr,'NetMail failed.. Why???');
            HangUp;
            Delay(1600);
            Exit;
          End;   (* End Delay *)
       SuccessfulNetMail:=False;
       SendString(ConfigSet.NetPas+#13);
       Delay(500);
       GetItAll;
       SendString(NodeRec.Node+#13);
       Delay(500);
       GetItAll;
       SendString(NodeRec.Pass+#13);
       Delay(500);
       GetItAll;
       Delay(1500);
       If Not Carrier then Begin
       Appendfile(ConfigSet.ForumDi+'Notices.BBS',t);
       WriteLn(T,'On '+DateStr(Now)+' at '+TimeStr(Now)+' we had the wrong password');
         WriteLn(T,'when we tried to send netmail to '+NodeRec.Name);
         TextClose(T);
         SuccessfulNetMail:=True;
       End;                      (* End if not carrier *)
       If ConfigSet.NetType1 then SendString('U'+#13);
       oktosend:=False;
       For I:=1 to 255 Do
           Begin
                If NodeRec.BaseSelection[I] Then SendString(Strr(I)+#13);
                If NodeRec.BaseSelection[I] then GetItAll;
                oktosend:=False;
           End;
       SendString('0'+#13);
       Delay(500);
       GetItAll;
       oktosend:=true;
       If Packaged then
          Begin
               SendString('Y'+#13);
               Delay(500);
               GetItAll;
               SendString('Y'+#13); (* This is the "Yes to receive" *)
               If oktosend then SendViaDSZ;
          End Else            (* End if packaged *)
       Begin
         SendString('N'+#13);
         Delay(500);
         GetItAll;
         SendString('Y'+#13); (* yes to receive *)
       end;
       Delay(1500);
       If Not Carrier then Begin
          SuccessfulNetMail:=False;
          Exit;
       End;    (* If Not Carrier *)
       Received:=ExecDsz;
       HangUp;
       If Received then ProcessIncomming;
       UpDateNode;
       SuccessfulNetMail:=True;
  End;                         (* End SuccessfulNetMail *)


  Begin
       While Not Eof(Fnode) Do
       Begin
       Seek(Fnode,CurrentNodeNumber);
       Read(Fnode,NodeRec);
       Repeat
             DialNode;
       Until SuccessfulNetMail;   (* End Loop *)
       Inc(CurrentNodeNumber);
       End;      (* End While Not EofFnode *)
  End;      (* End DialNodes *)

  Procedure ExitNetMail;
  Begin
    ClrScr;
    WriteLn(Usr,'Now we''re done.. Setting back on Auto Answer.');
    DoAnswer;
    SendString('ATZ'+#13);
    Delay(2500);
    GetItAll;
    SendString('ATS0=1'+#13);
    Delay(700);
    GetItAll;
  End;

Begin
     SetUpForNetMail;
     DialNodes;
     ExitNetMail;
     EnsureClosed;
     Halt(0);
End;             (* End Do_Net_Mail *)

(* This is when it is recieved at the MATRIX  *)

 procedure get_incomming;
  var i,j,k,l,NumBase,NodeNumber:integer;
      done,sending,upgrade,email,bulletins:boolean;
      f:file;
      t:text;
      ID,Pass:String;
      Bases:Array[1..255] of Byte;
      NodeRec:NodeNetRec;
      NodeFile:File of NodeNetRec;

      Function ExecDsz:boolean;
      var tries:integer;
           ken:boolean;
           f:file;
      begin
      ken:=false;
      assign(f,configset.workdir+'Net.Zip');
      if exist(configset.workdir+'Net.Zip') then erase(f);
      close(f);
      execdsz:=false;
        tries:=0;
         ClrScr;
         WriteLn(Usr,'Receiving NetMail.');
         exec('DSZ.COM',' port '+strr(configset.useco)+' speed '+strlong(baudrate)+' ha slow rz '+configset.workdir);
         if dosexitcode=0 then ken:=true;
      execdsz:=ken;
  end;             (* End ExecDsz *)

  Function FindBaseName(BaseId:Byte):SStr;
  Var Board:BoardRec;
      Fbd:File of BoardRec;
      Sek:Integer;
  Begin           (* Echo should equal baseId *)
      Assign(Fbd,ConfigSet.BoardDi+'BoardDir');
      Reset(Fbd);
      Sek:=0;
      FindBaseName:='';
      Repeat
        Seek(Fbd,Sek);
        Read(Fbd,Board);
        Inc(Sek);
        If Board.Echo=BaseId then FindBaseName:=Board.ShortName;
      Until (Board.Echo=BaseId) or Eof(Fbd);
      Close(Fbd);
  End;             (* End FindBaseName *)


  Procedure SendOutGoing; (* This sends the outgoing netmail. *)
  Var Ct,Loper,NumMsgs:Integer;
      NetPost:NetPostRec;
      FNP:File of NetPostRec;
      Bul:BulRec;
      M:Message;
      Bfile:File of BulRec;
      BaseName:SStr;
      CurBase:Byte;

      Procedure Package;
      Begin
      ClrScr;
      WriteLn(Usr,'Making NetMail Package as per request.');
      CurBase:=0;
      NumMsgs:=0;
      Assign(Fnp,Configset.NetDir+'NetMail.Pkg');
      ReWrite(Fnp);
      Loper:=0;
      While Loper<NumBase Do
       Begin
         Inc(Loper);
         BaseName:=FindBaseName(Bases[Loper]);
         If BaseName<>'' then Begin
         Assign(Bfile,ConfigSet.BoardDi+BaseName+'.BUL');
         Reset(Bfile);
         Ct:=0;
         While Not Eof(Bfile) Do
           Begin
             Seek(Bfile,Ct);
             Read(Bfile,Bul);
             If Bul.When>NodeRec.LastDate Then
               Begin
               Inc(NumMsgs);
               NetPost.NetIdNum:=Bases[Loper];
               NetPost.BulletinRec:=Bul;
               ReloadText(Bul.Line,M);
               NetPost.MessageRec:=M;
               Seek(Fnp,FileSize(Fnp));
               Write(Fnp,NetPost);
               End; (* If Bul.When>NodeRec.LastDate *)
             Inc(Ct);
           End(* End While Not Eof *)
         Close(Bfile);
         End;         (* End if basename<>'' *)
       End;           (* End Loper *)
       Close(Fnp);
      End;            (* End Package *)

      Procedure ZipPackage;
      Var F:File;
      Begin
           Exec('PKZIP.EXE',Configset.NetDir+'Net.Zip '+ConfigSet.NetDir+'NetMail.Pkg');
           Assign(F,ConfigSet.NetDir+'NetMail.Pkg');
           Erase(F);
           Close(F);
           If Upgrade then if Exist(ConfigSet.NetType1Path+'UPGRADE.ZIP') then
            Exec('PKZIP.EXE',configset.netdir+'Net.Zip '+ConfigSet.NetType1Path+'UPGRADE.ZIP')
            ELSE UPGRADE:=False;
      End;          (* End ZipPackage *)

      Procedure SendDsz;
      Var F:File;
      Begin
        ClrScr;
        WriteLn(Usr,'Sending NetMail Packet.');
 Exec('DSZ.COM',' port '+Strr(ConfigSet.UseCo)+' speed '+strlong(Baudrate)+' ha slow sz -m '+configset.NetDir+'Net.Zip');
        Assign(F,ConfigSet.NetDir+'Net.Zip');
        Erase(F);
      End;       (* End SendDsz *)

      Procedure UpdateStory;
                        Begin
           appendfile(configset.forumdi+'NOTICES.BBS',t);
           WriteLn(T,^S'????????????????????????????????????????????????????????????????????????????');
           WriteLn(T,^M^R'  On '+DateStr(Now)+' At '+TimeStr(Now)+' The Following Happened.');
           WriteLn(T,^M^R'('+Strr(NumMsgs)+') Were sent to '+NodeRec.Name+'/'+NodeRec.Node);
           If Upgrade then
           WriteLn(T,^R'A ViSiON Upgrade was sent in this packet.');
           WriteLn(T,^M);
           WriteLn(T,^S'????????????????????????????????????????????????????????????????????????????');
           WriteLn(T,^M);
           TextClose(T);
      End;              (* End UpdateStory *)

      Begin
        Package;
        ZipPackage;
        SendDsz;
        NodeRec.LastDate:=Now;
        UpDateStory;
      End;                    (* End SendOutGoing *)

  Procedure UpdateNode;
  Begin
    Assign(Nodefile,Configset.ForumDi+'NodeList.BBS');
    Reset(NodeFile);
    Seek(NodeFile,NodeNumber);
    Write(NodeFile,NodeRec);
    Close(Nodefile);
  End;              (* End UpdateNode *)

  Procedure ProcessIncomming;
  Var Fnp:File of NetPostRec;
      NetPost:NetPostRec;
      M:Message;
      B:BulRec;
      NumMsgs:Integer;
      Bfile:File of BulRec;

      Procedure UpDateStory;
      Begin
           appendfile(ConfigSet.ForumDi+'Notices.BBS',t);
           WriteLn(T,^S'???????????????????????????????????????????????????????????????????????????');
           WriteLn(T,^M^R' On '+DateStr(Now)+' at '+TimeStr(Now)+' The Following Happened.');
           WriteLn(T,^M'('+Strr(NumMsgs)+') Messages Were Received from '+NodeRec.Name+'/'+NodeRec.Node+^M);
           WriteLn(T,^S'???????????????????????????????????????????????????????????????????????????');
           TextClose(T);
           NewPosts:=NewPosts+NumMsgs;
           Gnup:=Gnup+NumMsgs;
           WriteStatus;
      End;              (* End UpDateStory *)

      Procedure UnZipNet;
      Var F:File;
      Begin
           SwapVectors;
           Exec(GetEnv('Comspec'),'/C Pkunzip '+ConfigSet.WorkDir+'Net.Zip -o '+ConfigSet.WorkDir);
           Assign(F,Configset.