Beijing Paradise BBS Backup/PARADISE.ISO/software/BBSDOORW/RADOOR30.ZIP/ONLINE.PAS

Pascal/Delphi Source File | 1994-04-10 | 7.2 KB | 301 lines

{╔═════════════════════════════════════════════════════════════════════════╗
 ║                                                                         ║
 ║                   (c) CopyRight LiveSystems 1990, 1994                  ║
 ║                                                                         ║
 ║ Author    : Gerhard Hoogterp                                            ║
 ║ FidoNet   : 2:282/100.5   2:283/7.33                                    ║
 ║ BitNet    : [e-mail]                                     ║
 ║                                                                         ║
 ║ SnailMail : Kremersmaten 108                                            ║
 ║             7511 LC Enschede                                            ║
 ║             The Netherlands                                             ║
 ║                                                                         ║
 ║        This module is part of the RADoor BBS doorwriters toolbox.       ║
 ║                                                                         ║
 ╚═════════════════════════════════════════════════════════════════════════╝}

Unit Online;
Interface
Uses GlobInfo,
     BBStypes,
     LowLevel,
     Fossil;

Type ChkFunc = Function:Boolean;
     GetProc = Procedure(Foss : FossilObject);
     PutProc = Procedure(ToNode : Byte;Msg : String);

Var ChkForMsg : ChkFunc;
    ReadMsg   : GetProc;
    WriteMsg  : PutProc;



Implementation
{$F+}

Const ReadOnly           = $00;
      WriteOnly          = $01;
      ReadWrite          = $02;

      ShareCompatible    = $00;
      ShareDenyReadWrite = $10;
      ShareDenyWrite     = $20;
      ShareDenyRead      = $30;
      ShareDenyNone      = $40;

      Inheritance        = $80;

{---- RA Online message procedures ----------------------------------------}

Function RAChkForMsg:Boolean;
Var NodeNr : String[2];
    MsgName: String[12];

Begin
RAChkForMsg:=false;
If GlobalInfo.UseQuietMode
   Then Exit;
NodeNr:=S(GlobalInfo.Node,0);
MsgName:='NODE'+NodeNr+'.RA';
RAChkForMsg:=ExistFile(GlobalInfo.CommonDir+MsgName);
End;

Procedure RAReadMsg(Foss : FossilObject);
Var Msg    : Text;
    NodeNr : String[2];
    MsgName: String[12];
    Line   : String[80];
    Count  : Byte;
Begin
NodeNr:=S(GlobalInfo.Node,0);
MsgName:='NODE'+NodeNr+'.RA';

FileMode:=ReadOnly+ShareDenyNone;
Assign(Msg,GlobalInfo.CommonDir+MsgName);
Reset(Msg);

While Not Eof(Msg) Do
 Begin
 ReadLn(Msg,Line);
 If Pos(']258',Line)=0
    Then Begin
         Count:=1;
         While Count<Length(Line) Do
          Begin
          If Line[Count]=#11
             Then Delete(Line,Count,1)
             Else Inc(Count);
           End;
         {$IfDef MultiLanguage}
           Foss.WriteLnF(#13'^0'+Line);
         {$Else}
           Foss.WriteLnF(#13+Line);
         {$EndIf}
         End;
 End;
Close(Msg);
Erase(Msg);
If IoResult<>0
   Then;
End;

Procedure RASendOnlineMsg( ToNode  : Byte;
                           Msg     : String);

Var MsgF    : Text;
    NodeNr  : String[2];
    MsgName : String[12];

Begin
NodeNr:=S(ToNode,0);
MsgName:='NODE'+NodeNr+'.RA';

FileMode:=ReadWrite+ShareDenyReadWrite;
Assign(MsgF,GlobalInfo.CommonDir+MsgName);
Append(MsgF);
If IoResult<>0
   Then Rewrite(MsgF);
{$IfDef MultiLanguage}
  WriteLn(MsgF,#11+']497'+GlobalInfo.UserName+#11+']496'+S(GlobalInfo.Node,0)+':');
{$Else}
  WriteLn(MsgF,'*** MSG *** From '+GlobalInfo.UserName+' on node '+S(GlobalInfo.Node,0)+':');
{$EndIf}
WriteLn(MsgF,'');
WriteLn(MsgF,Msg);
WriteLn(MsgF,'');
WriteLn(MsgF,#11']258'#01);

Close(MsgF);
End;

{---- QBBS Online message procedures ----------------------------------------}

Function QChkForMsg:Boolean;
Var NodeNr : String[2];
    MsgName: String[12];

Begin
QChkForMsg:=false;
If GlobalInfo.UseQuietMode
   Then Exit;
NodeNr:=S(GlobalInfo.Node,2);
If NodeNr[1]=' '
   Then NodeNr[1]:='0';
MsgName:='NODE'+NodeNr+'.DAT';
QChkForMsg:=ExistFile(GlobalInfo.CommonDir+MsgName);
End;

Procedure QReadMsg(Foss : FossilObject);
Var Msg    : Text;
    NodeNr : String[2];
    MsgName: String[12];
    Line   : String[80];
Begin
NodeNr:=S(GlobalInfo.Node,2);
If NodeNr[1]=' '
   Then NodeNr[1]:='0';
MsgName:='NODE'+NodeNr+'.DAT';

FileMode:=ReadOnly+ShareDenyNone;
Assign(Msg,GlobalInfo.CommonDir+MsgName);
Reset(Msg);

While Not Eof(Msg) Do
 Begin
 ReadLn(Msg,Line);
 Foss.WriteLnF(#13+Line);
 End;
Close(Msg);
Erase(Msg);
If IoResult<>0
   Then;
End;

Procedure QSendOnlineMsg( ToNode  : Byte;
                          Msg     : String);

Var MsgF    : Text;
    NodeNr  : String[2];
    MsgName : String[12];

Begin
NodeNr:=S(ToNode,2);
If NodeNr[1]=' '
   Then NodeNr[1]:='0';
MsgName:='NODE'+NodeNr+'.DAT';

FileMode:=ReadWrite+ShareDenyReadWrite;
Assign(MsgF,GlobalInfo.CommonDir+MsgName);
Append(MsgF);
If IoResult<>0
   Then Rewrite(MsgF);

WriteLn(MsgF,'Message ** from '+GlobalInfo.UserName+' on node '+S(GlobalInfo.Node,0)+':');
WriteLn(MsgF,'');
WriteLn(MsgF,Msg);
WriteLn(MsgF,'');
WriteLn(MsgF,^A);

Close(MsgF);
End;

{---- SBBS Online message procedures ----------------------------------------}

Function SBBSChkForMsg:Boolean;
Var NodeNr : String[2];
    MsgName: String[12];

Begin
SBBSChkForMsg:=false;
If GlobalInfo.UseQuietMode
   Then Exit;
NodeNr:=S(GlobalInfo.Node,0);
MsgName:='TOLINE'+NodeNr;
SBBSChkForMsg:=ExistFile(GlobalInfo.CommonDir+MsgName);
End;

Procedure SBBSReadMsg(Foss : FossilObject);
Var Msg    : Text;
    Name   : String[40];
    NodeNr : String[2];
    MsgName: String[12];
    Line   : String[80];
Begin
NodeNr:=S(GlobalInfo.Node,1);
MsgName:='TOLINE'+NodeNr;

FileMode:=ReadOnly+ShareDenyNone;
Assign(Msg,GlobalInfo.CommonDir+MsgName);
Reset(Msg);

While Not Eof(Msg) Do
 Begin
 ReadLn(Msg,Line);
 If Pos('/MESSAGE',Line)>0
    Then Begin
         Name:=FindToken(Line,',');
         Name:=FindToken(Line,',');
         NodeNr:=FindToken(Line,'/');
         WriteLn('*** An online message from ',Name,' on node ',NodeNr,':');
         End
    Else Begin
         If Line[1]<>'/'
            Then Foss.WriteLnF(Line);
         End;
 End;
Close(Msg);
Erase(Msg);
If IoResult<>0
   Then;
End;

Procedure SBBSSendOnlineMsg( ToNode  : Byte;
                             Msg     : String);

Var MsgF    : Text;
    NodeNr  : String[2];
    MsgName : String[12];

Begin
NodeNr:=S(GlobalInfo.Node,0);
MsgName:='TOLINE'+NodeNr;

FileMode:=ReadWrite+ShareDenyReadWrite;
Assign(MsgF,GlobalInfo.CommonDir+MsgName);
Append(MsgF);
If IoResult<>0
   Then Rewrite(MsgF);

WriteLn(MsgF,'/MESSAGE,',GlobalInfo.UserName,',',S(GlobalInfo.Node,0),'/');
WriteLn(MsgF,'');
WriteLn(MsgF,Msg);
WriteLn(MsgF,'');
WriteLn(MsgF,'/END/');

Close(MsgF);
End;

Begin

Case CurrentBBSType Of
 NO_BBS,
 RA_BBS : Begin
          ChkForMsg:=RAChkForMsg;
          ReadMsg:=RAReadMsg;
          WriteMsg:=RASendOnlineMsg;
          End;
 Q_BBS  : Begin
          ChkForMsg:=QChkForMsg;
          ReadMsg:=QReadMsg;
          WriteMsg:=QSendOnlineMsg;
          End;
 S_BBS  : Begin
           ChkForMsg:=SBBSChkForMsg;
          ReadMsg:=SBBSReadMsg;
          WriteMsg:=SBBSSendOnlineMsg;
          End;
End; {Case}

End.