From e98cf71497b3e7e183891cf5df57f8abc891ffef Mon Sep 17 00:00:00 2001 From: mysticbbs Date: Mon, 13 Feb 2012 19:50:48 -0500 Subject: [PATCH] Initial import --- mystic/109to110.pas | 976 +++++++++ mystic/ansi_install.ans | 13 + mystic/aview.pas | 164 ++ mystic/aviewarj.pas | 111 + mystic/aviewlzh.pas | 81 + mystic/aviewrar.pas | 102 + mystic/aviewzip.pas | 126 ++ mystic/bbs_ansi_help.pas | 419 ++++ mystic/bbs_ansi_menubox.pas | 592 ++++++ mystic/bbs_ansi_menuform.pas | 700 +++++++ mystic/bbs_ansi_menuinput.pas | 199 ++ mystic/bbs_cfg_archive.pas | 148 ++ mystic/bbs_cfg_events.pas | 125 ++ mystic/bbs_cfg_filebase.pas | 167 ++ mystic/bbs_cfg_groups.pas | 149 ++ mystic/bbs_cfg_language.pas | 130 ++ mystic/bbs_cfg_menuedit.pas | 302 +++ mystic/bbs_cfg_msgbase.pas | 236 +++ mystic/bbs_cfg_protocol.pas | 148 ++ mystic/bbs_cfg_seclevel.pas | 107 + mystic/bbs_cfg_useredit.pas | 346 ++++ mystic/bbs_cfg_vote.pas | 144 ++ mystic/bbs_common.pas | 514 +++++ mystic/bbs_doors.pas | 348 ++++ mystic/bbs_edit_full.pas | 848 ++++++++ mystic/bbs_edit_line.pas | 200 ++ mystic/bbs_filebase.pas | 3408 ++++++++++++++++++++++++++++++ mystic/bbs_general.pas | 1560 ++++++++++++++ mystic/bbs_io.pas | 1824 ++++++++++++++++ mystic/bbs_msgbase.pas | 3664 +++++++++++++++++++++++++++++++++ mystic/bbs_msgbase_abs.pas | 608 ++++++ mystic/bbs_msgbase_ansi.pas | 486 +++++ mystic/bbs_msgbase_jam.pas | 1831 ++++++++++++++++ mystic/bbs_msgbase_squish.pas | 1582 ++++++++++++++ mystic/bbs_nodechat.pas | 497 +++++ mystic/bbs_nodeinfo.pas | 196 ++ mystic/bbs_sysopchat.pas | 292 +++ mystic/bbs_user.pas | 1316 ++++++++++++ 38 files changed, 24659 insertions(+) create mode 100644 mystic/109to110.pas create mode 100644 mystic/ansi_install.ans create mode 100644 mystic/aview.pas create mode 100644 mystic/aviewarj.pas create mode 100644 mystic/aviewlzh.pas create mode 100644 mystic/aviewrar.pas create mode 100644 mystic/aviewzip.pas create mode 100644 mystic/bbs_ansi_help.pas create mode 100644 mystic/bbs_ansi_menubox.pas create mode 100644 mystic/bbs_ansi_menuform.pas create mode 100644 mystic/bbs_ansi_menuinput.pas create mode 100644 mystic/bbs_cfg_archive.pas create mode 100644 mystic/bbs_cfg_events.pas create mode 100644 mystic/bbs_cfg_filebase.pas create mode 100644 mystic/bbs_cfg_groups.pas create mode 100644 mystic/bbs_cfg_language.pas create mode 100644 mystic/bbs_cfg_menuedit.pas create mode 100644 mystic/bbs_cfg_msgbase.pas create mode 100644 mystic/bbs_cfg_protocol.pas create mode 100644 mystic/bbs_cfg_seclevel.pas create mode 100644 mystic/bbs_cfg_useredit.pas create mode 100644 mystic/bbs_cfg_vote.pas create mode 100644 mystic/bbs_common.pas create mode 100644 mystic/bbs_doors.pas create mode 100644 mystic/bbs_edit_full.pas create mode 100644 mystic/bbs_edit_line.pas create mode 100644 mystic/bbs_filebase.pas create mode 100644 mystic/bbs_general.pas create mode 100644 mystic/bbs_io.pas create mode 100644 mystic/bbs_msgbase.pas create mode 100644 mystic/bbs_msgbase_abs.pas create mode 100644 mystic/bbs_msgbase_ansi.pas create mode 100644 mystic/bbs_msgbase_jam.pas create mode 100644 mystic/bbs_msgbase_squish.pas create mode 100644 mystic/bbs_nodechat.pas create mode 100644 mystic/bbs_nodeinfo.pas create mode 100644 mystic/bbs_sysopchat.pas create mode 100644 mystic/bbs_user.pas diff --git a/mystic/109to110.pas b/mystic/109to110.pas new file mode 100644 index 0000000..3e1a9c0 --- /dev/null +++ b/mystic/109to110.pas @@ -0,0 +1,976 @@ +Program UP110; + +// set lang preferences to defaults + +{$I M_OPS.PAS} + +Uses + CRT, + m_Strings; + +{$I RECORDS.PAS} + +Type + ExtAddrType = Record + Zone, + Net, + Node, + Point : Word; + Desc : String[15]; + End; + + OldConfigRec = Record { MYSTIC.DAT in root BBS directory } + Version : String[8]; + SysPath, { System path (root BBS directory) } + AttachPath, { File attach directory } + DataPath, { Data file directory } + MsgsPath, { Default JAM directory } + ArcsPath, { Archive software directory } + QwkPath, { Local QWK directory } + ScriptPath, { Script file directory } + LogsPath : String[40]; { Log file directory } + BBSName, { BBS Name } + SysopName : String[30]; { Sysop Name } + SysopPW : String[15]; { Sysop Password } + SystemPW : String[15]; { System Password } + MaxNode : Byte; { Max # of nodes the BBS has } + DefStartMenu : String[8]; { Default start menu } + DefFallMenu : String[8]; { Default fallback menu } + DefThemeFile : String[8]; { Default language file } + DefTermMode : Byte; { 0 = Ask } + { 1 = Detect } + { 2 = Detect, ask if none } + { 3 = Force ANSI } + ScreenBlank : Byte; { Mins before WFC screen saver starts} + ChatStart : SmallInt; { Chat hour start, } + ChatEnd : SmallInt; { Chat hour end: mins since midnight } + ChatFeedback : Boolean; { E-mail sysop if page isn't answered} + AcsSysop : String[20]; { BBS List Editor ACS } + AllowNewUsers : Boolean; { Allow new users? } + NewUserPW : String[15]; { New user password } + NewUserSec : SmallInt; { New user security level } + AskRealName, { Ask new users for real name? } + AskAlias, { Ask new users for an alias? } + AskStreet, { Ask new user for street address? } + AskCityState, { Ask new users for city/state? } + AskZipCode, { Ask new users for ZIP code } + AskHomePhone, { Ask new users for home phone #? } + AskDataPhone, { Ask new users for data phone #? } + AskBirthdate, { Ask new users for date of birth? } + AskGender, { Ask new users for their gender? } + AskTheme, { Ask new users to select a language?} + AskEmail, + AskUserNote, + AskOption1, + AskOption2, + AskOption3, + UseUSAPhone : Boolean; { Use XXX-XXX-XXXX format phone #s? } + UserEditorType : Byte; { 0 = Line Editor } + { 1 = Full Editor } + { 2 = Ask } + UserDateType : Byte; { 1 = MM/DD/YY } + { 2 = DD/MM/YY } + { 3 = YY/DD/MM } + { 4 = Ask } + UseMatrix : Boolean; { Use MATRIX-style login? } + MatrixMenu : String[8]; { Matrix Menu Name } + MatrixPW : String[15]; { Matrix Password } + MatrixAcs : String[20]; { ACS required to see Matrix PW } + NewUserEmail : Boolean; { Force new user feedback } + UserMailIndex : Byte; { use lightbar email msg index? } + UserQuoteWin : Byte; { 0 = no, 1 = ues, 2 = ask } + UserReadIndex : Byte; { 0 = no, 1 = yes, 2 = ask } + Option1 : String[10]; + Option2 : String[10]; + Option3 : String[10]; + FCompress : Boolean; { Compress file area numbers? } + ImportDIZ : Boolean; { Search for FILE_ID.DIZ? } + AcsValidate : String[20]; { ACS to auto-validate uploads } + AcsSeeUnvalid : String[20]; { ACS to see unvalidated files } + AcsDLUnvalid : String[20]; { ACS to download unvalidated files } + AcsSeeFailed : String[20]; { ACS to see failed files } + AcsDLFailed : String[20]; { ACS to download failed files } + TestUploads : Boolean; { Test uploaded files? } + TestPassLevel : Byte; { Pass errorlevel } + TestCmdLine : String[60]; { Upload processor command line } + MaxFileDesc : Byte; { Max # of File Description Lines } + FreeUL : LongInt; { Max space required for uploads } + FreeCDROM : LongInt; { Free space required for CD Copy } + MCompress : Boolean; { Compress message area numbers? } + qwkBBSID : String[8]; { QWK packet display name } + qwkWelcome : String[8]; { QWK welcome display file } + qwkNews : String[8]; { QWK news display file } + qwkGoodbye : String[8]; { QWK goodbye display file } + qwkArchive : String[3]; { Default QWK archive } + qwkMaxBase : SmallInt; { Max # of messages per base (QWK) } + qwkMaxPacket : SmallInt; { Max # of messages per packet } + NetAddress : Array[1..20] of ExtAddrType; { Network Addresses } + Origin : String[50]; { Default origin line } + ColorQuote : Byte; { Default quote color } + ColorText : Byte; { Default text color } + ColorTear : Byte; { Default tear line color } + ColorOrigin : Byte; { Default origin line color } + SystemCalls : LongInt; { Total calls to the BBS } + AcsInvLogin : String[20]; { Invisible login ACS } + ChatLogging : Boolean; { Record SysOp chat to CHAT.LOG? } + StatusType : Byte; { 0 = 2 line, 1 = 1 line } + UserFileList : Byte; { 0 = Normal, 1 = Lightbar, 2 = Ask } + FShowHeader : Boolean; { Redisplay file header after pause } + SysopMacro : Array[1..4] of String[80]; { Sysop Macros } + UploadBase : SmallInt; { Default upload file base } + MaxAutoSig : Byte; { Max Auto-Sig lines } + FColumns : Byte; { File area list columns } + MColumns : Byte; { Message area list columns } + netCrash : Boolean; { NetMail CRASH flag? } + netHold : Boolean; { NetMail HOLD flag? } + netKillSent : Boolean; { NetMail KILLSENT flag? } + UserNameFormat : Byte; { user input format } + MShowHeader : Boolean; { redisplay message header } + DefScreenSize : Byte; { default screen length } + DupeScan : Byte; { dupescan: 0=no,1=yes,2=yes global } + Inactivity : Word; { Seconds before inactivity timeout } + UserReadType : Byte; { 0 = normal, 1 = ansi, 2 = ask } + UserHotKeys : Byte; { 0 = no, 1 = yes, 2 = ask } + UserIdxPos : LongInt; { permanent user # position } + AcsSeeInvis : String[20]; { ACS to see invisible users } + FeedbackTo : String[30]; { Feedback to user } + AllowMulti : Boolean; { Allow multiple node logins? } + StartMGroup : Word; { new user msg group start } + StartFGroup : Word; { new user file group start } + MShowBases : Boolean; + FShowBases : Boolean; + UserFullChat : Byte; { 0 = no, 1 = yes, 2 = ask } + AskScreenSize : Boolean; + inetDomain : String[25]; + inetSMTPUse : Boolean; + inetSMTPPort : Word; + inetSMTPMax : Word; + inetPOP3Use : Boolean; + inetPOP3Port : Word; + inetPOP3Max : Word; + inetTNUse : Boolean; + inetTNPort : Word; + inetTNDupes : Byte; + inetIPBlocking : Boolean; + inetIPLogging : Boolean; + inetFTPUse : Boolean; + inetFTPPort : Word; + inetFTPMax : Word; + inetFTPDupes : Byte; + inetFTPPortMin : Word; + inetFTPPortMax : Word; + inetFTPAnon : Boolean; + inetFTPTimeout : Word; + Reserved : Array[1..192] of Byte; + End; + + OldUserRec = Record { USERS.DAT } + Flags : Byte; { User Flags } + Handle : String[30]; { Handle } + RealName : String[30]; { Real Name } + Password : String[15]; { Password } + Address : String[30]; { Address } + City : String[25]; { City } + ZipCode : String[9]; { Zipcode } + HomePhone : String[15]; { Home Phone } + DataPhone : String[15]; { Data Phone } + Birthday : LongInt; + Gender : Char; { M> Male F> Female } + EmailAddr : String[35]; { email address } + Option1 : String[35]; { optional question #1 } + Option2 : String[35]; { optional question #2 } + Option3 : String[35]; { optional question #3 } + UserInfo : String[30]; { user comment field } + AF1 : AccessFlagType; + AF2 : AccessFlagType; { access flags set #2 } + Security : SmallInt; { Security Level } + StartMenu : String[8]; { Start menu for user } + FirstOn : LongInt; { Date/Time of First Call } + LastOn : LongInt; { Date/Time of Last Call } + Calls : LongInt; { Number of calls to BBS } + CallsToday: SmallInt; { Number of calls today } + DLs : SmallInt; { # of downloads } + DLsToday : SmallInt; { # of downloads today } + DLk : LongInt; { # of downloads in K } + DLkToday : LongInt; { # of downloaded K today } + ULs : LongInt; { total number of uploads } + ULk : LongInt; { total number of uploaded K } + Posts : LongInt; { total number of msg posts } + Emails : LongInt; { total number of sent email } + TimeLeft : LongInt; { time left online for today } + TimeBank : SmallInt; { number of mins in timebank } + Archive : String[3]; { default archive extension } + QwkFiles : Boolean; { Include new files in QWK? } + DateType : Byte; { Date format (see above) } + ScrnPause : Byte; { user's screen length } + Language : String[8]; { user's language file } + LastFBase : Word; { Last file base } + LastMBase : Word; { Last message base } + LastMGroup: Word; { Last group accessed } + LastFGroup: Word; { Last file group accessed } + Vote : Array[1..mysMaxVoteQuestion] of Byte; { Voting booth data } + EditType : Byte; { 0 = Line, 1 = Full, 2 = Ask } + FileList : Byte; { 0 = Normal, 1 = Lightbar } + SigUse : Boolean; { Use auto-signature? } + SigOffset : LongInt; { offset to sig in AUTOSIG.DAT } + SigLength : Byte; { number of lines in sig } + HotKeys : Boolean; { does user have hotkeys on? } + MReadType : Byte; { 0 = line 1 = full 2 = ask } + PermIdx : LongInt; { permanent user number } + UseLBIndex: Boolean; { use lightbar index? } + UseLBQuote: Boolean; { use lightbar quote mode } + UseLBMIdx : Boolean; { use lightbar index in email? } + UserFullChat : Boolean; { use full screen teleconference } + Reserved : Array[1..98] of Byte; + End; + + OldGroupRec = Record { GROUP_*.DAT } + Name : String[30]; { Group name } + ACS : String[20]; { ACS required to access group } + End; + + OldArcRec = Record { ARCHIVE.DAT } + Name : String[20]; { Archive description } + Ext : String[3]; { Archive extension } + Pack : String[60]; { Pack command line } + Unpack : String[60]; { Unpack command line } + View : String[60]; { View command line } + End; + + OldSecurityRec = Record { SECURITY.DAT } + Desc : String[30]; { Description of security level } + Time : SmallInt; { Time online (mins) per day } + MaxCalls : SmallInt; { Max calls per day } + MaxDLs : SmallInt; { Max downloads per day } + MaxDLk : SmallInt; { Max download kilobytes per day } + MaxTB : SmallInt; { Max mins allowed in time bank } + DLRatio : Byte; { Download ratio (# of DLs per UL) } + DLKRatio : SmallInt; { DL K ratio (# of DLed K per UL K } + AF1 : AccessFlagType; { Access flags for this level A-Z } + AF2 : AccessFlagType; { Access flags #2 for this level } + Hard : Boolean; { Do a hard AF upgrade? } + StartMNU : String[8]; { Start Menu for this level } + PCRatio : SmallInt; { Post / Call ratio per 100 calls } + Res1 : Byte; { reserved for future use } + Res2 : LongInt; { reserved for future use } + End; + +Var + Config : RecConfig; + +Function DeleteFile (FN : String) : Boolean; +Var + F : File; +Begin + Assign (F, FN); +{ SetFAttr (F, Archive);} + {$I-} Erase (F); {$I+} + DeleteFile := (IoResult = 0); +End; + +Function RenameFile (Old, New: String) : Boolean; +Var + OldF : File; +Begin + DeleteFile(New); + Assign (OldF, Old); + {$I-} ReName (OldF, New); {$I+} + + Result := (IoResult = 0); +End; + +Procedure WarningDisplay; +Var + Ch : Char; +Begin + TextAttr := 15; + ClrScr; + WriteLn ('MYSTIC BBS VERSION 1.10 UPGRADE UTILITY'); + TextAttr := 8; + WriteLn ('---------------------------------------'); + WriteLn; + TextAttr := 7; + WriteLn ('You must be using a current installation of Mystic BBS 1.09 in'); + WriteLn ('order for this upgrade to work. If you are not using 1.09, then'); + WriteLn ('you must upgrade to that version before proceeding with this upgrade'); + WriteLn; + WriteLn ('You will need to have access rights to all of your BBS directory'); + WriteLn ('structure, otherwise, you may experience crashes during the'); + WriteLn ('upgrade process.'); + WriteLn; + WriteLn ('Make sure you read the UPGRADE.TXT and follow all steps completely!'); + WriteLn; + TextAttr := 12; + WriteLn (^G^G'*WARNING* MAKE A BACKUP OF YOUR BBS BEFORE ATTEMPTING TO UPGRADE!'); + TextAttr := 7; + WriteLn; + Repeat + Write ('Are you ready to upgrade now (Y/N): '); + Ch := UpCase(ReadKey); + WriteLn (Ch); + Until Ch in ['Y', 'N']; + If Ch = 'N' Then Halt; + WriteLn; +End; + +Procedure ConvertConfig; +Var + A : LongInt; + OldConfigFile : File of OldConfigRec; + OldConfig : OldConfigRec; + ConfigFile : File of RecConfig; +Begin + Assign (OldConfigFile, 'mystic.dat'); + {$I-} Reset (OldConfigFile); {$I+} + If IoResult <> 0 Then Begin + WriteLn ('ERROR: Run this program from the root Mystic BBS directory.'); + Halt(1); + End; + + WriteLn ('[-] Updating system configuration...'); + + Read (OldConfigFile, OldConfig); + Close (OldConfigFile); + + With OldConfig Do Begin + Config.DataChanged := mysDataChanged; + Config.SystemCalls := SystemCalls; + Config.UserIdxPos := UserIdxPos; + Config.SystemPath := SysPath; + Config.DataPath := DataPath; + Config.LogsPath := LogsPath; + Config.MsgsPath := MsgsPath; + Config.AttachPath := AttachPath; + Config.ScriptPath := ScriptPath; + Config.QwkPath := QwkPath; + Config.SemaPath := SysPath; + Config.BBSName := BBSName; + Config.SysopName := SysopName; + Config.SysopPW := SysopPW; + Config.SystemPW := SystemPW; + Config.FeedbackTo := FeedbackTo; + Config.Inactivity := Inactivity; + Config.DefStartMenu := DefStartMenu; + Config.DefFallMenu := DefFallMenu; + Config.DefThemeFile := DefThemeFile; + Config.DefTermMode := DefTermMode; + Config.DefScreenSize := DefScreenSize; + Config.UseMatrix := UseMatrix; + Config.MatrixMenu := MatrixMenu; + Config.MatrixPW := MatrixPW; + Config.MatrixAcs := MatrixAcs; + Config.AcsSysop := AcsSysop; + Config.AcsInvisLogin := AcsInvLogin; + Config.AcsSeeInvis := AcsSeeInvis; + + For A := 1 to 4 Do Config.SysopMacro[A] := SysopMacro[A]; + + Config.ChatStart := ChatStart; + Config.ChatEnd := ChatEnd; + Config.ChatFeedback := ChatFeedback; + Config.ChatLogging := ChatLogging; + Config.AllowNewUsers := AllowNewUsers; + Config.NewUserSec := NewUserSec; + Config.NewUserPW := NewUserPW; + Config.NewUserEMail := NewUserEmail; + Config.StartMGroup := StartMGroup; + Config.StartFGroup := StartFGroup; + Config.UseUSAPhone := UseUSAPhone; + Config.UserNameFormat := UserNameFormat; + Config.UserDateType := UserDateType; + Config.UserEditorType := UserEditorType; + Config.UserHotKeys := UserHotkeys; + Config.UserFullChat := UserFullChat; + Config.UserFileList := UserFileList; + Config.UserReadType := UserReadType; + Config.UserMailIndex := UserMailIndex; + Config.UserReadIndex := UserReadIndex; + Config.UserQuoteWin := UserQuoteWin; + Config.AskTheme := AskTheme; + Config.AskRealName := AskRealName; + Config.AskAlias := AskAlias; + Config.AskStreet := AskStreet; + Config.AskCityState := AskCityState; + Config.AskZipCode := AskZipCode; + Config.AskHomePhone := AskHomePhone; + Config.AskDataPhone := AskDataPhone; + Config.AskBirthdate := AskBirthDate; + Config.AskGender := AskGender; + Config.AskEmail := AskEmail; + Config.AskUserNote := AskUserNote; + Config.AskScreenSize := AskScreenSize; + + FillChar (Config.OptionalField, SizeOf(Config.OptionalField), #0); + + Config.OptionalField[1].Ask := AskOption1; + Config.OptionalField[1].Desc := Option1; + Config.OptionalField[1].iType := 1; + Config.OptionalField[1].iField := 35; + Config.OptionalField[1].iMax := 35; + Config.OptionalField[2].Ask := AskOption2; + Config.OptionalField[2].Desc := Option2; + Config.OptionalField[2].iType := 1; + Config.OptionalField[2].iField := 35; + Config.OptionalField[2].iMax := 35; + Config.OptionalField[3].Ask := AskOption3; + Config.OptionalField[3].Desc := Option3; + Config.OptionalField[3].iType := 1; + Config.OptionalField[3].iField := 35; + Config.OptionalField[3].iMax := 35; + + For A := 4 to 10 Do Begin + Config.OptionalField[A].Ask := False; + Config.OptionalField[A].Desc := 'Unused'; + Config.OptionalField[A].iType := 1; + Config.OptionalField[A].iField := 35; + Config.OptionalField[A].iMax := 35; + End; + + Config.MCompress := MCompress; + Config.MColumns := MColumns; + Config.MShowHeader := MShowHeader; + Config.MShowBases := MShowBases; + Config.MaxAutoSig := MaxAutoSig; + Config.qwkMaxBase := qwkMaxBase; + Config.qwkMaxPacket := qwkMaxPacket; + Config.qwkArchive := qwkArchive; + Config.qwkBBSID := qwkBBSID; + Config.qwkWelcome := qwkWelcome; + Config.qwkNews := qwkNews; + Config.qwkGoodbye := qwkGoodbye; + Config.Origin := Origin; + + FillChar (Config.NetAddress, SizeOf(Config.NetAddress), #0); + + For A := 1 to 20 Do Begin + Config.NetAddress[A].Zone := NetAddress[A].Zone; + Config.NetAddress[A].Net := NetAddress[A].Net; + Config.NetAddress[A].Node := NetAddress[A].Node; + Config.NetAddress[A].Point := NetAddress[A].Point; + Config.NetDesc[A] := NetAddress[A].Desc; + End; + + Config.NetCrash := NetCrash; + Config.NetHold := NetHold; + Config.NetKillSent := NetKillSent; + Config.ColorQuote := ColorQuote; + Config.ColorText := ColorText; + Config.ColorTear := ColorTear; + Config.ColorOrigin := ColorOrigin; + Config.FCompress := FCompress; + Config.FColumns := FColumns; + Config.FShowHeader := FShowHeader; + Config.FShowBases := FShowBases; + Config.FDupeScan := DupeScan; + Config.UploadBase := UploadBase; + Config.ImportDIZ := ImportDIZ; + Config.FreeUL := FreeUL; + Config.FreeCDROM := FreeCDROM; + Config.MaxFileDesc := MaxFileDesc; + Config.TestUploads := TestUploads; + Config.TestPassLevel := TestPassLevel; + Config.TestCmdLine := TestCmdLine; + Config.AcsValidate := AcsValidate; + Config.AcsSeeUnvalid := AcsSeeUnvalid; + Config.AcsDLUnvalid := AcsDLUnvalid; + Config.AcsSeeFailed := AcsSeeFailed; + Config.AcsDLFailed := AcsDLFailed; + Config.inetDomain := inetDomain; + Config.inetIPBlocking := inetIPBlocking; + Config.inetIPLogging := inetIPLogging; + Config.inetSMTPUse := inetSMTPUse; + Config.inetSMTPPort := inetSMTPPort; + Config.inetSMTPMax := inetSMTPMax; + Config.inetPOP3Use := inetPOP3Use; + Config.inetPOP3Port := inetPOP3Port; + Config.inetPOP3Max := inetPOP3Max; + Config.inetTNUse := inetTNUse; + Config.inetTNPort := inetTNPort; + Config.inetTNDupes := inetTNDupes; + Config.inetFTPUse := inetFTPUse; + Config.inetFTPPort := inetFTPPort; + Config.inetFTPMax := inetFTPMax; + Config.inetFTPDupes := inetFTPDupes; + Config.inetFTPPortMin := inetFTPPortMin; + Config.inetFTPPortMax := inetFTPPortMax; + Config.inetFTPAnon := inetFTPAnon; + Config.inetFTPTimeout := inetFTPTimeout; + + { new in 1.10 a11 } + + Config.TemplatePath := SysPath + 'template' + PathChar; + Config.MenuPath := SysPath + 'menus' + PathChar; + Config.TextPath := SysPath + 'text' + PathChar; + Config.WebPath := SysPath + 'http' + PathChar; + + Config.PWChange := 0; + Config.LoginAttempts := 3; + Config.LoginTime := 30; + Config.PWInquiry := True; + + Config.DefScreenCols := 80; + + Config.AcsMultiLogin := 's255'; + + Config.AskScreenCols := False; + + Config.ColorKludge := 08; + Config.AcsCrossPost := 's255'; + Config.AcsFileAttach := 's255'; + Config.AcsNodeLookup := 's255'; + Config.FSEditor := False; + Config.FSCommand := ''; + + Config.FCommentLines := 10; + Config.FCommentLen := 79; + + Config.inetTNMax := MaxNode; + + Config.inetSMTPDupes := 1; + Config.inetPOP3Dupes := 1; + + Config.inetNNTPUse := False; + Config.inetNNTPPort := 119; + Config.inetNNTPMax := 8; + Config.inetNNTPDupes := 3; + + Config.UseStatusBar := True; + Config.StatusColor1 := 9 + 1 * 16; + Config.StatusColor2 := 9 + 1 * 16; + Config.StatusColor3 := 15 + 1 * 16; + + Config.PWAttempts := 3; + End; + + Assign (ConfigFile, 'mystic.dat'); + ReWrite (ConfigFile); + Write (ConfigFile, Config); + Close (ConfigFile); +End; + +Procedure ConvertUsers; +Var + User : RecUser; + UserFile : File of RecUser; + OldUser : OldUserRec; + OldUserFile : File of OldUserRec; + A : LongInt; +Begin + WriteLn ('[-] Updating user database...'); + + ReNameFile(Config.DataPath + 'users.dat', Config.DataPath + 'users.old'); + + Assign (OldUserFile, Config.DataPath + 'users.old'); + Reset (OldUserFile); + + Assign (UserFile, Config.DataPath + 'users.dat'); + ReWrite (UserFile); + + While Not Eof(OldUserFile) Do Begin + Read (OldUserFile, OldUser); + + FillChar (User, SizeOf(User), #0); + + With OldUser Do Begin + User.PermIdx := PermIdx; + User.Flags := Flags; + User.Handle := Handle; + User.RealName := RealName; + User.Password := Password; + User.Address := Address; + User.City := City; + User.ZipCode := ZipCode; + User.HomePhone := HomePhone; + User.DataPhone := DataPhone; + User.Birthday := Birthday; + User.Gender := Gender; + User.Email := EmailAddr; + + FillChar (User.Optional, SizeOf(User.Optional), #0); + + User.Optional[1] := Option1; + User.Optional[2] := Option2; + User.Optional[3] := Option3; + + User.UserInfo := UserInfo; + User.Theme := Language; + User.AF1 := AF1; + User.AF2 := AF2; + User.Security := Security; + User.Expires := '00/00/00'; + User.ExpiresTo := 0; + User.LastPWChange := '00/00/00'; + User.StartMenu := StartMenu; + User.Archive := Archive; + User.QwkFiles := QwkFiles; + User.DateType := DateType; + User.ScreenSize := ScrnPause; + User.ScreenCols := 80; + User.PeerIP := ''; + User.PeerName := ''; + User.FirstOn := FirstOn; + User.LastOn := LastOn; + User.Calls := Calls; + User.CallsToday := CallsToday; + User.DLs := DLs; + User.DLsToday := DLsToday; + User.DLk := DLk; + User.DLkToday := DLkToday; + User.ULs := ULs; + User.ULk := ULk; + User.Posts := Posts; + User.Emails := Emails; + User.TimeLeft := TimeLeft; + User.TimeBank := TimeBank; + User.FileRatings := 0; + User.FileComment := 0; + User.LastFBase := LastFBase; + User.LastMBase := LastMBase; + User.LastFGroup := LastFGroup; + User.LastMGroup := LastMGroup; + + For A := 1 to 20 Do + User.Vote[A] := Vote[A]; + + User.EditType := EditType; + User.FileList := FileList; + User.SigUse := SigUse; + User.SigOffset := SigOffset; + User.SigLength := SigLength; + User.HotKeys := HotKeys; + User.MReadType := MReadType; + User.UseLBIndex := UseLBIndex; + User.UseLBQuote := UseLBQuote; + User.UseLBMIdx := UseLBMIdx; + User.UseFullChat := UserFullChat; + User.Credits := 0; + End; + + Write (UserFile, User); + End; + + Close (UserFile); + Close (OldUserFile); + + DeleteFile (Config.DataPath + 'users.old'); +End; + +Procedure ConvertSecurity; +Var + Sec : RecSecurity; + SecFile : File of RecSecurity; + OldSec : OldSecurityRec; + OldSecFile : File of OldSecurityRec; + A : LongInt; +Begin + WriteLn ('[-] Updating security definitions...'); + + ReNameFile(Config.DataPath + 'security.dat', Config.DataPath + 'security.old'); + + Assign (OldSecFile, Config.DataPath + 'security.old'); + Reset (OldSecFile); + + Assign (SecFile, Config.DataPath + 'security.dat'); + ReWrite (SecFile); + + While Not Eof(OldSecFile) Do Begin + Read (OldSecFile, OldSec); + + FillChar (Sec, SizeOf(Sec), #0); + + With OldSec Do Begin + Sec.Desc := Desc; + Sec.Time := Time; + Sec.MaxCalls := MaxCalls; + Sec.MaxDLs := MaxDLs; + Sec.MaxDLk := MaxDLk; + Sec.MaxTB := MaxTB; + Sec.DLRatio := DLRatio; + Sec.DLKRatio := DLKRatio; + Sec.AF1 := AF1; + Sec.AF2 := AF2; + Sec.Hard := Hard; + Sec.StartMNU := StartMNU; + Sec.PCRatio := PCRatio; + End; + + Write (SecFile, Sec); + End; + + Close (SecFile); + Close (OldSecFile); + + DeleteFile (Config.DataPath + 'security.old'); +End; + +(* +Procedure ConvertMessageBases; +Var + MBase : MBaseRec; + MBaseFile : File of MBaseRec; + OldBase : OldMBaseRec; + OldBaseFile : File of OldMBaseRec; +Begin + WriteLn ('[-] Updating message base config...'); + + ReNameFile(Config.DataPath + 'mbases.dat', Config.DataPath + 'mbases.old'); + + Assign (OldBaseFile, Config.DataPath + 'mbases.old'); + Reset (OldBaseFile); + + Assign (MBaseFile, Config.DataPath + 'mbases.dat'); + ReWrite (MBaseFile); + + While Not Eof(OldBaseFile) Do Begin + Read (OldBaseFile, OldBase); + + With OldBase Do Begin + MBase.Name := Name; + MBase.QwkName := QwkName; + MBase.FileName := FileName; + MBase.Path := Path; + MBase.BaseType := BaseType; + MBase.NetType := NetType; + MBase.PostType := PostType; + MBase.ACS := ACS; + MBase.ReadACS := ReadACS; + MBase.PostACS := PostACS; + MBase.SysopACS := SysopACS; + MBase.Password := Password; + MBase.ColQuote := ColQuote; + MBase.ColTear := ColTear; + MBase.ColText := ColText; + MBase.ColOrigin := ColOrigin; + MBase.NetAddr := NetAddr; + MBase.Origin := Origin; + MBase.UseReal := UseReal; + MBase.DefNScan := DefNScan; + MBase.DefQScan := DefQScan; + MBase.MaxMsgs := MaxMsgs; + MBase.MaxAge := MaxAge; + MBase.Header := Header; + MBase.Index := Index; + End; + + Write (MBaseFile, MBase); + End; + + Close (MBaseFile); + Close (OldBaseFile); + + DeleteFile (Config.DataPath + 'mbases.old'); +End; +*) +(* +Procedure ConvertFileBases; +Var + FBase : FBaseRec; + FBaseFile : File of FBaseRec; + OldBase : OldFBaseRec; + OldBaseFile : File of OldFBaseRec; +Begin + WriteLn ('[-] Updating file base config...'); + + ReNameFile(Config.DataPath + 'fbases.dat', Config.DataPath + 'fbases.old'); + + Assign (OldBaseFile, Config.DataPath + 'fbases.old'); + Reset (OldBaseFile); + + Assign (FBaseFile, Config.DataPath + 'fbases.dat'); + ReWrite (FBaseFile); + + While Not Eof(OldBaseFile) Do Begin + Read (OldBaseFile, OldBase); + + With OldBase Do Begin + FBase.Name := Name; + FBase.FtpName := strStripMCI(FBase.Name); + FBase.FileName := FileName; + FBase.DispFile := DispFile; + FBase.ListACS := ACS; + FBase.FtpACS := ACS; + FBase.SysopACS := SysopACS; + FBase.ULACS := ULACS; + FBase.DLACS := DLACS; + FBase.Path := Path; + FBase.Password := Password; + FBase.ShowUL := ShowUL; + FBase.DefScan := DefScan; + FBase.IsCDROM := IsCDROM; + FBase.IsFREE := IsFREE; + End; + + Write (FBaseFile, FBase); + End; + + Close (FBaseFile); + Close (OldBaseFile); + + DeleteFile (Config.DataPath + 'fbases.old'); +End; +*) +(* +Procedure ConvertLanguageDefs; +Var + Lang : LangRec; + LangFile : File of LangRec; + OldLang : OldLangRec; + OldLangFile : File of OldLangRec; + TempBar : PercentRec; +Begin + WriteLn ('[-] Updating language definitions...'); + + ReNameFile(Config.DataPath + 'language.dat', Config.DataPath + 'language.old'); + + Assign (OldLangFile, Config.DataPath + 'language.old'); + Reset (OldLangFile); + + Assign (LangFile, Config.DataPath + 'language.dat'); + ReWrite (LangFile); + + While Not Eof(OldLangFile) Do Begin + Read (OldLangFile, OldLang); + + TempBar.BarLen := 10; + TempBar.LoChar := '°'; + TempBar.LoAttr := 8; + TempBar.HiChar := '²'; + TempBar.HiAttr := 25; + + With OldLang Do Begin + Lang.FileName := FileName; + Lang.Desc := Desc; + Lang.TextPath := TextPath; + Lang.MenuPath := MenuPath; + Lang.okASCII := okASCII; + Lang.okANSI := okANSI; + Lang.BarYN := BarYN; + Lang.FieldCol1 := FieldColor; + Lang.FieldCol2 := FieldColor; + Lang.FieldChar := InputCh; + Lang.EchoCh := EchoCh; + Lang.QuoteColor := QuoteColor; + Lang.TagCh := TagCh; + Lang.FileHi := FileHi; + Lang.FileLo := FileLo; + Lang.NewMsgChar := NewMsgChar; + + Lang.VotingBar := TempBar; + Lang.FileBar := TempBar; + Lang.MsgBar := TempBar; + End; + + Write (LangFile, Lang); + End; + + Close (LangFile); + Close (OldLangFile); + + DeleteFile (Config.DataPath + 'language.old'); +End; +*) + +Procedure ConvertArchives; +Var + Arc : RecArchive; + ArcFile : File of RecArchive; + OldArc : OldArcRec; + OldArcFile : File of OldArcRec; +Begin + WriteLn ('[-] Updating archives...'); + + If Not ReNameFile(Config.DataPath + 'archive.dat', Config.DataPath + 'archive.old') Then Begin + WriteLn('[!] UNABLE TO FIND: ' + Config.DataPath + 'archive.dat'); + Exit; + End; + + Assign (OldArcFile, Config.DataPath + 'archive.old'); + Reset (OldArcFile); + + Assign (ArcFile, Config.DataPath + 'archive.dat'); + ReWrite (ArcFile); + + While Not Eof(OldArcFile) Do Begin + Read (OldArcFile, OldArc); + + Arc.Desc := OldArc.Name; + Arc.Ext := OldArc.Ext; + Arc.Pack := OldArc.Pack; + Arc.Unpack := OldArc.Unpack; + Arc.View := OldArc.View; + Arc.OSType := OSType; + Arc.Active := True; + + Write (ArcFile, Arc); + End; + + Close (ArcFile); + Close (OldArcFile); + + DeleteFile (Config.DataPath + 'archive.old'); +End; + +Procedure ConvertGroups; +Var + Group : RecGroup; + GroupFile : File of RecGroup; + OldGroup : OldGroupRec; + OldGroupFile : File of OldGroupRec; + Count : Byte; + FN : String; +Begin + WriteLn ('[-] Updating groups...'); + + For Count := 1 to 2 Do Begin + If Count = 1 Then FN := 'groups_f' Else FN := 'groups_g'; + + If Not ReNameFile(Config.DataPath + FN + '.dat', Config.DataPath + FN + '.old') Then Begin + WriteLn('[!] UNABLE TO FIND: ' + Config.DataPath + FN + '.dat'); + Continue; + End; + + Assign (OldGroupFile, Config.DataPath + FN + '.old'); + Reset (OldGroupFile); + + Assign (GroupFile, Config.DataPath + FN + '.dat'); + ReWrite (GroupFile); + + While Not Eof(OldGroupFile) Do Begin + Read (OldGroupFile, OldGroup); + + Group.Name := OldGroup.Name; + Group.ACS := OldGroup.ACS; + Group.Hidden := False; + + Write (GroupFile, Group); + End; + + Close (GroupFile); + Close (OldGroupFile); + + DeleteFile (Config.DataPath + FN + '.old'); + End; +End; + +Var + ConfigFile : File of RecConfig; +Begin + WarningDisplay; + +// comment this out ONLY IF config needs converting + Assign (ConfigFile, 'mystic.dat'); + Reset (ConfigFile); + Read (ConfigFile, Config); + Close (ConfigFile); + +// ConvertConfig; //1.10a11 +// ConvertUsers; //1.10a11 +//ConvertSecurity; //1.10a11 + +// ConvertArchives; //1.10a1 +// ConvertGroups; //1.10a1 + + TextAttr := 12; + WriteLn; + WriteLn ('COMPLETE!'); +End. diff --git a/mystic/ansi_install.ans b/mystic/ansi_install.ans new file mode 100644 index 0000000..d923f02 --- /dev/null +++ b/mystic/ansi_install.ans @@ -0,0 +1,13 @@ + + +² +ÜÜÜÜ °²ÜÜÜÜܱ۱°²°²gj! + ÞÛÜÜþ ß Ý °²°ÞÛÛÛÝÝÜÜÜÜÜÜÜÛÛÛÛÛÜÜÜÜß ßßÛÛÛÛÛÛ²ßßÜÜÜÜÜÜÜÛÛÜÜ + °ÛÛÛÜÜÜßÜÜÛÛÛÞÛÛÛÝ ²ßß ß ÜÜÛÛÛÛÛÛ²°ßÛÛÛÛÛßßßß ÜÛÛÛÛ²ÜßÛÛÛÛÛÛÛÛÛÛÛ±þ +ß ²ÛÛÛÛÜÜßÛ²ßÜÜÛÛÛÛ²ÞÛÛÛÝ ² ÞÛÛÛ²±²ÛÛÛÜÜ ÜÜ ²ÛÛÛ² Ü ÜÜÜ ßßÜÜÜÜÜßßÞÛ² ÜÜ ÜÛÛÛÝÞ +² ±²²²ÛßßÛÜÜÛßßÛ²²²±Þ²²²²Ü Þ²²²± ßßÛÛ²²±°Üß °²²²± ² ²²Ü±° ÛÛÛÛ²°²²²± ² Þ²²²° ² +ß Û°°°Û ßßßß Û°°°Û ß°°°°ÛÜÛ°°°Û ß ßß°°°°Û Û°°°Ûݱ °°°°Û°²²²²²Û±°°°Ýß °°°Û° ² +°²²ÛÛ Û ²ÜÜÜܲ ÛÛÛÛÛ ±Ü ßßßßÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ°± ßÛÛÛÛÜÜÛÛÛÛÛ±°°°°° ßÛÛÛÛÜÜÜÜÜ ÜÜÛ +ÜÜþ ßß² ± °°²ÜÜÜÜÜÜܲßßßßß ²ÛÛÛݲ°²ÛÛÛ²ßßßß ÞÜÜ ßßßßßßßß ßßßßß ßßßßßßß Ý°° +°Ý°²þ Þßßßßßßßßßßßßß ßßÜ +ßÜÜß ÜÜß diff --git a/mystic/aview.pas b/mystic/aview.pas new file mode 100644 index 0000000..9b53bf5 --- /dev/null +++ b/mystic/aview.pas @@ -0,0 +1,164 @@ +Unit AView; + +{$I M_OPS.PAS} + +Interface + +Uses Dos; + +Type + ArcSearchRec = Record + Name : String[50]; + Size : LongInt; + Time : LongInt; + Attr : Byte; + End; + +Type + PGeneralArchive = ^TGeneralArchive; + TGeneralArchive = Object + ArcFile : File; + Constructor Init; + Destructor Done; Virtual; + Procedure FindFirst (Var SR: ArcSearchRec); Virtual; + Procedure FindNext (Var SR: ArcSearchRec); Virtual; + End; + +Type + PArchive = ^TArchive; + TArchive = Object + Constructor Init; + Destructor Done; + Function Name (n:string) : Boolean; + Procedure FindFirst (Var SR: ArcSearchRec); + Procedure FindNext (Var SR: ArcSearchRec); + Private + _Name : String; + _Archive : PGeneralArchive; + End; + +Function Get_Arc_Type (Name: String) : Char; + +Implementation + +Uses + AViewZIP, + AViewARJ, + AViewLZH, + AViewRAR; + +Function Get_Arc_Type (Name: String) : Char; +Var + ArcFile : File; + Buf : Array[1..3] of Char; + Res : LongInt; +Begin + Get_Arc_Type := '?'; + If Name = '' Then Exit; + + Assign (ArcFile, Name); + {$I-} Reset (ArcFile, 1); {$I+} + If IoResult <> 0 Then Exit; + + BlockRead (ArcFile, Buf, SizeOf(Buf), Res); + Close (ArcFile); + + If Res = 0 Then Exit; + + If (Buf[1] = 'R') and (Buf[2] = 'a') and (Buf[3] = 'r') Then + Get_Arc_Type := 'R' + Else + + If (Buf[1] = #$60) And (Buf[2] = #$EA) Then + Get_Arc_Type := 'A' + Else + + If (Buf[1] = 'P') And (Buf[2] = 'K') Then + Get_Arc_Type := 'Z' + Else + + If Pos('.LZH', Name) > 0 Then + Get_Arc_Type := 'L'; +End; + +Constructor TGeneralArchive.Init; +Begin +End; + +Destructor TGeneralArchive.Done; +Begin +End; + +Procedure TGeneralArchive.FindFirst(var sr:ArcSearchRec); +Begin +End; + +Procedure TGeneralArchive.FindNext(var sr:ArcSearchRec); +Begin +End; + +Constructor TArchive.Init; +Begin + _Name := ''; + _Archive := Nil; +End; + +Destructor TArchive.Done; +Begin + If _Archive <> Nil Then Begin + Close (_Archive^.ArcFile); + Dispose (_Archive, Done); + End; +End; + +Function TArchive.Name (N: String): Boolean; +Var + SR : SearchRec; +Begin + If _Archive <> Nil Then Begin + Close (_Archive^.ArcFile); + Dispose (_Archive, Done); + _Archive := Nil; + End; + + Name := False; + _Name := N; + + Dos.FindFirst(_Name, AnyFile, SR); + FindClose (SR); + + If DosError <> 0 Then Exit; + + Case Get_Arc_Type(_Name) of + '?' : Exit; + 'A' : _Archive := New(PArjArchive, Init); + 'Z' : _Archive := New(PZipArchive, Init); + 'L' : _Archive := New(PLzhArchive, Init); + 'R' : _Archive := New(PRarArchive, Init); + End; + + Assign(_Archive^.ArcFile, N); + {$I-} Reset(_Archive^.ArcFile, 1); {$I+} + If IoResult <> 0 Then Begin + Dispose (_Archive, Done); + Exit; + End; + + Name := True; +End; + +Procedure TArchive.FindFirst (Var SR : ArcSearchRec); +Begin + FillChar(SR, SizeOf(SR), 0); + If _Archive = Nil Then Exit; + _Archive^.FindFirst(SR); +End; + +Procedure TArchive.FindNext(var sr:ArcSearchRec); +Begin + FillChar(SR, SizeOf(SR), 0); + If _Archive = Nil Then Exit; + _Archive^.FindNext(SR); +End; + +End. diff --git a/mystic/aviewarj.pas b/mystic/aviewarj.pas new file mode 100644 index 0000000..03ff505 --- /dev/null +++ b/mystic/aviewarj.pas @@ -0,0 +1,111 @@ +Unit AViewARJ; + +{$I M_OPS.PAS} + +Interface + +Uses + Dos, + AView; + +Const + flag_DIR = $10; + +Type + AFHeader = Record + HeadId : Word; + BHdrSz : Word; + HdrSz : Byte; + AVNo : Byte; + MAVX : Byte; + HostOS : Byte; + Flags : Byte; + SVer : Byte; + FType : Byte; + Res1 : Byte; + DOS_DT : LongInt; + CSize : LongInt; + OSize : LongInt; + SEFP : LongInt; + FSFPos : Word; + SEDLgn : Word; + Res2 : Word; + NameDat : Array[1..120] of Char; + Res3 : Array[1..10] of Char; + End; + +Type + PArjArchive = ^TArjArchive; + TArjArchive = Object(TGeneralArchive) + Constructor Init; + Procedure FindFirst (Var SR : ArcSearchRec); Virtual; + Procedure FindNext (Var SR : ArcSearchRec); Virtual; + Private + _FHdr : AFHeader; + _SL : LongInt; + Procedure GetHeader (Var SR : ArcSearchRec); + End; + +Implementation + +Const + BSize = 4096; + +Var + BUFF : Array[1..BSize] of Byte; + +Constructor TArjArchive.Init; +Begin + FillChar (_FHdr, SizeOf(_FHdr), 0); +End; + +Procedure TArjArchive.GetHeader(var sr:ArcSearchRec); +Var + {$IFDEF MSDOS} + BC : Word; + {$ELSE} + BC : LongInt; + {$ENDIF} + B : Byte; +Begin + FillChar (_FHdr, SizeOf(_FHdr), #0); + FillChar (Buff, BSize, #0); + Seek (ArcFile, _SL); + BlockRead (ArcFile, BUFF, BSIZE, BC); + Move(BUFF[1], _FHdr, SizeOf(_FHdr)); + With _FHdr Do Begin + If BHdrSz > 0 Then Begin + B := 1; + SR.Name := ''; + While NameDat[B] <> #0 Do Begin + If NameDat[B] = '/' Then + SR.Name := '' + Else + SR.Name := SR.Name + NameDat[B]; + Inc(B); + End; + SR.Size := BHdrSz + CSize; + If FType = 2 Then SR.Size := BHdrSz; + If BHdrSz = 0 Then SR.Size := 0; + Inc(_SL, SR.Size + 10); + SR.Time := DOS_DT; +{ If Flags and flag_DIR > 0 Then SR.Attr := 16 Else SR.Attr := 0;} +{ If (SR.Name[Length(SR.Name)] = '/') and (SR.Size = 0) Then SR.Attr := 16;} + + End; + End; +End; + +Procedure TArjArchive.FindFirst (Var SR : ArcSearchRec); +Begin + _SL := 0; + GetHeader (SR); + GetHeader (SR); +End; + +Procedure TArjArchive.FindNext (Var SR : ArcSearchRec); +Begin + GetHeader(SR); +End; + +End. diff --git a/mystic/aviewlzh.pas b/mystic/aviewlzh.pas new file mode 100644 index 0000000..d4ac810 --- /dev/null +++ b/mystic/aviewlzh.pas @@ -0,0 +1,81 @@ +Unit aviewlzh; + +{$I M_OPS.PAS} + +Interface + +Uses Dos,aview; + +Type LFHeader=Record + Headsize,Headchk :byte; + HeadID :packed Array[1..5] of char; + Packsize,Origsize,Filetime:longint; + Attr :word; + Filename :string[12]; + f32 :pathstr; + dt :DateTime; + end; + + +type PLzhArchive=^TLzhArchive; + TLzhArchive=object(TGeneralArchive) + constructor Init; + procedure FindFirst(var sr:ArcSearchRec);virtual; + procedure FindNext(var sr:ArcSearchRec);virtual; + private + _FHdr:LFHeader; + _SL:longint; + procedure GetHeader(var sr:ArcSearchRec); + end; + + +Implementation + + +constructor TLzhArchive.Init; +begin + _SL:=0; + FillChar(_FHdr,sizeof(_FHdr),0); +end; + + +procedure TLzhArchive.GetHeader(var sr:ArcSearchRec); +Var + {$IFDEF MSDOS} + NR : Word; + {$ELSE} + NR : LongInt; + {$ENDIF} +begin + fillchar(sr,sizeof(sr),0); + seek(ArcFile,_SL); + if eof(ArcFile) then Exit; + blockread(ArcFile,_FHdr,sizeof(LFHeader),nr); + if _FHdr.headsize=0 then exit; + inc(_SL,_FHdr.headsize); + inc(_SL,2); + inc(_SL,_FHdr.packsize); + if _FHdr.headsize<>0 then + UnPackTime(_FHdr.FileTime,_FHdr.DT); + sr.Name:=_FHdr.FileName; + sr.Size:=_FHdr.OrigSize; + sr.Time:=_FHdr.FileTime; +end; + + +procedure TLzhArchive.FindFirst(var sr:ArcSearchRec); +begin + _SL:=0; + GetHeader(sr); +end; + + +procedure TLzhArchive.FindNext(var sr:ArcSearchRec); +begin + GetHeader(sr); +end; + + +end. + +{ CUT ----------------------------------------------------------- } diff --git a/mystic/aviewrar.pas b/mystic/aviewrar.pas new file mode 100644 index 0000000..e3fe885 --- /dev/null +++ b/mystic/aviewrar.pas @@ -0,0 +1,102 @@ +Unit AViewRAR; + +{$I M_OPS.PAS} + +(* DOES NOT WORK IF FILE HAS COMMENTS... NEED TO READ SKIP ADDSIZE IF NOT $74 + +1. Read and check marker block +2. Read archive header +3. Read or skip HEAD_SIZE-sizeof(MAIN_HEAD) bytes +4. If end of archive encountered then terminate archive processing, + else read 7 bytes into fields HEAD_CRC, HEAD_TYPE, HEAD_FLAGS, + HEAD_SIZE. +5. Check HEAD_TYPE. + if HEAD_TYPE==0x74 + read file header ( first 7 bytes already read ) + read or skip HEAD_SIZE-sizeof(FILE_HEAD) bytes + if (HEAD_FLAGS & 0x100) + read or skip HIGH_PACK_SIZE*0x100000000+PACK_SIZE bytes + else + read or skip PACK_SIZE bytes + else + read corresponding HEAD_TYPE block: + read HEAD_SIZE-7 bytes + if (HEAD_FLAGS & 0x8000) + read ADD_SIZE bytes +6. go to 4. +*) + +Interface + +Uses + DOS, + AView; + +Type + RarHeaderRec = Record + PackSize : LongInt; + Size : LongInt; + HostOS : Byte; + FileCRC : LongInt; + Time : LongInt; + Version : Byte; + Method : Byte; + FNSize : SmallInt; + Attr : Longint; + End; + + PRarArchive = ^TRarArchive; + TRarArchive = Object(TGeneralArchive) + Constructor Init; + Procedure FindFirst (Var SR : ArcSearchRec); Virtual; + Procedure FindNext (Var SR : ArcSearchRec); Virtual; + Private + RAR : RarHeaderRec; + Buf : Array[1..12] of Byte; + Offset : Word; + End; + +Implementation + +Constructor TRarArchive.Init; +Begin +End; + +Procedure TRarArchive.FindFirst (Var SR : ArcSearchRec); +Begin + If Eof(ArcFile) Then Exit; + + BlockRead (ArcFile, Buf[1], 12); + + If Buf[10] <> $73 Then Exit; + + BlockRead (ArcFile, offset, 2); + BlockRead (ArcFile, Buf[1], 6); + + Seek (ArcFile, FilePos(ArcFile) + (offset - 13)); + FindNext (SR); +End; + +Procedure TRarArchive.FindNext (Var SR: ArcSearchRec); +Begin + If Eof(ArcFile) Then Exit; + + BlockRead (ArcFile, Buf[1], 5); + + If Buf[3] <> $74 Then Exit; + + BlockRead (ArcFile, Offset, 2); + BlockRead (ArcFile, RAR, SizeOf(RAR)); + BlockRead (ArcFile, SR.Name[1], RAR.FNSize); + + SR.Name[0] := Chr(RAR.FNSize); + + SR.Time := RAR.Time; + SR.Size := RAR.Size; + + If RAR.Attr = 16 Then SR.Attr := $10; + + Seek(ArcFile, FilePos(ArcFile) + (Offset - (SizeOf(RAR) + 7 + Length(SR.Name))) + RAR.PackSize); +End; + +End. \ No newline at end of file diff --git a/mystic/aviewzip.pas b/mystic/aviewzip.pas new file mode 100644 index 0000000..b737446 --- /dev/null +++ b/mystic/aviewzip.pas @@ -0,0 +1,126 @@ +Unit AViewZip; + +{$I M_OPS.PAS} + +Interface + +Uses + DOS, + AView; + +Type + ZFLocalHeader = Record + Signature : LongInt; + Version, + GPBFlag, + Compress, + Date, + Time : Word; + CRC32, + CSize, + USize : LongInt; + FNameLen, + ExtraField : Word; + End; + + ZFCentralHeader = Record + Signature : LongInt; + Version : Word; + Needed : Word; + Flags : Word; + Compress : Word; + Date : Word; + Time : Word; + Crc32 : LongInt; + CSize : LongInt; + USize : LongInt; + FNameLen : Word; + ExtraField : Word; + CommentLen : Word; + DiskStart : Word; + iFileAttr : Word; + eFileAttr : LongInt; + Offset : LongInt; + End; + +Type + PZipArchive = ^TZipArchive; + + TZipArchive = Object(TGeneralArchive) + Constructor Init; + Procedure FindFirst (Var SR : ArcSearchRec); Virtual; + Procedure FindNext (Var SR : ArcSearchRec); Virtual; + + Private + Hdr : ZFLocalHeader; + cHdr : ZFCentralHeader; + cFile : Word; + tFile : Word; + Procedure GetHeader (Var SR : ArcSearchRec); + End; + +Implementation + +Const + LocalSig = $04034B50; + CentralSig = $02014b50; + +Constructor TZipArchive.Init; +Begin + tFile := 0; + cFile := 0; +End; + +Procedure TZipArchive.GetHeader (Var SR : ArcSearchRec); +Var + S : String; +Begin + FillChar (SR, SizeOf(SR), 0); + S := ''; + + If Eof(ArcFile) or (cFile = tFile) Then Exit; + + BlockRead (ArcFile, cHdr, SizeOf(cHdr)); + BlockRead (ArcFile, S[1], cHdr.FNameLen); + + S[0] := Chr(cHdr.FNameLen); + + If cHdr.Signature = CentralSig Then Begin + Inc (cFile); + + If (S[Length(S)] = '/') and (cHdr.uSize = 0) Then SR.Attr := 16; + + SR.Name := S; + SR.Size := cHdr.uSize; + SR.Time := cHdr.Date + cHdr.Time * LongInt(256 * 256); + End; + + Seek (ArcFile, FilePos(ArcFile) + cHdr.ExtraField + cHdr.CommentLen); +End; + +Procedure TZipArchive.FindFirst (Var SR : ArcSearchRec); +Var + CurPos : LongInt; + bRead : LongInt; +Begin + BlockRead (ArcFile, Hdr, SizeOf(Hdr)); + + While Hdr.Signature = LocalSig Do Begin + Inc (tFile); + CurPos := FilePos(ArcFile) + Hdr.FNameLen + Hdr.ExtraField + Hdr.cSize; + Seek (ArcFile, CurPos); + BlockRead (ArcFile, Hdr, SizeOf(Hdr), bRead); + If bRead <> SizeOf(Hdr) Then Exit; + End; + + Seek (ArcFile, CurPos); + + GetHeader(SR); +End; + +Procedure TZipArchive.FindNext (Var SR : ArcSearchRec); +Begin + GetHeader(SR); +End; + +End. diff --git a/mystic/bbs_ansi_help.pas b/mystic/bbs_ansi_help.pas new file mode 100644 index 0000000..aba5292 --- /dev/null +++ b/mystic/bbs_ansi_help.pas @@ -0,0 +1,419 @@ +Unit bbs_Ansi_Help; + +// very old online-help class from Genesis Engine (my ansi editor) +// updated to compile with mystic but needs a lot of touch ups. +// idea is to template this out and have .hlp files that can be used in +// all help areas if they exist instead of just a display file. +// and of course a menu command to active this with ANY hlp files so sysops +// can use it however they'd like +// +// hlp files are text files which can have embedded pipe color codes in them +// and also have keywords and the ability to link around them, sort of like +// a very basic HTML system for BBS with an ansi interface to scroll around +// and follow links. + +// first port to class system from object -- DONE +// second make sure it even works --- DONE (buggy) +// then: + +// 1. change " 0) and Session.User.Access(FBase.ListACS) Then Scan_Current_Base; + End; + Close (FBaseFile); + End Else Begin + If FBase.FileName = '' Then + Session.io.OutFullLn(Session.GetPrompt(038)) + Else Begin + GetFileScan; + Reset (FBaseFile); + Scan_Current_Base; + Close (FBaseFile); + End; + End; + + If Not Found Then Session.io.OutFullLn('|CR'); + + If NewFiles Then + Session.io.OutFullLn (Session.GetPrompt(89)) + Else + Session.io.OutFullLn (Session.GetPrompt(88)); + + Session.User.IgnoreGroup := False; + FBase := TempFBase; +End; + +(**************************************************************************) +(* FILE SECTION - SYSOP FUNCTIONS *) +(**************************************************************************) + +Procedure TFileBase.DirectoryEditor (Edit : Boolean; Mask: String); + +Function Get_Next_File (Back: Boolean): Boolean; +Var + Old : FDirRec; + Pos : LongInt; +Begin + Old := FDir; + Pos := FilePos(FDirFile); + + Get_Next_File := True; + Repeat + If (Eof(FDirFile) And Not Back) or ((FilePos(FDirFile) = 1) and Back) Then Begin + FDir := Old; + Seek (FDirFile, Pos); (* this may need {I-} and/or Pos-1 *) + Get_Next_File := False; + Exit; + End; + If Back Then Seek (FDirFile, FilePos(FDirFile) - 2); + Read (FDirFile, FDir); + If (FDir.Flags And FDirDeleted = 0) and WildCardMatch(Mask, FDir.FileName) Then + Break; + Until False; +End; + +Var + DataFile : File; + DataFile2 : File; + A : Integer; + B : Integer; + Temp : String; + Old : FBaseRec; + TF : Text; +Begin + If FBase.FileName = '' Then Begin + Session.io.OutFullLn(Session.GetPrompt(38)); + Exit; + End; + + If Not Session.User.Access(FBase.SysopACS) Then Begin + Session.io.OutFullLn (Session.GetPrompt(39)); + Exit; + End; + + If Mask = '' Then Begin + Session.io.OutFull (Session.GetPrompt(195)); + Mask := Session.io.GetInput(70, 70, 11, '*.*'); + End; + + Session.SystemLog ('File DIR editor'); + + Assign (FDirFile, Config.DataPath + FBase.FileName + '.dir'); + {$I-} Reset (FDirFile); {$I+} + If IoResult <> 0 Then Begin + Session.io.OutFullLn (Session.GetPrompt(40)); + Exit; + End; + + If Eof(FDirFile) Then Begin + Session.io.OutFullLn (Session.GetPrompt(40)); + Close (FDirFile); + Exit; + End; + + Assign (DataFile, Config.DataPath + FBase.FileName + '.des'); + {$I-} Reset (DataFile, 1); {$I+} + If IoResult <> 0 Then ReWrite (DataFile, 1); + + If Get_Next_File(False) Then Begin + + If Edit Then Mask := '*.*'; + + Repeat + Session.io.OutFullLn ('|07|CLFile DIR Editor : ' + strI2S(FilePos(FDirFile)) + ' of ' + strI2S(FileSize(FDirFile))); + Session.io.OutFullLn ('|08|$D79Ä'); + Session.io.OutFullLn ('|031) |14' + FDir.FileName); + Session.io.OutFullLn ('|08|$D79Ä'); + + Session.io.OutFullLn ('|032) File Size : |11' + strPadR(strComma(FDir.Size) + ' bytes', 19, ' ') + + '|033) Uploader : |11' + FDir.Uploader); + + Session.io.OutFullLn ('|034) File Date : |11' + strPadR(DateDos2Str(FDir.DateTime, Session.User.ThisUser.DateType), 19, ' ') + + '|035) Downloads : |11' + strI2S(FDir.DLs)); + + Session.io.OutFull ('|036) Status : |11'); + + Temp := ''; + + If FDir.Flags And FDirDeleted <> 0 Then + Temp := '|12DELETED' + Else Begin + If FDir.Flags And FDirInvalid <> 0 Then Temp := 'Invalid '; + If FDir.Flags And FDirOffline <> 0 Then Temp := Temp + 'Offline '; + If FDir.Flags And FDirFailed <> 0 Then Temp := Temp + 'Failed '; + If FDir.Flags And FDirFree <> 0 Then Temp := Temp + 'Free'; + If Temp = '' Then Temp := 'Normal'; + End; + + Session.io.OutFullLn (Temp); + Session.io.OutFullLn ('|08|$D79Ä'); + + Seek (DataFile, FDir.Pointer); + For A := 1 to 11 Do Begin + Temp := ''; + If A <= FDir.Lines Then Begin + BlockRead (DataFile, Temp[0], 1); + BlockRead (DataFile, Temp[1], Ord(Temp[0])); + End; + + If A = 1 Then + Session.io.OutFullLn ('|03!) Description : |07' + Temp) + Else + Session.io.OutFullLn (strRep(' ', 17) + Temp); + End; + + Session.io.OutFullLn ('|08|$D79Ä'); + + Session.io.OutFull ('|09([) Previous (]) Next (D) Delete (I) Import DIZ (U) Update DIZ' + + '|CR(M) Move (V) View Archive (E) Email ULer (Q) Quit: '); + Case Session.io.OneKey('123456[]DEIMQUV!', True) of + '1' : Begin + Temp := Session.io.InXY (4, 3, 70, 70, 11, FDir.FileName); + If Not FBase.IsCDROM Then + If (Temp <> FDir.FileName) and (Temp <> '') Then Begin + If Not FileExist(FBase.Path + Temp) or (strUpper(Temp) = strUpper(FDir.FileName)) Then Begin + Assign(TF, FBase.Path + FDir.FileName); + {$I-} ReName(TF, FBase.Path + Temp); {$I+} + If IoResult = 0 Then FDir.FileName := Temp; + End; + End; + End; + 'D' : Begin + If Session.io.GetYN('|CR|12Delete this entry? |11', False) Then Begin + FDir.Flags := FDir.Flags Or FDirDeleted; + If FileExist(FBase.Path + FDir.FileName) Then + If Session.io.GetYN ('|12Delete ' + FBase.Path + FDir.FileName + '? |11', False) Then + FileErase(FBase.Path + FDir.FileName); + End Else + FDir.Flags := FDir.Flags And (Not FDirDeleted); + + Seek (FDirFile, FilePos(FDirFile) - 1); + Write (FDirFile, FDir); + End; + 'E' : If Session.Menu.ExecuteCommand ('MW', '/TO:' + strReplace(FDir.Uploader, ' ', '_')) Then; + 'I' : Begin + Session.io.OutFullLn ('|CR|14Importing file_id.diz...'); + If ImportDIZ(FDir.FileName) Then Begin + FDir.Pointer := FileSize(DataFile); + Seek (DataFile, FDir.Pointer); + For A := 1 to FDir.Lines Do + BlockWrite (DataFile, Session.Msgs.MsgText[A][0], Length(Session.Msgs.MsgText[A]) + 1); + End; + End; + 'M' : Begin + Session.User.IgnoreGroup := True; + Repeat + Session.io.OutFull ('|CR|09Move to which base (?/List): '); + Temp := Session.io.GetInput(4, 4, 12, ''); + If Temp = '?' Then Begin + Old := FBase; + ListFileAreas(False); + FBase := Old; + End Else Begin + Reset (FBaseFile); + B := strS2I(Temp); + If (B > 0) and (B <= FileSize(FBaseFile)) Then Begin + Session.io.OutFull ('|CR|14Moving |15' + FDir.FileName + '|14: '); + + Old := FBase; + Seek (FBaseFile, B - 1); + Read (FBaseFile, FBase); + + If Not CopyFile (Old.Path + FDir.FileName, FBase.Path + FDir.FileName) Then Begin + Session.io.OutFull ('ERROR|CR|CR|PA'); + + FBase := Old; + Break; + End; + + FileErase(Old.Path + FDir.FileName); + + A := FilePos(FDirFile); + Close (FDirFile); + + Assign (FDirFile, Config.DataPath + FBase.FileName + '.dir'); + {$I-} Reset (FDirFile); {$I+} + If IoResult <> 0 Then ReWrite(FDirFile); + + Assign (DataFile2, Config.DataPath + FBase.FileName + '.des'); + {$I-} Reset (DataFile2, 1); {$I+} + If IoResult <> 0 Then ReWrite (DataFile2, 1); + + Seek (DataFile, FDir.Pointer); + FDir.Pointer := FileSize(DataFile2); + Seek (DataFile2, FDir.Pointer); + For B := 1 to FDir.Lines Do Begin + BlockRead (DataFile, Temp[0], 1); + BlockRead (DataFile, Temp[1], Ord(Temp[0])); + BlockWrite (DataFile2, Temp[0], Length(Temp) + 1); + End; + Close (DataFile2); + Seek (FDirFile, FileSize(FDirFile)); + Write (FDirFile, FDir); + Close (FDirFile); + + FBase := Old; + + Assign (FDirFile, Config.DataPath + FBase.FileName + '.dir'); + Reset (FDirFile); + Seek (FDirFile, A - 1); + Read (FDirFile, FDir); + + FDir.Flags := FDir.Flags Or FDirDeleted; + End; + Close (FBaseFile); + Break; + End; + Until False; + + Session.User.IgnoreGroup := False; + End; + 'Q' : Begin + Seek (FDirFile, FilePos(FDirFile) - 1); + Write (FDirFile, FDir); + Break; + End; + 'U' : Begin + Session.io.OutFullLn ('|CR|14Updating FILE_ID.DIZ...'); + + Assign (TF, Session.TempPath + 'file_id.diz'); + ReWrite (TF); + Seek (DataFile, FDir.Pointer); + For B := 1 to FDir.Lines Do Begin + BlockRead (DataFile, Temp[0], 1); + BlockRead (DataFile, Temp[1], Ord(Temp[0])); + WriteLn (TF, Temp); + End; + Close (TF); + + ExecuteArchive (FBase.Path + FDir.FileName, '', Session.TempPath + 'file_id.diz', 1); + + FileErase(Session.TempPath + 'file_id.diz'); + End; + 'V' : If Not ArchiveView (FBase.Path + FDir.FileName) Then Session.io.OutFullLn(Session.GetPrompt(191)); + '[' : Begin + Seek (FDirFile, FilePos(FDirFile) - 1); + Write (FDirFile, FDir); + If Not Get_Next_File(True) Then; + End; + ']' : Begin + Seek (FDirFile, FilePos(FDirFile) - 1); + Write (FDirFile, FDir); + If Not Get_Next_File(False) Then; + End; + '!' : Begin + Seek (DataFile, FDir.Pointer); + If FDir.Lines > Config.MaxFileDesc Then FDir.Lines := Config.MaxFileDesc; + For A := 1 to FDir.Lines Do Begin + BlockRead (DataFile, Session.Msgs.MsgText[A][0], 1); + BlockRead (DataFile, Session.Msgs.MsgText[A][1], Ord(Session.Msgs.MsgText[A][0])); + End; + + Temp := 'Description Editor'; + B := FDir.Lines; + + If Editor(B, mysMaxFileDescLen, Config.MaxFileDesc, True, False, Temp) Then Begin + FDir.Lines := B; + FDir.Pointer := FileSize(DataFile); + Seek (DataFile, FDir.Pointer); + For A := 1 to FDir.Lines Do + BlockWrite (DataFile, Session.Msgs.MsgText[A][0], Length(Session.Msgs.MsgText[A]) + 1); + End; + End; + '2' : Begin + Session.io.OutFull ('Size: '); + FDir.Size := strS2I(Session.io.GetInput(8, 8, 12, strI2S(FDir.Size))); + End; + '4' : FDir.DateTime := DateStr2Dos(Session.io.InXY(16, 6, 8, 8, 15, DateDos2Str(FDir.DateTime, Session.User.ThisUser.DateType))); + '3' : FDir.Uploader := Session.io.InXY(50, 5, 30, 30, 18, FDir.Uploader); + '5' : FDir.DLs := strS2I(Session.io.InXY(50, 6, 4, 4, 12, strI2S(FDir.DLs))); + '6' : Begin + Session.io.OutFull('|CRFlags: F(a)iled, (F)ree, (O)ffline, (U)nvalidated, (Q)uit: '); + Case Session.io.OneKey('AFOUQ', True) of + 'A' : FDir.Flags := FDir.Flags XOR FDirFailed; + 'F' : FDir.Flags := FDir.Flags XOR FDirFree; + 'O' : FDir.Flags := FDir.Flags XOR FDirOffline; + 'U' : FDir.Flags := FDir.Flags XOR FDirInvalid; + End; + End; + End; + Until False; + End; + + Close (FDirFile); + Close (DataFile); +End; + +Procedure TFileBase.MassUpload; +Var + Done : Boolean; + AutoAll : Boolean; + + Procedure Do_Area; + Var + A : Byte; + OldPos : Word; + Skip : Boolean; + DataFile : File; + DirInfo : SearchRec; + AutoArea : Boolean; + Temp : String; + Begin + If FBase.FileName = '' Then Exit; + + AutoArea := AutoAll; + + Session.io.OutFullLn ('|CR|03Processing |14|FB|03...'); + + Assign (DataFile, Config.DataPath + FBase.FileName + '.des'); + {$I-} Reset (DataFile, 1); {$I+} + If IoResult = 0 Then + Seek (DataFile, FileSize(DataFile)) + Else + ReWrite (DataFile, 1); + + Assign (FDirFile, Config.DataPath + FBase.FileName + '.dir'); + + FindFirst(FBase.Path + FileMask, Archive, DirInfo); + While DosError = 0 Do Begin + + OldPos := FilePos(FBaseFile); + Close (FBaseFile); + + CheckFileNameLength(FBase.Path, DirInfo.Name); + + Skip := IsDupeFile(DirInfo.Name, False); + + Reset (FBaseFile); + Seek (FBaseFile, OldPos); + + If Not Skip Then + Session.io.OutFullLn ('|CR|03File : |14' + DirInfo.Name); + + If Not AutoArea And Not Skip Then Begin + Session.io.OutFull ('|03Cmd : |09(Y)es, (N)o, (A)uto, (G)lobal, (S)kip, (Q)uit: '); + Case Session.io.OneKey('AGNQSY', True) of + 'A' : AutoArea := True; + 'G' : Begin + AutoArea := True; + AutoAll := True; + End; + 'N' : Skip := True; + 'Q' : Begin + Done := True; + Break; + End; + 'S' : Break; + End; + End; + + If Not Skip Then Begin + FDir.FileName := DirInfo.Name; + FDir.Size := DirInfo.Size; + FDir.DateTime := CurDateDos; + FDir.Uploader := Session.User.ThisUser.Handle; + FDir.DLs := 0; + FDir.Flags := 0; + FDir.Lines := 0; + + If Config.ImportDIZ Then + If Not ImportDIZ(DirInfo.Name) Then + If Not AutoArea Then + GetFileDescription(DirInfo.Name); + + If FDir.Lines = 0 Then Begin + Session.Msgs.MsgText[1] := Session.GetPrompt(208); + FDir.Lines := 1; + End; + + FDir.Pointer := FileSize(DataFile); + For A := 1 to FDir.Lines Do + BlockWrite (DataFile, Session.Msgs.MsgText[A][0], Length(Session.Msgs.MsgText[A]) + 1); + + If Config.TestUploads and (Config.TestCmdLine <> '') Then Begin + Temp := ''; + A := 1; + + While A <= Length(Config.TestCmdLine) Do Begin + If Config.TestCmdLine[A] = '%' Then Begin + Inc(A); + If Config.TestCmdLine[A] = '1' Then Temp := Temp + '1' Else + If Config.TestCmdLine[A] = '2' Then Temp := Temp + '38400' Else + If Config.TestCmdLine[A] = '3' Then Temp := Temp + FBase.Path + FDir.FileName; + End Else + Temp := Temp + Config.TestCmdLine[A]; + + Inc (A); + End; + + If ShellDOS('', Temp) <> Config.TestPassLevel Then + FDir.Flags := FDir.Flags OR FDirFailed; + End; + + {$I-} Reset (FDirFile); {$I+} + If IoResult <> 0 Then ReWrite(FDirFile); + Seek (FDirFile, FileSize(FDirFile)); + Write (FDirFile, FDir); + Close (FDirFile); + End; + FindNext(DirInfo); + End; + + FindClose(DirInfo); + + Close (DataFile); + End; + +Var + Old : FBaseRec; + Pos : LongInt; +Begin + Session.SystemLog ('Mass upload'); + + Old := FBase; + Done := False; + AutoAll := False; + + Reset (FBaseFile); + + If Session.io.GetYN('|CR|12Upload files in all directories? |11', True) Then Begin + While Not Done and Not Eof(FBaseFile) Do Begin + Read (FBaseFile, FBase); + Pos := FilePos(FBaseFile); + Do_Area; + Seek (FBaseFile, Pos); + End; + End Else + Do_Area; + + Close (FBaseFile); + + FBase := Old; +End; + +End. diff --git a/mystic/bbs_general.pas b/mystic/bbs_general.pas new file mode 100644 index 0000000..cd90609 --- /dev/null +++ b/mystic/bbs_general.pas @@ -0,0 +1,1560 @@ +Unit bbs_General; + +{$I M_OPS.PAS} + +Interface + +// more ancient come from my teenage years lol this stuff needs to be +// sorted out / cleaned up and passed a session pointer or relocate to +// one of the classes + +Uses + m_Strings, + m_DateTime, + {$IFNDEF UNIX} + bbs_SysopChat, + {$ENDIF} + bbs_Common, + bbs_Edit_Full, + bbs_Edit_Line; + +Function Editor (Var Lines: SmallInt; MaxLen, MaxLine: SmallInt; TEdit, Forced : Boolean; Var Subj: String) : Boolean; +Procedure Upgrade_User_Level (Now : Boolean; Var U : RecUser; Sec: Byte); +Procedure View_BBS_List (Long: Boolean; Data: String); +Procedure Add_BBS_List (Name : String); + +Procedure AutoSig_Edit; +Procedure AutoSig_View; + +Procedure List_Users (Data: String); +{$IFNDEF UNIX} + Procedure Page_For_Chat (Forced: Boolean); +{$ENDIF} +Procedure Last_Callers; +Procedure Add_TimeBank; +Procedure Get_TimeBank; +Procedure One_Liners (Data : String); +Procedure Display_Quote; +Procedure Add_Booth; +Procedure Voting_Booth (Forced: Boolean; Num: Integer); +Procedure Voting_Result (Data : Integer); +Procedure Voting_Booth_New; +Procedure View_History (LastDays: Word); +Function Check_Node_Message : Boolean; +Procedure View_Directory (Data: String; ViewType: Byte); + +Implementation + +Uses + DOS, + m_FileIO, + m_QuickSort, + bbs_Core, + bbs_NodeInfo; + +Function Editor (Var Lines: SmallInt; MaxLen, MaxLine: SmallInt; TEdit, Forced : Boolean; Var Subj: String) : Boolean; +Begin + If (Session.io.Graphics > 0) and ((Session.User.ThisUser.EditType = 1) or ((Session.User.ThisUser.EditType = 2) and Session.io.GetYN(Session.GetPrompt(106), True))) Then + Editor := AnsiEditor(Lines, MaxLen, MaxLine, TEdit, Forced, Subj) + Else + Editor := LineEditor(Lines, MaxLen, MaxLine, TEdit, Forced, Subj); +End; + +Procedure Upgrade_User_Level (Now: Boolean; Var U: RecUser; Sec: Byte); +Var + A : Char; + T : RecSecurity; +Begin + Reset (Session.User.SecurityFile); + Seek (Session.User.SecurityFile, Sec - 1); + Read (Session.User.SecurityFile, T); + Close (Session.User.SecurityFile); + + U.Security := Sec; + U.StartMenu := T.StartMenu; + U.TimeLeft := T.Time; + U.Expires := '00/00/00'; + U.ExpiresTo := T.ExpiresTo; + + If T.Expires > 0 Then + U.Expires := DateJulian2Str(CurDateJulian + T.Expires, 1); + + For A := 'A' to 'Z' Do + If Ord(A) - 64 in T.AF1 Then + U.AF1 := U.AF1 + [Ord(A) - 64] + Else + If T.Hard Then + U.AF1 := U.AF1 - [Ord(A) - 64]; + + For A := 'A' to 'Z' Do + If Ord(A) - 64 in T.AF2 Then + U.AF2 := U.AF2 + [Ord(A) - 64] + Else + If T.Hard Then + U.AF2 := U.AF2 - [Ord(A) - 64]; + + If Now Then Session.User.Security := T; +End; + +Procedure AutoSig_Edit; +Var + DF : File; + Lines : Integer; + Str : String; +Begin + If Config.MaxAutoSig = 0 Then Exit; + + Assign (DF, Config.DataPath + 'autosig.dat'); + + If Session.User.ThisUser.SigLength > 0 Then Begin + Reset (DF, 1); + Seek (DF, Session.User.ThisUser.SigOffset); + For Lines := 1 to Session.User.ThisUser.SigLength Do Begin + BlockRead (DF, Session.Msgs.MsgText[Lines][0], 1); + BlockRead (DF, Session.Msgs.MsgText[Lines][1], Ord(Session.Msgs.MsgText[Lines][0])); + End; + Close (DF); + End Else + Lines := 0; + + Str := 'Signature Editor'; {++lang} + + If Editor (Lines, 78, Config.MaxAutoSig, True, False, Str) Then Begin + {$I-} Reset (DF, 1); {$I+} + If IoResult <> 0 Then ReWrite (DF, 1); + Session.User.ThisUser.SigLength := Lines; + Session.User.ThisUser.SigOffset := FileSize(DF); + Seek (DF, Session.User.ThisUser.SigOffset); + For Lines := 1 to Lines Do + BlockWrite (DF, Session.Msgs.MsgText[Lines][0], Length(Session.Msgs.MsgText[Lines]) + 1); + Close (DF); + End; +End; + +Procedure AutoSig_View; +Var + DF : File; + A : Byte; + S : String[79]; +Begin + If Session.User.ThisUser.SigLength > 0 Then Begin + Assign (DF, Config.DataPath + 'autosig.dat'); + Reset (DF, 1); + Seek (DF, Session.User.ThisUser.SigOffset); + + For A := 1 to Session.User.ThisUser.SigLength Do Begin + BlockRead (DF, S[0], 1); + BlockRead (DF, S[1], Ord(S[0])); + Session.io.OutFullLn (S); + End; + + Close (DF); + End Else + Session.io.OutFull (Session.GetPrompt(336)); +End; + +Procedure Display_Quote; +Var + TF : Text; + TxtBuf : Array[1..1024] of Char; + Total, + Count : Integer; + Str : String; +Begin + Assign (TF, Config.DataPath + 'quotes.dat'); + {$I-} Reset (TF); {$I+} + If IoResult <> 0 Then Exit; + SetTextBuf (TF, TxtBuf); + + Total := 0; + While Not Eof(TF) Do Begin + ReadLn (TF, Str); + If Str[1] = '*' Then Inc(Total); + End; + + If Total = 0 Then Begin + Close (TF); + Exit; + End; + + Count := Random(Total) + 1; + Total := 0; + + Reset (TF); + While Total <> Count Do Begin + ReadLn (TF, Str); + If Str[1] = '*' Then Inc(Total); + End; + + While Not Eof(TF) Do Begin + ReadLn (TF, Str); + If Str[1] = '*' Then Break Else Session.io.OutFullLn (Str); + End; + Close (TF); +End; + +Function SearchBBS (Str : String; Temp : BBSListRec) : Boolean; +Begin + Str := strUpper(Str); + + SearchBBS := Bool_Search(Str, Temp.BBSName) or + Bool_Search(Str, Temp.SysopName) or + Bool_Search(Str, Temp.Software) or + Bool_Search(Str, Temp.Telnet) or + Bool_Search(Str, Temp.Phone) or + Bool_Search(Str, Temp.Location); +End; + +Procedure Add_BBS_List (Name : String); +Var + BBSFile : File of BBSListRec; + BBSList : BBSListRec; + Temp : BBSListRec; +Begin + If Name = '' Then Exit; + + Session.io.OutFull (Session.GetPrompt(361)); + Case Session.io.OneKey ('DTBQ', True) of + 'D' : BBSList.cType := 0; + 'T' : BBSList.cType := 1; + 'B' : BBSList.cType := 2; + 'Q' : Exit; + End; + + Session.io.OutRawLn(''); + + If BBSList.cType in [0, 2] Then Begin + Session.io.OutFull (Session.GetPrompt(283)); + BBSList.Phone := Session.io.GetInput(15, 15, 12, ''); + If BBSList.Phone = '' Then Exit; + End Else + BBSList.Phone := 'None'; //++lang + + If BBSList.cType in [1, 2] Then Begin + Session.io.OutFull (Session.GetPrompt(330)); + BBSList.Telnet := Session.io.GetInput(40, 40, 11, ''); + If BBSList.Telnet = '' Then Exit; + End Else + BBSList.Telnet := 'None'; //++lang + + Assign (BBSFile, Config.DataPath + Name + '.bbi'); + {$I-} Reset(BBSFile); {$I+} + If IoResult <> 0 Then ReWrite(BBSFile); + + While Not Eof(BBSFile) Do Begin + Read (BBSFile, Temp); + + If ((strUpper(BBSList.Phone) = strUpper(Temp.Phone)) and (Temp.Phone <> 'None')) or + ((strUpper(BBSList.Telnet) = strUpper(Temp.Telnet)) and (Temp.Telnet <> 'None')) Then Begin + Session.io.OutFullLn(Session.GetPrompt(362)); + Close (BBSFile); + Exit; + End; + End; + Close (BBSFile); + + Session.io.OutFull (Session.GetPrompt(284)); + BBSList.BBSName := Session.io.GetInput(30, 30, 11, ''); + + Session.io.OutFull (Session.GetPrompt(285)); + BBSList.Location := Session.io.GetInput(25, 25, 18, ''); + + Session.io.OutFull (Session.GetPrompt(286)); + BBSList.SysopName := Session.io.GetInput(30, 30, 11, ''); + + Session.io.OutFull (Session.GetPrompt(287)); + BBSList.BaudRate := Session.io.GetInput(6, 6, 11, ''); + + Session.io.OutFull (Session.GetPrompt(288)); + BBSList.Software := Session.io.GetInput(10, 10, 11, ''); + + If Session.io.GetYN(Session.GetPrompt(290), True) Then Begin + BBSList.Deleted := False; + BBSList.AddedBy := Session.User.ThisUser.Handle; + BBSList.Verified := CurDateDos; + + Reset (BBSFile); + Seek (BBSFile, FileSize(BBSFile)); + Write (BBSFile, BBSList); + Close (BBSFile); + End; +End; + +Procedure View_BBS_List (Long : Boolean; Data : String); +Var + BBSFile : File of BBSListRec; + BBSList : BBSListRec; + Name : String[8]; + Str : String; + Search : Boolean; +Begin + Search := False; + + If Pos(';', Data) > 0 Then Begin + Name := Copy(Data, 1, Pos(';', Data) - 1); + Search := Pos(';SEARCH', strUpper(Data)) > 0; + End Else + Name := Data; + + If Name = '' Then Exit; + + Assign (BBSFile, Config.DataPath + Name + '.bbi'); + {$I-} Reset(BBSFile); {$I+} + If IoResult <> 0 Then Begin + Session.io.OutFullLn (Session.GetPrompt(291)); + Exit; + End; + + If Search Then Begin + Session.io.OutFull (Session.GetPrompt(292)); + Str := Session.io.GetInput(30, 30, 11, ''); + End; + + Session.io.PausePtr := 1; + Session.io.AllowPause := True; + + If Long Then + Session.io.OutFullLn (Session.GetPrompt(264)) + Else + Session.io.OutFullLn (Session.GetPrompt(260)); + + While Not EOF(BBSFile) Do Begin + Read (BBSFile, BBSList); + + If BBSList.Deleted Then Continue; + + If (Search and SearchBBS(Str, BBSList)) or Not Search Then Begin + Session.io.PromptInfo[1] := BBSList.BBSName; + + Case BBSList.cType of + 0 : Begin + Session.io.PromptInfo[3] := BBSList.Phone; + Session.io.PromptInfo[2] := 'DIALUP'; //++lang + End; + 1 : Begin + Session.io.PromptInfo[3] := BBSList.Telnet; + Session.io.PromptInfo[2] := 'TELNET'; //++lang + End; + 2 : Begin + Session.io.PromptInfo[3] := BBSList.Telnet; + Session.io.PromptInfo[2] := 'DU/TEL'; //++lang + End; + End; + + If (BBSList.cType = 0) and Long Then Session.io.PromptInfo[3] := BBSList.Telnet; + + Session.io.PromptInfo[4] := BBSList.Software; + Session.io.PromptInfo[5] := BBSList.Location; + Session.io.PromptInfo[6] := BBSList.SysopName; + Session.io.PromptInfo[7] := BBSList.BaudRate; + Session.io.PromptInfo[8] := BBSList.AddedBy; + Session.io.PromptInfo[9] := BBSList.Phone; + Session.io.PromptInfo[10] := DateDos2Str(BBSList.Verified, Session.User.ThisUser.DateType); + + If Long Then Begin + Session.io.OutFullLn (Session.GetPrompt(265)); + Session.io.OutFull (Session.GetPrompt(267)); + Case Session.io.OneKey('DQV'#13, True) of + 'D' : If Session.User.Access(Config.AcsSysop) or (strUpper(BBSList.AddedBy) = strUpper(Session.User.ThisUser.Handle)) Then Begin + If Session.io.GetYN(Session.GetPrompt(294), False) Then Begin + BBSList.Deleted := True; + Seek (BBSFile, FilePos(BBSFile) - 1); + Write (BBSFile, BBSList); + End; + End Else + Session.io.OutFullLn (Session.GetPrompt(295)); + 'Q' : Break; + 'V' : If Session.io.GetYN(Session.GetPrompt(266), False) Then Begin + BBSList.Verified := CurDateDos; + Seek (BBSFile, FilePos(BBSFile) - 1); + Write (BBSFile, BBSList); + End; + End; + End Else Begin + Session.io.OutFullLn (Session.GetPrompt(261)); + + If (Session.io.PausePtr >= Session.User.ThisUser.ScreenSize) and (Session.io.AllowPause) Then + Case Session.io.MorePrompt of + 'N' : Break; + 'C' : Session.io.AllowPause := False; + End; + End; + End; + End; + Close (BBSFile); + + If Not Long Then + Session.io.OutFullLn (Session.GetPrompt(262)); +End; + +Procedure List_Users (Data : String); +Var + Total : Integer; + tUser : RecUser; +Begin + If Data = 'SEARCH' Then Begin + Session.io.OutFull (Session.GetPrompt(32)); + Data := Session.io.GetInput (30, 30, 12, ''); + End; + + Reset (Session.User.UserFile); + + Session.io.PausePtr := 1; + Session.io.AllowPause := True; + + Session.io.OutFullLn (Session.GetPrompt(29)); + + Total := 0; + + While Not Eof(Session.User.UserFile) Do Begin + Read (Session.User.UserFile, tUser); + + If tUser.Flags AND UserDeleted <> 0 Then Continue; + + Session.io.PromptInfo[1] := tUser.Handle; + Session.io.PromptInfo[2] := tUser.City; + Session.io.PromptInfo[3] := DateDos2Str(tUser.LastOn, Session.User.ThisUser.DateType); + Session.io.PromptInfo[4] := tUser.Gender; + Session.io.PromptInfo[5] := strI2S(tUser.Security); + Session.io.PromptInfo[6] := tUser.Address; + Session.io.PromptInfo[7] := strI2S(DaysAgo(tUser.Birthday) DIV 365); + Session.io.PromptInfo[8] := tUser.Email; + Session.io.PromptInfo[9] := tUser.UserInfo; + Session.io.PromptInfo[10] := tUser.Optional[1]; + Session.io.PromptInfo[11] := tUser.Optional[2]; + Session.io.PromptInfo[12] := tUser.Optional[3]; + + If (Data = '') or (Pos(Data, strUpper(tUser.Handle)) > 0) Then Begin + Session.io.OutFullLn (Session.GetPrompt(30)); + Inc (Total); + + If (Session.io.PausePtr >= Session.User.ThisUser.ScreenSize) and (Session.io.AllowPause) Then + Case Session.io.MorePrompt of + 'N' : Break; + 'C' : Session.io.AllowPause := False; + End; + End; + End; + Close (Session.User.UserFile); + Session.io.PromptInfo[1] := strI2S(Total); + Session.io.OutFull (Session.GetPrompt(31)); +End; + +{$IFNDEF UNIX} +Procedure Page_For_Chat (Forced: Boolean); +Var + Temp : String; + A, B : Integer; +Begin + If Forced or ((TimerMinutes >= Config.ChatStart) and (TimerMinutes <= Config.ChatEnd)) Then Begin + Session.io.OutFull (Session.GetPrompt(23)); + Temp := Session.io.GetInput(50, 50, 11, ''); + If Temp = '' Then Exit; + + Session.SystemLog('Chat Page: ' + Temp); + + Update_Status_Line (0, ' ' + strPadR(Session.User.ThisUser.Handle, 17, ' ') + ' ' + strPadR(Temp, 40, ' ') + ' ALT+(S)plit (C)Line'); + + Session.io.OutFull(Session.GetPrompt(24)); + + For A := 1 to 10 Do Begin + Session.io.OutFull(Session.GetPrompt(25)); + + For B := 0 to 6 Do Begin + //SysBeepEx(523, 50); + //SysBeepEx(659, 50); + End; + If Input.KeyPressed Then If Input.ReadKey = #0 Then Begin + Case Input.ReadKey of + #31 : OpenChat(True); + #46 : OpenChat(False); + End; + Exit; + End; + WaitMS(1000); + End; + End; + + Update_Status_line (StatusPtr, ''); + + Session.io.OutFull (Session.GetPrompt(28)); + + If Config.ChatFeedback Then + If Session.io.GetYN(Session.GetPrompt(178), False) Then + Session.Msgs.PostMessage (True, '/TO:' + strReplace(Config.SysopName, ' ', '_') + ' /SUBJ:Chat_Feedback'); +End; +{$ENDIF} + +Procedure Last_Callers; +Begin + Session.io.OutFullLn (Session.GetPrompt(141)); + Reset (LastOnFile); + While Not Eof(LastOnFile) Do Begin + Read (LastOnFile, LastOn); + Session.io.PromptInfo[1] := LastOn.Handle; + Session.io.PromptInfo[2] := strI2S(LastOn.Node); + Session.io.PromptInfo[3] := LastOn.City; + Session.io.PromptInfo[4] := DateDos2Str(LastOn.DateTime, Session.User.ThisUser.DateType); + Session.io.PromptInfo[5] := TimeDos2Str(LastOn.DateTime, True); + Session.io.PromptInfo[6] := LastOn.Baud; + Session.io.PromptInfo[7] := strI2S(LastOn.CallNum); + Session.io.PromptInfo[8] := LastOn.Address; + Session.io.PromptInfo[9] := LastOn.UserInfo; + Session.io.PromptInfo[10] := LastOn.EmailAddr; + Session.io.PromptInfo[11] := LastOn.Option1; + Session.io.PromptInfo[12] := LastOn.Option2; + Session.io.PromptInfo[13] := LastOn.Option3; + Session.io.OutFullLn (Session.GetPrompt(142)); + End; + Close (LastOnFile); + Session.io.OutFull (Session.GetPrompt(143)); +End; + +Procedure Add_TimeBank; +Var + A : Integer; +Begin + Session.io.OutFull (Session.GetPrompt(172)); + A := strS2I(Session.io.GetInput(4, 4, 11, '')); + If A > 0 Then + If (A < Session.TimeLeft - 4) Then Begin + If (Session.User.Security.MaxTB > 0) and (Session.User.ThisUser.TimeBank + A > Session.User.Security.MaxTB) Then Begin + Session.io.OutFullLn (Session.GetPrompt(209)); + Exit; + End; + Inc (Session.User.ThisUser.TimeBank, A); + Session.SetTimeLeft (Session.TimeLeft - A); + End Else + Session.io.OutFullLn (Session.GetPrompt(210)); +End; + +Procedure Get_TimeBank; +Var + A : Integer; +Begin + Session.io.OutFull (Session.GetPrompt(173)); + A := strS2I(Session.io.GetInput(4, 4, 11, '')); + If (A > 0) and (A <= Session.User.ThisUser.TimeBank) Then Begin + Dec (Session.User.ThisUser.TimeBank, A); + Session.SetTimeLeft (Session.TimeLeft + A); + End; +End; + +Procedure One_Liners (Data : String); +Const + MaxLines : Byte = 9; + MaxLen : Byte = 75; + MaxField : Byte = 75; +Var + OneLineFile : File of OneLineRec; + OneLine : OneLineRec; + Str : String; + A : Byte; +Begin + A := Pos(';', Data); + If A > 0 Then Begin + MaxLines := strS2I(Copy(Data, 1, A - 1)) - 1; + Delete (Data, 1, A); + A := Pos(';', Data); + MaxLen := strS2I(Copy(Data, 1, A - 1)); + MaxField := strS2I(Copy(Data, A + 1, Length(Data))); + End; + + Assign (OneLineFile, Config.DataPath + 'oneliner.dat'); + {$I-} Reset (OneLineFile); {$I+} + If IoResult <> 0 Then ReWrite (OneLineFile); + + Repeat + Reset (OneLineFile); + Session.io.OutFullLn (Session.GetPrompt(188)); + + While Not Eof(OneLineFile) Do Begin + Read (OneLineFile, OneLine); + Session.io.PromptInfo[1] := OneLine.Text; + Session.io.PromptInfo[2] := OneLine.From; + Session.io.PromptInfo[3] := OneLine.From[1]; + If Pos(' ', OneLine.From) > 0 Then + Session.io.PromptInfo[3] := Session.io.PromptInfo[3] + OneLine.From[Pos(' ', OneLine.From) + 1]; + Session.io.OutFullLn (Session.GetPrompt(337)); + End; + + If Session.io.GetYN(Session.GetPrompt(189), False) Then Begin + Session.io.OutFull (Session.GetPrompt(190)); + Str := Session.io.GetInput (MaxField, MaxLen, 11, ''); + If Str <> '' Then Begin + If FileSize(OneLineFile) > MaxLines Then + KillRecord (OneLineFile, 1, SizeOf(OneLineRec)); + + OneLine.Text := Str; + OneLine.From := Session.User.ThisUser.Handle; + + Seek (OneLineFile, FileSize(OneLineFile)); + Write (OneLineFile, OneLine); + End; + End Else + Break; + Until False; + + Close (OneLineFile); +End; + +Procedure Add_Booth; +Var + A : Byte; +Begin + If Not Session.io.GetYN (Session.GetPrompt(275), True) Then Exit; + + Reset (VoteFile); + If FileSize (VoteFile) = mysMaxVoteQuestion Then Begin + Close (VoteFile); + Session.io.OutFull (Session.GetPrompt(276)); + Exit; + End; + Close (VoteFile); + + Session.io.OutFull (Session.GetPrompt(277)); + Vote.Question := Session.io.GetInput(78, 78, 11, ''); + If Vote.Question = '' Then Exit; + + Session.io.OutFullLn (Session.GetPrompt(278)); + + A := 1; + + While A <= 15 Do Begin + Session.io.PromptInfo[1] := strI2S(A); + Session.io.OutFull (Session.GetPrompt(279)); + Vote.Answer[A].Text := Session.io.GetInput(40, 40, 11, ''); + If Vote.Answer[A].Text = '' Then Begin + Dec (A); + Break; + End; + Vote.Answer[A].Votes := 0; + Inc(A); + End; + + If A = 0 Then Exit; + + Vote.AnsNum := A; + Vote.Votes := 0; + Vote.ACS := ''; + Vote.AddACS := 's999'; + Vote.ForceACS := 's999'; + + If Session.io.GetYN(Session.GetPrompt(280), True) Then Vote.AddACS := ''; + + If Session.io.GetYN(Session.GetPrompt(281), True) Then Begin + Reset (VoteFile); + Seek (VoteFile, FileSize(VoteFile)); + Write (VoteFile, Vote); + Close (VoteFile); + End; +End; + +{ VOTING BOOTH SHIT } + +Function Voting_List : Byte; +Var + Total : Byte; +Begin + Reset (VoteFile); + + Session.io.OutFullLn (Session.GetPrompt(241)); + + Total := 0; + While Not Eof(VoteFile) Do Begin + Read (VoteFile, Vote); + If Session.User.Access(Vote.ACS) Then Begin + Inc (Total); + Session.io.PromptInfo[1] := strI2S(Total); + Session.io.PromptInfo[2] := Vote.Question; + If Session.User.ThisUser.Vote[FilePos(VoteFile)] = 0 Then + Session.io.PromptInfo[3] := '*' //++lang + Else + Session.io.PromptInfo[3] := ' '; + Session.io.OutFullLn (Session.GetPrompt(242)); + End; + End; + Close (VoteFile); + + If Total = 0 Then Session.io.OutFullLn (Session.GetPrompt(243)); + Voting_List := Total; +End; + +Procedure Voting_Result (Data : Integer); +Var + A : SmallInt; + P : SmallInt; +Begin + Reset (VoteFile); + + If (Data > 0) and (Data <= FileSize(VoteFile)) Then Begin + Seek (VoteFile, Data - 1); + Read (VoteFile, Vote); + Close (VoteFile); + End Else Begin + A := Voting_List; + If A = 0 Then Exit; + + Repeat + Session.io.PromptInfo[1] := strI2S(A); + Session.io.OutFull (Session.GetPrompt(263)); + P := strS2I(Session.io.GetInput(2, 2, 12, '')); + If P = 0 Then Exit; + If P <= A Then Break; + Until False; + + Reset (VoteFile); + A := 0; + Repeat + Read (VoteFile, Vote); + If Session.User.Access(Vote.ACS) Then Inc(A); + Until A = P; + Close (VoteFile); + End; + + Session.io.PromptInfo[1] := Vote.Question; + Session.io.PromptInfo[2] := strI2S(Vote.Votes); + Session.io.OutFullLn (Session.GetPrompt(249)); + For A := 1 to Vote.AnsNum Do Begin + Session.io.PromptInfo[1] := strI2S(A); + Session.io.PromptInfo[2] := Vote.Answer[A].Text; + Session.io.PromptInfo[3] := strI2S(Vote.Answer[A].Votes); + If Vote.Votes = 0 Then Begin + Session.io.PromptInfo[4] := '0'; + Session.io.PromptInfo[5] := ''; + End Else Begin + Session.io.PromptInfo[5] := Session.io.DrawPercent(Session.Lang.VotingBar, Vote.Answer[A].Votes, Vote.Votes, P); + Session.io.PromptInfo[4] := strI2S(P); + End; + Session.io.OutFullLn (Session.GetPrompt(250)); + End; + Session.io.OutFull (Session.GetPrompt(251)); +End; + +Procedure Voting_Booth_New; +Var + NewQues : Array[1..mysMaxVoteQuestion] of Boolean; + Pos : Byte; +Begin + Reset (VoteFile); + While Not Eof(VoteFile) Do Begin + Read (VoteFile, Vote); + If Session.User.Access(Vote.ACS) Then + NewQues[FilePos(VoteFile)] := (Session.User.ThisUser.Vote[FilePos(VoteFile)] = 0) + Else + NewQues[FilePos(VoteFile)] := False; + End; + Close (VoteFile); + + For Pos := 1 to mysMaxVoteQuestion Do + If NewQues[Pos] Then Voting_Booth (False, Pos); +End; + +Procedure Voting_Booth (Forced: Boolean; Num: Integer); +Var + VPos : Byte; + Temp : Byte; + Total : Byte; + Str : String[40]; +Begin + + If Not Forced And (Num = 0) Then Begin + Total := Voting_List; + If Total = 0 Then Exit; + + Repeat + Session.io.PromptInfo[1] := strI2S(Total); + Session.io.OutFull (Session.GetPrompt(244)); + Temp := strS2I(Session.io.GetInput(2, 2, 12, '')); + If Temp = 0 Then Exit; + If Temp <= Total Then Break; + Until False; + + Total := 0; + Reset (VoteFile); + Repeat + Read (VoteFile, Vote); + If Session.User.Access(Vote.ACS) Then Inc(Total); + Until Total = Temp; + End Else Begin + Reset (VoteFile); + If Num > FileSize(VoteFile) Then Begin + Close (VoteFile); + Exit; + End; + Seek (VoteFile, Num - 1); + Read (VoteFile, Vote); + End; + + VPos := FilePos(VoteFile); + + Repeat + Session.io.PromptInfo[1] := Vote.Question; + Session.io.OutFullLn (Session.GetPrompt(245)); + For Temp := 1 to Vote.AnsNum Do Begin + Session.io.PromptInfo[1] := strI2S(Temp); + Session.io.PromptInfo[2] := Vote.Answer[Temp].Text; + If Session.User.ThisUser.Vote[VPos] = Temp Then + Session.io.PromptInfo[3] := '*' //++lang + Else + Session.io.PromptInfo[3] := ' '; + Session.io.OutFullLn (Session.GetPrompt(246)); + End; + + If Session.User.Access(Vote.AddACS) and (Vote.AnsNum < 15) Then Begin + Session.io.PromptInfo[1] := strI2S(Vote.AnsNum + 1); + Session.io.PromptInfo[2] := Session.GetPrompt(252); + Session.io.PromptInfo[3] := ' '; + Session.io.OutFullLn (Session.GetPrompt(246)); + End; + + Session.io.OutFull (Session.GetPrompt(247)); + Temp := strS2I(Session.io.GetInput(2, 2, 12, '')); + + If (Vote.AnsNum < 15) and Session.User.Access(Vote.AddACS) and (Temp = Succ(Vote.AnsNum)) Then Begin + Session.io.OutFull (Session.GetPrompt(253)); + Str := Session.io.GetInput (40, 40, 11, ''); + If Str <> '' Then Begin + Inc (Vote.AnsNum); + Vote.Answer[Vote.AnsNum].Text := Str; + Vote.Answer[Vote.AnsNum].Votes := 0; + End; + End; + + If (Temp > 0) and (Temp <= Vote.AnsNum) Then Begin + If Session.User.ThisUser.Vote[VPos] <> 0 Then Begin + Dec (Vote.Answer[Session.User.ThisUser.Vote[VPos]].Votes); + Dec (Vote.Votes); + End; + Inc(Vote.Answer[Temp].Votes); + Inc(Vote.Votes); + Session.User.ThisUser.Vote[VPos] := Temp; + + Seek (VoteFile, VPos - 1); + Write (VoteFile, Vote); + Break; + End Else + If Forced Then Session.io.OutFull (Session.GetPrompt(254)) Else Break; + Until False; + + Close (VoteFile); + If Session.io.GetYN (Session.GetPrompt(248), True) Then Voting_Result(VPos); +End; + +Procedure View_History (LastDays: Word); +Var + Temp : HistoryRec; + Days : Word; +Begin + Assign (Session.HistoryFile, Config.DataPath + 'history.dat'); + {$I-} Reset(Session.HistoryFile); {$I+} + If IoResult <> 0 Then + Session.io.OutFullLn (Session.GetPrompt(454)) + Else Begin + If (LastDays > 0) And (FileSize(Session.HistoryFile) >= LastDays) Then + Seek (Session.HistoryFile, FileSize(Session.HistoryFile) - LastDays); + + Session.io.AllowPause := True; + Session.io.PausePtr := 1; + Days := 0; + + Session.io.OutFullLn (Session.GetPrompt(455)); + + While Not Eof(Session.HistoryFile) Do Begin + Read (Session.HistoryFile, Temp); + + Session.io.PromptInfo[1] := DateDos2Str(Temp.Date, Session.User.ThisUser.DateType); + Session.io.PromptInfo[2] := strI2S(Temp.Calls); + Session.io.PromptInfo[3] := strI2S(Temp.NewUsers); + Session.io.PromptInfo[4] := strI2S(Temp.Posts); + Session.io.PromptInfo[5] := strI2S(Temp.Emails); + Session.io.PromptInfo[6] := strI2S(Temp.Downloads); + Session.io.PromptInfo[7] := strI2S(Temp.DownloadKB); + Session.io.PromptInfo[8] := strI2S(Temp.Uploads); + Session.io.PromptInfo[9] := strI2S(Temp.UploadKB); + + Session.io.OutFullLn (Session.GetPrompt(456)); + + Inc (Days); + + If (Session.io.PausePtr >= Session.User.ThisUser.ScreenSize) and (Session.io.AllowPause) Then + Case Session.io.MorePrompt of + 'N' : Break; + 'C' : Session.io.AllowPause := False; + End; + End; + + Close (Session.HistoryFile); + + Session.io.PromptInfo[1] := strI2S(Days); + + Session.io.OutFullLn (Session.GetPrompt(457)); + End; +End; + +Function Check_Node_Message : Boolean; +Var + Res : Boolean; + Str : String; +Begin + Check_Node_Message := False; + Res := False; + + Assign (NodeMsgFile, Session.TempPath + 'chat.tmp'); + FileMode := 66; + {$I-} Reset (NodeMsgFile); {$I+} + If IoResult <> 0 Then Exit; + +{ checks for non-teleconference node messages: + 2 = system broadcast message (ie, not from user, from mystic) + 3 = user to user node message } + + While Not Eof(NodeMsgFile) Do Begin + Res := True; + + Read (NodeMsgFile, NodeMsg); + + Session.io.PromptInfo[1] := NodeMsg.FromWho; + Session.io.PromptInfo[2] := strI2S(NodeMsg.FromNode); + + Case NodeMsg.MsgType of + 2 : Begin + Session.io.OutFullLn (Session.GetPrompt(179) + NodeMsg.Message); + Session.io.OutFullLn (Session.GetPrompt(180)); + End; + 3 : Begin + Session.io.OutFullLn (Session.GetPrompt(144) + '|CR' + NodeMsg.Message); + Session.io.OutFull (Session.GetPrompt(145)); + End; + End; + End; + + Close (NodeMsgFile); + Erase (NodeMsgFile); + + If Res And (NodeMsg.MsgType = 3) Then + If Session.io.OneKey(#13 + 'R', True) = 'R' Then Begin + Session.io.OutFullLn(Session.GetPrompt(360)); + Str := Session.io.GetInput(79, 79, 11, ''); + If Str <> '' Then Send_Node_Message(3, Session.io.PromptInfo[2] + ';' + Str, 0); + End; + + Check_Node_Message := Res; +End; + +Procedure View_Directory (Data: String; ViewType: Byte); +Const + vtMaxList = 1000; + +Type + RecSauceInfo = Packed Record + Title : String[35]; + Author : String[20]; + Group : String[20]; + End; + + DirRec = Record + Desc : String[160]; + Size : LongInt; + Date : LongInt; + IsDir : Boolean; + Title : String[34]; + Author : String[19]; + Group : String[19]; + End; + +Var + WinTop : Byte; + WinBot : Byte; + WinSize : Byte; + DirList : Array[1..vtMaxList] of ^DirRec; + DirCount : LongInt = 0; + CurTop : LongInt = 1; + CurBot : LongInt = 1; + CurPos : LongInt = 1; + CurPath : String; + Root : String; + + Function ReadSauceInfo (FN: String; Var Sauce: RecSauceInfo) : Boolean; + Var + DF : File; + Str : String; + Res : LongInt; + Begin + Result := False; + + Assign (DF, FN); + + {$I-} Reset (DF, 1); {$I+} + + If IoResult <> 0 Then Exit; + + {$I-} Seek (DF, FileSize(DF) - 130); {$I+} + + If IoResult <> 0 Then Begin + Close (DF); + Exit; + End; + + BlockRead (DF, Str[1], 130); + Str[0] := #130; + + Close (DF); + + Res := Pos('SAUCE', Copy(Str, 1, 7)); + + If Res > 0 Then Begin + Result := True; + + Sauce.Title := strReplace(Copy(Str, 7 + Res, 35), #0, #32); + Sauce.Author := strReplace(Copy(Str, 42 + Res, 20), #0, #32); + Sauce.Group := strReplace(Copy(Str, 62 + Res, 20), #0, #32); + End; + End; + + Procedure BuildDirectory (Path: String); + Var + SR : SearchRec; + Count : Word; + Sauce : RecSauceInfo; + Temp : String; + SortLoop : Word; + SortPos : Word; + Sort : TQuickSort; + Begin + For Count := DirCount Downto 1 Do + Dispose(DirList[Count]); + + Sort := TQuickSort.Create; + Temp := Session.GetPrompt(473); + DirCount := 0; + + For Count := 1 to 2 Do Begin + FindFirst (Path + '*', AnyFile, SR); + + While (DosError = 0) And (DirCount < vtMaxList) Do Begin + If (SR.Name = '.') or ((Path = Root) And (SR.Name = '..')) Then Begin + FindNext (SR); + Continue; + End; + + If ((Count = 1) And (SR.Attr And Directory = 0)) or + ((Count = 2) And (SR.Attr And Directory <> 0)) Then Begin + FindNext(SR); + Continue; + End; + + Inc (DirCount); + + New (DirList[DirCount]); + + DirList[DirCount]^.Desc := SR.Name; + DirList[DirCount]^.Size := SR.Size; + DirList[DirCount]^.Date := SR.Time; + + If (SR.Attr And Directory) = 0 Then Begin + DirList[DirCount]^.IsDir := False; + + If ReadSauceInfo(Path + SR.Name, Sauce) Then Begin + DirList[DirCount]^.Title := Sauce.Title; + DirList[DirCount]^.Author := Sauce.Author; + DirList[DirCount]^.Group := Sauce.Group; + End Else Begin + DirList[DirCount]^.Title := strWordGet(1, Temp, ';'); + DirList[DirCount]^.Author := strWordGet(2, Temp, ';'); + DirList[DirCount]^.Group := strWordGet(3, Temp, ';'); + End; + End Else + DirList[DirCount]^.IsDir := True; + + FindNext (SR); + End; + + FindClose (SR); + + Case Count of + 1 : Begin + SortPos := DirCount; + + For SortLoop := 1 to DirCount Do + Sort.Add(strUpper(DirList[SortLoop]^.Desc), LongInt(@DirList[SortLoop]^)); + + Sort.Sort(1, DirCount, qAscending); + + For SortLoop := 1 to DirCount Do + DirList[SortLoop] := Pointer(Sort.Data[SortLoop]^.Ptr); + End; + 2 : If SortPos <> DirCount Then Begin + Sort.Clear; + + For SortLoop := Succ(SortPos) to DirCount Do + Sort.Add(strUpper(DirList[SortLoop]^.Desc), LongInt(@DirList[SortLoop]^)); + + Sort.Sort(1, DirCount - SortPos, qAscending); + + For SortLoop := 1 to DirCount - SortPos Do + DirList[SortLoop + SortPos] := Pointer(Sort.Data[SortLoop]^.Ptr); + End; + End; + End; + + Sort.Free; + End; + + Procedure SetBarInfo (BarPos: Word); + Begin + Session.io.PromptInfo[1] := DirList[BarPos]^.Desc; + Session.io.PromptInfo[2] := strComma(DirList[BarPos]^.Size); + Session.io.PromptInfo[3] := DateDos2Str(DirList[BarPos]^.Date, Session.User.ThisUser.DateType); + Session.io.PromptInfo[7] := TimeDos2Str(DirList[BarPos]^.Date, True); + + If DirList[BarPos]^.IsDir Then Begin + Session.io.PromptInfo[4] := ''; + Session.io.PromptInfo[5] := ''; + Session.io.PromptInfo[6] := ''; + End Else Begin + Session.io.PromptInfo[4] := DirList[BarPos].Author; + Session.io.PromptInfo[5] := DirList[BarPos].Title; + Session.io.PromptInfo[6] := DirList[BarPos].Group; + End; + End; + + Procedure DrawPage; + Var + Count : SmallInt; + Start : Word; + Begin + Start := CurTop; + + For Count := WinTop to WinBot Do Begin + Session.io.AnsiGotoXY(1, Count); + + If Start <= DirCount Then Begin + SetBarInfo(Start); + + Case DirList[Start]^.IsDir of + False : Session.io.OutFull(Session.GetPrompt(467)); + True : Session.io.OutFull(Session.GetPrompt(469)); + End; + End Else Begin + Session.io.PromptInfo[1] := ''; + Session.io.PromptInfo[2] := ''; + Session.io.PromptInfo[3] := ''; + Session.io.PromptInfo[4] := ''; + Session.io.PromptInfo[5] := ''; + Session.io.PromptInfo[6] := ''; + Session.io.PromptInfo[7] := ''; + + Session.io.OutFull(Session.GetPrompt(467)); + End; + + Inc (Start); + End; + + CurBot := Start - 1; + + If CurPos > CurBot Then CurPos := CurBot; + + Session.io.PromptInfo[1] := Session.io.DrawPercent(Session.Lang.GalleryBar, CurBot, DirCount, Count); + Session.io.PromptInfo[2] := strI2S(Count); + + Session.io.OutFull(Session.GetPrompt(472)); + End; + + Procedure DrawBar (Selected: Boolean); + Begin + SetBarInfo(CurPos); + + Session.io.AnsiGotoXY (1, CurPos - CurTop + WinTop); + + If Selected Then + Case DirList[CurPos]^.IsDir of + False : Session.io.OutFull(Session.GetPrompt(468)); + True : Session.io.OutFull(Session.GetPrompt(470)); + End + Else + Case DirList[CurPos]^.IsDir of + False : Session.io.OutFull(Session.GetPrompt(467)); + True : Session.io.OutFull(Session.GetPrompt(469)); + End; + End; + + Procedure UpdatePath; + Var + Temp : String; + Begin + Temp := CurPath; + + Delete (Temp, 1, Length(Root) - 1); + + If Length(Temp) > 70 Then + Session.io.PromptInfo[1] := '..' + Copy(Temp, (Length(Temp) - 68), 255) + Else + Session.io.PromptInfo[1] := Temp; + + Session.io.PromptInfo[2] := strComma(DirCount); + + Session.io.OutFull(Session.GetPrompt(471)); + End; + + Procedure FullReDraw; + Begin + Session.io.OutFile('ansigal', False, 0); + + WinTop := Session.io.ScreenInfo[1].Y; + WinBot := Session.io.ScreenInfo[2].Y; + WinSize := WinBot - WinTop + 1; + + UpdatePath; + DrawPage; + DrawBar(True); + End; + + Function FindCharacter (Ch: Char) : Byte; + Var + Loop : Boolean; + StartPos : Word; + EndPos : Word; + Count : Word; + Begin + Result := 0; + Loop := True; + StartPos := CurPos + 1; + EndPos := DirCount; + + If StartPos > DirCount Then StartPos := 1; + + Count := StartPos; + + While (Count <= EndPos) Do Begin + If UpCase(DirList[Count]^.Desc[1]) = Ch Then Begin + Result := 1; + + While Count <> CurPos Do Begin + If CurPos < Count Then Begin + If CurPos < DirCount Then Inc (CurPos); + If CurPos >= CurTop + WinSize Then Begin + Inc (CurTop); + Result := 2; + End; + End Else + If CurPos > Count Then Begin + If CurPos > 1 Then Dec (CurPos); + If CurPos < CurTop Then Begin + Dec (CurTop); + Result := 2; + End; + End; + End; + Break; + End; + + If (Count = DirCount) and Loop Then Begin + Count := 0; + StartPos := 1; + EndPos := CurPos - 1; + Loop := False; + End; + + Inc (Count); + End; + End; + +Var + Ch : Char; + Count : Word; + Speed : Byte; +Begin + If Session.io.Graphics = 0 Then Begin + Session.io.OutFullLn(Session.GetPrompt(466)); + Exit; + End; + + Session.io.AllowArrow := True; + + Root := DirSlash(strWordGet(1, Data, ';')); + Speed := strS2I(strWordGet(2, Data, ';')); + CurPath := Root; + + BuildDirectory(CurPath); + + FullReDraw; + + Repeat + Ch := UpCase(Session.io.GetKey); + + If Session.io.IsArrow Then Begin + Case Ch of + #71 : If CurPos > 1 Then Begin + CurPos := 1; + CurTop := 1; + + DrawPage; + DrawBar(True); + End; + #72 : If CurPos > 1 Then Begin + If CurPos = CurTop Then Begin + Dec (CurTop); + Dec (CurPos); + + DrawPage; + DrawBar(True); + End Else Begin + DrawBar(False); + Dec(CurPos); + DrawBar(True); + End; + End; + #73, + #75 : If CurTop - WinSize >= 1 Then Begin + Dec (CurTop, WinSize); + Dec (CurPos, WinSize); + + DrawPage; + DrawBar(True); + End Else + If CurPos > 1 Then Begin + CurPos := 1; + CurTop := 1; + + DrawPage; + DrawBar(True); + End; + #79 : If CurPos < DirCount Then Begin + CurPos := DirCount; + CurTop := DirCount - WinSize + 1; + + If CurTop < 1 Then CurTop := 1; + + DrawPage; + DrawBar(True); + End; + #80 : If CurPos < DirCount Then Begin + If CurPos = CurBot Then Begin + Inc (CurTop); + Inc (CurPos); + DrawPage; + DrawBar(True); + End Else Begin + DrawBar(False); + Inc(CurPos); + DrawBar(True); + End; + End; + #77, + #81 : If CurTop + WinSize <= DirCount - WinSize Then Begin + Inc (CurPos, WinSize); + Inc (CurTop, WinSize); + + DrawPage; + DrawBar(True); + End Else + If CurPos < DirCount Then Begin + CurPos := DirCount; + CurTop := DirCount - WinSize + 1; + + If CurTop < 1 Then CurTop := 1; + + DrawPage; + DrawBar(True); + End; + End; + End Else + Case Ch of + #08 : If CurPath <> Root Then Begin + Delete (CurPath, Length(CurPath), 1); + + While CurPath[Length(CurPath)] <> PathChar Do + Delete (CurPath, Length(CurPath), 1); + + BuildDirectory(CurPath); + + CurPos := 1; + CurTop := 1; + + UpdatePath; + DrawPage; + DrawBar(True); + End; + #13 : If DirList[CurPos]^.IsDir Then Begin + If DirList[CurPos]^.Desc = '..' Then Begin + Delete (CurPath, Length(CurPath), 1); + + While CurPath[Length(CurPath)] <> PathChar Do + Delete (CurPath, Length(CurPath), 1); + End Else + CurPath := CurPath + DirList[CurPos]^.Desc + PathChar; + + BuildDirectory(CurPath); + + CurPos := 1; + CurTop := 1; + + UpdatePath; + DrawPage; + DrawBar(True); + End Else Begin + Session.io.AllowMCI := True; + Session.io.AnsiColor(7); + Session.io.AnsiClear; + Session.io.OutFile (CurPath + DirList[CurPos]^.Desc, False, Speed); + Session.io.PauseScreen; + + FullReDraw; + End; + #27 : Break; + '?' : Begin + Session.io.OutFile('ansigalh', False, 0); + FullRedraw; + End; + '!' : If Not DirList[CurPos]^.IsDir Then Begin + Session.io.AnsiColor(7); + Session.io.AnsiGotoXY(1, Session.User.ThisUser.ScreenSize); + + If Session.io.GetYN(Session.GetPrompt(474), False) Then + Session.FileBase.SendFile(CurPath + DirList[CurPos]^.Desc); + + FullReDraw; + End; + Else + DrawBar(False); + + Case FindCharacter(Ch) of + 0, + 1 : DrawBar(True); + 2 : Begin + DrawPage; + DrawBar(True); + End; + End; + End; + Until Session.ShutDown; + + Session.io.AnsiColor(7); + Session.io.AnsiGotoXY(1, 24); + + For Count := DirCount DownTo 1 Do + Dispose (DirList[Count]); +End; + +(* MYSTIC 2's ANSIVIEWER +- needs to be intergrated with the msgbases. there should NOT be a msgtext AND this + class. there should only be one place where the massive message buffer exists. + +Procedure TBBSIO.AnsiViewer (Data: String); +Var + Buf : Array[1..4096] of Char; + BufLen : LongInt; + TopLine : LongInt; + WinSize : LongInt; + Ansi : TMsgBaseAnsi; + AFile : File; + Ch : Char; + FN : String; + Template : String; + Str : String; + Sauce : RecSauceInfo; + + Procedure Update; + Begin + // add percentage bar and line number here + Ansi.DrawPage (TBBSCore(Owner).Term.ScreenInfo[1].Y, TBBSCore(Owner).Term.ScreenInfo[2].Y, TopLine); + End; + +Begin + Template := strWordGet(1, Data, ';'); + FN := strWordGet(2, Data, ';'); + + If Pos(mysPathSep, FN) = 0 Then + FN := TBBSCore(Owner).Theme.PathText + FN; + + If Pos('.', FN) = 0 Then + FN := FN + '.ans'; + + If Not FileExist(FN) Then Exit; + + PromptInfo['A'] := JustFile(FN); + + If ReadSauceInfo(FN, Sauce) Then Begin + PromptInfo['B'] := strStripR(strWide2Str(Sauce.Title, 35), ' '); + PromptInfo['C'] := strStripR(strWide2Str(Sauce.Author, 20), ' '); + PromptInfo['D'] := strStripR(strWide2Str(Sauce.Group, 20), ' '); + Str := strWide2Str(Sauce.Date, 8); + PromptInfo['E'] := Copy(Str, 5, 2) + '/' + Copy(Str, 7, 2) + '/' + Copy(Str, 1, 4); + End Else Begin + PromptInfo['B'] := 'Unknown'; + PromptInfo['C'] := PromptInfo['B']; + PromptInfo['D'] := PromptInfo['B']; + PromptInfo['E'] := '??/??/????'; + End; + + Ansi := TMsgBaseAnsi.Create(TBBSCore(Owner), False); + + Assign (AFile, FN); + ioReset (AFile, 1, fmReadWrite + fmDenyNone); + + While Not Eof(AFile) Do Begin + ioBlockRead (AFile, Buf, SizeOf(Buf), BufLen); + If Ansi.ProcessBuf (Buf, BufLen) Then Break; + End; + + Close (AFile); + + TBBSCore(Owner).Term.AllowArrow := True; + + ShowTemplate(Template); + + WinSize := TBBSCore(Owner).Term.ScreenInfo[2].Y - TBBSCore(Owner).Term.ScreenInfo[1].Y + 1; + + If strUpper(strWordGet(3, Data, ';')) = 'END' Then Begin + TopLine := Ansi.Lines - WinSize + 1; + If TopLine < 1 Then TopLine := 1; + End Else + TopLine := 1; + + Update; + + While Not TBBSCore(Owner).ShutDown Do Begin + Ch := UpCase(GetKey(0)); + + If IsArrow Then Begin + Case Ch of + #71 : If TopLine > 1 Then Begin + TopLine := 1; + Update; + End; + #72 : If TopLine > 1 Then Begin + Dec (TopLine); + Update; + End; + #73, + #75 : If TopLine > 1 Then Begin + Dec (TopLine, WinSize); + If TopLine < 1 Then TopLine := 1; + Update; + End; + #79 : If TopLine + WinSize <= Ansi.Lines Then Begin + TopLine := Ansi.Lines - WinSize + 1; + Update; + End; + #80 : If TopLine + WinSize <= Ansi.Lines Then Begin + Inc (TopLine); + Update; + End; + #77, + #81 : If TopLine < Ansi.Lines - WinSize Then Begin + Inc (TopLine, WinSize); + If TopLine + WinSize > Ansi.Lines Then TopLine := Ansi.Lines - WinSize + 1; + Update; + End; + End; + End Else + If Ch = #27 Then Break; + End; + + Ansi.Free; + + OutRaw(AnsiGotoXY(1, TBBSCore(Owner).User.ThisUser.ScreenSize)); +End; +*) +End. diff --git a/mystic/bbs_io.pas b/mystic/bbs_io.pas new file mode 100644 index 0000000..5d24c49 --- /dev/null +++ b/mystic/bbs_io.pas @@ -0,0 +1,1824 @@ +Unit BBS_IO; + +{$I M_OPS.PAS} + +Interface + +Uses + {$IFDEF WINDOWS} + Windows, + WinSock2, + {$ENDIF} + m_Types, + m_DateTime, + m_FileIO, + m_Strings, + m_Term_Ansi, + bbs_Common; + +Const + TBBSIOBufferSize = 4 * 1024 - 1; + MaxPromptInfo = 15; + +Type + TBBSIO = Class + Core : Pointer; + Term : TTermAnsi; + ScreenInfo : Array[0..9] of Record X, Y, A : Byte; End; + PromptInfo : Array[1..MaxPromptInfo] of String[89]; + FmtString : Boolean; + FmtLen : Byte; + FmtType : Byte; + InMacro : Boolean; + InMacroPos : Byte; + InMacroStr : String; + BaudEmulator : Byte; + AllowPause : Boolean; + AllowMCI : Boolean; + LocalInput : Boolean; + AllowArrow : Boolean; + IsArrow : Boolean; + UseInField : Boolean; + UseInLimit : Boolean; + UseInSize : Boolean; + InLimit : Byte; + InSize : Byte; + AllowAbort : Boolean; + Aborted : Boolean; + NoFile : Boolean; + Graphics : Byte; + PausePtr : Byte; + InputData : Array[1..mysMaxInputHistory] of String[255]; + LastMCIValue : String; + InputPos : Byte; + + {$IFDEF WINDOWS} + OutBuffer : Array[0..TBBSIOBufferSize] of Char; + OutBufPos : SmallInt; + SocketEvent : THandle; + {$ENDIF} + + Constructor Create (Var Owner: Pointer); + Destructor Destroy; Override; + + Procedure BufAddChar (Ch: Char); + Procedure BufAddStr (Str: String); + Procedure BufFlush; + Function ParseMCI (Display : Boolean; Code: String) : Boolean; + Function StrMci (Str: String) : String; + Function Attr2Ansi (Attr: Byte) : String; + Function Pipe2Ansi (Color : Byte) : String; + Procedure AnsiGotoXY (X : Byte; Y:Byte); + Procedure AnsiMoveX (X : Byte); + Procedure AnsiMoveY (Y : Byte); + Procedure AnsiColor (A : Byte); + Procedure AnsiClear; + Procedure AnsiClrEOL; + Procedure OutPipe (Str: String); + Procedure OutPipeLn (Str: String); + Procedure OutRaw (Str : String); + Procedure OutRawLn (Str: String); + Procedure OutBS (Num : Byte; Del: Boolean); + Procedure OutFull (Str : String); + Procedure OutFullLn (Str : String); + Procedure OutFile (FName : String; DoPause: Boolean; Speed: Byte); + Function OutYN (Y : Boolean) : String; + Function OutON (O : Boolean) : String; + Procedure PauseScreen; + Function MorePrompt : Char; + Function DrawPercent (Bar : PercentRec; Part, Whole : SmallInt; Var Percent : SmallInt) : String; + Function GetInput (Field, Max, Mode: Byte; Default : String) : String; + Function InXY (X, Y, Field, Max, Mode: Byte; Default: String) : String; + Function InKey : Char; + Function GetYNL (Str: String; Yes: Boolean) : Boolean; + Function GetKey : Char; + Function GetYN (Str: String; Yes: Boolean) : Boolean; + Function GetPW (Str : String; BadStr : String; PW : String) : Boolean; + Function OneKey (Str: String; Echo: Boolean) : Char; + Procedure RemoteRestore (Var Image: TConsoleImageRec); + Procedure PurgeInputBuffer; + + {$IFDEF WINDOWS} + Procedure LocalScreenDisable; + Procedure LocalScreenEnable; + {$ENDIF} + End; + +Implementation + +Uses + DOS, + bbs_Core, + bbs_General; + +Constructor TBBSIO.Create (Var Owner: Pointer); +Begin + Core := Owner; + FmtString := False; + FmtLen := 0; + FmtType := 0; + InMacro := False; + InMacroPos := 0; + InMacroStr := ''; + AllowPause := False; + AllowMCI := True; + LocalInput := False; + AllowArrow := False; + IsArrow := False; + UseInField := True; + UseInLimit := False; + UseInSize := False; + InLimit := 0; + InSize := 0; + AllowAbort := False; + Aborted := False; + NoFile := False; + Graphics := 1; + PausePtr := 1; + LastMCIValue := ''; + InputPos := 0; + + {$IFDEF WINDOWS} + FillChar(OutBuffer, SizeOf(OutBuffer), 0); + OutBufPos := 0; + + If Not TBBSCore(Core).LocalMode Then + SocketEvent := WSACreateEvent; + {$ENDIF} + + Term := TTermAnsi.Create(Screen); +End; + +Destructor TBBSIO.Destroy; +Begin + {$IFDEF WINDOWS} + If Not TBBSCore(Core).LocalMode Then WSACloseEvent(SocketEvent); + {$ENDIF} + + Term.Free; + + Inherited Destroy; +End; + +Procedure TBBSIO.BufAddChar (Ch: Char); +Begin + {$IFDEF WINDOWS} + OutBuffer[OutBufPos] := Ch; + + Inc (OutBufPos); + + If OutBufPos = TBBSIOBufferSize Then BufFlush; + {$ENDIF} + + Term.Process(Ch); +End; + +Procedure TBBSIO.BufAddStr (Str: String); +Var + Count : Word; +Begin + For Count := 1 to Length(Str) Do + BufAddChar(Str[Count]); +End; + +Procedure TBBSIO.BufFlush; +Var + Res : LongInt; +Begin + {$IFDEF WINDOWS} + If OutBufPos > 0 Then Begin + If Not TBBSCore(Core).LocalMode Then Begin + Res := TBBSCore(Core).Client.WriteBuf(OutBuffer, OutBufPos); + + While (Res = -1) and (WSAGetLastError = EWOULDBLOCK) Do Begin + WaitMS(10); + Res := TBBSCore(Core).Client.WriteBuf(OutBuffer, OutBufPos); + End; + End; + + OutBufPos := 0; + End; + {$ENDIF} + + {$IFDEF UNIX} + Screen.BufFlush; + {$ENDIF} +End; + +Procedure TBBSIO.AnsiMoveY (Y : Byte); +Var + T : Byte; +Begin + If Graphics = 0 Then Exit; + + T := Screen.CursorY; + + If Y > T Then BufAddStr (#27 + '[' + strI2S(Y-T) + 'B') Else + If Y < T Then BufAddStr (#27 + '[' + strI2S(T-Y) + 'A'); +End; + +Procedure TBBSIO.AnsiMoveX (X : Byte); +Var + T : Byte; +Begin + If Graphics = 0 Then Exit; + + T := Screen.CursorX; + + If X > T Then BufAddStr (#27 + '[' + strI2S(X-T) + 'C') Else + If X < T Then BufAddStr (#27 + '[' + strI2S(T-X) + 'D'); +End; + +Procedure TBBSIO.PauseScreen; +Var + Attr : Byte; + Ch : Char; +Begin + Attr := Screen.TextAttr; + + OutFull (TBBSCore(Core).GetPrompt(22)); + + PurgeInputBuffer; + + Repeat + Ch := GetKey; + Until Ch <> ''; + + AnsiColor(Attr); + + BufAddStr(#13#10); +End; + +Function TBBSIO.MorePrompt : Char; +Var + SavedAttr : Byte; + SavedMCI : Boolean; + Ch : Char; +Begin + SavedMCI := AllowMCI; + AllowMCI := True; + SavedAttr := Screen.TextAttr; + + OutFull (TBBSCore(Core).GetPrompt(132)); + + PurgeInputBuffer; + + Ch := OneKey('YNC' + #13, False); + + OutBS(Screen.CursorX, True); + AnsiColor(SavedAttr); + + PausePtr := 1; + AllowMCI := SavedMCI; + Result := Ch; +End; + +Procedure TBBSIO.OutBS (Num: Byte; Del: Boolean); +Var + A : Byte; + Str : String[7]; +Begin + If Del Then Str := #8#32#8 Else Str := #8; + + For A := 1 to Num Do + OutRaw (Str); +End; + +Procedure TBBSIO.OutPipe (Str: String); +Var + Count : Byte; + Code : String[2]; +Begin + If FmtString Then Begin + FmtString := False; + Case FmtType of + 1 : Str := strPadR(Str, FmtLen + Length(Str) - Length(strStripPipe(Str)), ' '); + 2 : Str := strPadL(Str, FmtLen + Length(Str) - Length(strStripPipe(Str)), ' '); + 3 : Str := strPadC(Str, FmtLen + Length(Str) - Length(strStripPipe(Str)), ' '); + End; + End; + + Count := 1; + + While Count <= Length(Str) Do Begin + If (Str[Count] = '|') and (Count < Length(Str) - 1) Then Begin + Code := Copy(Str, Count + 1, 2); + If Code = '00' Then BufAddStr(Pipe2Ansi(0)) Else + If Code = '01' Then BufAddStr(Pipe2Ansi(1)) Else + If Code = '02' Then BufAddStr(Pipe2Ansi(2)) Else + If Code = '03' Then BufAddStr(Pipe2Ansi(3)) Else + If Code = '04' Then BufAddStr(Pipe2Ansi(4)) Else + If Code = '05' Then BufAddStr(Pipe2Ansi(5)) Else + If Code = '06' Then BufAddStr(Pipe2Ansi(6)) Else + If Code = '07' Then BufAddStr(Pipe2Ansi(7)) Else + If Code = '08' Then BufAddStr(Pipe2Ansi(8)) Else + If Code = '09' Then BufAddStr(Pipe2Ansi(9)) Else + If Code = '10' Then BufAddStr(Pipe2Ansi(10)) Else + If Code = '11' Then BufAddStr(Pipe2Ansi(11)) Else + If Code = '12' Then BufAddStr(Pipe2Ansi(12)) Else + If Code = '13' Then BufAddStr(Pipe2Ansi(13)) Else + If Code = '14' Then BufAddStr(Pipe2Ansi(14)) Else + If Code = '15' Then BufAddStr(Pipe2Ansi(15)) Else + If Code = '16' Then BufAddStr(Pipe2Ansi(16)) Else + If Code = '17' Then BufAddStr(Pipe2Ansi(17)) Else + If Code = '18' Then BufAddStr(Pipe2Ansi(18)) Else + If Code = '19' Then BufAddStr(Pipe2Ansi(19)) Else + If Code = '20' Then BufAddStr(Pipe2Ansi(20)) Else + If Code = '21' Then BufAddStr(Pipe2Ansi(21)) Else + If Code = '22' Then BufAddStr(Pipe2Ansi(22)) Else + If Code = '23' Then BufAddStr(Pipe2Ansi(23)) Else + BufAddStr(Str[Count] + Code); + Inc (Count, 2); + End Else + BufAddChar(Str[Count]); + + Inc (Count); + End; +End; + +Procedure TBBSIO.OutPipeLn (Str : String); +Begin + OutPipe (Str + #13#10); + Inc (PausePtr); +End; + +Procedure TBBSIO.OutRaw (Str: String); +Begin + If FmtString Then Begin + FmtString := False; + Case FmtType of + 1 : Str := strPadR(Str, FmtLen, ' '); + 2 : Str := strPadL(Str, FmtLen, ' '); + 3 : Str := strPadC(Str, FmtLen, ' '); + End; + End; + + BufAddStr(Str); +End; + +Procedure TBBSIO.OutRawLn (Str: String); +Begin + BufAddStr (Str + #13#10); + Inc (PausePtr); +End; + +Function TBBSIO.ParseMCI (Display: Boolean; Code: String) : Boolean; +Var + A : LongInt; +Begin + LastMCIValue := #255; + Result := True; + + If Not AllowMCI Then Begin + Result := False; + Exit; + End; + + Case Code[1] of + '!' : Begin + A := strS2I(Code[2]); + ScreenInfo[A].X := Screen.CursorX; + ScreenInfo[A].Y := Screen.CursorY; + ScreenInfo[A].A := Screen.TextAttr; + End; + '$' : Case Code[2] of + 'C' : Begin + FmtString := True; + FmtType := 3; + End; + 'D' : Begin + FmtString := True; + FmtType := 4; + End; + 'L' : Begin + FmtString := True; + FmtType := 2; + End; + 'R' : Begin + FmtString := True; + FmtType := 1; + End; + End; + '&' : Case Code[2] of + '1' : LastMCIValue := PromptInfo[1]; + '2' : LastMCIValue := PromptInfo[2]; + '3' : LastMCIValue := PromptInfo[3]; + '4' : LastMCIValue := PromptInfo[4]; + '5' : LastMCIValue := PromptInfo[5]; + '6' : LastMCIValue := PromptInfo[6]; + '7' : LastMCIValue := PromptInfo[7]; + '8' : LastMCIValue := PromptInfo[8]; + '9' : LastMCIValue := PromptInfo[9]; + '0' : LastMCIValue := PromptInfo[10]; + 'A' : LastMCIValue := PromptInfo[11]; + 'B' : LastMCIValue := PromptInfo[12]; + 'C' : LastMCIValue := PromptInfo[13]; + 'D' : LastMCIValue := PromptInfo[14]; + 'E' : LastMCIValue := PromptInfo[15]; + End; + '0' : Case Code[2] of + '0' : LastMCIValue := Pipe2Ansi(0); + '1' : LastMCIValue := Pipe2Ansi(1); + '2' : LastMCIValue := Pipe2Ansi(2); + '3' : LastMCIValue := Pipe2Ansi(3); + '4' : LastMCIValue := Pipe2Ansi(4); + '5' : LastMCIValue := Pipe2Ansi(5); + '6' : LastMCIValue := Pipe2Ansi(6); + '7' : LastMCIValue := Pipe2Ansi(7); + '8' : LastMCIValue := Pipe2Ansi(8); + '9' : LastMCIValue := Pipe2Ansi(9); + End; + '1' : Case Code[2] of + '0' : LastMCIValue := Pipe2Ansi(10); + '1' : LastMCIValue := Pipe2Ansi(11); + '2' : LastMCIValue := Pipe2Ansi(12); + '3' : LastMCIValue := Pipe2Ansi(13); + '4' : LastMCIValue := Pipe2Ansi(14); + '5' : LastMCIValue := Pipe2Ansi(15); + '6' : LastMCIValue := Pipe2Ansi(16); + '7' : LastMCIValue := Pipe2Ansi(17); + '8' : LastMCIValue := Pipe2Ansi(18); + '9' : LastMCIValue := Pipe2Ansi(19); + End; + '2' : Case Code[2] of + '0' : LastMCIValue := Pipe2Ansi(20); + '1' : LastMCIValue := Pipe2Ansi(21); + '2' : LastMCIValue := Pipe2Ansi(22); + '3' : LastMCIValue := Pipe2Ansi(23); + End; + 'A' : Case Code[2] of + 'G' : LastMCIValue := strI2S(DaysAgo(TBBSCore(Core).User.ThisUser.Birthday) DIV 365); + 'S' : LastMCIValue := OutON(TBBSCore(Core).User.ThisUser.SigUse); + 'V' : LastMCIValue := OutYN(Chat.Available); + End; + 'B' : Case Code[2] of + 'D' : If TBBSCore(Core).LocalMode Then + LastMCIValue := 'LOCAL' {++lang add these to lang file } + Else + LastMCIValue := 'TELNET'; {++lang } + 'E' : LastMCIValue := ^G; + 'I' : LastMCIValue := DateJulian2Str(TBBSCore(Core).User.ThisUser.Birthday, TBBSCore(Core).User.ThisUser.DateType); + 'N' : LastMCIValue := Config.BBSName; + 'S' : OutBS(1, True); + End; + 'C' : Case Code[2] of + 'L' : AnsiClear; + 'M' : LastMCIValue := OutON(TBBSCore(Core).User.ThisUser.UseFullChat); + 'R' : OutRawLn (''); + 'S' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.Calls); + 'T' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.CallsToday); + End; + 'D' : Case Code[2] of + 'A' : LastMCIValue := DateDos2Str(CurDateDos, TBBSCore(Core).User.ThisUser.DateType); + 'E' : Begin + BufFlush; + WaitMS(500); + End; + 'F' : Begin + FmtString := True; + FmtType := 5; + End; + 'I' : Begin + FmtString := True; + FmtType := 16; + End; + 'K' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.DLk); + 'L' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.DLs); + 'T' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.DLsToday); + End; + 'F' : Case Code[2] of + 'B' : LastMCIValue := TBBSCore(Core).FileBase.FBase.Name; + 'G' : LastMCIValue := TBBSCore(Core).FileBase.FGroup.Name; + 'K' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.ULk); + 'O' : LastMCIValue := DateDos2Str(TBBSCore(Core).User.ThisUser.FirstOn, TBBSCore(Core).User.ThisUser.DateType); + 'U' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.ULs); + End; + 'H' : Case Code[2] of + 'K' : LastMCIValue := OutON(TBBSCore(Core).User.ThisUser.HotKeys); + End; + 'I' : Case Code[2] of + 'F' : UseInField := False; + 'N' : Begin + FmtString := True; + FmtType := 12; + End; + 'L' : LastMCIValue := OutON(Chat.Invisible); + 'S' : Begin + FmtString := True; + FmtType := 14; + End; + End; + 'K' : Case Code[2] of + 'T' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.DLkToday); + End; + 'L' : Case Code[2] of + 'O' : LastMCIValue := DateDos2Str(TBBSCore(Core).User.ThisUser.LastOn, TBBSCore(Core).User.ThisUser.DateType); + End; + 'M' : Case Code[2] of + 'B' : LastMCIValue := TBBSCore(Core).Msgs.MBase.Name; + 'E' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.Emails); + 'G' : LastMCIValue := TBBSCore(Core).Msgs.Group.Name; + 'L' : LastMCIValue := OutON(TBBSCore(Core).User.ThisUser.UseLBIndex); + 'N' : LastMCIValue := Config.NetDesc[TBBSCore(Core).Msgs.MBase.NetAddr]; + 'P' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.Posts); + 'T' : LastMCIValue := strI2S(TBBSCore(Core).Msgs.GetTotalMessages(TBBSCore(Core).Msgs.MBase)); + End; + 'N' : Case Code[2] of + 'D' : LastMCIValue := strI2S(TBBSCore(Core).NodeNum); + 'E' : LastMCIValue := strI2S(TBBSCore(Core).MinutesUntilEvent(TBBSCore(Core).NextEvent.ExecTime)); + End; + 'O' : Case Code[2] of + 'S' : LastMCIValue := OSID; + End; + 'P' : Case Code[2] of + 'A' : PauseScreen; + 'B' : PurgeInputBuffer; + 'C' : Begin + A := 0; + If TBBSCore(Core).User.ThisUser.Calls > 0 Then + A := Round(TBBSCore(Core).User.ThisUser.Posts / TBBSCore(Core).User.ThisUser.Calls * 100); + LastMCIValue := strI2S(A); + End; + 'I' : BufAddChar('|'); + 'N' : Repeat Until GetKey <> ''; + 'O' : AllowPause := False; + 'W' : LastMCIValue := strI2S(Config.PWChange); + End; + 'Q' : Case Code[2] of + 'A' : LastMCIValue := TBBSCore(Core).User.ThisUser.Archive; + 'L' : LastMCIValue := OutYN (TBBSCore(Core).User.ThisUser.QwkFiles); + 'O' : Display_Quote; + End; + 'R' : Case Code[2] of + 'D' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.DLRatio); + 'K' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.DLkRatio); + 'P' : Begin + FmtString := True; + FmtType := 13; + End; + End; + 'S' : Case Code[2] of + 'B' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.MaxTB); + 'C' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.MaxCalls); + 'D' : LastMCIValue := TBBSCore(Core).User.Security.Desc; + 'K' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.MaxDLK); + 'L' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.Security); + 'N' : LastMCIValue := Config.SysopName; + 'P' : Begin + A := Round(TBBSCore(Core).User.Security.PCRatio / 100 * 100); + LastMCIValue := strI2S(A); + End; + 'T' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.Time); + 'X' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.MaxDLs); + End; + 'T' : Case Code[2] of + 'B' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.TimeBank); + 'C' : LastMCIValue := strI2S(Config.SystemCalls); + 'E' : If Graphics = 1 Then LastMCIValue := 'Ansi' Else LastMCIValue := 'Ascii'; //++lang + 'I' : LastMCIValue := TimeDos2Str(CurDateDos, True); + 'L' : LastMCIValue := strI2S(TBBSCore(Core).TimeLeft); + 'O' : LastMCIValue := strI2S(TBBSCore(Core).ElapsedTime); + End; + 'U' : Case Code[2] of + '#' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.PermIdx); + '1' : LastMCIValue := TBBSCore(Core).User.ThisUser.Optional[1]; + '2' : LastMCIValue := TBBSCore(Core).User.ThisUser.Optional[2]; + '3' : LastMCIValue := TBBSCore(Core).User.ThisUser.Optional[3]; + 'A' : LastMCIValue := TBBSCore(Core).User.ThisUser.Address; + 'B' : Case TBBSCore(Core).User.ThisUser.FileList of + 0 : LastMCIValue := 'Normal'; + 1 : LastMCIValue := 'Lightbar'; {++lang} + End; + 'C' : LastMCIValue := TBBSCore(Core).User.ThisUser.City; + 'D' : LastMCIValue := TBBSCore(Core).User.ThisUser.DataPhone; + 'E' : Case TBBSCore(Core).User.ThisUser.EditType of + 0 : LastMCIValue := 'Line'; {++lang} + 1 : LastMCIValue := 'Full'; + 2 : LastMCIValue := 'Ask'; + End; + 'F' : LastMCIValue := DateTypeStr[TBBSCore(Core).User.ThisUser.DateType]; + 'G' : If TBBSCore(Core).User.ThisUser.Gender = 'M' Then + LastMCIValue := 'Male' + Else + LastMCIValue := 'Female'; {++lang} + 'H' : LastMCIValue := TBBSCore(Core).User.ThisUser.Handle; + 'I' : LastMCIValue := TBBSCore(Core).User.ThisUser.UserInfo; + 'J' : Case TBBSCore(Core).User.ThisUser.MReadType of + 0 : LastMCIValue := 'Normal'; + 1 : LastMCIValue := 'Lightbar'; {++lang} + End; + 'K' : LastMCIValue := TBBSCore(Core).User.ThisUser.Email; + 'L' : LastMCIValue := TBBSCore(Core).Lang.Desc; + 'M' : LastMCIValue := OutON(TBBSCore(Core).User.ThisUser.UseLBMIdx); + 'N' : LastMCIValue := TBBSCore(Core).User.ThisUser.RealName; + 'P' : LastMCIValue := TBBSCore(Core).User.ThisUser.HomePhone; + 'Q' : Case TBBSCore(Core).User.ThisUser.UseLBQuote of + False : LastMCIValue := 'Standard'; + True : LastMCIValue := 'Lightbar'; {++langfile++} + End; + 'S' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.ScreenSize); + 'X' : LastMCIValue := TBBSCore(Core).UserHostInfo; + 'Y' : LastMCIValue := TBBSCore(Core).UserIPInfo; + 'Z' : LastMCIValue := TBBSCore(Core).User.ThisUser.ZipCode; + End; + 'V' : Case Code[2] of + 'R' : LastMCIValue := mysVersion; + End; + 'X' : Case Code[2] of + 'D' : If DateValid(Session.User.ThisUser.Expires) Then + LastMCIValue := strI2S(Abs(CurDateJulian - DateStr2Julian(Session.User.ThisUser.Expires))) + Else + LastMCIValue := '0'; + 'S' : LastMCIValue := strI2S(Session.User.ThisUser.ExpiresTo); + 'X' : LastMCIValue := ''; + End; + '[' : Case Code[2] of + 'A' : Begin + FmtString := True; + FmtType := 8; + End; + 'B' : Begin + FmtString := True; + FmtType := 9; + End; + 'C' : Begin + FmtString := True; + FmtType := 10; + End; + 'D' : Begin + FmtString := True; + FmtType := 11; + End; + 'K' : AnsiClrEOL; + 'L' : Begin + FmtString := True; + FmtType := 15; + End; + 'X' : Begin + FmtString := True; + FmtType := 6; + End; + 'Y' : Begin + FmtString := True; + FmtType := 7; + End; + End; + Else + Result := False; + End; + + If Display And (LastMCIValue <> #255) Then + OutPipe(LastMCIValue); +End; + +Procedure TBBSIO.OutFull (Str : String); +Var + A : Byte; + B : Byte; + D : DirStr; + N : NameStr; + E : ExtStr; +Begin + A := 1; + + While A <= Length(Str) Do Begin + If (Str[A] = '|') and (A < Length(Str) - 1) Then Begin + + If Not ParseMCI (True, Copy(Str, A + 1, 2)) Then Begin + BufAddChar(Str[A]); + Inc(A); + Continue; + End; + + Inc (A, 2); + + If FmtString Then Begin + If FmtType = 5 Then Begin + FmtString := False; + + B := A + 1; + + While (Str[B] <> ' ') and (Str[B] <> '|') and (B <= Length(Str)) Do + Inc (B); + + FSplit (strStripLOW(Copy(Str, A + 1, B - A - 1)), D, N, E); + OutFile (TBBSCore(Core).Lang.TextPath + N + E, True, 0); + + A := B; + + Continue; + End; + + FmtLen := strS2I(Copy(Str, A + 1, 2)); + Inc (A, 2); + + Case FmtType of + 4 : Begin + Inc (A); + FmtString := False; + BufAddStr (strRep(Str[A], FmtLen)); + End; + 6 : Begin + AnsiMoveX (FmtLen); + FmtString := False; + End; + 7 : Begin + AnsiMoveY (FmtLen); + FmtString := False; + End; + 8 : Begin + AnsiMoveY (Screen.CursorY - FmtLen); + FmtString := False; + End; + 9 : Begin + AnsiMoveY (Screen.CursorY + FmtLen); + FmtString := False; + End; + 10: Begin + AnsiMoveX (Screen.CursorX + FmtLen); + FmtString := False; + End; + 11: Begin + AnsiMoveX (Screen.CursorX - FmtLen); + FmtString := False; + End; + 12: Begin + UseInLimit := True; + InLimit := FmtLen; + FmtString := False; + End; + 13: Begin + PausePtr := FmtLen; + FmtString := False; + End; + 14: Begin + UseInSize := True; + InSize := FmtLen; + FmtString := False; + End; + 15: Begin + While Screen.CursorX > FmtLen Do + OutBS(1, True); + + FmtString := False; + End; + End; + End; + End Else + BufAddChar (Str[A]); + + Inc(A); + End; +End; + +Procedure TBBSIO.OutFullLn (Str : String); +Begin + OutFull (Str + #13#10); + Inc (PausePtr); +End; + +Procedure TBBSIO.AnsiClrEOL; +Begin + BufAddStr (#27 + '[K'); +End; + +Function TBBSIO.Pipe2Ansi (Color: Byte) : String; +Var + CurFG : Byte; + CurBG : Byte; + Prefix : String[2]; +Begin + Result := ''; + + If Graphics = 0 Then Exit; + + CurBG := (Screen.TextAttr SHR 4) AND 7; + CurFG := Screen.TextAttr AND $F; + Prefix := ''; + + If Color < 16 Then Begin + If Color = CurFG Then Exit; + +// Screen.TextAttr := Color + CurBG * 16; + + If (Color < 8) and (CurFG > 7) Then Prefix := '0;'; + If (Color > 7) and (CurFG < 8) Then Prefix := '1;'; + If Color > 7 Then Dec(Color, 8); + + Case Color of + 00: Result := #27 + '[' + Prefix + '30'; + 01: Result := #27 + '[' + Prefix + '34'; + 02: Result := #27 + '[' + Prefix + '32'; + 03: Result := #27 + '[' + Prefix + '36'; + 04: Result := #27 + '[' + Prefix + '31'; + 05: Result := #27 + '[' + Prefix + '35'; + 06: Result := #27 + '[' + Prefix + '33'; + 07: Result := #27 + '[' + Prefix + '37'; + End; + + If Prefix <> '0;' Then + Result := Result + 'm' + Else + Case CurBG of + 00: Result := Result + ';40m'; + 01: Result := Result + ';44m'; + 02: Result := Result + ';42m'; + 03: Result := Result + ';46m'; + 04: Result := Result + ';41m'; + 05: Result := Result + ';45m'; + 06: Result := Result + ';43m'; + 07: Result := Result + ';47m'; + End; + End Else Begin + If (Color - 16) = CurBG Then Exit; + +// Screen.TextAttr := CurFG + (Color - 16) * 16; + + Case Color of + 16: Result := #27 + '[40m'; + 17: Result := #27 + '[44m'; + 18: Result := #27 + '[42m'; + 19: Result := #27 + '[46m'; + 20: Result := #27 + '[41m'; + 21: Result := #27 + '[45m'; + 22: Result := #27 + '[43m'; + 23: Result := #27 + '[47m'; + End; + End; +End; + +Function TBBSIO.Attr2Ansi (Attr: Byte) : String; +Begin + Result := ''; + + If Graphics = 0 Then Exit; + + Result := Pipe2Ansi(Attr AND $F) + Pipe2Ansi(((Attr SHR 4) AND 7) + 16); +End; + +Procedure TBBSIO.AnsiColor (A : Byte); +Begin + If Graphics = 0 Then Exit; + + BufAddStr(Attr2Ansi(A)); +End; + +Procedure TBBSIO.AnsiGotoXY (X: Byte; Y: Byte); +Begin + If Graphics = 0 Then Exit; + + If X = 0 Then X := Screen.CursorX; + If Y = 0 Then Y := Screen.CursorY; + + BufAddStr (#27'[' + strI2S(Y) + ';' + strI2S(X) + 'H'); +End; + +Procedure TBBSIO.AnsiClear; +Begin + If Graphics > 0 Then + BufAddStr (#27 + '[2J') + Else + BufAddChar (#12); + + PausePtr := 1; +End; + +Function TBBSIO.OutYN (Y: Boolean) : String; +Begin + If Y Then OutYN := 'Yes' Else OutYN := 'No'; {++lang?} +End; + +Function TBBSIO.OutON (O : Boolean) : String; +Begin + If O Then OutON := 'On' Else OutON := 'Off'; {++lang} +End; + +Procedure TBBSIO.OutFile (FName : String; DoPause: Boolean; Speed: Byte); +Var + Buffer : Array[1..4096] of Char; + BufPos : LongInt; + BufSize : LongInt; + dFile : File; + Ext : String[4]; + Code : String[2]; + Old : Boolean; + Str : String; + Ch : Char; + Done : Boolean; + + Function GetChar : Char; + Begin + If BufPos = BufSize Then Begin + BlockRead (dFile, Buffer, SizeOf(Buffer), BufSize); + + BufPos := 0; + + If BufSize = 0 Then Begin + Done := True; + Buffer[1] := #26; + End; + End; + + Inc (BufPos); + + Result := Buffer[BufPos]; + End; + +Begin + If Pos(PathChar, FName) = 0 Then + FName := TBBSCore(Core).Lang.TextPath + FName; + + If Pos('.', FName) > 0 Then + Ext := '' + Else + If (Graphics = 1) and (FileExist(FName + '.ans')) Then + Ext := '.ans' + Else + Ext := '.asc'; + + If FileExist(FName + Copy(Ext, 1, 3) + '1') Then Begin + Repeat + BufPos := Random(9); + If BufPos = 0 Then + Code := Ext[Length(Ext)] + Else + Code := strI2S(BufPos); + Until FileExist(FName + Copy(Ext, 1, 3) + Code); + + Ext := Copy(Ext, 1, 3) + Code; + End; + + Assign (dFile, FName + Ext); + {$I-} Reset(dFile, 1); {$I+} + If IoResult <> 0 Then Begin + NoFile := True; + Exit; + End; + + NoFile := False; + Old := AllowPause; + AllowPause := DoPause; + PausePtr := 1; + Done := False; + BufPos := 0; + BufSize := 0; + Ch := #0; + BaudEmulator := Speed; + + While Not Done Do Begin + Ch := GetChar; + + If BaudEmulator > 0 Then Begin + BufFlush; + + If BufPos MOD BaudEmulator = 0 Then WaitMS(6); + End; + + Case Ch of + #10 : Begin + BufAddChar (#10); + Inc (PausePtr); + + If (PausePtr = TBBSCore(Core).User.ThisUser.ScreenSize) and (AllowPause) Then + Case MorePrompt of + 'N' : Break; + 'C' : AllowPause := False; + End; + End; + #26 : Break; + '|' : Begin + Code := GetChar; + Code := Code + GetChar; + + If Not ParseMCI(True, Code) Then Begin + BufAddStr('|' + Code); + Continue; + End; + + If FmtString Then Begin + If FmtType = 5 Then Begin + FmtString := False; + Str := ''; + + While Not Done Do Begin + Ch := GetChar; + If Ch in [#10, '|'] Then Break; + Str := Str + GetChar; + End; + + OutFile (TBBSCore(Core).Lang.TextPath + strStripLOW(Str), True, 0); + + Continue; + End; + + Code := GetChar; + Code := Code + GetChar; + FmtLen := strS2I(Code); + + Case FmtType of + 4 : Begin + BufAddStr (strRep(GetChar, FmtLen)); + FmtString := False; + End; + 6 : Begin + AnsiMoveX (FmtLen); + FmtString := False; + End; + 7 : Begin + AnsiMoveY (FmtLen); + FmtString := False; + End; + 8 : Begin + AnsiMoveY (Screen.CursorY - FmtLen); + FmtString := False; + End; + 9 : Begin + AnsiMoveY (Screen.CursorY + FmtLen); + FmtString := False; + End; + 10: Begin + AnsiMoveX (Screen.CursorX + FmtLen); + FmtString := False; + End; + 11: Begin + AnsiMoveX (Screen.CursorX - FmtLen); + FmtString := False; + End; + 12: Begin + UseInLimit := True; + InLimit := FmtLen; + FmtString := False; + End; + 13: Begin + PausePtr := FmtLen; + FmtString := True; + End; + 14: Begin + UseInSize := True; + InSize := FmtLen; + FmtString := False; + End; + 15: Begin + While Screen.CursorX > FmtLen Do + OutBS(1, True); + + FmtString := False; + End; + 16: Begin + BaudEmulator := FmtLen; + FmtString := False; + End; + End; + End; + End; + Else + BufAddChar(Ch); + End; + End; + + AllowPause := Old; + Close (dFile); + + BufFlush; +End; + +{$IFDEF UNIX} +Function TBBSIO.InKey : Char; +Begin + Result := #1; + IsArrow := False; + + If Input.KeyWait(1000) Then Begin + Result := Input.ReadKey; + LocalInput := True; + + If Result = #0 Then Begin + Result := Input.ReadKey; + + If (AllowArrow) and (Result in [#71..#73, #75, #77, #79..#83]) Then Begin + IsArrow := True; + Exit; + End; + + Result := #1; + End; + End; +End; +{$ENDIF} + +{$IFDEF WINDOWS} +Function TBBSIO.InKey : Char; +Var + Handles : Array[0..1] of THandle; + InType : Byte; +Begin + Result := #1; + + Handles[0] := Input.ConIn; + + If Not TBBSCore(Core).LocalMode Then Begin + Handles[1] := SocketEvent; + + WSAResetEvent (Handles[1]); + WSAEventSelect (TBBSCore(Core).Client.FSocketHandle, Handles[1], FD_READ OR FD_CLOSE); + + Case WaitForMultipleObjects(2, @Handles, False, 1000) of + WAIT_OBJECT_0 : InType := 1; + WAIT_OBJECT_0 + 1 : InType := 2; + Else + Exit; + End; + End Else + Case WaitForSingleObject (Handles[0], 1000) of + WAIT_OBJECT_0 : InType := 1; + Else + Exit; + End; + + Case InType of + 1 : Begin // LOCAL input event + If Not Input.ProcessQueue Then Exit; + + Result := Input.ReadKey; + LocalInput := True; + IsArrow := False; + + If Result = #0 Then Begin + Result := Input.ReadKey; + + If (AllowArrow) and (Result in [#71..#73, #75, #77, #79..#83]) and (Screen.Active) Then Begin + IsArrow := True; + Exit; + End; + + Process_Sysop_Cmd (Result); + + Result := #1; + End; + + If Not Screen.Active Then Result := #1; + End; + 2 : Begin // SOCKET read event + If TBBSCore(Core).Client.ReadBuf(Result, 1) < 0 Then Begin + TBBSCore(Core).SystemLog ('User dropped carrier'); + Halt(0); + End; + + LocalInput := False; + + If AllowArrow Then Begin + IsArrow := True; + + Case Result of + #03 : Result := #81; { pgdn } + #04 : Result := #77; { right } + #05 : Result := #72; { up } + #18 : Result := #73; { pgup } + #19 : Result := #75; { left } + #24 : Result := #80; { down } + #27 : Begin + If Not TBBSCore(Core).Client.DataWaiting Then WaitMS(25); + If Not TBBSCore(Core).Client.DataWaiting Then WaitMS(25); + If TBBSCore(Core).Client.DataWaiting Then Begin + If TBBSCore(Core).Client.ReadChar = '[' Then + Case TBBSCore(Core).Client.ReadChar of + 'A' : Result := #72; { ansi up } + 'B' : Result := #80; { ansi down } + 'C' : Result := #77; { ansi right } + 'D' : Result := #75; { ansi left } + 'H' : Result := #71; { ansi home } + 'K' : Result := #79; { ansi end } + 'V' : Result := #73; { ansi pageup } + 'U' : Result := #81; { ansi pgdown } + End; + End Else + IsArrow := False; + End; + #127: Result := #83; { delete } + Else + IsArrow := False; + End; + End; + End; + End; +End; +{$ENDIF} + +Function TBBSIO.GetKey : Char; +Var + TimeCount : LongInt; + LastSec : LongInt; +Begin + Result := #1; + + TBBSCore(Core).TimeOut := TimerSeconds; + + BufFlush; + + Repeat + If LastSec <> TimerSeconds Then Begin + + If GetKeyFunc(False) Then Begin + Result := #02; + Exit; + End; + + LastSec := TimerSeconds; + + If InMacro Then + If InMacroPos <= Length(InMacroStr) Then Begin + Result := InMacroStr[InMacroPos]; + Inc (InMacroPos); + Exit; + End Else + InMacro := False; + + If TBBSCore(Core).CheckTimeOut Then + If TimerSeconds - TBBSCore(Core).TimeOut >= Config.Inactivity Then Begin + TBBSCore(Core).SystemLog('Inactivity timeout'); + OutFullLn (TBBSCore(Core).GetPrompt(136)); + Halt(0); + End; + + TimeCount := TBBSCore(Core).TimeLeft; + + If TimeCount <> Session.LastTimeLeft Then Begin + Session.LastTimeLeft := TimeCount; + + {$IFNDEF UNIX} + Update_Status_Line(StatusPtr, ''); + {$ENDIF} + + If TBBSCore(Core).TimerOn Then Begin + If TimeCount = 5 Then Begin + If Not TBBSCore(Core).TimeChecked Then Begin + TBBSCore(Core).TimeChecked := True; + OutFullLn (TBBSCore(Core).GetPrompt(134)); + End; + End Else + If TimeCount < 1 Then Begin + If Not TBBSCore(Core).TimeChecked Then Begin + TBBSCore(Core).TimeChecked := True; + OutFullLn (TBBSCore(Core).GetPrompt(135)); + TBBSCore(Core).SystemLog ('User ran out of time'); + Halt(0); + End; + End Else + TBBSCore(Core).TimeChecked := False; + End; + + If TBBSCore(Core).NextEvent.Active Then + If (TBBSCore(Core).MinutesUntilEvent(TBBSCore(Core).NextEvent.ExecTime) = TBBSCore(Core).NextEvent.Warning) And + (Not TBBSCore(Core).EventWarn) And (TBBSCore(Core).NextEvent.Forced) Then Begin + TBBSCore(Core).EventWarn := True; + OutFullLn (TBBSCore(Core).GetPrompt(133)); + End; + End; + End; + + Result := InKey; + Until Result <> #1; +End; + +Function TBBSIO.GetYNL (Str: String; Yes: Boolean) : Boolean; +Var + Ch : Char; + X : Byte; + Temp : Boolean; +Begin + PurgeInputBuffer; + + OutFull (Str); + + Temp := AllowArrow; + AllowArrow := True; + X := Screen.CursorX; + + Repeat + AnsiMoveX (X); + If Yes Then OutFull (TBBSCore(Core).GetPrompt(316)) Else OutFull (TBBSCore(Core).GetPrompt(317)); + Ch := UpCase(GetKey); + If IsArrow Then Begin + If Ch = #77 Then Yes := False; + If Ch = #75 Then Yes := True; + End Else + If Ch = #13 Then Break Else + If Ch = #32 Then Yes := Not Yes Else + If Ch = 'Y' Then Begin + Yes := True; + AnsiMoveX(X); + OutFull (TBBSCore(Core).GetPrompt(316)); + Break; + End Else + If Ch = 'N' Then Begin + Yes := False; + AnsiMoveX (X); + OutFull (TBBSCore(Core).GetPrompt(317)); + Break; + End; + Until False; + + OutRawLn(''); + + AllowArrow := Temp; + GetYNL := Yes; +End; + +Function TBBSIO.GetYN (Str: String; Yes: Boolean) : Boolean; +Begin + If TBBSCore(Core).Lang.BarYN and (Graphics = 1) Then Begin + GetYN := GetYNL(Str, Yes); + Exit; + End; + + OutFull (Str); + + Case OneKey(#13'YN', False) of + 'Y' : Yes := True; + 'N' : Yes := False; + End; + + OutFullLn (OutYN(Yes)); + + GetYN := Yes; +End; + +Function TBBSIO.GetPW (Str: String; BadStr: String; PW: String) : Boolean; +Var + Loop : Byte; + Temp : String[15]; +Begin + Result := True; + + If PW = '' Then Exit; + + Loop := 0; + + Repeat + OutFull (Str); + Temp := GetInput(15, 15, 16, ''); + If Temp = PW Then + Exit + Else Begin + OutFullLn(BadStr); + Inc (Loop); + + If (TBBSCore(Core).User.ThisUser.Handle <> '') and (Loop = 1) Then + TBBSCore(Core).SystemLog ('User: ' + TBBSCore(Core).User.ThisUser.Handle); + + TBBSCore(Core).SystemLog ('Bad PW: ' + Temp); + End; + Until Loop = Config.PWAttempts; + + Result := False; +End; + +Function TBBSIO.OneKey (Str: String; Echo: Boolean): Char; +Var + Ch : Char; +Begin + PurgeInputBuffer; + + Repeat + Ch := UpCase(GetKey); + Until Pos (Ch, Str) > 0; + + If Echo Then OutRawLn (Ch); + + Result := Ch; +End; + +Function TBBSIO.GetInput (Field, Max, Mode: Byte; Default: String) : String; +(* +{ input modes: } +{ 1 = standard input +{ 2 = upper case } +{ 3 = proper } +{ 4 = usa phone number } +{ 5 = date } +{ 6 = password } +{ 7 = lower cased } +{ 8 = user defined input } +{ 9 = standard input with no CRLF } +*) +Var + FieldCh : Char; + Ch : Char; + S : String; + StrPos : Integer; + xPos : Byte; + Junk : Integer; + CurPos : Integer; + ArrowSave : Boolean; + BackPos : Byte; + BackSaved : String; + + Procedure pWrite (Str : String); + Begin + If (Mode = 6) and (S <> '') Then + BufAddStr (strRep(TBBSCore(Core).Lang.EchoCh, Length(Str))) + Else + BufAddStr (Str); + End; + + Procedure ReDraw; + Begin + AnsiMoveX (xPos); + + pWrite (Copy(S, Junk, Field)); + If UseInField Then AnsiColor(TBBSCore(Core).Lang.FieldCol2); + pWrite (strRep(FieldCh, Field - Length(Copy(S, Junk, Field)))); + If UseInField Then AnsiColor(TBBSCore(Core).Lang.FieldCol1); + + AnsiMoveX (xPos + CurPos - 1); + End; + + Procedure ReDrawPart; + Begin + pWrite (Copy(S, StrPos, Field - CurPos + 1)); + If UseInField Then AnsiColor(TBBSCore(Core).Lang.FieldCol2); + pWrite (strRep(FieldCh, (Field - CurPos + 1) - Length(Copy(S, StrPos, Field - CurPos + 1)))); + If UseInField Then AnsiColor(TBBSCore(Core).Lang.FieldCol1); + + AnsiMoveX (xPos + CurPos - 1); + End; + + Procedure ScrollRight; + Begin + Inc (Junk, Field DIV 2); {scroll size} + If Junk > Length(S) Then Junk := Length(S); + If Junk > Max Then Junk := Max; + CurPos := StrPos - Junk + 1; + ReDraw; + End; + + Procedure ScrollLeft; + Begin + Dec (Junk, Field DIV 2); {scroll size} + If Junk < 1 Then Junk := 1; + CurPos := StrPos - Junk + 1; + ReDraw; + End; + + Procedure Add_Char (Ch : Char); + Begin + If CurPos > Field then ScrollRight; + + Insert (Ch, S, StrPos); + If StrPos < Length(S) Then ReDrawPart; + + Inc (StrPos); + Inc (CurPos); + + pWrite (Ch); + End; + +Begin + If UseInLimit Then Begin + Field := InLimit; + UseInLimit := False; + End; + + If UseInSize Then Begin + UseInSize := False; + If InSize <= Max Then Max := InSize; + End; + + xPos := Screen.CursorX; + FieldCh := ' '; + + If Mode > 10 Then Begin + Dec (Mode, 10); + If UseInField and (Graphics = 1) Then Begin + FieldCh := TBBSCore(Core).Lang.FieldChar; + AnsiColor (TBBSCore(Core).Lang.FieldCol2); + BufAddStr (strRep(FieldCh, Field)); + AnsiColor (TBBSCore(Core).Lang.FieldCol1); + AnsiMoveX (xPos); + End Else + UseInField := False; + End Else + UseInField := False; + + If Mode = 8 Then + Case Config.UserNameFormat of + 0 : Mode := 1; + 1 : Mode := 2; + 2 : Mode := 7; + 3 : Mode := 3; + End; + + ArrowSave := AllowArrow; + AllowArrow := (Mode in [1..3, 7..9]) and (Graphics > 0); + + BackPos := 0; + S := Default; + StrPos := Length(S) + 1; + Junk := StrPos - Field; + If Junk < 1 Then Junk := 1; + CurPos := StrPos - Junk + 1; + pWrite (Copy(S, Junk, Field)); + + PurgeInputBuffer; + + Repeat + Ch := GetKey; + If IsArrow Then Begin + Case Ch of + #71 : If StrPos > 1 Then Begin + StrPos := 1; + Junk := 1; + CurPos := 1; + ReDraw; + End; + #72 : If (BackPos < mysMaxInputHistory) And (BackPos < InputPos) Then Begin + Inc (BackPos); + + If BackPos = 1 Then BackSaved := S; + + S := InputData[BackPos]; + StrPos := Length(S) + 1; + Junk := StrPos - Field; + If Junk < 1 Then Junk := 1; + CurPos := StrPos - Junk + 1; + ReDraw; + End; + #75 : If StrPos > 1 Then Begin + If CurPos = 1 Then ScrollLeft; + Dec (StrPos); + Dec (CurPos); + If CurPos < 1 then CurPos := 1; + AnsiMoveX (Screen.CursorX - 1); + End; + #77 : If StrPos < Length(S) + 1 Then Begin + If (CurPos = Field) and (StrPos < Length(S)) Then ScrollRight; + Inc (CurPos); + Inc (StrPos); + AnsiMoveX (Screen.CursorX + 1); + End; + #79 : Begin + StrPos := Length(S) + 1; + Junk := StrPos - Field; + If Junk < 1 Then Junk := 1; + CurPos := StrPos - Junk + 1; + ReDraw; + End; + #80 : If (BackPos > 0) Then Begin + Dec (BackPos); + + If BackPos = 0 Then + S := BackSaved + Else + S := InputData[BackPos]; + + StrPos := Length(S) + 1; + Junk := StrPos - Field; + If Junk < 1 Then Junk := 1; + CurPos := StrPos - Junk + 1; + ReDraw; + End; + #83 : If (StrPos <= Length(S)) and (Length(S) > 0) Then Begin + Delete(S, StrPos, 1); + ReDrawPart; + End; + End; + End Else + Case Ch of + #02 : ReDraw; + #08 : If StrPos > 1 Then Begin + Dec (StrPos); + Delete (S, StrPos, 1); + If CurPos = 1 Then + ScrollLeft + Else + If StrPos = Length(S) + 1 Then Begin + If UseInField Then AnsiColor(TBBSCore(Core).Lang.FieldCol2); + BufAddStr (#8 + FieldCh + #8); + If UseInField Then AnsiColor(TBBSCore(Core).Lang.FieldCol1); + Dec (CurPos); + End Else Begin + BufAddChar (#8); + Dec (CurPos); + ReDrawPart; + End; + End; + #13 : Break; + ^Y : Begin + S := ''; + StrPos := 1; + Junk := 1; + CurPos := 1; + ReDraw; + End; + #32.. + #254: If Length(S) < Max Then + Case Mode of + 1 : Add_Char (Ch); + 2 : Add_Char (UpCase(Ch)); + 3 : Begin + If (CurPos = 1) or (S[StrPos-1] in [' ', '.']) Then + Ch := UpCase(Ch) + Else + Ch := LoCase(Ch); + Add_Char(Ch); + End; + 4 : If (Ord(Ch) > 47) and (Ord(Ch) < 58) Then + Case StrPos of + 4,8 : Begin + Add_Char ('-'); + Add_Char (Ch); + End; + 3,7 : Begin + Add_Char (Ch); + Add_Char ('-'); + End; + Else + Add_Char(Ch); + End; + 5 : If (Ord(Ch) > 47) and (Ord(Ch) < 58) Then + Case StrPos of + 2,5 : Begin + Add_Char (Ch); + Add_Char ('/'); + End; + 3,6 : Begin + Add_Char ('/'); + Add_Char (Ch); + End; + Else + Add_Char (Ch); + End; + 6 : Add_Char(UpCase(Ch)); + 7 : Add_Char(LoCase(Ch)); + 9 : Add_Char(Ch); + End; + End; + Until False; + + If Mode <> 6 Then Begin + For Junk := 4 DownTo 2 Do + InputData[Junk] := InputData[Junk - 1]; + + InputData[1] := S; + + If InputPos < mysMaxInputHistory Then Inc(InputPos); + End; + + If Mode = 9 Then + OutFull ('|16') + Else + OutFullLn ('|16'); + + Case Mode of + 5 : Case TBBSCore(Core).User.ThisUser.DateType of { Convert to MM/DD/YY } + {DD/MM/YY} + 2 : S := Copy(S, 4, 2) + '/' + Copy(S, 1, 2) + '/' + Copy(S, 7, 2); + {YY/DD/MM} + 3 : S := Copy(S, 7, 2) + '/' + Copy(S, 4, 2) + '/' + Copy(S, 1, 2); + End; + End; + + UseInField := True; + AllowArrow := ArrowSave; + GetInput := S; +End; + +Function TBBSIO.InXY (X, Y, Field, Max, Mode: Byte; Default: String) : String; +Begin + If Graphics = 0 Then + OutFull ('|CR: ') + Else + AnsiGotoXY (X, Y); + + InXY := GetInput (Field, Max, Mode, Default); +End; + +Function TBBSIO.DrawPercent (Bar : PercentRec; Part, Whole : SmallInt; Var Percent : SmallInt) : String; +Var + FillSize : Byte; +Begin + Screen.TextAttr := 0; // kludge to force it to return full ansi codes + + If (Part = 0) or (Whole = 0) or (Part > Whole) Then Begin + FillSize := 0; + Percent := 0; +// FillSize := Bar.BarLen; +// Percent := 100; +// this needs work... + End Else Begin + FillSize := Round(Part / Whole * Bar.BarLen); + Percent := Round(Part / Whole * 100); + End; + + DrawPercent := Attr2Ansi(Bar.HiAttr) + strRep(Bar.HiChar, FillSize) + + Attr2Ansi(Bar.LoAttr) + strRep(Bar.LoChar, Bar.BarLen - FillSize); +End; + +{$IFDEF UNIX} +Procedure TBBSIO.RemoteRestore (Var Image: TConsoleImageRec); +Var + CountX : Byte; + CountY : Byte; +Begin + For CountY := Image.Y1 to Image.Y2 Do Begin + Session.io.AnsiGotoXY (Image.X1, CountY); + + For CountX := Image.X1 to Image.X2 Do Begin + Session.io.AnsiColor(Image.Data[CountY][CountX].Attributes); + Session.io.BufAddChar(Image.Data[CountY][CountX].UnicodeChar); + End; + End; + + Session.io.AnsiColor(Image.CursorA); + Session.io.AnsiGotoXY(Image.CursorX, Image.CursorY); + + Session.io.BufFlush; +End; +{$ELSE} +Procedure TBBSIO.RemoteRestore (Var Image: TConsoleImageRec); +Var + CountX : Byte; + CountY : Byte; + BufPos : Integer; + Buffer : Array[1..SizeOf(TConsoleScreenRec) DIV 2] of Word Absolute Image.Data; + TempChar : Char; +Begin + BufPos := 1; + + For CountY := Image.Y1 to Image.Y2 Do Begin + Session.io.AnsiGotoXY (Image.X1, CountY); + + For CountX := Image.X1 to Image.X2 Do Begin + + Session.io.AnsiColor(Buffer[BufPos+1]); + + TempChar := Char(Buffer[BufPos]); + + If TempChar = #0 Then TempChar := ' '; + + Session.io.BufAddChar(TempChar); + Inc (BufPos, 2); + End; + End; + + Session.io.AnsiColor(Image.CursorA); + Session.io.AnsiGotoXY(Image.CursorX, Image.CursorY); + + Session.io.BufFlush; +End; +{$ENDIF} + +Function TBBSIO.StrMci (Str: String) : String; +Var + Count : Byte; + Code : String[2]; +Begin + Result := ''; + Count := 1; + + While Count <= Length(Str) Do Begin + If (Str[Count] = '|') and (Count < Length(Str) - 1) Then Begin + Code := Copy(Str, Count + 1, 2); + Inc (Count, 2); + Case Code[1] of + '0' : Result := Result + '|' + Code; + '1' : Result := Result + '|' + Code; + '2' : Result := Result + '|' + Code; + Else + If ParseMCI(False, Code) Then + Result := Result + LastMCIValue + Else + Result := Result + '|' + Code; + End; + End Else + Result := Result + Str[Count]; + + Inc(Count); + End; +End; + +Procedure TBBSIO.PurgeInputBuffer; +Begin + While Input.KeyPressed Do Input.ReadKey; + {$IFDEF WINDOWS} + If Not TBBSCore(Core).LocalMode Then TBBSCore(Core).Client.PurgeInputData; + {$ENDIF} +End; + +{$IFDEF WINDOWS} +Procedure TBBSIO.LocalScreenDisable; +Begin + Screen.ClearScreenNoUpdate; + Screen.WriteXYNoUpdate(1, 1, 7, 'Screen disabled. Press ALT-V to view user'); + Screen.Active := False; +End; + +Procedure TBBSIO.LocalScreenEnable; +Begin + Screen.Active := True; + Screen.ShowBuffer; + Update_Status_Line(StatusPtr, ''); +End; +{$ENDIF} + +End. diff --git a/mystic/bbs_msgbase.pas b/mystic/bbs_msgbase.pas new file mode 100644 index 0000000..ac18a10 --- /dev/null +++ b/mystic/bbs_msgbase.pas @@ -0,0 +1,3664 @@ +Unit bbs_MsgBase; + +{$I M_OPS.PAS} + +Interface + +Uses + m_FileIO, + m_DateTime, + bbs_Common, + bbs_General, + bbs_MsgBase_ABS, + bbs_MsgBase_JAM, + bbs_MsgBase_Squish; + +Type + TMsgBase = Class + MBaseFile : File of MBaseRec; + MScanFile : File of MScanRec; + GroupFile : File of RecGroup; + TotalMsgs : Integer; + TotalConf : Integer; + MsgBase : PMsgBaseABS; + MBase : MBaseRec; + MScan : MScanRec; + Group : RecGroup; + MsgText : RecMessageText; + WereMsgs : Boolean; + Reading : Boolean; + + Constructor Create (Var Owner: Pointer); + Destructor Destroy; Override; + + Function OpenCreateBase (Var Msg: PMsgBaseABS; Var Area: MBaseRec) : Boolean; + Procedure AppendMessageText (Var Msg: PMsgBaseABS; Lines: Integer; ReplyID: String); + Procedure AssignMessageData (Var Msg: PMsgBaseABS); + Function GetTotalMessages (Var TempBase: MBaseRec) : LongInt; + Procedure PostTextFile (Data: String; AllowCodes: Boolean); + Function SaveMessage (mArea: MBaseRec; mFrom, mTo, mSubj: String; mAddr: RecEchoMailAddr; mLines: Integer) : Boolean; + Function ListAreas (Compress: Boolean) : Integer; + Procedure ChangeArea (Data: String); + Procedure SetMessageScan; + Procedure GetMessageScan; + Procedure SendMassEmail; + Procedure MessageUpload (Var CurLine: SmallInt); + Procedure ReplyMessage (Email: Boolean; ListMode: Byte; ReplyID: String); + Procedure EditMessage; + Function ReadMessages (Mode : Char; SearchStr: String) : Boolean; + Procedure ToggleNewScan (QWK: Boolean); + Procedure MessageGroupChange (Ops: String; FirstBase, Intro : Boolean); + Procedure PostMessage (Email: Boolean; Data: String); + Procedure CheckEMail; + Procedure MessageNewScan (Data: String); + Procedure GlobalMessageSearch (Mode: Char); + Procedure SetMessagePointers; + Procedure ViewSentEmail; + Procedure DownloadQWK (Data: String); + Procedure UploadREP; + Procedure WriteCONTROLDAT; + Function WriteMSGDAT : LongInt; + Function ResolveOrigin (var mArea: MBaseRec) : String; + End; + +Implementation + +Uses + m_Strings, + bbs_Core, + bbs_User, + bbs_NodeInfo, + bbs_cfg_UserEdit; + +Type + BSingle = Array [0..3] of Byte; + + QwkNdxHdr = Record + MsgPos : BSingle; + Junk : Byte; + End; + + QwkDATHdr = Record {128 bytes} + Status : Char; + MSGNum : Array [1..7] of Char; + Date : Array [1..8] of Char; + Time : Array [1..5] of Char; + UpTO : Array [1..25] of Char; + UpFROM : Array [1..25] of Char; + Subject : Array [1..25] of Char; + PassWord : Array [1..12] of Char; + ReferNum : Array [1..8] of Char; + NumChunk : Array [1..6] of Char; + Active : Char; {225 active, 226 killed} + ConfNum : Word; + Junk : Word; + NetTag : Char; + End; + +Constructor TMsgBase.Create (Var Owner: Pointer); +Begin + Inherited Create; + + MBase.Name := 'None'; + Group.Name := 'None'; + WereMsgs := False; + Reading := False; +End; + +Destructor TMsgBase.Destroy; +Begin + Inherited Destroy; +End; + +Function TMsgBase.OpenCreateBase (Var Msg: PMsgBaseABS; Var Area: MBaseRec) : Boolean; +Begin + Result := False; + + Case Area.BaseType of + 0 : Msg := New(PMsgBaseJAM, Init); + 1 : Msg := New(PMsgBaseSquish, Init); + End; + + Msg^.SetMsgPath (Area.Path + Area.FileName); + Msg^.SetTempFile (Session.TempPath + 'msgbuf.'); + + If Not Msg^.OpenMsgBase Then + If Not Msg^.CreateMsgBase (Area.MaxMsgs, Area.MaxAge) Then Begin + Dispose (Msg, Done); + Exit; + End Else + If Not Msg^.OpenMsgBase Then Begin + Dispose (Msg, Done); + Exit; + End; + + Result := True; +End; + +Function TMsgBase.GetTotalMessages (Var TempBase: MBaseRec) : LongInt; +Var + TempMsg : PMsgBaseABS; +Begin + Result := 0; + + If TempBase.Name = 'None' Then Exit; + + If OpenCreateBase(TempMsg, TempBase) Then Begin + Result := TempMsg^.NumberOfMsgs; + TempMsg^.CloseMsgBase; + Dispose (TempMsg, Done); + End; +End; + +Procedure TMsgBase.SetMessageScan; +Var + Count : Integer; + Temp : MScanRec; +Begin + Temp.NewScan := MBase.DefNScan; + Temp.QwkScan := MBase.DefQScan; + + Assign (MScanFile, MBase.Path + MBase.FileName + '.scn'); + {$I-} Reset (MScanFile); {$I+} + If IoResult <> 0 Then ReWrite (MScanFile); + + If FileSize(MScanFile) < Session.User.UserNum - 1 Then Begin + Seek (MScanFile, FileSize(MScanFile)); + For Count := FileSize(MScanFile) to Session.User.UserNum - 1 Do + Write (MScanFile, Temp); + End; + + Seek (MScanFile, Session.User.UserNum - 1); + Write (MScanFile, MScan); + Close (MScanFile); +End; + +Procedure TMsgBase.GetMessageScan; +Begin + MScan.NewScan := MBase.DefNScan; + MScan.QwkScan := MBase.DefQScan; + + Assign (MScanFile, MBase.Path + MBase.FileName + '.scn'); + {$I-} Reset (MScanFile); {$I+} + If IoResult <> 0 Then Exit; + + If FileSize(MScanFile) >= Session.User.UserNum Then Begin {filesize and usernum are } + Seek (MScanFile, Session.User.UserNum - 1); {not zero based } + Read (MScanFile, MScan); + + { added security measure for forced reading bases } + + If MBase.DefNScan = 2 Then MScan.NewScan := 2; + If MBase.DefQScan = 2 Then MScan.QwkScan := 2; + End; + + Close (MScanFile); +End; + +Procedure TMsgBase.AppendMessageText (Var Msg: PMsgBaseABS; Lines: Integer; ReplyID: String); +Var + DF : File; + S : String; + A : SmallInt; +Begin + If MBase.NetType > 0 Then Begin + Msg^.DoStringLn (#1 + 'MSGID: ' + strAddr2Str(Config.NetAddress[MBase.NetAddr]) + ' ' + strI2H(CurDateDos)); + + If ReplyID <> '' Then + Msg^.DoStringLn (#1 + 'REPLY: ' + ReplyID); + End; + + For A := 1 to Lines Do + Msg^.DoStringLn(MsgText[A]); + + If Session.User.ThisUser.SigUse and (Session.User.ThisUser.SigLength > 0) Then Begin + + Assign (DF, Config.DataPath + 'autosig.dat'); + Reset (DF, 1); + Seek (DF, Session.User.ThisUser.SigOffset); + + Msg^.DoStringLn(''); + + For A := 1 to Session.User.ThisUser.SigLength Do Begin + BlockRead (DF, S[0], 1); + BlockRead (DF, S[1], Ord(S[0])); + Msg^.DoStringLn(S); + End; + + Close (DF); + End; + + If MBase.NetType > 0 Then Begin + Msg^.DoStringLn (#13 + '--- ' + mysSoftwareID + ' BBS v' + mysVersion + ' (' + OSID + ')'); + Msg^.DoStringLn (' * Origin: ' + ResolveOrigin(MBase) + ' (' + strAddr2Str(Config.NetAddress[MBase.NetAddr]) + ')'); + End; +End; + +Procedure TMsgBase.AssignMessageData (Var Msg: PMsgBaseABS); +Var + Addr : RecEchoMailAddr; + SemFile : Text; +Begin + Msg^.StartNewMsg; + + If MBase.UseReal Then + Msg^.SetFrom(Session.User.ThisUser.RealName) + Else + Msg^.SetFrom(Session.User.ThisUser.Handle); + + Msg^.SetLocal (True); + + If MBase.NetType > 0 Then Begin + If MBase.NetType = 3 Then + Msg^.SetMailType(mmtNetMail) + Else + Msg^.SetMailType(mmtEchoMail); + + Addr := Config.NetAddress[MBase.NetAddr]; + + Msg^.SetOrig(Addr); + + Case MBase.NetType of + 1 : Begin + Assign (SemFile, Config.SemaPath + 'echomail.now'); + If Session.ExitLevel > 5 Then Session.ExitLevel := 7 Else Session.ExitLevel := 5; + End; + 2 : Begin + Assign (SemFile, Config.SemaPath + 'netmail.now'); + If Session.ExitLevel = 5 Then Session.ExitLevel := 7 Else Session.ExitLevel := 6; + End; + 3 : Begin + Assign (SemFile, Config.SemaPath + 'newsmail.now'); + If Session.ExitLevel > 5 Then Session.ExitLevel := 7 Else Session.ExitLevel := 5; + End; + End; + + ReWrite (SemFile); + Close (SemFile); + + End Else + Msg^.SetMailType(mmtNormal); + + Msg^.SetPriv(MBase.PostType = 1); + Msg^.SetDate(DateDos2Str(CurDateDos, 1)); + Msg^.SetTime(TimeDos2Str(CurDateDos, False)); +End; + +Procedure TMsgBase.ChangeArea (Data: String); +Var + A, + Total : Word; + Old : MBaseRec; + Str : String[5]; + Compress : Boolean; + + Function CheckPassword : Boolean; + Begin + CheckPassword := True; + + If MBase.Password <> '' Then + If Not Session.io.GetPW(Session.GetPrompt(103), Session.GetPrompt(417), MBase.Password) Then Begin + Session.io.OutFullLn (Session.GetPrompt(67)); + MBase := Old; + Close (MBaseFile); + CheckPassword := False; + Exit; + End; + End; + +Begin + Compress := Config.MCompress; + Old := MBase; + + If (Data = '+') or (Data = '-') Then Begin + Reset (MBaseFile); + + A := Session.User.ThisUser.LastMBase - 1; + + Repeat + Case Data[1] of + '+' : Inc(A); + '-' : Dec(A); + End; + + {$I-} + Seek (MBaseFile, A); + Read (MBaseFile, MBase); + {$I+} + + If IoResult <> 0 Then Break; + + If Session.User.Access(MBase.ACS) Then Begin + If Not CheckPassword Then Break; + Session.User.ThisUser.LastMBase := FilePos(MBaseFile); + Close (MBaseFile); + Exit; + End; + Until False; + + Close (MBaseFile); + MBase := Old; + Exit; + End; + + A := strS2I(Data); + + If A > 0 Then Begin + Inc (A); + Reset (MBaseFile); + If A <= FileSize(MBaseFile) Then Begin + Seek (MBaseFile, A-1); + Read (MBaseFile, MBase); + If Session.User.Access(MBase.ACS) Then Begin + If Not CheckPassword Then Exit; + Session.User.ThisUser.LastMBase := FilePos(MBaseFile) + End Else + MBase := Old; + End; + Close (MBaseFile); + Exit; + End; + + If Pos('NOLIST', strUpper(Data)) > 0 Then Begin + Reset (MBaseFile); + Total := FileSize(MBaseFile); + Close (MBaseFile); + End Else + Total := ListAreas(Compress); + + If Total = 0 Then Begin + Session.io.OutFullLn (Session.GetPrompt(94)); + MBase := Old; + End Else Begin + Repeat + Session.io.OutFull (Session.GetPrompt(102)); + + Str := Session.io.GetInput(5, 5, 12, ''); + + If Str = '?' Then Begin + Compress := Config.MCompress; + Total := ListAreas(Compress); + End Else + Break; + Until False; + + A := strS2I(Str); + + If (A > 0) and (A <= Total) Then Begin + Reset (MBaseFile); + If Not Compress Then Begin + Seek (MBaseFile, A - 1); + Read (MBaseFile, MBase); + If Not Session.User.Access(MBase.ACS) Then Begin + MBase := Old; + Close (MBaseFile); + Exit; + End; + End Else Begin + Total := 0; + + While Not Eof(MBaseFile) And (A <> Total) Do Begin + Read (MBaseFile, MBase); + If Session.User.Access(MBase.ACS) Then Inc(Total); + End; + + If A <> Total Then Begin + Close (MBaseFile); + MBase := OLD; + Exit; + End; + End; + + If Not CheckPassword Then Exit; + + Session.User.ThisUser.LastMBase := FilePos(MBaseFile); + + Close (MBaseFile); + End Else + MBase := Old; + End; +End; + +Procedure TMsgBase.ToggleNewScan (QWK: Boolean); +Var + Total: LongInt; + + Procedure List_Bases; + Begin + Session.io.PausePtr := 1; + Session.io.AllowPause := True; + + If QWK Then + Session.io.OutFullLn (Session.GetPrompt(90)) + Else + Session.io.OutFullLn (Session.GetPrompt(91)); + + Session.io.OutFullLn (Session.GetPrompt(92)); + + Total := 0; + Reset (MBaseFile); + While Not Eof(MBaseFile) Do Begin + Read (MBaseFile, MBase); + If Session.User.Access(MBase.ACS) Then Begin + Inc (Total); + + Session.io.PromptInfo[1] := strI2S(Total); + Session.io.PromptInfo[2] := MBase.Name; + + GetMessageScan; + + If ((MScan.NewScan > 0) And Not QWK) or ((MScan.QwkScan > 0) And QWK) Then + Session.io.PromptInfo[3] := 'Yes' + Else + Session.io.PromptInfo[3] := 'No'; + + Session.io.OutFull (Session.GetPrompt(93)); + + If (Total MOD 2 = 0) And (Total > 0) Then Session.io.OutRawLn(''); + End; + + If EOF(MBaseFile) and (Total MOD 2 <> 0) Then Session.io.OutRawLn(''); + + If (Session.io.PausePtr = Session.User.ThisUser.ScreenSize) and (Session.io.AllowPause) Then + Case Session.io.MorePrompt of + 'N' : Break; + 'C' : Session.io.AllowPause := False; + End; + End; + + Session.io.OutFull (Session.GetPrompt(430)); + End; + + Procedure ToggleBase (A : Word); + Var + B : Word; + Begin + B := 0; + Reset (MBaseFile); + Repeat + Read (MBaseFile, MBase); + If Session.User.Access(MBase.ACS) Then Inc(B); + If A = B Then Break; + Until False; + + GetMessageScan; + + Session.io.PromptInfo[1] := MBase.Name; + + If QWK Then Begin + Case MScan.QwkScan of + 0 : Begin + MScan.QwkScan := 1; + Session.io.OutFullLn (Session.GetPrompt(97)); + End; + 1 : Begin + MScan.QwkScan := 0; + Session.io.OutFullLn (Session.GetPrompt(96)); + End; + 2 : Session.io.OutFullLn (Session.GetPrompt(302)); + End; + End Else Begin + Case MScan.NewScan of + 0 : Begin + MScan.NewScan := 1; + Session.io.OutFullLn (Session.GetPrompt(99)); + End; + 1 : Begin + MScan.NewScan := 0; + Session.io.OutFullLn (Session.GetPrompt(98)); + End; + 2 : Session.io.OutFullLn (Session.GetPrompt(302)); + End; + End; + + SetMessageScan; + End; + +Var + Old : MBaseRec; + Temp : String[11]; + A : Word; + N1 : Word; + N2 : Word; +Begin + Old := MBase; + + List_Bases; + + If Total = 0 Then Begin + Session.io.OutFullLn (Session.GetPrompt(94)); + MBase := Old; + Exit; + End; + + Repeat + Session.io.OutFull (Session.GetPrompt(95)); + Temp := Session.io.GetInput(11, 11, 12, ''); + If (Temp = '') or (Temp = 'Q') Then Break; + If Temp = '?' Then + List_Bases + Else Begin + If Pos('-', Temp) > 0 Then Begin + N1 := strS2I(Copy(Temp, 1, Pos('-', Temp) - 1)); + N2 := strS2I(Copy(Temp, Pos('-', Temp) + 1, Length(Temp))); + End Else Begin + N1 := strS2I(Temp); + N2 := N1; + End; + + For A := N1 to N2 Do + If (A > 0) and (A <= Total) Then ToggleBase(A); + End; + Until False; + + Close (MBaseFile); + MBase := Old; +End; + +Procedure TMsgBase.MessageGroupChange (Ops : String; FirstBase, Intro : Boolean); +Var + A : Word; + Total : Word; + tGroup : RecGroup; + tMBase : MBaseRec; + tLast : Word; + Areas : Word; + Data : Word; +Begin + tGroup := Group; + + If (Ops = '+') or (Ops = '-') Then Begin + Reset (GroupFile); + + A := Session.User.ThisUser.LastMGroup - 1; + + Repeat + Case Ops[1] of + '+' : Inc(A); + '-' : Dec(A); + End; + + {$I-} + Seek (GroupFile, A); + Read (GroupFile, Group); + {$I+} + + If IoResult <> 0 Then Break; + + If Session.User.Access(Group.ACS) Then Begin + Session.User.ThisUser.LastMGroup := FilePos(GroupFile); + Close (GroupFile); + + If Intro Then Session.io.OutFile ('group' + strI2S(Session.User.ThisUser.LastMGroup), True, 0); + + If FirstBase Then Begin + Session.User.ThisUser.LastMBase := 0; + ChangeArea('+'); + End; + + Exit; + End; + Until False; + + Close (GroupFile); + + Group := tGroup; + Exit; + End; + + Data := strS2I(Ops); + + Reset (GroupFile); + + If Data > 0 Then Begin + If Data > FileSize(GroupFile) Then Begin + Close (GroupFile); + Exit; + End; + + Seek (GroupFile, Data-1); + Read (GroupFile, Group); + + If Session.User.Access(Group.ACS) Then Begin + Session.User.ThisUser.LastMGroup := FilePos(GroupFile); + If Intro Then Session.io.OutFile ('group' + strI2S(Data), True, 0); + End Else + Group := tGroup; + + Close (GroupFile); + + If FirstBase Then Begin + Session.User.ThisUser.LastMBase := 1; + ChangeArea('+'); + End; + + Exit; + End; + + Session.io.PausePtr := 1; + Session.io.AllowPause := True; + + Session.io.OutFullLn (Session.GetPrompt(174)); { was after reset(groupfile) } + + tLast := Session.User.ThisUser.LastMGroup; + Total := 0; + + While Not Eof(GroupFile) Do Begin + Read (GroupFile, Group); + + If Not Group.Hidden And Session.User.Access(Group.ACS) Then Begin + + Areas := 0; + Session.User.ThisUser.LastMGroup := FilePos(GroupFile); + + If Config.MShowBases Then Begin + Reset (MBaseFile); + Read (MBaseFile, tMBase); { Skip EMAIL base } + While Not Eof(MBaseFile) Do Begin + Read (MBaseFile, tMBase); + If Session.User.Access(tMBase.ACS) Then Inc(Areas); + End; + Close (MBaseFile); + End; + + Inc (Total); + + Session.io.PromptInfo[1] := strI2S(Total); + Session.io.PromptInfo[2] := Group.Name; + Session.io.PromptInfo[3] := strI2S(Areas); + + Session.io.OutFullLn (Session.GetPrompt(175)); + + If (Session.io.PausePtr = Session.User.ThisUser.ScreenSize) and (Session.io.AllowPause) Then + Case Session.io.MorePrompt of + 'N' : Break; + 'C' : Session.io.AllowPause := False; + End; + End; + End; + + Session.User.ThisUser.LastMGroup := tLast; + + If Total = 0 Then + Session.io.OutFullLn (Session.GetPrompt(176)) + Else Begin + Session.io.OutFull (Session.GetPrompt(177)); + + A := strS2I(Session.io.GetInput(5, 5, 11, '')); + + If (A > 0) and (A <= Total) Then Begin + Total := 0; + + Reset (GroupFile); + Repeat + Read (GroupFile, Group); + If Not Group.Hidden And Session.User.Access(Group.ACS) Then Inc(Total); + If A = Total Then Break; + Until False; + + Session.User.ThisUser.LastMGroup := FilePos(GroupFile); + + If Intro Then Session.io.OutFile ('group' + strI2S(Session.User.ThisUser.LastMGroup), True, 0); + + Session.User.ThisUser.LastMBase := 1; + ChangeArea('+'); + + End Else + Group := tGroup; + End; + + Close (GroupFile); +End; + +Function TMsgBase.ListAreas (Compress: Boolean) : Integer; +Var + Total : Word = 0; + Listed : Word = 0; + TempBase : MBaseRec; +Begin + Reset (MBaseFile); + + Session.io.PausePtr := 1; + Session.io.AllowPause := True; + + While Not Eof(MBaseFile) Do Begin + Read (MBaseFile, TempBase); + + If Session.User.Access(TempBase.ACS) Then Begin + Inc (Listed); + + If Listed = 1 Then + Session.io.OutFullLn(Session.GetPrompt(100)); + + If Compress Then + Inc (Total) + Else + Total := FilePos(MBaseFile); + + Session.io.PromptInfo[1] := strI2S(Total); + Session.io.PromptInfo[2] := TempBase.Name; + Session.io.PromptInfo[3] := strI2S(GetTotalMessages(TempBase)); + + Session.io.OutFull (Session.GetPrompt(101)); + + If (Listed MOD Config.MColumns = 0) and (Listed > 0) Then Session.io.OutRawLn(''); + End; + + If Eof(MBaseFile) and (Listed MOD Config.MColumns <> 0) Then Session.io.OutRawLn(''); + + If (Session.io.PausePtr = Session.User.ThisUser.ScreenSize) and (Session.io.AllowPause) Then + Case Session.io.MorePrompt of + 'N' : Begin + Total := FileSize(MBaseFile); + Break; + End; + 'C' : Session.io.AllowPause := False; + End; + End; + + Close (MBaseFile); + + Result := Total; +End; + +Procedure TMsgBase.ReplyMessage (Email: Boolean; ListMode : Byte; ReplyID : String); +Var + ToWho : String[30]; {to field} + Subj : String[60]; {subject field} + Addr : RecEchomailAddr; {netmail to addr} + MsgNew : PMsgBaseABS; + Temp1 : String; {quote text} + Temp2 : String[2]; {Initials} + Temp3 : String[80]; {Text} + tFile : Text; + Lines : SmallInt; +Begin + If Not Session.User.Access(MBase.PostACS) Then Begin + Session.io.OutFullLn (Session.GetPrompt(105)); + Exit; + End; + + Set_Node_Action (Session.GetPrompt(349)); + + If ListMode = 0 Then + Session.io.OutFull (Session.GetPrompt(407)) + Else + Session.io.OutFull (Session.GetPrompt(408)); + + Repeat + ToWho := Session.io.GetInput(30, 30, 18, MsgBase^.GetFrom); + + If ToWho = '' Then Exit; + + If Not Email Then Break; + + If Not Session.User.FindUser(ToWho, False) Then Begin + Session.io.PromptInfo[1] := ToWho; + + Session.io.OutFullLn (Session.GetPrompt(161)); + + ToWho := MsgBase^.GetFrom; + End Else + Break; + Until False; + + If MBase.NetType = 3 Then Begin + Session.io.OutFull (Session.GetPrompt(342)); + + MsgBase^.GetOrig(Addr); + + Temp3 := Session.io.GetInput(20, 20, 12, strAddr2Str(Addr)); + + If Not strStr2Addr (Temp3, Addr) Then Exit; + End; + + Subj := MsgBase^.GetSubj; + + If Pos ('Re:', Subj) = 0 Then Subj := 'Re: ' + Subj; + + Session.io.OutFull (Session.GetPrompt(451)); + + Subj := Session.io.GetInput (60, 60, 11, Subj); + + If Subj = '' Then Exit; + + Assign (tFile, Session.TempPath + 'msgtmp'); + {$I-} ReWrite (tFile); {$I+} + If IoResult = 0 Then Begin + Temp3 := MsgBase^.GetFrom; + Temp2 := Temp3[1]; + + If Pos(' ', Temp3) > 0 Then + Temp2 := Temp2 + Temp3[Succ(Pos(' ', Temp3))]; + + Temp1 := Session.GetPrompt(464); + + Temp1 := strReplace(Temp1, '|&1', MsgBase^.GetDate); + Temp1 := strReplace(Temp1, '|&2', MsgBase^.GetFrom); + Temp1 := strReplace(Temp1, '|&3', Temp2); + + WriteLn (tFile, Temp1); + WriteLn (tFile, ' '); + + Lines := 0; + + MsgBase^.MsgTxtStartUp; + + While Not MsgBase^.EOM and (Lines < mysMaxMsgLines - 2) Do Begin + Inc (Lines); + + Temp3 := MsgBase^.GetString(79); + + If Temp3[1] <> #1 Then + WriteLn (tFile, Temp2 + '> ' + Copy(Temp3, 1, 74)); + End; + + Close (tFile); + End; + + Lines := 0; + + Session.io.PromptInfo[1] := ToWho; + Session.io.PromptInfo[2] := Subj; + + If Editor(Lines, 78, mysMaxMsgLines, False, False, Subj) Then Begin + + Session.io.OutFull (Session.GetPrompt(107)); + + Case MBase.BaseType of + 0 : MsgNew := New(PMsgBaseJAM, Init); + 1 : MsgNew := New(PMsgBaseSquish, Init); + End; + + MsgNew^.SetMsgPath (MBase.Path + MBase.FileName); + + If Not MsgNew^.OpenMsgBase Then Begin + Dispose (MsgNew, Done); + Exit; + End; + + AssignMessageData(MsgNew); + + Case MBase.NetType of + 2 : MsgNew^.SetTo('All'); + 3 : Begin + MsgNew^.SetDest (Addr); + MsgNew^.SetCrash (Config.netCrash); + MsgNew^.SetHold (Config.netHold); + MsgNew^.SetKillSent (Config.netKillSent); + MsgNew^.SetTo (ToWho); + + Addr := Config.NetAddress[MBase.NetAddr]; + MsgNew^.SetOrig (Addr); + End; + Else + MsgNew^.SetTo(ToWho); + End; + + MsgNew^.SetSubj(Subj); + MsgNew^.SetRefer(MsgBase^.GetMsgNum); + + AppendMessageText (MsgNew, Lines, ReplyID); + + MsgNew^.WriteMsg; + MsgNew^.CloseMsgBase; + + If MsgBase^.GetSeeAlso = 0 Then Begin + MsgBase^.MsgStartUp; + MsgBase^.SetSeeAlso(MsgNew^.GetMsgNum); + MsgBase^.ReWriteHdr; + End; + + If Email Then Begin + Session.SystemLog ('Sent Email to ' + MsgNew^.GetTo); + + Inc (Session.User.ThisUser.Emails); + Inc (Session.HistoryEmails); + End Else Begin + Session.SystemLog ('Posted #' + strI2S(MsgNew^.GetMsgNum) + ': "' + Subj + '" to ' + strStripMCI(MBase.Name)); + + Inc (Session.User.ThisUser.Posts); + Inc (Session.HistoryPosts); + End; + + Dispose (MsgNew, Done); + + Session.io.OutFullLn (Session.GetPrompt(122)); + End Else + Session.io.OutFullLn (Session.GetPrompt(109)); + + FileErase(Session.TempPath + 'msgtmp'); +End; + +Procedure TMsgBase.EditMessage; +Var + A : Integer; + Lines : Integer; + Temp1 : String; + DestAddr : RecEchoMailAddr; + + Procedure ReadText; + Begin + MsgBase^.MsgTxtStartUp; + Lines := 0; + While Not MsgBase^.EOM and (Lines < mysMaxMsgLines) Do Begin + Inc (Lines); + MsgText[Lines] := MsgBase^.GetString(79); + End; + + If Lines < mysMaxMsgLines Then Begin + Inc (Lines); + MsgText[Lines] := ''; + End; + End; + +Begin + ReadText; + + Repeat + Session.io.PromptInfo[1] := MsgBase^.GetTo; + Session.io.PromptInfo[2] := MsgBase^.GetSubj; + + If MBase.NetType = 3 Then Begin + MsgBase^.GetDest(DestAddr); + Session.io.PromptInfo[1] := Session.io.PromptInfo[1] + ' (' + strAddr2Str(DestAddr) + ')'; + End; + + Session.io.OutFull (Session.GetPrompt(296)); + + Case Session.io.OneKey('ABQ!', True) of + 'A' : Begin + Session.io.OutFull (Session.GetPrompt(297)); + If MBase.NetType = 3 Then Begin + Temp1 := Session.io.GetInput(30, 30, 11, MsgBase^.GetTo); + Session.io.OutFull (Session.GetPrompt(298)); + If strStr2Addr(Session.io.GetInput(20, 20, 12, strAddr2Str(DestAddr)), DestAddr) Then Begin + MsgBase^.SetTo(Temp1); + MsgBase^.SetDest(DestAddr) + End; + End Else + If MBase.PostType = 1 Then Begin + Temp1 := Session.io.GetInput (30, 30, 11, MsgBase^.GetTo); + If Session.User.SearchUser(Temp1, MBase.UseReal) Then + MsgBase^.SetTo(Temp1); + End Else + MsgBase^.SetTo(Session.io.GetInput(30, 30, 11, MsgBase^.GetTo)); + End; + 'B' : Begin + Session.io.OutFull (Session.GetPrompt(299)); + MsgBase^.SetSubj(Session.io.GetInput(50, 50, 11, MsgBase^.GetSubj)); + End; + '!' : Begin + Temp1 := MsgBase^.GetSubj; + If Editor(Lines, 78, mysMaxMsgLines, False, False, Temp1) Then + MsgBase^.SetSubj(Temp1) + Else + ReadText; + End; + 'Q' : Begin + If Session.io.GetYN(Session.GetPrompt(300), False) Then Begin + MsgBase^.EditMsgInit; + + For A := 1 to Lines Do + MsgBase^.DoStringLn(MsgText[A]); + + MsgBase^.EditMsgSave; + End; + Break; + End; + + End; + Until False; +End; + +Procedure TMsgBase.MessageUpload (Var CurLine: SmallInt); +Var + FN : String[100]; {was string} + TF : Text; + T1 : String[30]; { Saved TO: } + T2 : String[60]; { Saved SUBJ: } + OK : Boolean; +Begin + OK := False; + + T1 := Session.io.PromptInfo[1]; + T2 := Session.io.PromptInfo[2]; + + Session.io.OutFull (Session.GetPrompt(352)); + + If Session.LocalMode Then Begin + FN := Session.io.GetInput(70, 70, 11, ''); + + If FN = '' Then Exit; + + OK := FileExist(FN); + End Else Begin + FN := Session.TempPath + Session.io.GetInput(70, 70, 11, ''); + + If Session.FileBase.SelectProtocol(False) = 'Q' Then Exit; + + Session.FileBase.ExecuteProtocol(False, FN); + + OK := Session.FileBase.dszSearch(JustFile(FN)); + End; + + If OK Then Begin + Assign (TF, FN); + Reset (TF); + While Not Eof(TF) and (CurLine < mysMaxMsgLines) Do Begin + ReadLn (TF, MsgText[CurLine]); + Inc (CurLine); + End; + Close (TF); + End; + + If Not Session.LocalMode Then FileErase(FN); + + CleanDirectory(Session.TempPath, 'msgtmp'); + + Session.io.PromptInfo[1] := T1; + Session.io.PromptInfo[2] := T2; +End; + +Function TMsgBase.ReadMessages (Mode : Char; SearchStr : String) : Boolean; +Var + ReadRes : Boolean; + ScanMode : Byte; + ValidKeys : String; + HelpFile : String[8]; + LastRead : LongInt; + ListMode : Byte; + ReplyID : String[31]; + + Procedure Set_Message_Security; + Begin + If Mode = 'E' Then Begin + ValidKeys := 'ADJLNPQRX?'#13; + HelpFile := 'emailhlp'; + End Else + If Session.User.Access(MBase.SysopACS) or Session.User.IsThisUser(MsgBase^.GetFrom) Then Begin + ValidKeys := 'ADEGHIJLMNPQRTX[]?'#13; + HelpFile := 'readshlp'; + End Else Begin + ValidKeys := 'AGHIJLNPQRTX[]?'#13; + HelpFile := 'readhlp'; + End; + End; + + Function Move_Message : Boolean; + Var + MsgNew : PMsgBaseABS; + Str : String; + TempBase : MBaseRec; + Area : Integer; + Addr : RecEchoMailAddr; + Begin + Result := False; + Session.User.IgnoreGroup := True; + + Repeat + Session.io.OutFull (Session.GetPrompt(282)); + + Str := Session.io.GetInput(4, 4, 12, ''); + + If Str = '?' Then + ListAreas(False) + Else Begin + Reset (MBaseFile); + + Area := strS2I(Str) - 1; + + If (Area > 0) and (Area < FileSize(MBaseFile) - 1) Then Begin + Seek (MBaseFile, Area); + Read (MBaseFile, TempBase); + Close (MBaseFile); + + If Not Session.User.Access(TempBase.PostACS) Then Begin + Session.io.OutFullLn (Session.GetPrompt(105)); + Break; + End; + + Session.io.PromptInfo[1] := TempBase.Name; + + Session.io.OutFullLn (Session.GetPrompt(318)); + + If Not OpenCreateBase(MsgNew, TempBase) Then Break; + + MsgNew^.StartNewMsg; + MsgNew^.SetFrom (MsgBase^.GetFrom); + MsgNew^.SetLocal (True); + + Case TempBase.NetType of + 0 : MsgNew^.SetMailType(mmtNormal); + 3 : MsgNew^.SetMailType(mmtNetMail); + Else + MsgNew^.SetMailType(mmtEchoMail); + End; + + MsgBase^.GetOrig(Addr); + MsgNew^.SetOrig(Addr); + MsgNew^.SetPriv(MsgBase^.IsPriv); + MsgNew^.SetDate(MsgBase^.GetDate); + MsgNew^.SetTime(MsgBase^.GetTime); + MsgNew^.SetTo(MsgBase^.GetTo); + MsgNew^.SetSubj(MsgBase^.GetSubj); + + MsgBase^.MsgTxtStartUp; + + While Not MsgBase^.EOM Do Begin + Str := MsgBase^.GetString(79); + MsgNew^.DoStringLn(Str); + End; + + If MsgNew^.WriteMsg <> 0 Then; + + MsgNew^.CloseMsgBase; + + Session.SystemLog('Moved msg to ' + strStripMCI(TempBase.Name)); + + Dispose (MsgNew, Done); + + MsgBase^.DeleteMsg; + + Move_Message := True; + Break; + End Else Begin + Close (MBaseFile); + Break; + End; + End; + Until False; + + Session.User.IgnoreGroup := False; + End; + + Procedure Export_Message; + Var + FN : String; + Temp : String; + TF : Text; + Begin + If Session.LocalMode Then Begin + If ListMode = 0 Then + Session.io.OutFull (Session.GetPrompt(363)) + Else + Session.io.OutFull (Session.GetPrompt(415)); + + FN := Session.io.GetInput(70, 70, 11, ''); + End Else Begin + If ListMode = 0 Then + Session.io.OutFull (Session.GetPrompt(326)) + Else + Session.io.OutFull (Session.GetPrompt(414)); + + FN := Session.TempPath + Session.io.GetInput(70, 70, 11, ''); + End; + + If FN = '' Then Exit; + + Session.io.PromptInfo[1] := JustFileName(FN); + + Assign (TF, FN); + {$I-} ReWrite (TF); {$I+} + If IoResult = 0 Then Begin + WriteLn (TF, 'From: ' + MsgBase^.GetFrom); + WriteLn (TF, ' To: ' + MsgBase^.GetTo); + WriteLn (TF, 'Subj: ' + MsgBase^.GetSubj); + WriteLn (TF, 'Date: ' + MsgBase^.GetDate + ' ' + MsgBase^.GetTime); + WriteLn (TF, 'Base: ' + MBase.Name); + WriteLn (TF, ''); + MsgBase^.MsgTxtStartUp; + While Not MsgBase^.EOM Do Begin + Temp := MsgBase^.GetString(79); + If Temp[1] <> #1 Then WriteLn (TF, Temp); + End; + Close (TF); + Session.io.OutFullLn (Session.GetPrompt(327)); + If Not Session.LocalMode Then Begin + Session.FileBase.SendFile(FN); + FileErase(FN); + End; + End; + End; + + Function SeekNextMsg (First, Back: Boolean): Boolean; + Var + Res : Boolean; + Str : String; + Begin + Res := False; + + If (ScanMode = 3) and First Then Begin + If Mode = 'S' Then Session.io.OutRawLn(''); + Session.io.OutFull (Session.GetPrompt(130)); + End; + + If Not First Then + If Back Then + MsgBase^.SeekPrior + Else + MsgBase^.SeekNext; + + While Not Res And MsgBase^.SeekFound Do Begin + MsgBase^.MsgStartUp; + + Case ScanMode of + 0 : Res := True; + 1 : Res := Session.User.IsThisUser(MsgBase^.GetTo); + 2 : Res := Session.User.IsThisUser(MsgBase^.GetTo) or Session.User.IsThisUser(MsgBase^.GetFrom); + 3 : Begin + Res := (Pos(SearchStr, strUpper(MsgBase^.GetTo)) > 0) or (Pos(SearchStr, strUpper(MsgBase^.GetFrom)) > 0) or + (Pos(SearchStr, strUpper(MsgBase^.GetSubj)) > 0); + + If Not Res Then Begin + MsgBase^.MsgTxtStartUp; + + While Not Res And Not MsgBase^.EOM Do Begin + Str := strUpper(MsgBase^.GetString(79)); + Res := Pos(SearchStr, Str) > 0; + End; + End; + End; + 4 : Res := Session.User.IsThisUser(MsgBase^.GetFrom); + End; + + If Not Res Then + If Back Then + MsgBase^.SeekPrior + Else + MsgBase^.SeekNext; + End; + + If (ScanMode = 3) And First Then + Session.io.OutBS (Screen.CursorX, True); + + If Not WereMsgs Then WereMsgs := Res; + + SeekNextMsg := Res; + End; + + Procedure Assign_Header_Info; + Var + NetAddr : RecEchoMailAddr; + Begin + Session.io.PromptInfo[1] := MsgBase^.GetFrom; + + If MBase.NetType = 3 Then Begin + MsgBase^.GetOrig(NetAddr); + Session.io.PromptInfo[1] := Session.io.PromptInfo[1] + ' (' + strAddr2Str(NetAddr) + ')'; + End; + + Session.io.PromptInfo[2] := MsgBase^.GetTo; + + If MBase.NetType = 3 Then Begin + MsgBase^.GetDest(NetAddr); + Session.io.PromptInfo[2] := Session.io.PromptInfo[2] + ' (' + strAddr2Str(NetAddr) + ')'; + End; + + Session.io.PromptInfo[3] := MsgBase^.GetSubj; + Session.io.PromptInfo[4] := MsgBase^.GetDate; + Session.io.PromptInfo[10] := MsgBase^.GetTime; + Session.io.PromptInfo[5] := strI2S(MsgBase^.GetMsgNum); + Session.io.PromptInfo[6] := strI2S(MsgBase^.GetHighMsgNum); + Session.io.PromptInfo[7] := strI2S(MsgBase^.GetRefer); + Session.io.PromptInfo[8] := strI2S(MsgBase^.GetSeeAlso); + + If MsgBase^.IsLocal Then Session.io.PromptInfo[9] := 'Local' Else Session.io.PromptInfo[9] := 'Echo'; //++lang + If MsgBase^.IsPriv Then Session.io.PromptInfo[9] := Session.io.PromptInfo[9] + ' Private'; //++lang + If MsgBase^.IsSent Then Session.io.PromptInfo[9] := Session.io.PromptInfo[9] + ' Sent'; //++lang + If MsgBase^.IsDeleted Then Session.io.PromptInfo[9] := Session.io.PromptInfo[9] + ' Deleted'; //++lang + End; + + Procedure Send_Msg_Text (Str : String); + Var + B : Byte; + Begin + B := Pos('>', strStripL(Str, ' ')); + If (B > 0) and (B < 5) Then Begin + Session.io.AnsiColor(MBase.ColQuote); + Session.io.OutPipe (Str); + Session.io.AnsiColor(MBase.ColText); + End Else + If Copy(Str, 1, 4) = '--- ' Then Begin + Session.io.AnsiColor(MBase.ColTear); + Session.io.OutPipe (Str); + Session.io.AnsiColor(MBase.ColText); + End Else + If Copy(Str, 1, 2) = ' *' Then Begin + Session.io.AnsiColor(MBase.ColOrigin); + Session.io.OutPipe (Str); + Session.io.AnsiColor(MBase.ColText); + End Else + Session.io.OutPipe (Str); + + If ListMode = 1 Then + Session.io.AnsiClrEOL; + + Session.io.OutRawLn(''); + End; + +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) + + Function Ansi_View_Message : Boolean; + Var + Lines : SmallInt; + PageSize : SmallInt; + PageStart : SmallInt; + PageEnd : SmallInt; + + Procedure Draw_Msg_Text; + Var + A : SmallInt; + Temp : String; + Begin + PageEnd := PageStart; + + Session.io.AnsiGotoXY (1, Session.io.ScreenInfo[1].Y); + Session.io.AnsiColor (MBase.ColText); + + For A := 1 to PageSize Do + If PageEnd <= Lines Then Begin + Send_Msg_Text(MsgText[PageEnd]); + Inc (PageEnd); + End Else Begin + Session.io.AnsiClrEOL; + Session.io.OutRawLn (''); + End; + + Temp := Session.io.DrawPercent(Session.Lang.MsgBar, PageEnd - 1, Lines, A); + + If Session.io.ScreenInfo[4].Y <> 0 Then Begin + Session.io.AnsiGotoXY (Session.io.ScreenInfo[4].X, Session.io.ScreenInfo[4].Y); + Session.io.AnsiColor (Session.io.ScreenInfo[4].A); + Session.io.OutRaw (strPadL(strI2S(A), 3, ' ')); + End; + + If Session.io.ScreenInfo[5].Y <> 0 Then Begin + Session.io.AnsiGotoXY (Session.io.ScreenInfo[5].X, Session.io.ScreenInfo[5].Y); + Session.io.OutFull (Temp); + End; + End; + + Var + Ch : Char; + A : LongInt; + CurMsg : LongInt; + Begin + Ansi_View_Message := False; + + Repeat + If Check_Node_Message Then; + + Set_Node_Action (Session.GetPrompt(348)); + + Set_Message_Security; + + If MsgBase^.GetMsgNum > LastRead Then LastRead := MsgBase^.GetMsgNum; + + CurMsg := MsgBase^.GetMsgNum; + Session.io.AllowArrow := True; + Lines := 0; + PageStart := 1; + + MsgBase^.MsgTxtStartUp; + + While Not MsgBase^.EOM And (Lines < mysMaxMsgLines) Do Begin + Inc (Lines); + MsgText[Lines] := MsgBase^.GetString(79);//HERE + + If MsgText[Lines][1] = #1 Then Begin + If Copy(MsgText[Lines], 1, 6) = #1 + 'MSGID' Then + ReplyID := Copy(MsgText[Lines], 9, Length(MsgText[Lines])); + + Dec (Lines); + End; + End; + + Assign_Header_Info; + + Session.io.ScreenInfo[4].Y := 0; + Session.io.ScreenInfo[5].Y := 0; + + Session.io.OutFile ('ansimrd', True, 0); + + PageSize := Session.io.ScreenInfo[2].Y - Session.io.ScreenInfo[1].Y + 1; + + Draw_Msg_Text; + + Repeat + Session.io.PurgeInputBuffer; + + Repeat + Ch := UpCase(Session.io.GetKey); + Until (Pos(Ch, #27 + ValidKeys) > 0) or Session.io.IsArrow; + + If Session.io.IsArrow Then Begin + Case Ch of + #71 : If PageStart > 1 Then Begin + PageStart := 1; + Draw_Msg_Text; + End; + #72 : If PageStart > 1 Then Begin + Dec (PageStart); + Draw_Msg_Text; + End; + #73 : If PageStart > 1 Then Begin + If PageStart - PageSize > 0 Then + Dec (PageStart, PageSize) + Else + PageStart := 1; + Draw_Msg_Text; + End; + #75 : If SeekNextMsg(False, True) Then + Break + Else Begin + MsgBase^.SeekFirst(CurMsg); + SeekNextMsg(True, False); + End; + #77 : If SeekNextMsg(False, False) Then + Break + Else Begin + MsgBase^.SeekFirst(CurMsg); + SeekNextMsg(True, False); + End; + #79 : Begin + PageStart := Lines - PageSize + 1; + + If PageStart < 1 Then PageStart := 1; + + Draw_Msg_Text; + End; + #80 : If PageEnd <= Lines Then Begin + Inc (PageStart); + Draw_Msg_Text; + End; + #81 : If (Lines > PageSize) and (PageEnd <= Lines) Then Begin + If PageStart + PageSize <= Lines - PageSize Then + Inc (PageStart, PageSize) + Else + PageStart := Lines - PageSize + 1; + + Draw_Msg_Text; + End; + End; + End Else + Case Ch of + 'A' : Break; + 'D' : Begin + If Session.io.GetYN(Session.GetPrompt(402), True) Then Begin + MsgBase^.DeleteMsg; + If Not SeekNextMsg(False, False) Then Begin + Ansi_View_Message := True; + Exit; + End; + End Else + MsgBase^.SeekFirst(CurMsg); + Break; + End; + 'E' : Begin + EditMessage; + Break; + End; + 'G' : Begin + Ansi_View_Message := True; + Exit; + End; + 'H' : Begin + LastRead := CurMsg - 1; + End; + 'I' : Begin + LastRead := MsgBase^.GetHighMsgNum; + Ansi_View_Message := True; + Exit; + End; + 'J' : Begin + Session.io.PromptInfo[1] := strI2S(CurMsg); + Session.io.PromptInfo[2] := strI2S(MsgBase^.GetHighMsgNum); + + Session.io.OutFull (Session.GetPrompt(403)); + A := strS2I(Session.io.GetInput(9, 9, 12, '')); + If (A > 0) and (A <= MsgBase^.GetHighMsgNum) Then Begin + MsgBase^.SeekFirst(A); + If Not SeekNextMsg(True, False) Then Begin + MsgBase^.SeekFirst(CurMsg); + If SeekNextMsg(True, False) Then; + End; + End; + Break; + End; + 'L' : Exit; + 'M' : Begin + If Move_Message Then + If Not SeekNextMsg(False, False) Then Begin + Ansi_View_Message := True; + Exit; + End; + Break; + End; + #13 : If (Lines > PageSize) and (PageEnd <= Lines) Then Begin + If PageStart + PageSize <= Lines - PageSize Then + Inc (PageStart, PageSize) + Else + PageStart := Lines - PageSize + 1; + + Draw_Msg_Text; + End Else Begin + If SeekNextMsg(False, False) Then + Break + Else Begin + Ansi_View_Message := True; + Exit; + End; + End; + 'N' : If SeekNextMsg(False, False) Then + Break + Else Begin + Ansi_View_Message := True; + Exit; + End; + 'P' : If SeekNextMsg(False, True) Then + Break + Else Begin + MsgBase^.SeekFirst(CurMsg); + SeekNextMsg(True, False); + End; + #27, + 'Q' : Begin + GetMessageScan; + If MScan.NewScan = 2 Then + Session.io.OutFullLn(Session.GetPrompt(406)) + Else Begin + ReadRes := False; + Ansi_View_Message := True; + Exit; + End; + End; + 'R' : Begin + ReplyMessage (Mode = 'E', ListMode, ReplyID); + Break; + End; + 'T' : Begin + Session.io.PromptInfo[1] := MBase.Name; + GetMessageScan; + Case MScan.NewScan of + 0 : Begin + MScan.NewScan := 1; + Session.io.OutFull (Session.GetPrompt(405)); + End; + 1 : Begin + MScan.NewScan := 0; + Session.io.OutFull (Session.GetPrompt(404)); + End; + 2 : Session.io.OutFull (Session.GetPrompt(406)); + End; + + SetMessageScan; + Break; + End; + 'X' : Begin + Export_Message; + Break; + End; + '[' : If MsgBase^.GetRefer > 0 Then Begin + MsgBase^.SeekFirst(MsgBase^.GetRefer); + MsgBase^.MsgStartUp; + Break; + End; + ']' : If MsgBase^.GetSeeAlso > 0 Then Begin + MsgBase^.SeekFirst(MsgBase^.GetSeeAlso); + MsgBase^.MsgStartUp; + Break; + End; + '?' : Begin + Session.io.OutFile ('amsghlp2', True, 0); + Break; + End; + End; + Until False; + Until False; + End; + +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) + + Procedure Ansi_Read_Messages; + Type + MsgInfoRec = Record + Num : LongInt; + MsgFrom : String[30]; + MsgTo : String[30]; + Subj : String[60]; + NewMsgs : Boolean; + End; + + Var + PageSize : SmallInt; + PagePos : SmallInt; + PageTotal : SmallInt; + CurPage : Word; + MsgInfo : Array[1..24] of MsgInfoRec; + FirstPage : Boolean; + + Procedure DrawPage; + Var + A : SmallInt; + Begin + Session.io.AnsiGotoXY (1, Session.io.ScreenInfo[1].Y); + + For A := 1 to PageSize Do + If A <= PageTotal Then Begin + With MsgInfo[A] Do Begin + Session.io.PromptInfo[1] := strI2S(Num); + Session.io.PromptInfo[2] := Subj; + Session.io.PromptInfo[3] := MsgFrom; + Session.io.PromptInfo[4] := MsgTo; + If NewMsgs Then + Session.io.PromptInfo[5] := Session.Lang.NewMsgChar + Else + Session.io.PromptInfo[5] := ' '; + End; + + Session.io.OutFull (Session.GetPrompt(399)); + Session.io.AnsiClrEOL; + Session.io.OutRawLn(''); + End Else Begin + Session.io.AnsiClrEOL; + Session.io.OutRawLn(''); + End; + End; + + Procedure FullReDraw; + Begin + If Check_Node_Message Then; + Session.io.OutFile ('ansimlst', True, 0); + + PageSize := Session.io.ScreenInfo[2].Y - Session.io.ScreenInfo[1].Y + 1; + End; + + Function Read_Page (First, Back, NoDraw : Boolean) : Boolean; + Var + A : SmallInt; + B : SmallInt; + Temp : MsgInfoRec; + Begin + Read_Page := False; + FirstPage := False; + + If SeekNextMsg(First, Back) Then Begin + + If First Then Begin + FullReDraw; + CurPage := 0; + End; + +{ add scanning prompt here } +(* +if (scanmode=3) then begin + Session.io.AnsiGotoXY(32, 11); + Session.io.OutFull ('|08.---------------.'); + Session.io.AnsiGotoXY(32, 12); + Session.io.OutFull ('| |07searching ... |08|'); + Session.io.AnsiGotoXY(32, 13); + Session.io.OutFull ('`---------------'''); +end; +*) + PageTotal := 0; + Read_Page := True; + + Repeat + Inc (PageTotal); + MsgInfo[PageTotal].Num := MsgBase^.GetMsgNum; + MsgInfo[PageTotal].MsgFrom := MsgBase^.GetFrom; + MsgInfo[PageTotal].MsgTo := MsgBase^.GetTo; + MsgInfo[PageTotal].Subj := MsgBase^.GetSubj; + MsgInfo[PageTotal].NewMsgs := MsgBase^.GetMsgNum > LastRead; + Until (PageTotal = PageSize) or (Not SeekNextMsg(False, Back)); + + If Back Then Begin { reverse message order } + Dec (CurPage); + + B := PageTotal; + + For A := 1 to PageTotal DIV 2 Do Begin + Temp := MsgInfo[A]; + MsgInfo[A] := MsgInfo[B]; + MsgInfo[B] := Temp; + Dec (B); + End; + + // if backwards and page is not filled, fill it going foward. + + If PageTotal < PageSize Then Begin + FirstPage := True; + + MsgBase.SeekFirst(MsgInfo[PageTotal].Num); + + While SeekNextMsg(False, False) and (PageTotal < PageSize) Do Begin + Inc (PageTotal); + MsgInfo[PageTotal].Num := MsgBase^.GetMsgNum; + MsgInfo[PageTotal].MsgFrom := MsgBase^.GetFrom; + MsgInfo[PageTotal].MsgTo := MsgBase^.GetTo; + MsgInfo[PageTotal].Subj := MsgBase^.GetSubj; + MsgInfo[PageTotal].NewMsgs := MsgBase^.GetMsgNum > LastRead; + End; + + Read_Page := False; + End; + End Else Begin + Inc (CurPage); + Read_Page := True; + End; + + If Not NoDraw Then DrawPage; + End; + End; + + Procedure UpdateBar (On : Boolean); + Begin + If PageTotal = 0 Then Exit; + + Session.io.PromptInfo[1] := strI2S(MsgInfo[PagePos].Num); + Session.io.PromptInfo[2] := MsgInfo[PagePos].Subj; + Session.io.PromptInfo[3] := MsgInfo[PagePos].MsgFrom; + Session.io.PromptInfo[4] := MsgInfo[PagePos].MsgTo; + + If MsgInfo[PagePos].NewMsgs Then + Session.io.PromptInfo[5] := Session.Lang.NewMsgChar + Else + Session.io.PromptInfo[5] := ' '; + + Session.io.AnsiGotoXY (1, Session.io.ScreenInfo[1].Y + PagePos - 1); + + If On Then + Session.io.OutFull (Session.GetPrompt(400)) + Else + Session.io.OutFull (Session.GetPrompt(401)); + End; + + Procedure Ansi_Message_Index; + Var + Ch : Char; + SN : LongInt; + A : Byte; + Begin + If Read_Page (True, False, False) Then Begin + WereMsgs := True; + PagePos := 1; + + Repeat + Session.io.AllowArrow := True; + + UpdateBar(True); + + Session.io.PurgeInputBuffer; + + Ch := UpCase(Session.io.GetKey); + + If Session.io.IsArrow Then Begin + Case Ch of + #71 : Begin + UpdateBar(False); + + While Read_Page(False, True, True) Do; + + PagePos := 1; + + DrawPage; + End; + #72 : Begin + UpdateBar(False); + + If PagePos > 1 Then + Dec (PagePos) + Else Begin + SN := MsgInfo[PagePos].Num; + + MsgBase^.SeekFirst(MsgInfo[1].Num); + + If Not Read_Page(False, True, False) Then + PagePos := 1 + Else + If Not FirstPage Then + PagePos := PageTotal + Else Begin + For A := 1 to PageTotal Do + If MsgInfo[A].Num = SN Then Begin + PagePos := A - 1; + Break; + End; + + If PagePos < 1 Then PagePos := 1; + End; + End; + End; + #73, + #75 : Begin + UpdateBar(False); + + MsgBase^.SeekFirst(MsgInfo[1].Num); + + If Not Read_Page(False, True, False) Then + PagePos := 1 + Else + If PagePos > PageTotal Then PagePos := PageTotal; + End; + #80 : Begin + UpdateBar(False); + + If PagePos < PageTotal Then + Inc (PagePos) + Else Begin + MsgBase^.SeekFirst(MsgInfo[PageTotal].Num); + If Read_Page(False, False, False) Then PagePos := 1; + End; + End; + #77, + #81 : Begin + MsgBase^.SeekFirst(MsgInfo[PageTotal].Num); + If Read_Page(False, False, False) Then Begin + If PagePos > PageTotal Then PagePos := PageTotal; + End Else Begin + UpdateBar(False); + PagePos := PageTotal; + End; + End; + #79 : Begin + UpdateBar(False); + While Read_Page(False, False, True) Do ; + PagePos := PageTotal; + DrawPage; + End; + End; + End Else + Case Ch of + #13 : Begin + MsgBase^.SeekFirst(MsgInfo[PagePos].Num); + If SeekNextMsg (True, False) Then; + If Ansi_View_Message Then Break; + + MsgBase^.SeekFirst(MsgInfo[1].Num); + + If Not Read_Page(True, False, False) Then Begin + PageTotal := 0; + FullReDraw; + DrawPage; + End; + End; + 'Q', + #27 : Begin + GetMessageScan; + + If MScan.NewScan = 2 Then + Session.io.OutFullLn(Session.GetPrompt(406)) + Else Begin + ReadRes := False; + Break; + End; + End; + 'G' : Break; + 'I' : Begin + LastRead := MsgBase^.GetHighMsgNum; + Break; + End; + '?' : Begin + Session.io.OutFile('amsghlp1', True, 0); + FullReDraw; + DrawPage; + End; + End; + Until False; + End; + + Session.io.AllowArrow := False; + + If WereMsgs Then Begin + Session.io.AnsiGotoXY (1, Session.io.ScreenInfo[3].Y); + Session.io.OutRawLn(''); + End; + End; + + Begin + If ((Mode = 'E') and Session.User.ThisUser.UseLBMIdx) or ((Mode <> 'E') and Session.User.ThisUser.UseLBIndex) Then + Ansi_Message_Index + Else Begin + If SeekNextMsg(True, False) Then + If Not Ansi_View_Message Then + Ansi_Message_Index; + End; + End; + +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) + + Procedure Ascii_Read_Messages; + + Procedure Display_Header; + Begin + Session.io.PausePtr := 1; + + Session.io.OutFile (MBase.Header, True, 0); + + If Session.io.NoFile Then Begin + Session.io.OutFullLn ('|CL|03From : |14|$R40|&1 |03Msg # : |14|&5 |03of |14|&6'); + Session.io.OutFullLn ('|03To : |10|$R40|&2 |03Refer to : |10|&7'); + Session.io.OutFullLn ('|03Subj : |12|$R40|&3 |03See Also : |12|&8'); + Session.io.OutFullLn ('|03Date : |11|&4 |$R31|&0 |03Status : |13|&9'); + Session.io.OutFullLn ('|03Base : |14|MB|CR'); + End; + + Session.io.AnsiColor (MBase.ColText); + End; + + Var + Str : String; + A : LongInt; + B : LongInt; + Begin + If SeekNextMsg(True, False) Then + Repeat +// Set_Node_Action (Session.GetPrompt(348)); + + If MsgBase^.GetMsgNum > LastRead Then LastRead := MsgBase^.GetMsgNum; + + Set_Message_Security; + Assign_Header_Info; + Display_Header; + + MsgBase^.MsgTxtStartUp; + + WereMsgs := True; + Session.io.AllowPause := True; + + While Not MsgBase^.EOM Do Begin + Str := MsgBase^.GetString(79); + + If Str[1] = #1 Then Begin + If Copy(Str, 1, 6) = #1 + 'MSGID' Then + ReplyID := Copy(Str, 9, Length(Str)); + End Else + Send_Msg_Text (Str); + + If (Session.io.PausePtr = Session.User.ThisUser.ScreenSize) and (Session.io.AllowPause) Then Begin + Case Session.io.MorePrompt of + 'N' : Break; + 'C' : Session.io.AllowPause := False; + End; + + If Config.MShowHeader Then Display_Header; + End; + End; + + Session.io.AllowPause := False; + + Repeat + Check_Node_Message; + + Session.io.PromptInfo[1] := strI2S(MsgBase^.GetMsgNum); + Session.io.PromptInfo[2] := strI2S(MsgBase^.GetHighMsgNum); + + If Mode = 'E' Then + Session.io.OutFull (Session.GetPrompt(115)) + Else + If Session.User.Access(MBase.SysopACS) or Session.User.IsThisUser(MsgBase^.GetFrom) Then + Session.io.OutFull (Session.GetPrompt(213)) + Else + Session.io.OutFull (Session.GetPrompt(116)); + + Str := Session.io.OneKey(ValidKeys, True); + Case Str[1] of + 'A' : Break; + 'D' : If Session.io.GetYN (Session.GetPrompt(117), True) Then Begin {Delete E-mail} + MsgBase^.DeleteMsg; + If Not SeekNextMsg(False, False) Then Exit; + Break; + End; + 'E' : Begin + EditMessage; + Break; + End; + 'G' : Exit; + 'H' : LastRead := MsgBase^.GetMsgNum - 1; + 'I' : Begin + LastRead := MsgBase^.GetHighMsgNum; + Exit; + End; + 'J' : Begin + B := MsgBase^.GetMsgNum; + Session.io.OutFull (Session.GetPrompt(334)); + A := strS2I(Session.io.GetInput(9, 9, 12, '')); + If (A > 0) and (A <= MsgBase^.GetHighMsgNum) Then Begin + MsgBase^.SeekFirst(A); + If Not SeekNextMsg(True, False) Then Begin + MsgBase^.SeekFirst(B); + If Not SeekNextMsg(True, False) Then; + End; + End; + Break; + End; + 'L' : Begin + Session.io.PausePtr := 1; + Session.io.AllowPause := True; + A := MsgBase^.GetMsgNum; + + Session.io.OutFullLn(Session.GetPrompt(411)); + + While SeekNextMsg(False, False) Do Begin + Assign_Header_Info; + Session.io.OutFullLn (Session.GetPrompt(412)); + + If (Session.io.PausePtr = Session.User.ThisUser.ScreenSize) and (Session.io.AllowPause) Then + Case Session.io.MorePrompt of + 'N' : Break; + 'C' : Session.io.AllowPause := False; + End; + End; + + Session.io.OutFull (Session.GetPrompt(413)); + + MsgBase^.SeekFirst(A); + MsgBase^.MsgStartup; + End; + 'M' : Begin + If Move_Message Then + If Not SeekNextMsg(False, False) Then Exit; + Break; + End; + #13, + 'N' : If SeekNextMsg(False, False) Then Break Else Exit; + 'P' : Begin + If Not SeekNextMsg(False, True) Then Begin + MsgBase^.SeekFirst(MsgBase^.GetMsgNum); + SeekNextMsg(True, False); + End; + Break; + End; + 'Q' : Begin + GetMessageScan; + If MScan.NewScan = 2 Then + Session.io.OutFullLn(Session.GetPrompt(302)) + Else Begin + ReadRes := False; + Exit; + End; + End; + 'R' : Begin + ReplyMessage (Mode = 'E', ListMode, ReplyID); + Break; + End; + 'T' : Begin + Session.io.PromptInfo[1] := MBase.Name; + GetMessageScan; + Case MScan.NewScan of + 0 : Begin + MScan.NewScan := 1; + Session.io.OutFull (Session.GetPrompt(99)); + End; + 1 : Begin + MScan.NewScan := 0; + Session.io.OutFull (Session.GetPrompt(98)); + End; + 2 : Session.io.OutFull (Session.GetPrompt(302)); + End; + + SetMessageScan; + End; + 'X' : Export_Message; + '?' : Session.io.OutFile(HelpFile, True, 0); + '[' : If MsgBase^.GetRefer > 0 Then Begin + MsgBase^.SeekFirst(MsgBase^.GetRefer); + MsgBase^.MsgStartUp; + Break; + End Else + Session.io.OutFullLn (Session.GetPrompt(128)); + ']' : If MsgBase^.GetSeeAlso > 0 Then Begin + MsgBase^.SeekFirst(MsgBase^.GetSeeAlso); + MsgBase^.MsgStartUp; + Break; + End Else + Session.io.OutFullLn (Session.GetPrompt(199)); + End; + Until False; + Until False; + End; + +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +(**************************************************************************) +{ F = Forward S = Search E = Electronic Mail + N = New messages Y = Your messages G = Global scan + P = Global personal scan B = By You T = Global text search } +Var + MsgNum : LongInt; +Begin + ReadMessages := True; + ReadRes := True; + WereMsgs := False; + ReplyID := ''; + + If MBase.FileName = '' Then Begin + Session.io.OutFullLn (Session.GetPrompt(110)); + Exit; + End; + + If Not Session.User.Access(MBase.ReadACS) Then Begin + If Not (Mode in ['G', 'P', 'T']) Then Session.io.OutFullLn (Session.GetPrompt(111)); + Exit; + End; + + If Not (Mode in ['B', 'T', 'S', 'E', 'F', 'G', 'N', 'P', 'Y']) Then Begin + Session.io.OutFull (Session.GetPrompt(112)); + Mode := Session.io.OneKey('BFNSYQ', True); + End; + + Case Mode of + 'Q' : Exit; + 'S' : If SearchStr = '' Then Begin + Session.io.OutFull (Session.GetPrompt(396)); + SearchStr := Session.io.GetInput(50, 50, 12, ''); + If SearchStr = '' Then Exit; + End; + End; + + Case MBase.BaseType of + 0 : MsgBase := New(PMsgBaseJAM, Init); + 1 : MsgBase := New(PMsgbaseSquish, Init); + End; + + MsgBase^.SetMsgPath (MBase.Path + MBase.FileName); + + If Not MsgBase^.OpenMsgBase Then Begin + If Mode = 'E' Then + Session.io.OutFullLn (Session.GetPrompt(124)) + Else + If Not (Mode in ['G', 'P', 'T']) Then Session.io.OutFullLn (Session.GetPrompt(114)); + Dispose (MsgBase, Done); + Exit; + End; + + If Mode = 'E' Then + ScanMode := 1 + Else + If (MBase.PostType = 1) or (Mode = 'Y') or (Mode = 'P') Then + ScanMode := 2 + Else + If (Mode = 'S') or (Mode = 'T') Then + ScanMode := 3 + Else + If Mode = 'B' Then + ScanMode := 4 + Else + ScanMode := 0; + + LastRead := MsgBase^.GetLastRead(Session.User.UserNum); + MsgNum := 1; + + If Mode = 'F' Then Begin + Session.io.PromptInfo[1] := strI2S(MsgBase^.GetHighMsgNum); + Session.io.OutFull (Session.GetPrompt(338)); + MsgNum := strS2I(Session.io.GetInput(6, 6, 12, '')); + End; + + Set_Node_Action (Session.GetPrompt(348)); + + If Mode in ['B', 'S', 'T', 'Y', 'E', 'F'] Then + MsgBase^.SeekFirst(MsgNum) + Else + MsgBase^.SeekFirst(LastRead + 1); + + Set_Message_Security; + + Reading := True; + + If (Session.User.ThisUser.MReadType = 1) and (Session.io.Graphics > 0) Then Begin + ListMode := 1; + Ansi_Read_Messages; + End Else Begin + ListMode := 0; + Ascii_Read_Messages; + End; + + If Not (Mode in ['E', 'S', 'T']) Then MsgBase^.SetLastRead (Session.User.UserNum, LastRead); + + MsgBase^.CloseMsgBase; + Dispose (MsgBase, Done); + + Reading := False; + + If WereMsgs Then Begin + If Not (Mode in ['B', 'E', 'P']) And ReadRes Then + If ListMode = 0 Then Begin + Session.io.OutFull('|CR'); + If Session.io.GetYN(Session.GetPrompt(383), False) Then + PostMessage (False, ''); + End Else + If Session.io.GetYN(Session.GetPrompt(438), False) Then + PostMessage (False, ''); + End Else + Case Mode of + 'S' : Session.io.OutFullLn (Session.GetPrompt(113)); + 'B', + 'Y', + 'N' : Session.io.OutFullLn ('|CR' + Session.GetPrompt(113)); + End; + + Result := ReadRes; +End; + +Procedure TMsgBase.PostMessage (Email: Boolean; Data: String); +Var + MsgTo : String[30]; + MsgSubj : String[60]; + MsgAddr : String[20]; + TempStr : String; + DestAddr : RecEchoMailAddr; + A : Integer; + Lines : Integer; + Forced : Boolean; + Old : MBaseRec; +Begin + Old := MBase; + + If Email Then Begin + Reset (MBaseFile); + Read (MBaseFile, MBase); + Close (MBaseFile); + End; + + If MBase.FileName = '' Then Begin + Session.io.OutFullLn (Session.GetPrompt(110)); + MBase := Old; + Exit; + End; + + If Not Session.User.Access(MBase.PostACS) Then Begin + Session.io.OutFullLn (Session.GetPrompt(105)); + MBase := Old; + Exit; + End; + + Set_Node_Action (Session.GetPrompt(349)); + + MsgTo := ''; + MsgSubj := ''; + MsgAddr := ''; + Forced := False; + + For A := 1 to strWordCount(Data, ' ') Do Begin + TempStr := strWordGet(A, Data, ' '); + + If Pos ('/F', strUpper(TempStr)) > 0 Then + Forced := True + Else + If Pos ('/TO:', strUpper(TempStr)) > 0 Then + MsgTo := strReplace(Copy(TempStr, Pos('/TO:', strUpper(TempStr)) + 4, Length(TempStr)), '_', ' ') + Else + If Pos ('/SUBJ:', strUpper(TempStr)) > 0 Then + MsgSubj := strReplace(Copy(TempStr, Pos('/SUBJ:', strUpper(TempStr)) + 6, Length(TempStr)), '_', ' ') + Else + If Pos('/ADDR:', strUpper(TempStr)) > 0 Then + MsgAddr := strReplace(Copy(TempStr, Pos('/ADDR:', strUpper(TempStr)) + 6, Length(TempStr)), '_', ' '); + End; + + If MBase.NetType = 2 Then { UseNet Base: To = "All" } + MsgTo := 'All' + Else + If MBase.NetType = 3 Then Begin { NetMail Base: Get To *and* Address } + If MsgTo = '' Then Begin + Session.io.OutFull (Session.GetPrompt(119)); + MsgTo := Session.io.GetInput (30, 30, 18, ''); + End; + + If MsgAddr = '' Then Begin + Session.io.OutFull (Session.GetPrompt(342)); + MsgAddr := Session.io.GetInput (20, 20, 12, ''); + If Not strStr2Addr(MsgAddr, DestAddr) Then MsgTo := ''; + End; + End Else + If MBase.PostType = 1 Then Begin { if the base is flagged private } + If MsgTo = '' Then Begin + Session.io.OutFull (Session.GetPrompt(450)); + MsgTo := Session.io.GetInput (30, 30, 18, ''); + If Not Session.User.SearchUser(MsgTo, MBase.UseReal) Then MsgTo := ''; + End Else + If strUpper(MsgTo) = 'SYSOP' Then MsgTo := Config.SysopName; + + If Session.User.FindUser(MsgTo, False) Then Begin + Session.io.PromptInfo[1] := MsgTo; + Session.io.OutFullLn (Session.GetPrompt(108)); + End Else + MsgTo := ''; + End Else Begin + Session.io.OutFull (Session.GetPrompt(119)); + MsgTo := Session.io.GetInput (30, 30, 18, 'All'); + End; + + If MsgTo = '' Then Begin + MBase := Old; + Exit; + End; + + If MsgSubj = '' Then + Repeat + Session.io.OutFull (Session.GetPrompt(120)); + MsgSubj := Session.io.GetInput (60, 60, 11, ''); + If MsgSubj = '' Then + If Forced Then + Session.io.OutFull (Session.GetPrompt(307)) + Else Begin + MBase := Old; + Exit; + End; + Until MsgSubj <> ''; + + Lines := 0; + + Session.io.PromptInfo[1] := MsgTo; + Session.io.PromptInfo[2] := MsgSubj; + + If Editor(Lines, 78, mysMaxMsgLines, False, Forced, MsgSubj) Then Begin + Session.io.OutFull (Session.GetPrompt(107)); + + { all of this below should be replaced with a SaveMessage function } + { the same should be used for Replying and also for TextFile post } + { and then the automated e-mails can be added where mystic will send } + { notifications out to the sysop for various things (configurable) } + { also could be used in mass email rewrite and qwk .REP rewrite } + + If Not OpenCreateBase(MsgBase, MBase) Then Begin + MBase := Old; + Exit; + End; + + AssignMessageData(MsgBase); + + MsgBase^.SetTo (MsgTo); + MsgBase^.SetSubj (MsgSubj); + + If MBase.NetType = 3 Then Begin + MsgBase^.SetDest (DestAddr); + MsgBase^.SetCrash (Config.netCrash); + MsgBase^.SetHold (Config.netHold); + MsgBase^.SetKillSent (Config.netKillSent); + + DestAddr := Config.NetAddress[MBase.NetAddr]; + MsgBase^.SetOrig (DestAddr); + End; + + AppendMessageText (MsgBase, Lines, ''); + + If MsgBase^.WriteMsg <> 0 Then; + + MsgBase^.CloseMsgBase; + + If Email Then Begin + Session.SystemLog ('Sent Email to ' + MsgTo); + + Inc (Session.User.ThisUser.Emails); + Inc (Session.HistoryEmails); + + A := Is_User_Online(MsgTo); + + If A <> 0 Then Begin + TempStr := Session.GetPrompt(465); + TempStr := strReplace(TempStr, '|&1', Session.User.ThisUser.Handle); + TempStr := strReplace(TempStr, '|&2', MsgSubj); + + Send_Node_Message(2, strI2S(A) + ';' + TempStr, 0); + End; + End Else Begin + Session.SystemLog ('Posted #' + strI2S(MsgBase^.GetMsgNum) + ': "' + MsgSubj + '" to ' + strStripMCI(MBase.Name)); + + Inc (Session.User.ThisUser.Posts); + Inc (Session.HistoryPosts); + End; + + Dispose (MsgBase, Done); + Session.io.OutFullLn (Session.GetPrompt(122)); + End Else + Session.io.OutFullLn (Session.GetPrompt(109)); + + MBase := Old; +End; + +Procedure TMsgBase.CheckEMail; +Var + Old : MBaseRec; + Total : Integer; +Begin + Session.io.OutFull (Session.GetPrompt(123)); + + Session.io.BufFlush; + + Old := MBase; + + Reset (MBaseFile); + Read (MBaseFile, MBase); + Close (MBaseFile); + + Case MBase.BaseType of + 0 : MsgBase := New(PMsgBaseJAM, Init); + 1 : MsgBase := New(PMsgBaseSquish, Init); + End; + + MsgBase^.SetMsgPath (MBase.Path + MBase.FileName); + + If Not MsgBase^.OpenMsgBase Then Begin + Session.io.OutFullLn (Session.GetPrompt(124)); + Dispose (MsgBase, Done); + MBase := Old; + Exit; + End; + + Total := 0; + + MsgBase^.YoursFirst(Session.User.ThisUser.RealName, Session.User.ThisUser.Handle); + + If MsgBase^.YoursFound Then Begin + Session.io.OutFullLn (Session.GetPrompt(125)); + + Total := 0; + + While MsgBase^.YoursFound Do Begin + MsgBase^.MsgStartUp; + + Inc (Total); + + Session.io.PromptInfo[1] := strI2S(Total); + Session.io.PromptInfo[2] := MsgBase^.GetFrom; + Session.io.PromptInfo[3] := MsgBase^.GetSubj; + Session.io.PromptInfo[4] := MsgBase^.GetDate; + + Session.io.OutFullLn (Session.GetPrompt(126)); + + MsgBase^.YoursNext; + End; + + If Session.io.GetYN (Session.GetPrompt(127), True) Then Begin + MsgBase^.CloseMsgBase; + Dispose (MsgBase, Done); + + ReadMessages('E', ''); + + Session.io.OutFullLn (Session.GetPrompt(118)); + + MBase := Old; + Exit; + End; + End Else + Session.io.OutFullLn (Session.GetPrompt(124)); + + MsgBase^.CloseMsgBase; + Dispose (MsgBase, Done); + MBase := Old; +End; + +Procedure TMsgBase.SetMessagePointers; +Var + NewDate : LongInt; + + Procedure UpdateBase; + Var + Found : Boolean; + Begin + Found := False; + + Case MBase.BaseType of + 0 : MsgBase := New(PMsgBaseJAM, Init); + 1 : MsgBase := New(PMsgBaseSquish, Init); + End; + + MsgBase^.SetMsgPath (MBase.Path + MBase.FileName); + + If MsgBase^.OpenMsgBase Then Begin + MsgBase^.SeekFirst(1); + + While MsgBase^.SeekFound Do Begin + MsgBase^.MsgStartUp; + If DateStr2Dos(MsgBase^.GetDate) >= NewDate Then Begin + MsgBase^.SetLastRead(Session.User.UserNum, MsgBase^.GetMsgNum - 1); + Found := True; + Break; + End; + MsgBase^.SeekNext; + End; + + If Not Found Then + MsgBase^.SetLastRead(Session.User.UserNum, MsgBase^.GetHighMsgNum); + End; + + Dispose (MsgBase, Done); + End; + +Var + Global : Boolean; + InDate : String[8]; +Begin + Session.io.OutFull (Session.GetPrompt(458)); + + InDate := Session.io.GetInput(8, 8, 15, ''); + + If Not DateValid(InDate) Then Exit; + + NewDate := DateStr2Dos(InDate); + Global := Session.io.GetYN(Session.GetPrompt(459), False); + + Session.io.OutFullLn (Session.GetPrompt(460)); + + If Global Then Begin + ioReset (MBaseFile, SizeOf(MBaseRec), fmRWDN); + ioRead (MBaseFile, MBase); + + While Not Eof(MBaseFile) Do Begin + ioRead (MBaseFile, MBase); + UpdateBase; + End; + End Else + UpdateBase; +End; + +Procedure TMsgBase.MessageNewScan (Data : String); +{ menu data commands: } +{ /P : scan for personal mail in all bases } +{ /M : scan only mandatory bases } +{ /G : scan all bases in all groups } +Var + Old : MBaseRec; + Mode : Char; + Mand : Boolean; +Begin + Old := MBase; + Mand := False; + + Reset (MBaseFile); + + If Pos ('/P', Data) > 0 Then Begin + Mode := 'P'; + + Session.SystemLog ('Scan for personal messages'); + End Else Begin + Mand := Pos('/M', Data) > 0; + Mode := 'G'; + + Read (MBaseFile, MBase); + + Session.SystemLog ('Scan for new messages'); + End; + + Session.User.IgnoreGroup := Pos('/G', Data) > 0; + WereMsgs := False; + + Session.io.OutRawLn (''); + + While Not Eof(MBaseFile) Do Begin + Read (MBaseFile, MBase); + + If Session.User.Access(MBase.ReadACS) Then Begin + GetMessageScan; + + If ((Mand) and (MBase.DefNScan = 2)) or ((Not Mand) and (MScan.NewScan > 0)) Then Begin + Session.io.OutBS (Screen.CursorX, True); + Session.io.OutFull (Session.GetPrompt(130)); + + If Not ReadMessages(Mode, '') Then Begin + Session.io.OutRawLn(''); + Break; + End; + + If WereMsgs Then Session.io.OutRawLn(''); + End; + End; + End; + + If Not WereMsgs Then Session.io.OutFullLn('|CR'); + + Session.io.OutFull (Session.GetPrompt(131)); + + Close (MBaseFile); + + Session.User.IgnoreGroup := False; + MBase := OLD; +End; + +Procedure TMsgBase.GlobalMessageSearch (Mode : Char); +{ C = current area } +{ G = all areas in group } +{ A = all areas in all groups } +Var + SearchStr : String; + Old : MBaseRec; +Begin + If Not (Mode in ['A', 'C', 'G']) Then Mode := 'G'; + + Session.io.OutFull (Session.GetPrompt(310)); + + SearchStr := Session.io.GetInput(50, 50, 12, ''); + + If SearchStr = '' Then Exit; + + OLD := MBase; + WereMsgs := False; + Session.User.IgnoreGroup := Mode = 'A'; + + If Mode = 'C' Then + ReadMessages('S', SearchStr) + Else Begin + Session.io.OutRawLn (''); + + Reset (MBaseFile); + Read (MBaseFile, MBase); {skip email base} + + While Not Eof(MBaseFile) Do Begin + Read (MBaseFile, MBase); + + If Session.User.Access(MBase.ReadACS) Then Begin + GetMessageScan; + + If MScan.NewScan > 0 Then Begin + If Not ReadMessages('T', SearchStr) Then Begin + Session.io.OutRawLn(''); + Break; + End; + + If WereMsgs Then Session.io.OutRawLn(''); + End; + End; + End; + + Session.io.OutFull (Session.GetPrompt(311)); + Close (MBaseFile); + End; + + Session.User.IgnoreGroup := False; + MBase := OLD; +End; + +Procedure TMsgBase.SendMassEmail; +Var + Mode : Char; + Names : Array[1..25] of String[35]; + NamePos : SmallInt; + ACS : String[20]; + Str : String[30]; + A : SmallInt; + MsgFrom : String[30]; + MsgTo : String[30]; + MsgSubj : String[60]; + Lines : Integer; + Old : MBaseRec; + OldUser : RecUser; + + Procedure Write_Mass_Msg; + Begin + Session.SystemLog ('Sending mass mail to ' + MsgTo); + + AssignMessageData(MsgBase); + + MsgBase^.SetFrom (MsgFrom); + MsgBase^.SetTo (MsgTo); + MsgBase^.SetSubj (MsgSubj); + + AppendMessageText (MsgBase, Lines, ''); + + If MsgBase^.WriteMsg <> 0 Then; + End; + +Begin + MsgFrom := Session.User.ThisUser.Handle; + + Session.io.OutFull (Session.GetPrompt(387)); + + Mode := Session.io.OneKey('123Q', True); + + Case Mode of + '1' : Begin + Session.io.OutFull (Session.GetPrompt(388)); + ACS := Session.io.GetInput(20, 20, 11, ''); + + If ACS = '' Then Exit; + + Session.io.OutFullLn (Session.GetPrompt(391)); + + OldUser := Session.User.ThisUser; + + Reset (Session.User.UserFile); + While Not Eof(Session.User.UserFile) Do Begin + If (Session.User.ThisUser.Flags AND UserDeleted = 0) and Session.User.Access(ACS) Then Begin + Read (Session.User.UserFile, Session.User.ThisUser); + Session.io.PromptInfo[1] := Session.User.ThisUser.Handle; + Session.io.OutFullLn (Session.GetPrompt(392)); + End; + End; + Close (Session.User.UserFile); + + Session.User.ThisUser := OldUser; + + If Not Session.io.GetYN(Session.GetPrompt(393), True) Then + Exit; + End; + '2' : Begin + NamePos := 0; + + Session.io.OutFull (Session.GetPrompt(389)); + + While NamePos < 25 Do Begin + Session.io.PromptInfo[1] := strI2S(NamePos); + Session.io.OutFull (Session.GetPrompt(390)); + Str := Session.io.GetInput (30, 30, 18, ''); + If Str <> '' Then Begin + If Session.User.SearchUser(Str, MBase.UseReal) Then Begin + Inc (NamePos); + Names[NamePos] := Str; + End; + End Else + If NamePos = 0 Then + Exit + Else + Break; + End; + + Session.io.OutFullLn (Session.GetPrompt(391)); + + For A := 1 to NamePos Do Begin + Session.io.PromptInfo[1] := Names[A]; + Session.io.OutFullLn (Session.GetPrompt(392)); + End; + + If Not Session.io.GetYN(Session.GetPrompt(393), True) Then + Exit; + End; + '3' : Begin + Mode := '1'; + ACS := '^'; + End; + 'Q' : Exit; + End; + + Session.io.OutFull (Session.GetPrompt(416)); + + MsgSubj := Session.io.GetInput (60, 60, 11, ''); + + If MsgSubj = '' Then Exit; + + Session.io.PromptInfo[1] := 'Mass Mail'; + Session.io.PromptInfo[2] := MsgSubj; + + Lines := 0; + + If Editor(Lines, 78, mysMaxMsgLines, False, False, MsgSubj) Then Begin + Session.io.OutFullLn (Session.GetPrompt(394)); + + OLD := MBase; + + Reset (MBaseFile); + Read (MBaseFile, MBase); + Close (MBaseFile); + + Case MBase.BaseType of + 0 : MsgBase := New(PMsgBaseJAM, Init); + 1 : MsgBase := New(PMsgBaseSquish, Init); + End; + + MsgBase^.SetMsgPath (MBase.Path + MBase.FileName); + + If Not MsgBase^.OpenMsgBase Then + If Not MsgBase^.CreateMsgBase (MBase.MaxMsgs, MBase.MaxAge) Then Begin + Dispose (MsgBase, Done); + MBase := Old; + Exit; + End Else + If Not MsgBase^.OpenMsgBase Then Begin + Dispose (MsgBase, Done); + MBase := Old; + Exit; + End; + + Case Mode of + '1' : Begin + OldUser := Session.User.ThisUser; + + Reset (Session.User.UserFile); + While Not Eof(Session.User.UserFile) Do Begin + Read (Session.User.UserFile, Session.User.ThisUser); + If (Session.User.ThisUser.Flags AND UserDeleted = 0) and Session.User.Access(ACS) Then Begin + MsgTo := Session.User.ThisUser.Handle; + Session.User.ThisUser := OldUser; + Write_Mass_Msg; + {// appends wrong autosig so we add thisuser := olduser?} + // shitty kludge all of these var swaps should be + // rewritten.. probably do away with global MBAse records + End; + End; + Close (Session.User.UserFile); + + Session.User.ThisUser := OldUser; + End; + '2' : For A := 1 to NamePos Do Begin + MsgTo := Names[A]; + Write_Mass_Msg; + End; + End; + + MsgBase^.CloseMsgBase; + + Dispose (MsgBase, Done); + End; +End; + +Procedure TMsgBase.ViewSentEmail; +Var + Old : MBaseRec; +Begin + Old := MBase; + + Reset (MBaseFile); + Read (MBaseFile, MBase); + Close (MBaseFile); + + ReadMessages('B', ''); + + MBase := Old; +End; + +{ QWK OPTIONS } + +// this unbuffered foulness should be rewritten... if only people actually +// used QWK... low priority. also it doesnt copy the welcome, etc files. + +Procedure TMsgBase.WriteCONTROLDAT; +Const + CRLF = #13#10; { for eventually having option for linux OR dos text files } +Var + tFile : Text; +Begin + Assign (tFile, Session.TempPath + 'control.dat'); + ReWrite (tFile); + + Write (tFile, Config.BBSName + CRLF); + Write (tFile, CRLF); {bbs City/State} + Write (tFile, CRLF); {bbs Phone number} + Write (tFile, Config.SysopName + CRLF); + Write (tFile, '0,' + Config.qwkBBSID + CRLF); + Write (tFile, DateDos2Str(CurDateDos, 1), ',', TimeDos2Str(CurDateDos, False) + CRLF); + Write (tFile, strUpper(Session.User.ThisUser.Handle) + CRLF); + Write (tFile, CRLF); + Write (tFile, '0' + CRLF); {What is this line?} + Write (tFile, TotalMsgs, CRLF); {TOTAL MSG IN PACKET} + Write (tFile, TotalConf - 1, CRLF); {TOTAL CONF - 1} + + Reset (MBaseFile); + Read (MBaseFile, MBase); {SKIP EMAIL BASE} + While Not Eof(MBaseFile) Do Begin + Read (MBaseFile, MBase); + If Session.User.Access(MBase.ReadACS) Then Begin + GetMessageScan; + If MScan.QwkScan > 0 Then Begin + Write (tFile, MBase.Index, CRLF); {conf #} + Write (tFile, MBase.QwkName, CRLF); {conf name} + End; + End; + End; + + Write (tFile, Config.qwkWelcome + CRLF); + Write (tFile, Config.qwkNews + CRLF); + Write (tFile, Config.qwkGoodbye + CRLF); + Close (tFile); +End; + +{ converts TP real to Microsoft 4 bytes single } +{ what kind of stupid standard uses this var type!? } + +Procedure Long2msb (Index : LongInt; Var MS : BSingle); +Var + Exp : Byte; +Begin + If Index <> 0 Then Begin + Exp := 0; + + While Index And $800000 = 0 Do Begin + Inc (Exp); + Index := Index SHL 1 + End; + + Index := Index And $7FFFFF; + End Else + Exp := 152; + + MS[0] := Index AND $FF; + MS[1] := (Index SHR 8) AND $FF; + MS[2] := (Index SHR 16) AND $FF; + MS[3] := 152 - Exp; +End; + +Function TMsgBase.WriteMSGDAT : LongInt; +{ returns last message added to qwk packet } +Var + DataFile : File; + NdxFile : File of QwkNdxHdr; + NdxHdr : QwkNdxHdr; + QwkHdr : QwkDATHdr; + Temp : String; + MsgAdded : Integer; {# of message added in packet} + LastRead : LongInt; + BufStr : String[128]; + Blocks : Word; + Index : LongInt; + Count : SmallInt; +Begin + Inc (TotalConf); + + MsgAdded := 0; + + Case MBase.BaseType of + 0 : MsgBase := New(PMsgBaseJAM, Init); + 1 : MsgBase := New(PMsgBaseSquish, Init); + End; + + MsgBase^.SetMsgPath (MBase.Path + MBase.FileName); + + If Not MsgBase^.OpenMsgBase Then Begin + Dispose (MsgBase, Done); + Exit; + End; + + Session.io.OutFull (Session.GetPrompt(231)); + + Assign (DataFile, Session.TempPath + 'messages.dat'); + Reset (DataFile, 1); + Seek (DataFile, FileSize(DataFile)); + + LastRead := MsgBase^.GetLastRead(Session.User.UserNum) + 1; + + MsgBase^.SeekFirst(LastRead); + While MsgBase^.SeekFound Do Begin + If ((Config.qwkMaxBase > 0) and (MsgAdded = Config.qwkMaxBase)) or + ((Config.qwkMaxPacket > 0) and (TotalMsgs = Config.qwkMaxPacket)) Then Break; + + FillChar (QwkHdr, 128, ' '); + + MsgBase^.MsgStartUp; + + If MsgBase^.IsPriv Then + If Not ((MsgBase^.GetTo = Session.User.ThisUser.RealName) or (MsgBase^.GetTo = Session.User.ThisUser.Handle)) Then Begin + MsgBase^.SeekNext; + Continue; + End; + + Inc (MsgAdded); + Inc (TotalMsgs); + + LastRead := MsgBase^.GetMsgNum; + + Temp := strPadR(strUpper(MsgBase^.GetFrom), 25, ' '); + Move (Temp[1], QwkHdr.UPFrom, 25); + Temp := strPadR(strUpper(MsgBase^.GetTo), 25, ' '); + Move (Temp[1], QwkHdr.UPTo, 25); + Temp := strPadR(MsgBase^.GetSubj, 25, ' '); + Move (Temp[1], QwkHdr.Subject, 25); + Temp := MsgBase^.GetDate; + Move (Temp[1], QwkHdr.Date, 8); + Temp := MsgBase^.GetTime; + Move (Temp[1], QwkHdr.Time, 5); + Temp := strPadR(strI2S(MsgBase^.GetMsgNum), 7, ' '); + Move (Temp[1], QwkHdr.MSGNum, 7); + Temp := strPadR(strI2S(MsgBase^.GetRefer), 8, ' '); + Move (Temp[1], QwkHdr.ReferNum, 8); + + QwkHdr.Active := #225; + QwkHdr.ConfNum := MBase.Index; + QwkHdr.Status := ' '; + + MsgBase^.MsgTxtStartUp; + + Blocks := MsgBase^.GetTextLen DIV 128; + If MsgBase^.GetTextLen MOD 128 > 0 Then Inc(Blocks, 2) Else Inc(Blocks); + Temp := strPadR(strI2S(Blocks), 6, ' '); + Move (Temp[1], QwkHdr.NumChunk, 6); + + If MsgAdded = 1 Then Begin + Assign (NdxFile, Session.TempPath + strPadL(strI2S(MBase.Index), 3, '0') + '.ndx'); + ReWrite (NdxFile); + End; + + Index := FileSize(DataFile) DIV 128 + 1; + + long2msb (Index, NdxHdr.MsgPos); + + Write (NdxFile, NdxHdr); + + BlockWrite (DataFile, QwkHdr, 128); + + BufStr := ''; + + While Not MsgBase^.EOM Do Begin + Temp := MsgBase^.GetString(79) + #227; + + If Temp[1] = #1 Then Continue; + + For Count := 1 to Length(Temp) Do Begin + BufStr := BufStr + Temp[Count]; + + If BufStr[0] = #128 Then Begin + BlockWrite (DataFile, BufStr[1], 128); + BufStr := ''; + End; + End; + End; + + If BufStr <> '' Then Begin + BufStr := strPadR(BufStr, 128, ' '); + BlockWrite (DataFile, BufStr[1], 128); + End; + + MsgBase^.SeekNext; + End; + + Close (DataFile); + + If MsgAdded > 0 Then Close (NdxFile); + + Session.io.PromptInfo[1] := strI2S(MBase.Index); + Session.io.PromptInfo[2] := MBase.Name; + Session.io.PromptInfo[3] := MBase.QwkName; + Session.io.PromptInfo[4] := strI2S(MsgBase^.NumberOfMsgs); + Session.io.PromptInfo[5] := strI2S(MsgAdded); + + MsgBase^.CloseMsgBase; + Dispose (MsgBase, Done); + + Session.io.OutBS (Screen.CursorX, True); + Session.io.OutFullLn (Session.GetPrompt(232)); + + Result := LastRead; +End; + +Procedure TMsgBase.UploadREP; +Var + DataFile : File; + OldMBase : MBaseRec; + QwkHdr : QwkDATHdr; + Temp : String[128]; + A : SmallInt; + B : SmallInt; + Chunks : SmallInt; +Begin + If Session.LocalMode Then + Session.FileBase.ExecuteArchive (Config.QWKPath + Config.qwkBBSID + '.rep', Session.User.ThisUser.Archive, FileMask{TempPath}, 2) + Else Begin + If Session.FileBase.SelectProtocol(False) = 'Q' Then Exit; + + Session.FileBase.ExecuteProtocol(False, Session.TempPath + Config.qwkBBSID + '.rep'); + + If Not Session.FileBase.dszSearch(Config.qwkBBSID + '.rep') Then Begin + Session.io.PromptInfo[1] := Config.qwkBBSID + '.rep'; + Session.io.OutFullLn (Session.GetPrompt(84)); + Exit; + End; + + Session.FileBase.ExecuteArchive (Session.TempPath + Config.qwkBBSID + '.rep', Session.User.ThisUser.Archive, FileMask, 2) + End; + + Assign (DataFile, Session.TempPath + Config.qwkBBSID + '.msg'); + {$I-} Reset (DataFile, 1); {$I+} + If IoResult <> 0 Then Begin + Session.io.OutFull (Session.GetPrompt(238)); + CleanDirectory(Session.TempPath, ''); + Exit; + End; + + BlockRead (DataFile, Temp[1], 128); + Temp[0] := #128; + If Pos(strUpper(Config.qwkBBSID), strUpper(Temp)) = 0 Then Begin + Session.io.OutFullLn (Session.GetPrompt(239)); + Close (DataFile); + CleanDirectory(Session.TempPath, ''); + Exit; + End; + + Session.io.OutFullLn (Session.GetPrompt(240)); + + OldMBase := MBase; + + While Not Eof(DataFile) Do Begin + BlockRead (DataFile, QwkHdr, SizeOf(QwkHdr)); + Move (QwkHdr.MsgNum, Temp[1], 7); + Temp[0] := #7; + + Reset (MBaseFile); + While Not Eof(MBaseFile) Do Begin + Read (MBaseFile, MBase); + If (strS2I(Temp) = MBase.Index) and (Session.User.Access(MBase.PostACS)) Then Begin + + Case MBase.BaseType of + 0 : MsgBase := New(PMsgBaseJAM, Init); + 1 : MsgBase := New(PMsgBaseSquish, Init); + End; + + MsgBase^.SetMsgPath (MBase.Path + MBase.FileName); + + If MsgBase^.OpenMsgBase Then Begin + + AssignMessageData(MsgBase); + + Temp[0] := #25; + Move (QwkHdr.UpTo, Temp[1], 25); + MsgBase^.SetTo(strStripR(Temp, ' ')); + Move (QwkHdr.Subject, Temp[1], 25); + MsgBase^.SetSubj(strStripR(Temp, ' ')); + Move (QwkHdr.ReferNum, Temp[1], 6); + Temp[0] := #6; + MsgBase^.SetRefer(strS2I(strStripR(Temp, ' '))); + + Move(QwkHdr.NumChunk, Temp[1], 6); + Chunks := strS2I(Temp) - 1; + + For A := 1 to Chunks Do Begin + BlockRead(DataFile, Temp[1], 128); + Temp[0] := #128; + Temp := strStripR(Temp, ' '); + For B := 1 to Length(Temp) Do Begin + If Temp[B] = #227 Then Temp[B] := #13; + MsgBase^.DoChar(Temp[B]); + End; + End; + + If MBase.NetType > 0 Then Begin + MsgBase^.DoStringLn(#13 + '--- ' + mysSoftwareID + ' BBS v' + mysVersion + ' (' + OSID + ')'); + MsgBase^.DoStringLn(' * Origin: ' + ResolveOrigin(MBase) + ' (' + strAddr2Str(Config.NetAddress[MBase.NetAddr]) + ')'); + End; + + If MsgBase^.WriteMsg <> 0 Then; + MsgBase^.CloseMsgBase; + + Inc (Session.User.ThisUser.Posts); + End; + Dispose (MsgBase, Done); + Break; + End; + End; + Close (MBaseFile); + End; + + Close (DataFile); + CleanDirectory (Session.TempPath, ''); + + MBase := OldMBase; +End; + +Procedure TMsgBase.DownloadQWK (Data: String); +Type + QwkLRRec = Record + Base : Word; + Pos : LongInt; + End; +Var + Old : MBaseRec; + DataFile : File; + Temp : String; + QwkLR : QwkLRRec; + QwkLRFile : File of QwkLRRec; +Begin + If Session.User.ThisUser.QwkFiles Then + Session.FileBase.ExportFileList(True, True); + + Old := MBase; + Temp := strPadR('Produced By ' + mysSoftwareID + ' BBS v' + mysVersion + '. ' + CopyID, 128, ' '); + + Assign (DataFile, Session.TempPath + 'messages.dat'); + ReWrite (DataFile, 1); + BlockWrite (DataFile, Temp[1], 128); + Close (DataFile); + + Assign (QwkLRFile, Session.TempPath + 'qlr.dat'); + ReWrite (QwkLRFile); + + Reset (MBaseFile); + Read (MBaseFile, MBase); {Skip Email base} + + Session.io.OutFullLn (Session.GetPrompt(230)); + + TotalMsgs := 0; + TotalConf := 0; + Session.User.IgnoreGroup := Pos('/ALLGROUP', strUpper(Data)) > 0; + + While Not Eof(MBaseFile) Do Begin + Read (MBaseFile, MBase); + If Session.User.Access(MBase.ReadACS) Then Begin + GetMessageScan; + If MScan.QwkScan > 0 Then Begin + QwkLR.Base := FilePos(MBaseFile); + QwkLR.Pos := WriteMsgDAT; + Write (QwkLRFile, QwkLR); + End; + End; + End; + + WriteControlDAT; + + Close (QwkLRFile); + + If TotalMsgs > 0 Then Begin + Session.io.PromptInfo[1] := strI2S(TotalMsgs); + Session.io.PromptInfo[2] := strI2S(TotalConf); + Session.io.OutFullLn (Session.GetPrompt(233)); + + Temp := Config.qwkBBSID + '.qwk'; + + Session.io.OutFullLn (Session.GetPrompt(234)); + + Session.io.PromptInfo[1] := Temp; + + If Session.LocalMode Then Begin + Session.FileBase.ExecuteArchive (Config.QWKPath + Temp, Session.User.ThisUser.Archive, Session.TempPath + FileMask, 1); + Session.io.OutFullLn (Session.GetPrompt(235)); + End Else Begin + Session.FileBase.ExecuteArchive (Session.TempPath + Temp, Session.User.ThisUser.Archive, Session.TempPath + FileMask, 1); + Session.FileBase.SendFile (Session.TempPath + Temp); + End; + + If Session.io.GetYN (Session.GetPrompt(236), True) Then Begin + Reset (MBaseFile); + Reset (QwkLRFile); + + While Not Eof(QwkLRFile) Do Begin + Read (QwkLRFile, QwkLR); + Seek (MBaseFile, QwkLR.Base - 1); + Read (MBaseFile, MBase); + + Case MBase.BaseType of + 0 : MsgBase := New(PMsgBaseJAM, Init); + 1 : MsgBase := New(PMsgBaseSquish, Init); + End; + + MsgBase^.SetMsgPath (MBase.Path + MBase.FileName); + + If MsgBase^.OpenMsgBase Then Begin + MsgBase^.SetLastRead (Session.User.UserNum, QwkLR.Pos); + MsgBase^.CloseMsgBase; + End; + + Dispose(MsgBase, Done); + End; + Close (QwkLRFile); + End; + End Else + Session.io.OutFullLn (Session.GetPrompt(228)); + + Session.User.IgnoreGroup := False; + + Close (MBaseFile); + MBase := Old; + + CleanDirectory (Session.TempPath, ''); +End; + +(* +// not completed or documented. is this worth bothering with? pcboard style +Procedure TMsgBase.Message_QuickScan (Mode: Char); +{ C = Current G = Group A = All Areas/Groups } +{ ADD: /NEW show only if new } +{ ADD: /YOU show only if new to you } +{ ADD for prompts: /NOSCAN }{ ADD: /NOFOOT }{ ADD: /NOHEAD } +Const + Global_CurBase : LongInt = 1; + Global_TotalBases : LongInt = 1; + Global_TotalMsgs : LongInt = 0; + Global_NewMsgs : LongInt = 0; + Global_YourMsgs : LongInt = 0; + + Procedure ScanBase; + Var + MsgBase : PMsgBaseABS; + NewMsgs : LongInt; + YourMsgs : LongInt; + TotalMsgs : LongInt; + MsgTo : String; + Begin + Session.io.PromptInfo[1] := MBase.Name; + Session.io.PromptInfo[2] := strI2S(Global_CurBase); + Session.io.PromptInfo[3] := strI2S(Global_TotalBases); + + NewMsgs := 0; + YourMsgs := 0; + TotalMsgs := 0; + + Session.io.OutFull('Scanning |&1 [|&2 of |&3]...'); + + Case MBase.BaseType of + 0 : MsgBase := New(PMsgBaseJAM, Init); + 1 : MsgBase := New(PMsgBaseSquish, Init); + End; + + MsgBase^.SetMsgPath (MBase.Path + MBase.FileName); + + If MsgBase^.OpenMsgBase Then Begin + TotalMsgs := MsgBase^.NumberOfMsgs; + + MsgBase^.SeekFirst(MsgBase^.GetLastRead(Session.User.UserNum) + 1); + + While MsgBase^.SeekFound Do Begin + Inc (NewMsgs); + + MsgBase^.MsgStartUp; + + MsgTo := strUpper(MsgBase^.GetTo); + + If (MsgTo = strUpper(Session.User.ThisUser.Handle)) or (MsgTo = strUpper(Session.User.ThisUser.RealName)) Then + Inc(YourMsgs); + + MsgBase^.SeekNext; + End; + + MsgBase^.CloseMsgBase; + End; + + Inc (Global_TotalMsgs, TotalMsgs); + Inc (Global_NewMsgs, NewMsgs); + Inc (Global_YourMsgs, YourMsgs); + + Session.io.PromptInfo[4] := strI2S(TotalMsgs); + Session.io.PromptInfo[5] := strI2S(NewMsgs); + Session.io.PromptInfo[6] := strI2S(YourMsgs); + Session.io.PromptInfo[7] := strI2S(Global_TotalMsgs); + Session.io.PromptInfo[8] := strI2S(Global_NewMsgs); + Session.io.PromptInfo[9] := strI2S(Global_YourMsgs); + + Session.io.OutBS(Screen.CursorX, True); + Session.io.OutFullLn('|03Base: |14|$R40|&1 |03Total: |09|$L04|&4|03 New: |11|$L04|&5 |03Yours: |12|$L03|&6'); + + Dispose (MsgBase, Done); + End; + +Var + Old : MBaseRec; +Begin + If Not (Mode in ['A', 'C', 'G']) Then Mode := 'G'; + + Old := MBase; + Session.User.IgnoreGroup := Mode = 'A'; + + Session.io.OutFullLn ('|CRStarting Quick Scan|CR'); + + If Mode = 'C' Then + ScanBase + Else Begin + Reset (MBaseFile); + Read (MBaseFile, MBase); {skip email base} + + Global_TotalBases := FileSize(MBaseFile); + + While Not Eof(MBaseFile) Do Begin + Read (MBaseFile, MBase); + + Global_CurBase := FilePos(MBaseFile); + + If Session.User.Access(MBase.ReadACS) Then Begin + GetMessageScan; + If MScan.NewScan > 0 Then ScanBase; + End; + End; + + Close (MBaseFile); + End; + + Session.io.OutFullLn('|CRQuick Scan complete. |PA'); + + Session.User.IgnoreGroup := False; + MBase := Old; +End; +*) + +Function TMsgBase.SaveMessage (mArea: MBaseRec; mFrom, mTo, mSubj: String; mAddr: RecEchoMailAddr; mLines: Integer) : Boolean; +Var + SemFile : File; + Count : SmallInt; + Msg : PMsgBaseABS; +Begin +// things to do: +// 2) see if we can use assignmessagedata, etc +// 3) add autosig? if we cannot use the assignmsgdata things + Result := False; + + If Not OpenCreateBase(Msg, mArea) Then Exit; + + Msg^.StartNewMsg; + Msg^.SetLocal (True); + + If mArea.NetType > 0 Then Begin + If mArea.NetType = 2 Then Begin + Msg^.SetMailType (mmtNetMail); + Msg^.SetCrash (Config.netCrash); + Msg^.SetHold (Config.netHold); + Msg^.SetKillSent (Config.netKillSent); + Msg^.SetDest (mAddr); + End Else + Msg^.SetMailType (mmtEchoMail); + + Msg^.SetOrig(Config.NetAddress[mArea.NetAddr]); + + Case mArea.NetType of + 1 : Assign (SemFile, Config.SemaPath + 'echomail.now'); + 2 : Assign (SemFile, Config.SemaPath + 'netmail.now'); + 3 : Assign (SemFile, Config.SemaPath + 'newsmail.now'); + End; + + ReWrite (SemFile); + Close (SemFile); + End Else + Msg^.SetMailType (mmtNormal); + + Msg^.SetPriv (mArea.PostType = 1); + Msg^.SetDate (DateDos2Str(CurDateDos, 1)); + Msg^.SetTime (TimeDos2Str(CurDateDos, False)); + Msg^.SetFrom (mFrom); + Msg^.SetTo (mTo); + Msg^.SetSubj (mSubj); + + For Count := 1 to mLines Do + Msg^.DoStringLn(MsgText[Count]); + + If mArea.NetType > 0 Then Begin + Msg^.DoStringLn (#13 + '--- ' + mysSoftwareID + ' BBS v' + mysVersion + ' (' + OSID + ')'); + Msg^.DoStringLn (' * Origin: ' + ResolveOrigin(mArea) + ' (' + strAddr2Str(Config.NetAddress[mArea.NetAddr]) + ')'); + End; + + Msg^.WriteMsg; + Msg^.CloseMsgBase; + + Dispose (Msg, Done); + + Result := True; +End; + +Procedure TMsgBase.PostTextFile (Data: String; AllowCodes: Boolean); +Const + MaxLines = 10000; +Var + MBaseFile : File; + mName : String; + mArea : Word; + mFrom : String; + mTo : String; + mSubj : String; + mAddr : RecEchoMailAddr; + mLines : Integer; + InFile : Text; + TextBuf : Array[1..2048] of Char; + Buffer : Array[1..MaxLines] of ^String; + Str : String[79]; + Lines : Integer; + Pages : Integer; + Count : Integer; + Offset : Integer; + TempBase : MBaseRec; +Begin + mName := strWordGet(1, Data, ';'); + mArea := strS2I(strWordGet(2, Data, ';')); + mFrom := strWordGet(3, Data, ';'); + mTo := strWordGet(4, Data, ';'); + mSubj := strWordGet(5, Data, ';'); + + Str := strWordGet(6, Data, ';'); + If (Str = '') Then Str := '0:0/0'; + strStr2Addr (Str, mAddr); + + If FileExist(Config.DataPath + mName) Then + mName := Config.DataPath + mName + Else + If Not FileExist(mName) Then Begin + Session.SystemLog('AutoPost: ' + mName + ' not found'); + Exit; + End; + + Assign (MBaseFile, Config.DataPath + 'mbases.dat'); + ioReset (MBaseFile, SizeOf(MBaseRec), fmReadWrite + fmDenyNone); + + If Not ioSeek (MBaseFile, mArea) Then Begin + Close (MBaseFile); + Exit; + End; + + If Not ioRead (MBaseFile, TempBase) Then Begin + Close (MBaseFile); + Exit; + End; + + Close (MBaseFile); + + Assign (InFile, mName); + SetTextBuf (InFile, TextBuf, SizeOf(TextBuf)); + Reset (InFile); + + Lines := 0; + + While Not Eof(InFile) And (Lines < MaxLines) Do Begin + ReadLn (InFile, Str); + + If AllowCodes Then Str := Session.io.StrMci(Str); + + Inc (Lines); + New (Buffer[Lines]); + + Buffer[Lines]^ := Str; + End; + + Close (InFile); + + Pages := Lines DIV mysMaxMsgLines + 1; + + If (Lines MOD mysMaxMsgLines = 0) Then Dec(Pages); + + For Count := 1 to Pages Do Begin + Offset := mysMaxMsgLines * Pred(Count); + mLines := 0; + + While (Offset < Lines) and (mLines < mysMaxMsgLines) Do Begin + Inc (mLines); + Inc (Offset); + + MsgText[mLines] := Buffer[Offset]^; + End; + + If Pages > 1 Then + Str := mSubj + ' (' + strI2S(Count) + '/' + strI2S(Pages) + ')' + Else + Str := mSubj; + + If Not SaveMessage (TempBase, mFrom, mTo, Str, mAddr, mLines) Then Break; + End; + + While Lines > 0 Do Begin + Dispose (Buffer[Lines]); + Dec (Lines); + End; +End; + +Function TMsgBase.ResolveOrigin (Var mArea: MBaseRec) : String; +Var + Loc : Byte; + FN : String; + TF : Text; + Buf : Array[1..2048] of Char; + Str : String; + Count : LongInt; + Pick : LongInt; +Begin + Result := ''; + Loc := Pos('@RANDOM=', mArea.Origin); + + If Loc > 0 Then Begin + FN := strStripB(Copy(mArea.Origin, Loc + 8, 255), ' '); + + If Pos(PathChar, FN) = 0 Then FN := Config.DataPath + FN; + + FileMode := 66; + + Assign (TF, FN); + SetTextBuf (TF, Buf, SizeOf(Buf)); + Reset (TF); + + If IoResult <> 0 Then Exit; + + Count := 0; + + While Not Eof(TF) Do Begin + ReadLn (TF, Str); + + If strStripB(Str, ' ') = '' Then Continue; + + Inc (Count); + End; + + If Count = 0 Then Begin + Close (TF); + Exit; + End; + + Pick := Random(Count) + 1; + + Reset (TF); + + Count := 0; + + While Not Eof(TF) Do Begin + ReadLn (TF, Str); + + If strStripB(Str, ' ') = '' Then Continue; + + Inc (Count); + + If Count = Pick Then Begin + Result := Str; + Break; + End; + End; + + Close (TF); + End Else + Result := mArea.Origin; +End; + +End. diff --git a/mystic/bbs_msgbase_abs.pas b/mystic/bbs_msgbase_abs.pas new file mode 100644 index 0000000..3083cba --- /dev/null +++ b/mystic/bbs_msgbase_abs.pas @@ -0,0 +1,608 @@ +{$I M_OPS.PAS} +{$WARNINGS OFF} + +Unit BBS_MsgBase_ABS; + +Interface + +Uses + BBS_Common; + +Type + MsgMailType = (mmtNormal, mmtEchoMail, mmtNetMail); + + PMsgBaseABS = ^TMsgBaseABS; + TMsgBaseABS = Object + LastSoft : Boolean; + TempFile : String; + + Procedure EditMsgInit; Virtual; + Procedure EditMsgSave; Virtual; + + Constructor Init; {Initialize} + Destructor Done; Virtual; {Done} + Procedure SetMsgPath(MP: String); Virtual; {Set msg path/other info} + Function OpenMsgBase : Boolean; Virtual; {Open the message base} + Procedure CloseMsgBase; Virtual; {Close the message base} + Function CreateMsgBase(MaxMsg: Word; MaxDays: Word): Boolean; Virtual; + Function MsgBaseExists: Boolean; Virtual; {Does msg base exist} + Function LockMsgBase: Boolean; Virtual; {Lock the message base} + Function UnLockMsgBase: Boolean; Virtual; {Unlock the message base} + Procedure SetDest(Var Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Dest} + Procedure SetOrig(Var Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Orig} + Procedure SetFrom(Name: String); Virtual; {Set message from} + Procedure SetTo(Name: String); Virtual; {Set message to} + Procedure SetSubj(Str: String); Virtual; {Set message subject} + Procedure SetCost(SCost: Word); Virtual; {Set message cost} + Procedure SetRefer(SRefer: LongInt); Virtual; {Set message reference} + Procedure SetSeeAlso(SAlso: LongInt); Virtual; {Set message see also} + Procedure SetDate(SDate: String); Virtual; {Set message date} + Procedure SetTime(STime: String); Virtual; {Set message time} + Procedure SetLocal(LS: Boolean); Virtual; {Set local status} + Procedure SetRcvd(RS: Boolean); Virtual; {Set received status} + Procedure SetPriv(PS: Boolean); Virtual; {Set priveledge vs public status} + Procedure SetCrash(SS: Boolean); Virtual; {Set crash netmail status} + Procedure SetHold(SS: Boolean); Virtual; {Set hold netmail status} + Procedure SetKillSent(SS: Boolean); Virtual; {Set kill/sent netmail status} + Procedure SetSent(SS: Boolean); Virtual; {Set sent netmail status} + Procedure SetFAttach(SS: Boolean); Virtual; {Set file attach status} + Procedure SetReqRct(SS: Boolean); Virtual; {Set request receipt status} + Procedure SetReqAud(SS: Boolean); Virtual; {Set request audit status} + Procedure SetRetRct(SS: Boolean); Virtual; {Set return receipt status} + Procedure SetFileReq(SS: Boolean); Virtual; {Set file request status} + Procedure DoString(Str: String); Virtual; {Add string to message text} + Procedure DoChar(Ch: Char); Virtual; {Add character to message text} + Procedure DoStringLn(Str: String); Virtual; {Add string and newline to msg text} + Procedure DoKludgeLn(Str: String); Virtual; {Add ^A kludge line to msg} + Function WriteMsg: Word; Virtual; {Write msg to msg base} + Function GetChar: Char; Virtual; {Get msg text character} + Function EOM: Boolean; Virtual; {No more msg text} + Function GetString(MaxLen: Word): String; Virtual; {Get wordwrapped string} + Function GetNoKludgeStr(MaxLen: Word): String; Virtual; {Get ww str no ^A lines} + Function GetFrom: String; Virtual; {Get from name on current msg} + Function GetTo: String; Virtual; {Get to name on current msg} + Function GetSubj: String; Virtual; {Get subject on current msg} + Function GetCost: Word; Virtual; {Get cost of current msg} + Function GetDate: String; Virtual; {Get date of current msg} + Function GetTime: String; Virtual; {Get time of current msg} + Function GetRefer: LongInt; Virtual; {Get reply to of current msg} + Function GetSeeAlso: LongInt; Virtual; {Get see also of current msg} + Function GetNextSeeAlso: LongInt; Virtual; + Procedure SetNextSeeAlso(SAlso: LongInt); Virtual; + Function GetMsgNum: LongInt; Virtual; {Get message number} + Function GetTextLen: LongInt; Virtual; {Get text length} + Procedure GetOrig (Var Addr : RecEchoMailAddr); Virtual; {Get origin address} + Procedure GetDest (Var Addr : RecEchoMailAddr); Virtual; {Get destination address} + Function IsLocal: Boolean; Virtual; {Is current msg local} + Function IsCrash: Boolean; Virtual; {Is current msg crash} + Function IsKillSent: Boolean; Virtual; {Is current msg kill sent} + Function IsSent: Boolean; Virtual; {Is current msg sent} + Function IsFAttach: Boolean; Virtual; {Is current msg file attach} + Function IsReqRct: Boolean; Virtual; {Is current msg request receipt} + Function IsReqAud: Boolean; Virtual; {Is current msg request audit} + Function IsRetRct: Boolean; Virtual; {Is current msg a return receipt} + Function IsFileReq: Boolean; Virtual; {Is current msg a file request} + Function IsRcvd: Boolean; Virtual; {Is current msg received} + Function IsPriv: Boolean; Virtual; {Is current msg priviledged/private} + Function IsDeleted: Boolean; Virtual; {Is current msg deleted} + Function IsEchoed: Boolean; Virtual; {Is current msg unmoved echomail msg} + Function GetMsgLoc: LongInt; Virtual; {To allow reseeking to message} + Procedure SetMsgLoc(ML: LongInt); Virtual; {Reseek to message} + Procedure MsgStartUp; Virtual; {Do message set-up tasks} + Procedure MsgTxtStartUp; Virtual; {Do message text start up tasks} + Procedure StartNewMsg; Virtual; {Initialize for adding message} + Procedure SeekFirst(MsgNum: LongInt); Virtual; {Start msg seek} + Procedure SeekNext; Virtual; {Find next matching msg} + Procedure SeekPrior; Virtual; {Prior msg} + Function SeekFound: Boolean; Virtual; {Msg was found} + Procedure YoursFirst(Name: String; Handle: String); Virtual; {Seek your mail} + Procedure YoursNext; Virtual; {Seek next your mail} + Function YoursFound: Boolean; Virtual; {Message found} + Function GetHighMsgNum: LongInt; Virtual; {Get highest msg number} + Procedure SetMailType(MT: MsgMailType); Virtual; {Set message base type} + Function GetSubArea: Word; Virtual; {Get sub area number} + Procedure ReWriteHdr; Virtual; {Rewrite msg header after changes} + Procedure DeleteMsg; Virtual; {Delete current message} + Procedure SetEcho(ES: Boolean); Virtual; {Set echo status} + Function NumberOfMsgs: LongInt; Virtual; {Number of messages} + Function GetLastRead(UNum: LongInt): LongInt; Virtual; {Get last read for user num} + Procedure SetLastRead(UNum: LongInt; LR: LongInt); Virtual; {Set last read} + Function GetMsgDisplayNum: LongInt; Virtual; {Get msg number to display} + Function GetTxtPos: LongInt; Virtual; {Get indicator of msg text position} + Procedure SetTxtPos(TP: LongInt); Virtual; {Set text position} + Function GetHighActiveMsgNum: LongInt; Virtual; {Get highest active msg num} + Procedure SetTempFile (TF: String); + End; + +Implementation + +Procedure TMsgBaseABS.SetTempFile (TF: String); +Begin + TempFile := TF; +End; + +Constructor TMsgBaseABS.Init; +Begin +End; + +Destructor TMsgBaseABS.Done; +Begin +End; + +Procedure TMsgBaseABS.SetMsgPath(MP: String); +Begin +End; + +Function TMsgBaseABS.OpenMsgBase: Boolean; +Begin +End; + +Procedure TMsgBaseABS.CloseMsgBase; +Begin +End; + +Function TMsgBaseABS.LockMsgBase: Boolean; +Begin +End; + +Function TMsgBaseABS.UnLockMsgBase: Boolean; +Begin +End; + +Procedure TMsgBaseABS.SetDest(Var Addr: RecEchoMailAddr); +Begin +End; + +Procedure TMsgBaseABS.SetOrig(Var Addr: RecEchoMailAddr); +Begin +End; + +Procedure TMsgBaseABS.SetFrom(Name: String); +Begin +End; + +Procedure TMsgBaseABS.SetTo(Name: String); +Begin +End; + +Procedure TMsgBaseABS.SetSubj(Str: String); +Begin +End; + +Procedure TMsgBaseABS.SetCost(SCost: Word); +Begin +End; + +Procedure TMsgBaseABS.SetRefer(SRefer: LongInt); +Begin +End; + +Procedure TMsgBaseABS.SetSeeAlso(SAlso: LongInt); +Begin +End; + +Procedure TMsgBaseABS.SetDate(SDate: String); +Begin +End; + +Procedure TMsgBaseABS.SetTime(STime: String); +Begin +End; + +Procedure TMsgBaseABS.SetLocal(LS: Boolean); +Begin +End; + +Procedure TMsgBaseABS.SetRcvd(RS: Boolean); +Begin +End; + +Procedure TMsgBaseABS.SetPriv(PS: Boolean); +Begin +End; + +Procedure TMsgBaseABS.SetHold (SS: Boolean); +Begin +End; + +Procedure TMsgBaseABS.SetCrash(SS: Boolean); +Begin +End; + +Procedure TMsgBaseABS.SetKillSent(SS: Boolean); +Begin +End; + +Procedure TMsgBaseABS.SetSent(SS: Boolean); +Begin +End; + +Procedure TMsgBaseABS.SetFAttach(SS: Boolean); +Begin +End; + +Procedure TMsgBaseABS.SetReqRct(SS: Boolean); +Begin +End; + +Procedure TMsgBaseABS.SetReqAud(SS: Boolean); +Begin +End; + +Procedure TMsgBaseABS.SetRetRct(SS: Boolean); +Begin +End; + +Procedure TMsgBaseABS.SetFileReq(SS: Boolean); +Begin +End; + +Procedure TMsgBaseABS.DoString (Str: String); +Var + Count : SmallWord; +Begin + For Count := 1 to Length(Str) Do + DoChar(Str[Count]); +End; + +Procedure TMsgBaseABS.DoChar(Ch: Char); +Begin +End; + +Procedure TMsgBaseABS.DoStringLn(Str: String); +Begin + DoString(Str + #13); +// DoChar(#13); +End; + +Procedure TMsgBaseABS.DoKludgeLn(Str: String); +Begin + DoStringLn(Str); +End; + +Function TMsgBaseABS.WriteMsg: Word; +Begin +End; + +Function TMsgBaseABS.GetChar: Char; +Begin +End; + +Function TMsgBaseABS.EOM: Boolean; +Begin +End; + +Function TMsgBaseABS.GetString(MaxLen: Word): String; +(* + Var + WPos: LongInt; + WLen: Byte; + StrDone: Boolean; + TxtOver: Boolean; + StartSoft: Boolean; + CurrLen: Word; + PPos: LongInt; + TmpCh: Char; + OldPos: LongInt; + + Begin + If EOM Then + GetString := '' + Else + Begin + StrDone := False; + CurrLen := 0; + PPos := GetTxtPos; + WPos := GetTxtPos; + WLen := 0; + StartSoft := LastSoft; + LastSoft := True; + OldPos := GetTxtPos; + TmpCh := GetChar; + While ((Not StrDone) And (CurrLen < MaxLen) And (Not EOM)) Do + Begin + Case TmpCh of + #$00:; + #$0d: Begin + StrDone := True; + LastSoft := False; + End; + #$8d:; + #$0a:; + #$20: Begin + If ((CurrLen <> 0) or (Not StartSoft)) Then + Begin + Inc(CurrLen); + WLen := CurrLen; + GetString[CurrLen] := TmpCh; + WPos := GetTxtPos; + End + Else + StartSoft := False; + End; + Else + Begin + Inc(CurrLen); + GetString[CurrLen] := TmpCh; + End; + End; + If Not StrDone Then + Begin + OldPos := GetTxtPos; + TmpCh := GetChar; + End; + End; + If StrDone Then + Begin + GetString[0] := Chr(CurrLen); + End + Else + If EOM Then + Begin + GetString[0] := Chr(CurrLen); + End + Else + Begin + If WLen = 0 Then + Begin + GetString[0] := Chr(CurrLen); + SetTxtPos(OldPos); + End + Else + Begin + GetString[0] := Chr(WLen); + SetTxtPos(WPos); + End; + End; + End; +*) +{ the above stuff could be used to write universal GETSTRING and GETCHAR } +{ functions for ANY message base format. } +Begin +End; + +Procedure TMsgBaseABS.SeekFirst(MsgNum: LongInt); +Begin +End; + +Procedure TMsgBaseABS.SeekNext; +Begin +End; + +Function TMsgBaseABS.GetFrom: String; +Begin +End; + +Function TMsgBaseABS.GetTo: String; +Begin +End; + +Function TMsgBaseABS.GetSubj: String; +Begin +End; + +Function TMsgBaseABS.GetCost: Word; +Begin +End; + +Function TMsgBaseABS.GetDate: String; +Begin +End; + +Function TMsgBaseABS.GetTime: String; +Begin +End; + +Function TMsgBaseABS.GetRefer: LongInt; +Begin +End; + +Function TMsgBaseABS.GetSeeAlso: LongInt; +Begin +End; + +Function TMsgBaseABS.GetMsgNum: LongInt; +Begin +End; + +Function TMsgBaseABS.GetTextLen : LongInt; +Begin +End; + +Procedure TMsgBaseABS.GetOrig(Var Addr: RecEchoMailAddr); +Begin +End; + +Procedure TMsgBaseABS.GetDest(Var Addr: RecEchoMailAddr); +Begin +End; + +Function TMsgBaseABS.IsLocal: Boolean; +Begin +End; + +Function TMsgBaseABS.IsCrash: Boolean; +Begin +End; + +Function TMsgBaseABS.IsKillSent: Boolean; +Begin +End; + +Function TMsgBaseABS.IsSent: Boolean; +Begin +End; + +Function TMsgBaseABS.IsFAttach: Boolean; +Begin +End; + +Function TMsgBaseABS.IsReqRct: Boolean; +Begin +End; + +Function TMsgBaseABS.IsReqAud: Boolean; +Begin +End; + +Function TMsgBaseABS.IsRetRct: Boolean; +Begin +End; + +Function TMsgBaseABS.IsFileReq: Boolean; +Begin +End; + +Function TMsgBaseABS.IsRcvd: Boolean; +Begin +End; + +Function TMsgBaseABS.IsPriv: Boolean; +Begin +End; + +Function TMsgBaseABS.IsDeleted: Boolean; +Begin +End; + +Function TMsgBaseABS.IsEchoed: Boolean; +Begin +End; + +Function TMsgBaseABS.GetMsgLoc: LongInt; +Begin +End; + +Procedure TMsgBaseABS.SetMsgLoc(ML: LongInt); +Begin +End; + +Procedure TMsgBaseABS.MsgStartUp; +Begin +End; + +Procedure TMsgBaseABS.MsgTxtStartUp; +Begin +End; + +Procedure TMsgBaseABS.YoursFirst(Name: String; Handle: String); +Begin +End; + +Procedure TMsgBaseABS.YoursNext; +Begin +End; + +Function TMsgBaseABS.YoursFound: Boolean; +Begin +End; + +Function TMsgBaseABS.CreateMsgBase(MaxMsg: Word; MaxDays: Word): Boolean; +Begin +End; + +Function TMsgBaseABS.MsgBaseExists: Boolean; +Begin +End; + +Procedure TMsgBaseABS.StartNewMsg; +Begin +End; + +Function TMsgBaseABS.GetHighMsgNum: LongInt; +Begin +End; + +Function TMsgBaseABS.SeekFound: Boolean; +Begin +End; + +Procedure TMsgBaseABS.SetMailType(MT: MsgMailType); +Begin +End; + +Function TMsgBaseABS.GetSubArea: Word; +Begin + GetSubArea := 0; +End; + +Procedure TMsgBaseABS.ReWriteHdr; +Begin +End; + +Procedure TMsgBaseABS.DeleteMsg; +Begin +End; + +Procedure TMsgBaseABS.SetEcho(ES: Boolean); +Begin +End; + +Procedure TMsgBaseABS.SeekPrior; +Begin +End; + +Function TMsgBaseABS.NumberOfMsgs: LongInt; +Begin +End; + +Function TMsgBaseABS.GetLastRead(UNum: LongInt): LongInt; +Begin +End; + +Procedure TMsgBaseABS.SetLastRead(UNum: LongInt; LR: LongInt); +Begin +End; + +Function TMsgBaseABS.GetMsgDisplayNum: LongInt; +Begin + GetMsgDisplayNum := GetMsgNum; +End; + +Function TMsgBaseABS.GetTxtPos: LongInt; +Begin + GetTxtPos := 0; +End; + +Procedure TMsgBaseABS.SetTxtPos(TP: LongInt); +Begin +End; + +Procedure TMsgBaseABS.SetNextSeeAlso(SAlso: LongInt); +Begin +End; + +Function TMsgBaseABS.GetNextSeeAlso: LongInt; +Begin + GetNextSeeAlso:=0; +End; + +Function TMsgBaseABS.GetNoKludgeStr(MaxLen: Word): String; +Begin + Result := GetString(MaxLen); + While ((Length(Result) > 0) and (Result[1] = #1) and (Not EOM)) Do + Result := GetString(MaxLen); +End; + +Function TMsgBaseABS.GetHighActiveMsgNum: LongInt; +Begin + SeekFirst(GetHighMsgNum); + + If Not SeekFound Then + SeekPrior; + + If SeekFound Then + GetHighActiveMsgNum := GetMsgNum + Else + GetHighActiveMsgNum := 0; +End; + +Procedure TMsgBaseABS.EditMsgInit; +Begin +End; + +Procedure TMsgBaseABS.EditMsgSave; +Begin +End; + +End. diff --git a/mystic/bbs_msgbase_ansi.pas b/mystic/bbs_msgbase_ansi.pas new file mode 100644 index 0000000..c2ea0cf --- /dev/null +++ b/mystic/bbs_msgbase_ansi.pas @@ -0,0 +1,486 @@ +{$I M_OPS.PAS} + +Unit BBS_MsgBase_Ansi; + +// mystic 2 ansi reader + +Interface + +Uses + m_Strings, + BBS_Common; + +Type + PtrMessageLine = ^RecMessageLine; + RecMessageLine = Array[1..80] of Record + Ch : Char; + Attr : Byte; + End; + + RecMessageAnsi = Array[1..mysMaxMsgLines] of RecMessageLine; + // make this a pointer? + + TMsgBaseAnsi = Class + GotAnsi : Boolean; + GotPipe : Boolean; + PipeCode : String[2]; + Owner : Pointer; + Data : RecMessageAnsi; + Code : String; + Lines : Word; + CurY : Word; + Escape : Byte; + SavedX : Byte; + SavedY : Byte; + CurX : Byte; + Attr : Byte; + + Procedure SetFore (Color: Byte); + Procedure SetBack (Color: Byte); + Procedure ResetControlCode; + Function ParseNumber (Var Line: String) : Integer; + Function AddChar (Ch: Char) : Boolean; + Procedure MoveXY (X, Y: Word); + Procedure MoveUP; + Procedure MoveDOWN; + Procedure MoveLEFT; + Procedure MoveRIGHT; + Procedure MoveCursor; + Procedure CheckCode (Ch: Char); + Procedure ProcessChar (Ch: Char); + + Constructor Create (O: Pointer; Msg: Boolean); + Destructor Destroy; Override; + Function ProcessBuf (Var Buf; BufLen: Word) : Boolean; + Procedure WriteLine (Line: Word; Flush: Boolean); + Procedure DrawLine (Y, Line: Word; Flush: Boolean); + Procedure DrawPage (pStart, pEnd, pLine: Word); + Procedure Clear; + Function GetLineText (Line: Word) : String; + Procedure SetLineColor (Attr, Line: Word); + Procedure RemoveLine (Line: Word); + End; + +Implementation + +Uses + BBS_Core; + +Constructor TMsgBaseAnsi.Create (O: Pointer; Msg: Boolean); +Begin + Inherited Create; + + Owner := O; + + Clear; +End; + +Destructor TMsgBaseAnsi.Destroy; +Begin + Inherited Destroy; +End; + +Procedure TMsgBaseAnsi.Clear; +Begin + Lines := 1; + CurX := 1; + CurY := 1; + Attr := 7; + GotAnsi := False; + GotPipe := False; + PipeCode := ''; + + FillChar (Data, SizeOf(Data), 0); + + ResetControlCode; +End; + +Procedure TMsgBaseAnsi.ResetControlCode; +Begin + Escape := 0; + Code := ''; +End; + +Procedure TMsgBaseAnsi.SetFore (Color: Byte); +Begin + Attr := Color + ((Attr SHR 4) AND 7) * 16; +End; + +Procedure TMsgBaseAnsi.SetBack (Color: Byte); +Begin + Attr := (Attr AND $F) + Color * 16; +End; + +Function TMsgBaseAnsi.AddChar (Ch: Char) : Boolean; +Begin + AddChar := False; + + Data[CurY][CurX].Ch := Ch; + Data[CurY][CurX].Attr := Attr; + + If CurX < 80 Then + Inc (CurX) + Else Begin + If CurY = mysMaxMsgLines Then Begin + AddChar := True; + Exit; + End Else Begin + CurX := 1; + Inc (CurY); + End; + End; +End; + +Function TMsgBaseAnsi.ParseNumber (Var Line: String) : Integer; +Var + A : Integer; + B : LongInt; + Str1 : String; + Str2 : String; +Begin + Str1 := Line; + + Val(Str1, A, B); + + If B = 0 Then + Str1 := '' + Else Begin + Str2 := Copy(Str1, 1, B - 1); + + Delete (Str1, 1, B); + Val (Str2, A, B); + End; + + Line := Str1; + ParseNumber := A; +End; + +Procedure TMsgBaseAnsi.MoveXY (X, Y: Word); +Begin + If X > 80 Then X := 80; + If Y > mysMaxMsgLines Then Y := mysMaxMsgLines; + + CurX := X; + CurY := Y; +End; + +Procedure TMsgBaseAnsi.MoveCursor; +Var + X : Byte; + Y : Byte; +Begin + X := ParseNumber(Code); + Y := ParseNumber(Code); + + If X = 0 Then X := 1; + If Y = 0 Then Y := 1; + + MoveXY (X, Y); + + ResetControlCode; +End; + +Procedure TMsgBaseAnsi.MoveUP; +Var + NewPos : Integer; + Offset : Integer; +Begin + Offset := ParseNumber (Code); + + If Offset = 0 Then Offset := 1; + + If (CurY - Offset) < 1 Then + NewPos := 1 + Else + NewPos := CurY - Offset; + + MoveXY (CurX, NewPos); + + ResetControlCode; +End; + +Procedure TMsgBaseAnsi.MoveDOWN; +Var + NewPos : Byte; +Begin + NewPos := ParseNumber (Code); + + If NewPos = 0 Then NewPos := 1; + + MoveXY (CurX, CurY + NewPos); + + ResetControlCode; +End; + +Procedure TMsgBaseAnsi.MoveLEFT; +Var + NewPos : Integer; + Offset : Integer; +Begin + Offset := ParseNumber (Code); + + If Offset = 0 Then Offset := 1; + + If CurX - Offset < 1 Then + NewPos := 1 + Else + NewPos := CurX - Offset; + + MoveXY (NewPos, CurY); + + ResetControlCode; +End; + +Procedure TMsgBaseAnsi.MoveRIGHT; +Var + NewPos : Integer; + Offset : Integer; +Begin + Offset := ParseNumber(Code); + + If Offset = 0 Then Offset := 1; + + If CurX + Offset > 80 Then Begin + NewPos := (CurX + Offset) - 80; + Inc (CurY); + End Else + NewPos := CurX + Offset; + + MoveXY (NewPos, CurY); + + ResetControlCode; +End; + +Procedure TMsgBaseAnsi.CheckCode (Ch: Char); +Var + Temp1 : Byte; + Temp2 : Byte; +Begin + Case Ch of + '0'..'9', ';', '?' : Code := Code + Ch; + 'H', 'f' : MoveCursor; + 'A' : MoveUP; + 'B' : MoveDOWN; + 'C' : MoveRIGHT; + 'D' : MoveLEFT; + 'J' : Begin + {ClearScreenData;} + ResetControlCode; + End; + 'K' : Begin + Temp1 := CurX; + For Temp2 := CurX To 80 Do + AddChar(' '); + MoveXY (Temp1, CurY); + ResetControlCode; + End; + 'h' : ResetControlCode; + 'm' : Begin + While Length(Code) > 0 Do Begin + Case ParseNumber(Code) of + 0 : Attr := 7; + 1 : Attr := Attr OR $08; + 5 : Attr := Attr OR $80; + 7 : Begin + Attr := Attr AND $F7; + Attr := ((Attr AND $70) SHR 4) + ((Attr AND $7) SHL 4) + Attr AND $80; + End; + 30: Attr := (Attr AND $F8) + 0; + 31: Attr := (Attr AND $F8) + 4; + 32: Attr := (Attr AND $F8) + 2; + 33: Attr := (Attr AND $F8) + 6; + 34: Attr := (Attr AND $F8) + 1; + 35: Attr := (Attr AND $F8) + 5; + 36: Attr := (Attr AND $F8) + 3; + 37: Attr := (Attr AND $F8) + 7; + 40: SetBack (0); + 41: SetBack (4); + 42: SetBack (2); + 43: SetBack (6); + 44: SetBack (1); + 45: SetBack (5); + 46: SetBack (3); + 47: SetBack (7); + End; + End; + + ResetControlCode; + End; + 's' : Begin + SavedX := CurX; + SavedY := CurY; + ResetControlCode; + End; + 'u' : Begin + MoveXY (SavedX, SavedY); + ResetControlCode; + End; + Else + ResetControlCode; + End; +End; + +Procedure TMsgBaseAnsi.ProcessChar (Ch: Char); +Begin + If GotPipe Then Begin + PipeCode := PipeCode + Ch; + + If Length(PipeCode) = 2 Then Begin + + Case strS2I(PipeCode) of + 00.. + 15 : SetFore(strS2I(PipeCode)); + 16.. + 23 : SetBack(strS2I(PipeCode) - 16); + Else + AddChar('|'); + AddChar(PipeCode[1]); + AddChar(PipeCode[2]); + End; + + GotPipe := False; + PipeCode := ''; + End; + + Exit; + End; + + Case Escape of + 0 : Begin + Case Ch of + #27 : Escape := 1; + #9 : MoveXY (CurX + 8, CurY); + #12 : {Edit.ClearScreenData}; + Else + If Ch = '|' Then + GotPipe := True + Else + AddChar (Ch); + + ResetControlCode; + End; + End; + 1 : If Ch = '[' Then Begin + Escape := 2; + Code := ''; + GotAnsi := True; + End Else + Escape := 0; + 2 : CheckCode(Ch); + Else + ResetControlCode; + End; +End; + +Function TMsgBaseAnsi.ProcessBuf (Var Buf; BufLen: Word) : Boolean; +Var + Count : Word; + Buffer : Array[1..4096] of Char Absolute Buf; +Begin + Result := False; + + For Count := 1 to BufLen Do Begin + If CurY > Lines Then Lines := CurY; + Case Buffer[Count] of + #10 : If CurY = mysMaxMsgLines Then Begin + Result := True; + GotAnsi := False; + Break; + End Else + Inc (CurY); + #13 : CurX := 1; + #26 : Begin + Result := True; + Break; + End; + Else + ProcessChar(Buffer[Count]); + End; + End; +End; + +Procedure TMsgBaseAnsi.WriteLine (Line: Word; Flush: Boolean); +Var + Count : Byte; +Begin + If Line > Lines Then Exit; + + For Count := 1 to 79 Do Begin + Session.io.BufAddStr (Session.io.Attr2Ansi(Data[Line][Count].Attr)); + If Data[Line][Count].Ch in [#0, #255] Then + Session.io.BufAddStr(' ') + Else + Session.io.BufAddStr (Data[Line][Count].Ch); + End; + + Session.io.BufAddStr(#13#10); + + If Flush Then Session.io.BufFlush; + + Inc (Session.io.PausePtr); +End; + +Procedure TMsgBaseAnsi.DrawLine (Y, Line: Word; Flush: Boolean); +Var + Count : Byte; +Begin + Session.io.AnsiGotoXY(1, Y); + + If Line > Lines Then Begin + Session.io.BufAddStr(Session.io.Attr2Ansi(Session.io.ScreenInfo[1].A)); + Session.io.AnsiClrEOL; + End Else + For Count := 1 to 80 Do Begin + Session.io.BufAddStr (Session.io.Attr2Ansi(Data[Line][Count].Attr)); + If Data[Line][Count].Ch in [#0, #255] Then + Session.io.BufAddStr(' ') + Else + Session.io.BufAddStr (Data[Line][Count].Ch); + End; + + If Flush Then Session.io.BufFlush; +End; + +Procedure TMsgBaseAnsi.DrawPage (pStart, pEnd, pLine: Word); +Var + Count : Word; +Begin + For Count := pStart to pEnd Do Begin + DrawLine (Count, pLine, False); + Inc (pLine); + End; + + Session.io.BufFlush; +End; + +Function TMsgBaseAnsi.GetLineText (Line: Word) : String; +Var + Count : Word; +Begin + Result := ''; + + If Line > Lines Then Exit; + + For Count := 1 to 80 Do + Result := Result + Data[Line][Count].Ch; +End; + +Procedure TMsgBaseAnsi.SetLineColor (Attr, Line: Word); +Var + Count : Word; +Begin + For Count := 1 to 80 Do + Data[Line][Count].Attr := Attr; +End; + +Procedure TMsgBaseAnsi.RemoveLine (Line: Word); +Var + Count : Word; +Begin + For Count := Line to Lines - 1 Do + Data[Count] := Data[Count + 1]; + + Dec (Lines); +End; + +End. diff --git a/mystic/bbs_msgbase_jam.pas b/mystic/bbs_msgbase_jam.pas new file mode 100644 index 0000000..b1486a0 --- /dev/null +++ b/mystic/bbs_msgbase_jam.pas @@ -0,0 +1,1831 @@ +{$I M_OPS.PAS} + +// things to do: +// 2. make readmsgtext read directly into msgtext record? +// 3. make squish use temporary buffer file +// 4. remove all mkcrap stuff... basically rewrite everything 1 by 1 + +Unit BBS_MsgBase_JAM; + +Interface + +Uses + m_Strings, + bbs_Common, + bbs_MsgBase_ABS; + +Const + JamIdxBufSize = 200; + JamSubBufSize = 4000; + JamTxtBufSize = 4000; + TxtSubBufSize = 2000; + + Jam_Local = $00000001; + Jam_InTransit = $00000002; + Jam_Priv = $00000004; + Jam_Rcvd = $00000008; + Jam_Sent = $00000010; + Jam_KillSent = $00000020; + Jam_AchvSent = $00000040; + Jam_Hold = $00000080; + Jam_Crash = $00000100; + Jam_Imm = $00000200; + Jam_Direct = $00000400; + Jam_Gate = $00000800; + Jam_Freq = $00001000; + Jam_FAttch = $00002000; + Jam_TruncFile = $00004000; + Jam_KillFile = $00008000; + Jam_RcptReq = $00010000; + Jam_ConfmReq = $00020000; + Jam_Orphan = $00040000; + Jam_Encrypt = $00080000; + Jam_Compress = $00100000; + Jam_Escaped = $00200000; + Jam_FPU = $00400000; + Jam_TypeLocal = $00800000; + Jam_TypeEcho = $01000000; + Jam_TypeNet = $02000000; + Jam_NoDisp = $20000000; + Jam_Locked = $40000000; + Jam_Deleted = $80000000; + +Type + JamHdrType = Record + Signature : Array[1..4] of Char; + Created : LongInt; + ModCounter : LongInt; + ActiveMsgs : LongInt; + PwdCRC : LongInt; + BaseMsgNum : LongInt; + Extra : Array[1..1000] of Char; + End; + + JamMsgHdrType = Record + Signature : Array[1..4] of Char; + Rev : Word; + Resvd : Word; + SubFieldLen : LongInt; + TimesRead : LongInt; + MsgIdCrc : LongInt; + ReplyCrc : LongInt; + ReplyTo : LongInt; + ReplyFirst : LongInt; + ReplyNext : LongInt; + DateWritten : LongInt; + DateRcvd : LongInt; + DateArrived : LongInt; + MsgNum : LongInt; + Attr1 : LongInt; + Attr2 : LongInt; + TextOfs : LongInt; + TextLen : LongInt; + PwdCrc : LongInt; + Cost : LongInt; + End; + + JamIdxType = Record + MsgToCrc : LongInt; + HdrLoc : LongInt; + End; + + JamLastType = Record + NameCrc : LongInt; + UserNum : LongInt; + LastRead : LongInt; + HighRead : LongInt; + End; + + JamIdxArrayType = Array[0..JamIdxBufSize] of JamIdxType; + JamSubBuffer = Array[1..JamSubBufSize] of Char; + JamTxtBufType = Array[0..JamTxtBufSize] Of Char; + + HdrType = Record + JamHdr : JamMsgHdrType; + SubBuf : JamSubBuffer; + End; + + JamMsgType = Record + HdrFile : File; + TxtFile : File; + IdxFile : File; + MsgPath : String[128]; + BaseHdr : JamHdrType; + Dest : RecEchoMailAddr; + Orig : RecEchoMailAddr; + MsgFrom : String[65]; + MsgTo : String[65]; + MsgSubj : String[100]; + MsgDate : String[8]; + MsgTime : String[5]; + CurrMsgNum : LongInt; + YourName : String[35]; + YourHdl : String[35]; + NameCrc : LongInt; + HdlCrc : LongInt; + TxtPos : LongInt; + TxtEnd : LongInt; + TxtBufStart : LongInt; + TxtRead : {$IFDEF FPC} Word {$ELSE} LongInt {$ENDIF}; + IdxRead : {$IFDEF FPC} Word {$ELSE} LongInt {$ENDIF}; + MailType : MsgMailType; + BufFile : File; + LockCount : LongInt; + IdxStart : LongInt; + TxtSubBuf : Array[0..TxtSubBufSize] of Char; + TxtSubChars : Integer; + End; + + PMsgBaseJAM = ^TMsgBaseJAM; + TMsgBaseJAM = Object(TMsgBaseABS) + JM : ^JamMsgType; + MsgHdr : ^HdrType; + JamIdx : ^JamIdxArrayType; + TxtBuf : ^JamTxtBufType; + Error : Word; + + Procedure EditMsgInit; Virtual; + Procedure EditMsgSave; Virtual; + Constructor Init; {Initialize} + Destructor Done; Virtual; {Done} + Procedure SetMsgPath(St: String); Virtual; {Set netmail path} + Function GetHighMsgNum: LongInt; Virtual; {Get highest netmail msg number in area} + Function LockMsgBase: Boolean; Virtual; {Lock the message base} + Function UnLockMsgBase: Boolean; Virtual; {Unlock the message base} + Procedure SetDest(Var Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Dest} + Procedure SetOrig(Var Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Orig} + Procedure SetFrom(Name: String); Virtual; {Set message from} + Procedure SetTo(Name: String); Virtual; {Set message to} + Procedure SetSubj(Str: String); Virtual; {Set message subject} + Procedure SetCost(SCost: Word); Virtual; {Set message cost} + Procedure SetRefer(SRefer: LongInt); Virtual; {Set message reference} + Procedure SetSeeAlso(SAlso: LongInt); Virtual; {Set message see also} + Function GetNextSeeAlso: LongInt; Virtual; + Procedure SetNextSeeAlso(SAlso: LongInt); Virtual; + Procedure SetDate(SDate: String); Virtual; {Set message date} + Procedure SetTime(STime: String); Virtual; {Set message time} + Procedure SetLocal(LS: Boolean); Virtual; {Set local status} + Procedure SetRcvd(RS: Boolean); Virtual; {Set received status} + Procedure SetPriv(PS: Boolean); Virtual; {Set priveledge vs public status} + Procedure SetHold(SS: Boolean); Virtual; {set hold netmail status} + Procedure SetCrash(SS: Boolean); Virtual; {Set crash netmail status} + Procedure SetKillSent(SS: Boolean); Virtual; {Set kill/sent netmail status} + Procedure SetSent(SS: Boolean); Virtual; {Set sent netmail status} + Procedure SetFAttach(SS: Boolean); Virtual; {Set file attach status} + Procedure SetReqRct(SS: Boolean); Virtual; {Set request receipt status} + Procedure SetReqAud(SS: Boolean); Virtual; {Set request audit status} + Procedure SetRetRct(SS: Boolean); Virtual; {Set return receipt status} + Procedure SetFileReq(SS: Boolean); Virtual; {Set file request status} + Procedure DoString(Str: String); Virtual; {Add string to message text} + Procedure DoChar(Ch: Char); Virtual; {Add character to message text} + Procedure DoStringLn(Str: String); Virtual; {Add string and newline to msg text} + Procedure DoKludgeLn(Str: String); Virtual; {Add ^AKludge line to msg} + Function WriteMsg: Word; Virtual; + Function GetChar: Char; Virtual; + Procedure MsgStartUp; Virtual; {set up msg for reading} + Function EOM: Boolean; Virtual; {No more msg text} + Function GetString(MaxLen: Word): String; Virtual; {Get wordwrapped string} + Procedure SeekFirst(MsgNum: LongInt); Virtual; {Seek msg number} + Procedure SeekNext; Virtual; {Find next matching msg} + Procedure SeekPrior; Virtual; {Seek prior matching msg} + Function GetFrom: String; Virtual; {Get from name on current msg} + Function GetTo: String; Virtual; {Get to name on current msg} + Function GetSubj: String; Virtual; {Get subject on current msg} + Function GetCost: Word; Virtual; {Get cost of current msg} + Function GetDate: String; Virtual; {Get date of current msg} + Function GetTime: String; Virtual; {Get time of current msg} + Function GetRefer: LongInt; Virtual; {Get reply to of current msg} + Function GetSeeAlso: LongInt; Virtual; {Get see also of current msg} + Function GetMsgNum: LongInt; Virtual; {Get message number} + Procedure GetOrig(Var Addr: RecEchoMailAddr); Virtual; {Get origin address} + Procedure GetDest(Var Addr: RecEchoMailAddr); Virtual; {Get destination address} + Function GetTextLen : LongInt; Virtual; {returns length of text in msg} + Function IsLocal: Boolean; Virtual; {Is current msg local} + Function IsCrash: Boolean; Virtual; {Is current msg crash} + Function IsKillSent: Boolean; Virtual; {Is current msg kill sent} + Function IsSent: Boolean; Virtual; {Is current msg sent} + Function IsFAttach: Boolean; Virtual; {Is current msg file attach} + Function IsReqRct: Boolean; Virtual; {Is current msg request receipt} + Function IsReqAud: Boolean; Virtual; {Is current msg request audit} + Function IsRetRct: Boolean; Virtual; {Is current msg a return receipt} + Function IsFileReq: Boolean; Virtual; {Is current msg a file request} + Function IsRcvd: Boolean; Virtual; {Is current msg received} + Function IsPriv: Boolean; Virtual; {Is current msg priviledged/private} + Function IsDeleted: Boolean; Virtual; {Is current msg deleted} + Function IsEchoed: Boolean; Virtual; {Msg should be echoed} + Function GetMsgLoc: LongInt; Virtual; {Msg location} + Procedure SetMsgLoc(ML: LongInt); Virtual; {Msg location} + Procedure YoursFirst(Name: String; Handle: String); Virtual; {Seek your mail} + Procedure YoursNext; Virtual; {Seek next your mail} + Function YoursFound: Boolean; Virtual; {Message found} + Procedure StartNewMsg; Virtual; + Function OpenMsgBase : Boolean; Virtual; + Procedure CloseMsgBase; Virtual; + Function MsgBaseExists: Boolean; Virtual; {Does msg base exist} + Function CreateMsgBase(MaxMsg: Word; MaxDays: Word): Boolean; Virtual; + Function SeekFound: Boolean; Virtual; + Procedure SetMailType(MT: MsgMailType); Virtual; {Set message base type} + Function GetSubArea: Word; Virtual; {Get sub area number} + Procedure ReWriteHdr; Virtual; {Rewrite msg header after changes} + Procedure DeleteMsg; Virtual; {Delete current message} + Function NumberOfMsgs: LongInt; Virtual; {Number of messages} + Function GetLastRead(UNum: LongInt): LongInt; Virtual; {Get last read for user num} + Procedure SetLastRead(UNum: LongInt; LR: LongInt); Virtual; {Set last read} + Procedure MsgTxtStartUp; Virtual; {Do message text start up tasks} + Function GetTxtPos: LongInt; Virtual; {Get indicator of msg text position} + Procedure SetTxtPos(TP: LongInt); Virtual; {Set text position} + Procedure SetAttr1(Mask: LongInt; St: Boolean); {Set attribute 1} + Function ReadIdx: Word; + Function WriteIdx: Word; + Procedure AddSubField(id: Word; Data: String); + Function FindLastRead(Var LastFile: File; UNum: LongInt): LongInt; + Function ReReadIdx(Var IdxLoc : LongInt) : Word; + End; + +Function JamStrCrc(St: String): LongInt; + +Implementation + +Uses + DOS, + m_CRC, + m_FileIO, + m_DateTime, + MKCRAP; // REMOVE THIS ASAP. + +Type + SubFieldPTR = ^SubFieldType; + SubFieldType = Record + LoId : Word; + HiId : Word; + DataLen : LongInt; + Data : Array[1..1000] of Char; + End; + +Constructor TMsgBaseJAM.Init; +Begin + New(JM); + New(JamIdx); + New(MsgHdr); { this new here messes everything up } + New(TxtBuf); + If ((JM = Nil) Or (JamIdx = Nil) or (MsgHdr = Nil) or (TxtBuf = Nil)) Then Begin + If JM <> Nil Then Dispose(JM); + If JamIdx <> Nil Then Dispose(JamIdx); + If MsgHdr <> Nil Then Dispose(MsgHdr); + If TxtBuf <> Nil Then Dispose(TxtBuf); + Fail; + Exit; + End Else Begin + FillChar(JM^, SizeOf(JM^), #0); + JM^.MsgPath := ''; + JM^.IdxStart := -30; + JM^.IdxRead := 0; + Error := 0; + End; +End; + +Destructor TMsgBaseJAM.Done; +Begin + If JM <> Nil Then Dispose(JM); + If JamIdx <> Nil Then Dispose(JamIdx); + If MsgHdr <> Nil Then Dispose(MsgHdr); + If TxtBuf <> Nil Then Dispose(TxtBuf); +End; + +Function JamStrCrc(St: String): LongInt; + Var + i: Word; + crc: LongInt; + + Begin + Crc := -1; + For i := 1 to Length(St) Do + Crc := Crc32(Ord(LoCase(St[i])), Crc); + JamStrCrc := Crc; + End; + + +Procedure TMsgBaseJAM.SetMsgPath(St: String); + Begin + JM^.MsgPath := Copy(St, 1, 124); + End; + + +Function TMsgBaseJAM.GetHighMsgNum: LongInt; + Begin + GetHighMsgNum := JM^.BaseHdr.BaseMsgNum + FileSize(JM^.IdxFile) - 1; + End; + + +Procedure TMsgBaseJAM.SetDest(Var Addr: RecEchoMailAddr); + Begin + JM^.Dest := Addr; + End; + + +Procedure TMsgBaseJAM.SetOrig(Var Addr: RecEchoMailAddr); + Begin + JM^.Orig := Addr; + End; + + +Procedure TMsgBaseJAM.SetFrom(Name: String); + Begin + JM^.MsgFrom := Name; + End; + + +Procedure TMsgBaseJAM.SetTo(Name: String); + Begin + JM^.MsgTo := Name; + End; + + +Procedure TMsgBaseJAM.SetSubj(Str: String); + Begin + JM^.MsgSubj := Str; + End; + + +Procedure TMsgBaseJAM.SetCost(SCost: Word); + Begin + MsgHdr^.JamHdr.Cost := SCost; + End; + + +Procedure TMsgBaseJAM.SetRefer(SRefer: LongInt); + Begin + MsgHdr^.JamHdr.ReplyTo := SRefer; + End; + + +Procedure TMsgBaseJAM.SetSeeAlso(SAlso: LongInt); + Begin + MsgHdr^.JamHdr.ReplyFirst := SAlso; + End; + + +Procedure TMsgBaseJAM.SetDate(SDate: String); + Begin + JM^.MsgDate := SDate; + End; + + +Procedure TMsgBaseJAM.SetTime(STime: String); + Begin + JM^.MsgTime := STime; + End; + + +Procedure TMsgBaseJAM.SetAttr1(Mask: LongInt; St: Boolean); + Begin + If St Then + MsgHdr^.JamHdr.Attr1 := MsgHdr^.JamHdr.Attr1 Or Mask + Else + MsgHdr^.JamHdr.Attr1 := MsgHdr^.JamHdr.Attr1 And (Not Mask); + End; + +Procedure TMsgBaseJAM.SetLocal(LS: Boolean); +Begin + SetAttr1(Jam_Local, LS); +End; + +Procedure TMsgBaseJAM.SetRcvd(RS: Boolean); +Begin + SetAttr1(Jam_Rcvd, RS); +End; + +Procedure TMsgBaseJAM.SetPriv(PS: Boolean); +Begin + SetAttr1(Jam_Priv, PS); +End; + +Procedure TMsgBaseJAM.SetHold(SS: Boolean); +Begin + SetAttr1 (Jam_Hold, SS); +End; + +Procedure TMsgBaseJAM.SetCrash(SS: Boolean); +Begin + SetAttr1(Jam_Crash, SS); +End; + +Procedure TMsgBaseJAM.SetKillSent(SS: Boolean); +Begin + SetAttr1(Jam_KillSent, SS); +End; + +Procedure TMsgBaseJAM.SetSent(SS: Boolean); +Begin + SetAttr1(Jam_Sent, SS); +End; + +Procedure TMsgBaseJAM.SetFAttach(SS: Boolean); +Begin + SetAttr1(Jam_FAttch, SS); +End; + +Procedure TMsgBaseJAM.SetReqRct(SS: Boolean); +Begin + SetAttr1(Jam_RcptReq, SS); +End; + +Procedure TMsgBaseJAM.SetReqAud(SS: Boolean); +Begin + SetAttr1(Jam_ConfmReq, SS); +End; + +Procedure TMsgBaseJAM.SetRetRct(SS: Boolean); +Begin +End; + +Procedure TMsgBaseJAM.SetFileReq(SS: Boolean); +Begin + SetAttr1(Jam_Freq, SS); +End; + + +Procedure TMsgBaseJAM.DoString(Str: String); +Var + i: Word; +Begin + i := 1; + While i <= Length(Str) Do Begin + DoChar(Str[i]); + Inc(i); + End; +End; + +Procedure TMsgBaseJAM.DoChar(Ch: Char); +Var +// TmpStr: String; + NumWrite: Word; +Begin + Case ch of + #13: LastSoft := False; + #10:; + Else + LastSoft := True; + End; + If (JM^.TxtPos - JM^.TxtBufStart) >= JamTxtBufSize Then Begin + If JM^.TxtBufStart = 0 Then Begin +// GetDir(0, TmpStr); +// TmpStr := GetTempName(TmpStr); + Assign(JM^.BufFile, TempFile); + FileMode := fmReadWrite + fmDenyNone; + ReWrite(JM^.BufFile, 1); + End; + NumWrite := JM^.TxtPos - JM^.TxtBufStart; + BlockWrite(JM^.BufFile, TxtBuf^, NumWrite); + Error := IoResult; + JM^.TxtBufStart := FileSize(JM^.BufFile); + End; + TxtBuf^[JM^.TxtPos - JM^.TxtBufStart] := Ch; + Inc(JM^.TxtPos); +End; + +Procedure TMsgBaseJAM.DoStringLn(Str: String); +Begin + DoString(Str); + DoChar(#13); +End; + +Procedure TMsgBaseJAM.DoKludgeLn(Str: String); +Var + TmpStr: String; + +Begin + If Str[1] = #1 Then + Str := Copy(Str,2,255); + + If Copy(Str,1,3) = 'PID' Then Begin + TmpStr := strStripL(Copy(Str,4,255),':'); + TmpStr := Copy(strStripB(TmpStr, ' '),1,40); + AddSubField(7, TmpStr); + End Else + If Copy(Str,1,5) = 'MSGID' Then Begin + TmpStr := strStripL(Copy(Str,6,255),':'); + TmpStr := Copy(strStripB(TmpStr,' '),1,100); + AddSubField(4, TmpStr); + MsgHdr^.JamHdr.MsgIdCrc := JamStrCrc(TmpStr); + End Else + If Copy(Str,1,4) = 'INTL' Then Begin {ignore} + End Else + If Copy(Str,1,4) = 'TOPT' Then Begin {ignore} + End Else + If Copy(Str,1,4) = 'FMPT' Then Begin {ignore} + End Else + If Copy(Str,1,5) = 'REPLY' Then Begin + TmpStr := strStripL(Copy(Str,8,255),':'); + TmpStr := Copy(strStripB(TmpStr,' '),1,100); + AddSubField(5, TmpStr); + MsgHdr^.JamHdr.ReplyCrc := JamStrCrc(TmpStr); + End Else + If Copy(Str,1,4) = 'PATH' Then Begin + TmpStr := strStripL(Copy(Str,5,255),':'); + TmpStr := strStripB(TmpStr,' '); + AddSubField(2002, TmpStr); + End Else Begin + AddSubField(2000, strStripB(Str,' ')); + End; +End; + +Procedure TMsgBaseJAM.AddSubField(id: Word; Data: String); +Type + SubFieldPTR = ^SubFieldType; + SubFieldType = Record + LoID : Word; + HiID : Word; + DataLen : LongInt; + Data : Array[1..256] of Char; + End; + + Var + SubField: SubFieldPTR; + + Begin + SubField := SubFieldPTR(@MsgHdr^.SubBuf[MsgHdr^.JamHdr.SubFieldLen + 1]); + If (MsgHdr^.JamHdr.SubFieldLen + 8 + Length(Data) < JamSubBufSize) Then + Begin + Inc(MsgHdr^.JamHdr.SubFieldLen, 8 + Length(Data)); + SubField^.LoId := Id; + SubField^.HiId := 0; + SubField^.DataLen := Length(Data); + Move(Data[1], SubField^.Data[1], Length(Data)); + End; + End; + +Procedure TMsgBaseJAM.EditMsgInit; +Begin + JM^.TxtBufStart := 0; + JM^.TxtPos := 0; + + MsgHdr^.JamHdr.SubFieldLen := 0; + FillChar(MsgHdr^.SubBuf, SizeOf(MsgHdr^.SubBuf), #0); +End; + +(* +Procedure TMsgBaseJAM.EditMsgSave; +Var +{$IFDEF MSDOS} + iPos : Word; +{$ELSE} + iPos : LongInt; +{$ENDIF} + TmpIdx : JamIdxType; + TmpHdr : JamMsgHdrType; + IdxLoc : LongInt; +Begin + MsgHdr^.JamHdr.TextOfs := FileSize(JM^.TxtFile); + MsgHdr^.JamHdr.TextLen := JM^.TxtPos; + + If JM^.TxtBufStart > 0 Then Begin + iPos := JM^.TxtPos - JM^.TxtBufStart; + + BlockWrite(JM^.BufFile, TxtBuf^, iPos); + + Seek (JM^.BufFile, 0); + Seek (JM^.TxtFile, FileSize(JM^.TxtFile)); + + While Not Eof(JM^.BufFile) Do Begin + BlockRead (JM^.BufFile, TxtBuf^, SizeOf(TxtBuf^), iPos); + + JM^.TxtBufStart := FilePos(JM^.TxtFile); + JM^.TxtRead := iPos; + + BlockWrite(JM^.TxtFile, TxtBuf^, iPos); + End; + + Close(JM^.BufFile); + Erase(JM^.BufFile); + End Else Begin {Write text using TxtBuf only} + Seek (JM^.Txtfile, FileSize(JM^.TxtFile)); + BlockWrite (JM^.TxtFile, TxtBuf^, JM^.TxtPos); + JM^.TxtRead := JM^.TxtPos; + End; + + If ReReadIdx(IdxLoc) = 0 Then; + + TmpHdr := MsgHdr^.JamHdr; + TmpHdr.Attr1 := TmpHdr.Attr1 AND Jam_Deleted; + TmpHdr.TextLen := 0; + + Seek (JM^.HdrFile, JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc); + BlockWrite (JM^.HdrFile, TmpHdr, SizeOf(TmpHdr)); + + JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc := FileSize(JM^.HdrFile); + + If Length(JM^.MsgTo) > 0 Then AddSubField(3, JM^.MsgTo); + If Length(JM^.MsgFrom) > 0 Then AddSubField(2, JM^.MsgFrom); + If Length(JM^.MsgSubj) > 0 Then Begin + If IsFileReq Then + AddSubField(11, JM^.MsgSubj) + Else + AddSubField(6, JM^.MsgSubj); + End; + + If ((JM^.Dest.Zone <> 0) or (JM^.Dest.Net <> 0) or + (JM^.Dest.Node <> 0) or (JM^.Dest.Point <> 0)) Then + AddSubField(1, AddrType2Str(JM^.Dest)); + + If ((JM^.Orig.Zone <> 0) or (JM^.Orig.Net <> 0) or + (JM^.Orig.Node <> 0) or (JM^.Orig.Point <> 0)) Then + AddSubField(0, AddrType2Str(JM^.Orig)); + + JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc := JamStrCrc(JM^.MsgTo); + + Seek (JM^.HdrFile, JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc); + BlockWrite (JM^.HdrFile, MsgHdr^, SizeOf(MsgHdr^.JamHdr) + MsgHdr^.JamHdr.SubFieldLen); + + If WriteIdx = 0 Then; + If UnLockMsgBase Then; +End; +*) + +Procedure TMsgBaseJAM.EditMsgSave; +Var + iPos : LongInt; + WriteError : Word; +// TmpIdx : JamIdxType; + TmpHdr : JamMsgHdrType; + IdxLoc : LongInt; +Begin + WriteError := 0; + + MsgHdr^.JamHdr.TextOfs := FileSize(JM^.TxtFile); + MsgHdr^.JamHdr.TextLen := JM^.TxtPos; + + If JM^.TxtBufStart > 0 Then Begin {Write text using buffer file} + iPos := JM^.TxtPos - JM^.TxtBufStart; + BlockWrite(JM^.BufFile, TxtBuf^, iPos); + WriteError := IoResult; + If WriteError = 0 Then Begin + Seek(JM^.BufFile, 0); + WriteError := IoResult; + End; + If WriteError = 0 Then Begin + Seek(JM^.TxtFile, FileSize(JM^.TxtFile)); + WriteError := IoResult; + End; + While ((Not Eof(JM^.BufFile)) and (WriteError = 0)) Do Begin {copy buffer file to text file} + BlockRead(JM^.BufFile, TxtBuf^, SizeOf(TxtBuf^), iPos); + WriteError := IoResult; + If WriteError = 0 Then Begin + JM^.TxtBufStart := FilePos(JM^.TxtFile); + JM^.TxtRead := iPos; + BlockWrite(JM^.TxtFile, TxtBuf^, iPos); + Error := IoResult; + End; + End; + Close(JM^.BufFile); + Error := IoResult; + Erase(JM^.BufFile); + Error := IoResult; + End Else Begin {Write text using TxtBuf only} + Seek(JM^.Txtfile, FileSize(JM^.TxtFile)); + WriteError := IoResult; + If WriteError = 0 Then Begin + BlockWrite(JM^.TxtFile, TxtBuf^, JM^.TxtPos); + WriteError := IoResult; + JM^.TxtRead := JM^.TxtPos; + End; + End; + + If WriteError = 0 Then Begin {Add subfields as needed} + If Length(JM^.MsgTo) > 0 Then AddSubField(3, JM^.MsgTo); + If Length(JM^.MsgFrom) > 0 Then AddSubField(2, JM^.MsgFrom); + If Length(JM^.MsgSubj) > 0 Then Begin + If IsFileReq Then + AddSubField(11, JM^.MsgSubj) + Else + AddSubField(6, JM^.MsgSubj); + End; + If ((JM^.Dest.Zone <> 0) or (JM^.Dest.Net <> 0) or + (JM^.Dest.Node <> 0) or (JM^.Dest.Point <> 0)) Then + AddSubField(1, strAddr2Str(JM^.Dest)); + If ((JM^.Orig.Zone <> 0) or (JM^.Orig.Net <> 0) or + (JM^.Orig.Node <> 0) or (JM^.Orig.Point <> 0)) Then + AddSubField(0, strAddr2Str(JM^.Orig)); + WriteError := IoResult; + End; + + If ReReadIdx(IdxLoc) = 0 Then; + +(* new shit begin *) + TmpHdr := MsgHdr^.JamHdr; + TmpHdr.TextLen := 0; + TmpHdr.Attr1 := Jam_Deleted; + + Seek (JM^.HdrFile, JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc); + BlockWrite (JM^.HdrFile, TmpHdr, SizeOf(TmpHdr)); + +(* new shit end *) + + JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc := FileSize(JM^.HdrFile); + JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc := JamStrCrc(JM^.MsgTo); + + Seek (JM^.HdrFile, FileSize(JM^.HdrFile)); + BlockWrite (JM^.HdrFile, MsgHdr^, SizeOf(MsgHdr^.JamHdr) + MsgHdr^.JamHdr.SubFieldLen); + + If WriteIdx = 0 Then; + + If UnLockMsgBase Then; {unlock msg base} +End; + +Function TMsgBaseJAM.WriteMsg: Word; + Var + DT: DateTime; + WriteError: Word; + i: longint; + TmpIdx: JamIdxType; + +Begin + WriteError := 0; + If LastSoft Then Begin + DoChar(#13); + DoChar(#10); + End; + If WriteError = 0 Then Begin + MsgHdr^.JamHdr.Signature[1] := 'J';{Set signature} + MsgHdr^.JamHdr.Signature[2] := 'A'; + MsgHdr^.JamHdr.Signature[3] := 'M'; + MsgHdr^.JamHdr.Signature[4] := #0; + Case JM^.MailType of + mmtNormal : SetAttr1 (Jam_TypeLocal, True); + mmtEchoMail : SetAttr1 (Jam_TypeEcho, True); + mmtNetMail : SetAttr1 (Jam_TypeNet, True); + End; + MsgHdr^.JamHdr.Rev := 1; + MsgHdr^.JamHdr.DateArrived := ToUnixDate(CurDateDos); {Get date processed} + + DT.Year := strS2I(Copy(JM^.MsgDate, 7, 2)); {Convert date written} + DT.Month := strS2I(Copy(JM^.MsgDate, 1, 2)); + DT.Day := strS2I(Copy(JM^.MsgDate, 4, 2)); + + If DT.Year < 80 Then + Inc(DT.Year, 2000) + Else + Inc(DT.Year, 1900); + + DT.Sec := 0; + DT.Hour := strS2I(Copy(JM^.MsgTime, 1, 2)); + DT.Min := strS2I(Copy(JM^.MsgTime, 4, 2)); + + MsgHdr^.JamHdr.DateWritten := DTToUnixDate(DT); + End; + + If WriteError = 0 Then Begin {Lock message base for update} + If Not LockMsgBase Then + WriteError := 5; + End; + If WriteError = 0 Then Begin {Handle message text} + MsgHdr^.JamHdr.TextOfs := FileSize(JM^.TxtFile); + MsgHdr^.JamHdr.MsgNum := GetHighMsgNum + 1; + MsgHdr^.Jamhdr.TextLen := JM^.TxtPos; + If JM^.TxtBufStart > 0 Then Begin {Write text using buffer file} + i := JM^.TxtPos - JM^.TxtBufStart; + BlockWrite(JM^.BufFile, TxtBuf^, i); {write buffer to file} + WriteError := IoResult; + If WriteError = 0 Then Begin {seek start of buffer file} + Seek(JM^.BufFile, 0); + WriteError := IoResult; + End; + If WriteError = 0 Then Begin {seek end of text file} + Seek(JM^.TxtFile, FileSize(JM^.TxtFile)); + WriteError := IoResult; + End; + While ((Not Eof(JM^.BufFile)) and (WriteError = 0)) Do Begin {copy buffer file to text file} + BlockRead(JM^.BufFile, TxtBuf^, SizeOf(TxtBuf^), i); + WriteError := IoResult; + If WriteError = 0 Then Begin + JM^.TxtBufStart := FilePos(JM^.TxtFile); + JM^.TxtRead := i; + BlockWrite(JM^.TxtFile, TxtBuf^, i); + Error := IoResult; + End; + End; + Close(JM^.BufFile); + Error := IoResult; + Erase(JM^.BufFile); + Error := IoResult; + End Else Begin {Write text using TxtBuf only} + Seek(JM^.Txtfile, FileSize(JM^.TxtFile)); + WriteError := IoResult; + If WriteError = 0 Then + Begin + BlockWrite(JM^.TxtFile, TxtBuf^, JM^.TxtPos); + WriteError := IoResult; + JM^.TxtRead := JM^.TxtPos; + End; + End; + If WriteError = 0 Then {Add index record} + Begin + TmpIdx.HdrLoc := FileSize(JM^.HdrFile); + TmpIdx.MsgToCrc := JamStrCrc(JM^.MsgTo); + Seek(JM^.IdxFile, FileSize(JM^.IdxFile)); + WriteError := IoResult; + End; + If WriteError = 0 Then {write index record} + Begin + BlockWrite(JM^.IdxFile, TmpIdx, 1); + WriteError := IoResult; + End; + If WriteError = 0 Then Begin {Add subfields as needed} + If Length(JM^.MsgTo) > 0 Then AddSubField(3, JM^.MsgTo); + If Length(JM^.MsgFrom) > 0 Then AddSubField(2, JM^.MsgFrom); + If Length(JM^.MsgSubj) > 0 Then Begin + If IsFileReq Then + AddSubField(11, JM^.MsgSubj) + Else + AddSubField(6, JM^.MsgSubj); + End; + If ((JM^.Dest.Zone <> 0) or (JM^.Dest.Net <> 0) or + (JM^.Dest.Node <> 0) or (JM^.Dest.Point <> 0)) Then + AddSubField(1, strAddr2Str(JM^.Dest)); + If ((JM^.Orig.Zone <> 0) or (JM^.Orig.Net <> 0) or + (JM^.Orig.Node <> 0) or (JM^.Orig.Point <> 0)) Then + AddSubField(0, strAddr2Str(JM^.Orig)); + Seek(JM^.HdrFile, FileSize(JM^.HdrFile)); {Seek to end of .jhr file} + WriteError := IoResult; + End; + If WriteError = 0 Then Begin {write msg header} + BlockWrite(JM^.HdrFile, MsgHdr^, SizeOf(MsgHdr^.JamHdr) + + MsgHdr^.JamHdr.SubFieldLen); + WriteError := IoResult; + End; + If WriteError = 0 Then Begin {update msg base header} + Inc(JM^.BaseHdr.ActiveMsgs); + Inc(JM^.BaseHdr.ModCounter); + End; + If UnLockMsgBase Then; {unlock msg base} + End; + WriteMsg := WriteError; {return result of writing msg} + End; + + +Function TMsgBaseJAM.GetChar: Char; +Begin + If JM^.TxtPos < 0 Then Begin + GetChar := JM^.TxtSubBuf[JM^.TxtSubChars + JM^.TxtPos]; + Inc(JM^.TxtPos); + If JM^.TxtPos >= 0 Then + JM^.TxtPos := MsgHdr^.JamHdr.TextOfs; + End Else Begin + If ((JM^.TxtPos < JM^.TxtBufStart) Or + (JM^.TxtPos >= JM^.TxtBufStart + JM^.TxtRead)) Then Begin + JM^.TxtBufStart := JM^.TxtPos - 80; + If JM^.TxtBufStart < 0 Then JM^.TxtBufStart := 0; + Seek(JM^.TxtFile, JM^.TxtBufStart); + Error := IoResult; + If Error = 0 Then Begin + BlockRead(JM^.TxtFile, TxtBuf^, SizeOf(TxtBuf^), JM^.TxtRead); + Error := IoResult; + End; + End; + GetChar := TxtBuf^[JM^.TxtPos - JM^.TxtBufStart]; + Inc(JM^.TxtPos); + End; +End; + +(* +Procedure TMsgBaseJAM.AddTxtSub(St: String); + Var + i: Word; + + Begin + For i := 1 to Length(St) Do + Begin + If JM^.TxtSubChars <= TxtSubBufSize Then + Begin + JM^.TxtSubBuf[JM^.TxtSubChars] := St[i]; + Inc(JM^.TxtSubChars); + End; + End; + If JM^.TxtSubChars <= TxtSubBufSize Then + Begin + JM^.TxtSubBuf[JM^.TxtSubChars] := #13; + Inc(JM^.TxtSubChars); + End; + End; +*) + +Procedure TMsgBaseJAM.MsgStartUp; + Var + SubCtr: LongInt; + SubPtr: SubFieldPTR; + NumRead: LongInt; + DT: DateTime; + IdxLoc: LongInt; + TmpStr: String; +{ TmpAddr: AddrType;} + + Begin + Error := 0; + LastSoft := False; + JM^.MsgFrom := ''; + JM^.MsgTo := ''; + JM^.MsgSubj := ''; + JM^.TxtSubChars := 0; + If SeekFound Then Begin + Error := ReReadIdx(IdxLoc); + If Error = 0 Then Begin + Seek(JM^.HdrFile, JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc); + Error := IoResult; + End; + If Error = 0 Then Begin + BlockRead(JM^.HdrFile, MsgHdr^, SizeOf(MsgHdr^), NumRead); + Error := IoResult; + End; + If Error = 0 Then Begin + UnixToDt(MsgHdr^.JamHdr.DateWritten, DT); + + JM^.MsgDate := strZero(DT.Month) + '-' + strZero(DT.Day) + '-' + Copy(strI2S(DT.Year), 3, 2); + JM^.MsgTime := strZero(DT.Hour) + ':' + strZero(DT.Min); + + SubCtr := 1; + While ((SubCtr <= MsgHdr^.JamHdr.SubFieldLen) and + (SubCtr < JamSubBufSize)) Do + Begin + SubPtr := SubFieldPTR(@MsgHdr^.SubBuf[SubCtr]); + Inc(SubCtr, SubPtr^.DataLen + 8); + Case(SubPtr^.LoId) Of + 0: Begin {Orig} + FillChar(JM^.Orig, SizeOf(JM^.Orig), #0); + TmpStr[0] := Chr(SubPtr^.DataLen and $ff); + If Ord(TmpStr[0]) > 128 Then TmpStr[0] := #128; + Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0])); + If strStr2Addr(TmpStr, JM^.Orig) Then; + End; + 1: Begin {Dest} + FillChar(JM^.Dest, SizeOf(JM^.Dest), #0); + TmpStr[0] := Chr(SubPtr^.DataLen and $ff); + If Ord(TmpStr[0]) > 128 Then + TmpStr[0] := #128; + Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0])); + If strStr2Addr(TmpStr, JM^.Dest) Then; + End; + 2: Begin {MsgFrom} + JM^.MsgFrom[0] := Chr(SubPtr^.DataLen and $ff); + If Ord(JM^.MsgFrom[0]) > 65 Then + JM^.MsgFrom[0] := #65; + Move(SubPtr^.Data, JM^.MsgFrom[1], Ord(JM^.MsgFrom[0])); + End; + 3: Begin {MsgTo} + JM^.MsgTo[0] := Chr(SubPtr^.DataLen and $ff); + If Ord(JM^.MsgTo[0]) > 65 Then JM^.MsgTo[0] := #65; + Move(SubPtr^.Data, JM^.MsgTo[1], Ord(JM^.MsgTo[0])); + End; +(* + 4: Begin {MsgId} + TmpStr[0] := Chr(SubPtr^.DataLen and $ff); + If Ord(TmpStr[0]) > 240 Then + TmpSTr[0] := #240; + Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0])); + AddTxtSub(#1'MSGID: ' + TmpStr); + End; +*) +(* + 5: Begin {Reply} + TmpStr[0] := Chr(SubPtr^.DataLen and $ff); + If Ord(TmpStr[0]) > 240 Then + TmpSTr[0] := #240; + Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0])); + AddTxtSub(#1'REPLY: ' + TmpStr); + End; +*) + 6: Begin {MsgSubj} + JM^.MsgSubj[0] := Chr(SubPtr^.DataLen and $ff); + If Ord(JM^.MsgSubj[0]) > 100 Then + JM^.MsgSubj[0] := #100; + Move(SubPtr^.Data, JM^.MsgSubj[1], Ord(JM^.MsgSubj[0])); + End; +(* + 7: Begin {PID} + TmpStr[0] := Chr(SubPtr^.DataLen and $ff); + If Ord(TmpStr[0]) > 240 Then + TmpSTr[0] := #240; + Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0])); + AddTxtSub(#1'PID: ' + TmpStr); + End; +*) +(* + 8: Begin {VIA} + TmpStr[0] := Chr(SubPtr^.DataLen and $ff); + If Ord(TmpStr[0]) > 240 Then + TmpSTr[0] := #240; + Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0])); + AddTxtSub(#1'Via ' + TmpStr); + End; +*) + 9: Begin {File attached} + If IsFAttach Then Begin + JM^.MsgSubj[0] := Chr(SubPtr^.DataLen and $ff); + If Ord(JM^.MsgSubj[0]) > 100 Then + JM^.MsgSubj[0] := #100; + Move(SubPtr^.Data, JM^.MsgSubj[1], Ord(JM^.MsgSubj[0])); + End + End; + 11: Begin {File request} + If IsFileReq Then + Begin + JM^.MsgSubj[0] := Chr(SubPtr^.DataLen and $ff); + If Ord(JM^.MsgSubj[0]) > 100 Then + JM^.MsgSubj[0] := #100; + Move(SubPtr^.Data, JM^.MsgSubj[1], Ord(JM^.MsgSubj[0])); + End + End; +(* + 2000: Begin {Unknown kludge} + TmpStr[0] := Chr(SubPtr^.DataLen and $ff); + If Ord(TmpStr[0]) > 240 Then + TmpSTr[0] := #240; + Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0])); + AddTxtSub(#1 + TmpStr); + End; +*) +(* + 2001: Begin {SEEN-BY} + TmpStr[0] := Chr(SubPtr^.DataLen and $ff); + If Ord(TmpStr[0]) > 240 Then + TmpSTr[0] := #240; + Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0])); + AddTxtSub(#1'SEEN-BY: ' + TmpStr); + End; +*) +(* + 2002: Begin {PATH} + TmpStr[0] := Chr(SubPtr^.DataLen and $ff); + If Ord(TmpStr[0]) > 240 Then + TmpSTr[0] := #240; + Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0])); + AddTxtSub(#1'PATH: ' + TmpStr); + End; +*) +(* + 2003: Begin {FLAGS} + TmpStr[0] := Chr(SubPtr^.DataLen and $ff); + If Ord(TmpStr[0]) > 240 Then + TmpSTr[0] := #240; + Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0])); + AddTxtSub(#1'FLAGS: ' + TmpStr); + End; +*) + End; + End; + End; + End; + End; + +Procedure TMsgBaseJAM.MsgTxtStartUp; +Begin + LastSoft := False; + JM^.TxtEnd := MsgHdr^.JamHdr.TextOfs + MsgHdr^.JamHdr.TextLen - 1; + + If JM^.TxtSubChars > 0 Then + JM^.TxtPos := - JM^.TxtSubChars + Else + JM^.TxtPos := MsgHdr^.JamHdr.TextOfs; +End; + +Function TMsgBaseJAM.GetString(MaxLen: Word): String; + Var + WPos: LongInt; + WLen: Byte; + StrDone: Boolean; +// TxtOver: Boolean; + StartSoft: Boolean; + CurrLen: Word; +// PPos: LongInt; + TmpCh: Char; + + Begin + StrDone := False; + CurrLen := 0; +// PPos := JM^.TxtPos; + WPos := 0; + WLen := 0; + StartSoft := LastSoft; + LastSoft := True; + TmpCh := GetChar; + While ((Not StrDone) And (CurrLen <= MaxLen) And (Not EOM)) Do Begin + Case TmpCh of + #$00:; + #$0d: Begin + StrDone := True; + LastSoft := False; + End; + #$8d:; + #$0a:; + #$20: Begin + If ((CurrLen <> 0) or (Not StartSoft)) Then + Begin + Inc(CurrLen); + WLen := CurrLen; + GetString[CurrLen] := TmpCh; + WPos := JM^.TxtPos; + End + Else + StartSoft := False; + End; + Else + Begin + Inc(CurrLen); + GetString[CurrLen] := TmpCh; + End; + End; + If Not StrDone Then + TmpCh := GetChar; + End; + If StrDone Then + Begin + GetString[0] := Chr(CurrLen); + End + Else + If EOM Then + Begin + GetString[0] := Chr(CurrLen); + End + Else + Begin + If WLen = 0 Then + Begin + GetString[0] := Chr(CurrLen); + Dec(JM^.TxtPos); + End + Else + Begin + GetString[0] := Chr(WLen); + JM^.TxtPos := WPos; + End; + End; + End; + + +Function TMsgBaseJAM.EOM: Boolean; + Begin + EOM := (((JM^.TxtPos < MsgHdr^.JamHdr.TextOfs) Or + (JM^.TxtPos > JM^.TxtEnd)) And (JM^.TxtPos >= 0)); + End; + +(* +Function TMsgBaseJAM.WasWrap: Boolean; + Begin + WasWrap := LastSoft; + End; +*) + +Function TMsgBaseJAM.GetFrom: String; {Get from name on current msg} + Begin + GetFrom := JM^.MsgFrom; + End; + + +Function TMsgBaseJAM.GetTo: String; {Get to name on current msg} + Begin + GetTo := JM^.MsgTo; + End; + + +Function TMsgBaseJAM.GetSubj: String; {Get subject on current msg} + Begin + GetSubj := JM^.MsgSubj; + End; + + +Function TMsgBaseJAM.GetCost: Word; {Get cost of current msg} + Begin + GetCost := MsgHdr^.JamHdr.Cost; + End; + + +Function TMsgBaseJAM.GetDate: String; {Get date of current msg} + Begin + GetDate := JM^.MsgDate; + End; + + +Function TMsgBaseJAM.GetTime: String; {Get time of current msg} + Begin + GetTime := JM^.MsgTime; + End; + + +Function TMsgBaseJAM.GetRefer: LongInt; {Get reply to of current msg} + Begin + GetRefer := MsgHdr^.JamHdr.ReplyTo; + End; + + +Function TMsgBaseJAM.GetSeeAlso: LongInt; {Get see also of current msg} + Begin + GetSeeAlso := MsgHdr^.JamHdr.ReplyFirst; + End; + + +Function TMsgBaseJAM.GetMsgNum: LongInt; {Get message number} + Begin + GetMsgNum := MsgHdr^.JamHdr.MsgNum; + End; + + +Procedure TMsgBaseJAM.GetOrig(Var Addr: RecEchoMailAddr); {Get origin address} + Begin + Addr := JM^.Orig; + End; + + +Procedure TMsgBaseJAM.GetDest(Var Addr: RecEchoMailAddr); {Get destination address} + Begin + Addr := JM^.Dest; + End; + +Function TMsgBaseJAM.GetTextLen : LongInt; {returns length of text in msg} +Begin + GetTextLen := MsgHdr^.JamHdr.TextLen; +End; + +Function TMsgBaseJAM.IsLocal: Boolean; {Is current msg local} + Begin + IsLocal := (MsgHdr^.JamHdr.Attr1 and Jam_Local) <> 0; + End; + + +Function TMsgBaseJAM.IsCrash: Boolean; {Is current msg crash} + Begin + IsCrash := (MsgHdr^.JamHdr.Attr1 and Jam_Crash) <> 0; + End; + + +Function TMsgBaseJAM.IsKillSent: Boolean; {Is current msg kill sent} + Begin + IsKillSent := (MsgHdr^.JamHdr.Attr1 and Jam_KillSent) <> 0; + End; + + +Function TMsgBaseJAM.IsSent: Boolean; {Is current msg sent} + Begin + IsSent := (MsgHdr^.JamHdr.Attr1 and Jam_Sent) <> 0; + End; + + +Function TMsgBaseJAM.IsFAttach: Boolean; {Is current msg file attach} + Begin + IsFAttach := (MsgHdr^.JamHdr.Attr1 and Jam_FAttch) <> 0; + End; + + +Function TMsgBaseJAM.IsReqRct: Boolean; {Is current msg request receipt} + Begin + IsReqRct := (MsgHdr^.JamHdr.Attr1 and Jam_RcptReq) <> 0; + End; + + +Function TMsgBaseJAM.IsReqAud: Boolean; {Is current msg request audit} + Begin + IsReqAud := (MsgHdr^.JamHdr.Attr1 and Jam_ConfmReq) <> 0; + End; + + +Function TMsgBaseJAM.IsRetRct: Boolean; {Is current msg a return receipt} + Begin + IsRetRct := False; + End; + + +Function TMsgBaseJAM.IsFileReq: Boolean; {Is current msg a file request} + Begin + IsFileReq := (MsgHdr^.JamHdr.Attr1 and Jam_Freq) <> 0; + End; + + +Function TMsgBaseJAM.IsRcvd: Boolean; {Is current msg received} + Begin + IsRcvd := (MsgHdr^.JamHdr.Attr1 and Jam_Rcvd) <> 0; + End; + + +Function TMsgBaseJAM.IsPriv: Boolean; {Is current msg priviledged/private} + Begin + IsPriv := (MsgHdr^.JamHdr.Attr1 and Jam_Priv) <> 0; + End; + + +Function TMsgBaseJAM.IsDeleted: Boolean; {Is current msg deleted} + Begin + IsDeleted := (MsgHdr^.JamHdr.Attr1 and Jam_Deleted) <> 0; + End; + + +Function TMsgBaseJAM.IsEchoed: Boolean; {Is current msg echoed} + Begin + IsEchoed := True; + End; + + +Procedure TMsgBaseJAM.SeekFirst(MsgNum: LongInt); {Start msg seek} + Begin + JM^.CurrMsgNum := MsgNum - 1; + If JM^.CurrMsgNum < (JM^.BaseHdr.BaseMsgNum - 1) Then + JM^.CurrMsgNum := JM^.BaseHdr.BaseMsgNum - 1; + SeekNext; + End; + + +Procedure TMsgBaseJAM.SeekNext; {Find next matching msg} +Var + IdxLoc: LongInt; +Begin + If JM^.CurrMsgNum <= GetHighMsgNum Then + Inc(JM^.CurrMsgNum); + + Error := ReReadIdx(IdxLoc); + + While (((JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc < 0) or (JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc = -1)) And (JM^.CurrMsgNum <= GetHighMsgNum)) Do Begin + Inc(JM^.CurrMsgNum); + Error := ReReadIdx(IdxLoc); + End; +End; + +Procedure TMsgBaseJAM.SeekPrior; +Var + IdxLoc: LongInt; +Begin + If JM^.CurrMsgNum >= JM^.BaseHdr.BaseMsgNum Then + Dec(JM^.CurrMsgNum); + + Error := ReReadIdx(IdxLoc); + + If JM^.CurrMsgNum >= JM^.BaseHdr.BaseMsgNum Then + While (IdxLoc >= 0) And (((JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc < 0) or (JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc = -1)) And (JM^.CurrMsgNum >= JM^.BaseHdr.BaseMsgNum)) Do Begin + Dec(JM^.CurrMsgNum); + Error := ReReadIdx(IdxLoc); + End; +End; + +Function TMsgBaseJAM.SeekFound: Boolean; +Begin + SeekFound := ((JM^.CurrMsgNum >= JM^.BaseHdr.BaseMsgNum) and (JM^.CurrMsgNum <= GetHighMsgNum)); +End; + + +Function TMsgBaseJAM.GetMsgLoc: LongInt; {Msg location} +Begin + GetMsgLoc := GetMsgNum; +End; + + +Procedure TMsgBaseJAM.SetMsgLoc(ML: LongInt); {Msg location} + Begin + JM^.CurrMsgNum := ML; + End; + + +Procedure TMsgBaseJAM.YoursFirst(Name: String; Handle: String); +Begin + JM^.YourName := Name; + JM^.YourHdl := Handle; + JM^.NameCrc := JamStrCrc(Name); + JM^.HdlCrc := JamStrCrc(Handle); + JM^.CurrMsgNum := JM^.BaseHdr.BaseMsgNum - 1; + YoursNext; +End; + + +Procedure TMsgBaseJAM.YoursNext; +Var + Found : Boolean; + IdxLoc : LongInt; + NumRead : LongInt; + SubCtr : LongInt; + SubPtr : SubFieldPTR; +Begin + Error := 0; + Found := False; + + Inc(JM^.CurrMsgNum); + While ((Not Found) and (JM^.CurrMsgNum <= GetHighMsgNum) And (Error = 0)) Do Begin + Error := ReReadIdx(IdxLoc); + If Error = 0 Then Begin {Check CRC values} + If ((JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc = JM^.NameCrc) or + (JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc = JM^.HdlCrc)) Then Begin + Seek(JM^.HdrFile, JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc); + Error := IoResult; + If Error = 0 Then {Read message header} + Begin + BlockRead(JM^.HdrFile, MsgHdr^, SizeOf(MsgHdr^), NumRead); + Error := IoResult; + End; + If ((Error = 0) and (Not IsRcvd)) Then Begin + SubCtr := 1; + While ((SubCtr <= MsgHdr^.JamHdr.SubFieldLen) and + (SubCtr < JamSubBufSize)) Do Begin + SubPtr := SubFieldPTR(@MsgHdr^.SubBuf[SubCtr]); + Inc(SubCtr, SubPtr^.DataLen + 8); + Case(SubPtr^.LoId) Of + 3: Begin {MsgTo} + JM^.MsgTo[0] := Chr(SubPtr^.DataLen and $ff); + If Ord(JM^.MsgTo[0]) > 65 Then + JM^.MsgTo[0] := #65; + Move(SubPtr^.Data, JM^.MsgTo[1], Ord(JM^.MsgTo[0])); + If ((strUpper(JM^.MsgTo) = strUpper(JM^.YourName)) Or + (strUpper(JM^.MsgTo) = strUpper(JM^.YourHdl))) Then + Found := True; + End; + End; + End; + End; + End; + End; + If (Not Found) Then + Inc(JM^.CurrMsgNum); + End; + End; + + +Function TMsgBaseJAM.YoursFound: Boolean; + Begin + YoursFound := ((JM^.CurrMsgNum >= JM^.BaseHdr.BaseMsgNum) and + (JM^.CurrMsgNum <= GetHighMsgNum)); + End; + + +Procedure TMsgBaseJAM.StartNewMsg; + Begin + JM^.TxtBufStart := 0; + JM^.TxtPos := 0; + FillChar(MsgHdr^, SizeOf(MsgHdr^), #0); + MsgHdr^.JamHdr.SubFieldLen := 0; + MsgHdr^.JamHdr.MsgIdCrc := -1; + MsgHdr^.JamHdr.ReplyCrc := -1; + MsgHdr^.JamHdr.PwdCrc := -1; + JM^.MsgTo := ''; + JM^.MsgFrom := ''; + JM^.MsgSubj := ''; + FillChar(JM^.Orig, SizeOf(JM^.Orig), #0); + FillChar(JM^.Dest, SizeOf(JM^.Dest), #0); + JM^.MsgDate := DateDos2Str(CurDateDos, 1); + JM^.MsgTime := TimeDos2Str(CurDateDos, False); +// writeln(jm^.msgdate); + End; + + +Function TMsgBaseJAM.MsgBaseExists: Boolean; + Begin + MsgBaseExists := (FileExist(JM^.MsgPath + '.jhr')); + End; + + +Function TMsgBaseJAM.ReadIdx: Word; + Begin + If JM^.IdxStart < 0 Then JM^.IdxStart := 0; + Seek(JM^.IdxFile, JM^.IdxStart); + BlockRead(JM^.IdxFile, JamIdx^, JamIdxBufSize, JM^.IdxRead); + ReadIdx := IoResult; + End; + + +Function TMsgBaseJAM.WriteIdx: Word; + Begin + Seek(JM^.IdxFile, JM^.IdxStart); + BlockWrite(JM^.IdxFile, JamIdx^, JM^.IdxRead); + WriteIdx := IoResult; + End; + + +Function TMsgBaseJAM.OpenMsgBase: Boolean; +Var + OpenError : Word; +Begin + OpenError := 0; + JM^.LockCount := 0; + + Assign(JM^.HdrFile, JM^.MsgPath + '.jhr'); + Assign(JM^.TxtFile, JM^.MsgPath + '.jdt'); + Assign(JM^.IdxFile, JM^.MsgPath + '.jdx'); + + FileMode := fmReadWrite + fmDenyNone; + + Reset(JM^.HdrFile, 1); + + OpenError := IoResult; + + If OpenError = 0 Then Begin + Seek(JM^.HdrFile, 1); + BlockRead(JM^.HdrFile, JM^.BaseHdr.Signature[2] , SizeOf(JM^.BaseHdr) - 1); + OpenError := IoResult; + End; + + If OpenError = 0 Then Begin + FileMode := fmReadWrite + fmDenyNone; + Reset(JM^.TxtFile, 1); + OpenError := IoResult; + End; + + If OpenError = 0 Then Begin + FileMode := fmReadWrite + fmDenyNone; + Reset(JM^.IdxFile, SizeOf(JamIdxType)); + OpenError := IoResult; + End; + + JM^.IdxStart := -10; + JM^.IdxRead := 0; + JM^.TxtBufStart := - 10; + JM^.TxtRead := 0; + OpenMsgBase := (OpenError = 0); +End; + +Procedure TMsgBaseJAM.CloseMsgBase; +Begin + Close(JM^.HdrFile); + Close(JM^.TxtFile); + Close(JM^.IdxFile); +End; + +Function TMsgBaseJAM.CreateMsgBase(MaxMsg: Word; MaxDays: Word): Boolean; +Var + TmpHdr: ^JamHdrType; + CreateError: Word; +// i: Word; + +Begin + CreateError := 0; + + New(TmpHdr); + If TmpHdr = Nil Then + CreateError := 500 + Else Begin; + FillChar(TmpHdr^, SizeOf(TmpHdr^), #0); + TmpHdr^.Signature[1] := 'J'; + TmpHdr^.Signature[2] := 'A'; + TmpHdr^.Signature[3] := 'M'; + TmpHdr^.BaseMsgNum := 1; + TmpHdr^.Created := ToUnixDate(CurDateDos); + TmpHdr^.PwdCrc := -1; + CreateError := SaveFile(JM^.MsgPath + '.jhr', TmpHdr^, SizeOf(TmpHdr^)); + Dispose(TmpHdr); + If CreateError = 0 Then + CreateError := SaveFile(JM^.MsgPath + '.jlr', CreateError, 0); + If CreateError = 0 Then + CreateError := SaveFile(JM^.MsgPath + '.jdt', CreateError, 0); + If CreateError = 0 Then + CreateError := SaveFile(JM^.MsgPath + '.jdx', CreateError , 0); + If IoResult <> 0 Then; + End; + CreateMsgBase := CreateError = 0; +End; + + +Procedure TMsgBaseJAM.SetMailType(MT: MsgMailType); + Begin + JM^.MailType := MT; + End; + + +Function TMsgBaseJAM.GetSubArea: Word; + Begin + GetSubArea := 0; + End; + + +Procedure TMsgBaseJAM.ReWriteHdr; +Var + IdxLoc: LongInt; + +Begin + If LockMsgBase Then + Error := 0 + Else + Error := 5; + Error := ReReadIdx(IdxLoc); + If Error = 0 Then Begin + Seek(JM^.HdrFile, JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc); + Error := IoResult; + End; + If Error = 0 Then Begin + BlockWrite(JM^.HdrFile, MsgHdr^.JamHdr, SizeOf(MsgHdr^.JamHdr)); + Error := IoResult; + End; + If UnLockMsgBase Then; +End; + + +Procedure TMsgBaseJAM.DeleteMsg; +Var + DelError : Word; + IdxLoc : LongInt; +Begin + If Not IsDeleted Then Begin + If LockMsgBase Then + DelError := 0 + Else + DelError := 5; + If DelError = 0 Then Begin + SetAttr1(Jam_Deleted, True); + Dec(JM^.BaseHdr.ActiveMsgs); + DelError := ReReadIdx(IdxLoc); + End; + If DelError = 0 Then ReWriteHdr; + If DelError = 0 Then Begin + Inc(JM^.BaseHdr.ModCounter); +{these three were commented out for some reason } + JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc := -1; + JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc := -1; + If WriteIdx = 0 Then; + End; + If UnLockMsgBase Then; + End; +End; + +Function TMsgBaseJAM.NumberOfMsgs: LongInt; +Begin + NumberOfMsgs := JM^.BaseHdr.ActiveMsgs; +End; + + +Function TMsgBaseJAM.FindLastRead(Var LastFile: File; UNum: LongInt): LongInt; + Const + LastSize = 100; + + Type LastArray = Array[1..LastSize] of JamLastType; + + Var + LastBuf: ^LastArray; + LastError: Word; + NumRead: LongInt; + Found: Boolean; + i: Word; + LastStart: LongInt; + + Begin + FindLastRead := -1; + Found := False; + New(LastBuf); + Seek(LastFile, 0); + LastError := IoResult; + While ((Not Eof(LastFile)) and (LastError = 0) And (Not Found)) Do + Begin + LastStart := FilePos(LastFile); + BlockRead(LastFile, LastBuf^, LastSize, NumRead); + LastError := IoResult; + For i := 1 to NumRead Do Begin + If LastBuf^[i].UserNum = UNum Then + Begin + Found := True; + FindLastRead := LastStart + i - 1; + End; + End; + End; + Dispose(LastBuf); + End; + + +Function TMsgBaseJAM.GetLastRead(UNum: LongInt): LongInt; +Var + RecNum: LongInt; + LastFile: File; + TmpLast: JamLastType; +Begin + Assign(LastFile, JM^.MsgPath + '.jlr'); + FileMode := fmReadWrite + fmDenyNone; + Reset(LastFile, SizeOf(JamLastType)); + Error := IoResult; + RecNum := FindLastRead(LastFile, UNum); + If RecNum >= 0 Then Begin + Seek(LastFile, RecNum); + If Error = 0 Then Begin + BlockRead(LastFile, TmpLast, 1); + Error := IoResult; + GetLastRead := TmpLast.HighRead; + End; + End Else + GetLastRead := 0; + + Close(LastFile); + Error := IoResult; +End; + +Procedure TMsgBaseJAM.SetLastRead(UNum: LongInt; LR: LongInt); + Var + RecNum: LongInt; + LastFile: File; + TmpLast: JamLastType; + + Begin + Assign(LastFile, JM^.MsgPath + '.jlr'); + FileMode := fmReadWrite + fmDenyNone; + Reset(LastFile, SizeOf(JamLastType)); + Error := IoResult; + If Error <> 0 Then ReWrite(LastFile, SizeOf(JamLastType)); + Error := IoResult; + RecNum := FindLastRead(LastFile, UNum); + If RecNum >= 0 Then Begin + Seek(LastFile, RecNum); + If Error = 0 Then Begin + BlockRead(LastFile, TmpLast, 1); + Error := IoResult; + TmpLast.HighRead := LR; + TmpLast.LastRead := LR; + If Error = 0 Then Begin + Seek(LastFile, RecNum); + Error := IoResult; + End; + If Error = 0 Then Begin + BlockWrite(LastFile, TmpLast, 1); + Error := IoResult; + End; + End; + End Else Begin + TmpLast.UserNum := UNum; + TmpLast.HighRead := Lr; + TmpLast.NameCrc := UNum; + TmpLast.LastRead := Lr; + Seek(LastFile, FileSize(LastFile)); + Error := IoResult; + If Error = 0 Then Begin + BlockWrite(LastFile, TmpLast, 1); + Error := IoResult; + End; + End; + Close(LastFile); + Error := IoResult; +End; + + +Function TMsgBaseJAM.GetTxtPos: LongInt; +Begin + GetTxtPos := JM^.TxtPos; +End; + +Procedure TMsgBaseJAM.SetTxtPos(TP: LongInt); +Begin + JM^.TxtPos := TP; +End; + +Function TMsgBaseJAM.LockMsgBase: Boolean; +Var + LockError: Word; +Begin + LockError := 0; + If JM^.LockCount = 0 Then Begin + If LockError = 0 Then Begin +// LockError := shLock(JM^.HdrFile, 0, 1); + End; + If LockError = 0 Then Begin + Seek(JM^.HdrFile, 0); + LockError := IoResult; + End; + If LockError = 0 Then Begin + BlockRead(JM^.HdrFile, JM^.BaseHdr , SizeOf(JM^.BaseHdr)); + LockError := IoResult; + End; + End; + Inc(JM^.LockCount); + LockMsgBase := (LockError = 0); +End; + +Function TMsgBaseJAM.UnLockMsgBase: Boolean; +Var + LockError: Word; +Begin + LockError := 0; + If JM^.LockCount > 0 Then Dec(JM^.LockCount); + If JM^.LockCount = 0 Then Begin + If LockError = 0 Then Begin +// LockError := UnLockFile(JM^.HdrFile, 0, 1); + End; + If LockError = 0 Then Begin + Seek(JM^.HdrFile, 0); + LockError := IoResult; + End; + If LockError = 0 Then Begin + BlockWrite(JM^.HdrFile, JM^.BaseHdr, SizeOf(JM^.BaseHdr)); + LockError := IoResult; + End; + End; + UnLockMsgBase := (LockError = 0); +End; + +{SetSeeAlso/GetSeeAlso provided by 2:201/623@FidoNet Jonas@iis.bbs.bad.se} + +Procedure TMsgBaseJAM.SetNextSeeAlso(SAlso: LongInt); +Begin + MsgHdr^.JamHdr.ReplyNext := SAlso; +End; + +Function TMsgBaseJAM.GetNextSeeAlso: LongInt; {Get next see also of current msg} +Begin + GetNextSeeAlso := MsgHdr^.JamHdr.ReplyNext; +End; + +Function TMsgBaseJAM.ReReadIdx(Var IdxLoc : LongInt) : Word; +Begin + ReReadIdx := 0; + IdxLoc := JM^.CurrMsgNum - JM^.BaseHdr.BaseMsgNum; + If ((IdxLoc < JM^.IdxStart) OR (IdxLoc >= (JM^.IdxStart+JM^.IdxRead))) Then Begin + JM^.IdxStart := IdxLoc - 30; + If JM^.IdxStart < 0 Then JM^.IdxStart := 0; + ReReadIdx := ReadIdx; + End; +End; + +End. diff --git a/mystic/bbs_msgbase_squish.pas b/mystic/bbs_msgbase_squish.pas new file mode 100644 index 0000000..1a8907c --- /dev/null +++ b/mystic/bbs_msgbase_squish.pas @@ -0,0 +1,1582 @@ +{$I M_OPS.PAS} + +Unit BBS_MsgBase_Squish; + +Interface + +Uses + BBS_MsgBase_Abs, + BBS_Common, + DOS; + +Const + SqHdrId = $AFAE4453; + SqLinkNext = 0; + SqLinkPrev = 1; + SqNullFrame = 0; + SqFrameMsg = 0; + SqFrameFree = 1; + SqFrameRLE = 2; + SqFrameLZW = 3; + SqFromSize = 36; + SqToSize = 36; + SqSubjSize = 72; + SqMaxReply = 10; + +Type + SqBaseType = Record + Len : Word; { Length of this record } + Rsvd1 : Word; { Future use } + NumMsg : LongInt; { Number of messages } + HighMsg : LongInt; { Highest msg } + SkipMsg : LongInt; { # of msgs to keep in beginning of area } + HighWater : LongInt; { High water UMsgId } + Uid : LongInt; { Next UMsgId } + Base : String[79]; { Base name of Squish file } + BeginFrame : LongInt; { Offset of first frame in file } + LastFrame : LongInt; { Offset of last frame in file } + FirstFree : LongInt; { Offset of first free frame in file } + LastFree : LongInt; { Offset of last free frame in file } + EndFrame : LongInt; { Pointer to end of file } + MaxMsg : LongInt; { Maximum number of messages } + KeepDays : Word; { Maximum age of messages } + SqHdrSize : Word; { Size of frame header } + Rsvd2 : Array[1..124] of Byte; + End; + + SqFrameHdrType = Record + Id : LongInt; { Must equal SqHdrId } + NextFrame : LongInt; { Next msg frame } + PrevFrame : LongInt; { Prior msg frame } + FrameLength : LongInt; { Length of this frame not counting header } + MsgLength : LongInt; { Length of message } + ControlLength : LongInt; { Length of control information } + FrameType : Word; { Type of message frame } + Rsvd : Word; { Future use } + End; + + SqMsgHdrType = Record + Attr : LongInt; { Msg attribute } + MsgFrom : String[SqFromSize - 1]; { Nul Term from name } + MsgTo : String[SqToSize - 1]; { Nul term to name } + Subj : String[SqSubjSize - 1]; { Nul term subject } + Orig : RecEchoMailAddr; { Origin address } + Dest : RecEchoMailAddr; { Destination address } + DateWritten : LongInt; { Date msg written } + DateArrived : LongInt; { Date msg arrived here } + UtcOffset : Word; { Minutes offset from UTC } + ReplyTo : LongInt; { Original msg } + Replies : Array[1..SqMaxReply] of LongInt; { Replies } + AzDate : String[19]; { AsciiZ "Fido" style date } + End; + + SqIdxType = Record + Ofs : LongInt; { Offset of frame header } + UMsgId : LongInt; { Unique message id } + Hash : LongInt; { Hash of MsgTo name } + End; + +Const + SqIdxArraySize = 5200; {5200} + +Type + SqIdxArrayType = Array[1..SqIdxArraySize] of SqIdxType; + SqIdxPtrType = ^SqIdxArrayType; + + FreeListType = Record + FreePos : LongInt; + FreeSize : LongInt; + End; + +Const + MaxFree = 500; + +Type + FreeArrayType = Array[1..MaxFree] of FreeListType; + +Const + SqBSize : Word = SizeOf(SqBaseType); + SqFSize : Word = SizeOf(SqFrameHdrType); + SqMSize : Word = SizeOf(SqMsgHdrType); + SqISize : Word = SizeOf(SqIdxType); + +Const + SqTxtBufferSize = 16000; {reduced from 34000 to 16000. this should } + {handle 200 lines x 80 chars EASILY } +Type + SqInfoType = Record + FN : String[80]; + MsgChars : Array[1..SqTxtBufferSize] of Char; + Error : Word; + SqdFile : File; + SqIFile : File; + SqBase : SqBaseType; + SqBaseExtra : Array[1..100] of Char; + SqdOpened : Boolean; + SqiOpened : Boolean; + SqiAlloc : Word; + Locked : Boolean; + FreeLoaded : Boolean; + HighestFree : Word; + Frame : SqFrameHdrType; + MsgHdr : SqMsgHdrType; + Extra : Array[1..100] of Char; + TxtCtr : Word; + MsgDone : Boolean; + CurrIdx : Word; + StrDate : String[8]; + StrTime : String[8]; + CurrentFramePos : LongInt; + CurrentUID : LongInt; + SName : String[35]; + SHandle : String[35]; + HName : LongInt; + HHandle : LongInt; + End; + +Type + + PMsgBaseSquish = ^TMsgBaseSquish; + TMsgBaseSquish = Object(TMsgBaseAbs) + SqInfo : ^SqInfoType; + SqIdx : ^SqIdxArrayType; + FreeArray : ^FreeArrayType; + + Procedure EditMsgInit; Virtual; + Procedure EditMsgSave; Virtual; + + Constructor Init; {Initialize} + Destructor Done; Virtual; {Done cleanup and dispose} + Function OpenMsgBase: Boolean; Virtual; {Open message base} + Procedure CloseMsgBase; Virtual; {Close message base} + Function CreateMsgBase(MaxMsg: Word; MaxDays: Word): Boolean; Virtual; + Function MsgBaseExists: Boolean; Virtual; + Procedure SetMsgPath(FN: String); Virtual; {Set filepath and name - no extension} + Function SqdOpen: Boolean; Virtual; {Open squish data file} + Function SqiOpen: Boolean; Virtual; {Open squish index file} + Procedure SqdClose; Virtual; {Close squish data file} + Procedure SqiClose; Virtual; {Close squish index file} + Function LockMsgBase: Boolean; Virtual; {Lock msg base} + Function UnLockMsgBase: Boolean; Virtual; {Unlock msg base} + Procedure ReadBase; Virtual; {Read base data record} + Procedure WriteBase; Virtual; {Write base data record} + Function GetBeginFrame: LongInt; Virtual; {Get beginning frame pos} + Function GetHighWater: LongInt; Virtual; {Get high water umsgid} + Function GetHighMsgNum: LongInt; Virtual; {Get highest msg number} + Procedure ReadFrame(FPos: LongInt); Virtual; {Read frame at FPos} + Procedure ReadVarFrame(Var Frame: SqFrameHdrType; FPos: LongInt); Virtual; {Read frame at FPos into Frame} + Procedure WriteFrame(FPos: LongInt); Virtual; {Write frame at FPos} + Procedure WriteVarFrame(Var Frame: SqFrameHdrType; FPos: LongInt); Virtual; + Procedure UnlinkFrame(Var Frame: SqFrameHdrType); Virtual; {Unlink frame from linked list} + Procedure LinkFrameNext(Var Frame: SqFrameHdrType; OtherFrame: LongInt; + FramePos: LongInt); Virtual; {Link frame after other frame} + Procedure KillMsg(MsgNum: LongInt); {Kill msg msgnum} + Procedure KillExcess; {Kill msg in excess of limit} + Procedure FindFrame(Var FL: LongInt; Var FramePos: LongInt); Virtual; + Function GetNextFrame: LongInt; Virtual; {Get next frame pos} + Procedure ReadMsgHdr(FPos: LongInt); Virtual; {Read msg hdr for frame at FPos} + Procedure WriteMsgHdr(FPos: LongInt); Virtual; {Read msg hdr for frame at FPos} + Procedure WriteText(FPos: LongInt); Virtual; {Write text buffer for frame at Fpos} + Function SqHashName(Name: String): LongInt; Virtual; {Convert name to hash value} + Procedure StartNewMsg; Virtual; {Initialize msg header} + Function GetFrom: String; Virtual; {Get message from} + Function GetTo: String; Virtual; {Get message to} + Function GetSubj: String; Virtual; {Get message subject} + Function GetTextLen: LongInt; Virtual; {Get text length} + Procedure SetFrom(Str: String); Virtual; {Set message from} + Procedure SetTo(Str: String); Virtual; {Set message to} + Procedure SetSubj(Str: String); Virtual; {Set message subject} + Procedure SetDate(Str: String); Virtual; {Set message date} + Procedure SetTime(Str: String); Virtual; {Set message time} + Function GetDate: String; Virtual; {Get message date mm-dd-yy} + Function GetTime: String; Virtual; {Get message time hh:mm} + Function GetRefer: LongInt; Virtual; {Get reply to of current msg} + Procedure SetRefer(Num: LongInt); Virtual; {Set reply to of current msg} + Function GetSeeAlso: LongInt; Virtual; {Get see also msg} + Procedure SetSeeAlso(Num: LongInt); Virtual; {Set see also msg} + Procedure ReadText(FPos: LongInt); Virtual; + Function GetChar: Char; Virtual; + Function GetString(MaxLen: Word): String; Virtual; + Procedure GetOrig(Var Addr: RecEchoMailAddr); Virtual; + Procedure SetOrig(Var Addr: RecEchoMailAddr); Virtual; + Procedure GetDest(Var Addr: RecEchoMailAddr); Virtual; + Procedure SetDest(Var Addr: RecEchoMailAddr); Virtual; + Function EOM: Boolean; Virtual; +(* + Function WasWrap: Boolean; Virtual; +*) + Procedure InitText; Virtual; + Procedure DoString(Str: String); Virtual; {Add string to message text} + Procedure DoChar(Ch: Char); Virtual; {Add character to message text} + Procedure DoStringLn(Str: String); Virtual; {Add string and newline to msg text} + Function WriteMsg: Word; Virtual; {Write msg to msg base} + Procedure ReadIdx; Virtual; + Procedure WriteIdx; Virtual; + Procedure SeekFirst(MsgNum: LongInt); Virtual; {Seeks to 1st msg >= MsgNum} + Function GetMsgNum: LongInt; Virtual; + Procedure SeekNext; Virtual; + Procedure SeekPrior; Virtual; + Function SeekFound: Boolean; Virtual; + Function GetIdxFramePos: LongInt; Virtual; + Function GetIdxHash: LongInt; Virtual; + Function IsLocal: Boolean; Virtual; {Is current msg local} + Function IsCrash: Boolean; Virtual; {Is current msg crash} + Function IsKillSent: Boolean; Virtual; {Is current msg kill sent} + Function IsSent: Boolean; Virtual; {Is current msg sent} + Function IsFAttach: Boolean; Virtual; {Is current msg file attach} + Function IsReqRct: Boolean; Virtual; {Is current msg request receipt} + Function IsReqAud: Boolean; Virtual; {Is current msg request audit} + Function IsRetRct: Boolean; Virtual; {Is current msg a return receipt} + Function IsFileReq: Boolean; Virtual; {Is current msg a file request} + Function IsRcvd: Boolean; Virtual; {Is current msg received} + Function IsPriv: Boolean; Virtual; {Is current msg priviledged/private} + Function IsDeleted: Boolean; Virtual; {Is current msg deleted} + Procedure SetAttr(St: Boolean; Mask: LongInt); Virtual; {Set attribute} + Procedure SetLocal(St: Boolean); Virtual; {Set local status} + Procedure SetRcvd(St: Boolean); Virtual; {Set received status} + Procedure SetPriv(St: Boolean); Virtual; {Set priveledge vs public status} + Procedure SetCrash(St: Boolean); Virtual; {Set crash netmail status} + Procedure SetHold (ST: Boolean); Virtual; + Procedure SetKillSent(St: Boolean); Virtual; {Set kill/sent netmail status} + Procedure SetSent(St: Boolean); Virtual; {Set sent netmail status} + Procedure SetFAttach(St: Boolean); Virtual; {Set file attach status} + Procedure SetReqRct(St: Boolean); Virtual; {Set request receipt status} + Procedure SetReqAud(St: Boolean); Virtual; {Set request audit status} + Procedure SetRetRct(St: Boolean); Virtual; {Set return receipt status} + Procedure SetFileReq(St: Boolean); Virtual; {Set file request status} + Procedure MsgStartUp; Virtual; {Set up message} + Procedure MsgTxtStartUp; Virtual; {Set up for msg text} + Procedure SetMailType(MT: MsgMailType); Virtual; {Set message base type} + Function GetSubArea: Word; Virtual; {Get sub area number} + Procedure ReWriteHdr; Virtual; {Rewrite msg header after changes} + Procedure DeleteMsg; Virtual; {Delete current message} + Procedure LoadFree; Virtual; {Load freelist into memory} + Function NumberOfMsgs: LongInt; Virtual; {Number of messages} + Procedure SetEcho(ES: Boolean); Virtual; {Set echo status} + Function IsEchoed: Boolean; Virtual; {Is current msg unmoved echomail msg} + Function GetLastRead(UNum: LongInt): LongInt; Virtual; {Get last read for user num} + Procedure SetLastRead(UNum: LongInt; LR: LongInt); Virtual; {Set last read} + Function GetMsgLoc: LongInt; Virtual; {To allow reseeking to message} + Procedure SetMsgLoc(ML: LongInt); Virtual; {Reseek to message} + Function IdxHighest: LongInt; Virtual; { *** } + Procedure YoursFirst(Name: String; Handle: String); Virtual; {Seek your mail} + Procedure YoursNext; Virtual; {Seek next your mail} + Function YoursFound: Boolean; Virtual; {Message found} + Function GetMsgDisplayNum: LongInt; Virtual; {Get msg number to display} + Function GetTxtPos: LongInt; Virtual; {Get indicator of msg text position} + Procedure SetTxtPos(TP: LongInt); Virtual; {Set text position} + End; + +Implementation + +Uses + mkcrap, + m_Strings, + m_DateTime, + m_FileIO; + +Const + SqMsgPriv = $00001; + SqMsgCrash = $00002; + SqMsgRcvd = $00004; + SqMsgSent = $00008; + SqMsgFile = $00010; + SqMsgFwd = $00020; + SqMsgOrphan = $00040; + SqMsgKill = $00080; + SqMsgLocal = $00100; + SqMsgHold = $00200; + SqMsgXX2 = $00400; + SqMsgFreq = $00800; + SqMsgRrq = $01000; + SqMsgCpt = $02000; + SqMsgArq = $04000; + SqMsgUrg = $08000; + SqMsgScanned = $10000; + +Constructor TMsgBaseSquish.Init; +Begin + New(SqInfo); + New(FreeArray); + If ((SqInfo = nil) or (FreeArray = nil)) Then Begin + If SqInfo <> Nil Then Dispose(SqInfo); + If FreeArray <> Nil Then Dispose(FreeArray); + Fail; + Exit; + End; + SqInfo^.SqdOpened := False; + SqInfo^.SqiOpened := False; + SqInfo^.FN := ''; + SqInfo^.Error := 0; + SqInfo^.Locked := False; + SqInfo^.FreeLoaded := False; + SqInfo^.SqiAlloc := 0; +End; + +Destructor TMsgBaseSquish.Done; +Begin + If SqInfo^.SqdOpened Then SqdClose; + If SqInfo^.SqiOpened Then SqiClose; + If SqInfo^.SqIAlloc > 0 Then + If SqIdx <> Nil Then + FreeMem(SqIdx, SqInfo^.SqiAlloc * SizeOf(SqIdxType)); + Dispose(FreeArray); + Dispose(SqInfo); +End; + +Procedure TMsgBaseSquish.SetMsgPath(FN: String); +Begin + SqInfo^.FN := FExpand(FN); + If Pos('.', SqInfo^.FN) > 0 Then + SqInfo^.FN := Copy(SqInfo^.FN,1,Pos('.', SqInfo^.FN) - 1); +End; + +Function TMsgBaseSquish.OpenMsgBase: Boolean; +Begin + If SqiOpen Then Begin + OpenMsgBase := SqdOpen; + ReadIdx; + End Else + OpenMsgBase := False; +End; + +Function TMsgBaseSquish.SqdOpen: Boolean; +Var + NumRead: LongInt; +Begin + If Not SqInfo^.SqdOpened Then Begin + Assign(SqInfo^.SqdFile, SqInfo^.FN + '.sqd'); + FileMode := 66; {ReadWrite + DenyNone} + If Not ioReset(SqInfo^.SqdFile, 1, fmreadwrite + fmdenynone) Then + SqdOpen := False + Else Begin + SqInfo^.SqdOpened := True; + SqdOpen := True; + If Not ioBlockRead(SqInfo^.SqdFile, SqInfo^.SqBase, 2, NumRead) Then + SqdOpen := False + Else Begin + If SqInfo^.SqBase.Len = 0 Then + SqInfo^.SqBase.Len := SqBSize; + If SqInfo^.SqBase.Len > (SizeOf(SqBaseType) + 100) Then + SqdOpen := False + Else Begin + SqBSize := SqInfo^.SqBase.Len; + ReadBase; + End; + End; + End; + End Else + SqdOpen := True; + End; + +Function TMsgBaseSquish.SqiOpen: Boolean; +Begin + If Not SqInfo^.SqiOpened Then Begin + Assign(SqInfo^.SqiFile, SqInfo^.FN + '.sqi'); +// FileMode := 66; {fmReadWrite + fmDenyNone;} + If Not ioReset(SqInfo^.SqiFile, SizeOf(SqIdxType), fmReadWrite + fmDenyNone) Then + SqiOpen := False + Else Begin + SqInfo^.SqiOpened := True; + SqiOpen := True; + End; + End Else + SqiOpen := True; + End; + +Procedure TMsgBaseSquish.CloseMsgBase; +Begin + SqdClose; + SqiClose; + FileMode := fmReadWrite + fmDenyNone; { shouldn't be needed... } +End; + +Function TMsgBaseSquish.CreateMsgBase(MaxMsg: Word; MaxDays: Word): Boolean; +Begin + If Not SqInfo^.SqdOpened Then Begin + FillChar(SqInfo^.SqBase, SizeOf(SqInfo^.SqBase), 0); + SqInfo^.SqBase.Len := 256; + SqInfo^.SqBase.SqHdrSize := SqFSize; + SqInfo^.SqBase.UID := 1; + SqInfo^.SqBase.NumMsg := 0; + SqInfo^.SqBase.Base := SqInfo^.FN; + Str2Az(SqInfo^.FN, 78, SqInfo^.SqBase.Base); + + SqInfo^.SqBase.MaxMsg := MaxMsg; + SqInfo^.SqBase.KeepDays := MaxDays; + SqInfo^.SqBase.EndFrame := SqInfo^.SqBase.Len; + + CreateMsgBase := (SaveFile(SqInfo^.FN + '.sqd', SqInfo^.SqBase, SqInfo^.SqBase.Len) = 0); + If SaveFile(SqInfo^.FN + '.sqi', SqInfo^.SqBase, 0) = 0 Then; + If SaveFile(SqInfo^.FN + '.sql', SqInfo^.SqBase, 0) = 0 Then; + End Else + CreateMsgBase := False; +End; + +Function TMsgBaseSquish.MsgBaseExists: Boolean; +Begin + MsgBaseExists := FileExist(SqInfo^.FN + '.sqd'); +End; + +Procedure TMsgBaseSquish.SqdClose; +Begin + If SqInfo^.SqdOpened Then Close(SqInfo^.SqdFile); + If IOResult <> 0 Then; + SqInfo^.SqdOpened := False; +End; + +Function TMsgBaseSquish.LockMsgBase: Boolean; {Lock msg base} +Begin + If Not SqInfo^.Locked Then Begin + sqinfo^.locked := true; +{ SqInfo^.Locked := shLock(SqInfo^.SqdFile, 0, 1) = 0;} + LockMsgBase := SqInfo^.Locked; + ReadBase; + ReadIdx; + SqInfo^.FreeLoaded := False; + End; +End; + +Function TMsgBaseSquish.UnLockMsgBase: Boolean; {Unlock msg base} +Begin + If SqInfo^.Locked Then Begin + WriteBase; + WriteIdx; + sqinfo^.locked := false; +// SqInfo^.Locked := Not UnLockFile(SqInfo^.SqdFile, 0, 1) < 2; + UnLockMsgBase := Not SqInfo^.Locked; + End; +End; + +Procedure TMsgBaseSquish.SqiClose; +Begin + If SqInfo^.SqiOpened Then Close(SqInfo^.SqiFile); + If IoResult <> 0 Then; + SqInfo^.SqiOpened := False; +End; + +Procedure TMsgBaseSquish.ReadBase; +Var + NumRead: LongInt; +Begin + Seek (SqInfo^.SqdFile, 0); + If Not ioBlockRead(SqInfo^.SqdFile, SqInfo^.SqBase, SqBSize, NumRead) Then + SqInfo^.Error := ioCode; + + If SqInfo^.SqBase.SqHdrSize = 0 Then + SQInfo^.SqBase.SqHdrSize := SqFSize; + + SqFSize := SqInfo^.SqBase.SqHdrSize; +End; + +Procedure TMsgBaseSquish.WriteBase; +Var + Res : LongInt; +Begin + Seek (SqInfo^.SqdFile, 0); + + If Not ioBlockWrite(SqInfo^.SqdFile, SqInfo^.SqBase, SQBSize, Res) Then + SqInfo^.Error := ioCode; +End; + +Procedure TMsgBaseSquish.StartNewMsg; {Initialize msg header} +Begin + FillChar (SqInfo^.MsgHdr, SizeOf(SqInfo^.MsgHdr), 0); + FillChar (SqInfo^.Frame, SizeOf(SqInfo^.Frame), 0); + + SqInfo^.TxtCtr := 0; + SqInfo^.StrDate := ''; + SqInfo^.StrTime := ''; +End; + +Function TMsgBaseSquish.GetFrom: String; {Get message from} +Begin + GetFrom := strWide2Str(SqInfo^.MsgHdr.MsgFrom, 35); +End; + +Function TMsgBaseSquish.GetTo: String; {Get message to} +Begin + GetTo := strWide2Str(SqInfo^.MsgHdr.MsgTo, 35); +End; + +Function TMsgBaseSquish.GetSubj: String; {Get message subject} +Begin + GetSubj := strWide2Str(SqInfo^.MsgHdr.Subj, 72); +End; + +Function TMsgBaseSquish.GetTextLen: LongInt; {Get text length} +Begin +{ GetTextLen := SqInfo^.TxtCtr;} + GetTextLen := SqInfo^.Frame.MsgLength - 320; +End; + +Procedure TMsgBaseSquish.SetFrom(Str: String); {Set message from} +Begin + Str2Az(Str, 35, SqInfo^.MsgHdr.MsgFrom); +End; + +Procedure TMsgBaseSquish.SetTo(Str: String); {Set message to} +Begin + Str2Az(Str,35, SqInfo^.MsgHdr.MsgTo); +End; + +Procedure TMsgBaseSquish.SetSubj(Str: String); {Set message subject} +Begin + Str2Az(Str,72, SqInfo^.MSgHdr.Subj); +End; + +Function TMsgBaseSquish.GetDate: String; {Get message date mm-dd-yy} +Var + TmpDate: LongInt; +Begin + TmpDate := (SqInfo^.MsgHdr.DateWritten shr 16) + + ((SqInfo^.MsgHdr.DateWritten and $ffff) shl 16); + GetDate := DateDos2Str(TmpDate, 1); +End; + +Function TMsgBaseSquish.GetTime: String; {Get message time hh:mm} +Var + TmpDate: LongInt; +Begin + TmpDate := (SqInfo^.MsgHdr.DateWritten shr 16) + + ((SqInfo^.MsgHdr.DateWritten and $ffff) shl 16); + GetTime := TimeDos2Str(TmpDate, False); +End; + +Procedure TMsgBaseSquish.SetDate(Str: String); +Begin + SqInfo^.StrDate := Copy(Str,1,8); +End; + +Procedure TMsgBaseSquish.SetTime(Str: String); +Begin + SqInfo^.StrTime := Copy(Str,1,8); +End; + +Procedure TMsgBaseSquish.GetOrig(Var Addr: RecEchoMailAddr); +Begin + Addr := SqInfo^.MsgHdr.Orig; +End; + +Procedure TMsgBaseSquish.SetOrig(Var Addr: RecEchoMailAddr); +Begin + SqInfo^.MsgHdr.Orig := Addr; +End; + +Procedure TMsgBaseSquish.GetDest(Var Addr: RecEchoMailAddr); +Begin + Addr := SqInfo^.MsgHdr.Dest; +End; + +Procedure TMsgBaseSquish.SetDest(Var Addr: RecEchoMailAddr); +Begin + SqInfo^.MsgHdr.Dest := Addr; +End; + +Function TMsgBaseSquish.SqHashName(Name: String): LongInt; +Var + Hash : LongInt; + Tmp : LongInt; + Counter : Word; +Begin + Hash := 0; + Counter := 1; + While Counter <= Length(Name) Do Begin + Hash := (Hash shl 4) + Ord(LoCase(Name[Counter])); + Tmp := Hash and $F0000000; + If (Tmp <> 0) Then Hash := (Hash or (Tmp shr 24)) or Tmp; + Inc(Counter); + End; + SqHashName := Hash and $7fffffff; +End; + +Procedure TMsgBaseSquish.ReadFrame(FPos: LongInt); {Read frame at FPos} +Begin + ReadVarFrame(SqInfo^.Frame, FPos); +End; + +Procedure TMsgBaseSquish.ReadVarFrame(Var Frame: SqFrameHdrType; FPos: LongInt); {Read frame at FPos} +Var + NumRead : LongInt; +Begin + Seek(SqInfo^.SqdFile, FPos); + SqInfo^.Error := IoResult; + If SqInfo^.Error = 0 Then Begin + If Not ioBlockRead(SqInfo^.SqdFile, Frame, SizeOf(SqFrameHdrType), NumRead) Then + SqInfo^.Error := ioCode; + End; +End; + +Procedure TMsgBaseSquish.WriteFrame(FPos: LongInt); {Read frame at FPos} +Begin + WriteVarFrame(SqInfo^.Frame, FPos); +End; + +Procedure TMsgBaseSquish.WriteVarFrame(Var Frame: SqFrameHdrType; FPos: LongInt); {Write frame at FPos} +Var + Res : LongInt; +Begin + Seek(SqInfo^.SqdFile, FPos); + SqInfo^.Error := IoResult; + If SqInfo^.Error = 0 Then Begin + If Not ioBlockWrite(SqInfo^.SqdFile, Frame, SizeOf(SqFrameHdrType), Res) Then + SqInfo^.Error := ioCode; + End; +End; + +Procedure TMsgBaseSquish.UnlinkFrame(Var Frame: SqFrameHdrType); +Var + TmpFrame: SqFrameHdrType; +Begin + If Frame.PrevFrame <> 0 Then Begin + ReadVarFrame(TmpFrame, Frame.PrevFrame); + TmpFrame.NextFrame := Frame.NextFrame; + WriteVarFrame(TmpFrame, Frame.PrevFrame); + End; + If Frame.NextFrame <> 0 Then Begin + ReadVarFrame(TmpFrame, Frame.NextFrame); + TmpFrame.PrevFrame := Frame.PrevFrame; + WriteVarFrame(TmpFrame, Frame.NextFrame); + End; +End; + +Procedure TMsgBaseSquish.LoadFree; +Var + i : Word; + TmpFrame : SqFrameHdrType; + TmpPos : LongInt; +Begin + For i := 1 to MaxFree Do Begin + FreeArray^[i].FreePos := 0; + FreeArray^[i].FreeSize := 0; + End; + SqInfo^.FreeLoaded := True; + i := 0; + TmpPos := SqInfo^.SqBase.FirstFree; + While ((TmpPos <> 0) and (i < MaxFree)) Do Begin + ReadVarFrame(TmpFrame, TmpPos); + Inc(i); + FreeArray^[i].FreeSize := TmpFrame.FrameLength; + FreeArray^[i].FreePos := TmpPos; + TmpPos := TmpFrame.NextFrame; + End; + SqInfo^.HighestFree := i; +End; + +Procedure TMsgBaseSquish.FindFrame(Var FL: LongInt; Var FramePos: LongInt); +Var + TmpFrame : SqFrameHdrType; + BestFoundPos : LongInt; + BestFoundSize : LongInt; + BestIdx : Word; + i : Word; +Begin + If Not SqInfo^.FreeLoaded Then LoadFree; + + BestFoundPos := 0; + BestFoundSize := 0; + + For i := 1 to SqInfo^.HighestFree Do Begin + If (FreeArray^[i].FreeSize > FL) Then Begin + If ((BestFoundSize = 0) or (FreeArray^[i].FreeSize < BestFoundSize)) Then Begin + BestFoundSize := FreeArray^[i].FreeSize; + BestFoundPos := FreeArray^[i].FreePos; + BestIdx := i; + End; + End + End; + + FramePos := BestFoundPos; + + If FramePos <> 0 Then Begin + ReadVarFrame(TmpFrame, FramePos); + FreeArray^[BestIdx].FreePos := 0; + FreeArray^[BestIdx].FreeSize := 0; + End; + + If FramePos = 0 Then Begin + FL := 0; + FramePos := SqInfo^.SqBase.EndFrame; + End Else Begin + UnLinkFrame(TmpFrame); + + If TmpFrame.PrevFrame = 0 Then SqInfo^.SqBase.FirstFree := TmpFrame.NextFrame; + If TmpFrame.NextFrame = 0 Then SqInfo^.SqBase.LastFree := TmpFrame.PrevFrame; + + FL := TmpFrame.FrameLength; + End; +End; + +Procedure TMsgBaseSquish.LinkFrameNext(Var Frame: SqFrameHdrType; OtherFrame: LongInt; FramePos: LongInt); +Var + TmpFrame: SqFrameHdrType; +Begin + If OtherFrame <> 0 Then Begin + ReadVarFrame(TmpFrame, OtherFrame); + + TmpFrame.NextFrame := FramePos; + Frame.PrevFrame := OtherFrame; + + WriteVarFrame(TmpFrame, OtherFrame); + End; +End; + +Procedure TMsgBaseSquish.KillMsg(MsgNum: LongInt); +Var + i: Word; + KillPos: LongInt; + IndexPos: LongInt; + KillFrame: SqFrameHdrType; + TmpFrame: SqFrameHdrType; + CurrMove: LongInt; + AlreadyLocked: Boolean; + FreeCtr: Word; +Begin + AlreadyLocked := SqInfo^.Locked; + If Not AlreadyLocked Then + If LockMsgBase Then; + If SqIdx = Nil Then + SqInfo^.Error := 999 + Else Begin + i := 1; + While ((i <= SqInfo^.SqBase.NumMsg) and (MsgNum <> SqIdx^[i].UMsgId)) Do + Inc(i); + If MsgNum = SqIdx^[i].UMsgId Then Begin + IndexPos := i; + KillPos := SqIdx^[i].Ofs; + ReadVarFrame(KillFrame, KillPos); + If KillFrame.PrevFrame = 0 Then + SqInfo^.SqBase.BeginFrame := KillFrame.NextFrame; + If KillFrame.NextFrame = 0 Then + SqInfo^.SqBase.LastFrame := KillFrame.PrevFrame; + KillFrame.FrameType := sqFrameFree; + UnLinkFrame(KillFrame); + If ((SqInfo^.SqBase.FirstFree = 0) or (SqInfo^.SqBase.LastFree = 0)) Then Begin + SqInfo^.SqBase.FirstFree := KillPos; + SqInfo^.SqBase.LastFree := KillPos; + KillFrame.PrevFrame := 0; + KillFrame.NextFrame := 0; + End Else Begin + KillFrame.NextFrame := 0; + KillFrame.PrevFrame := SqInfo^.SqBase.LastFree; + ReadVarFrame(TmpFrame, SqInfo^.SqBase.LastFree); + TmpFrame.NextFrame := KillPos; + WriteVarFrame(TmpFrame, SqInfo^.SqBase.LastFree); + SqInfo^.SqBase.LastFree := KillPos; + End; + WriteVarFrame(KillFrame, KillPos); + FreeCtr := 1; + While ((FreeCtr < MaxFree) and (FreeArray^[FreeCtr].FreePos <> 0)) Do + Inc(FreeCtr); + If FreeArray^[FreeCtr].FreePos = 0 Then Begin + FreeArray^[FreeCtr].FreePos := KillPos; + FreeArray^[FreeCtr].FreeSize := KillFrame.FrameLength; + End; + If FreeCtr > SqInfo^.HighestFree Then + SqInfo^.HighestFree := FreeCtr; + Dec(SqInfo^.SqBase.NumMsg); + Dec(SqInfo^.SqBase.HighMsg); + CurrMove := IndexPos; + While CurrMove <= SqInfo^.SqBase.NumMsg Do Begin + SqIdx^[CurrMove] := SqIdx^[CurrMove + 1]; + Inc(CurrMove); + End; + End; + End; + If Not AlreadyLocked Then + If UnlockMsgBase Then; +End; + +Procedure TMsgBaseSquish.ReadMsgHdr(FPos: LongInt); {Read msg hdr for frame at FPos} +Var + NumRead: LongInt; +Begin + Seek(SqInfo^.SqdFile, FPos + SqFSize); + SqInfo^.Error := IoResult; + If SqInfo^.Error = 0 Then Begin + If Not ioBlockRead(SqInfo^.SqdFile, SqInfo^.MsgHdr, SizeOf(SqMsgHdrType), NumRead) Then + SqInfo^.Error := ioCode; + End; +End; + +Procedure TMsgBaseSquish.WriteMsgHdr(FPos: LongInt); {Read msg hdr for frame at FPos} +Var + Res : LongInt; +Begin + Seek(SqInfo^.SqdFile, FPos + SqFSize); + SqInfo^.Error := IoResult; + If SqInfo^.Error = 0 Then Begin + If Not ioBlockWrite(SqInfo^.SqdFile, SqInfo^.MsgHdr, SizeOf(SqMsgHdrType), Res) Then + SqInfo^.Error := ioCode; + End; +End; + +Procedure TMsgBaseSquish.WriteText(FPos: LongInt); {Write text buffer for frame at Fpos} +Var + Res : LongInt; +Begin + Seek(SqInfo^.SqdFile, FPos + SqFSize + SqMSize); + SqInfo^.Error := IoResult; + If SqInfo^.Error = 0 Then Begin + If Not ioBlockWrite(SqInfo^.SqdFile, SqInfo^.MsgChars, SqInfo^.TxtCtr, Res) Then + SqInfo^.Error := ioCode; + End; +End; + +Function TMsgBaseSquish.GetBeginFrame: LongInt; {Get beginning frame pos} +Begin + GetBeginFrame := SqInfo^.SqBase.BeginFrame; +End; + +Function TMsgBaseSquish.GetNextFrame: LongInt; {Get next frame pos} +Begin + GetNextFrame := SqInfo^.Frame.NextFrame; +End; + +Procedure TMsgBaseSquish.ReadText(FPos: LongInt); +Begin + Seek(SqInfo^.SqdFile, FPos + SqFSize + SqMSize); + SqInfo^.Error := IoResult; + If SqInfo^.Error = 0 Then Begin + If SqInfo^.Frame.MsgLength > SqTxtBufferSize Then + BlockRead(SqInfo^.SqdFile, SqInfo^.MsgChars, SqTxtBufferSize) + Else + BlockRead(SqInfo^.SqdFile, SqInfo^.MsgChars, SqInfo^.Frame.MsgLength); + SqInfo^.Error := IoResult; + End; + SqInfo^.TxtCtr := 1 + SqInfo^.Frame.ControlLength; + SqInfo^.MsgDone := False; + LastSoft := False; +End; + +Procedure TMsgBaseSquish.InitText; +Begin + SqInfo^.TxtCtr := 0; +End; + +Procedure TMsgBaseSquish.DoString (Str: String); {Add string to message text} +Var + i: Word; +Begin + i := 1; + While i <= Length(Str) Do Begin + DoChar(Str[i]); + Inc(i); + End; +End; + +Procedure TMsgBaseSquish.DoChar (Ch: Char); {Add character to message text} +Begin + If SqInfo^.TxtCtr < SqTxtBufferSize Then Begin + Inc(SqInfo^.TxtCtr); + SqInfo^.MsgChars[SqInfo^.TxtCtr] := Ch; + End; +End; + +Procedure TMsgBaseSquish.DoStringLn(Str: String); {Add string and newline to msg text} +Begin + DoString(Str); + DoChar(#13); +End; + +Procedure TMsgBaseSquish.KillExcess; +Var + AlreadyLocked: Boolean; +Begin + AlreadyLocked := SqInfo^.Locked; + If Not AlreadyLocked Then + If LockMsgBase Then; + If SqIdx = Nil Then + SqInfo^.error := 999 + Else Begin + If ((SqInfo^.SqBase.MaxMsg > 0) and + (SqInfo^.SqBase.MaxMsg > SqInfo^.SqBase.SkipMsg)) Then Begin + While (SqInfo^.SqBase.NumMsg > SqInfo^.SqBase.MaxMsg) Do + KillMsg(SqIdx^[SqInfo^.SqBase.SkipMsg + 1].UMsgId); + End; + End; + If Not AlreadyLocked Then + If UnlockMsgBase Then; +End; + +Function TMsgBaseSquish.WriteMsg: Word; {Write msg to msg base} +Var + MsgSize : LongInt; + FrameSize : LongInt; + FramePos : LongInt; + TmpFrame : SqFrameHdrType; + TmpDate : LongInt; + TmpDT : DateTime; + TmpStr : String; + AlreadyLocked : Boolean; +Begin + DoChar(#0); + TmpDT.Year := strS2I(Copy(SqInfo^.StrDate,7,2)); + If TmpDT.Year > 79 Then + Inc(TmpDT.Year, 1900) + Else + Inc(TmpDT.Year, 2000); + TmpDT.Month := strS2I(Copy(SqInfo^.StrDate,1,2)); + TmpDT.Day := strS2I(Copy(SqInfo^.StrDate,4,2)); + TmpDt.Hour := strS2I(Copy(SqInfo^.StrTime,1,2)); + TmpDt.Min := strS2I(Copy(SqInfo^.StrTime, 4,2)); + TmpDt.Sec := 0; + TmpStr := FormattedDate(TmpDT, 'DD NNN YY ') + Copy(SqInfo^.StrTime, 1, 5) + ':00'; + PackTime(TmpDT, TmpDate); + SqInfo^.MsgHdr.DateWritten := (TmpDate shr 16) + ((TmpDate and $ffff) shl 16); + TmpDate := CurDateDos; + SqInfo^.MsgHdr.DateArrived := (TmpDate shr 16) + ((TmpDate and $ffff) shl 16); + Str2AZ(TmpStr, 20, SqInfo^.MsgHdr.AZDate); + AlreadyLocked := SqInfo^.Locked; + If Not AlreadyLocked Then + If LockMsgBase Then; + If SqInfo^.Locked Then Begin + MsgSize := SqInfo^.TxtCtr + SqMSize; + FrameSize := MsgSize; + + FindFrame(FrameSize, FramePos); + + If SqInfo^.SqBase.LastFrame <> 0 Then Begin + ReadVarFrame(TmpFrame, SqInfo^.SqBase.LastFrame); + TmpFrame.NextFrame := FramePos; + WriteVarFrame(TmpFrame, SqInfo^.SqBase.LastFrame); + TmpFrame.PrevFrame := SqInfo^.SqBase.LastFrame; + End Else Begin + SqInfo^.SqBase.BeginFrame := FramePos; + TmpFrame.PrevFrame := 0; + End; + + TmpFrame.Id := SqHdrId; + TmpFrame.FrameType := SqFrameMsg; + SqInfo^.SqBase.LastFrame := FramePos; + TmpFrame.NextFrame := 0; + TmpFrame.FrameLength := FrameSize; + TmpFrame.MsgLength := MsgSize; + TmpFrame.ControlLength := 0; + + If TmpFrame.FrameLength = 0 Then Begin + TmpFrame.FrameLength := TmpFrame.MsgLength + 0; {slack to minimize free frames} + SqInfo^.SqBase.EndFrame := FramePos + SqFSize + TmpFrame.FrameLength; + End; + + If SqInfo^.SqBase.NumMsg >= SqInfo^.SqiAlloc Then Begin + WriteIdx; + ReadIdx; + End; + + If SqIdx = Nil Then Begin + SqInfo^.Error := 999; + WriteMsg := 999; + End Else Begin + WriteVarFrame(TmpFrame, FramePos); + WriteMsgHdr(FramePos); + WriteText(FramePos); + + Inc(SqInfo^.SqBase.NumMsg); + + SqIdx^[SqInfo^.SqBase.NumMsg].Ofs := FramePos; + SqIdx^[SqInfo^.SqBase.NumMsg].UMsgId := SqInfo^.SqBase.UID; + SqIdx^[SqInfo^.SqBase.NumMsg].Hash := SqHashName(strWide2Str(SqInfo^.MsgHdr.MsgTo, 35)); + + Inc(SqInfo^.SqBase.UId); + + SqInfo^.SqBase.HighMsg := SqInfo^.SqBase.NumMsg; + + KillExcess; + + SqInfo^.CurrIdx := SqInfo^.SqBase.NumMsg; + + WriteMsg := 0; + End; + If Not AlreadyLocked Then + If UnLockMsgBase Then; + End Else + WriteMsg := 5; +End; + +(* +Function TMsgBaseSquish.GetString (MaxLen : Word) : String; +Var + StartSoft : Boolean; + Str : String; + Ch : Char; + WLen : Byte; + WPos : Word; +Begin + StartSoft := LastSoft; + LastSoft := True; + WLen := 0; + WPos := 0; + Str := ''; + + While (Length(Str) < MaxLen) and (not SqInfo^.MsgDone) Do Begin + Ch := GetChar; + Case Ch of + #00, + #13 : Begin + LastSoft := True; + Break; + End; + #10, + #141: ; + #32 : If (Str <> '') or (Not StartSoft) Then Begin + Str := Str + Ch; + WLen := Length(Str); + WPos := SqInfo^.TxtCtr; + End Else + StartSoft := False; + Else + Str := Str + Ch; + End; + End; + + If (Not (Ch in [#00, #13])) and (Not SqInfo^.MsgDone) Then + If WLen = 0 Then + Dec(SqInfo^.TxtCtr) + Else Begin + Str[0] := Chr(WLen); + SqInfo^.TxtCtr := WPos; + End; + + GetString := Str; +End; +*) + +Function TMsgBaseSquish.GetString(MaxLen: Word): String; +Var + WPos : Word; + WLen : Byte; + StrDone : Boolean; +// TxtOver : Boolean; + StartSoft : Boolean; + CurrLen : Word; +// PPos : Word; + TmpCh : Char; +Begin + StrDone := False; + CurrLen := 0; +// PPos := SqInfo^.TxtCtr; + WPos := 0; + WLen := 0; + StartSoft := LastSoft; + LastSoft := True; +{ TmpCh := GetChar;} + While ((Not StrDone) And (CurrLen < MaxLen) And (Not SqInfo^.MsgDone)) Do Begin + TmpCh := GetChar; + Case TmpCh of + #00, + #13 : Begin + StrDone := True; + LastSoft := False; + End; + #10, + #141: ; + #32 : Begin + If ((CurrLen <> 0) or (Not StartSoft)) Then Begin + Inc(CurrLen); + WLen := CurrLen; + GetString[CurrLen] := TmpCh; + WPos := SqInfo^.TxtCtr; + End Else + StartSoft := False; + End; + Else + Inc(CurrLen); + GetString[CurrLen] := TmpCh; + End; +{ If Not StrDone Then TmpCh := GetChar;} + End; + + If StrDone Then Begin + GetString[0] := Chr(CurrLen); + End Else + If SqInfo^.MsgDone Then Begin + GetString[0] := Chr(CurrLen); + End Else Begin + If WLen = 0 Then Begin + GetString[0] := Chr(CurrLen); + Dec(SqInfo^.TxtCtr); + End Else Begin + GetString[0] := Chr(WLen); + SqInfo^.TxtCtr := WPos; + End; + End; +End; + +Function TMsgBaseSquish.EOM: Boolean; +Begin + EOM := (SqInfo^.TxtCtr >= SqInfo^.Frame.MsgLength) or (SqInfo^.MsgChars[SqInfo^.TxtCtr] = #0); +End; + +(* +Function TMsgBaseSquish.WasWrap: Boolean; +Begin + WasWrap := LastSoft; +End; +*) + +Function TMsgBaseSquish.GetChar: Char; +Begin + If (SqInfo^.TxtCtr >= SqInfo^.Frame.MsgLength) or (SqInfo^.MsgChars[SqInfo^.TxtCtr] = #0) Then Begin + GetChar := #0; + SqInfo^.MsgDone := True; + End Else Begin + GetChar := SqInfo^.MsgChars[SqInfo^.TxtCtr]; + Inc(SqInfo^.TxtCtr); + End; +End; + + +Function TMsgBaseSquish.GetHighWater: LongInt; {Get high water umsgid} +Begin + GetHighWater := LongInt(SqInfo^.SqBase.HighWater); +End; + +Function TMsgBaseSquish.GetHighMsgNum: LongInt; {Get highest msg number} +Begin + GetHighMsgNum := LongInt(SqInfo^.SqBase.Uid) - 1; +End; + +Procedure TMsgBaseSquish.ReadIdx; +Var + NumRead: LongInt; +Begin + If SqInfo^.SqiAlloc > 0 Then + If SqIdx <> Nil Then + FreeMem(SqIdx, SqInfo^.SqiAlloc * SizeOf(SqIdxType)); + SqInfo^.SqiAlloc := FileSize(SqInfo^.SqiFile) + 100; + If SqInfo^.SqiAlloc > SqIdxArraySize Then + SqInfo^.SqiAlloc := SqIdxArraySize ; + GetMem(SqIdx, SqInfo^.SqiAlloc * SizeOf(SqIdxType)); + If SqIdx = nil Then + SqInfo^.Error := 999 + Else Begin + Seek(SqInfo^.SqiFile, 0); + If IoResult = 0 Then Begin + If Not ioBlockRead(SqInfo^.SqiFile, SqIdx^, SqInfo^.SqiAlloc, NumRead) Then + SqInfo^.Error := ioCode; + End Else + SqInfo^.Error := 300; + End; +End; + +Procedure TMsgBaseSquish.WriteIdx; +Var + Res : LongInt; +Begin + If SqIdx = nil Then + SqInfo^.Error := 999 + Else Begin + Seek(SqInfo^.SqiFile, 0); + Truncate(SqInfo^.SqiFile); + If IoResult = 0 Then Begin + If Not ioBlockWrite(SqInfo^.SqiFile, SqIdx^, SqInfo^.SqBase.NumMsg, Res) Then + SqInfo^.Error := ioCode; + End Else + SqInfo^.Error := 300; + End; +End; + +Procedure TMsgBaseSquish.SeekFirst(MsgNum: LongInt); +Begin + SqInfo^.CurrIdx := 1; + ReadIdx; + While ((SqInfo^.CurrIdx <= SqInfo^.SqBase.NumMsg) and + (MsgNum > LongInt(SqIdx^[SqInfo^.CurrIdx].UMsgId))) Do + SeekNext; +End; + +Function TMsgBaseSquish.IdxHighest: LongInt; +Var + i: Word; + Tmp: LongInt; +Begin + Tmp := 0; + i := 1; + While i <= SqInfo^.SqBase.NumMsg Do Begin + If SqIdx^[i].UMsgId > Tmp Then Tmp := SqIdx^[i].UMsgId; + Inc(i); + End; + IdxHighest := Tmp; +End; + +Function TMsgBaseSquish.GetMsgNum: LongInt; +Begin + If ((SqInfo^.CurrIdx <= SqInfo^.SqBase.NumMsg) and + (SqInfo^.CurrIdx > 0)) Then + GetMsgNum := LongInt(SqIdx^[SqInfo^.CurrIdx].UMsgId) + Else + GetMsgNum := -1; +End; + +Procedure TMsgBaseSquish.SeekNext; +Begin + Inc(SqInfo^.CurrIdx); +End; + +Procedure TMsgBaseSquish.SeekPrior; + Begin + If SqInfo^.CurrIdx > 1 Then + Dec(SqInfo^.CurrIdx) + Else + SqInfo^.CurrIdx := 0; + End; + +Function TMsgBaseSquish.SeekFound: Boolean; + Begin + SeekFound := GetMsgNum >= 0; + End; + +Function TMsgBaseSquish.GetIdxFramePos: LongInt; + Begin + If SqInfo^.CurrIdx <= SqInfo^.SqBase.NumMsg Then + GetIdxFramePos := SqIdx^[SqInfo^.CurrIdx].Ofs + Else + GetIdxFramePos := -1; + End; + +Function TMsgBaseSquish.GetIdxHash: LongInt; + Begin + If SqInfo^.CurrIdx <= SqInfo^.SqBase.NumMsg Then + GetIdxHash := SqIdx^[SqInfo^.CurrIdx].Hash + Else + GetIdxHash := 0; + End; + +Function TMsgBaseSquish.IsLocal: Boolean; {Is current msg local} +Begin + IsLocal := ((SqInfo^.MsgHdr.Attr and SqMsgLocal) <> 0); +End; + +Function TMsgBaseSquish.IsCrash: Boolean; {Is current msg crash} +Begin + IsCrash := ((SqInfo^.MsgHdr.Attr and SqMsgCrash) <> 0); +End; + +Function TMsgBaseSquish.IsKillSent: Boolean; {Is current msg kill sent} +Begin + IsKillSent := ((SqInfo^.MsgHdr.Attr and SqMsgKill) <> 0); +End; + +Function TMsgBaseSquish.IsSent: Boolean; {Is current msg sent} +Begin + IsSent := ((SqInfo^.MsgHdr.Attr and SqMsgSent) <> 0); +End; + +Function TMsgBaseSquish.IsFAttach: Boolean; {Is current msg file attach} +Begin + IsFAttach := ((SqInfo^.MsgHdr.Attr and SqMsgFile) <> 0); +End; + +Function TMsgBaseSquish.IsReqRct: Boolean; {Is current msg request receipt} +Begin + IsReqRct := ((SqInfo^.MsgHdr.Attr and SqMsgRRQ) <> 0); +End; + +Function TMsgBaseSquish.IsReqAud: Boolean; {Is current msg request audit} +Begin + IsReqAud := ((SqInfo^.MsgHdr.Attr and SqMsgArq) <> 0); +End; + +Function TMsgBaseSquish.IsRetRct: Boolean; {Is current msg a return receipt} +Begin + IsRetRct := ((SqInfo^.MsgHdr.Attr and SqMsgCpt) <> 0); +End; + +Function TMsgBaseSquish.IsFileReq: Boolean; {Is current msg a file request} +Begin + IsFileReq := ((SqInfo^.MsgHdr.Attr and SqMsgFreq) <> 0); +End; + +Function TMsgBaseSquish.IsRcvd: Boolean; {Is current msg received} +Begin + IsRcvd := ((SqInfo^.MsgHdr.Attr and SqMsgRcvd) <> 0); +End; + +Function TMsgBaseSquish.IsPriv: Boolean; {Is current msg priviledged/private} +Begin + IsPriv := ((SqInfo^.MsgHdr.Attr and SqMsgPriv) <> 0); +End; + +Function TMsgBaseSquish.IsEchoed: Boolean; +Begin + IsEchoed := ((SqInfo^.MsgHdr.Attr and SqMsgScanned) = 0); +End; + +Function TMsgBaseSquish.IsDeleted: Boolean; {Is current msg deleted} +Begin + IsDeleted := False; +End; + +Function TMsgBaseSquish.GetRefer: LongInt; {Get reply to of current msg} +Begin + GetRefer := LongInt(SqInfo^.MsgHdr.ReplyTo); +End; + +Procedure TMsgBaseSquish.SetRefer(Num: LongInt); {Set reply to of current msg} +Begin + SqInfo^.MsgHdr.ReplyTo := LongInt(Num); +End; + +Function TMsgBaseSquish.GetSeeAlso: LongInt; {Get see also msg} +Begin + GetSeeAlso := LongInt(SqInfo^.MsgHdr.Replies[1]); +End; + +Procedure TMsgBaseSquish.SetSeeAlso(Num: LongInt); {Set see also msg} +Begin + SqInfo^.MsgHdr.Replies[1] := LongInt(Num); +End; + +Procedure TMsgBaseSquish.SetAttr(St: Boolean; Mask: LongInt); {Set attribute} +Begin + If St Then + SqInfo^.MsgHdr.Attr := SqInfo^.MsgHdr.Attr or Mask + Else + SqInfo^.MsgHdr.Attr := SqInfo^.MsgHdr.Attr and (Not Mask); +End; + +Procedure TMsgBaseSquish.SetLocal(St: Boolean); {Set local status} +Begin + SetAttr(St, SqMsgLocal); +End; + +Procedure TMsgBaseSquish.SetRcvd(St: Boolean); {Set received status} +Begin + SetAttr(St, SqMsgRcvd); +End; + +Procedure TMsgBaseSquish.SetPriv(St: Boolean); {Set priveledge vs public status} +Begin + SetAttr(St, SqMsgPriv); +End; + +Procedure TMsgBaseSquish.SetEcho(ES: Boolean); +Begin + SetAttr(Not ES, SqMsgScanned); +End; + +Procedure TMsgBaseSquish.SetCrash(St: Boolean); {Set crash netmail status} +Begin + SetAttr(St, SqMsgCrash); +End; + +Procedure TMsgBaseSquish.SetHold (ST: Boolean); +Begin + SetAttr (ST, SqMsgHold); +End; + +Procedure TMsgBaseSquish.SetKillSent(St: Boolean); {Set kill/sent netmail status} +Begin + SetAttr(St, SqMsgKill); +End; + +Procedure TMsgBaseSquish.SetSent(St: Boolean); {Set sent netmail status} +Begin + SetAttr(St, SqMsgSent); +End; + +Procedure TMsgBaseSquish.SetFAttach(St: Boolean); {Set file attach status} +Begin + SetAttr(St, SqMsgFile); +End; + +Procedure TMsgBaseSquish.SetReqRct(St: Boolean); {Set request receipt status} +Begin + SetAttr(St, SqMsgRrq); +End; + +Procedure TMsgBaseSquish.SetReqAud(St: Boolean); {Set request audit status} +Begin + SetAttr(St, SqMsgarq); +End; + +Procedure TMsgBaseSquish.SetRetRct(St: Boolean); {Set return receipt status} +Begin + SetAttr(St, SqMsgCpt); +End; + +Procedure TMsgBaseSquish.SetFileReq(St: Boolean); {Set file request status} +Begin + SetAttr(St, SqMsgFreq); +End; + +Procedure TMsgBaseSquish.MsgStartUp; +Begin + SqInfo^.CurrentFramePos := GetIdxFramePos; + SqInfo^.CurrentUID := SqIdx^[SqInfo^.CurrIdx].UMsgId; + ReadFrame(SqInfo^.CurrentFramePos); + ReadMsgHdr(SqInfo^.CurrentFramePos); +End; + +Procedure TMsgBaseSquish.MsgTxtStartUp; +//Var +// CFrame: LongInt; +Begin + ReadText(SqInfo^.CurrentFramePos); +End; + +Procedure TMsgBaseSquish.SetMailType(MT: MsgMailType); +Begin +End; + +Function TMsgBaseSquish.GetSubArea: Word; +Begin + GetSubArea := 0; +End; + +Procedure TMsgBaseSquish.ReWriteHdr; +Var + AlreadyLocked : Boolean; + I : LongInt; +Begin + AlreadyLocked := SqInfo^.Locked; + + If Not AlreadyLocked Then + If LockMsgBase Then; + + WriteFrame(SqInfo^.CurrentFramePos); + WriteMsgHdr(SqInfo^.CurrentFramePos); + + i := 1; + + While ((i <= SqInfo^.SqBase.NumMsg) and (SqInfo^.CurrentFramePos <> SqIdx^[i].Ofs)) Do + Inc(i); + + If SqIdx^[i].Ofs = SqInfo^.CurrentFramePos Then Begin + If IsRcvd Then + SqIdx^[i].Hash := 0 + Else + SqIdx^[i].Hash := SqHashName(SqInfo^.MsgHdr.MsgTo); + End; + + If Not AlreadyLocked Then + If UnLockMsgBase Then; +End; + +Procedure TMsgBaseSquish.DeleteMsg; +Begin + KillMsg(SqInfo^.CurrentUID); +End; + +Function TMsgBaseSquish.NumberOfMsgs: LongInt; +Var + TmpBase: SqBaseType; +Begin + If LoadFile(SqInfo^.FN + '.sqd', TmpBase, SizeOf(TmpBase)) = 0 Then + NumberOfMsgs := TmpBase.NumMsg + Else + NumberOfMsgs := 0; +End; + +Function TMsgBaseSquish.GetLastRead(UNum: LongInt): LongInt; +Var + LRec: LongInt; +Begin + If ((UNum + 1) * SizeOf(LRec)) > GetFileSize(SqInfo^.FN + '.sql') Then + GetLastRead := 0 + Else Begin + If LoadFilePos(SqInfo^.FN + '.sql', LRec, SizeOf(LRec), UNum * SizeOf(LRec)) = 0 Then + GetLastRead := LRec + Else + GetLastRead := 0; + End; +End; + +Procedure TMsgBaseSquish.SetLastRead(UNum: LongInt; LR: LongInt); +Var + LRec : LongInt; + Status : Word; +Begin + Status := 0; + If ((UNum + 1) * SizeOf(LRec)) > GetFileSize(SqInfo^.FN + '.sql') Then Begin + Status := ExtendFile(SqInfo^.FN + '.sql', (UNum + 1) * SizeOf(LRec)); + End; + LRec := LR; + If Status = 0 Then + Status := SaveFilePos(SqInfo^.FN + '.sql', LRec, SizeOf(LRec), + UNum * SizeOf(LRec)); +End; + +Function TMsgBaseSquish.GetMsgLoc: LongInt; +Begin + GetMsgLoc := GetMsgNum; +End; + +Procedure TMsgBaseSquish.SetMsgLoc(ML: LongInt); +Begin + SeekFirst(ML); +End; + +Procedure TMsgBaseSquish.YoursFirst(Name: String; Handle: String); +Begin + SqInfo^.CurrIdx := 0; + ReadIdx; + SqInfo^.SName := strUpper(Name); + SqInfo^.SHandle := strUpper(Handle); + SqInfo^.HName := SqHashName(Name); + SqInfo^.HHandle := SqHashName(Handle); + YoursNext; +End; + +Procedure TMsgBaseSquish.YoursNext; +Var + WasFound: Boolean; +Begin + WasFound := False; + Inc(SqInfo^.CurrIdx); + While ((SqInfo^.CurrIdx <= SqInfo^.SqBase.NumMsg) and (Not WasFound)) Do Begin + While ((SqIdx^[SqInfo^.CurrIdx].Hash <> SqInfo^.HName) And + (SqIdx^[SqInfo^.CurrIdx].Hash <> SqInfo^.HHandle) And + (SqInfo^.CurrIdx <= SqInfo^.SqBase.NumMsg)) Do + Inc(SqInfo^.CurrIdx); + If SqInfo^.CurrIdx <= SqInfo^.SqBase.NumMsg Then Begin + MsgStartUp; + If ((Not IsRcvd) and + ((strUpper(GetTo) = SqInfo^.SName) or (strUpper(GetTo) = SqInfo^.SHandle))) Then + WasFound := True + Else + Inc(SqInfo^.CurrIdx); + End; + End; +End; + +Function TMsgBaseSquish.YoursFound: Boolean; +Begin + YoursFound := SqInfo^.CurrIdx <= SqInfo^.SqBase.NumMsg; +End; + +Function TMsgBaseSquish.GetMsgDisplayNum: LongInt; +Begin + GetMsgDisplayNum := SqInfo^.CurrIdx; +End; + +Function TMsgBaseSquish.GetTxtPos: LongInt; +Begin + GetTxtPos := SqInfo^.TxtCtr; +End; + +Procedure TMsgBaseSquish.SetTxtPos(TP: LongInt); +Begin + SqInfo^.TxtCtr := TP; +End; + +Procedure TMsgBaseSquish.EditMsgInit; +Begin + SqInfo^.TxtCtr := 0; +End; + +Procedure TMsgBaseSquish.EditMsgSave; +Begin +(* + DeleteMsg; + + Dec(SqInfo^.CurrentUID); + Dec(SqInfo^.SqBase.UId); + + WriteMsg; +*) +rewritehdr; +End; + +End. diff --git a/mystic/bbs_nodechat.pas b/mystic/bbs_nodechat.pas new file mode 100644 index 0000000..a78cacc --- /dev/null +++ b/mystic/bbs_nodechat.pas @@ -0,0 +1,497 @@ +Unit bbs_NodeChat; + +{$I M_OPS.PAS} + +Interface + +Procedure Node_Chat; + +Implementation + +Uses + m_Strings, + m_DateTime, + m_FileIO, + bbs_NodeInfo, + bbs_Common, + bbs_User, + bbs_Core; + +Var + ChatSize : Byte; + ChatUpdate : LongInt; + TextPos : Byte; + TopPage : Byte; + LinePos : Byte; + Full : Boolean; + +Procedure FullReDraw; +Var + Count : Byte; + Temp : Byte; +Begin + If Not Full Then Exit; + + Session.io.AnsiGotoXY (1, Session.io.ScreenInfo[1].Y); + + Temp := TopPage; + + For Count := 0 to ChatSize Do Begin + Session.io.AnsiClrEOL; + If Temp <= TextPos Then Begin + Session.io.OutPipeLn (Session.Msgs.MsgText[Temp]); + Inc (Temp); + End Else + Session.io.OutRawLn(''); + End; +End; + +Procedure Change_Room (R : Byte); +Var + CF : File of ChatRec; +Begin + If (R < 1) or (R > 99) Then Exit; + + Reset (RoomFile); + Seek (RoomFile, R-1); + Read (RoomFile, Room); + Close (RoomFile); + + Chat.Room := R; + CurRoom := R; + + Assign (CF, Config.DataPath + 'chat' + strI2S(Session.NodeNum) + '.dat'); + Reset (CF); + Write (CF, Chat); + Close (CF); + + Send_Node_Message (5, strI2S(Session.NodeNum) + ';' + 'Now chatting in channel ' + strI2S(CurRoom), 0); //++lang +End; + +Procedure Update_Topic; +Begin + If Not Full Then Exit; + + { look around and make common function called goscreeninfo(num) that } + { goes to an x/y position and changes the attribute } + + Session.io.AnsiGotoXY (Session.io.ScreenInfo[4].X, Session.io.ScreenInfo[4].Y); + Session.io.AnsiColor (Session.io.ScreenInfo[4].A); + + Session.io.OutRaw (strPadR(strI2S(CurRoom), 2, ' ')); + + Session.io.AnsiGotoXY (Session.io.ScreenInfo[5].X, Session.io.ScreenInfo[5].Y); + Session.io.AnsiColor (Session.io.ScreenInfo[5].A); + + Session.io.OutRaw (strPadR(Room.Name, 40, ' ')); +End; + +Function GetKeyNodeChatFunc (Forced : Boolean) : Boolean; +{ 1 = node chat broadcast message (if room = 0) + node chat regular text (if room = room user is in) + 4 = node chat private message + 5 = chat broadcast (ie: xxx has entered chat) + 6 = chat action (ie: g00r00 claps his hands) + 7 = chat topic update } + + Procedure AddText (Str : String); + Var + Count : Byte; + Begin + If TextPos < 200 Then + Inc (TextPos) + Else + For Count := 2 to 200 Do + Session.Msgs.MsgText[Count - 1] := Session.Msgs.MsgText[Count]; + + Session.Msgs.MsgText[TextPos] := Str; + End; + +Var + Str : String; + StrLen : Byte; + Indent : Byte; + Lines : Byte; + OldAttr : Byte; + OldX : Byte; + OldY : Byte; +Begin + GetKeyNodeChatFunc := False; + + If Session.User.InChat or Session.InUserEdit Then Exit; + + If (TimerSeconds - ChatUpdate <> 0) or Forced Then Begin + + Assign (NodeMsgFile, Session.TempPath + 'chat.tmp'); + FileMode := 66; + {$I-} Reset (NodeMsgFile); {$I+} + If IoResult = 0 Then Begin + + OldAttr := Screen.TextAttr; + OldX := Screen.CursorX; + OldY := Screen.CursorY; + + While Not Eof(NodeMsgFile) Do Begin + Read (NodeMsgFile, NodeMsg); + + If NodeMsg.MsgType in [1, 4..7] Then Begin + Session.io.OutRaw (Session.io.Pipe2Ansi(16)); + + Case NodeMsg.MsgType of + 1 : If NodeMsg.Room = 0 Then + Str := strReplace(Session.GetPrompt(319), '|&1', NodeMsg.FromWho) + Else + If NodeMsg.Room = CurRoom Then + Str := strReplace(Session.GetPrompt(181), '|&1', NodeMsg.FromWho) + Else + Continue; + 4 : Str := strReplace(Session.GetPrompt(218), '|&1', NodeMsg.FromWho); + 5 : Str := Session.GetPrompt(226); + 6 : Str := strReplace(Session.GetPrompt(229), '|&1', NodeMsg.FromWho); + 7 : Begin + Reset (RoomFile); + Seek (RoomFile, CurRoom - 1); + Read (RoomFile, Room); + Close (RoomFile); + + Update_Topic; + Str := Session.GetPrompt(226); + End; + End; + + If Full Then Begin + StrLen := Length(Str); + Indent := Length(strStripMCI(Str)); + Lines := 0; + + Repeat + Inc (Lines); + + If Length(Str + NodeMsg.Message) > 79 Then Begin + Str := Str + Copy(NodeMsg.Message, 1, 79 - StrLen); + AddText(Str); + Delete (NodeMsg.Message, 1, 79 - StrLen); + Str := strRep(' ', Indent); + End Else Begin + AddText(Str + NodeMsg.Message); + Break; + End; + Until False; + + If LinePos + Lines > Session.io.ScreenInfo[2].Y Then Begin + Indent := (ChatSize DIV 2) - 2; + TopPage := TextPos - Indent; + LinePos := Session.io.ScreenInfo[1].Y + Indent + 1; + FullReDraw; + End Else Begin + Session.io.AnsiGotoXY(1, LinePos); + For Indent := Lines DownTo 1 Do Begin + Session.io.AnsiClrEOL; + Session.io.OutPipeLn(Session.Msgs.MsgText[TextPos - Indent + 1]); + Inc (LinePos); + End; + End; + + Session.io.AnsiGotoXY (OldX, OldY); + End Else Begin + If Session.io.Graphics = 0 Then + Session.io.OutBS (Screen.CursorX, True) + Else Begin + Session.io.AnsiMoveX(1); + Session.io.AnsiClrEOL; + End; + + Session.io.OutPipe (Str); + Session.io.OutPipeLn (NodeMsg.Message); + End; + End; + End; + + Close (NodeMsgFile); + Erase (NodeMsgFile); + + If Not Full And Not Forced Then Begin + Session.io.PromptInfo[1] := Session.User.ThisUser.Handle; + Session.io.OutFull ('|CR' + Session.GetPrompt(427)); + End; + + Session.io.AnsiColor (OldAttr); + + GetKeyNodeChatFunc := True; + End; + + ChatUpdate := TimerSeconds; + End; +End; + +Procedure Node_Chat; + + Procedure Chat_Template; + Begin + If Not Full Then Begin + Session.io.OutFile('teleconf', True, 0); + Exit; + End; + + Session.io.PromptInfo[1] := strI2S(CurRoom); + Session.io.PromptInfo[2] := Room.Name; + + Session.io.OutFile ('ansitele', True, 0); + + ChatSize := Session.io.ScreenInfo[2].Y - Session.io.ScreenInfo[1].Y; + + Update_Topic; + End; + + Procedure Show_Users_In_Chat; + Var + A : Byte; + Temp : ChatRec; + RM : RoomRec; + Begin + Session.io.OutFullLn (Session.GetPrompt(332)); + + For A := 1 to Config.INetTNMax Do Begin + Assign (ChatFile, Config.DataPath + 'chat' + strI2S(A) + '.dat'); + {$I-} Reset (ChatFile); {$I+} + If IoResult = 0 Then Begin + Read (ChatFile, Temp); + Close (ChatFile); + If Temp.InChat Then Begin + Reset (RoomFile); + Seek (RoomFile, Temp.Room - 1); + Read (RoomFile, RM); + Close (RoomFile); + Session.io.PromptInfo[1] := Temp.Name; + Session.io.PromptInfo[2] := strI2S(A); + Session.io.PromptInfo[3] := strI2S(Temp.Room); + Session.io.PromptInfo[4] := RM.Name; + Session.io.OutFullLn (Session.GetPrompt(333)); + End; + End; + End; + + Session.io.OutFullLn (Session.GetPrompt(453)); + + Chat_Template; + FullReDraw; + End; + + Procedure Send_Private_Message (Str : String); + Var + UserName : String; + Text : String; + Count : Byte; + Temp : ChatRec; + Begin + UserName := strUpper(strReplace(strWordGet(2, Str, ' '), '_', ' ')); + Text := Copy(Str, strWordPos(3, Str, ' '), Length(Str)); + + If Text = '' Then Exit; + + For Count := 1 to Config.INetTNMax Do Begin + Assign (ChatFile, Config.DataPath + 'chat' + strI2S(Count) + '.dat'); + {$I-} Reset (ChatFile); {$I+} + If IoResult = 0 Then Begin + Read (ChatFile, Temp); + Close (ChatFile); + If strUpper(Temp.Name) = UserName Then Begin + Send_Node_Message (4, strI2S(Count) + ';' + Text, 0); + Exit; + End; + End; + End; + + Send_Node_Message (5, strI2S(Session.NodeNum) + ';' + 'User ' + UserName + ' not found', 0); //++lang + End; + + Procedure ChatScrollBack; + Var + Ch : Char; + TopSave : Byte; + Begin + If Not Full Then Exit; + + TopSave := TopPage; + + Session.io.AnsiGotoXY (1, Session.io.ScreenInfo[3].Y); + Session.io.AnsiClrEOL; + Session.io.OutFull (Session.GetPrompt(237)); + + Repeat + Ch := Session.io.GetKey; + + If Ch = #27 Then Break; + + If Session.io.IsArrow Then + Case Ch of + #71 : If TopPage > 1 Then Begin + TopPage := 1; + FullReDraw; + End; + #72 : If TopPage > 1 Then Begin + Dec(TopPage); + FullReDraw; + End; + #73, + #75 : If TopPage > 1 Then Begin + If TopPage < ChatSize Then + TopPage := 1 + Else + Dec (TopPage, ChatSize); + FullReDraw; + End; + #79 : If TopPage < TopSave Then Begin + TopPage := TopSave; + FullReDraw; + End; + #80 : If TopPage < TopSave Then Begin + Inc(TopPage); + FullReDraw; + End; + #77, + #81 : If TopPage < TopSave Then Begin + If TopPage + ChatSize > TopSave Then + TopPage := TopSave + Else + Inc (TopPage, ChatSize); + FullReDraw; + End; + End; + Until False; + + TopPage := TopSave; + FullReDraw; + End; + +Var + Str : String; + Str2 : String; + Avail : Boolean; +Begin + Full := Session.User.ThisUser.UseFullChat And (Session.io.Graphics > 0); + + Set_Node_Action (Session.GetPrompt(347)); + + Avail := Chat.Available; + Chat.InChat := True; + Chat.Available := False; + + Assign (ChatFile, Config.DataPath + 'chat' + strI2S(Session.NodeNum) + '.dat'); + Reset (ChatFile); + Write (ChatFile, Chat); + Close (ChatFile); + + FileErase(Session.TempPath + 'chat.tmp'); + + Send_Node_Message (5, '0;' + Session.User.ThisUser.Handle + ' has entered chat', 0); //++lang + + Change_Room (1); + + Chat_Template; + + TopPage := 1; + TextPos := 0; + LinePos := Session.io.ScreenInfo[1].Y; + + FullReDraw; + + GetKeyFunc := GetKeyNodeChatFunc; + + Repeat + Session.io.PromptInfo[1] := Session.User.ThisUser.Handle; + + If Full Then Session.io.AnsiGotoXY (1, Session.io.ScreenInfo[3].Y) Else Session.io.OutRawLn(''); + + Session.io.OutFull (Session.GetPrompt(427)); + + If Full Then + Str := Session.io.GetInput (79 - Screen.CursorX + 1, 250, 19, '') + Else + Str := Session.io.GetInput (79 - Screen.CursorX + 1, 250, 11, ''); + + If Str[1] = '/' Then Begin + GetKeyFunc := NoGetKeyFunc; + + Str2 := strUpper(strWordGet(1, Str, ' ')); + + If Str2 = '/B' Then Begin + Str2 := Copy(Str, strWordPos(2, Str, ' '), Length(Str)); + If Str2 <> '' Then + Send_Node_Message (1, '0;' + Str2, 0) + End Else + If Str2 = '/CLS' Then Begin + TopPage := 1; + TextPos := 0; + LinePos := Session.io.ScreenInfo[1].Y; + + FullReDraw; + End Else + If Str2 = '/?' Then Begin + Session.io.OutFile ('telehelp', True, 0); + Chat_Template; + FullReDraw + End Else + If Str2 = '/SCROLL' Then + ChatScrollBack + Else + If Str2 = '/Q' Then + Break + Else + If Str2 = '/ME' Then Begin + Str := Copy(Str, 5, Length(Str)); + + If Str <> '' Then + Send_Node_Message (6, '0;' + Str, CurRoom); + End Else + If Str2 = '/MSG' Then + Send_Private_Message(Str) + Else + If Str2 = '/NAMES' Then + Show_Users_In_Chat + Else + If Str2 = '/JOIN' Then Begin + Change_Room (strS2I(strWordGet(2, Str, ' '))); + Update_Topic; + End Else + If Str2 = '/WHO' Then Begin + Session.io.AnsiClear; + Show_Whos_Online; + Chat_Template; + FullReDraw; + End Else + If Str2 = '/TOPIC' Then Begin + Room.Name := Copy(Str, strWordPos(2, Str, ' '), Length(Str)); + + Reset (RoomFile); + Seek (RoomFile, CurRoom - 1); + Write (RoomFile, Room); + Close (RoomFile); + + Send_Node_Message (7, '0;Topic changed to "' + Room.Name + '"', CurRoom); // ++lang + End; + + GetKeyFunc := GetKeyNodeChatFunc; + End Else + If Str <> '' Then Begin + Send_Node_Message (1, '0;' + Str, CurRoom); + If Not Full Then Session.io.OutRawLn(''); + GetKeyNodeChatFunc(True); + End; + Until False; + + GetKeyFunc := NoGetKeyFunc; + Chat.InChat := False; + Chat.Available := Avail; + + Assign (ChatFile, Config.DataPath + 'chat' + strI2S(Session.NodeNum) + '.dat'); + Reset (ChatFile); + Write (ChatFile, Chat); + Close (ChatFile); + + FileErase(Session.TempPath + 'chat.tmp'); + + Send_Node_Message (5, '0;' + Session.User.ThisUser.Handle + ' has left chat', 0); //++lang +End; + +End. diff --git a/mystic/bbs_nodeinfo.pas b/mystic/bbs_nodeinfo.pas new file mode 100644 index 0000000..ceb3477 --- /dev/null +++ b/mystic/bbs_nodeinfo.pas @@ -0,0 +1,196 @@ +Unit bbs_NodeInfo; { Multinode functions } + +{$I M_OPS.PAS} + +Interface + +Function Is_User_Online (Name : String) : Word; +Procedure Set_Node_Action (Action: String); +Procedure Show_Whos_Online; +Procedure Send_Node_Message (MsgType: Byte; Data: String; Room: Byte); + +Implementation + +Uses + m_DateTime, + m_Strings, + bbs_Common, + bbs_Core, + bbs_User; + +Function Is_User_Online (Name : String) : Word; +Var + TempChat : ChatRec; + Count : Word; +Begin + Is_User_Online := 0; + + For Count := 1 to Config.INetTNMax Do Begin + Assign (ChatFile, Config.DataPath + 'chat' + strI2S(Count) + '.dat'); + {$I-} Reset(ChatFile); {$I+} + If IoResult <> 0 Then Continue; + Read (ChatFile, TempChat); + Close (ChatFile); + + If (Count <> Session.NodeNum) and (TempChat.Active) and (TempChat.Name = Name) Then Begin + Is_User_Online := Count; + Exit; + End; + End; +End; + +Procedure Set_Node_Action (Action: String); +Begin + Assign (ChatFile, Config.DataPath + 'chat' + strI2S(Session.NodeNum) + '.dat'); + ReWrite (ChatFile); + + If Action <> '' Then Begin + Chat.Active := True; + Chat.Name := Session.User.ThisUser.Handle; + Chat.Location := Session.User.ThisUser.City; + Chat.Action := Action; + Chat.Gender := Session.User.ThisUser.Gender; + Chat.Age := DaysAgo(Session.User.ThisUser.Birthday) DIV 365; + If Session.LocalMode Then + Chat.Baud := 'LOCAL' {++lang} + Else + Chat.Baud := 'TELNET'; {++lang} + End Else Begin + Chat.Active := False; + Chat.Invisible := False; + Chat.Available := False; + Chat.Age := 0; + Chat.Gender := '?'; + End; + + Write (ChatFile, Chat); + Close (ChatFile); + + {$IFDEF WIN32} + Screen.SetWindowTitle (WinConsoleTitle + strI2S(Session.NodeNum) + ' - ' + Session.User.ThisUser.Handle + ' - ' + Action); + {$ENDIF} +End; + +Procedure Show_Whos_Online; +Var + TChat : ChatRec; + A : Word; +Begin + Session.io.OutFullLn (Session.GetPrompt(138)); + + For A := 1 to Config.INetTNMax Do Begin + Assign (ChatFile, Config.DataPath + 'chat' + strI2S(A) + '.dat'); + {$I-} Reset(ChatFile); {$I+} + If IoResult <> 0 Then Continue; + Read (ChatFile, TChat); + Close (ChatFile); + + If TChat.Active and ((Not TChat.Invisible) or (TChat.Invisible and Session.User.Access(Config.AcsSeeInvis))) Then Begin + Session.io.PromptInfo[1] := strI2S(A); + Session.io.PromptInfo[2] := TChat.Name; + Session.io.PromptInfo[3] := TChat.Action; + Session.io.PromptInfo[4] := TChat.Location; + Session.io.PromptInfo[5] := TChat.Baud; + Session.io.PromptInfo[6] := TChat.Gender; + Session.io.PromptInfo[7] := strI2S(TChat.Age); + Session.io.PromptInfo[8] := Session.io.OutYN(TChat.Available); + Session.io.OutFullLn (Session.GetPrompt(139)); + End Else Begin + Session.io.PromptInfo[1] := strI2S(A); + Session.io.OutFullLn (Session.GetPrompt(268)); + End; + End; + + Session.io.OutFull (Session.GetPrompt(140)); +End; + +Procedure Send_Node_Message (MsgType: Byte; Data: String; Room: Byte); +Var + ToNode : Byte; + A, B, C : Byte; + Temp : ChatRec; + Str : String[3]; +Begin + If Data = '' Then Begin + Repeat + Session.io.OutFull (Session.GetPrompt(146)); + Str := Session.io.GetInput(3, 3, 12, ''); + If Str = '?' Then Show_Whos_Online Else Break; + Until False; + + ToNode := strS2I(Str); + + If (ToNode < 0) or (ToNode > Config.INetTNMax) Then Begin + Session.io.OutFullLn (Session.GetPrompt(147)); + Exit; + End; + + B := ToNode; + C := ToNode; + End Else Begin + If Pos(';', Data) = 0 Then Exit; + ToNode := strS2I(Copy(Data, 1, Pos(';', Data)-1)); + Delete (Data, 1, Pos(';', Data)); + If ToNode = 0 Then Begin + B := 1; + C := Config.INetTNMax; + If MsgType = 3 Then MsgType := 2; +{ If Not (MsgType in [1, 4..7]) Then MsgType := 2;} +{ used line above comment now... see if that does anything } + + End Else Begin + B := ToNode; + C := ToNode; + End; + End; + + For A := B to C Do Begin + + Assign (ChatFile, Config.DataPath + 'chat' + strI2S(A) + '.dat'); + FileMode := 66; + {$I-} Reset (ChatFile); {$I+} + If IoResult = 0 Then Begin + Read (ChatFile, Temp); + Close (ChatFile); + + If (Not Temp.Active) and (ToNode > 0) Then Begin + Session.io.OutFullLn (Session.GetPrompt(147)); + Exit; + End; + + If (Not Temp.Available) and not (MsgType in [1, 4..7]) and (ToNode > 0) Then Begin + Session.io.OutFullLn (Session.GetPrompt(395)); + Exit; + End; + + If Temp.Active and (Temp.Available or Temp.InChat) Then Begin + If Data = '' Then Begin + Session.io.PromptInfo[1] := Temp.Name; { TEMP NODE NAME } + Session.io.PromptInfo[2] := strI2S(A); + Session.io.OutFullLn (Session.GetPrompt(148)); + NodeMsg.Message := Session.io.GetInput(79, 79, 11, ''); + End Else + NodeMsg.Message := Data; + + If NodeMsg.Message = '' Then Exit; + + NodeMsg.FromNode := Session.NodeNum; + NodeMsg.ToWho := Temp.Name; + NodeMsg.MsgType := MsgType; + NodeMsg.Room := Room; + NodeMsg.FromWho := Session.User.ThisUser.Handle; + + Assign (NodeMsgFile, Config.SystemPath + 'temp' + strI2S(A) + PathChar + 'chat.tmp'); + FileMode := 66; + {$I-} Reset (NodeMsgFile); {$I+} + If IoResult <> 0 Then ReWrite(NodeMsgFile); + + Seek (NodeMsgFile, FileSize(NodeMsgFile)); + Write (NodeMsgFile, NodeMsg); + Close (NodeMsgFile); + End; + End; + End; +End; + +End. diff --git a/mystic/bbs_sysopchat.pas b/mystic/bbs_sysopchat.pas new file mode 100644 index 0000000..677bfe5 --- /dev/null +++ b/mystic/bbs_sysopchat.pas @@ -0,0 +1,292 @@ +Unit bbs_SysOpChat; + +(* some ideas for chat: + +split chat additions: + +- scroll half window instead of just the last line +- allow full arrow key movement in chat windows... + kinda like a full screen editor... +- ctrl-k brings up a command menu, which has: + OutFull file + display file + dos drop? add mini-dos internal to mystic? + +*) +{$I M_OPS.PAS} + +Interface + +Procedure OpenChat (Split : Boolean); + +Implementation + +Uses + m_Types, + m_Strings, + m_DateTime, + bbs_Common, + bbs_Core, + bbs_User; + +Var + tFile : Text; + +Procedure Split_Chat; +Var + Update : LongInt = 0; + LastUser : Boolean; + UserStr : String; + SysopStr : String; + Temp1, + Temp2 : String; + Ch : Char; + UserX, + UserY : Byte; + SysopX, + SysopY : Byte; + X, Y, A : Byte; + +Procedure Total_ReDraw; +Begin + Session.io.PromptInfo[1] := Session.User.ThisUser.Handle; + Session.io.PromptInfo[2] := Config.SysopName; + + Session.io.ScreenInfo[9].X := 0; + Session.io.ScreenInfo[0].X := 0; + + Session.io.OutFile ('ansichat', True, 0); + + UserStr := ''; + UserX := Session.io.ScreenInfo[3].X; + UserY := Session.io.ScreenInfo[1].Y; + SysopX := Session.io.ScreenInfo[7].X; + SysopY := Session.io.ScreenInfo[5].Y; + SysopStr := ''; + + Session.io.AnsiGotoXY (SysopX, SysopY); + Session.io.AnsiColor (Session.io.ScreenInfo[5].A); + + LastUser := False; +End; + +Begin + Total_ReDraw; + + Repeat + If Update <> TimerMinutes Then Begin + X := Screen.CursorX; + Y := Screen.CursorY; + A := Screen.TextAttr; + + If Session.io.ScreenInfo[9].X <> 0 Then Begin + Session.io.AnsiGotoXY (Session.io.ScreenInfo[9].X, Session.io.ScreenInfo[9].Y); + Session.io.AnsiColor (Session.io.ScreenInfo[9].A); + Session.io.OutFull ('|$L04|TL'); + End; + + If Session.io.ScreenInfo[0].X <> 0 Then Begin + Session.io.AnsiGotoXY (Session.io.ScreenInfo[0].X, Session.io.ScreenInfo[0].Y); + Session.io.AnsiColor (Session.io.ScreenInfo[0].A); + Session.io.OutFull ('|TI'); + End; + + Session.io.AnsiGotoXY (X, Y); + Session.io.AnsiColor(A); + + Update := TimerMinutes; + End; + + Ch := Session.io.GetKey; + + If Not Session.io.LocalInput and Not LastUser Then Begin + Session.io.AnsiGotoXY (UserX, UserY); + Session.io.AnsiColor (Session.io.ScreenInfo[1].A); + LastUser := True; + End Else + If Session.io.LocalInput and LastUser Then Begin + Session.io.AnsiGotoXY (SysopX, SysopY); + Session.io.AnsiColor (Session.io.ScreenInfo[5].A); + LastUser := False; + End; + + Case Ch of + #00 : If Session.io.LocalInput Then Process_Sysop_Cmd(Input.ReadKey); + ^R : If Session.io.LocalInput Then Total_ReDraw; + #08 : If Session.io.LocalInput Then Begin + If SysopX > Session.io.ScreenInfo[7].X Then Begin + Session.io.OutBS (1, True); + Dec (SysopX); + Dec (SysopStr[0]); + End; + End Else Begin + If UserX > Session.io.ScreenInfo[3].X Then Begin + Session.io.OutBS (1, True); + Dec (UserX); + Dec (UserStr[0]); + End; + End; + #10 : ; + #13 : If Session.io.LocalInput Then Begin + sysopx := Session.io.ScreenInfo[7].x; + if sysopy = Session.io.ScreenInfo[6].y then begin + for sysopy := Session.io.ScreenInfo[6].y downto Session.io.ScreenInfo[5].y do begin + Session.io.AnsiGotoXY(Session.io.ScreenInfo[7].x, sysopy); + Session.io.OutRaw (strRep(' ', Session.io.ScreenInfo[8].x - Session.io.ScreenInfo[7].x + 1)); + Session.io.AnsiGotoXY(Session.io.ScreenInfo[7].x, sysopy); + end; + Session.io.OutRaw(sysopstr); + end; + If Config.ChatLogging Then WriteLn (tFile, 'S> ' + SysopSTR); + inc (sysopy); + sysopstr := ''; + Session.io.AnsiGotoXY (sysopx, sysopy); + End Else Begin + userx := Session.io.ScreenInfo[3].x; + if usery = Session.io.ScreenInfo[2].y then begin + for usery := Session.io.ScreenInfo[2].y downto Session.io.ScreenInfo[1].y do begin + Session.io.AnsiGotoXY(userx, usery); + Session.io.OutRaw (strRep(' ', Session.io.ScreenInfo[4].x - Session.io.ScreenInfo[3].x + 1)); + Session.io.AnsiGotoXY(userx, usery); + end; + Session.io.OutRaw(userstr); + end; + inc (usery); + If Config.ChatLogging Then WriteLn (tFile, 'U> ' + UserSTR); + userstr := ''; + Session.io.AnsiGotoXY (userx, usery); + End; + #27 : If Session.io.LocalInput Then Break; + Else + If Session.io.LocalInput Then Begin + Session.io.BufAddChar (ch); + inc (sysopx); + sysopstr := sysopstr + ch; + if sysopx > Session.io.ScreenInfo[8].x then begin + strwrap (sysopstr, temp2, Session.io.ScreenInfo[8].x - session.io.screeninfo[7].x + 1); + temp1 := sysopstr; + If Config.ChatLogging Then WriteLn (tFile, 'S> ' + SysopSTR); + sysopstr := temp2; + Session.io.OutBS (length(temp2), True); + if sysopy=Session.io.ScreenInfo[6].y then begin + for sysopy := Session.io.ScreenInfo[6].y downto Session.io.ScreenInfo[5].y do begin + Session.io.AnsiGotoXY(Session.io.ScreenInfo[7].x, sysopy); + Session.io.OutRaw (strRep(' ', Session.io.ScreenInfo[8].x - Session.io.ScreenInfo[7].x + 1)); + end; + Session.io.AnsiGotoXY(Session.io.ScreenInfo[7].x, sysopy); + Session.io.OutRaw(temp1); + end; + inc (sysopy); + Session.io.AnsiGotoXY(Session.io.ScreenInfo[7].x, sysopy); + Session.io.OutRaw (sysopstr); + sysopx := Screen.CursorX; + end; + End Else Begin + Session.io.BufAddChar (ch); + inc (userx); + userstr := userstr + ch; + if userx > Session.io.ScreenInfo[4].x then begin + strwrap (userstr, temp2, Session.io.ScreenInfo[4].x - session.io.screeninfo[3].x + 1); + temp1 := userstr; + If Config.ChatLogging Then WriteLn (tFile, 'U> ' + UserSTR); + userstr := temp2; + Session.io.OutBS (length(temp2), True); + if usery=Session.io.ScreenInfo[2].y then begin + for usery := Session.io.ScreenInfo[2].y downto Session.io.ScreenInfo[1].y do begin + Session.io.AnsiGotoXY(Session.io.ScreenInfo[3].x, usery); + Session.io.OutRaw (strRep(' ', Session.io.ScreenInfo[4].x - Session.io.ScreenInfo[3].x + 1)); + end; + Session.io.AnsiGotoXY(Session.io.ScreenInfo[3].x, usery); + Session.io.OutRawln(temp1); + end; + inc(usery); + Session.io.AnsiGotoXY (Session.io.ScreenInfo[3].x, usery); + Session.io.OutRaw(userstr); + userx := Screen.CursorX; + end; + end; + End; + Until False; + + Session.io.AnsiGotoXY (1, Session.User.ThisUser.ScreenSize); + + Session.io.OutFull ('|16' + Session.GetPrompt(27)); +End; + +Procedure Line_Chat; +Var + Ch : Char; + Str1, + Str2 : String; +Begin + Str1 := ''; + Str2 := ''; + Session.io.OutFullLn (Session.GetPrompt(26)); + + Repeat + Ch := Session.io.GetKey; + Case Ch of + #27 : If Session.io.LocalInput Then Break; + #13 : Begin + If Config.ChatLogging Then WriteLn (tFile, Str1); + Session.io.OutRawLn(''); + Str1 := ''; + End; + #8 : If Str1 <> '' Then Begin + Session.io.OutBS(1, True); + Dec(Str1[0]); + End; + Else + Str1 := Str1 + Ch; + Session.io.BufAddChar(Ch); + If Length(Str1) > 78 Then Begin + strWrap (Str1, Str2, 78); + Session.io.OutBS(Length(Str2), True); + Session.io.OutRawLn (''); + Session.io.OutRaw (Str2); + If Config.ChatLogging Then WriteLn (tFile, Str1); + Str1 := Str2; + End; + End; + Until False; + + Session.io.OutFull (Session.GetPrompt(27)); +End; + +Procedure OpenChat (Split : Boolean); +Var + Image : TConsoleImageRec; +Begin + Session.User.InChat := True; + + Screen.GetScreenImage(1,1,79,24,Image); + + Update_Status_Line (0, '(ESC) to Quit, (Ctrl-R) to Redraw'); + + If Config.ChatLogging Then Begin + Assign (tFile, Config.LogsPath + 'chat.log'); + {$I-} Append (tFile); {$I+} + If IoResult <> 0 Then ReWrite (tFile); + + WriteLn (tFile, ''); + WriteLn (tFile, 'Chat recorded ' + DateDos2Str(CurDateDos, 1) + ' ' + TimeDos2Str(CurDateDos, True) + + ' with ' + Session.User.ThisUser.Handle); + WriteLn (tFile, strRep('-', 70)); + End; + + If ((Split) And (Session.io.Graphics > 0)) Then Split_Chat Else Line_Chat; + + If Config.ChatLogging Then Begin + WriteLn (tFile, strRep('-', 70)); + Close (tFile); + End; + + Session.User.InChat := False; + Session.TimeOut := TimerSeconds; + + Session.io.RemoteRestore(Image); + + Update_Status_Line (StatusPtr, ''); +End; + +End. diff --git a/mystic/bbs_user.pas b/mystic/bbs_user.pas new file mode 100644 index 0000000..51d2ffe --- /dev/null +++ b/mystic/bbs_user.pas @@ -0,0 +1,1316 @@ +Unit bbs_User; + +{$I M_OPS.PAS} + +Interface + +Uses + m_FileIO, + m_Strings, + m_DateTime, + bbs_Common, + bbs_General, + bbs_MsgBase, + bbs_FileBase, + bbs_Menus, + bbs_NodeInfo, + mpl_Execute; + +Type + TBBSUser = Class + UserFile : File of RecUser; + SecurityFile : File of RecSecurity; + Security : RecSecurity; + ThisUser : RecUser; + TempUser : RecUser; + UserNum : LongInt; + AcsOkFlag : Boolean; + IgnoreGroup : Boolean; + InChat : Boolean; + MatrixOK : Boolean; + + Constructor Create (Var Owner: Pointer); + Destructor Destroy; Override; + + Function IsThisUser (Str: String) : Boolean; + Function Access (Str: String) : Boolean; + Function SearchUser (Var Str : String; Real : Boolean) : Boolean; + Function FindUser (Str: String; Adjust: Boolean) : Boolean; + Function GetMatrixUser : Boolean; + Procedure DetectGraphics; + Procedure GetGraphics; + Procedure GetDateFormat (Edit: Boolean); + Procedure GetAddress (Edit: Boolean); + Procedure GetCityState (Edit: Boolean); + Procedure GetZipCode (Edit: Boolean); + Procedure GetHomePhone (Edit: Boolean); + Procedure GetDataPhone (Edit: Boolean); + Procedure GetBirthDate (Edit: Boolean); + Procedure GetGender (Edit: Boolean); + Procedure GetScreenLength (Edit: Boolean); + Procedure GetPassword (Edit: Boolean); + Procedure GetRealName (Edit: Boolean); + Procedure GetAlias (Edit: Boolean; Def: String); + Procedure GetEditor (Edit: Boolean); + Procedure GetFileList (Edit: Boolean); + Procedure GetMsgList (Edit: Boolean); + Procedure GetHotKeys (Edit: Boolean); + Procedure GetEmail (Edit: Boolean); + Procedure GetUserNote (Edit: Boolean); + Procedure GetOption1 (Edit: Boolean); + Procedure GetOption2 (Edit: Boolean); + Procedure GetOption3 (Edit: Boolean); + Procedure GetLanguage; + Procedure User_Logon (Var UN, PW, MPE : String); + Procedure User_Logon2; + Procedure User_Logon3; + Procedure CreateNewUser (DefName: String); + Procedure Edit_User_Settings (What: Byte); + Function Check_Trash (Name: String) : Boolean; + End; + +Implementation + +Uses + bbs_Core; + +Constructor TBBSUser.Create (Var Owner: Pointer); +Begin + UserNum := -1; + ThisUser.ScreenSize := Config.DefScreenSize; + ThisUser.DateType := 1; + ThisUser.Security := 255; + ThisUser.HotKeys := True; + ThisUser.RealName := 'Unknown'; + ThisUser.Handle := 'Unknown'; + ThisUser.EditType := 1; + ThisUser.Birthday := CurDateJulian; + ThisUser.Gender := 'U'; + + IgnoreGroup := False; + InChat := False; + AcsOkFlag := False; + MatrixOK := False; +End; + +Destructor TBBSUser.Destroy; +Begin + Inherited Destroy; +End; + +Function TBBSUser.IsThisUser (Str: String) : Boolean; +Begin + Str := strUpper(Str); + Result := (strUpper(ThisUser.RealName) = Str) or (strUpper(ThisUser.Handle) = Str); +End; + +Function TBBSUser.Access (Str: String) : Boolean; +Const + OpCmds = ['%', '^', '(', ')', '&', '!', '|']; + AcsCmds = ['A', 'D', 'E', 'F', 'G', 'H', 'M', 'N', 'O', 'S', 'T', 'U', 'W', 'Z']; +Var + Key : Char; + Data : String; + Check : Boolean; + Out : String; + First : Boolean; + + Procedure CheckCommand; + Var + Res : Boolean; + Temp1 : LongInt; + Temp2 : LongInt; + Begin + Res := False; + + Case Key of + 'A' : Res := DaysAgo(ThisUser.Birthday) DIV 365 >= strS2I(Data); + 'D' : Res := (Ord(Data[1]) - 64) in ThisUser.AF2; + 'E' : Case Data[1] of + '1' : Res := Session.io.Graphics = 1; + '0' : Res := Session.io.Graphics = 0; + End; + 'F' : Res := (Ord(Data[1]) - 64) in ThisUser.AF1; + 'G' : If IgnoreGroup Then Begin + First := True; + Check := False; + Data := ''; + Exit; + End Else + Res := ThisUser.LastMGroup = strS2I(Data); + 'H' : Res := strS2I(Data) < strS2I(Copy(TimeDos2Str(CurDateDos, False), 1, 2)); + 'M' : Res := strS2I(Data) < strS2I(Copy(TimeDos2Str(CurDateDos, False), 4, 2)); + 'N' : Res := strS2I(Data) = Session.NodeNum; + 'O' : Case Data[1] of + 'A' : Res := Chat.Available; + 'I' : Res := Chat.Invisible; + 'K' : Res := AcsOkFlag; + 'M' : Begin + Res := Access(Session.Msgs.MBase.SysopACS); + + If Session.Msgs.Reading Then + Res := Res or IsThisUser(Session.msgs.MsgBase^.GetFrom); + End; + 'P' : If (ThisUser.Calls > 0) And (ThisUser.Flags AND UserNoRatio = 0) Then Begin + Temp1 := Round(Security.PCRatio / 100 * 100); + Temp2 := Round(ThisUser.Posts / ThisUser.Calls * 100); + Res := (Temp2 >= Temp1); + End Else + Res := True; + End; + 'S' : Res := ThisUser.Security >= strS2I(Data); + 'T' : Res := Session.TimeLeft > strS2I(Data); + 'U' : Res := ThisUser.PermIdx = strS2I(Data); + 'W' : Res := strS2I(Data) = DayOfWeek; + 'Z' : If IgnoreGroup Then Begin + Check := False; + First := True; + Data := ''; + Exit; + End Else + Res := strS2I(Data) = ThisUser.LastFGroup; + End; + + If Res Then Out := Out + '^' Else Out := Out + '%'; + + Check := False; + First := True; + Data := ''; + End; + +Var + A : Byte; + Paran1 : Byte; + Paran2 : Byte; + Ch1 : Char; + Ch2 : Char; + S1 : String; +Begin + Data := ''; + Out := ''; + Check := False; + Str := strUpper(Str); + First := True; + + For A := 1 to Length(Str) Do + If Str[A] in OpCmds Then Begin + If Check Then CheckCommand; + Out := Out + Str[A]; + End Else + If (Str[A] in AcsCmds) and (First or Check) Then Begin + If Check Then CheckCommand; + Key := Str[A]; + If First Then First := False; + End Else Begin + Data := Data + Str[A]; + Check := True; + If A = Length(Str) Then CheckCommand; + End; + + Out := '(' + Out + ')'; + + While Pos('&', Out) <> 0 Do Delete (Out, Pos('&', Out), 1); + + While Pos('(', Out) <> 0 Do Begin + Paran2 := 1; + While ((Out[Paran2] <> ')') And (Paran2 <= Length(Out))) Do Begin + If (Out[Paran2] = '(') Then Paran1 := Paran2; + Inc (Paran2); + End; + + S1 := Copy(Out, Paran1 + 1, (Paran2 - Paran1) - 1); + + While Pos('!', S1) <> 0 Do Begin + A := Pos('!', S1) + 1; + If S1[A] = '^' Then S1[A] := '%' Else + If S1[A] = '%' Then S1[A] := '^'; + Delete (S1, A - 1, 1); + End; + + While Pos('|', S1) <> 0 Do Begin + A := Pos('|', S1) - 1; + Ch1 := S1[A]; + Ch2 := S1[A + 2]; + + If (Ch1 in ['%', '^']) and (Ch2 in ['%', '^']) Then Begin + Delete (S1, A, 3); + If (Ch1 = '^') or (Ch2 = '^') Then + Insert ('^', S1, A) + Else + Insert ('%', S1, A) + End Else + Delete (S1, A + 1, 1); + End; + + While Pos('%%', S1) <> 0 Do Delete (S1, Pos('%%', S1), 1); + While Pos('^^', S1) <> 0 Do Delete (S1, Pos('^^', S1), 1); + While Pos('%^', S1) <> 0 Do Delete (S1, Pos('%^', S1) + 1, 1); + While Pos('^%', S1) <> 0 Do Delete (S1, Pos('^%', S1), 1); + + Delete (Out, Paran1, (Paran2 - Paran1) + 1); + Insert (S1, Out, Paran1); + End; + + Result := (Pos('%', Out) = 0); +End; + +Function TBBSUser.SearchUser (Var Str : String; Real : Boolean) : Boolean; +Var + Found : Boolean; + First : Boolean; +Begin + Str := strUpper(Str); + + If Str = 'SYSOP' Then + Str := strUpper(Config.SysopName); + + Found := False; + First := True; + + Reset (UserFile); + + While Not Eof(UserFile) Do Begin + Read (UserFile, TempUser); + + If TempUser.Flags AND UserDeleted <> 0 Then Continue; + + If Pos(Str, strUpper(TempUser.Handle)) > 0 Then Begin + If First Then Begin + Session.io.OutRawLn (''); + First := False; + End; + + Session.io.PromptInfo[1] := TempUser.Handle; + + If Session.io.GetYN (Session.GetPrompt(155), True) Then Begin + If Real Then + Str := TempUser.RealName + Else + Str := TempUser.Handle; + Found := True; + Break; + End; + End; + End; + + Close (UserFile); + + If Not Found Then + Session.io.OutFullLn (Session.GetPrompt(156)); + + Result := Found; +End; + +Function TBBSUser.FindUser (Str: String; Adjust: Boolean) : Boolean; +Begin + FindUser := False; + + If Str = '' Then Exit; + + Str := strUpper(Str); + + Reset (UserFile); + + While Not Eof(UserFile) Do Begin + Read (UserFile, TempUser); + + If ((strUpper(TempUser.RealName) = Str) or (strUpper(TempUser.Handle) = Str)) and (TempUser.Flags And UserDeleted = 0) Then Begin + If Adjust Then UserNum := FilePos(UserFile); + + FindUser := True; + Break; + End; + End; + + Close (UserFile); +End; + +Function TBBSUser.GetMatrixUser : Boolean; +Var + SavedNum : LongInt; +Begin + Result := False; + + If UserNum <> -1 Then Begin + GetMatrixUser := True; + Exit; + End; + + Session.io.OutFull (Session.GetPrompt(273)); + + ThisUser.Handle := Session.io.GetInput(30, 30, 18, ''); + + If Not FindUser(ThisUser.Handle, True) Then Exit; + + SavedNum := UserNum; + UserNum := -1; + + If Not Session.io.GetPW(Session.GetPrompt(274), Session.GetPrompt(293), TempUser.Password) Then Begin + If Config.PWInquiry Then + If Session.io.GetYN(Session.GetPrompt(475), False) Then + Session.Msgs.PostMessage(True, '/TO:' + strReplace(Config.FeedbackTo, ' ', '_') + ' /SUBJ:Password_Inquiry'); + + Session.Msgs.PostTextFile('hackwarn.txt;0;' + Config.SysopName + ';' + TempUser.Handle + ';Possible hack attempt', True); + + Exit; + End; + + ThisUser := TempUser; + UserNum := SavedNum; + Result := True; +End; + +{$IFDEF UNIX} +Procedure TBBSUser.DetectGraphics; +Var + Loop : Byte; +Begin + If Not Session.Lang.okANSI Then Begin + Session.io.Graphics := 0; + Exit; + End; + + Session.io.OutFull (Session.GetPrompt(258)); + Session.io.OutRaw (#27 + '[6n'); + Session.io.BufFlush; + + For Loop := 1 to 12 Do Begin + WaitMS(500); + While Input.KeyPressed Do + If Input.ReadKey in [#27, '[', '0'..'9', ';', 'R'] Then Begin + Session.io.Graphics := 1; + Break; + End; + End; + + While Input.KeyPressed Do Loop := Byte(Input.ReadKey); + + Session.io.OutFullLn (Session.GetPrompt(259)); +End; +{$ELSE} +Procedure TBBSUser.DetectGraphics; +Var + Loop : Byte; +Begin + If Not Session.Lang.okANSI Then Begin + Session.io.Graphics := 0; + Exit; + End; + + Session.io.OutFull (Session.GetPrompt(258)); + + If Session.LocalMode Then + Session.io.Graphics := 1 + Else Begin + Session.Client.PurgeInputData; + Session.io.OutRaw (#27 + '[6n'); + Session.io.BufFlush; + + For Loop := 1 to 6 Do Begin + If Session.Client.WaitForData(1000) > 0 Then + If Session.Client.ReadChar in [#27, '[', '0'..'9', ';', 'R'] Then Begin + Session.io.Graphics := 1; + Break; + End; + End; + + Session.Client.PurgeInputData; + End; + + Session.io.OutFullLn (Session.GetPrompt(259)); +End; +{$ENDIF} + +Procedure TBBSUser.GetGraphics; +Begin + Session.io.OutFull (Session.GetPrompt(154)); + Session.io.Graphics := strS2I(Session.io.OneKey('01', True)); +End; + +Procedure TBBSUser.GetEmail (Edit : Boolean); +Begin + If Edit Then + Session.io.OutFull (Session.GetPrompt(440)) + Else + Session.io.OutFull (Session.GetPrompt(439)); + + ThisUser.EMail := Session.io.GetInput(35, 35, 11, ThisUser.Email); +End; + +Procedure TBBSUser.GetUserNote (Edit : Boolean); +Begin + If Edit Then + Session.io.OutFull (Session.GetPrompt(442)) + Else + Session.io.OutFull (Session.GetPrompt(441)); + + ThisUser.UserInfo := Session.io.GetInput(30, 30, 11, ThisUser.UserInfo); +End; + +Procedure TBBSUser.GetOption1 (Edit : Boolean); +Begin + If Edit Then + Session.io.OutFull (Session.GetPrompt(444)) + Else + Session.io.OutFull (Session.GetPrompt(443)); + + ThisUser.Optional[1] := Session.io.GetInput(35, 35, 11, ThisUser.Optional[1]); +End; + +Procedure TBBSUser.GetOption2 (Edit : Boolean); +Begin + If Edit Then + Session.io.OutFull (Session.GetPrompt(446)) + Else + Session.io.OutFull (Session.GetPrompt(445)); + + ThisUser.Optional[2] := Session.io.GetInput(35, 35, 11, ThisUser.Optional[2]); +End; + +Procedure TBBSUser.GetOption3 (Edit : Boolean); +Begin + If Edit Then + Session.io.OutFull (Session.GetPrompt(448)) + Else + Session.io.OutFull (Session.GetPrompt(447)); + + ThisUser.Optional[3] := Session.io.GetInput(35, 35, 11, ThisUser.Optional[3]); +End; + +Procedure TBBSUser.GetEditor (Edit : Boolean); +Begin + If Edit Then + Session.io.OutFull (Session.GetPrompt(373)) + Else + Session.io.OutFull (Session.GetPrompt(303)); + + ThisUser.EditType := strS2I(Session.io.OneKey('012', True)); +End; + +Function TBBSUser.Check_Trash (Name: String) : Boolean; +Var + tFile : Text; + Str : String[30]; +Begin + Result := False; + Name := strUpper(Name); + + Assign (tFile, Config.DataPath + 'trashcan.dat'); + {$I-} Reset (tFile); {$I+} + + If IoResult <> 0 Then Exit; + + While Not Eof(tFile) Do Begin + ReadLn (tFile, Str); + If strUpper(Str) = Name Then Begin + Result := True; + Session.io.OutFullLn (Session.GetPrompt(309)); + Break; + End; + End; + Close (tFile); +End; + +Procedure TBBSUser.GetRealName (Edit: Boolean); +Var + Str : String[30]; +Begin + Repeat + Session.io.OutFull (Session.GetPrompt(6)); + Str := strStripB(Session.io.GetInput(30, 30, 18, ''), ' '); + If Pos(' ', Str) = 0 Then Begin + Session.io.OutFullLn (Session.GetPrompt(7)); + Str := ''; + End Else + If Check_Trash(Str) Then + Str := '' + Else + If FindUser(Str, False) Then Begin + If Edit and (Str = ThisUser.RealName) Then Break; + Session.io.OutFullLn (Session.GetPrompt(8)); + Str := ''; + End; + Until Str <> ''; + + ThisUser.RealName := Str; +End; + +Procedure TBBSUser.GetAlias (Edit: Boolean; Def: String); +Var + Str : String[30]; +Begin + Repeat + Session.io.OutFull (Session.GetPrompt(9)); + Str := strStripB(Session.io.GetInput(30, 30, 18, Def), ' '); + If Check_Trash(Str) Then + Str := '' + Else + If FindUser(Str, False) Then Begin + If Edit and (Str = ThisUser.Handle) Then Break; + Session.io.OutFullLn (Session.GetPrompt(8)); + Str := ''; + End; + Until Str <> ''; + + ThisUser.Handle := Str; +End; + +Procedure TBBSUser.GetAddress (Edit: Boolean); +Var + Str: String[30]; +Begin + If Edit Then Str := ThisUser.Address Else Str := ''; + + Repeat + If Edit Then + Session.io.OutFull (Session.GetPrompt(364)) + Else + Session.io.OutFull (Session.GetPrompt(10)); + Str := Session.io.GetInput(30, 30, 18, Str); + Until Str <> ''; + + ThisUser.Address := Str; +End; + +Procedure TBBSUser.GetCityState (Edit: Boolean); +Var + Str : String[25]; +Begin + If Edit Then Str := ThisUser.City Else Str := ''; + + Repeat + If Edit Then + Session.io.OutFull (Session.GetPrompt(365)) + Else + Session.io.OutFull (Session.GetPrompt(11)); + Str := Session.io.GetInput(25, 25, 18, Str); + Until Str <> ''; + + ThisUser.City := Str; +End; + +Procedure TBBSUser.GetZipCode (Edit: Boolean); +Var + Str : String[9]; +Begin + If Edit Then Str := ThisUser.ZipCode Else Str := ''; + + Repeat + If Edit Then + Session.io.OutFull (Session.GetPrompt(366)) + Else + Session.io.OutFull (Session.GetPrompt(12)); + Str := Session.io.GetInput(9, 9, 12, Str); + Until Str <> ''; + + ThisUser.ZipCode := Str; +End; + +Procedure TBBSUser.GetHomePhone (Edit: Boolean); +Var + Str : String[15]; +Begin + If Edit Then Str := ThisUser.HomePhone Else Str := ''; + + Repeat + If Edit Then + Session.io.OutFull (Session.GetPrompt(367)) + Else + Session.io.OutFull (Session.GetPrompt(13)); + If Config.UseUSAPhone Then + Str := Session.io.GetInput(12, 12, 14, Str) + Else + Str := Session.io.GetInput(15, 15, 12, Str); + Until (Length(Str) = 12) or (Not Config.UseUSAPhone and (Str <> '')); + ThisUser.HomePhone := Str; +End; + +Procedure TBBSUser.GetDataPhone (Edit: Boolean); +Var + Str : String[15]; +Begin + If Edit Then Str := ThisUser.DataPhone Else Str := ''; + + Repeat + If Edit Then + Session.io.OutFull (Session.GetPrompt(368)) + Else + Session.io.OutFull (Session.GetPrompt(14)); + If Config.UseUSAPhone Then + Str := Session.io.GetInput(12, 12, 14, Str) + Else + Str := Session.io.GetInput(15, 15, 12, Str); + Until (Length(Str) = 12) or (Not Config.UseUSAPhone and (Str <> '')); + ThisUser.DataPhone := Str; +End; + +Procedure TBBSUser.GetBirthDate (Edit: Boolean); +Var + Str : String[8]; +Begin + If Edit Then Str := DateJulian2Str(ThisUser.Birthday, ThisUser.DateType) Else Str := ''; + Repeat + If Edit Then + Session.io.OutFull(Session.GetPrompt(369)) + Else + Session.io.OutFull (Session.GetPrompt(15)); + Str := Session.io.GetInput(8, 8, 15, ''); + Until Length(Str) = 8; + ThisUser.Birthday := DateStr2Julian(Str); +End; + +Procedure TBBSUser.GetGender (Edit: Boolean); +Begin + If Edit Then + Session.io.OutFull (Session.GetPrompt(370)) + Else + Session.io.OutFull (Session.GetPrompt(16)); + + ThisUser.Gender := Session.io.OneKey('MF', True); +End; + +Procedure TBBSUser.GetDateFormat (Edit : Boolean); +Begin + If Edit Then + Session.io.OutFull (Session.GetPrompt(371)) + Else + Session.io.OutFull (Session.GetPrompt(152)); + + ThisUser.DateType := strS2I(Session.io.OneKey('123', True)); +End; + +Procedure TBBSUser.GetHotKeys (Edit: Boolean); +Begin + If Edit Then + ThisUser.HotKeys := Session.io.GetYN(Session.GetPrompt(409), True) + Else + ThisUser.HotKeys := Session.io.GetYN(Session.GetPrompt(410), True); +End; + +Procedure TBBSUser.GetMsgList (Edit: Boolean); +Begin + If Edit Then + Session.io.OutFull (Session.GetPrompt(397)) + Else + Session.io.OutFull (Session.GetPrompt(398)); + + ThisUser.MReadType := strS2I(Session.io.OneKey('01', True)); +End; + +Procedure TBBSUser.GetFileList (Edit: Boolean); +Begin + If Edit Then + Session.io.OutFull (Session.GetPrompt(374)) + Else + Session.io.OutFull (Session.GetPrompt(320)); + + ThisUser.FileList := strS2I(Session.io.OneKey('01', True)); +End; + +Procedure TBBSUser.GetScreenLength (Edit: Boolean); +Var + A : Byte; +Begin + Session.io.PromptInfo[1] := strI2S(Config.DefScreenSize); + + If Edit Then + Session.io.OutFull (Session.GetPrompt(372)) + Else + Session.io.OutFull (Session.GetPrompt(153)); + + A := strS2I(Session.io.GetInput(2, 2, 12, strI2S(Config.DefScreenSize))); + + If (A < 1) or (A > 255) Then A := Config.DefScreenSize; + + ThisUser.ScreenSize := A; +End; + +Procedure TBBSUser.GetPassword (Edit: Boolean); +Var + Str1 : String[15]; + Str2 : String[15]; +Begin + If Edit Then Begin + Session.io.OutFull(Session.GetPrompt(151)); + Str1 := Session.io.GetInput(15, 15, 16, ''); + If Str1 <> ThisUser.Password Then Begin + Session.io.OutFullLn (Session.GetPrompt(418)); + Exit; + End; + End; + + Repeat + Repeat + If Edit Then + Session.io.OutFull (Session.GetPrompt(419)) + Else + Session.io.OutFull (Session.GetPrompt(17)); + + Str1 := Session.io.GetInput(15, 15, 16, ''); + + If Length(Str1) < 4 Then + If Edit Then + Session.io.OutFullLn (Session.GetPrompt(420)) + Else + Session.io.OutFullLn (Session.GetPrompt(18)); + Until Length(Str1) >= 4; + + If Edit Then + Session.io.OutFull (Session.GetPrompt(421)) + Else + Session.io.OutFull (Session.GetPrompt(19)); + + Str2 := Session.io.GetInput(15, 15, 16, ''); + + If Str1 <> Str2 Then + If Edit Then + Session.io.OutFullLn (Session.GetPrompt(418)) + Else + Session.io.OutFullLn (Session.GetPrompt(20)); + Until (Str1 = Str2) or (Edit); + + If Str1 = Str2 Then Begin + ThisUser.Password := Str1; + ThisUser.LastPWChange := DateDos2Str(CurDateDos, 1); + End; +End; + +Procedure TBBSUser.GetLanguage; +Var + Old : LangRec; + T : Byte; + A : Byte; +Begin + T := 0; + Old := Session.Lang; + + Session.io.OutFullLn (Session.GetPrompt(182)); + + Reset (Session.LangFile); + Repeat + Read (Session.LangFile, Session.Lang); + If ((Not Session.Lang.okASCII) and (Session.io.Graphics = 0)) or + ((Not Session.Lang.okANSI) and (Session.io.Graphics = 1)) Then Continue; + Inc (T); + Session.io.PromptInfo[1] := strI2S(T); + Session.io.PromptInfo[2] := Session.Lang.Desc; + Session.io.OutFullLn (Session.GetPrompt(183)); + Until Eof(Session.LangFile); + + { Lang := Old; } + + Session.io.OutFull (Session.GetPrompt(184)); + A := strS2I(Session.io.GetInput(2, 2, 12, '')); + + {force user to select a language} + If (A < 1) or (A > T) Then A := 1; + + T := 0; + Reset (Session.LangFile); + Repeat + Read (Session.LangFile, Session.Lang); + If ((Not Session.Lang.okASCII) and (Session.io.Graphics = 0)) or + ((Not Session.Lang.okANSI) and (Session.io.Graphics = 1)) Then Continue; + Inc (T); + Until T = A; +{ Close (Session.LangFile);} + + If Not Session.LoadThemeData(Session.Lang.FileName) Then Begin + Session.io.OutFullLn (Session.GetPrompt(185)); + Session.Lang := Old; + End Else + ThisUser.Theme := Session.Lang.FileName; +End; + +Procedure TBBSUser.CreateNewUser (DefName: String); +Const + ExecMPE : Boolean = False; {placeholder for apply.mpx dev} +Begin + If Not Config.AllowNewUsers Then Begin + Session.io.OutFile ('nonewusr', True, 0); + Halt(0); + End; + + If Config.NewUserPW <> '' Then + If Not Session.io.GetPW(Session.GetPrompt(5), Session.GetPrompt(422), Config.NewUserPW) Then Halt(0); + + Session.SystemLog ('NEW USER'); + + { make user intialize data function } + + If ExecMPE Then Begin { replace this with apple.mpx once the above is done } +(* + If User.ThisUser.RealName = '' Then User.ThisUser.RealName := User.ThisUser.Handle; + If User.ThisUser.Handle = '' Then User.ThisUser.Handle := User.ThisUser.RealName; + + If { Test validity of user data } + IsUser(User.ThisUser.RealName) or + IsUser(User.ThisUser.Handle) or + (User.ThisUser.Password = '') or + (User.ThisUser.RealName = '') or + (User.ThisUser.Handle = '') + Then Begin + Sysop_Log('"apply.mpx" does not set minimum data elements'); + Halt(1); + End; +*) + End Else Begin + Session.io.OutFile ('newuser1', True, 0); + + If strUpper(DefName) = 'NEW' Then DefName := ''; + + With Config Do Begin + If AskTheme Then GetLanguage Else ThisUser.Theme := DefThemeFile; + If AskAlias Then GetAlias(False, DefName); + If AskRealName Then GetRealName(False); + If AskStreet Then GetAddress(False); + If AskCityState Then GetCityState(False); + If AskZipCode Then GetZipCode(False); + If AskHomePhone Then GetHomePhone(False); + If AskDataPhone Then GetDataPhone(False); + If AskGender Then GetGender(False); + If UserDateType = 4 Then GetDateFormat(False) Else ThisUser.DateType := UserDateType; + If AskBirthdate Then GetBirthdate(False); + If AskEmail Then GetEmail(False); + If AskUserNote Then GetUserNote(False); + If OptionalField[1].Ask Then GetOption1(False); + If OptionalField[2].Ask Then GetOption2(False); + If OptionalField[3].Ask Then GetOption3(False); + If UserEditorType = 2 Then GetEditor(False) Else ThisUser.EditType := UserEditorType; + + If UserQuoteWin = 2 Then + ThisUser.UseLBQuote := Session.io.GetYN(Session.GetPrompt(60), False) + Else + ThisUser.UseLBQuote := Boolean(UserQuoteWin); + + If UserFileList = 2 Then GetFileList(False) Else ThisUser.FileList := UserFileList; + If UserReadType = 2 Then GetMsgList(False) Else ThisUser.MReadType := UserReadType; + + If UserReadIndex = 2 Then + ThisUser.UseLBIndex := Session.io.GetYN(Session.GetPrompt(429), False) + Else + ThisUser.UseLBIndex := Boolean(UserReadIndex); + + If UserMailIndex = 2 Then + ThisUser.UseLBMIdx := Session.io.GetYN(Session.GetPrompt(331), False) + Else + ThisUser.UseLBMIdx := Boolean(UserMailIndex); + + If UserFullChat = 2 Then + ThisUser.UseFullChat := Session.io.GetYN(Session.GetPrompt(187), True) + Else + ThisUser.UseFullChat := Boolean(UserFullChat); + + If UserHotKeys = 2 Then GetHotKeys(False) Else ThisUser.HotKeys := Boolean(UserHotKeys); + End; + + If Config.AskScreenSize Then + GetScreenLength(False) + Else + ThisUser.ScreenSize := Config.DefScreenSize; + + GetPassword(False); + End; + + Upgrade_User_Level (True, ThisUser, Config.NewUserSec); + + ThisUser.FirstOn := CurDateDos; + ThisUser.Archive := Config.qwkArchive; + ThisUser.LastFBase := 0; + ThisUser.LastFGroup := Config.StartFGroup; + ThisUser.LastMGroup := Config.StartMGroup; + ThisUser.LastMBase := 0; + ThisUser.Flags := 0; + + If Not Config.AskRealName Then ThisUser.RealName := ThisUser.Handle; + If Not Config.AskAlias Then ThisUser.Handle := ThisUser.RealName; + {If either handles or realnames are toggled off, fill the gaps} + + Session.Menu.MenuName := 'newinfo'; + + Session.Menu.ExecuteMenu (False, False, False); + + Session.io.OutFullLn (Session.GetPrompt(21)); + + Reset (UserFile); + UserNum := Succ(FileSize(UserFile)); + + Inc (Config.UserIdxPos); + ThisUser.PermIdx := Config.UserIdxPos; + + Seek (UserFile, UserNum - 1); + Write (UserFile, ThisUser); + Close (UserFile); + + Reset (ConfigFile); + Write (ConfigFile, Config); + Close (ConfigFile); + + Session.SystemLog ('Created Account: ' + ThisUser.Handle); + + If Config.NewUserEmail Then Begin + Session.io.OutFile('feedback', True, 0); + If Session.Menu.ExecuteCommand ('MW', '/TO:' + strReplace(Config.FeedbackTo, ' ', '_') + ' /SUBJ:New_User_Feedback /F') Then; + End; + + If FileExist(Config.ScriptPath + 'newuser.mpx') Then + ExecuteMPL(NIL, 'newuser'); + + If FileExist(Config.DataPath + 'newletter.txt') Then + Session.Msgs.PostTextFile('newletter.txt;0;' + Config.SysopName + ';' + ThisUser.Handle + ';Welcome', True); + + If FileExist(Config.DataPath + 'sysletter.txt') Then + Session.Msgs.PostTextFile('sysletter.txt;0;' + Config.SysopName + ';' + Config.SysopName + ';New account created', True); +End; + +Procedure TBBSUser.User_Logon3; +Var + A : Byte; + Ch : Char; +Begin + {$IFDEF LOGGING} Session.SystemLog('Logon3'); {$ENDIF} + + Chat.Available := True; + + If Access(Config.AcsInvisLogin) Then + Chat.Invisible := Session.io.GetYN(Session.GetPrompt(308), False); + +{ update last caller information } + + If Not Session.LocalMode And Not Chat.Invisible And (ThisUser.Flags AND UserNoCaller = 0) Then Begin + Reset (LastOnFile); + + If FileSize(LastOnFile) >= 10 Then + KillRecord (LastOnFile, 1, SizeOf(LastOnRec)); + + LastOn.Handle := ThisUser.Handle; + LastOn.City := ThisUser.City; + LastOn.Node := Session.NodeNum; + LastOn.DateTime := CurDateDos; + LastOn.CallNum := Config.SystemCalls; + LastOn.Address := ThisUser.Address; + LastOn.EmailAddr := ThisUser.Email; + LastOn.UserInfo := ThisUser.UserInfo; + LastOn.Option1 := ThisUser.Optional[1]; + LastOn.Option2 := ThisUser.Optional[2]; + LastOn.Option3 := ThisUser.Optional[3]; + + If Session.LocalMode Then + LastOn.Baud := 'LOCAL' + Else + LastOn.Baud := 'TELNET'; + + Seek (LastOnFile, FileSize(LastOnFile)); + Write (LastOnFile, LastOn); + Close (LastOnFile); + End; + +{ update node info / settings } + + Set_Node_Action(Session.GetPrompt(345)); + +{ this (below) causes runtime 201 when range checking is ON } + + For A := 1 to 9 Do + Session.io.OutFile ('logon' + strI2S(A), True, 0); + + Session.io.OutFile ('sl' + strI2S(ThisUser.Security), True, 0); + + For Ch := 'A' to 'Z' Do + If Ord(Ch) - 64 in ThisUser.AF1 Then Session.io.OutFile ('flag1' + Ch, True, 0); + + For Ch := 'A' to 'Z' Do + If Ord(Ch) - 64 in ThisUser.AF2 Then Session.io.OutFile ('flag2' + Ch, True, 0); + + If DateDos2Str(CurDateDos, 1) = DateJulian2Str(ThisUser.Birthday, 1) Then Session.io.OutFile ('birthday', True, 0); + + { Check for forced voting questions } + + Reset (VoteFile); + While Not Eof(VoteFile) Do Begin + Read (VoteFile, Vote); + If Access(Vote.ACS) and Access(Vote.ForceACS) and (ThisUser.Vote[FilePos(VoteFile)] = 0) Then Begin + A := FilePos(VoteFile); + Close (VoteFile); + Voting_Booth (True, A); + Reset (VoteFile); + Seek (VoteFile, A); + End; + End; + Close (VoteFile); + + { END forced voting check } +End; + +Procedure TBBSUser.User_Logon2; +Begin + {$IFDEF LOGGING} Session.SystemLog('Logon2'); {$ENDIF} + + Reset (SecurityFile); + Seek (SecurityFile, Pred(ThisUser.Security)); + Read (SecurityFile, Security); + Close (SecurityFile); + + If DateDos2Str(ThisUser.LastOn, 1) <> DateDos2Str(CurDateDos, 1) Then Begin + ThisUser.CallsToday := 0; + ThisUser.DLsToday := 0; + ThisUser.DLkToday := 0; + ThisUser.TimeLeft := Security.Time + End; + + If Not Session.LocalMode And (ThisUser.Flags AND UserNoCaller = 0) Then Begin + Reset (ConfigFile); + Read (ConfigFile, Config); + Inc (Config.SystemCalls); + + Reset (ConfigFile); + Write (ConfigFile, Config); + Close (ConfigFile); + End; + + Inc (ThisUser.Calls); + Inc (ThisUser.CallsToday); + + If (Not Access(Config.AcsMultiLogin)) and (Is_User_Online(ThisUser.Handle) <> 0) Then Begin + Session.io.OutFullLn(Session.GetPrompt(426)); + Halt(0); + End; + + If ThisUser.Flags And UserLockedOut <> 0 Then Begin + Session.io.OutFull (Session.GetPrompt(129)); + Session.SystemLog ('User has been locked out'); + Halt(0); + End; + + If (ThisUser.CallsToday >= Security.MaxCalls) and (Security.MaxCalls > 0) Then Begin + Session.io.OutFullLn (Session.GetPrompt(157)); + Halt(0); + End; + + {Find last message/file base and group} + + If ThisUser.LastMGroup > 0 Then + Session.Msgs.MessageGroupChange (strI2S(ThisUser.LastMGroup), False, False) + Else + Session.Msgs.MessageGroupChange ('+', True, False); + + If ThisUser.LastMBase > 0 Then + Session.Msgs.ChangeArea(strI2S(ThisUser.LastMBase - 1)) + Else + Session.Msgs.ChangeArea('+'); + + If ThisUser.LastFGroup > 0 Then + Session.FileBase.FileGroupChange(strI2S(ThisUser.LastFGroup), False, False) + Else + Session.FileBase.FileGroupChange('+', True, False); + + If ThisUser.LastFBase > 0 Then + Session.FileBase.ChangeFileArea(strI2S(ThisUser.LastFBase)) + Else + Session.FileBase.ChangeFileArea('+'); + + If (Session.TimeOffset = 0) or (Session.TimeOffset > ThisUser.TimeLeft) Then + Session.SetTimeLeft (ThisUser.TimeLeft); + + // check account expired -- DONE + // check password change + // check auto-upgrades posts/calls/downloads/uploads/etc + + If DateValid(Session.User.ThisUser.Expires) Then + If CurDateJulian - DateStr2Julian(Session.User.ThisUser.Expires) >= 0 Then Begin + Session.SystemLog('Account expired to level ' + strI2S(Session.User.ThisUser.ExpiresTo)); + + Upgrade_User_Level(True, Session.User.ThisUser, Session.User.ThisUser.ExpiresTo); + + If Session.User.ThisUser.Security = 0 Then Begin + Session.io.OutFullLn(Session.GetPrompt(477)); + Session.User.ThisUser.Flags := Session.User.ThisUser.Flags AND UserDeleted; + Exit; + End Else + Session.io.OutFullLn(Session.GetPrompt(476)); + End; + + If (Config.PWChange > 0) and (Session.User.ThisUser.Flags AND UserNoPWChange = 0) Then + If Not DateValid(Session.User.ThisUser.LastPWChange) Then + Session.User.ThisUser.LastPWChange := DateDos2Str(CurDateDos, 1) + Else + If CurDateJulian - DateStr2Julian(Session.User.ThisUser.LastPWChange) >= 0 Then Begin + Session.SystemLog('Required password change'); + Session.io.OutFullLn(Session.GetPrompt(478)); + Session.User.GetPassword(False); + End; + + {$IFNDEF UNIX} + Update_Status_Line(StatusPtr, ''); + {$ENDIF} +End; + +Procedure TBBSUser.User_Logon (Var UN, PW, MPE : String); +Var + A : Integer; + Count : Byte; +Begin + {$IFDEF LOGGING} Session.SystemLog('Logon1'); {$ENDIF} + + Set_Node_Action (Session.GetPrompt(345)); + + Session.io.Graphics := 0; + + Session.SystemLog ('Connect from ' + Session.UserIPInfo + ' (' + Session.UserHostInfo + ')'); + + If Config.SystemPW <> '' Then + If Not Session.io.GetPW(Session.GetPrompt(4), Session.GetPrompt(417), Config.SystemPW) Then Begin + Session.io.OutFile ('closed', True, 0); + Session.SystemLog('Failed system password'); + Halt(0); + End; + + Session.io.OutFullLn ('|CL' + mysSoftwareID + ' BBS v' + mysVersion + ' (' + OSID + ') Node |ND (|BD)'); + Session.io.OutFullLn (CopyID); + + If Config.DefTermMode = 0 Then + GetGraphics + Else + If Config.DefTermMode = 3 Then + Session.io.Graphics := 1 + Else Begin + DetectGraphics; + If (Session.io.Graphics = 0) and (Config.DefTermMode = 2) Then GetGraphics; + End; + + If FileExist(Config.ScriptPath + 'startup.mpx') Then + ExecuteMPL(NIL, 'startup'); + + If Not Session.Lang.okASCII and (Session.io.Graphics = 0) Then Begin + Session.io.OutFullLn (Session.GetPrompt(321)); + Session.SystemLog ('ASCII login disabled'); + Halt(0); + End Else + If Not Session.Lang.okANSI and (Session.io.Graphics = 1) Then Begin + Session.io.OutFullLn (Session.GetPrompt(322)); + Session.SystemLog ('ANSI login disabled'); + Halt(0); + End; + + If UN <> '' Then Begin + If Not FindUser(UN, True) Then + Halt; + + If strUpper(PW) <> TempUser.Password Then Begin + UserNum := -1; + Halt; + End; + End Else Begin + If Config.UseMatrix Then Begin + Repeat + Session.Menu.MenuName := Config.MatrixMenu; + Session.Menu.ExecuteMenu (True, False, False); + Until MatrixOK or Session.ShutDown; + End; + + Session.io.OutFile ('prelogon', True, 0); + + Count := 0; + + Repeat + If Count = Config.LoginAttempts Then Halt; + + Session.io.OutFull (Session.GetPrompt(0)); + ThisUser.Handle := strStripB(Session.io.GetInput(30, 30, 18, ''), ' '); + + If Not FindUser(ThisUser.Handle, True) Then Begin + Session.io.OutFile ('newuser', True, 0); + + If Session.io.GetYN(Session.GetPrompt(1), False) Then Begin + CreateNewUser(ThisUser.Handle); + User_Logon2; + User_Logon3; + Exit; + End; + + Inc (Count); + End Else Break; + Until False; + + A := UserNum; {If user would drop carrier here itd save their info } + UserNum := -1; {which is only User.ThisUser.realname at this time } + + If Not Session.io.GetPW(Session.GetPrompt(2), Session.GetPrompt(3), TempUser.Password) Then Begin + If Config.PWInquiry Then + If Session.io.GetYN(Session.GetPrompt(475), False) Then + Session.Msgs.PostMessage(True, '/TO:' + strReplace(Config.FeedbackTo, ' ', '_') + ' /SUBJ:Password_Inquiry'); + + Session.Msgs.PostTextFile('hackwarn.txt;0;' + Config.SysopName + ';' + TempUser.Handle + ';Possible hack attempt', True); + + Halt(0); + End; + + UserNum := A; + End; + + ThisUser := TempUser; + + Session.SystemLog ('User: ' + ThisUser.Handle + ' logged in'); + + If Not Session.LoadThemeData(ThisUser.Theme) Then Begin + Session.io.OutFullLn (Session.GetPrompt(186)); + If Session.LoadThemeData(Config.DefThemeFile) Then + ThisUser.Theme := Config.DefThemeFile; + End; + + User_Logon2; + + If MPE <> '' Then Begin + ExecuteMPL(NIL, MPE); + Halt; + End Else + User_Logon3; +End; + +Procedure TBBSUser.Edit_User_Settings (What: Byte); +Begin + Case What of + 1 : GetAddress(True); + 2 : GetCityState(True); + 3 : GetZipCode(True); + 4 : GetHomePhone(True); + 5 : GetDataPhone(True); + 6 : GetBirthDate(True); + 7 : GetGender(True); + 8 : GetDateFormat(True); + 9 : Repeat + GetGraphics; + If (Not Session.Lang.okASCII and (Session.io.Graphics = 0)) or (Not Session.Lang.okANSI and (Session.io.Graphics = 1)) Then + Session.io.OutFullLn (Session.GetPrompt(325)) + Else + Break; + Until False; + 10 : GetScreenLength(True); + 11 : GetPassword(True); + 12 : GetRealName(True); + 13 : GetAlias(True, ''); + 14 : GetLanguage; + 15 : GetEditor(True); + 16 : If Access(Config.AcsInvisLogin) Then Begin + Chat.Invisible := Not Chat.Invisible; + Set_Node_Action (Chat.Action); + End; + 17 : GetFileList(True); + 18 : Chat.Available := Not Chat.Available; + 19 : GetHotKeys(True); + 20 : GetMsgList(True); + 21 : ThisUser.UseLBIndex := Not ThisUser.UseLBIndex; + 22 : GetEmail(True); + 23 : GetUserNote(True); + 24 : GetOption1(True); + 25 : GetOption2(True); + 26 : GetOption3(True); + 27 : ThisUser.UseLBQuote := Not ThisUser.UseLBQuote; + 28 : ThisUser.UseLBMIdx := Not ThisUser.UseLBMIdx; + 29 : ThisUser.UseFullChat := Not ThisUser.UseFullChat; + 30 : ThisUser.QwkFiles := Not ThisUser.QwkFiles; + 31 : Session.FileBase.SelectArchive; + End; +End; + +End.