mysticbbs/mystic/bbs_core.pas

465 lines
12 KiB
ObjectPascal
Raw Permalink Normal View History

2012-02-13 15:23:40 -08:00
Unit BBS_Core;
// ====================================================================
// Mystic BBS Software Copyright 1997-2013 By James Coyle
// ====================================================================
//
// This file is part of Mystic BBS.
//
// Mystic BBS is free software: you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation, either version 3 of the License, or
// (at your option) any later version.
//
// Mystic BBS is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
// GNU General Public License for more details.
//
// You should have received a copy of the GNU General Public License
// along with Mystic BBS. If not, see <http://www.gnu.org/licenses/>.
//
// ====================================================================
2012-02-13 15:23:40 -08:00
{$I M_OPS.PAS}
Interface
Uses
m_io_Base,
{$IFNDEF UNIX}
m_io_Sockets,
{$ENDIF}
2012-02-13 15:23:40 -08:00
m_FileIO,
m_Strings,
2012-09-06 01:33:15 -07:00
m_Pipe,
2012-02-13 15:23:40 -08:00
m_DateTime,
2013-08-29 03:04:20 -07:00
BBS_Records,
2012-02-13 15:23:40 -08:00
BBS_IO,
BBS_MsgBase,
BBS_User,
BBS_FileBase,
BBS_Menus,
MPL_Execute;
Const
mysMessageThreshold = 3;
2012-02-13 15:23:40 -08:00
Type
TBBSCore = Class
{$IFNDEF UNIX}
2012-08-21 09:23:47 -07:00
Client : TIOBase;
{$ENDIF}
2013-03-13 20:56:42 -07:00
User : TBBSUser;
Msgs : TMsgBase;
FileBase : TFileBase;
Menu : TMenuEngine;
IO : TBBSIO;
Pipe : TPipe;
EventFile : File of RecEvent;
2013-03-13 20:56:42 -07:00
ThemeFile : File of RecTheme;
VoteFile : File of VoteRec;
Vote : VoteRec;
2013-08-29 03:04:20 -07:00
Chat : ChatRec;
2013-03-13 20:56:42 -07:00
CommHandle : LongInt;
ShutDown : Boolean;
TempPath : String;
Event : RecEvent;
NextEvent : RecEvent;
2013-03-13 20:56:42 -07:00
Theme : RecTheme;
LocalMode : Boolean;
Baud : LongInt;
ExitLevel : Byte;
EventWarn : Boolean;
EventExit : Boolean;
EventRunAfter : Boolean;
NodeNum : Byte;
TimerStart : Integer;
TimerEnd : Integer;
LastTimeLeft : Integer;
TimeOut : LongInt;
UserLoginName : String[30];
UserLoginPW : String[15];
UserHostInfo : String[50];
UserIPInfo : String[15];
CheckTimeOut : Boolean;
TimeOffset : Word;
TimeSaved : Word;
TimerOn : Boolean;
TimeChecked : Boolean;
ConfigMode : Boolean;
InUserEdit : Boolean;
AllowMessages : Boolean;
InMessage : Boolean;
MessageCheck : Byte;
HistoryFile : File of RecHistory;
HistoryEmails : Word;
HistoryPosts : Word;
HistoryDLs : Word;
HistoryDLKB : LongInt;
HistoryULs : Word;
HistoryULKB : LongInt;
HistoryHour : SmallInt;
LastScanHadNew : Boolean;
LastScanHadYou : Boolean;
2013-05-20 02:35:04 -07:00
PromptData : Array[0..mysMaxThemeText] of Pointer;
2013-09-16 13:31:39 -07:00
StatusPtr : Byte;
CurRoom : Byte;
ConfigFile : File of RecConfig;
ChatFile : File of ChatRec;
RoomFile : File of RoomRec;
Room : RoomRec;
LastOnFile : File of RecLastOn;
LastOn : RecLastOn;
2012-02-13 15:23:40 -08:00
Constructor Create;
Destructor Destroy; Override;
Procedure UpdateHistory;
Procedure FindNextEvent;
Function GetPrompt (N : Word) : String;
Procedure SystemLog (Str: String);
Function MinutesUntilEvent (ExecTime: Integer): Integer;
Procedure SetTimeLeft (Mins: Integer);
Function ElapsedTime : Integer;
Function TimeLeft : Integer;
Function LoadThemeData (Str: String) : Boolean;
2013-05-26 23:57:34 -07:00
Procedure DisposeThemeData;
2012-02-13 15:23:40 -08:00
End;
Var
Session : TBBSCore;
Implementation
2013-08-29 03:04:20 -07:00
Uses
BBS_DataBase;
2012-02-13 15:23:40 -08:00
Constructor TBBSCore.Create;
Begin
Inherited Create;
HistoryEmails := 0;
HistoryPosts := 0;
HistoryDLs := 0;
HistoryDLKB := 0;
HistoryULs := 0;
HistoryULKB := 0;
2012-08-21 14:56:40 -07:00
HistoryHour := 0;
2012-02-13 15:23:40 -08:00
ShutDown := False;
CommHandle := -1;
LocalMode := False;
Baud := 38400;
2012-02-13 15:23:40 -08:00
ExitLevel := 0;
EventWarn := False;
EventExit := False;
EventRunAfter := False;
NodeNum := 0;
2013-03-13 20:56:42 -07:00
UserLoginName := '';
UserLoginPW := '';
2012-02-13 15:23:40 -08:00
UserHostInfo := '';
UserIPInfo := '';
CheckTimeOut := True;
TimeOut := TimerSeconds;
2012-02-13 15:23:40 -08:00
TimeOffset := 0;
TimeSaved := 0;
TimerOn := False;
TimeChecked := False;
ConfigMode := False;
InUserEdit := False;
AllowMessages := True;
InMessage := False;
MessageCheck := mysMessageThreshold;
2013-09-16 13:31:39 -07:00
StatusPtr := 1;
2012-02-13 15:23:40 -08:00
{$IFNDEF UNIX}
Client := TIOSocket.Create;
TIOSocket(Client).FTelnetServer := True;
2012-02-13 15:23:40 -08:00
{$ENDIF}
User := TBBSUser.Create(Pointer(Self));
IO := TBBSIO.Create(Pointer(Self));
Msgs := TMsgBase.Create(Pointer(Self));
FileBase := TFileBase.Create(Pointer(Self));
Menu := TMenuEngine.Create(Pointer(Self));
2012-02-13 15:23:40 -08:00
End;
Destructor TBBSCore.Destroy;
Begin
2013-05-26 23:57:34 -07:00
DisposeThemeData;
2012-08-21 09:23:47 -07:00
Pipe.Free;
2012-02-13 15:23:40 -08:00
Msgs.Free;
FileBase.Free;
Menu.Free;
User.Free;
IO.Free;
2013-04-01 13:22:22 -07:00
{$IFNDEF UNIX}
2012-02-13 15:23:40 -08:00
Client.Free;
{$ENDIF}
Inherited Destroy;
End;
Procedure TBBSCore.UpdateHistory;
Var
History : RecHistory;
2012-02-13 15:23:40 -08:00
Begin
2012-08-21 09:23:47 -07:00
If User.ThisUser.Flags AND UserNoHistory <> 0 Then Exit;
2012-07-19 18:12:19 -07:00
Assign (HistoryFile, bbsCfg.DataPath + 'history.dat');
2012-02-13 15:23:40 -08:00
2012-08-21 14:56:40 -07:00
If Not ioReset (HistoryFile, SizeOf(RecHistory), fmRWDN) Then
ioReWrite(HistoryFile, SizeOf(RecHistory), fmRWDW);
2012-02-13 15:23:40 -08:00
History.Date := CurDateDos;
While Not Eof(HistoryFile) Do Begin
ioRead (HistoryFile, History);
2012-07-19 18:12:19 -07:00
2012-02-13 15:23:40 -08:00
If DateDos2Str(History.Date, 1) = DateDos2Str(CurDateDos, 1) Then Begin
ioSeek (HistoryFile, FilePos(HistoryFile) - 1);
Break;
End;
End;
If Eof(HistoryFile) Then Begin
FillChar(History, SizeOf(History), 0);
2012-09-22 21:59:33 -07:00
2012-02-13 15:23:40 -08:00
History.Date := CurDateDos;
End;
Inc (History.Emails, HistoryEmails);
Inc (History.Posts, HistoryPosts);
Inc (History.Downloads, HistoryDLs);
Inc (History.Uploads, HistoryULs);
Inc (History.DownloadKB, HistoryDLKB);
Inc (History.UploadKB, HistoryULKB);
2012-07-19 18:12:19 -07:00
If Not LocalMode And (User.ThisUser.Flags AND UserNoLastCall = 0) Then
Inc (History.Calls, 1);
2012-09-22 21:59:33 -07:00
If User.ThisUser.Calls = 1 Then Inc (History.NewUsers);
2012-02-13 15:23:40 -08:00
2012-09-20 10:52:58 -07:00
If Not LocalMode Then Inc (History.Hourly[HistoryHour]);
2012-08-21 14:56:40 -07:00
2012-02-13 15:23:40 -08:00
ioWrite (HistoryFile, History);
Close (HistoryFile);
End;
Procedure TBBSCore.FindNextEvent;
Var
MinCheck : Integer;
Begin
NextEvent.Active := False;
MinCheck := -1;
Assign (EventFile, bbsCfg.DataPath + 'event.dat');
2012-02-13 15:23:40 -08:00
If Not ioReset (EventFile, SizeOf(RecEvent), fmRWDN) Then
ioReWrite (EventFile, SizeOf(RecEvent), fmRWDN);
2012-02-13 15:23:40 -08:00
While Not Eof(EventFile) Do Begin
ioRead (EventFile, Event);
If (MinCheck = -1) or ((MinCheck <> -1) and (MinutesUntilEvent(Event.ExecTime) < MinCheck)) Then Begin
If Event.Active and (Event.ExecType = 0) and ((Event.Node = 0) or (Event.Node = NodeNum)) and (Event.ExecDays[DayOfWeek(CurDateDos)]) Then Begin
2012-02-13 15:23:40 -08:00
MinCheck := MinutesUntilEvent(Event.ExecTime);
NextEvent := Event;
End;
End;
End;
Close (EventFile);
End;
Procedure TBBSCore.SystemLog (Str: String);
Var
tLOG : Text;
Begin
Assign (tLOG, bbsCfg.LogsPath + 'node' + strI2S(NodeNum) + '.log');
2012-02-13 15:23:40 -08:00
{$I-} Append(tLOG); {$I+}
If IoResult <> 0 Then ReWrite (tLOG);
If Str = '-' Then
WriteLn (tLOG, strRep('-', 40))
2012-02-13 15:23:40 -08:00
Else
2013-09-04 12:02:58 -07:00
WriteLn (tLOG, FormatDate (CurDateDT, 'NNN DD YYYY HH:II') + ' ' + Str);
2012-02-13 15:23:40 -08:00
Close (tLOG);
End;
Function TBBSCore.MinutesUntilEvent (ExecTime: Integer): Integer;
Begin {exits if 0 mins}
If ExecTime > TimerMinutes Then Result := ExecTime - TimerMinutes Else
If TimerMinutes > ExecTime Then Result := 1440 - TimerMinutes + ExecTime Else
If NextEvent.Active Then Begin
If DateDos2Str(NextEvent.LastRan, 1) = DateDos2Str(CurDateDos, 1) Then Begin
Result := 1440; {if it was already ran...}
Exit;
End;
If NextEvent.Forced Then Begin
EventExit := True;
{$IFDEF UNIX}
io.OutFullLn (GetPrompt(137));
SystemLog ('User disconnected for system event');
{$ELSE}
If Not LocalMode Then begin
io.OutFullLn (GetPrompt(137));
SystemLog('User disconnected for system event');
End;
{$ENDIF}
SystemLog('Event: ' + NextEvent.Name);
Halt (NextEvent.ExecLevel);
2012-02-13 15:23:40 -08:00
End Else
EventRunAfter := True;
End;
End;
Procedure TBBSCore.SetTimeLeft (Mins: Integer);
Begin
TimerStart := TimerMinutes;
TimerEnd := TimerStart + Mins;
TimerOn := True;
End;
Function TBBSCore.ElapsedTime : Integer;
Begin
If TimerStart > TimerMinutes Then Begin
Dec (TimerStart, 1440);
Dec (TimerEnd, 1440);
2012-09-06 01:33:15 -07:00
SetTimeLeft (User.Security.Time);
2012-02-13 15:23:40 -08:00
End;
ElapsedTime := TimerMinutes - TimerStart;
End;
Function TBBSCore.TimeLeft : Integer;
Begin
If Not TimerOn Then Begin
TimeLeft := 0;
2013-09-03 05:02:29 -07:00
2012-02-13 15:23:40 -08:00
Exit;
End;
If TimerStart > TimerMinutes Then Begin
Dec (TimerStart, 1440);
Dec (TimerEnd, 1440);
SetTimeLeft (User.Security.Time);
End;
TimeLeft := TimerEnd - TimerMinutes;
End;
2013-05-20 02:35:04 -07:00
Function TBBSCore.GetPrompt (N: Word) : String;
Begin
Result := String(PromptData[N]^);
If Result[1] = '@' Then Begin
io.OutFile (Copy(Result, 2, Length(Result)), True, 0);
Result := '';
End Else
If Result[1] = '!' Then Begin
ExecuteMPL (NIL, Copy(Result, 2, Length(Result)));
Result := '';
End;
End;
2013-05-26 23:57:34 -07:00
Procedure TBBSCore.DisposeThemeData;
Var
Count : LongInt;
Begin
For Count := mysMaxThemeText DownTo 0 Do Begin
If Assigned(PromptData[Count]) Then
FreeMem(PromptData[Count]);
2013-05-20 02:35:04 -07:00
2013-05-26 23:57:34 -07:00
PromptData[Count] := NIL;
2013-05-20 02:35:04 -07:00
End;
2013-05-26 23:57:34 -07:00
End;
2013-05-20 02:35:04 -07:00
2013-05-26 23:57:34 -07:00
Function TBBSCore.LoadThemeData (Str: String) : Boolean;
2013-05-20 02:35:04 -07:00
Var
Count : LongInt;
PromptFile : Text;
Buffer : Array[1..1024 * 8] of Char;
Temp : String;
TempTheme : RecTheme;
Begin
Result := False;
Reset (ThemeFile);
While Not Eof(ThemeFile) Do Begin
Read (ThemeFile, TempTheme);
If strUpper(TempTheme.FileName) = strUpper(Str) Then Begin
Result := True;
Theme := TempTheme;
Break;
End;
End;
Close (ThemeFile);
If Not Result Then Exit;
Result := False;
FileMode := 66;
Assign (PromptFile, bbsCfg.DataPath + Theme.FileName + '.txt');
2013-05-20 02:35:04 -07:00
SetTextBuf (PromptFile, Buffer);
{$I-} Reset (PromptFile); {$I+}
If IoResult <> 0 Then Exit;
DisposeThemeData;
While Not Eof(PromptFile) Do Begin
ReadLn (PromptFile, Temp);
If Copy(Temp, 1, 3) = '000' Then
Count := 0
Else
If strS2I(Copy(Temp, 1, 3)) > 0 Then
Count := strS2I(Copy(Temp, 1, 3))
Else
Count := -1;
If Count <> -1 Then Begin
Temp := Copy(Temp, 5, Length(Temp));
If Assigned (PromptData[Count]) Then
FreeMem(PromptData[Count], SizeOf(PromptData[Count]^));
GetMem (PromptData[Count], Length(Temp) + 1);
Move (Temp, PromptData[Count]^, Length(Temp) + 1);
End;
End;
Close (PromptFile);
Result := True;
For Count := 1 to mysMaxThemeText Do
If Not Assigned(PromptData[Count]) Then Begin
SystemLog ('Missing prompt #' + strI2S(Count));
IO.OutFullLn('|12Missing prompt #' + strI2S(Count));
Result := False;
End;
If Not Result Then Halt(1);
End;
2012-02-13 15:23:40 -08:00
End.