Initial import
This commit is contained in:
mysticbbs
parent
0fc68847ac
commit
e98cf71497
976
mystic/109to110.pas
Normal file
976
mystic/109to110.pas
Normal file
|
|
@ -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.
|
||||
13
mystic/ansi_install.ans
Normal file
13
mystic/ansi_install.ans
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
[0;0;40;37m
|
||||
|
||||
[61C[1;33m<33>
|
||||
[0;36m<36><6D>[37m[11C[1;30m<30><6D> [0m<30>[47;30m<30>[40;37m[24C[1;36m<36><6D><EFBFBD><EFBFBD><EFBFBD>[0m[10C[1;33m<33>۱[0m<30>[47;30m<30>[40;37m[9C<39>[47;30m<30>[1;40mgj!
|
||||
[46;36m<36><6D><EFBFBD>[0;36m<36>[37m[5C[1;30m<30> <20> <20> [0;36m<36>[46;30m<30>[1;40;36m<36>[46m<36>[37m<37><6D>[36m<36><6D>[0m[6C[1;30m<30>[0m[6C[1;47m<37>[40;36m<36><6D><EFBFBD><EFBFBD>[0;36m<36>[1m<31><6D>[47;37m<37><6D>[46;36m<36>[47;37m<37>[40;36m<36><6D><EFBFBD><EFBFBD>[33m<33> <20><><EFBFBD>[37m<37><6D>[33m<33><6D>۲<EFBFBD><DBB2>[0;36m<36>[1m<31><6D><EFBFBD><EFBFBD><EFBFBD>[46m<36>[40m<30><6D>[46m<36>[0;36m<36>
|
||||
[1m<31>[46m<36>[37m<37><6D>[36m<36>[0;36m<36>[37m[6C[1;30m<30><6D>[0;36m<36>[1;46m<36><6D><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>[0m [1;47;30m<30>[40m<30><6D> <20> [0;36m<36>[1;46m<36><6D><EFBFBD><EFBFBD>[40m<30><6D>[46m<36>[40m<30><6D>[46m<36><6D><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>[0m [1;33m<33><6D><EFBFBD><EFBFBD>۲<EFBFBD>[0;36m<36>[1;46m<36><6D>[47;37m<37><6D>[46;36m<36>[47;37m<37>[46;36m<36><6D><EFBFBD><EFBFBD><EFBFBD>[40m<30>[30m<30>
|
||||
[47;37m<37>[0m [1;36m<36>[46m<36><6D><EFBFBD><EFBFBD><EFBFBD>[0;36m<36>[1;30m<30><6D>[47m<37>[40m<30>[0;36m<36>[1;46m<36><6D>[47;37m<37>[46;36m<36><6D>[40m<30>[46m<36><6D><EFBFBD><EFBFBD><EFBFBD>[0m [1;46;30m<30>[0m [1;46;36m<36><6D><EFBFBD><EFBFBD>[40m<30><6D><EFBFBD>[46m<36><6D><EFBFBD><EFBFBD>[0;36m<36> [1;30m<30><6D> [36m<36>[46m<36><6D><EFBFBD>[40m<30> [30m<30> [36m<36><6D><EFBFBD> [33m<33><6D>[36m<36><6D><EFBFBD><EFBFBD><EFBFBD>[33m<33><6D>[0;36m<36>[1;46m۲[0m [1;30m<30><6D> [0;36m<36>[1;46m<36><6D><EFBFBD>[0;36m<36>[1;30m<30>
|
||||
[47m<37>[0m [1;36m<36>[46m<36><6D><EFBFBD><EFBFBD>[40m<30>[46m<36>[40m<30><6D><EFBFBD><EFBFBD>[46m<36>[40m<30>[46m۲<6D><DBB2>[40m<30>[0;36m<36>[1m<31>[46m<36><6D><EFBFBD>[0;36m<36> [1;46m<6D>[40m<30><6D> [0;36m<36>[1;46m<36><6D>۲<EFBFBD><DBB2><EFBFBD>[0;36m<36>[1;30m<30> [46;36m<36><6D><EFBFBD><EFBFBD>[40m<30> [46;30m<30>[0m [1;46;36m<36><6D>ܱ<EFBFBD>[0m [1;47m<37><6D>[46;36m<36><6D>[40m<30><6D><EFBFBD>[46m<36><6D><EFBFBD>[0m [1;30m<30> [0;36m<36>[1m<31>[46m<36><6D><EFBFBD>[40m [47;30m<30>[0m
|
||||
[1;30m<30> [0;36m<36>[1;46m<36><6D><EFBFBD>[0;36m<36> <20>[1;46m<36><6D>[0;36m<36> <20>[1;46m<36><6D><EFBFBD>[0;36m<36> <20>[1;46m<36><6D><EFBFBD><EFBFBD>[0;36m<36><6D><EFBFBD>[1;46m<36><6D><EFBFBD>[0;36m<36> [1;30m<30> [0;36m<36><6D>[1;46m<36><6D><EFBFBD><EFBFBD>[0;36m<36> <20>[1;46m<36><6D><EFBFBD>[0;36m<36><6D>[1;30m<30> [46;36m<36><6D><EFBFBD><EFBFBD>[0;36m۰[1;46m<36><6D><EFBFBD><EFBFBD>[40m<30>[0;36m<36>[1m<31>[46m<36><6D><EFBFBD>[0;36m<36>[1;30m<30>[0m [1;46;36m<36><6D><EFBFBD>[0;36m<36>[1m<31> [46;30m<30>[0m
|
||||
[36m<36>[46;30m<30>[40;36m<36><6D><EFBFBD>[46m [40m<30> [1;46;30m<30>[40m<30><6D><EFBFBD>ܲ [0;36m<36><6D><EFBFBD><EFBFBD><EFBFBD> [1;30m<30><6D> [0;36m<36><6D><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>[46;30m<30><6D>[40;37m [36m<36><6D><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>[1m<31>[46m<36><6D><EFBFBD><EFBFBD><EFBFBD>[0m [36m<36><6D><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> [1;30m<30><6D><EFBFBD>
|
||||
<EFBFBD><EFBFBD><EFBFBD> [0;36m<36>߲ [1;30m<30> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ܲ<EFBFBD><DCB2><EFBFBD><EFBFBD><EFBFBD> [0;36m<36><6D><EFBFBD><EFBFBD>ݲ[46;30m<30>[40;36m<36><6D><EFBFBD>۲<EFBFBD><DBB2><EFBFBD><EFBFBD> [1;30m<30><6D><EFBFBD> [0;36m<36><6D><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> [1;30mݰ<6D>
|
||||
[0m[8C[1;30m<30>[0m[12C[1;30m<30>[0m[6C[36m<36>[46;30m<30>[40;37m[11C[1;30m<30> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>[0m[14C[1;30m<30><6D>
|
||||
[0m[21C[1;30m<30><6D><EFBFBD>[0m[18C[1;30m<30> <20><><EFBFBD>
|
||||
164
mystic/aview.pas
Normal file
164
mystic/aview.pas
Normal file
|
|
@ -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.
|
||||
111
mystic/aviewarj.pas
Normal file
111
mystic/aviewarj.pas
Normal file
|
|
@ -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.
|
||||
81
mystic/aviewlzh.pas
Normal file
81
mystic/aviewlzh.pas
Normal file
|
|
@ -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 ----------------------------------------------------------- }
|
||||
102
mystic/aviewrar.pas
Normal file
102
mystic/aviewrar.pas
Normal file
|
|
@ -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.
|
||||
126
mystic/aviewzip.pas
Normal file
126
mystic/aviewzip.pas
Normal file
|
|
@ -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.
|
||||
419
mystic/bbs_ansi_help.pas
Normal file
419
mystic/bbs_ansi_help.pas
Normal file
|
|
@ -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 "<a href=" to "<link="
|
||||
// 2. completely redo loading so text is stored in pointer of records...
|
||||
// we can allow larger help files.
|
||||
// 3. text file read needs to be buffered
|
||||
// 4. needs to use ansi template
|
||||
// 5. quickjump/sitemap option
|
||||
// 6. add linking to OTHER .hlp files?
|
||||
// 7. how to better integrate with the bbs? execute MPL command? what else?
|
||||
//
|
||||
// after this is done... port the ansi editor itself for online ansi editing
|
||||
// goodness! and also make file manager for sysops
|
||||
// needs to support lines better than 255 characters too
|
||||
|
||||
{$I M_OPS.PAS}
|
||||
|
||||
Interface
|
||||
|
||||
Uses
|
||||
bbs_Ansi_MenuBox;
|
||||
|
||||
Const
|
||||
geMaxHelpTest = 200;
|
||||
geMaxHelpKeyLen = 20;
|
||||
geMaxHelpLineLinks = 10;
|
||||
|
||||
Type
|
||||
TLineInfoRec = Record // make into pointer
|
||||
Text : String; // make into pointer of string
|
||||
Links : Byte;
|
||||
Link : Array[1..geMaxHelpLineLinks] of Record //make into pointer
|
||||
Key : String[geMaxHelpKeyLen];
|
||||
LinkPos : Byte;
|
||||
LinkLen : Byte;
|
||||
End;
|
||||
End;
|
||||
|
||||
TAnsiMenuHelp = Class
|
||||
Box : TAnsiMenuBox;
|
||||
HelpFile : Text;
|
||||
CurKey : String[geMaxHelpKeyLen];
|
||||
Text : Array[1..geMaxHelpTest] of TLineInfoRec;
|
||||
Lines : Word;
|
||||
|
||||
Constructor Create;
|
||||
Destructor Destroy; Override;
|
||||
Procedure OpenHelp (X1, Y1, X2, Y2: Byte; FN, Keyword: String);
|
||||
Function ReadKeywordData : Boolean;
|
||||
End;
|
||||
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
m_Strings,
|
||||
bbs_Core;
|
||||
|
||||
function striplinks (s:string):string;
|
||||
var
|
||||
a : byte;
|
||||
B : byte;
|
||||
begin
|
||||
a := 255;
|
||||
|
||||
while a > 0 do begin
|
||||
a := pos('<a href=', s);
|
||||
if a > 0 then begin
|
||||
b := 1;
|
||||
while s[a+8+b] <> '>' do inc(b);
|
||||
Delete (S, a, 9 + b);
|
||||
a := Pos('</a>', S);
|
||||
If a = 0 Then a := Length(S);
|
||||
Delete (S, a, 4);
|
||||
end;
|
||||
end;
|
||||
|
||||
striplinks := s;
|
||||
end;
|
||||
|
||||
Constructor TAnsiMenuHelp.Create;
|
||||
Begin
|
||||
Inherited Create;
|
||||
End;
|
||||
|
||||
Destructor TAnsiMenuHelp.Destroy;
|
||||
Begin
|
||||
Inherited Destroy;
|
||||
End;
|
||||
|
||||
Function TAnsiMenuHelp.ReadKeywordData : Boolean;
|
||||
Var
|
||||
Str : String;
|
||||
Key : String;
|
||||
Temp1 : Byte;
|
||||
Temp2 : Byte;
|
||||
Done : Boolean;
|
||||
Buffer : Array[1..2048] of Char;
|
||||
Begin
|
||||
SetTextBuf (HelpFile, Buffer);
|
||||
Reset (HelpFile);
|
||||
|
||||
Done := False;
|
||||
|
||||
While Not Eof(HelpFile) And Not Done Do Begin
|
||||
ReadLn (HelpFile, Str);
|
||||
|
||||
Temp1 := Pos('<keyword> ', Str);
|
||||
If Temp1 = 0 Then Continue;
|
||||
|
||||
Key := Copy(Str, Temp1 + 10, Length(Str));
|
||||
|
||||
If Key <> CurKey Then Continue;
|
||||
|
||||
Lines := 0;
|
||||
|
||||
While Not Eof(HelpFile) Do Begin
|
||||
ReadLn (HelpFile, Str);
|
||||
|
||||
If Pos('<end>', Str) > 0 Then Begin
|
||||
Done := True;
|
||||
Break;
|
||||
End;
|
||||
|
||||
Inc (Lines);
|
||||
|
||||
Text[Lines].Text := StripLinks(Str);
|
||||
Text[Lines].Links := 0;
|
||||
Str := strStripPipe(Str);
|
||||
|
||||
Repeat
|
||||
Temp1 := Pos('<a href=', Str);
|
||||
|
||||
If Temp1 = 0 Then Break;
|
||||
|
||||
Inc (Text[Lines].Links);
|
||||
|
||||
Text[Lines].Link[Text[Lines].Links].LinkPos := Temp1;
|
||||
|
||||
Temp2 := 0;
|
||||
Key := '';
|
||||
|
||||
While Str[Temp1 + 8 + Temp2] <> '>' Do Begin
|
||||
Key := Key + Str[Temp1 + 8 + Temp2];
|
||||
Inc(Temp2);
|
||||
End;
|
||||
|
||||
Delete (Str, Temp1, 9 + Temp2);
|
||||
Temp2 := Pos('</a>', Str);
|
||||
Delete (Str, Temp2, 4);
|
||||
|
||||
Text[Lines].Link[Text[Lines].Links].LinkLen := Temp2 - Temp1;
|
||||
Text[Lines].Link[Text[Lines].Links].Key := Key;
|
||||
Until False;
|
||||
End;
|
||||
End;
|
||||
|
||||
Close (HelpFile);
|
||||
|
||||
Result := Done And (Lines > 0);
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuHelp.OpenHelp (X1, Y1, X2, Y2: Byte; FN, Keyword: String);
|
||||
Var
|
||||
TopPage : Integer;
|
||||
CurLine : Integer;
|
||||
CurLPos : Byte;
|
||||
WinSize : Integer;
|
||||
LastPos : Byte;
|
||||
LastKey : Array[1..10] of String[geMaxHelpKeyLen];
|
||||
|
||||
Procedure LinkOFF (LineNum: Word; YPos, LPos: Byte);
|
||||
Var
|
||||
S : String;
|
||||
Begin
|
||||
If Text[LineNum].Links = 0 Then Exit;
|
||||
|
||||
With Text[LineNum] Do
|
||||
S := Copy(strStripPipe(Text), Link[LPos].LinkPos, Link[LPos].LinkLen);
|
||||
|
||||
WriteXY (X1 + Text[LineNum].Link[LPos].LinkPos, YPos, 9, S);
|
||||
End;
|
||||
|
||||
Procedure DrawPage;
|
||||
Var
|
||||
Count1 : Byte;
|
||||
Count2 : Byte;
|
||||
Begin
|
||||
For Count1 := Y1 to WinSize Do Begin
|
||||
If TopPage + Count1 - Y1 <= Lines Then Begin
|
||||
WriteXYPipe (X1 + 1, (Count1 - Y1) + Y1 + 1, 7, X2 - X1 - 1, Text[TopPage + (Count1 - Y1)].Text);
|
||||
For Count2 := 1 to Text[TopPage + Count1 - 1].Links Do
|
||||
LinkOFF (TopPage + Count1 - 1, Count1 - Y1 + Y1 + 1, Count2);
|
||||
End Else
|
||||
WriteXYPipe (X1 + 1, (Count1 - Y1) + Y1 + 1, 7, X2 - X1 - 1, '');
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure LinkON;
|
||||
Var
|
||||
S : String;
|
||||
Begin
|
||||
With Text[TopPage + CurLine - 1] Do
|
||||
S := Copy(strStripPipe(Text), Link[CurLPos].LinkPos, Link[CurLPos].LinkLen);
|
||||
|
||||
WriteXY (X1 + Text[TopPage + CurLine - 1].Link[CurLPos].LinkPos, Y1 + CurLine, 31, S);
|
||||
|
||||
Session.io.AnsiGotoXY (X1 + Text[TopPage + CurLine - 1].Link[CurLPos].LinkPos, Y1 + CurLine);
|
||||
End;
|
||||
|
||||
Procedure UpdateCursor;
|
||||
Begin
|
||||
If Text[TopPage + CurLine - 1].Links > 0 Then Begin
|
||||
If CurLPos > Text[TopPage + CurLine - 1].Links Then CurLPos := Text[TopPage + CurLine - 1].Links;
|
||||
If CurLPos < 1 Then CurLPos := 1;
|
||||
LinkON;
|
||||
End Else Begin
|
||||
CurLPos := 1;
|
||||
Session.io.AnsiGotoXY (X1 + 1, Y1 + CurLine);
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure PageDown;
|
||||
Begin
|
||||
If Lines > WinSize Then Begin
|
||||
If TopPage + WinSize <= Lines - WinSize Then Begin
|
||||
Inc (TopPage, WinSize);
|
||||
Inc (CurLine, WinSize);
|
||||
End Else Begin
|
||||
TopPage := Lines - WinSize - 1;
|
||||
CurLine := WinSize;
|
||||
End;
|
||||
End Else
|
||||
CurLine := Lines;
|
||||
End;
|
||||
|
||||
Var
|
||||
OK : Boolean;
|
||||
Count : Byte;
|
||||
Ch : Char;
|
||||
Begin
|
||||
Assign (HelpFile, FN);
|
||||
Reset (HelpFile);
|
||||
|
||||
If IoResult <> 0 Then Exit;
|
||||
|
||||
Close (HelpFile);
|
||||
|
||||
TopPage := 1;
|
||||
CurLine := 1;
|
||||
LastPos := 0;
|
||||
WinSize := Y2 - Y1 - 1;
|
||||
CurKey := Keyword;
|
||||
OK := ReadKeywordData;
|
||||
|
||||
If Not OK and (CurKey <> 'INDEX') Then Begin
|
||||
CurKey := 'INDEX';
|
||||
OK := ReadKeywordData;
|
||||
End;
|
||||
|
||||
If Not OK Then Exit;
|
||||
|
||||
Box := TAnsiMenuBox.Create;
|
||||
|
||||
Box.Shadow := False;
|
||||
Box.FrameType := 1;
|
||||
Box.BoxAttr := 8;
|
||||
Box.BoxAttr2 := 8;
|
||||
Box.HeadAttr := 15;
|
||||
Box.Box3D := False;
|
||||
Box.Header := ' Section : ' + CurKey + ' ';
|
||||
|
||||
Box.Open (X1, Y1, X2, Y2);
|
||||
|
||||
DrawPage;
|
||||
UpdateCursor;
|
||||
|
||||
While OK Do Begin
|
||||
// Box.UpdateHeader (' Section : ' + CurKey + ' ');
|
||||
|
||||
TopPage := 1;
|
||||
CurLine := 1;
|
||||
|
||||
DrawPage;
|
||||
|
||||
For Count := 1 to WinSize Do
|
||||
If Text[Count].Links > 0 Then Begin
|
||||
CurLine := Count;
|
||||
Break;
|
||||
End;
|
||||
|
||||
UpdateCursor;
|
||||
|
||||
Session.io.AllowArrow := True;
|
||||
|
||||
Repeat
|
||||
Ch := Session.io.GetKey;
|
||||
|
||||
If Session.io.IsArrow Then Begin
|
||||
Case Ch of
|
||||
#71 : If (TopPage > 1) or (CurLine > 1) Then Begin
|
||||
TopPage := 1;
|
||||
CurLine := 1;
|
||||
DrawPage;
|
||||
UpdateCursor;
|
||||
End;
|
||||
#72 : Begin
|
||||
If (CurLine = 1) and (TopPage > 1) Then Begin
|
||||
Dec (TopPage);
|
||||
DrawPage;
|
||||
End Else If CurLine > 1 Then Begin
|
||||
LinkOFF(TopPage + CurLine - 1, CurLine + 1, CurLPos);
|
||||
Dec (CurLine)
|
||||
End;
|
||||
UpdateCursor;
|
||||
End;
|
||||
#73 : Begin
|
||||
If TopPage - WinSize > 0 Then Begin
|
||||
Dec (TopPage, WinSize);
|
||||
Dec (CurLine, WinSize);
|
||||
End Else Begin
|
||||
TopPage := 1;
|
||||
CurLine := 1;
|
||||
End;
|
||||
DrawPage;
|
||||
UpdateCursor;
|
||||
End;
|
||||
#75 : If (CurLPos > 1) and (Text[TopPage + CurLine - 1].Links > 0) Then Begin
|
||||
LinkOFF(TopPage + CurLine - 1, CurLine + 1, CurLPos);
|
||||
Dec(CurLPos);
|
||||
LinkON;
|
||||
End;
|
||||
#77 : If CurLPos < Text[TopPage + CurLine - 1].Links Then Begin
|
||||
LinkOFF(TopPage + CurLine - 1, CurLine + 1, CurLPos);
|
||||
Inc(CurLPos);
|
||||
LinkON;
|
||||
End;
|
||||
#79 : Begin
|
||||
Repeat
|
||||
PageDown;
|
||||
Until TopPage >= Lines - WinSize - 1;
|
||||
DrawPage;
|
||||
UpdateCursor;
|
||||
End;
|
||||
#80 : Begin
|
||||
If (CurLine = WinSize) and (TopPage + WinSize <= Lines) Then Begin
|
||||
Inc(TopPage);
|
||||
DrawPage;
|
||||
End Else
|
||||
If (CurLine < WinSize) And (TopPage + CurLine <= Lines) Then Begin
|
||||
LinkOFF(TopPage + CurLine - 1, CurLine + 1, CurLPos);
|
||||
Inc(CurLine);
|
||||
End;
|
||||
UpdateCursor;
|
||||
End;
|
||||
#81 : Begin
|
||||
PageDown;
|
||||
DrawPage;
|
||||
UpdateCursor;
|
||||
End;
|
||||
End;
|
||||
End Else Begin
|
||||
Case Ch of
|
||||
#13 : If Text[CurLine].Links > 0 Then Begin
|
||||
If Text[CurLine].Link[CurLPos].Key = '@PREV' Then Begin
|
||||
If LastPos = 0 Then
|
||||
CurKey := 'INDEX'
|
||||
Else Begin
|
||||
CurKey := LastKey[LastPos];
|
||||
Dec (LastPos);
|
||||
End;
|
||||
End Else Begin
|
||||
If LastPos < 10 Then
|
||||
Inc (LastPos)
|
||||
Else
|
||||
For Count := 1 to 9 Do LastKey[Count] := LastKey[Count + 1];
|
||||
|
||||
LastKey[LastPos] := CurKey;
|
||||
CurKey := Text[CurLine].Link[CurLPos].Key;
|
||||
End;
|
||||
|
||||
OK := ReadKeywordData;
|
||||
|
||||
If Not OK Then Begin
|
||||
CurKey := 'INDEX';
|
||||
OK := ReadKeywordData;
|
||||
End;
|
||||
|
||||
Break;
|
||||
End;
|
||||
#27 : Begin
|
||||
OK := False;
|
||||
Break;
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
Until False;
|
||||
End;
|
||||
|
||||
Box.Close;
|
||||
Box.Free;
|
||||
End;
|
||||
|
||||
End.
|
||||
592
mystic/bbs_ansi_menubox.pas
Normal file
592
mystic/bbs_ansi_menubox.pas
Normal file
|
|
@ -0,0 +1,592 @@
|
|||
Unit bbs_Ansi_MenuBox;
|
||||
|
||||
{$I M_OPS.PAS}
|
||||
|
||||
Interface
|
||||
|
||||
Uses
|
||||
m_Types;
|
||||
|
||||
Procedure WriteXY (X, Y, A: Byte; S: String);
|
||||
Procedure WriteXYPipe (X, Y, A, SZ : Byte; S: String);
|
||||
Function InXY (X, Y, Field, Max, Mode: Byte; Default: String) : String;
|
||||
Procedure VerticalLine (X, Y1, Y2 : Byte);
|
||||
Function ShowMsgBox (BoxType : Byte; Str : String) : Boolean;
|
||||
|
||||
Type
|
||||
TAnsiMenuBox = Class
|
||||
Image : TConsoleImageRec;
|
||||
HideImage : ^TConsoleImageRec;
|
||||
FrameType : Byte;
|
||||
BoxAttr : Byte;
|
||||
Box3D : Boolean;
|
||||
BoxAttr2 : Byte;
|
||||
BoxAttr3 : Byte;
|
||||
BoxAttr4 : Byte;
|
||||
Shadow : Boolean;
|
||||
ShadowAttr : Byte;
|
||||
HeadAttr : Byte;
|
||||
HeadType : Byte;
|
||||
Header : String;
|
||||
WasOpened : Boolean;
|
||||
|
||||
Constructor Create;
|
||||
Destructor Destroy; Override;
|
||||
Procedure Open (X1, Y1, X2, Y2: Byte);
|
||||
Procedure Close;
|
||||
Procedure Hide;
|
||||
Procedure Show;
|
||||
End;
|
||||
|
||||
TAnsiMenuListStatusProc = Procedure (Num: Word; Str: String);
|
||||
|
||||
TAnsiMenuListBoxRec = Record
|
||||
Name : String;
|
||||
Tagged : Byte; { 0 = false, 1 = true, 2 = never }
|
||||
End;
|
||||
|
||||
TAnsiMenuList = Class
|
||||
List : Array[1..65535] of ^TAnsiMenuListBoxRec;
|
||||
Box : TAnsiMenuBox;
|
||||
HiAttr : Byte;
|
||||
LoAttr : Byte;
|
||||
PosBar : Boolean;
|
||||
Format : Byte;
|
||||
LoChars : String;
|
||||
HiChars : String;
|
||||
ExitCode : Char;
|
||||
Picked : Integer;
|
||||
TopPage : Integer;
|
||||
NoWindow : Boolean;
|
||||
ListMax : Integer;
|
||||
AllowTag : Boolean;
|
||||
TagChar : Char;
|
||||
TagKey : Char;
|
||||
TagPos : Byte;
|
||||
TagAttr : Byte;
|
||||
Marked : Word;
|
||||
StatusProc : TAnsiMenuListStatusProc;
|
||||
Width : Integer;
|
||||
WinSize : Integer;
|
||||
X1 : Byte;
|
||||
Y1 : Byte;
|
||||
NoInput : Boolean;
|
||||
|
||||
Constructor Create;
|
||||
Destructor Destroy; Override;
|
||||
Procedure Open (BX1, BY1, BX2, BY2: Byte);
|
||||
Procedure Close;
|
||||
Procedure Add (Str: String; B: Byte);
|
||||
Procedure Get (Num: Word; Var Str: String; Var B: Boolean);
|
||||
Procedure SetStatusProc (P: TAnsiMenuListStatusProc);
|
||||
Procedure Clear;
|
||||
Procedure Delete (RecPos : Word);
|
||||
Procedure Update;
|
||||
End;
|
||||
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
m_Strings,
|
||||
BBS_Core,
|
||||
BBS_IO,
|
||||
BBS_Common;
|
||||
|
||||
Procedure WriteXY (X, Y, A: Byte; S: String);
|
||||
Begin
|
||||
Session.io.AnsiGotoXY(X, Y);
|
||||
Session.io.AnsiColor(A);
|
||||
Session.io.OutRaw(S);
|
||||
End;
|
||||
|
||||
Procedure WriteXYPipe (X, Y, A, SZ: Byte; S: String);
|
||||
Begin
|
||||
Session.io.AnsiGotoXY(X, Y);
|
||||
Session.io.AnsiColor(A);
|
||||
Session.io.OutPipe(S);
|
||||
|
||||
While Screen.CursorX < SZ Do Session.io.BufAddChar(' ');
|
||||
End;
|
||||
|
||||
Function InXY (X, Y, Field, Max, Mode: Byte; Default: String) : String;
|
||||
Begin
|
||||
Session.io.AnsiGotoXY (X, Y);
|
||||
|
||||
InXY := Session.io.GetInput (Field, Max, Mode, Default);
|
||||
End;
|
||||
|
||||
Procedure VerticalLine (X, Y1, Y2: Byte);
|
||||
Var
|
||||
Count : Byte;
|
||||
Begin
|
||||
For Count := Y1 to Y2 Do
|
||||
WriteXY (X, Count, 112, '³');
|
||||
End;
|
||||
|
||||
Function ShowMsgBox (BoxType : Byte; Str : String) : Boolean;
|
||||
Var
|
||||
Len : Byte;
|
||||
Len2 : Byte;
|
||||
Pos : Byte;
|
||||
MsgBox : TAnsiMenuBox;
|
||||
Ch : Char;
|
||||
Begin
|
||||
Result := True;
|
||||
|
||||
{ 0 = ok box }
|
||||
{ 1 = y/n box }
|
||||
{ 2 = just box }
|
||||
{ 3 = just box dont close }
|
||||
|
||||
MsgBox := TAnsiMenuBox.Create;
|
||||
|
||||
Len := (80 - (Length(Str) + 3)) DIV 2;
|
||||
Pos := 1;
|
||||
|
||||
MsgBox.Header := ' Info ';
|
||||
|
||||
If BoxType < 2 Then
|
||||
MsgBox.Open (Len, 10, Len + Length(Str) + 3, 15)
|
||||
Else
|
||||
MsgBox.Open (Len, 10, Len + Length(Str) + 3, 14);
|
||||
|
||||
WriteXY (Len + 2, 12, 113, Str);
|
||||
|
||||
Case BoxType of
|
||||
0 : Begin
|
||||
Len2 := (Length(Str) - 4) DIV 2;
|
||||
WriteXY (Len + Len2 + 2, 14, 30, ' OK ');
|
||||
Ch := Session.io.GetKey;
|
||||
End;
|
||||
1 : Repeat
|
||||
Len2 := (Length(Str) - 9) DIV 2;
|
||||
|
||||
WriteXY (Len + Len2 + 2, 14, 113, ' YES ');
|
||||
WriteXY (Len + Len2 + 7, 14, 113, ' NO ');
|
||||
|
||||
If Pos = 1 Then
|
||||
WriteXY (Len + Len2 + 2, 14, 30, ' YES ')
|
||||
Else
|
||||
WriteXY (Len + Len2 + 7, 14, 30, ' NO ');
|
||||
|
||||
Ch := Session.io.GetKey;
|
||||
|
||||
If Session.io.IsArrow Then
|
||||
Case Ch of
|
||||
#75 : Pos := 1;
|
||||
#77 : Pos := 0;
|
||||
End
|
||||
Else
|
||||
Case Ch of
|
||||
#13 : Begin
|
||||
Result := Boolean(Pos);
|
||||
Break;
|
||||
End;
|
||||
#32 : If Pos = 0 Then Inc(Pos) Else Pos := 0;
|
||||
'N' : Pos := 0;
|
||||
'Y' : Pos := 1;
|
||||
End;
|
||||
Until False;
|
||||
End;
|
||||
|
||||
MsgBox.Close;
|
||||
MsgBox.Free;
|
||||
End;
|
||||
|
||||
Constructor TAnsiMenuBox.Create;
|
||||
Begin
|
||||
Inherited Create;
|
||||
|
||||
Shadow := True;
|
||||
ShadowAttr := 0;
|
||||
Header := '';
|
||||
FrameType := 6;
|
||||
Box3D := True;
|
||||
BoxAttr := 15 + 7 * 16;
|
||||
BoxAttr2 := 8 + 7 * 16;
|
||||
BoxAttr3 := 15 + 7 * 16;
|
||||
BoxAttr4 := 8 + 7 * 16;
|
||||
HeadAttr := 0 + 7 * 16;
|
||||
HeadType := 0;
|
||||
HideImage := NIL;
|
||||
WasOpened := False;
|
||||
|
||||
FillChar(Image, SizeOf(TConsoleImageRec), 0);
|
||||
|
||||
Session.io.BufFlush;
|
||||
End;
|
||||
|
||||
Destructor TAnsiMenuBox.Destroy;
|
||||
Begin
|
||||
Inherited Destroy;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuBox.Open (X1, Y1, X2, Y2: Byte);
|
||||
Const
|
||||
BF : Array[1..8] of String[8] =
|
||||
('ÚÄ¿³³ÀÄÙ',
|
||||
'ÉÍ»ººÈͼ',
|
||||
'ÖÄ·ººÓĽ',
|
||||
'Õ͸³³Ô;',
|
||||
'ÛßÛÛÛÛÜÛ',
|
||||
'ÛßÜÛÛßÜÛ',
|
||||
' ',
|
||||
'.-.||`-''');
|
||||
Var
|
||||
A : Integer;
|
||||
B : Integer;
|
||||
Ch : Char;
|
||||
Begin
|
||||
If Not WasOpened Then
|
||||
If Shadow Then
|
||||
Screen.GetScreenImage(X1, Y1, X2 + 2{3}, Y2 + 1, Image)
|
||||
Else
|
||||
Screen.GetScreenImage(X1, Y1, X2, Y2, Image);
|
||||
|
||||
WasOpened := True;
|
||||
|
||||
B := X2 - X1 - 1;
|
||||
|
||||
If Not Box3D Then Begin
|
||||
BoxAttr2 := BoxAttr;
|
||||
BoxAttr3 := BoxAttr;
|
||||
BoxAttr4 := BoxAttr;
|
||||
End;
|
||||
|
||||
WriteXY (X1, Y1, BoxAttr, BF[FrameType][1] + strRep(BF[FrameType][2], B));
|
||||
WriteXY (X2, Y1, BoxAttr4, BF[FrameType][3]);
|
||||
|
||||
For A := Y1 + 1 To Y2 - 1 Do Begin
|
||||
WriteXY (X1, A, BoxAttr, BF[FrameType][4] + strRep(' ', B));
|
||||
WriteXY (X2, A, BoxAttr2, BF[FrameType][5]);
|
||||
End;
|
||||
|
||||
WriteXY (X1, Y2, BoxAttr3, BF[FrameType][6]);
|
||||
WriteXY (X1+1, Y2, BoxAttr2, strRep(BF[FrameType][7], B) + BF[FrameType][8]);
|
||||
|
||||
If Header <> '' Then
|
||||
Case HeadType of
|
||||
0 : WriteXY (X1 + 1 + (B - Length(Header)) DIV 2, Y1, HeadAttr, Header);
|
||||
1 : WriteXY (X1 + 1, Y1, HeadAttr, Header);
|
||||
2 : WriteXY (X2 - Length(Header), Y1, HeadAttr, Header);
|
||||
End;
|
||||
|
||||
If Shadow Then Begin
|
||||
For A := Y1 + 1 to Y2 + 1 Do
|
||||
For B := X2 to X2 + 1 Do Begin
|
||||
Ch := Screen.ReadCharXY(B, A);
|
||||
WriteXY (B + 1, A, ShadowAttr, Ch);
|
||||
End;
|
||||
|
||||
A := Y2 + 1;
|
||||
|
||||
For B := (X1 + 2) To (X2 + 2) Do Begin
|
||||
Ch := Screen.ReadCharXY(B, A);
|
||||
WriteXY (B, A, ShadowAttr, Ch);
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuBox.Close;
|
||||
Begin
|
||||
If WasOpened Then Session.io.RemoteRestore(Image);
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuBox.Hide;
|
||||
Begin
|
||||
If Assigned(HideImage) Then FreeMem(HideImage, SizeOf(TConsoleImageRec));
|
||||
|
||||
GetMem (HideImage, SizeOf(TConsoleImageRec));
|
||||
|
||||
Screen.GetScreenImage (Image.X1, Image.Y1, Image.X2, Image.Y2, HideImage^);
|
||||
|
||||
Session.io.RemoteRestore(Image);
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuBox.Show;
|
||||
Begin
|
||||
If Assigned (HideImage) Then Begin
|
||||
Session.io.RemoteRestore(HideImage^);
|
||||
FreeMem (HideImage, SizeOf(TConsoleImageRec));
|
||||
HideImage := NIL;
|
||||
End;
|
||||
End;
|
||||
|
||||
Constructor TAnsiMenuList.Create;
|
||||
Begin
|
||||
Inherited Create;
|
||||
|
||||
Box := TAnsiMenuBox.Create;
|
||||
ListMax := 0;
|
||||
HiAttr := 15 + 1 * 16;
|
||||
LoAttr := 1 + 7 * 16;
|
||||
PosBar := True;
|
||||
Format := 0;
|
||||
LoChars := #13#27;
|
||||
HiChars := '';
|
||||
NoWindow := False;
|
||||
AllowTag := False;
|
||||
TagChar := '*';
|
||||
TagKey := #32;
|
||||
TagPos := 0;
|
||||
TagAttr := 15 + 7 * 16;
|
||||
Marked := 0;
|
||||
Picked := 1;
|
||||
NoInput := False;
|
||||
StatusProc := NIL;
|
||||
|
||||
Session.io.BufFlush;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuList.Clear;
|
||||
Var
|
||||
Count : Word;
|
||||
Begin
|
||||
For Count := 1 to ListMax Do
|
||||
Dispose(List[Count]);
|
||||
|
||||
ListMax := 0;
|
||||
Marked := 0;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuList.Delete (RecPos : Word);
|
||||
Var
|
||||
Count : Word;
|
||||
Begin
|
||||
If List[RecPos] <> NIL Then Begin
|
||||
Dispose (List[RecPos]);
|
||||
|
||||
For Count := RecPos To ListMax - 1 Do
|
||||
List[Count] := List[Count + 1];
|
||||
|
||||
Dec (ListMax);
|
||||
End;
|
||||
End;
|
||||
|
||||
Destructor TAnsiMenuList.Destroy;
|
||||
Begin
|
||||
Box.Free;
|
||||
|
||||
Clear;
|
||||
|
||||
Inherited Destroy;
|
||||
End;
|
||||
|
||||
// this class is very inefficient and needs to have updates redone
|
||||
// BarON
|
||||
// BarOFF
|
||||
// UpdatePercent
|
||||
|
||||
Procedure TAnsiMenuList.Update;
|
||||
Var
|
||||
A : LongInt;
|
||||
S : String;
|
||||
B : Integer;
|
||||
C : Integer;
|
||||
Begin
|
||||
For A := 0 to WinSize - 1 Do Begin
|
||||
C := TopPage + A;
|
||||
|
||||
If C <= ListMax Then Begin
|
||||
S := ' ' + List[C]^.Name + ' ';
|
||||
Case Format of
|
||||
0 : S := strPadR (S, Width, ' ');
|
||||
1 : S := strPadL (S, Width, ' ');
|
||||
2 : S := strPadC (S, Width, ' ');
|
||||
End;
|
||||
End Else
|
||||
S := strRep(' ', Width);
|
||||
|
||||
If C = Picked Then B := HiAttr Else B := LoAttr;
|
||||
|
||||
WriteXY (X1 + 1, Y1 + 1 + A, B, S);
|
||||
|
||||
If PosBar Then
|
||||
WriteXY (X1 + Width + 1, Y1 + 1 + A, Box.BoxAttr2, #176);
|
||||
|
||||
If AllowTag Then
|
||||
If (C <= ListMax) and (List[C]^.Tagged = 1) Then
|
||||
WriteXY (TagPos, Y1 + 1 + A, TagAttr, TagChar)
|
||||
Else
|
||||
WriteXY (TagPos, Y1 + 1 + A, TagAttr, ' ');
|
||||
End;
|
||||
|
||||
If PosBar Then
|
||||
If (ListMax > 0) and (WinSize > 0) Then Begin
|
||||
A := (Picked * WinSize) DIV ListMax;
|
||||
If Picked >= ListMax Then A := Pred(WinSize);
|
||||
If (A < 0) or (Picked = 1) Then A := 0;
|
||||
WriteXY (X1 + Width + 1, Y1 + 1 + A, Box.BoxAttr2, #178);
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuList.Open (BX1, BY1, BX2, BY2 : Byte);
|
||||
Var
|
||||
Ch : Char;
|
||||
A : Word;
|
||||
sPos : Word;
|
||||
ePos : Word;
|
||||
First : Boolean;
|
||||
Begin
|
||||
If Not NoWindow Then
|
||||
Box.Open (BX1, BY1, BX2, BY2);
|
||||
|
||||
X1 := BX1;
|
||||
Y1 := BY1;
|
||||
|
||||
If (Picked < TopPage) or (Picked < 1) or (Picked > ListMax) or (TopPage < 1) or (TopPage > ListMax) Then Begin
|
||||
Picked := 1;
|
||||
TopPage := 1;
|
||||
End;
|
||||
|
||||
Width := BX2 - X1 - 1;
|
||||
WinSize := BY2 - Y1 - 1;
|
||||
TagPos := X1 + 1;
|
||||
|
||||
If NoInput Then Exit;
|
||||
|
||||
Update;
|
||||
|
||||
Repeat
|
||||
If Assigned(StatusProc) Then
|
||||
If ListMax > 0 Then
|
||||
StatusProc(Picked, List[Picked]^.Name)
|
||||
Else
|
||||
StatusProc(Picked, '');
|
||||
|
||||
Ch := Session.io.GetKey;
|
||||
|
||||
If Session.io.IsArrow Then Begin
|
||||
Case Ch of
|
||||
#71 : If Picked > 1 Then Begin { home }
|
||||
Picked := 1;
|
||||
TopPage := 1;
|
||||
Update;
|
||||
End;
|
||||
#72 : If (TopPage > 1) Or (Picked > 1) Then Begin { up arrow }
|
||||
If Picked > 1 Then Dec (Picked);
|
||||
If Picked < TopPage Then Dec (TopPage);
|
||||
Update;
|
||||
End;
|
||||
#73,
|
||||
#75 : If (TopPage > 1) or (Picked > 1) Then Begin { page up / left arrow }
|
||||
If Picked - WinSize > 1 Then Dec (Picked, WinSize) Else Picked := 1;
|
||||
If TopPage - WinSize < 1 Then TopPage := 1 Else Dec(TopPage, WinSize);
|
||||
Update;
|
||||
End;
|
||||
#79 : If Picked < ListMax Then Begin { end }
|
||||
If ListMax > WinSize Then TopPage := ListMax - WinSize + 1;
|
||||
Picked := ListMax;
|
||||
Update;
|
||||
End;
|
||||
#80 : Begin { down arrow }
|
||||
If Picked < ListMax Then Inc (Picked);
|
||||
If Picked > TopPage + WinSize - 1 Then Inc (TopPage);
|
||||
Update;
|
||||
End;
|
||||
#77,
|
||||
#81 : If ListMax > 0 Then Begin { page down / right arrow }
|
||||
If ListMax > WinSize Then Begin
|
||||
If Picked + WinSize > ListMax Then
|
||||
Picked := ListMax
|
||||
Else
|
||||
Inc (Picked, WinSize);
|
||||
Inc (TopPage, WinSize);
|
||||
If TopPage + WinSize > ListMax Then TopPage := ListMax - WinSize + 1;
|
||||
End Else Begin
|
||||
Picked := ListMax;
|
||||
End;
|
||||
Update;
|
||||
End;
|
||||
Else
|
||||
If Pos(Ch, HiChars) > 0 Then Begin
|
||||
ExitCode := Ch;
|
||||
Exit;
|
||||
End;
|
||||
End;
|
||||
End Else
|
||||
If AllowTag and (Ch = TagKey) and (List[Picked]^.Tagged <> 2) Then Begin
|
||||
If (List[Picked]^.Tagged = 1) Then Begin
|
||||
Dec (List[Picked]^.Tagged);
|
||||
Dec (Marked);
|
||||
End Else Begin
|
||||
List[Picked]^.Tagged := 1;
|
||||
Inc (Marked);
|
||||
End;
|
||||
If Picked < ListMax Then Inc (Picked);
|
||||
If Picked > TopPage + WinSize - 1 Then Inc (TopPage);
|
||||
End Else
|
||||
If Pos(Ch, LoChars) > 0 Then Begin
|
||||
ExitCode := Ch;
|
||||
Exit;
|
||||
End Else Begin
|
||||
Ch := UpCase(Ch);
|
||||
First := True;
|
||||
sPos := Picked + 1;
|
||||
ePos := ListMax;
|
||||
|
||||
If sPos > ListMax Then sPos := 1;
|
||||
|
||||
A := sPos;
|
||||
|
||||
While (A <= ePos) Do Begin
|
||||
If UpCase(List[A]^.Name[1]) = Ch Then Begin
|
||||
While A <> Picked Do Begin
|
||||
If Picked < A Then Begin
|
||||
If Picked < ListMax Then Inc (Picked);
|
||||
If Picked > TopPage + WinSize - 1 Then Inc (TopPage);
|
||||
End Else
|
||||
If Picked > A Then Begin
|
||||
If Picked > 1 Then Dec (Picked);
|
||||
If Picked < TopPage Then Dec (TopPage);
|
||||
End;
|
||||
End;
|
||||
Break;
|
||||
End;
|
||||
|
||||
If (A = ListMax) and First Then Begin
|
||||
A := 0;
|
||||
sPos := 1;
|
||||
ePos := Picked - 1;
|
||||
First := False;
|
||||
End;
|
||||
|
||||
Inc (A);
|
||||
End;
|
||||
End;
|
||||
Until False;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuList.Close;
|
||||
Begin
|
||||
If Not NoWindow Then Box.Close;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuList.Add (Str : String; B : Byte);
|
||||
Begin
|
||||
Inc (ListMax);
|
||||
New (List[ListMax]);
|
||||
|
||||
List[ListMax]^.Name := Str;
|
||||
List[ListMax]^.Tagged := B;
|
||||
|
||||
If B = 1 Then Inc(Marked);
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuList.Get (Num : Word; Var Str : String; Var B : Boolean);
|
||||
Begin
|
||||
Str := '';
|
||||
B := False;
|
||||
|
||||
If Num <= ListMax Then Begin
|
||||
Str := List[Num]^.Name;
|
||||
B := List[Num]^.Tagged = 1;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuList.SetStatusProc (P : TAnsiMenuListStatusProc);
|
||||
Begin
|
||||
StatusProc := P;
|
||||
End;
|
||||
|
||||
End.
|
||||
700
mystic/bbs_ansi_menuform.pas
Normal file
700
mystic/bbs_ansi_menuform.pas
Normal file
|
|
@ -0,0 +1,700 @@
|
|||
Unit bbs_Ansi_MenuForm;
|
||||
|
||||
{$I M_OPS.PAS}
|
||||
|
||||
Interface
|
||||
|
||||
Uses
|
||||
m_Types,
|
||||
bbs_ansi_MenuInput;
|
||||
|
||||
Const
|
||||
FormMaxItems = 50;
|
||||
|
||||
Const
|
||||
YesNoStr : Array[False..True] of String[03] = ('No', 'Yes');
|
||||
|
||||
Type
|
||||
FormItemType = (
|
||||
ItemNone,
|
||||
ItemString,
|
||||
ItemBoolean,
|
||||
ItemByte,
|
||||
ItemWord,
|
||||
ItemLong,
|
||||
ItemToggle,
|
||||
ItemPath,
|
||||
ItemChar,
|
||||
ItemAttr,
|
||||
ItemFlags,
|
||||
ItemDate,
|
||||
ItemPass,
|
||||
ItemPipe,
|
||||
ItemCaps,
|
||||
ItemBits
|
||||
);
|
||||
|
||||
FormItemPTR = ^FormItemRec;
|
||||
FormItemRec = Record
|
||||
HotKey : Char;
|
||||
Desc : String[60];
|
||||
Help : String[120];
|
||||
DescX : Byte;
|
||||
DescY : Byte;
|
||||
DescSize : Byte;
|
||||
FieldX : Byte;
|
||||
FieldY : Byte;
|
||||
FieldSize : Byte;
|
||||
ItemType : FormItemType;
|
||||
MaxSize : Byte;
|
||||
MinNum : LongInt;
|
||||
MaxNum : LongInt;
|
||||
S : ^String;
|
||||
O : ^Boolean;
|
||||
B : ^Byte;
|
||||
W : ^Word;
|
||||
L : ^LongInt;
|
||||
C : ^Char;
|
||||
F : ^TMenuFormFlagsRec;
|
||||
Toggle : String[68];
|
||||
End;
|
||||
|
||||
TAnsiMenuFormHelpProc = Procedure (Item: FormItemRec);
|
||||
TAnsiMenuFormDrawProc = Procedure (Hi: Boolean); // not functional
|
||||
TAnsiMenuFormDataProc = Procedure; // not functional
|
||||
|
||||
TAnsiMenuForm = Class
|
||||
Private
|
||||
Function GetColorAttr (C: Byte) : Byte;
|
||||
Function DrawAccessFlags (Var Flags: TMenuFormFlagsRec) : String;
|
||||
Procedure EditAccessFlags (Var Flags: TMenuFormFlagsRec);
|
||||
Procedure AddBasic (HK: Char; D: String; X, Y, FX, FY, DS, FS, MS: Byte; I: FormItemType; P: Pointer; H: String);
|
||||
Procedure BarON;
|
||||
Procedure BarOFF (RecPos: Word);
|
||||
Procedure FieldWrite (RecPos : Word);
|
||||
Procedure EditOption;
|
||||
Public
|
||||
Input : TAnsiMenuInput;
|
||||
HelpProc : TAnsiMenuFormHelpProc;
|
||||
DrawProc : TAnsiMenuFormDrawProc;
|
||||
DataProc : TAnsiMenuFormDataProc;
|
||||
ItemData : Array[1..FormMaxItems] of FormItemPTR;
|
||||
Items : Word;
|
||||
ItemPos : Word;
|
||||
Changed : Boolean;
|
||||
ExitOnFirst : Boolean;
|
||||
ExitOnLast : Boolean;
|
||||
WasHiExit : Boolean;
|
||||
WasFirstExit : Boolean;
|
||||
WasLastExit : Boolean;
|
||||
LoExitChars : String[30];
|
||||
HiExitChars : String[30];
|
||||
HelpX : Byte;
|
||||
HelpY : Byte;
|
||||
HelpSize : Byte;
|
||||
HelpColor : Byte;
|
||||
cLo : Byte;
|
||||
cHi : Byte;
|
||||
cData : Byte;
|
||||
cLoKey : Byte;
|
||||
cHiKey : Byte;
|
||||
cField1 : Byte;
|
||||
cField2 : Byte;
|
||||
|
||||
Constructor Create;
|
||||
Destructor Destroy; Override;
|
||||
|
||||
Procedure Clear;
|
||||
Procedure AddNone (HK: Char; D: String; X, Y, DS: Byte; H: String);
|
||||
Procedure AddStr (HK: Char; D: String; X, Y, FX, FY, DS, FS, MX: Byte; P: Pointer; H: String);
|
||||
Procedure AddPipe (HK: Char; D: String; X, Y, FX, FY, DS, FS, MX: Byte; P: Pointer; H: String);
|
||||
Procedure AddPath (HK: Char; D: String; X, Y, FX, FY, DS, FS, MX: Byte; P: Pointer; H: String);
|
||||
Procedure AddPass (HK: Char; D: String; X, Y, FX, FY, DS, FS, MX: Byte; P: Pointer; H: String);
|
||||
Procedure AddBol (HK: Char; D: String; X, Y, FX, FY, DS, FS: Byte; P: Pointer; H: String);
|
||||
Procedure AddByte (HK: Char; D: String; X, Y, FX, FY, DS, FS: Byte; MN, MX: Byte; P: Pointer; H: String);
|
||||
Procedure AddWord (HK: Char; D: String; X, Y, FX, FY, DS, FS: Byte; MN, MX: Word; P: Pointer; H: String);
|
||||
Procedure AddLong (HK: Char; D: String; X, Y, FX, FY, DS, FS: Byte; MN, MX: LongInt; P: Pointer; H: String);
|
||||
Procedure AddTog (HK: Char; D: String; X, Y, FX, FY, DS, FS, MN, MX: Byte; TG: String; P: Pointer; H: String);
|
||||
Procedure AddChar (HK: Char; D: String; X, Y, FX, FY, DS, MN, MX: Byte; P: Pointer; H: String);
|
||||
Procedure AddAttr (HK: Char; D: String; X, Y, FX, FY, DS: Byte; P: Pointer; H: String);
|
||||
Procedure AddFlag (HK: Char; D: String; X, Y, FX, FY, DS: Byte; P: Pointer; H: String);
|
||||
Procedure AddDate (HK: Char; D: String; X, Y, FX, FY, DS: Byte; P: Pointer; H: String);
|
||||
Procedure AddCaps (HK: Char; D: String; X, Y, FX, FY, DS, FS, MX: Byte; P: Pointer; H: String);
|
||||
Procedure AddBits (HK: Char; D: String; X, Y, FX, FY, DS: Byte; Flag: LongInt; P: Pointer; H: String);
|
||||
Function Execute : Char;
|
||||
End;
|
||||
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
m_FileIO,
|
||||
m_Strings,
|
||||
bbs_Core,
|
||||
bbs_Ansi_MenuBox;
|
||||
|
||||
Constructor TAnsiMenuForm.Create;
|
||||
Begin
|
||||
Inherited Create;
|
||||
|
||||
Input := TAnsiMenuInput.Create;
|
||||
HelpProc := NIL;
|
||||
DrawProc := NIL;
|
||||
DataProc := NIL;
|
||||
cLo := 0 + 7 * 16;
|
||||
cHi := 11 + 1 * 16;
|
||||
cData := 1 + 7 * 16;
|
||||
cLoKey := 15 + 7 * 16;
|
||||
cHiKey := 15 + 1 * 16;
|
||||
cField1 := 15 + 1 * 16;
|
||||
cField2 := 7 + 1 * 16;
|
||||
HelpX := 5;
|
||||
HelpY := 24;
|
||||
HelpColor := 15;
|
||||
HelpSize := 75;
|
||||
WasHiExit := False;
|
||||
WasFirstExit := False;
|
||||
ExitOnFirst := False;
|
||||
WasLastExit := False;
|
||||
ExitOnLast := False;
|
||||
|
||||
Clear;
|
||||
End;
|
||||
|
||||
Destructor TAnsiMenuForm.Destroy;
|
||||
Begin
|
||||
Clear;
|
||||
|
||||
Input.Free;
|
||||
|
||||
Inherited Destroy;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.Clear;
|
||||
Var
|
||||
Count : Word;
|
||||
Begin
|
||||
For Count := 1 to Items Do
|
||||
Dispose(ItemData[Count]);
|
||||
|
||||
Items := 0;
|
||||
ItemPos := 1;
|
||||
Changed := False;
|
||||
End;
|
||||
|
||||
Function TAnsiMenuForm.DrawAccessFlags (Var Flags: TMenuFormFlagsRec) : String;
|
||||
Var
|
||||
Str : String;
|
||||
Ch : Char;
|
||||
Begin
|
||||
Str := '';
|
||||
|
||||
For Ch := 'A' to 'Z' Do
|
||||
If Ord(Ch) - 64 in Flags Then Str := Str + Ch Else Str := Str + '-';
|
||||
|
||||
Result := Str;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.EditAccessFlags (Var Flags: TMenuFormFlagsRec);
|
||||
Var
|
||||
Box : TAnsiMenuBox;
|
||||
Ch : Char;
|
||||
Begin
|
||||
Box := TAnsiMenuBox.Create;
|
||||
|
||||
Box.Open (25, 11, 56, 14);
|
||||
|
||||
WriteXY (28, 13, 113, 'A-Z to toggle, ESC to Quit');
|
||||
|
||||
Repeat
|
||||
WriteXY (28, 12, 112, DrawAccessFlags(Flags));
|
||||
|
||||
Ch := UpCase(Session.io.GetKey);
|
||||
|
||||
Case Ch of
|
||||
#27 : Break;
|
||||
'A'..
|
||||
'Z' : Begin
|
||||
If Ord(Ch) - 64 in Flags Then
|
||||
Flags := Flags - [Ord(Ch) - 64]
|
||||
Else
|
||||
Flags := Flags + [Ord(Ch) - 64];
|
||||
|
||||
Changed := True;
|
||||
End;
|
||||
End;
|
||||
Until False;
|
||||
|
||||
Box.Close;
|
||||
Box.Free;
|
||||
End;
|
||||
|
||||
Function TAnsiMenuForm.GetColorAttr (C: Byte) : Byte;
|
||||
Var
|
||||
FG : Byte;
|
||||
BG : Byte;
|
||||
Box : TAnsiMenuBox;
|
||||
A : Byte;
|
||||
B : Byte;
|
||||
Ch : Char;
|
||||
Begin
|
||||
FG := C AND $F;
|
||||
BG := (C SHR 4) AND 7;
|
||||
|
||||
Box := TAnsiMenuBox.Create;
|
||||
|
||||
Box.Header := ' Select color ';
|
||||
|
||||
Box.Open (30, 7, 51, 18);
|
||||
|
||||
Repeat
|
||||
For A := 0 to 9 Do
|
||||
WriteXY (31, 8 + A, Box.BoxAttr, ' ');
|
||||
|
||||
For A := 0 to 7 Do
|
||||
For B := 0 to 15 Do
|
||||
WriteXY (33 + B, 9 + A, B + A * 16, 'þ');
|
||||
|
||||
WriteXY (37, 18, FG + BG * 16, ' Sample ');
|
||||
|
||||
WriteXYPipe (31 + FG, 8 + BG, 15, 5, 'Û|23ßßß|08Ü');
|
||||
WriteXYPipe (31 + FG, 9 + BG, 15, 5, 'Û|23 |08Û');
|
||||
WriteXYPipe (31 + FG, 10 + BG, 15, 5, '|23ß|08ÜÜÜ|08Û');
|
||||
WriteXY (33 + FG, 9 + BG, FG + BG * 16, 'þ');
|
||||
|
||||
Ch := Session.io.GetKey;
|
||||
|
||||
If Session.io.IsArrow Then Begin
|
||||
Case Ch of
|
||||
#72 : If BG > 0 Then Dec(BG);
|
||||
#75 : If FG > 0 Then Dec(FG);
|
||||
#77 : If FG < 15 Then Inc(FG);
|
||||
#80 : If BG < 7 Then Inc(BG);
|
||||
End;
|
||||
End Else
|
||||
Case Ch of
|
||||
#13 : Begin
|
||||
GetColorAttr := FG + BG * 16;
|
||||
Break;
|
||||
End;
|
||||
#27 : Begin
|
||||
GetColorAttr := C;
|
||||
Break;
|
||||
End;
|
||||
End;
|
||||
Until False;
|
||||
|
||||
Box.Close;
|
||||
Box.Free;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.AddBasic (HK: Char; D: String; X, Y, FX, FY, DS, FS, MS: Byte; I: FormItemType; P: Pointer; H: String);
|
||||
Begin
|
||||
Inc (Items);
|
||||
|
||||
New (ItemData[Items]);
|
||||
|
||||
With ItemData[Items]^ Do Begin
|
||||
HotKey := HK;
|
||||
Desc := D;
|
||||
DescX := X;
|
||||
DescY := Y;
|
||||
DescSize := DS;
|
||||
Help := H;
|
||||
ItemType := I;
|
||||
FieldSize := FS;
|
||||
MaxSize := MS;
|
||||
FieldX := FX;
|
||||
FieldY := FY;
|
||||
|
||||
Case ItemType of
|
||||
ItemCaps,
|
||||
ItemPipe,
|
||||
ItemPass,
|
||||
ItemDate,
|
||||
ItemPath,
|
||||
ItemString : S := P;
|
||||
ItemBoolean : O := P;
|
||||
ItemAttr,
|
||||
ItemToggle,
|
||||
ItemByte : B := P;
|
||||
ItemWord : W := P;
|
||||
ItemBits,
|
||||
ItemLong : L := P;
|
||||
ItemChar : C := P;
|
||||
ItemFlags : F := P;
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.AddNone (HK: Char; D: String; X, Y, DS: Byte; H: String);
|
||||
Begin
|
||||
If Items = FormMaxItems Then Exit;
|
||||
|
||||
AddBasic (HK, D, X, Y, 0, 0, DS, 0, 0, ItemNone, NIL, H);
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.AddChar (HK: Char; D: String; X, Y, FX, FY, DS, MN, MX: Byte; P: Pointer; H: String);
|
||||
Begin
|
||||
If Items = FormMaxItems Then Exit;
|
||||
|
||||
AddBasic (HK, D, X, Y, FX, FY, DS, 1, 1, ItemChar, P, H);
|
||||
|
||||
ItemData[Items]^.MinNum := MN;
|
||||
ItemData[Items]^.MaxNum := MX;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.AddStr (HK: Char; D: String; X, Y, FX, FY, DS, FS, MX: Byte; P: Pointer; H: String);
|
||||
Begin
|
||||
If Items = FormMaxItems Then Exit;
|
||||
|
||||
AddBasic (HK, D, X, Y, FX, FY, DS, FS, MX, ItemString, P, H);
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.AddPipe (HK: Char; D: String; X, Y, FX, FY, DS, FS, MX: Byte; P: Pointer; H: String);
|
||||
Begin
|
||||
If Items = FormMaxItems Then Exit;
|
||||
|
||||
AddBasic (HK, D, X, Y, FX, FY, DS, FS, MX, ItemPipe, P, H);
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.AddCaps (HK: Char; D: String; X, Y, FX, FY, DS, FS, MX: Byte; P: Pointer; H: String);
|
||||
Begin
|
||||
If Items = FormMaxItems Then Exit;
|
||||
|
||||
AddBasic (HK, D, X, Y, FX, FY, DS, FS, MX, ItemCaps, P, H);
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.AddPass (HK: Char; D: String; X, Y, FX, FY, DS, FS, MX: Byte; P: Pointer; H: String);
|
||||
Begin
|
||||
If Items = FormMaxItems Then Exit;
|
||||
|
||||
AddBasic (HK, D, X, Y, FX, FY, DS, FS, MX, ItemPass, P, H);
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.AddPath (HK: Char; D: String; X, Y, FX, FY, DS, FS, MX: Byte; P: Pointer; H: String);
|
||||
Begin
|
||||
If Items = FormMaxItems Then Exit;
|
||||
|
||||
AddBasic (HK, D, X, Y, FX, FY, DS, FS, MX, ItemPath, P, H);
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.AddBol (HK: Char; D: String; X, Y, FX, FY, DS, FS: Byte; P: Pointer; H: String);
|
||||
Begin
|
||||
If Items = FormMaxItems Then Exit;
|
||||
|
||||
AddBasic (HK, D, X, Y, FX, FY, DS, FS, 3, ItemBoolean, P, H);
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.AddBits (HK: Char; D: String; X, Y, FX, FY, DS: Byte; Flag: LongInt; P: Pointer; H: String);
|
||||
Begin
|
||||
If Items = FormMaxItems Then Exit;
|
||||
|
||||
AddBasic (HK, D, X, Y, FX, FY, DS, 3, 3, ItemBits, P, H);
|
||||
|
||||
ItemData[Items]^.MaxNum := Flag;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.AddByte (HK: Char; D: String; X, Y, FX, FY, DS, FS: Byte; MN, MX: Byte; P: Pointer; H: String);
|
||||
Begin
|
||||
If Items = FormMaxItems Then Exit;
|
||||
|
||||
AddBasic (HK, D, X, Y, FX, FY, DS, FS, Length(strI2S(MX)), ItemByte, P, H);
|
||||
|
||||
ItemData[Items]^.MinNum := MN;
|
||||
ItemData[Items]^.MaxNum := MX;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.AddWord (HK: Char; D: String; X, Y, FX, FY, DS, FS: Byte; MN, MX: Word; P: Pointer; H: String);
|
||||
Begin
|
||||
If Items = FormMaxItems Then Exit;
|
||||
|
||||
AddBasic (HK, D, X, Y, FX, FY, DS, FS, Length(strI2S(MX)), ItemWord, P, H);
|
||||
|
||||
ItemData[Items]^.MinNum := MN;
|
||||
ItemData[Items]^.MaxNum := MX;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.AddLong (HK: Char; D: String; X, Y, FX, FY, DS, FS: Byte; MN, MX: LongInt; P: Pointer; H: String);
|
||||
Begin
|
||||
If Items = FormMaxItems Then Exit;
|
||||
|
||||
AddBasic (HK, D, X, Y, FX, FY, DS, FS, Length(strI2S(MX)), ItemLong, P, H);
|
||||
|
||||
ItemData[Items]^.MinNum := MN;
|
||||
ItemData[Items]^.MaxNum := MX;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.AddTog (HK: Char; D: String; X, Y, FX, FY, DS, FS, MN, MX: Byte; TG: String; P: Pointer; H: String);
|
||||
Begin
|
||||
If Items = FormMaxItems Then Exit;
|
||||
|
||||
AddBasic (HK, D, X, Y, FX, FY, DS, FS, MX, ItemToggle, P, H);
|
||||
|
||||
ItemData[Items]^.Toggle := TG;
|
||||
ItemData[Items]^.MinNum := MN;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.AddAttr (HK: Char; D: String; X, Y, FX, FY, DS: Byte; P: Pointer; H: String);
|
||||
Begin
|
||||
If Items = FormMaxItems Then Exit;
|
||||
|
||||
AddBasic (HK, D, X, Y, FX, FY, DS, 8, 8, ItemAttr, P, H);
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.AddFlag (HK: Char; D: String; X, Y, FX, FY, DS: Byte; P: Pointer; H: String);
|
||||
Begin
|
||||
If Items = FormMaxItems Then Exit;
|
||||
|
||||
AddBasic (HK, D, X, Y, FX, FY, DS, 26, 26, ItemFlags, P, H);
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.AddDate (HK: Char; D: String; X, Y, FX, FY, DS: Byte; P: Pointer; H: String);
|
||||
Begin
|
||||
If Items = FormMaxItems Then Exit;
|
||||
|
||||
AddBasic (HK, D, X, Y, FX, FY, DS, 8, 8, ItemDate, P, H);
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.BarON;
|
||||
Var
|
||||
A : Byte;
|
||||
Begin
|
||||
If ItemPos = 0 Then Exit;
|
||||
|
||||
WriteXY (ItemData[ItemPos]^.DescX, ItemData[ItemPos]^.DescY, cHi, strPadR(ItemData[ItemPos]^.Desc, ItemData[ItemPos]^.DescSize, ' '));
|
||||
|
||||
A := Pos(ItemData[ItemPos]^.HotKey, strUpper(ItemData[ItemPos]^.Desc));
|
||||
|
||||
If A > 0 Then
|
||||
WriteXY (ItemData[ItemPos]^.DescX + A - 1, ItemData[ItemPos]^.DescY, cHiKey, ItemData[ItemPos]^.Desc[A]);
|
||||
|
||||
If HelpSize > 0 Then
|
||||
If Assigned(HelpProc) Then
|
||||
HelpProc(ItemData[ItemPos]^)
|
||||
Else
|
||||
WriteXYPipe (HelpX, HelpY, HelpColor, HelpSize, ItemData[ItemPos]^.Help);
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.BarOFF (RecPos: Word);
|
||||
Var
|
||||
A : Byte;
|
||||
Begin
|
||||
If RecPos = 0 Then Exit;
|
||||
|
||||
With ItemData[RecPos]^ Do Begin
|
||||
WriteXY (DescX, DescY, cLo, strPadR(Desc, DescSize, ' '));
|
||||
|
||||
A := Pos(HotKey, strUpper(Desc));
|
||||
|
||||
If A > 0 Then
|
||||
WriteXY (DescX + A - 1, DescY, cLoKey, Desc[A]);
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.FieldWrite (RecPos : Word);
|
||||
Begin
|
||||
// This could be changed to case itemtype and save display into string
|
||||
// variable. Then we would only require a single Screen.WriteXY function.
|
||||
// It would be a tiny bit slower (obviously, not really noticable) but
|
||||
// would reduce code size.
|
||||
|
||||
With ItemData[RecPos]^ Do Begin
|
||||
Case ItemType of
|
||||
ItemPass : WriteXY (FieldX, FieldY, cData, strPadR(strRep('*', Length(S^)), FieldSize, ' '));
|
||||
ItemCaps,
|
||||
ItemDate,
|
||||
ItemPath,
|
||||
ItemString : WriteXY (FieldX, FieldY, cData, strPadR(S^, FieldSize, ' '));
|
||||
ItemBoolean : WriteXY (FieldX, FieldY, cData, strPadR(YesNoStr[O^], FieldSize, ' '));
|
||||
ItemByte : WriteXY (FieldX, FieldY, cData, strPadR(strI2S(B^), FieldSize, ' '));
|
||||
ItemWord : WriteXY (FieldX, FieldY, cData, strPadR(strI2S(W^), FieldSize, ' '));
|
||||
ItemLong : WriteXY (FieldX, FieldY, cData, strPadR(strI2S(L^), FieldSize, ' '));
|
||||
ItemToggle : WriteXY (FieldX, FieldY, cData, StrPadR(strWordGet(B^ + 1 - MinNum, Toggle, ' '), FieldSize, ' '));
|
||||
ItemChar : WriteXY (FieldX, FieldY, cData, C^);
|
||||
ItemAttr : WriteXY (FieldX, FieldY, B^, ' Sample ');
|
||||
ItemFlags : WriteXY (FieldX, FieldY, cData, DrawAccessFlags(F^));
|
||||
ItemPipe : WriteXYPipe (FieldX, FieldY, 7, FieldSize, S^);
|
||||
ItemBits : WriteXY (FieldX, FieldY, cData, strPadR(YesNoStr[L^ AND MaxNum <> 0], FieldSize, ' '));
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure TAnsiMenuForm.EditOption;
|
||||
Var
|
||||
TempStr : String;
|
||||
TempByte : Byte;
|
||||
TempLong : LongInt;
|
||||
Begin
|
||||
With ItemData[ItemPos]^ Do
|
||||
Case ItemType of
|
||||
ItemPass,
|
||||
ItemCaps : S^ := Input.GetStr(FieldX, FieldY, FieldSize, MaxSize, 2, S^);
|
||||
ItemDate : S^ := Input.GetStr(FieldX, FieldY, FieldSize, MaxSize, 3, S^);
|
||||
ItemPipe,
|
||||
ItemString : S^ := Input.GetStr(FieldX, FieldY, FieldSize, MaxSize, 1, S^);
|
||||
ItemBoolean : Begin
|
||||
O^ := Not O^;
|
||||
Changed := True;
|
||||
End;
|
||||
ItemByte : B^ := Byte(Input.GetNum(FieldX, FieldY, FieldSize, MaxSize, MinNum, MaxNum, B^));
|
||||
ItemWord : W^ := Word(Input.GetNum(FieldX, FieldY, FieldSize, MaxSize, MinNum, MaxNum, W^));
|
||||
ItemLong : L^ := LongInt(Input.GetNum(FieldX, FieldY, FieldSize, MaxSize, MinNum, MaxNum, L^));
|
||||
ItemToggle : Begin
|
||||
If B^ < MaxSize Then Inc(B^) Else B^ := MinNum;
|
||||
Changed := True;
|
||||
End;
|
||||
ItemPath : S^ := DirSlash(Input.GetStr(FieldX, FieldY, FieldSize, MaxSize, 1, S^));
|
||||
ItemChar : Begin
|
||||
TempStr := Input.GetStr(FieldX, FieldY, FieldSize, MaxSize, 1, C^);
|
||||
Changed := TempStr[1] <> C^;
|
||||
C^ := TempStr[1];
|
||||
End;
|
||||
ItemAttr : Begin
|
||||
TempByte := GetColorAttr(B^);
|
||||
Changed := TempByte <> B^;
|
||||
B^ := TempByte;
|
||||
End;
|
||||
ItemFlags : EditAccessFlags(F^);
|
||||
ItemBits : Begin
|
||||
Changed := True;
|
||||
TempLong := L^;
|
||||
TempLong := TempLong XOR MaxNum;
|
||||
L^ := TempLong;
|
||||
End;
|
||||
End;
|
||||
|
||||
FieldWrite (ItemPos);
|
||||
|
||||
Changed := Changed or Input.Changed;
|
||||
End;
|
||||
|
||||
Function TAnsiMenuForm.Execute : Char;
|
||||
Var
|
||||
Count : Word;
|
||||
Ch : Char;
|
||||
NewPos : Word;
|
||||
NewXPos : Word;
|
||||
Begin
|
||||
Session.io.AllowArrow := True;
|
||||
|
||||
WasHiExit := False;
|
||||
|
||||
Input.Attr := cField1;
|
||||
Input.FillAttr := cField2;
|
||||
|
||||
For Count := 1 to Items Do Begin
|
||||
BarOFF(Count);
|
||||
FieldWrite(Count);
|
||||
End;
|
||||
|
||||
BarON;
|
||||
|
||||
Repeat
|
||||
Changed := Changed or Input.Changed;
|
||||
|
||||
Ch := UpCase(Session.io.GetKey);
|
||||
|
||||
If Session.io.IsArrow Then Begin
|
||||
If Pos(Ch, HiExitChars) > 0 Then Begin
|
||||
WasHiExit := True;
|
||||
Result := Ch;
|
||||
Break;
|
||||
End;
|
||||
|
||||
Case Ch of
|
||||
#72 : If ItemPos > 1 Then Begin
|
||||
BarOFF(ItemPos);
|
||||
Dec(ItemPos);
|
||||
BarON;
|
||||
End Else
|
||||
If ExitOnFirst Then Begin
|
||||
WasFirstExit := True;
|
||||
Result := Ch;
|
||||
Break;
|
||||
End;
|
||||
#75 : Begin
|
||||
NewPos := 0;
|
||||
NewXPos := 0;
|
||||
|
||||
For Count := 1 to Items Do
|
||||
If (ItemData[Count]^.DescY = ItemData[ItemPos]^.DescY) and
|
||||
(ItemData[Count]^.DescX < ItemData[ItemPos]^.DescX) and
|
||||
(ItemData[Count]^.DescX > NewXPos) Then Begin
|
||||
NewXPos := ItemData[Count]^.DescX;
|
||||
NewPos := Count;
|
||||
End;
|
||||
|
||||
If NewPos > 0 Then Begin
|
||||
BarOFF(ItemPos);
|
||||
ItemPos := NewPos;
|
||||
BarON;
|
||||
End;
|
||||
End;
|
||||
#77 : Begin
|
||||
NewPos := 0;
|
||||
NewXPos := 80;
|
||||
|
||||
For Count := 1 to Items Do
|
||||
If (ItemData[Count]^.DescY = ItemData[ItemPos]^.DescY) and
|
||||
(ItemData[Count]^.DescX > ItemData[ItemPos]^.DescX) and
|
||||
(ItemData[Count]^.DescX < NewXPos) Then Begin
|
||||
NewXPos := ItemData[Count]^.DescX;
|
||||
NewPos := Count;
|
||||
End;
|
||||
|
||||
If NewPos > 0 Then Begin
|
||||
BarOFF(ItemPos);
|
||||
ItemPos := NewPos;
|
||||
BarON;
|
||||
End;
|
||||
End;
|
||||
#80 : If ItemPos < Items Then Begin
|
||||
BarOFF(ItemPos);
|
||||
Inc(ItemPos);
|
||||
BarON;
|
||||
End Else
|
||||
If ExitOnLast Then Begin
|
||||
WasLastExit := True;
|
||||
Result := Ch;
|
||||
Break;
|
||||
End;
|
||||
End;
|
||||
End Else Begin
|
||||
Case Ch of
|
||||
#13 : If ItemPos > 0 Then
|
||||
If ItemData[ItemPos]^.ItemType = ItemNone Then Begin
|
||||
Result := ItemData[ItemPos]^.HotKey;
|
||||
Break;
|
||||
End Else
|
||||
EditOption;
|
||||
#27 : Begin
|
||||
Result := #27;
|
||||
Break;
|
||||
End;
|
||||
Else
|
||||
If Pos(Ch, LoExitChars) > 0 Then Begin
|
||||
Result := Ch;
|
||||
Break;
|
||||
End;
|
||||
End;
|
||||
|
||||
For Count := 1 to Items Do
|
||||
If ItemData[Count]^.HotKey = Ch Then Begin
|
||||
BarOFF(ItemPos);
|
||||
ItemPos := Count;
|
||||
BarON;
|
||||
|
||||
If ItemData[ItemPos]^.ItemType = ItemNone Then Begin
|
||||
Execute := ItemData[ItemPos]^.HotKey;
|
||||
BarOFF(ItemPos);
|
||||
Exit;
|
||||
End Else
|
||||
EditOption;
|
||||
End;
|
||||
End;
|
||||
Until False;
|
||||
|
||||
BarOFF(ItemPos);
|
||||
End;
|
||||
|
||||
End.
|
||||
199
mystic/bbs_ansi_menuinput.pas
Normal file
199
mystic/bbs_ansi_menuinput.pas
Normal file
|
|
@ -0,0 +1,199 @@
|
|||
Unit bbs_Ansi_MenuInput;
|
||||
|
||||
// ANSI ports of MDL menu/input libraries
|
||||
|
||||
{$I M_OPS.PAS}
|
||||
|
||||
Interface
|
||||
|
||||
Uses
|
||||
m_Strings,
|
||||
bbs_Ansi_MenuBox;
|
||||
|
||||
Type
|
||||
TAnsiMenuInput = Class
|
||||
HiChars : String[40];
|
||||
LoChars : String[40];
|
||||
ExitCode : Char;
|
||||
Attr : Byte;
|
||||
FillChar : Char;
|
||||
FillAttr : Byte;
|
||||
Changed : Boolean;
|
||||
|
||||
Constructor Create;
|
||||
Destructor Destroy; Override;
|
||||
|
||||
Function GetStr (X, Y, Field, Len, Mode: Byte; Default: String) : String;
|
||||
Function GetNum (X, Y, Field, Len: Byte; Min, Max, Default: LongInt) : LongInt;
|
||||
Function GetChar (X, Y : Byte; Default: Char) : Char;
|
||||
Function GetEnter (X, Y, Len: Byte; Default : String) : Boolean;
|
||||
Function GetYN (X, Y : Byte; Default: Boolean) : Boolean;
|
||||
End;
|
||||
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
bbs_Core,
|
||||
bbs_Common,
|
||||
bbs_IO;
|
||||
|
||||
Constructor TAnsiMenuInput.Create;
|
||||
Begin
|
||||
Inherited Create;
|
||||
|
||||
LoChars := #13;
|
||||
HiChars := '';
|
||||
Attr := 15 + 1 * 16;
|
||||
FillAttr := 7 + 1 * 16;
|
||||
FillChar := '°';
|
||||
Changed := False;
|
||||
End;
|
||||
|
||||
Destructor TAnsiMenuInput.Destroy;
|
||||
Begin
|
||||
Inherited Destroy;
|
||||
End;
|
||||
|
||||
Function TAnsiMenuInput.GetYN (X, Y : Byte; Default: Boolean) : Boolean;
|
||||
Var
|
||||
Ch : Char;
|
||||
Res : Boolean;
|
||||
YS : Array[False..True] of String[3] = ('No ', 'Yes');
|
||||
Begin
|
||||
ExitCode := #0;
|
||||
Changed := False;
|
||||
|
||||
Session.io.AnsiGotoXY (X, Y);
|
||||
|
||||
Res := Default;
|
||||
|
||||
Repeat
|
||||
WriteXY (X, Y, Attr, YS[Res]);
|
||||
|
||||
Ch := Session.io.GetKey;
|
||||
|
||||
If Session.io.IsArrow Then Begin
|
||||
If Pos(Ch, HiChars) > 0 Then Begin
|
||||
ExitCode := Ch;
|
||||
Break;
|
||||
End;
|
||||
End Else
|
||||
Case Ch of
|
||||
#13,
|
||||
#32 : Res := Not Res;
|
||||
Else
|
||||
If Pos(Ch, LoChars) > 0 Then Begin
|
||||
ExitCode := Ch;
|
||||
Break;
|
||||
End;
|
||||
End;
|
||||
Until False;
|
||||
|
||||
Changed := (Res <> Default);
|
||||
GetYN := Res;
|
||||
End;
|
||||
|
||||
Function TAnsiMenuInput.GetChar (X, Y : Byte; Default: Char) : Char;
|
||||
Var
|
||||
Ch : Char;
|
||||
Res : Char;
|
||||
Begin
|
||||
ExitCode := #0;
|
||||
Changed := False;
|
||||
Res := Default;
|
||||
|
||||
Session.io.AnsiGotoXY (X, Y);
|
||||
|
||||
Repeat
|
||||
WriteXY (X, Y, Attr, Res);
|
||||
|
||||
Ch := Session.io.GetKey;
|
||||
|
||||
If Session.io.IsArrow Then Begin
|
||||
If Pos(Ch, HiChars) > 0 Then Begin
|
||||
ExitCode := Ch;
|
||||
Break;
|
||||
End;
|
||||
End Else Begin
|
||||
If Ch = #27 Then Res := Default;
|
||||
|
||||
If Pos(Ch, LoChars) > 0 Then Begin
|
||||
ExitCode := Ch;
|
||||
Break;
|
||||
End;
|
||||
|
||||
If Ord(Ch) > 31 Then Res := Ch;
|
||||
End;
|
||||
Until False;
|
||||
|
||||
GetChar := Res;
|
||||
End;
|
||||
|
||||
Function TAnsiMenuInput.GetEnter (X, Y, Len: Byte; Default : String) : Boolean;
|
||||
Var
|
||||
Ch : Char;
|
||||
Res : Boolean;
|
||||
Begin
|
||||
ExitCode := #0;
|
||||
Changed := False;
|
||||
|
||||
WriteXY (X, Y, Attr, strPadR(Default, Len, ' '));
|
||||
|
||||
Session.io.AnsiGotoXY (X, Y);
|
||||
|
||||
Repeat
|
||||
Ch := Session.io.GetKey;
|
||||
Res := Ch = #13;
|
||||
|
||||
If Session.io.IsArrow Then Begin
|
||||
If Pos(Ch, HiChars) > 0 Then Begin
|
||||
ExitCode := Ch;
|
||||
Break;
|
||||
End;
|
||||
End Else
|
||||
If Pos(Ch, LoChars) > 0 Then Begin
|
||||
ExitCode := Ch;
|
||||
Break;
|
||||
End;
|
||||
Until Res;
|
||||
|
||||
Changed := Res;
|
||||
GetEnter := Res;
|
||||
End;
|
||||
|
||||
Function TAnsiMenuInput.GetStr (X, Y, Field, Len, Mode : Byte; Default : String) : String;
|
||||
{ mode options: }
|
||||
{ 0 = numbers only }
|
||||
{ 1 = as typed }
|
||||
{ 2 = all caps }
|
||||
{ 3 = date input }
|
||||
Var
|
||||
Str : String;
|
||||
Begin
|
||||
Session.io.AnsiGotoXY(X, Y);
|
||||
|
||||
Case Mode of
|
||||
0,
|
||||
1 : Str := Session.io.GetInput(Field, Len, 11, Default);
|
||||
2 : Str := Session.io.GetInput(Field, Len, 12, Default);
|
||||
3 : Str := Session.io.GetInput(Field, Len, 15, Default);
|
||||
End;
|
||||
|
||||
Changed := (Str <> Default);
|
||||
Result := Str;
|
||||
End;
|
||||
|
||||
Function TAnsiMenuInput.GetNum (X, Y, Field, Len: Byte; Min, Max, Default: LongInt) : LongInt;
|
||||
Var
|
||||
N : LongInt;
|
||||
Begin
|
||||
N := Default;
|
||||
N := strS2I(Self.GetStr(X, Y, Field, Len, 0, strI2S(N)));
|
||||
|
||||
If N < Min Then N := Min;
|
||||
If N > Max Then N := Max;
|
||||
|
||||
GetNum := N;
|
||||
End;
|
||||
|
||||
End.
|
||||
148
mystic/bbs_cfg_archive.pas
Normal file
148
mystic/bbs_cfg_archive.pas
Normal file
|
|
@ -0,0 +1,148 @@
|
|||
Unit bbs_cfg_Archive;
|
||||
|
||||
{$I M_OPS.PAS}
|
||||
|
||||
Interface
|
||||
|
||||
Procedure Configuration_ArchiveEditor;
|
||||
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
m_FileIO,
|
||||
m_Strings,
|
||||
bbs_Common,
|
||||
bbs_Ansi_MenuBox,
|
||||
bbs_Ansi_MenuForm;
|
||||
|
||||
Procedure EditArchive (Var Arc: RecArchive);
|
||||
Var
|
||||
Box : TAnsiMenuBox;
|
||||
Form : TAnsiMenuForm;
|
||||
Topic : String;
|
||||
Begin
|
||||
Topic := '';
|
||||
Box := TAnsiMenuBox.Create;
|
||||
Form := TAnsiMenuForm.Create;
|
||||
|
||||
Box.Header := ' Archive Editor: ' + Arc.Desc + ' ';
|
||||
|
||||
Box.Open (13, 5, 67, 15);
|
||||
|
||||
Form.HelpSize := 0;
|
||||
|
||||
VerticalLine (28, 7, 13);
|
||||
|
||||
Form.AddBol ('A', ' Active ' , 20, 7, 30, 7, 8, 3, @Arc.Active, '');
|
||||
Form.AddStr ('X', ' Extension ' , 17, 8, 30, 8, 11, 4, 4, @Arc.Ext, '');
|
||||
Form.AddTog ('O', ' OS ' , 24, 9, 30, 9, 4, 7, 0, 2, 'Windows Linux OSX', @Arc.OSType, '');
|
||||
Form.AddStr ('D', ' Description ' , 15, 10, 30, 10, 13, 30, 30, @Arc.Desc, '');
|
||||
Form.AddStr ('P', ' Pack Cmd ' , 18, 11, 30, 11, 10, 35, 80, @Arc.Pack, '');
|
||||
Form.AddStr ('U', ' Unpack Cmd ' , 16, 12, 30, 12, 12, 35, 80, @Arc.Unpack, '');
|
||||
Form.AddStr ('V', ' View Cmd ' , 18, 13, 30, 13, 10, 35, 80, @Arc.View, '');
|
||||
|
||||
Form.Execute;
|
||||
Box.Close;
|
||||
|
||||
Form.Free;
|
||||
Box.Free;
|
||||
End;
|
||||
|
||||
Procedure Configuration_ArchiveEditor;
|
||||
Var
|
||||
Box : TAnsiMenuBox;
|
||||
List : TAnsiMenuList;
|
||||
F : TBufFile;
|
||||
Arc : RecArchive;
|
||||
|
||||
// SORT THIS LIST BY NON CASE SENSITIVE ARCHIVE EXTENSION
|
||||
Procedure MakeList;
|
||||
Var
|
||||
OS : String;
|
||||
Begin
|
||||
List.Clear;
|
||||
|
||||
F.Reset;
|
||||
While Not F.Eof Do Begin
|
||||
F.Read (Arc);
|
||||
|
||||
Case Arc.OSType of
|
||||
0 : OS := 'Windows';
|
||||
1 : OS := 'Linux ';
|
||||
2 : OS := 'OSX';
|
||||
End;
|
||||
|
||||
List.Add (strPadR(YesNoStr[Arc.Active], 5, ' ') + strPadR(Arc.Ext, 7, ' ') + OS + ' ' + Arc.Desc, 0);
|
||||
End;
|
||||
|
||||
List.Add ('', 2);
|
||||
End;
|
||||
|
||||
Begin
|
||||
F := TBufFile.Create(SizeOf(RecArchive));
|
||||
|
||||
F.Open (Config.DataPath + 'archive.dat', fmOpenCreate, fmReadWrite + fmDenyNone, SizeOf(RecArchive));
|
||||
|
||||
Box := TAnsiMenuBox.Create;
|
||||
List := TAnsiMenuList.Create;
|
||||
|
||||
Box.Header := ' Archive Editor ';
|
||||
List.NoWindow := True;
|
||||
List.LoChars := #01#04#13#27;
|
||||
|
||||
Box.Open (13, 5, 67, 20);
|
||||
|
||||
WriteXY (15, 6, 112, 'Use Ext OSID Description');
|
||||
WriteXY (15, 7, 112, strRep('Ä', 51));
|
||||
WriteXY (15, 18, 112, strRep('Ä', 51));
|
||||
WriteXY (18, 19, 112, '(CTRL/A) Add (CTRL/D) Delete (ENTER) Edit');
|
||||
|
||||
Repeat
|
||||
MakeList;
|
||||
|
||||
List.Open (13, 7, 67, 18);
|
||||
List.Close;
|
||||
|
||||
Case List.ExitCode of
|
||||
#04 : If List.Picked < List.ListMax Then
|
||||
If ShowMsgBox(1, 'Delete this entry?') Then Begin
|
||||
F.RecordDelete (List.Picked);
|
||||
MakeList;
|
||||
End;
|
||||
#01 : Begin
|
||||
F.RecordInsert (List.Picked);
|
||||
|
||||
Arc.OSType := OSType;
|
||||
Arc.Active := False;
|
||||
Arc.Desc := 'New archive';
|
||||
Arc.Ext := 'NEW';
|
||||
Arc.Pack := '';
|
||||
Arc.Unpack := '';
|
||||
Arc.View := '';
|
||||
|
||||
F.Write (Arc);
|
||||
|
||||
MakeList;
|
||||
End;
|
||||
#13 : If List.Picked <> List.ListMax Then Begin
|
||||
F.Seek (List.Picked - 1);
|
||||
F.Read (Arc);
|
||||
|
||||
EditArchive(Arc);
|
||||
|
||||
F.Seek (List.Picked - 1);
|
||||
F.Write (Arc);
|
||||
End;
|
||||
#27 : Break;
|
||||
End;
|
||||
Until False;
|
||||
|
||||
F.Close;
|
||||
F.Free;
|
||||
|
||||
Box.Close;
|
||||
List.Free;
|
||||
Box.Free;
|
||||
End;
|
||||
|
||||
End.
|
||||
125
mystic/bbs_cfg_events.pas
Normal file
125
mystic/bbs_cfg_events.pas
Normal file
|
|
@ -0,0 +1,125 @@
|
|||
Unit bbs_cfg_Events;
|
||||
|
||||
{$I M_OPS.PAS}
|
||||
|
||||
Interface
|
||||
|
||||
Procedure Event_Editor;
|
||||
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
m_Strings,
|
||||
m_DateTime,
|
||||
bbs_Core,
|
||||
bbs_Common,
|
||||
bbs_User;
|
||||
|
||||
Procedure Event_Editor;
|
||||
Var
|
||||
A, B : Integer;
|
||||
Begin
|
||||
Session.SystemLog ('*EVENT EDITOR*');
|
||||
|
||||
Assign (Session.EventFile, Config.DataPath + 'events.dat');
|
||||
Reset (Session.EventFile);
|
||||
Repeat
|
||||
Session.io.OutFullLn ('|CL|14Event Editor|CR|CR|09### Name|CR--- ------------------------------ -----|14');
|
||||
Reset (Session.EventFile);
|
||||
While Not Eof(Session.EventFile) do begin
|
||||
read (Session.EventFile, session.event);
|
||||
if session.event.active then Session.io.BufAddChar('+') else Session.io.BufAddChar('-');
|
||||
Session.io.OutFullLn ('|15' + strPadR(strI2S(filepos(Session.EventFile)), 4, ' ') + '|14' + strPadR(session.event.name, 32, ' ') +
|
||||
strZero(session.event.exectime div 60) + ':' + strZero(session.event.exectime mod 60));
|
||||
end;
|
||||
Session.io.OutFull ('|CR|09(I)nsert, (D)elete, (E)dit, (Q)uit? ');
|
||||
case Session.io.OneKey ('DIEQ', True) of
|
||||
'D' : begin
|
||||
Session.io.OutRaw ('Delete which? ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
KillRecord (Session.EventFile, A, SizeOf(EventRec));
|
||||
end;
|
||||
'I' : begin
|
||||
Session.io.OutRaw ('Insert before? (1-' + strI2S(filesize(Session.EventFile)+1) + '): ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
if (a > 0) and (a <= filesize(Session.EventFile)+1) then begin
|
||||
AddRecord (Session.EventFile, A, SizeOf(EventRec));
|
||||
session.event.active := false;
|
||||
Session.Event.Name := 'New Event';
|
||||
Session.Event.errlevel := 0;
|
||||
Session.Event.exectime := 0;
|
||||
Session.Event.warning := 0;
|
||||
Session.Event.lastran := 0;
|
||||
Session.Event.offhook := false;
|
||||
Session.Event.node := 0;
|
||||
write (Session.EventFile, Session.event);
|
||||
end;
|
||||
end;
|
||||
'E' : begin
|
||||
Session.io.OutRaw ('Edit which? ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
if (a > 0) and (a <= filesize(Session.EventFile)) then begin
|
||||
seek (Session.EventFile, a-1);
|
||||
read (Session.EventFile, Session.event);
|
||||
repeat
|
||||
Session.io.OutFullLn ('|CL|14Event ' + strI2S(FilePos(Session.EventFile)) + ' of ' + strI2S(FileSize(Session.EventFile)) + '|CR|03');
|
||||
Session.io.OutRawln ('!. Active : ' + Session.io.OutYN(Session.Event.active));
|
||||
Session.io.OutRawln ('A. Description : ' + Session.Event.Name);
|
||||
Session.io.OutRawln ('B. Forced : ' + Session.io.OutYN(Session.Event.forced));
|
||||
Session.io.OutRawln ('C. Errorlevel : ' + strI2S(Session.Event.ErrLevel));
|
||||
Session.io.OutRaw ('D. Execution Time : ');
|
||||
a := Session.Event.exectime div 60;
|
||||
b := Session.Event.exectime mod 60;
|
||||
Session.io.OutRawln (strZero(a) + ':' + strZero(b));
|
||||
Session.io.OutRawln ('E. Busy Warning : ' + strI2S(Session.Event.Warning));
|
||||
Session.io.OutRawln ('F. Last Ran on : ' + DateDos2Str(Session.Event.LastRan, Session.User.ThisUser.DateType));
|
||||
Session.io.OutRawln ('G. Offhook Modem : ' + Session.io.OutYN(Session.Event.Offhook));
|
||||
Session.io.OutRaw ('H. Node Number : ');
|
||||
If Session.Event.Node = 0 Then
|
||||
Session.io.OutRawLn ('All')
|
||||
Else
|
||||
Session.io.OutRawLn (strI2S(Session.Event.Node));
|
||||
Session.io.OutFull ('|CR|09Command (Q/Quit): ');
|
||||
case Session.io.OneKey('[]!ABCDEFGHQ', True) of
|
||||
'[' : If FilePos(Session.EventFile) > 1 Then Begin
|
||||
Seek (Session.EventFile, FilePos(Session.EventFile)-1);
|
||||
Write (Session.EventFile, Session.Event);
|
||||
Seek (Session.EventFile, FilePos(Session.EventFile)-2);
|
||||
Read (Session.EventFile, Session.Event);
|
||||
End;
|
||||
']' : If FilePos(Session.EventFile) < FileSize(Session.EventFile) Then Begin
|
||||
Seek (Session.EventFile, FilePos(Session.EventFile)-1);
|
||||
Write (Session.EventFile, Session.Event);
|
||||
Read (Session.EventFile, Session.Event);
|
||||
End;
|
||||
'!' : Session.Event.active := not Session.Event.active;
|
||||
'A' : Session.Event.name := Session.io.InXY(21, 4, 30, 30, 11, Session.Event.name);
|
||||
'B' : Session.Event.forced := not Session.Event.forced;
|
||||
'C' : Session.Event.errlevel := strS2I(Session.io.InXY(21, 6, 3, 3, 12, strI2S(Session.Event.errlevel)));
|
||||
'D' : Begin
|
||||
a := strS2I(Session.io.InXY(21, 7, 2, 2, 12, ''));
|
||||
b := strS2I(Session.io.InXY(24, 7, 2, 2, 12, ''));
|
||||
if (a > -1) and (a < 24) and (b >= 0) and (b < 60) then
|
||||
Session.Event.exectime := (a * 60) + b;
|
||||
end;
|
||||
'E' : Session.Event.Warning := strS2I(Session.io.InXY(21, 8, 2, 2, 12, strI2S(Session.Event.Warning)));
|
||||
'F' : Session.Event.LastRan := DateStr2Dos(Session.io.InXY(21, 9, 8, 8, 15, DateDos2Str(Session.Event.lastran, Session.User.ThisUser.DateType)));
|
||||
'G' : Session.Event.Offhook := Not Session.Event.Offhook;
|
||||
'H' : Session.Event.Node := strS2I(Session.io.InXY(21, 11, 3, 3, 12, strI2S(Session.Event.Node)));
|
||||
'Q' : Break;
|
||||
end
|
||||
until false;
|
||||
seek (Session.EventFile, filepos(Session.EventFile)-1);
|
||||
write (Session.EventFile, Session.Event);
|
||||
end;
|
||||
end;
|
||||
'Q' : break;
|
||||
end;
|
||||
until False;
|
||||
|
||||
Close (Session.EventFile);
|
||||
|
||||
Session.FindNextEvent;
|
||||
End;
|
||||
|
||||
End.
|
||||
167
mystic/bbs_cfg_filebase.pas
Normal file
167
mystic/bbs_cfg_filebase.pas
Normal file
|
|
@ -0,0 +1,167 @@
|
|||
Unit bbs_cfg_FileBase;
|
||||
|
||||
{$I M_OPS.PAS}
|
||||
|
||||
Interface
|
||||
|
||||
Procedure File_Base_Editor;
|
||||
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
m_FileIO,
|
||||
m_Strings,
|
||||
bbs_Common,
|
||||
bbs_Core,
|
||||
bbs_User;
|
||||
|
||||
Procedure File_Base_Editor;
|
||||
Const
|
||||
ST : Array[0..2] of String[6] = ('No', 'Yes', 'Always');
|
||||
Var
|
||||
A,
|
||||
B : LongInt;
|
||||
Begin
|
||||
Session.SystemLog ('*FBASE EDITOR*');
|
||||
Reset(Session.FileBase.FBaseFile);
|
||||
|
||||
Repeat
|
||||
Session.io.AllowPause := True;
|
||||
|
||||
Session.io.OutFullLn ('|CL|14File Base Editor|CR|CR|09### Name|CR--- |$D40-');
|
||||
|
||||
Reset (Session.FileBase.FBaseFile);
|
||||
While Not Eof(Session.FileBase.FBaseFile) Do Begin
|
||||
Read (Session.FileBase.FBaseFile, Session.FileBase.FBase);
|
||||
Session.io.OutFullLn ('|15' + strPadR(strI2S(FilePos(Session.FileBase.FBaseFile)), 3, ' ') + ' |14|FB');
|
||||
|
||||
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 ('|CR|09(I)nsert, (D)elete, (E)dit, (M)ove, (Q)uit? ');
|
||||
Case Session.io.OneKey (#13'DEIMQ', True) of
|
||||
'D' : begin
|
||||
Session.io.OutRaw ('Delete which base? ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
If (A > 0) and (A <= FileSize(Session.FileBase.FBaseFile)) Then Begin
|
||||
Seek (Session.FileBase.FBaseFile, A - 1);
|
||||
Read (Session.FileBase.FBaseFile, Session.FileBase.FBase);
|
||||
FileErase (config.datapath + Session.FileBase.FBase.filename + '.dir');
|
||||
FileErase (config.datapath + Session.FileBase.FBase.filename + '.des');
|
||||
FileErase (config.datapath + Session.FileBase.FBase.filename + '.scn');
|
||||
KillRecord (Session.FileBase.FBaseFile, A, SizeOf(FBaseRec));
|
||||
End;
|
||||
End;
|
||||
'I' : begin
|
||||
Session.io.OutRaw ('Insert before which? (1-' + strI2S(filesize(Session.FileBase.FBaseFile)+1) + '): ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
if (a > 0) and (a <= filesize(Session.FileBase.FBaseFile)+1) then begin
|
||||
AddRecord (Session.FileBase.FBaseFile, A, SizeOf(Session.FileBase.FBaseFile));
|
||||
|
||||
Session.FileBase.FBase.Name := 'New File Base';
|
||||
Session.FileBase.FBase.FtpName := 'New_File_Base';
|
||||
Session.FileBase.FBase.Filename := 'NEW';
|
||||
Session.FileBase.FBase.Dispfile := '';
|
||||
Session.FileBase.FBase.ListACS := 's255';
|
||||
Session.FileBase.FBase.FtpACS := 's255';
|
||||
Session.FileBase.FBase.SysopACS := 's255';
|
||||
Session.FileBase.FBase.UlACS := 's255';
|
||||
Session.FileBase.FBase.DlACS := 's255';
|
||||
Session.FileBase.FBase.Path := '';
|
||||
Session.FileBase.FBase.Password := '';
|
||||
Session.FileBase.FBase.ShowUL := True;
|
||||
Session.FileBase.FBase.IsCDROM := False;
|
||||
Session.FileBase.FBase.DefScan := 1;
|
||||
|
||||
Write (Session.FileBase.FBaseFile, Session.FileBase.FBase);
|
||||
end;
|
||||
end;
|
||||
'E' : begin
|
||||
Session.io.OutRaw ('Edit which? ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
if (a > 0) and (a <= filesize(Session.FileBase.FBaseFile)) then begin
|
||||
seek (Session.FileBase.FBaseFile, a-1);
|
||||
read (Session.FileBase.FBaseFile, Session.FileBase.fbase);
|
||||
repeat
|
||||
Session.io.OutFullLn ('|CL|14File Base ' + strI2S(FilePos(Session.FileBase.FBaseFile)) + ' of ' + strI2S(FileSize(Session.FileBase.FBaseFile)) + '|CR|03');
|
||||
Session.io.OutRawln ('A. Name : ' + Session.FileBase.FBase.name);
|
||||
Session.io.OutRawln ('B. Filename : ' + Session.FileBase.FBase.filename);
|
||||
Session.io.OutRawln ('C. Display File : ' + Session.FileBase.FBase.dispfile);
|
||||
Session.io.OutRawln ('D. List ACS : ' + Session.FileBase.FBase.Listacs);
|
||||
Session.io.OutRawln ('E. Sysop ACS : ' + Session.FileBase.FBase.SysopACS);
|
||||
Session.io.OutRawln ('F. Upload ACS : ' + Session.FileBase.FBase.ulacs);
|
||||
Session.io.OutRawln ('G. Download ACS : ' + Session.FileBase.FBase.dlacs);
|
||||
Session.io.OutRawln ('H. Storage Path : ' + Session.FileBase.FBase.path);
|
||||
Session.io.OutRawln ('I. Password : ' + Session.FileBase.FBase.password);
|
||||
Session.io.OutRawln ('J. Show Uploader : ' + Session.io.OutYN(Session.FileBase.FBase.ShowUL));
|
||||
Session.io.OutRawLn ('K. Default New Scan : ' + ST[Session.FileBase.FBase.DefScan]);
|
||||
Session.io.OutRawLn ('L. CD-ROM Area : ' + Session.io.OutYN(Session.FileBase.FBase.IsCDROM));
|
||||
Session.io.OutRawLn ('M. All Files Free : ' + Session.io.OutYN(Session.FileBase.FBase.IsFREE));
|
||||
Session.io.OutRawLn ('N. FTP Base Name : ' + Session.FileBase.FBase.FTPName);
|
||||
Session.io.OutRawLn ('O. FTP List ACS : ' + Session.FileBase.FBase.FTPACS);
|
||||
Session.io.OutFull ('|CR|09([) Prev, (]) Next, (Q)uit: ');
|
||||
case Session.io.OneKey('[]ABCDEFGHIJKLMNOQ', True) of
|
||||
'[' : If FilePos(Session.FileBase.FBaseFile) > 1 Then Begin
|
||||
Seek (Session.FileBase.FBaseFile, FilePos(Session.FileBase.FBaseFile)-1);
|
||||
Write (Session.FileBase.FBaseFile, Session.FileBase.FBase);
|
||||
Seek (Session.FileBase.FBaseFile, FilePos(Session.FileBase.FBaseFile)-2);
|
||||
Read (Session.FileBase.FBaseFile, Session.FileBase.FBase);
|
||||
End;
|
||||
']' : If FilePos(Session.FileBase.FBaseFile) < FileSize(Session.FileBase.FBaseFile) Then Begin
|
||||
Seek (Session.FileBase.FBaseFile, FilePos(Session.FileBase.FBaseFile)-1);
|
||||
Write (Session.FileBase.FBaseFile, Session.FileBase.FBase);
|
||||
Read (Session.FileBase.FBaseFile, Session.FileBase.FBase);
|
||||
End;
|
||||
'A' : Session.FileBase.FBase.Name := Session.io.InXY(23, 3, 40, 40, 11, Session.FileBase.FBase.Name);
|
||||
'B' : Session.FileBase.FBase.FileName := Session.io.InXY(23, 4, 40, 40, 11, Session.FileBase.FBase.FileName);
|
||||
'C' : Session.FileBase.FBase.DispFile := Session.io.InXY(23, 5, 8, 8, 11, Session.FileBase.FBase.DispFile);
|
||||
'D' : Session.FileBase.FBase.ListACS := Session.io.InXY(23, 6, 20, 20, 11, Session.FileBase.FBase.ListACS);
|
||||
'E' : Session.FileBase.FBase.SysopACS := Session.io.InXY(23, 7, 20, 20, 11, Session.FileBase.FBase.SysopACS);
|
||||
'F' : Session.FileBase.FBase.ULacs := Session.io.InXY(23, 8, 20, 20, 11, Session.FileBase.FBase.ULacs);
|
||||
'G' : Session.FileBase.FBase.DLacs := Session.io.InXY(23, 9, 20, 20, 11, Session.FileBase.FBase.DLacs);
|
||||
'H' : Session.FileBase.FBase.Path := CheckPath(Session.io.InXY(23, 10, 39, 39, 11, Session.FileBase.FBase.Path));
|
||||
'I' : Session.FileBase.FBase.Password := Session.io.InXY(23, 11, 15, 15, 12, Session.FileBase.FBase.Password);
|
||||
'J' : Session.FileBase.FBase.ShowUL := Not Session.FileBase.FBase.ShowUL;
|
||||
'K' : If Session.FileBase.FBase.DefScan > 1 Then Session.FileBase.FBase.DefScan := 0 Else Inc(Session.FileBase.FBase.DefScan);
|
||||
'L' : Session.FileBase.FBase.IsCDROM := Not Session.FileBase.FBase.IsCDROM;
|
||||
'M' : Session.FileBase.FBase.IsFREE := Not Session.FileBase.FBase.IsFREE;
|
||||
'N' : Session.FileBase.FBase.FtpName := Session.io.InXY(23, 16, 40, 60, 11, Session.FileBase.FBase.FtpName);
|
||||
'O' : Session.FileBase.FBase.FtpACS := Session.io.InXY(23, 17, 30, 30, 11, Session.FileBase.FBase.FtpACS);
|
||||
'Q' : Break;
|
||||
End;
|
||||
Until False;
|
||||
Seek (Session.FileBase.FBaseFile, FilePos(Session.FileBase.FBaseFile) - 1);
|
||||
Write (Session.FileBase.FBaseFile, Session.FileBase.FBase);
|
||||
End;
|
||||
End;
|
||||
|
||||
'M' : Begin
|
||||
Session.io.OutRaw ('Move which? ');
|
||||
A := strS2I(Session.io.GetInput(3, 3, 12, ''));
|
||||
|
||||
Session.io.OutRaw ('Move before? (1-' + strI2S(FileSize(Session.FileBase.FBaseFile) + 1) + '): ');
|
||||
B := strS2I(Session.io.GetInput(3, 3, 12, ''));
|
||||
|
||||
If (A > 0) and (A <= FileSize(Session.FileBase.FBaseFile)) and (B > 0) and (B <= FileSize(Session.FileBase.FBaseFile) + 1) Then Begin
|
||||
Seek (Session.FileBase.FBaseFile, A - 1);
|
||||
Read (Session.FileBase.FBaseFile, Session.FileBase.FBase);
|
||||
|
||||
AddRecord (Session.FileBase.FBaseFile, B, SizeOf(FBaseRec));
|
||||
Write (Session.FileBase.FBaseFile, Session.FileBase.FBase);
|
||||
|
||||
If A > B Then Inc(A);
|
||||
|
||||
KillRecord (Session.FileBase.FBaseFile, A, SizeOf(FBaseRec));
|
||||
End;
|
||||
End;
|
||||
'Q' : Break;
|
||||
End;
|
||||
Until False;
|
||||
Close (Session.FileBase.FBaseFile);
|
||||
End;
|
||||
|
||||
End.
|
||||
149
mystic/bbs_cfg_groups.pas
Normal file
149
mystic/bbs_cfg_groups.pas
Normal file
|
|
@ -0,0 +1,149 @@
|
|||
Unit bbs_cfg_Groups;
|
||||
|
||||
{$I M_OPS.PAS}
|
||||
|
||||
Interface
|
||||
|
||||
Procedure Group_Editor;
|
||||
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
m_Strings,
|
||||
bbs_Common,
|
||||
bbs_Core;
|
||||
|
||||
Procedure File_Group;
|
||||
var
|
||||
a : SmallInt;
|
||||
fgroup : recgroup;
|
||||
Begin
|
||||
Reset (Session.FileBase.FGroupFile);
|
||||
Repeat
|
||||
Session.io.OutFullLn ('|CL|14File Group Editor|CR|CR|09### Name|CR--- ------------------------------');
|
||||
Reset (Session.FileBase.FGroupFile);
|
||||
while not eof(Session.FileBase.FGroupFile) do begin
|
||||
read (Session.FileBase.FGroupFile, FGroup);
|
||||
Session.io.OutFullLn ('|15' + strPadR(strI2S(filepos(Session.FileBase.FGroupFile)), 5, ' ') + '|14' + FGroup.Name);
|
||||
end;
|
||||
Session.io.OutFull ('|CR|09(I)nsert, (D)elete, (E)dit, (Q)uit? ');
|
||||
case Session.io.OneKey ('DIEQ', True) of
|
||||
'D' : begin
|
||||
Session.io.OutRaw ('Delete which? ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
KillRecord (Session.FileBase.FGroupFile, A, SizeOf(RecGroup));
|
||||
end;
|
||||
'I' : begin
|
||||
Session.io.OutRaw ('Insert before which? (1-' + strI2S(filesize(Session.FileBase.FGroupFile)+1) + '): ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
if (a > 0) and (a <= filesize(Session.FileBase.FGroupFile)+1) then begin
|
||||
AddRecord (Session.FileBase.FGroupFile, A, SizeOf(RecGroup));
|
||||
FGroup.Name := '';
|
||||
FGroup.ACS := 's255';
|
||||
write (Session.FileBase.FGroupFile, FGroup);
|
||||
end;
|
||||
end;
|
||||
'E' : begin
|
||||
Session.io.OutRaw ('Edit which? ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
if (a > 0) and (a <= filesize(Session.FileBase.FGroupFile)) then begin
|
||||
seek (Session.FileBase.FGroupFile, a-1);
|
||||
read (Session.FileBase.FGroupFile, FGroup);
|
||||
repeat
|
||||
Session.io.OutFullLn ('|CL|14File Group '+strI2S(FilePos(Session.FileBase.FGroupFile)) + ' of ' + strI2S(FileSize(Session.FileBase.FGroupFile))+'|CR|03');
|
||||
Session.io.OutRawln ('A. Name : ' + FGroup.Name);
|
||||
Session.io.OutRawln ('B. ACS : ' + FGroup.acs);
|
||||
Session.io.OutRawLn ('C. Hidden : ' + Session.io.OutYN(FGroup.Hidden));
|
||||
Session.io.OutFull ('|CR|09Command (Q/Quit): ');
|
||||
case Session.io.OneKey('ABCQ', True) of
|
||||
'A' : FGroup.name := Session.io.InXY(13, 3, 30, 30, 11, Fgroup.name);
|
||||
'B' : FGroup.acs := Session.io.InXY(13, 4, 20, 20, 11, Fgroup.acs);
|
||||
'C' : FGroup.Hidden := Not FGroup.Hidden;
|
||||
'Q' : break;
|
||||
end;
|
||||
until false;
|
||||
seek (Session.FileBase.FGroupFile, filepos(Session.FileBase.FGroupFile)-1);
|
||||
write (Session.FileBase.FGroupFile, FGroup);
|
||||
end;
|
||||
end;
|
||||
'Q' : break;
|
||||
end;
|
||||
|
||||
until False;
|
||||
close (Session.FileBase.FGroupFile);
|
||||
|
||||
End;
|
||||
|
||||
Procedure Message_Group;
|
||||
var
|
||||
a : SmallInt;
|
||||
group:Recgroup;
|
||||
Begin
|
||||
Reset (Session.Msgs.GroupFile);
|
||||
Repeat
|
||||
Session.io.OutFullLn ('|CL|14Message Group Editor|CR|CR|09### Name|CR--- ------------------------------');
|
||||
Reset (Session.Msgs.GroupFile);
|
||||
while not Eof(Session.Msgs.GroupFile) do begin
|
||||
read (Session.Msgs.GroupFile, Group);
|
||||
Session.io.OutFullLn ('|15' + strPadR(strI2S(filepos(Session.Msgs.GroupFile)), 5, ' ') + '|14' + Group.Name);
|
||||
end;
|
||||
Session.io.OutFull ('|CR|09(I)nsert, (D)elete, (E)dit, (Q)uit? ');
|
||||
case Session.io.OneKey ('DIEQ', True) of
|
||||
'D' : begin
|
||||
Session.io.OutRaw ('Delete which? ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
KillRecord (Session.Msgs.GroupFile, A, SizeOf(RecGroup));
|
||||
end;
|
||||
'I' : begin
|
||||
Session.io.OutRaw ('Insert before? (1-' + strI2S(filesize(Session.Msgs.GroupFile)+1) + '): ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
if (a > 0) and (a <= filesize(Session.Msgs.GroupFile)+1) then begin
|
||||
AddRecord (Session.Msgs.GroupFile, A, SizeOf(RecGroup));
|
||||
Group.Name := '';
|
||||
Group.ACS := 's255';
|
||||
write (Session.Msgs.GroupFile, Group);
|
||||
end;
|
||||
end;
|
||||
'E' : begin
|
||||
Session.io.OutRaw ('Edit which? ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
if (a > 0) and (a <= filesize(Session.Msgs.GroupFile)) then begin
|
||||
seek (Session.Msgs.GroupFile, a-1);
|
||||
read (Session.Msgs.GroupFile, Group);
|
||||
repeat
|
||||
Session.io.OutFullLn ('|CL|14Group ' + strI2S(FilePos(Session.Msgs.GroupFile)) + ' of ' + strI2S(FileSize(Session.Msgs.GroupFile)) + '|CR|03');
|
||||
Session.io.OutRawln ('A. Name : ' + Group.Name);
|
||||
Session.io.OutRawln ('B. ACS : ' + Group.acs);
|
||||
Session.io.OutRawLn ('C. Hidden : ' + Session.io.OutYN(Group.Hidden));
|
||||
|
||||
Session.io.OutFull ('|CR|09Command (Q/Quit): ');
|
||||
case Session.io.OneKey('ABCQ', True) of
|
||||
'A' : Group.name := Session.io.InXY(13, 3, 30, 30, 11, group.name);
|
||||
'B' : Group.acs := Session.io.InXY(13, 4, 20, 20, 11, group.acs);
|
||||
'C' : Group.Hidden := Not Group.Hidden;
|
||||
'Q' : break;
|
||||
end;
|
||||
until false;
|
||||
seek (Session.Msgs.GroupFile, filepos(Session.Msgs.GroupFile)-1);
|
||||
write (Session.Msgs.GroupFile, Group);
|
||||
end;
|
||||
end;
|
||||
'Q' : break;
|
||||
end;
|
||||
|
||||
until False;
|
||||
close (Session.Msgs.GroupFile);
|
||||
End;
|
||||
|
||||
Procedure Group_Editor;
|
||||
Begin
|
||||
Session.SystemLog ('*GROUP EDITOR*');
|
||||
|
||||
Session.io.OutFull ('|CL|09Edit Groups: (M)essage, (F)ile, (Q)uit? ');
|
||||
Case Session.io.OneKey('QMF', True) of
|
||||
'M' : Message_Group;
|
||||
'F' : File_Group;
|
||||
End;
|
||||
End;
|
||||
|
||||
End.
|
||||
130
mystic/bbs_cfg_language.pas
Normal file
130
mystic/bbs_cfg_language.pas
Normal file
|
|
@ -0,0 +1,130 @@
|
|||
Unit bbs_cfg_Language;
|
||||
|
||||
{$I M_OPS.PAS}
|
||||
|
||||
Interface
|
||||
|
||||
Procedure Lang_Editor;
|
||||
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
m_Strings,
|
||||
bbs_Common,
|
||||
bbs_Core;
|
||||
|
||||
Procedure Lang_Editor;
|
||||
var
|
||||
a : SmallInt;
|
||||
Old : LangRec;
|
||||
Begin
|
||||
Session.SystemLog ('*LANG EDITOR*');
|
||||
Old := Session.Lang;
|
||||
{ Reset (LangFile);}
|
||||
Repeat
|
||||
Session.io.OutFullLn ('|CL|14Language Editor|CR|CR|15## FileName Description|CR|09-- -------- ------------------------------');
|
||||
Reset (Session.LangFile);
|
||||
while not eof(Session.LangFile) do begin
|
||||
read (Session.LangFile, Session.Lang);
|
||||
Session.io.OutFullLn ('|15' + strPadR(strI2S(filepos(Session.LangFile)), 4, ' ') +
|
||||
'|14' + strPadR(Session.Lang.FileName, 10, ' ') + '|10' + Session.Lang.Desc);
|
||||
end;
|
||||
Session.Lang := Old;
|
||||
Session.io.OutFull ('|CR|09(I)nsert, (D)elete, (E)dit, (Q)uit? ');
|
||||
case Session.io.OneKey ('DIEQ', True) of
|
||||
'D' : begin
|
||||
Session.io.OutRaw ('Delete which? ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
if filesize(Session.LangFile) = 1 then
|
||||
Session.io.OutFullLn ('|CR|14You must have at least one language definition.|CR|PA')
|
||||
Else
|
||||
KillRecord (Session.LangFile, A, SizeOf(LangRec));
|
||||
end;
|
||||
'I' : begin
|
||||
Session.io.OutRaw ('Insert before? (1-' + strI2S(filesize(Session.LangFile)+1) + '): ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
if (a > 0) and (a <= filesize(Session.LangFile)+1) then begin
|
||||
AddRecord (Session.LangFile, A, SizeOf(LangRec));
|
||||
Session.lang.filename := '';
|
||||
Session.lang.textpath := '';
|
||||
Session.lang.menupath := '';
|
||||
write (Session.LangFile, Session.Lang);
|
||||
end;
|
||||
end;
|
||||
'E' : begin
|
||||
Session.io.OutRaw ('Edit which? ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
if (a > 0) and (a <= filesize(Session.LangFile)) then begin
|
||||
seek (Session.LangFile, a-1);
|
||||
read (Session.LangFile, Session.Lang);
|
||||
repeat
|
||||
Session.io.OutFullLn ('|CL|14Language ' + strI2S(FilePos(Session.LangFile)) + ' of ' + strI2S(FileSize(Session.LangFile)) + '|CR|03');
|
||||
Session.io.OutRawln ('A. Description: ' + Session.Lang.Desc);
|
||||
Session.io.OutRawln ('B. Filename : ' + Session.Lang.FileName);
|
||||
Session.io.OutRawln ('C. Text Path : ' + Session.Lang.TextPath);
|
||||
Session.io.OutRawln ('D. Menu Path : ' + Session.Lang.MenuPath);
|
||||
Session.io.OutRawln ('M. Allow ASCII: ' + Session.io.OutYN(Session.Lang.okASCII));
|
||||
Session.io.OutRawln ('N. Allow ANSI : ' + Session.io.OutYN(Session.Lang.okANSI));
|
||||
|
||||
Session.io.OutFullLn ('|CRE. Use Lightbar Y/N : ' + Session.io.OutYN(Session.Lang.BarYN));
|
||||
Session.io.OutFull ('|03|16H. Input Field Color: ');
|
||||
Session.io.AnsiColor(Session.Lang.FieldCol1);
|
||||
Session.io.OutFullLn ('Test|03|16');
|
||||
|
||||
Session.io.OutRaw ('I. Quote Bar Color : ');
|
||||
Session.io.AnsiColor(Session.Lang.QuoteColor);
|
||||
Session.io.OutFullLn ('Test|03|16');
|
||||
|
||||
Session.io.OutRawLn ('J. Echo Character : ' + Session.Lang.EchoCh);
|
||||
Session.io.OutRawLn ('K. Input Character : ' + Session.Lang.FieldChar);
|
||||
Session.io.OutRawLn ('L. File Tag Char : ' + Session.Lang.TagCh);
|
||||
|
||||
Session.io.OutRaw ('O. File Search Hi : ');
|
||||
Session.io.AnsiColor(Session.Lang.FileHI);
|
||||
Session.io.OutFullLn ('Test|03|16');
|
||||
|
||||
Session.io.OutRaw ('P. File Desc. Lo : ');
|
||||
Session.io.AnsiColor(Session.Lang.FileLO);
|
||||
Session.io.OutFullLn ('Test|03|16');
|
||||
|
||||
Session.io.OutRawLn ('R. LB New Msg Char : ' + Session.Lang.NewMsgChar);
|
||||
|
||||
Session.io.OutFull ('|CR|09Command (Q/Quit): ');
|
||||
case Session.io.onekey('ABCDEFGHIJKLMNOPQR', True) of
|
||||
'A' : Session.Lang.Desc := Session.io.InXY(17, 3, 30, 30, 11, Session.Lang.Desc);
|
||||
'B' : Session.Lang.filename := Session.io.InXY(17, 4, 8, 8, 11, Session.Lang.filename);
|
||||
'C' : Session.Lang.textpath := CheckPath(Session.io.InXY(17, 5, 40, 40, 11, Session.Lang.textpath));
|
||||
'D' : Session.Lang.menupath := CheckPath(Session.io.InXY(17, 6, 40, 40, 11, Session.Lang.MenuPath));
|
||||
'E' : Session.Lang.BarYN := Not Session.Lang.BarYN;
|
||||
'H' : Session.Lang.FieldCol1 := getColor(Session.Lang.FieldCol1);
|
||||
'I' : Session.Lang.QuoteColor := getColor(Session.Lang.QuoteColor);
|
||||
'J' : Begin Session.io.OutRaw ('Char: '); Session.Lang.EchoCh := Session.io.GetKey; End;
|
||||
'K' : Begin
|
||||
Session.io.OutRaw ('Char: ');
|
||||
Session.Lang.FieldChar := Session.io.GetKey;
|
||||
If Not (Session.Lang.FieldChar in [#32..#255]) Then
|
||||
Session.Lang.FieldChar := ' ';
|
||||
End;
|
||||
'L' : Begin Session.io.OutRaw ('Char: '); Session.Lang.TagCh := Session.io.GetKey; End;
|
||||
'M' : Session.Lang.okASCII := Not Session.Lang.okASCII;
|
||||
'N' : Session.Lang.okANSI := Not Session.Lang.okANSI;
|
||||
'O' : Session.Lang.FileHI := getColor(Session.Lang.FileHI);
|
||||
'P' : Session.Lang.FileLo := GetColor(Session.Lang.FileLO);
|
||||
'Q' : break;
|
||||
'R' : Begin Session.io.OutRaw('Char: '); Session.Lang.NewMsgChar := Session.io.GetKey; End;
|
||||
end;
|
||||
until false;
|
||||
seek (Session.LangFile, filepos(Session.LangFile)-1);
|
||||
write (Session.LangFile, Session.Lang);
|
||||
end;
|
||||
end;
|
||||
'Q' : break;
|
||||
end;
|
||||
|
||||
until False;
|
||||
close (Session.LangFile);
|
||||
|
||||
If Not Session.LoadThemeData(Old.FileName) Then Session.Lang := Old;
|
||||
End;
|
||||
|
||||
End.
|
||||
302
mystic/bbs_cfg_menuedit.pas
Normal file
302
mystic/bbs_cfg_menuedit.pas
Normal file
|
|
@ -0,0 +1,302 @@
|
|||
Unit bbs_cfg_menuedit;
|
||||
|
||||
{$I M_OPS.PAS}
|
||||
|
||||
Interface
|
||||
|
||||
Uses
|
||||
DOS,
|
||||
m_Strings,
|
||||
m_FileIO,
|
||||
bbs_Common,
|
||||
bbs_Core,
|
||||
bbs_User,
|
||||
bbs_Menus;
|
||||
|
||||
Procedure Menu_Editor;
|
||||
|
||||
Implementation
|
||||
|
||||
Var
|
||||
MenuFile : Text;
|
||||
|
||||
Procedure Menu_Editor;
|
||||
|
||||
Procedure ModifyMenu;
|
||||
var a,b{,c} : byte;
|
||||
{ tempcmd : menucmdrec;}
|
||||
Begin
|
||||
Session.io.OutRaw ('Menu to Edit: ');
|
||||
Session.Menu.MenuName := Session.io.GetInput(mysMaxMenuNameLen, mysMaxMenuNameLen, 11, '');
|
||||
|
||||
If Session.Menu.LoadMenu(False, False, False) <> 1 Then Exit;
|
||||
|
||||
Repeat
|
||||
Session.io.OutFullLn ('|CL|14Menu Command List|CR|03');
|
||||
Session.io.OutFullLn ('|15## Hot-Key Cmd Text ## Hot-Key Cmd Text');
|
||||
Session.io.OutFullLn ('|09-- -------- --- --------------------- -- -------- --- ---------------------|03');
|
||||
|
||||
For A := 1 to Session.Menu.CmdNum Do Begin
|
||||
Session.io.OutRaw (strPadR(strI2S(A), 3, ' ') + strPadR(Session.Menu.MenuList[A].HotKey, 9, ' ') +
|
||||
strPadR(Session.Menu.MenuList[A].Command, 4, ' ') + strPadR(Session.Menu.MenuList[A].Text, 21, ' ') + ' ');
|
||||
If (A = Session.Menu.CmdNum) or (A Mod 2 = 0) Then Session.io.OutRawLn('');
|
||||
End;
|
||||
|
||||
Session.io.OutFull ('|CR|09(E)dit, (I)nsert, (D)elete, (F)lags, (V)iew, (Q)uit: ');
|
||||
Case Session.io.OneKey('EIDFVQ', True) of
|
||||
'D' : begin
|
||||
Session.io.OutRaw('Delete which? ');
|
||||
a := strS2I(Session.io.GetInput(2, 2, 11, ''));
|
||||
if (a > 0) and (a <= Session.Menu.CmdNum) then begin
|
||||
for b := a to Session.Menu.CmdNum do
|
||||
Session.Menu.Menulist[b] := Session.Menu.Menulist[b+1];
|
||||
dec (Session.Menu.cmdnum);
|
||||
end;
|
||||
end;
|
||||
'I' : if Session.Menu.CmdNum < mysMaxMenuCmds Then Begin
|
||||
Session.io.OutRaw ('Insert before which (1-' + strI2S(Session.Menu.CmdNum + 1) + '): ');
|
||||
A := strS2I(Session.io.GetInput(2, 2, 11, ''));
|
||||
If (A > 0) And (A <= Session.Menu.CmdNum + 1) Then Begin
|
||||
Inc (Session.Menu.CmdNum);
|
||||
For B := Session.Menu.CmdNum DownTo A + 1 Do
|
||||
Session.Menu.MenuList[B] := Session.Menu.MenuList[B - 1];
|
||||
Session.Menu.MenuList[A].Text := '[XXX] New Command';
|
||||
Session.Menu.MenuList[A].HotKey := 'XXX';
|
||||
Session.Menu.MenuList[A].LongKey := 'XXX';
|
||||
Session.Menu.MenuList[A].ACS := '';
|
||||
Session.Menu.MenuList[A].Command := '';
|
||||
Session.Menu.MenuList[A].X := 0;
|
||||
Session.Menu.MenuList[A].Y := 0;
|
||||
Session.Menu.MenuList[A].lText := '';
|
||||
Session.Menu.MenuList[A].lhText := '';
|
||||
End;
|
||||
End;
|
||||
'F' : Begin
|
||||
repeat
|
||||
Session.io.OutFullLn ('|CL|14Menu Flags (' + Session.Menu.MenuName + ')|CR|03');
|
||||
Session.io.OutRawLn ('A. Menu Header : ' + strPadR(Session.Menu.Menu.header, 59, ' '));
|
||||
Session.io.OutRawLn ('B. Menu Prompt : ' + strPadR(Session.Menu.menu.prompt, 59, ' '));
|
||||
Session.io.OutRawLn ('C. Display Cols : ' + strI2S(Session.Menu.Menu.DispCols));
|
||||
Session.io.OutRawLn ('D. ACS : ' + Session.Menu.menu.acs);
|
||||
Session.io.OutRawLn ('E. Password : ' + Session.Menu.menu.password);
|
||||
Session.io.OutRawLn ('F. Display File : ' + Session.Menu.Menu.TextFile);
|
||||
Session.io.OutRawLn ('G. Fallback Menu : ' + Session.Menu.Menu.Fallback);
|
||||
Session.io.OutRaw ('H. Menu Type : ');
|
||||
|
||||
Case Session.Menu.Menu.MenuType of
|
||||
0 : Session.io.OutRawLn ('Standard');
|
||||
1 : Session.io.OutRawLn ('Lightbar');
|
||||
2 : Session.io.OutRawLn ('Lightbar Grid');
|
||||
End;
|
||||
|
||||
Session.io.OutRawLn ('I. Finish X/Y : ' + strPadR(strI2S(Session.Menu.menu.donex), 3, ' ') + strI2S(Session.Menu.menu.doney));
|
||||
Session.io.OutRawLn ('J. Use Global MNU: ' + Session.io.OutYN(Session.Menu.Menu.Global=1));
|
||||
Session.io.OutRaw ('K. Input Type : ');
|
||||
|
||||
Case Session.Menu.Menu.InputType of
|
||||
0 : Session.io.OutRawLn ('User setting');
|
||||
1 : Session.io.OutRawLn ('Hotkey');
|
||||
2 : Session.io.OutRawLn ('Longkey');
|
||||
End;
|
||||
|
||||
Session.io.OutFull ('|CR|09(V)iew or (Q)uit: ');
|
||||
Case Session.io.OneKey('ABCDEFGHIJKQV', True) of
|
||||
'A' : Session.Menu.Menu.Header := Session.io.InXY(20, 3, 60, 255, 11, Session.Menu.Menu.Header);
|
||||
'B' : Session.Menu.Menu.Prompt := Session.io.InXY(20, 4, 60, 255, 11, Session.Menu.Menu.Prompt);
|
||||
'C' : Begin
|
||||
Session.Menu.Menu.DispCols := strS2I(Session.io.InXY(20, 5, 1, 1, 12, strI2S(Session.Menu.Menu.DispCols)));
|
||||
If Session.Menu.Menu.DispCols < 1 Then Session.Menu.Menu.DispCols := 1;
|
||||
If Session.Menu.Menu.DispCols > 3 Then Session.Menu.Menu.DispCols := 3;
|
||||
End;
|
||||
'D' : Session.Menu.Menu.ACS := Session.io.InXY(20, 6, 20, 20, 11, Session.Menu.Menu.ACS);
|
||||
'E' : Session.Menu.Menu.Password := Session.io.InXY(20, 7, 15, 15, 12, Session.Menu.Menu.Password);
|
||||
'F' : Session.Menu.Menu.TextFile := Session.io.InXY(20, 8, 20, 20, 11, Session.Menu.Menu.TextFile);
|
||||
'G' : Session.Menu.Menu.Fallback := Session.io.InXY(20, 9, mysMaxMenuNameLen, mysMaxMenuNameLen, 11, Session.Menu.Menu.Fallback);
|
||||
'H' : If Session.Menu.Menu.MenuType = 2 Then Session.Menu.Menu.MenuType := 0 Else Inc(Session.Menu.Menu.MenuType);
|
||||
'I' : Begin
|
||||
Session.Menu.Menu.donex := strS2I(Session.io.InXY(20, 11, 2, 2, 12, strI2S(Session.Menu.Menu.donex)));
|
||||
Session.Menu.Menu.doney := strS2I(Session.io.InXY(23, 11, 2, 2, 12, strI2S(Session.Menu.Menu.doney)));
|
||||
End;
|
||||
'J' : If Session.Menu.Menu.Global = 1 Then dec(Session.Menu.Menu.global) else Session.Menu.Menu.global := 1;
|
||||
'K' : If Session.Menu.Menu.InputType = 2 Then Session.Menu.Menu.InputType := 0 Else Inc(Session.Menu.Menu.InputType);
|
||||
'Q' : Break;
|
||||
'V' : Session.Menu.ExecuteMenu (False, False, True);
|
||||
End;
|
||||
Until False;
|
||||
End;
|
||||
'E' : Begin
|
||||
Session.io.OutRaw ('Edit which? ');
|
||||
a := strS2I(Session.io.GetInput(2, 2, 11, ''));
|
||||
If (a > 0) and (a <= Session.Menu.CmdNum) then Begin
|
||||
Repeat
|
||||
Session.io.OutFullLn ('|CL|14Menu command ' + strI2S(a) + ' of ' + strI2S(Session.Menu.CmdNum) + '|CR|03');
|
||||
Session.io.OutRawln ('A. Text : ' + Session.Menu.MenuList[A].text);
|
||||
Session.io.OutRawln ('B. Hot Key : ' + Session.Menu.MenuList[A].HotKey);
|
||||
Session.io.OutRawLn ('C. Long Key: ' + Session.Menu.MenuList[A].LongKey);
|
||||
Session.io.OutRawln ('D. ACS : ' + Session.Menu.MenuList[A].acs);
|
||||
Session.io.OutRawln ('E. Command : ' + Session.Menu.MenuList[A].command);
|
||||
Session.io.OutRawln ('F. Data : ' + Session.Menu.MenuList[A].data);
|
||||
Session.io.OutFullLn ('|CRG. Lightbar X/Y : ' + strPadR(strI2S(Session.Menu.MenuList[a].x), 3, ' ') + strI2S(Session.Menu.MenuList[a].y));
|
||||
Session.io.OutRawln ('H. Lightbar Text : ' + Session.Menu.MenuList[a].ltext);
|
||||
Session.io.OutRawln ('I. Lightbar High : ' + Session.Menu.MenuList[a].lhtext);
|
||||
Session.io.OutRawln ('');
|
||||
Session.io.OutRawln ('J. Lightbar Up : ' + strI2S(Session.Menu.MenuList[a].cUP));
|
||||
Session.io.OutRawln ('K. Lightbar Down : ' + strI2S(Session.Menu.MenuList[a].cDOWN));
|
||||
Session.io.OutRawln ('L. Lightbar Left : ' + strI2S(Session.Menu.MenuList[a].cLEFT));
|
||||
Session.io.OutRawln ('M. Lightbar Right: ' + strI2S(Session.Menu.MenuList[a].cRIGHT));
|
||||
|
||||
Session.io.OutFull ('|CR|09([) Previous, (]) Next, (Q)uit: ');
|
||||
case session.io.onekey('[]ABCDEFGHIJKLMQ', True) of
|
||||
'[' : If A > 1 Then Dec(A);
|
||||
']' : If A < Session.Menu.CmdNum Then Inc(A);
|
||||
'A' : Session.Menu.MenuList[A].Text := Session.io.InXY(14, 3, 60, 79, 11, Session.Menu.MenuList[A].Text);
|
||||
'B' : Session.Menu.MenuList[A].HotKey := Session.io.InXY(14, 4, 8, 8, 12, Session.Menu.MenuList[A].HotKey);
|
||||
'C' : Session.Menu.MenuList[A].LongKey := Session.io.InXY(14, 5, 8, 8, 12, Session.Menu.MenuList[A].LongKey);
|
||||
'D' : Session.Menu.MenuList[A].ACS := Session.io.InXY(14, 6, 20, 20, 11, Session.Menu.MenuList[A].ACS);
|
||||
'E' : Repeat
|
||||
Session.io.OutFull ('|09Menu Command (?/List): ');
|
||||
Session.Menu.MenuList[A].command := Session.io.GetInput(2, 2, 12, '');
|
||||
If Session.Menu.MenuList[A].Command = '?' Then
|
||||
session.io.OutFile ('menucmds', True, 0)
|
||||
Else
|
||||
Break;
|
||||
Until False;
|
||||
'F' : Session.Menu.MenuList[A].Data := Session.io.InXY(14, 8, 60, 79, 11, Session.Menu.MenuList[a].data);
|
||||
'G' : Begin
|
||||
Session.Menu.MenuList[A].X := strS2I(Session.io.InXY(20, 10, 2, 2, 12, strI2S(Session.Menu.MenuList[A].X)));
|
||||
Session.Menu.MenuList[A].Y := strS2I(Session.io.InXY(23, 10, 2, 2, 12, strI2S(Session.Menu.MenuList[A].Y)));
|
||||
End;
|
||||
'H' : Session.Menu.MenuList[A].LText := Session.io.InXY(20, 11, 59, 79, 11, Session.Menu.MenuList[A].LText);
|
||||
'I' : Session.Menu.MenuList[A].LHText := Session.io.InXY(20, 12, 59, 79, 11, Session.Menu.MenuList[A].LHText);
|
||||
'J' : Session.Menu.MenuList[A].cUP := strS2I(Session.io.InXY(20, 14, 2, 2, 12, strI2S(Session.Menu.MenuList[A].cUP)));
|
||||
'K' : Session.Menu.MenuList[A].cDOWN := strS2I(Session.io.InXY(20, 15, 2, 2, 12, strI2S(Session.Menu.MenuList[A].cDOWN)));
|
||||
'L' : Session.Menu.MenuList[A].cLEFT := strS2I(Session.io.InXY(20, 16, 2, 2, 12, strI2S(Session.Menu.MenuList[A].cLEFT)));
|
||||
'M' : Session.Menu.MenuList[A].cRIGHT := strS2I(Session.io.InXY(20, 17, 2, 2, 12, strI2S(Session.Menu.MenuList[A].cRIGHT)));
|
||||
'Q' : Break;
|
||||
end;
|
||||
until false;
|
||||
End;
|
||||
End;
|
||||
(*
|
||||
'P' : begin
|
||||
Session.io.OutRaw('Move which? ');
|
||||
a := strS2I(Session.io.GetInput(2, 2, 11, ''));
|
||||
Session.io.OutRaw('Move before which (1-' + strI2S(Session.Menu.CmdNum+1) + '): ');
|
||||
b := strS2I(Session.io.GetInput(2, 2, 11, ''));
|
||||
end;
|
||||
*)
|
||||
'Q' : break;
|
||||
'V' : Session.Menu.ExecuteMenu(False, False, True);
|
||||
|
||||
end;
|
||||
Until false;
|
||||
|
||||
Session.io.OutFullLn ('|14Saving...');
|
||||
assign (menufile, Session.lang.menupath + Session.Menu.menuname + '.mnu');
|
||||
rewrite (menufile);
|
||||
writeln (menufile, Session.Menu.Menu.header);
|
||||
writeln (menufile, Session.Menu.Menu.prompt);
|
||||
writeln (menufile, Session.Menu.Menu.dispcols);
|
||||
writeln (menufile, Session.Menu.Menu.acs);
|
||||
writeln (menufile, Session.Menu.Menu.password);
|
||||
writeln (menufile, Session.Menu.Menu.textfile);
|
||||
WriteLn (MenuFile, Session.Menu.Menu.Fallback);
|
||||
writeln (menufile, Session.Menu.Menu.MenuType);
|
||||
WriteLn (MenuFile, Session.Menu.Menu.InputType);
|
||||
WriteLn (MenuFile, Session.Menu.Menu.DoneX);
|
||||
WriteLn (MenuFile, Session.Menu.Menu.DoneY);
|
||||
WriteLn (MenuFile, Session.Menu.Menu.Global);
|
||||
for a := 1 to Session.Menu.CmdNum do begin
|
||||
writeln (menufile, Session.Menu.MenuList[a].text);
|
||||
writeln (menufile, Session.Menu.MenuList[a].HotKey);
|
||||
WriteLn (MenuFile, Session.Menu.MenuList[A].LongKey);
|
||||
writeln (menufile, Session.Menu.MenuList[a].acs);
|
||||
writeln (menufile, Session.Menu.MenuList[a].command);
|
||||
writeln (menufile, Session.Menu.MenuList[a].data);
|
||||
writeln (menufile, Session.Menu.MenuList[a].x);
|
||||
writeln (menufile, Session.Menu.MenuList[a].y);
|
||||
writeln (menufile, Session.Menu.MenuList[a].cUP);
|
||||
WriteLn (MenuFile, Session.Menu.MenuList[A].cDOWN);
|
||||
WriteLn (MenuFile, Session.Menu.MenuList[A].cLEFT);
|
||||
WriteLn (MenuFile, Session.Menu.MenuList[A].cRIGHT);
|
||||
writeln (menufile, Session.Menu.MenuList[a].ltext);
|
||||
writeln (menufile, Session.Menu.MenuList[a].lhtext);
|
||||
end;
|
||||
close (menufile);
|
||||
End;
|
||||
|
||||
Var
|
||||
Old : String[8];
|
||||
OldLang : LangRec;
|
||||
DirInfo: SearchRec;
|
||||
A : Byte; {format dir output}
|
||||
Begin
|
||||
Old := Session.Menu.MenuName;
|
||||
OldLang := Session.Lang;
|
||||
Session.SystemLog ('*MENU EDITOR*');
|
||||
|
||||
Session.io.OutFull ('|CL');
|
||||
Session.User.GetLanguage;
|
||||
|
||||
Repeat
|
||||
Session.io.OutFullLn ('|CL|14Menu Editor (Language: ' + Session.Lang.Desc + ')|CR');
|
||||
Session.io.OutFullLn ('|08Directory of ' + Session.lang.MenuPath + '*.MNU|CR|03');
|
||||
|
||||
a := 0;
|
||||
FindFirst (Session.lang.MenuPath + '*.mnu', Archive, DirInfo);
|
||||
While DosError = 0 Do Begin
|
||||
inc (a);
|
||||
Session.io.OutRaw (strPadR(DirInfo.Name, 25, ' '));
|
||||
FindNext (DirInfo);
|
||||
if (a = 3) or (DosError <> 0) then begin
|
||||
Session.io.OutRawln('');
|
||||
a := 0
|
||||
end;
|
||||
|
||||
End;
|
||||
|
||||
Session.io.OutFull ('|CR|09(E)dit, (I)nsert, (D)elete, (Q)uit? ');
|
||||
Case session.io.OneKey('EIDQ', True) of
|
||||
'E' : ModifyMenu;
|
||||
'I' : Begin;
|
||||
Session.io.OutRaw ('Menu Name: ');
|
||||
Session.menu.MenuName := Session.io.GetInput(mysMaxMenuNameLen, mysMaxMenuNameLen, 11, '');
|
||||
If Session.Menu.MenuName <> '' Then Begin
|
||||
Assign (MenuFile, Session.Lang.MenuPath + Session.Menu.MenuName + '.mnu');
|
||||
{$I-} Reset(MenuFile); {$I+}
|
||||
If IoResult = 0 Then
|
||||
Session.io.OutRawLn ('Menu already exists')
|
||||
Else Begin
|
||||
Rewrite (MenuFile);
|
||||
WriteLn (MenuFile, 'New Menu');
|
||||
WriteLn (MenuFile, 'Command: ');
|
||||
WriteLn (MenuFile, '2');
|
||||
WriteLn (MenuFile, '');
|
||||
WriteLn (MenuFile, '');
|
||||
WriteLn (MenuFile, '');
|
||||
WriteLn (MenuFile, 'main');
|
||||
WriteLn (MenuFile, '0');
|
||||
WriteLn (MenuFile, '0');
|
||||
WriteLn (MenuFile, '0');
|
||||
WriteLn (MenuFile, '0');
|
||||
WriteLn (MenuFile, '1');
|
||||
Close (MenuFile);
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
'D' : Begin
|
||||
Session.io.OutRaw ('Menu to delete: ');
|
||||
Session.Menu.MenuName := Session.io.GetInput(mysMaxMenuNameLen, mysMaxMenuNameLen, 11, '');
|
||||
FileErase(Session.Lang.MenuPath + Session.Menu.MenuName + '.mnu');
|
||||
End;
|
||||
'Q' : Break;
|
||||
End;
|
||||
Until False;
|
||||
Session.Menu.MenuName := Old;
|
||||
Session.Lang := OldLang;
|
||||
Close (Session.PromptFile);
|
||||
Assign (Session.PromptFile, Config.DataPath + Session.Lang.FileName + '.lng');
|
||||
Reset (Session.PromptFile);
|
||||
End;
|
||||
|
||||
End.
|
||||
236
mystic/bbs_cfg_msgbase.pas
Normal file
236
mystic/bbs_cfg_msgbase.pas
Normal file
|
|
@ -0,0 +1,236 @@
|
|||
Unit bbs_cfg_MsgBase;
|
||||
|
||||
{$I M_OPS.PAS}
|
||||
|
||||
Interface
|
||||
|
||||
Procedure Message_Base_Editor;
|
||||
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
m_FileIO,
|
||||
m_Strings,
|
||||
bbs_Common,
|
||||
bbs_Core,
|
||||
bbs_User;
|
||||
|
||||
Procedure Message_Base_Editor;
|
||||
Const
|
||||
BT : Array[0..1] of String[6] = ('JAM', 'Squish');
|
||||
NT : Array[0..3] of String[8] = ('Local ', 'EchoMail', 'UseNet ', 'NetMail ');
|
||||
ST : Array[0..2] of String[6] = ('No', 'Yes', 'Always');
|
||||
Var
|
||||
A,
|
||||
B : Word; { was integer }
|
||||
Begin
|
||||
Session.SystemLog ('*MBASE EDITOR*');
|
||||
|
||||
Repeat
|
||||
Session.io.AllowPause := True;
|
||||
|
||||
Session.io.OutFullLn ('|CL|14Message Base Editor|CR|CR|09### Name|$D37 Type Format|CR--- |$D40- ------- ------');
|
||||
|
||||
Reset (Session.Msgs.MBaseFile);
|
||||
While Not Eof(Session.Msgs.MBaseFile) Do Begin
|
||||
Read (Session.Msgs.MBaseFile, Session.Msgs.MBase);
|
||||
|
||||
Session.io.OutFullLn ('|15' + strPadR(strI2S(FilePos(Session.Msgs.MBaseFile) - 1), 3, ' ') + ' |14|$R41|MB|10' +
|
||||
NT[Session.Msgs.MBase.NetType] + ' ' + BT[Session.Msgs.MBase.BaseType]);
|
||||
|
||||
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 ('|CR|09(I)nsert, (D)elete, (E)dit, (M)ove, (Q)uit? ');
|
||||
case Session.io.OneKey (#13'DIEMQ', True) of
|
||||
'D' : begin
|
||||
Session.io.OutFull ('Delete which? ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
If (A > 0) and (A <= FileSize(Session.Msgs.MBaseFile)) Then Begin
|
||||
Seek (Session.Msgs.MBaseFile, A);
|
||||
Read (Session.Msgs.MBaseFile, Session.Msgs.MBase);
|
||||
|
||||
FileErase (config.msgspath + Session.Msgs.MBase.filename + '.jhr');
|
||||
FileErase (config.msgspath + Session.Msgs.MBase.filename + '.jlr');
|
||||
FileErase (config.msgspath + Session.Msgs.MBase.filename + '.jdt');
|
||||
FileErase (config.msgspath + Session.Msgs.MBase.filename + '.jdx');
|
||||
FileErase (config.msgspath + Session.Msgs.MBase.filename + '.sqd');
|
||||
FileErase (config.msgspath + Session.Msgs.MBase.filename + '.sqi');
|
||||
FileErase (config.msgspath + Session.Msgs.MBase.filename + '.sql');
|
||||
|
||||
KillRecord (Session.Msgs.MBaseFile, A+1, SizeOf(MBaseRec));
|
||||
End;
|
||||
end;
|
||||
'I' : begin
|
||||
Session.io.OutFull ('Insert before? (1-' + strI2S(filesize(Session.Msgs.MBaseFile)) + '): ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
if (a > 0) and (a <= filesize(Session.Msgs.MBaseFile)) then begin
|
||||
AddRecord (Session.Msgs.MBaseFile, A, SizeOf(Session.Msgs.MBaseFile));
|
||||
|
||||
{find permanent mbase index}
|
||||
b := a + 1;
|
||||
reset (Session.Msgs.MBaseFile);
|
||||
while not eof(Session.Msgs.MBaseFile) do begin
|
||||
read (Session.Msgs.MBaseFile, Session.Msgs.mbase);
|
||||
if B = Session.Msgs.MBase.index then begin
|
||||
inc (b);
|
||||
reset (Session.Msgs.MBaseFile);
|
||||
end;
|
||||
end;
|
||||
Session.Msgs.MBase.name := 'New Message Base';
|
||||
Session.Msgs.MBase.qwkname := 'New Messages';
|
||||
Session.Msgs.MBase.filename := 'NEW';
|
||||
Session.Msgs.MBase.Path := config.msgspath;
|
||||
Session.Msgs.MBase.nettype := 0;
|
||||
Session.Msgs.MBase.posttype := 0;
|
||||
Session.Msgs.MBase.acs := 's255';
|
||||
Session.Msgs.MBase.readacs := 's255';
|
||||
Session.Msgs.MBase.postacs := 's255';
|
||||
Session.Msgs.MBase.sysopacs := 's255';
|
||||
Session.Msgs.MBase.index := B;
|
||||
Session.Msgs.MBase.netaddr := 1;
|
||||
Session.Msgs.MBase.origin := config.origin;
|
||||
Session.Msgs.MBase.usereal := false;
|
||||
Session.Msgs.MBase.colquote := config.colorquote;
|
||||
Session.Msgs.MBase.coltext := config.colortext;
|
||||
Session.Msgs.MBase.coltear := config.colortear;
|
||||
Session.Msgs.MBase.colorigin := config.colororigin;
|
||||
Session.Msgs.MBase.defnscan := 1;
|
||||
Session.Msgs.MBase.defqscan := 1;
|
||||
Session.Msgs.MBase.basetype := 0;
|
||||
seek (Session.Msgs.MBaseFile, a);
|
||||
write (Session.Msgs.MBaseFile, Session.Msgs.mbase);
|
||||
end;
|
||||
end;
|
||||
'E' : begin
|
||||
Session.io.OutFull ('Edit which? ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
if (a >= 0) and (a < filesize(Session.Msgs.MBaseFile)) then begin
|
||||
seek (Session.Msgs.MBaseFile, a);
|
||||
read (Session.Msgs.MBaseFile, Session.Msgs.mbase);
|
||||
repeat
|
||||
Session.io.OutFullLn ('|CL|14Message Base '+strI2S(FilePos(Session.Msgs.MBaseFile)-1)+' of '+strI2S(FileSize(Session.Msgs.MBaseFile)-1)+' |08[Perm Idx:' + strI2S(Session.Msgs.MBase.index) + ']|CR|03');
|
||||
Session.io.OutRawln ('A. Name : ' + Session.Msgs.MBase.name);
|
||||
Session.io.OutRawln ('B. QWK Name : ' + Session.Msgs.MBase.qwkname);
|
||||
Session.io.OutRawln ('C. Filename : ' + Session.Msgs.MBase.filename);
|
||||
Session.io.OutRawln ('D. Storage Path : ' + Session.Msgs.MBase.path);
|
||||
Session.io.OutRaw ('E. Post Type : ');
|
||||
If Session.Msgs.MBase.PostType = 0 Then Session.io.OutRaw ('Public ') Else Session.io.OutRaw ('Private');
|
||||
Session.io.OutRawLn (strRep(' ', 23) + 'Y. Base Format : ' + BT[Session.Msgs.MBase.BaseType]);
|
||||
|
||||
Session.io.OutFull ('|CRF. List ACS : ' + strPadR(Session.Msgs.MBase.acs, 30, ' '));
|
||||
Session.io.OutFull ('O. Quote Color : ');
|
||||
Session.io.AnsiColor(Session.Msgs.MBase.ColQuote);
|
||||
Session.io.OutFullLn ('XX> Quote|03|16');
|
||||
|
||||
Session.io.OutRaw ('G. Read ACS : ' + strPadR(Session.Msgs.MBase.readacs, 30, ' '));
|
||||
Session.io.OutFull ('P. Text Color : ');
|
||||
Session.io.AnsiColor(Session.Msgs.MBase.ColText);
|
||||
Session.io.OutFullLn ('Text|03|16');
|
||||
|
||||
Session.io.OutRaw ('H. Post ACS : ' + strPadR(Session.Msgs.MBase.postacs, 30, ' '));
|
||||
Session.io.OutFull ('R. Tear Color : ');
|
||||
Session.io.AnsiColor(Session.Msgs.MBase.ColTear);
|
||||
Session.io.OutFullLn ('--- Tear|03|16');
|
||||
|
||||
Session.io.OutRaw ('I. Sysop ACS : ' + strPadR(Session.Msgs.MBase.sysopacs, 30, ' '));
|
||||
Session.io.OutFull ('S. Origin Color : ');
|
||||
Session.io.AnsiColor(Session.Msgs.MBase.ColOrigin);
|
||||
Session.io.OutFullLn ('* Origin:|03|16');
|
||||
|
||||
Session.io.OutRaw ('J. Password : ' + strPadR(Session.Msgs.MBase.password, 30, ' '));
|
||||
Session.io.OutRawln ('T. Header File : ' + Session.Msgs.MBase.Header);
|
||||
Session.io.OutRawLn ('K. Base Type : ' + NT[Session.Msgs.MBase.NetType]);
|
||||
Session.io.OutRawln ('L. Net Address : ' + strAddr2Str(config.netaddress[Session.Msgs.MBase.netaddr]) + ' (' + Config.NetDesc[Session.Msgs.MBase.NetAddr] + ')');
|
||||
Session.io.OutRawln ('M. Origin line : ' + Session.Msgs.MBase.origin);
|
||||
Session.io.OutRawLn ('N. Use Realnames: ' + Session.io.OutYN(Session.Msgs.MBase.UseReal));
|
||||
|
||||
Session.io.OutFullLn ('|CRU. Default New Scan: ' + strPadR(ST[Session.Msgs.MBase.DefNScan], 27, ' ') +
|
||||
'W. Max Messages : ' + strI2S(Session.Msgs.MBase.MaxMsgs));
|
||||
|
||||
Session.io.OutRawLn ('V. Default QWK Scan: ' + strPadR(ST[Session.Msgs.MBase.DefQScan], 27, ' ') +
|
||||
'X. Max Msg Age : ' + strI2S(Session.Msgs.MBase.MaxAge) + ' days');
|
||||
|
||||
Session.io.OutFull ('|CR|09([) Prev, (]) Next, (Q)uit: ');
|
||||
case Session.io.OneKey('[]ABCDEFGHIJKLMNOPQRSTUVWXY', True) of
|
||||
'[' : If FilePos(Session.Msgs.MBaseFile) > 1 Then Begin
|
||||
Seek (Session.Msgs.MBaseFile, FilePos(Session.Msgs.MBaseFile)-1);
|
||||
Write (Session.Msgs.MBaseFile, Session.Msgs.MBase);
|
||||
Seek (Session.Msgs.MBaseFile, FilePos(Session.Msgs.MBaseFile)-2);
|
||||
Read (Session.Msgs.MBaseFile, Session.Msgs.MBase);
|
||||
End;
|
||||
']' : If FilePos(Session.Msgs.MBaseFile) < FileSize(Session.Msgs.MBaseFile) Then Begin
|
||||
Seek (Session.Msgs.MBaseFile, FilePos(Session.Msgs.MBaseFile)-1);
|
||||
Write (Session.Msgs.MBaseFile, Session.Msgs.MBase);
|
||||
Read (Session.Msgs.MBaseFile, Session.Msgs.MBase);
|
||||
End;
|
||||
'A' : Session.Msgs.MBase.Name := Session.io.InXY(19, 3, 40, 40, 11, Session.Msgs.MBase.Name);
|
||||
'B' : Session.Msgs.MBase.QwkName := Session.io.InXY(19, 4, 13, 13, 11, Session.Msgs.MBase.QwkName);
|
||||
'C' : Session.Msgs.MBase.FileName := Session.io.InXY(19, 5, 40, 40, 11, Session.Msgs.MBase.filename);
|
||||
'D' : Session.Msgs.MBase.Path := CheckPath(Session.io.InXY(19, 6, 39, 39, 11, Session.Msgs.MBase.Path));
|
||||
'E' : If Session.Msgs.MBase.PostType = 0 Then Inc(Session.Msgs.MBase.PostType) Else Dec(Session.Msgs.MBase.PostType);
|
||||
'F' : Session.Msgs.MBase.ACS := Session.io.InXY(19, 9, 20, 20, 11, Session.Msgs.MBase.acs);
|
||||
'G' : Session.Msgs.MBase.ReadACS := Session.io.InXY(19, 10, 20, 20, 11, Session.Msgs.MBase.readacs);
|
||||
'H' : Session.Msgs.MBase.PostACS := Session.io.InXY(19, 11, 20, 20, 11, Session.Msgs.MBase.postacs);
|
||||
'I' : Session.Msgs.MBase.SysopACS := Session.io.InXY(19, 12, 20, 20, 11, Session.Msgs.MBase.sysopacs);
|
||||
'J' : Session.Msgs.MBase.Password := Session.io.InXY(19, 13, 15, 15, 12, Session.Msgs.MBase.password);
|
||||
'K' : If Session.Msgs.MBase.NetType < 3 Then Inc(Session.Msgs.MBase.NetType) Else Session.Msgs.MBase.NetType := 0;
|
||||
'L' : begin
|
||||
Session.io.OutFullLn ('|03');
|
||||
For A := 1 to 30 Do Begin
|
||||
Session.io.OutRaw (strPadR(strI2S(A) + '.', 5, ' ') + strPadR(strAddr2Str(Config.NetAddress[A]), 30, ' '));
|
||||
If A Mod 2 = 0 then Session.io.OutRawLn('');
|
||||
End;
|
||||
Session.io.OutFull ('|CR|09Address: ');
|
||||
a := strS2I(Session.io.GetInput(2, 2, 12, ''));
|
||||
if (a > 0) and (a < 31) then Session.Msgs.MBase.netaddr := a;
|
||||
end;
|
||||
'M' : Session.Msgs.MBase.origin := Session.io.InXY(19, 16, 50, 50, 11, Session.Msgs.MBase.origin);
|
||||
'N' : Session.Msgs.MBase.usereal := Not Session.Msgs.MBase.UseReal;
|
||||
'O' : Session.Msgs.MBase.ColQuote := getColor(Session.Msgs.MBase.ColQuote);
|
||||
'P' : Session.Msgs.MBase.ColText := getColor(Session.Msgs.MBase.ColText);
|
||||
'R' : Session.Msgs.MBase.ColTear := getColor(Session.Msgs.MBase.ColTear);
|
||||
'S' : Session.Msgs.MBase.ColOrigin := getColor(Session.Msgs.MBase.ColOrigin);
|
||||
'T' : Session.Msgs.MBase.Header := Session.io.InXY(67, 13, 8, 8, 11, Session.Msgs.MBase.Header);
|
||||
'U' : If Session.Msgs.MBase.DefNScan < 2 Then Inc(Session.Msgs.MBase.DefNScan) Else Session.Msgs.MBase.DefNScan := 0;
|
||||
'V' : If Session.Msgs.MBase.DefQScan < 2 Then Inc(Session.Msgs.MBase.DefQScan) Else Session.Msgs.MBase.DefQScan := 0;
|
||||
'W' : Session.Msgs.MBase.MaxMsgs := strS2I(Session.io.InXY(67, 19, 5, 5, 12, strI2S(Session.Msgs.MBase.MaxMsgs)));
|
||||
'X' : Session.Msgs.MBase.MaxAge := strS2I(Session.io.InXY(67, 20, 5, 5, 12, strI2S(Session.Msgs.MBase.MaxAge)));
|
||||
'Y' : If Session.Msgs.MBase.BaseType = 0 Then Session.Msgs.MBase.BaseType := 1 Else Session.Msgs.MBase.BaseType := 0;
|
||||
'Q' : Break;
|
||||
End;
|
||||
Until False;
|
||||
Seek (Session.Msgs.MBaseFile, FilePos(Session.Msgs.MBaseFile) - 1);
|
||||
Write (Session.Msgs.MBaseFile, Session.Msgs.MBase);
|
||||
End;
|
||||
End;
|
||||
'M' : Begin
|
||||
Session.io.OutRaw ('Move which? ');
|
||||
A := strS2I(Session.io.GetInput(3, 3, 12, ''));
|
||||
|
||||
Session.io.OutRaw ('Move before? (1-' + strI2S(FileSize(Session.Msgs.MBaseFile)) + '): ');
|
||||
B := strS2I(Session.io.GetInput(3, 3, 12, ''));
|
||||
|
||||
If (A > 0) and (A <= FileSize(Session.Msgs.MBaseFile)) and (B > 0) and (B <= FileSize(Session.Msgs.MBaseFile)) Then Begin
|
||||
Seek (Session.Msgs.MBaseFile, A);
|
||||
Read (Session.Msgs.MBaseFile, Session.Msgs.MBase);
|
||||
|
||||
AddRecord (Session.Msgs.MBaseFile, B+1, SizeOf(MBaseRec));
|
||||
Write (Session.Msgs.MBaseFile, Session.Msgs.MBase);
|
||||
|
||||
If A > B Then Inc(A);
|
||||
|
||||
KillRecord (Session.Msgs.MBaseFile, A+1, SizeOf(MBaseRec));
|
||||
End;
|
||||
End;
|
||||
'Q' : break;
|
||||
end;
|
||||
|
||||
until False;
|
||||
close (Session.Msgs.MBaseFile);
|
||||
end;
|
||||
|
||||
end.
|
||||
148
mystic/bbs_cfg_protocol.pas
Normal file
148
mystic/bbs_cfg_protocol.pas
Normal file
|
|
@ -0,0 +1,148 @@
|
|||
Unit bbs_cfg_Protocol;
|
||||
|
||||
{$I M_OPS.PAS}
|
||||
|
||||
Interface
|
||||
|
||||
Procedure Configuration_ProtocolEditor;
|
||||
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
m_FileIO,
|
||||
m_Strings,
|
||||
bbs_Common,
|
||||
bbs_ansi_MenuBox,
|
||||
bbs_ansi_MenuForm;
|
||||
|
||||
Procedure EditProtocol (Var Prot: RecProtocol);
|
||||
Var
|
||||
Box : TAnsiMenuBox;
|
||||
Form : TAnsiMenuForm;
|
||||
Begin
|
||||
Box := TAnsiMenuBox.Create;
|
||||
Form := TAnsiMenuForm.Create;
|
||||
|
||||
Form.HelpSize := 0;
|
||||
|
||||
Box.Header := ' Protocol Editor: ' + Prot.Desc + ' ';
|
||||
|
||||
Box.Open (6, 5, 75, 15);
|
||||
|
||||
VerticalLine (22, 7, 13);
|
||||
|
||||
Form.AddBol ('A', ' Active ' , 14, 7, 24, 7, 8, 3, @Prot.Active, '');
|
||||
Form.AddTog ('O', ' OS ' , 18, 8, 24, 8, 4, 7, 0, 2, 'Windows Linux OSX', @Prot.OSType, '');
|
||||
Form.AddBol ('B', ' Batch ' , 15, 9, 24, 9, 7, 3, @Prot.Batch, '');
|
||||
Form.AddChar ('K', ' Hot Key ' , 13, 10, 24, 10, 9, 1, 254, @Prot.Key, '');
|
||||
Form.AddStr ('D', ' Description ' , 9, 11, 24, 11, 13, 40, 40, @Prot.Desc, '');
|
||||
Form.AddStr ('S', ' Send Command ', 8, 12, 24, 12, 14, 50, 100, @Prot.SendCmd, '');
|
||||
Form.AddStr ('R', ' Recv Command ', 8, 13, 24, 13, 14, 50, 100, @Prot.RecvCmd, '');
|
||||
|
||||
Form.Execute;
|
||||
Box.Close;
|
||||
|
||||
Form.Free;
|
||||
Box.Free;
|
||||
End;
|
||||
|
||||
Procedure Configuration_ProtocolEditor;
|
||||
Var
|
||||
Box : TAnsiMenuBox;
|
||||
List : TAnsiMenuList;
|
||||
F : TBufFile;
|
||||
Prot : RecProtocol;
|
||||
|
||||
Procedure MakeList;
|
||||
Var
|
||||
OS : String;
|
||||
Begin
|
||||
List.Clear;
|
||||
|
||||
F.Reset;
|
||||
|
||||
While Not F.Eof Do Begin
|
||||
F.Read (Prot);
|
||||
|
||||
Case Prot.OSType of
|
||||
0 : OS := 'Windows';
|
||||
1 : OS := 'Linux ';
|
||||
2 : OS := 'OSX';
|
||||
End;
|
||||
|
||||
//'Active OSID Batch Key Description');
|
||||
|
||||
List.Add (strPadR(strYN(Prot.Active), 6, ' ') + ' ' + strPadR(OS, 7, ' ') + ' ' + strPadR(strYN(Prot.Batch), 5, ' ') + ' ' + strPadR(Prot.Key, 4, ' ') + Prot.Desc, 0);
|
||||
End;
|
||||
|
||||
List.Add ('', 2);
|
||||
End;
|
||||
|
||||
Begin
|
||||
F := TBufFile.Create(SizeOf(RecProtocol));
|
||||
|
||||
F.Open (Config.DataPath + 'protocol.dat', fmOpenCreate, fmReadWrite + fmDenyNone, SizeOf(RecProtocol));
|
||||
|
||||
Box := TAnsiMenuBox.Create;
|
||||
List := TAnsiMenuList.Create;
|
||||
|
||||
Box.Header := ' Protocol Editor ';
|
||||
List.NoWindow := True;
|
||||
List.LoChars := #01#04#13#27;
|
||||
|
||||
Box.Open (13, 5, 67, 20);
|
||||
|
||||
WriteXY (15, 6, 112, 'Active OSID Batch Key Description');
|
||||
WriteXY (15, 7, 112, strRep('Ä', 51));
|
||||
WriteXY (15, 18, 112, strRep('Ä', 51));
|
||||
WriteXY (18, 19, 112, '(CTRL/A) Add (CTRL/D) Delete (ENTER) Edit');
|
||||
|
||||
Repeat
|
||||
MakeList;
|
||||
|
||||
List.Open (13, 7, 67, 18);
|
||||
List.Close;
|
||||
|
||||
Case List.ExitCode of
|
||||
#04 : If List.Picked < List.ListMax Then
|
||||
If ShowMsgBox(1, 'Delete this entry?') Then Begin
|
||||
F.RecordDelete (List.Picked);
|
||||
MakeList;
|
||||
End;
|
||||
#01 : Begin
|
||||
F.RecordInsert (List.Picked);
|
||||
|
||||
Prot.OSType := OSType;
|
||||
Prot.Desc := 'New protocol';
|
||||
Prot.Key := '!';
|
||||
Prot.Active := False;
|
||||
Prot.Batch := False;
|
||||
Prot.SendCmd := '';
|
||||
Prot.RecvCmd := '';
|
||||
|
||||
F.Write (Prot);
|
||||
|
||||
MakeList;
|
||||
End;
|
||||
#13 : If List.Picked <> List.ListMax Then Begin
|
||||
F.Seek (List.Picked - 1);
|
||||
F.Read (Prot);
|
||||
|
||||
EditProtocol(Prot);
|
||||
|
||||
F.Seek (List.Picked - 1);
|
||||
F.Write (Prot);
|
||||
End;
|
||||
#27 : Break;
|
||||
End;
|
||||
Until False;
|
||||
|
||||
F.Close;
|
||||
F.Free;
|
||||
|
||||
Box.Close;
|
||||
List.Free;
|
||||
Box.Free;
|
||||
End;
|
||||
|
||||
End.
|
||||
107
mystic/bbs_cfg_seclevel.pas
Normal file
107
mystic/bbs_cfg_seclevel.pas
Normal file
|
|
@ -0,0 +1,107 @@
|
|||
Unit bbs_cfg_SecLevel;
|
||||
|
||||
{$I M_OPS.PAS}
|
||||
|
||||
Interface
|
||||
|
||||
Procedure Levels_Editor;
|
||||
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
m_Strings,
|
||||
bbs_Common,
|
||||
bbs_Core,
|
||||
bbs_User;
|
||||
|
||||
Procedure Levels_Editor;
|
||||
Var
|
||||
A : Integer;
|
||||
Old : RecSecurity;
|
||||
Begin
|
||||
Session.SystemLog('*LEVEL EDITOR*');
|
||||
|
||||
Old := Session.User.Security;
|
||||
|
||||
Reset (Session.User.SecurityFile);
|
||||
Read (Session.User.SecurityFile, Session.User.Security);
|
||||
Repeat
|
||||
Session.io.OutFullLn ('|CL|14Security Level ' + strI2S(FilePos(Session.User.SecurityFile)) + ' of 255|CR|03');
|
||||
Session.io.OutRawLn ('A. Description : ' + Session.User.Security.Desc);
|
||||
Session.io.OutRawLn ('B. Time allowed/day : ' + strI2S(Session.User.Security.Time));
|
||||
Session.io.OutRawLn ('C. Max calls/day : ' + strI2S(Session.User.Security.MaxCalls));
|
||||
Session.io.OutRawLn ('D. Max downloads/day : ' + strI2S(Session.User.Security.MaxDLs));
|
||||
Session.io.OutRawLn ('E. Max download K/day : ' + strI2S(Session.User.Security.MaxDLk));
|
||||
Session.io.OutRawLn ('F. Max mins in time bank: ' + strI2S(Session.User.Security.MaxTB));
|
||||
|
||||
Session.io.OutRaw ('G. UL/DL ratio : ');
|
||||
If Session.User.Security.DLRatio = 0 Then
|
||||
Session.io.OutRawLn ('Disabled')
|
||||
Else
|
||||
Session.io.OutRawLn ('1 UL for every ' + strI2S(Session.User.Security.DLRatio) + ' DLs');
|
||||
|
||||
Session.io.OutRaw ('H. UL/DL Kb ratio : ');
|
||||
If Session.User.Security.DLKRatio = 0 Then
|
||||
Session.io.OutRawLn ('Disabled')
|
||||
Else
|
||||
Session.io.OutRawLn ('1 UL kb for every ' + strI2S(Session.User.Security.DLKRatio) + ' DL kb');
|
||||
|
||||
Session.io.OutRaw ('I. Post / Call Ratio : ');
|
||||
If Session.User.Security.PCRatio = 0 Then
|
||||
Session.io.OutRawLn ('Disabled')
|
||||
Else
|
||||
Session.io.OutRawLn (strI2S(Session.User.Security.PCRatio) + ' posts for every 100 calls');
|
||||
|
||||
Session.io.OutFullLn ('|CRK. Upgraded Flags Set 1 : ' + DrawAccessFlags(Session.User.Security.AF1));
|
||||
Session.io.OutFullLn ('L. Upgraded Flags Set 2 : ' + DrawAccessFlags(Session.User.Security.AF2));
|
||||
|
||||
Session.io.OutFullLn ('|CRM. Hard AF Upgrade : ' + Session.io.OutYN(Session.User.Security.Hard));
|
||||
|
||||
Session.io.OutRawLn ('N. Start Menu : ' + Session.User.Security.StartMeNU);
|
||||
|
||||
Session.io.OutFull ('|CR|09([) Previous, (]), Next, (J)ump, (Q)uit: ');
|
||||
Case Session.io.OneKey('[]ABCDEFGHIJKLMNQ', True) of
|
||||
'[' : If FilePos(Session.User.SecurityFile) > 1 Then Begin
|
||||
Seek (Session.User.SecurityFile, FilePos(Session.User.SecurityFile)-1);
|
||||
Write (Session.User.SecurityFile, Session.User.Security);
|
||||
Seek (Session.User.SecurityFile, FilePos(Session.User.SecurityFile)-2);
|
||||
Read (Session.User.SecurityFile, Session.User.Security);
|
||||
End;
|
||||
']' : If FilePos(Session.User.SecurityFile) < 255 Then Begin
|
||||
Seek (Session.User.SecurityFile, FilePos(Session.User.SecurityFile)-1);
|
||||
Write (Session.User.SecurityFile, Session.User.Security);
|
||||
Read (Session.User.SecurityFile, Session.User.Security);
|
||||
End;
|
||||
'A' : Session.User.Security.Desc := Session.io.InXY(27, 3, 30, 30, 11, Session.User.Security.Desc);
|
||||
'B' : Session.User.Security.Time := strS2I(Session.io.InXY(27, 4, 3, 3, 12, strI2S(Session.User.Security.Time)));
|
||||
'C' : Session.User.Security.MaxCalls := strS2I(Session.io.InXY(27, 5, 4, 4, 11, strI2S(Session.User.Security.MaxCalls)));
|
||||
'D' : Session.User.Security.MaxDLs := strS2I(Session.io.InXY(27, 6, 4, 4, 11, strI2S(Session.User.Security.MaxDLs)));
|
||||
'E' : Session.User.Security.MaxDLK := strS2I(Session.io.InXY(27, 7, 4, 4, 11, strI2S(Session.User.Security.MaxDLK)));
|
||||
'F' : Session.User.Security.MaxTB := strS2I(Session.io.InXY(27, 8, 4, 4, 11, strI2S(Session.User.Security.MaxTB)));
|
||||
'G' : Session.User.Security.DLRatio := strS2I(Session.io.InXY(27, 9, 2, 2, 12, strI2S(Session.User.Security.DLRatio)));
|
||||
'H' : Session.User.Security.DLKRatio := strS2I(Session.io.InXY(27, 10, 4, 4, 12, strI2S(Session.User.Security.DLKRatio)));
|
||||
'I' : Session.User.Security.PCRatio := strS2I(Session.io.InXY(27, 11, 4, 4, 12, strI2S(Session.User.Security.PCRatio)));
|
||||
'J' : Begin
|
||||
Session.io.OutRaw ('Jump to (1-255): ');
|
||||
A := strS2I(Session.io.GetInput(3, 3, 12, ''));
|
||||
If (A > 0) and (A < 256) Then Begin
|
||||
Seek (Session.User.SecurityFile, FilePos(Session.User.SecurityFile)-1);
|
||||
Write (Session.User.SecurityFile, Session.User.Security);
|
||||
Seek (Session.User.SecurityFile, A-1);
|
||||
Read (Session.User.SecurityFile, Session.User.Security);
|
||||
End;
|
||||
End;
|
||||
'K' : EditAccessFlags(Session.User.Security.AF1);
|
||||
'L' : EditAccessFlags(Session.User.Security.AF2);
|
||||
'M' : Session.User.Security.Hard := Not Session.User.Security.Hard;
|
||||
'N' : Session.User.Security.StartMenu := Session.io.InXY(27, 17, 8, 8, 11, Session.User.Security.startmenu);
|
||||
'Q' : Break;
|
||||
End;
|
||||
Until False;
|
||||
Seek (Session.User.SecurityFile, FilePos(Session.User.SecurityFile)-1);
|
||||
Write (Session.User.SecurityFile, Session.User.Security);
|
||||
Close (Session.User.SecurityFile);
|
||||
Session.User.Security := Old;
|
||||
End;
|
||||
|
||||
End.
|
||||
346
mystic/bbs_cfg_useredit.pas
Normal file
346
mystic/bbs_cfg_useredit.pas
Normal file
|
|
@ -0,0 +1,346 @@
|
|||
Unit bbs_cfg_UserEdit;
|
||||
|
||||
{$I M_OPS.PAS}
|
||||
|
||||
Interface
|
||||
|
||||
Uses
|
||||
m_Types,
|
||||
m_DateTime,
|
||||
m_Strings,
|
||||
bbs_Common,
|
||||
bbs_Core;
|
||||
|
||||
Procedure User_Editor (LocalEdit, OneUser : Boolean);
|
||||
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
bbs_User,
|
||||
bbs_NodeInfo,
|
||||
bbs_General;
|
||||
|
||||
Procedure User_Editor (LocalEdit, OneUser : Boolean);
|
||||
Const
|
||||
ModeTypeStr : Array[0..1] of String[8] = ('Standard', 'Lightbar');
|
||||
More : Boolean = False;
|
||||
Var
|
||||
ValidStr : String;
|
||||
UserNode : Word;
|
||||
LocalSave : Boolean;
|
||||
Image : TConsoleImageRec;
|
||||
Str : String;
|
||||
A : LongInt;
|
||||
Begin
|
||||
Reset (Session.User.UserFile);
|
||||
|
||||
If Eof(Session.User.UserFile) Then Begin
|
||||
Close (Session.User.UserFile);
|
||||
Exit;
|
||||
End;
|
||||
|
||||
Session.SystemLog ('*USER EDIT*');
|
||||
|
||||
Session.InUserEdit := True;
|
||||
|
||||
{$IFNDEF UNIX}
|
||||
If LocalEdit Then Begin
|
||||
Screen.GetScreenImage(1, 1, 80, 25, Image);
|
||||
LocalSave := Session.LocalMode;
|
||||
Session.LocalMode := True;
|
||||
Session.User.TempUser := Session.User.ThisUser;
|
||||
End;
|
||||
{$ENDIF}
|
||||
|
||||
If Not OneUser Then Begin
|
||||
Read (Session.User.UserFile, Session.User.TempUser);
|
||||
|
||||
If Session.User.UserNum = FilePos(Session.User.UserFile) Then
|
||||
Session.User.TempUser := Session.User.ThisUser;
|
||||
End;
|
||||
|
||||
Repeat
|
||||
UserNode := Is_User_Online(Session.User.TempUser.Handle);
|
||||
|
||||
Session.io.OutFull ('|16|CL|14User Editor: ' + strI2S(FilePos(Session.User.UserFile)) + ' of ' + strI2S(FileSize(Session.User.UserFile)) +
|
||||
' |03(Idx: ' + strI2S(Session.User.TempUser.PermIdx) + ')');
|
||||
|
||||
If UserNode > 0 Then
|
||||
Session.io.OutFull (' |10(On Node ' + strI2S(UserNode) + ')');
|
||||
|
||||
If LocalEdit Then
|
||||
Session.io.OutFullLn (' |12(Local Display)')
|
||||
Else
|
||||
Session.io.OutRawLn ('');
|
||||
|
||||
Session.io.OutFullLn ('|08|$D79Ä|03');
|
||||
|
||||
If More Then Begin
|
||||
Session.io.OutFullLn ('|12Additional settings for ' + Session.User.TempUser.Handle + ':|03|CR');
|
||||
|
||||
Session.io.OutRawLn ('A. Full NodeChat ' + Session.io.OutYN(Session.User.TempUser.UseFullChat));
|
||||
Session.io.OutRawLn ('B. Expires Date ' + Session.User.TempUser.Expires);
|
||||
Session.io.OutRawLn ('C. Expires To ' + strI2S(Session.User.TempUser.ExpiresTo));
|
||||
|
||||
For A := 1 to 10 Do Session.io.OutRawLn('');
|
||||
|
||||
Session.io.OutFullLn ('|10(1)|08|$D24Ä|10(2)|08|$D23Ä|10(3)|08|$D23Ä|03');
|
||||
|
||||
Session.io.OutRawLn ('Calls ' + strPadR(strI2S(Session.User.TempUser.Calls), 14, ' ') +
|
||||
'First Call ' + strPadR(DateDos2Str(Session.User.TempUser.FirstOn, Session.User.ThisUser.DateType), 14, ' ') +
|
||||
'Msg Posts ' + strI2S(Session.User.TempUser.Posts));
|
||||
Session.io.OutRawLn ('Calls Today ' + strPadR(strI2S(Session.User.TempUser.CallsToday), 14, ' ') +
|
||||
'Last Call ' + strPadR(DateDos2Str(Session.User.TempUser.LastOn, Session.User.ThisUser.DateType), 14, ' ') +
|
||||
'Sent Email ' + strI2S(Session.User.TempUser.Emails));
|
||||
Session.io.OutRawLn ('Downloads ' + strPadR(strI2S(Session.User.TempUser.DLs), 14, ' ') +
|
||||
'Download K ' + strPadR(strI2S(Session.User.TempUser.DLk), 14, ' ') +
|
||||
'Uploads ' + strI2S(Session.User.TempUser.ULs));
|
||||
Session.io.OutRawLn ('DLs Today ' + strPadR(strI2S(Session.User.TempUser.DLsToday), 14, ' ') +
|
||||
'DLk Today ' + strPadR(strI2S(Session.User.TempUser.DLkToday), 14, ' ') +
|
||||
'Upload KB ' + strI2S(Session.User.TempUser.ULk));
|
||||
|
||||
Session.io.OutFullLn ('|08|$D79Ä');
|
||||
Session.io.OutFull ('|09(Q)uit: ');
|
||||
|
||||
If UserNode > 0 Then
|
||||
ValidStr := 'Q'
|
||||
Else
|
||||
ValidStr := 'ABC123Q';
|
||||
|
||||
Case Session.io.OneKey(ValidStr, True) of
|
||||
'A' : Session.User.TempUser.UseFullChat := Not Session.User.TempUser.UseFullChat;
|
||||
'B' : Session.User.TempUser.Expires := Session.io.InXY(18, 6, 8, 8, 5, Session.User.TempUser.Expires);
|
||||
'C' : Session.User.TempUser.ExpiresTo := strS2I(Session.io.InXY(18, 7, 3, 3, 1, strI2S(Session.User.TempUser.ExpiresTo)));
|
||||
'Q' : More := False;
|
||||
'1' : Begin
|
||||
Session.User.TempUser.Calls := strS2I(Session.io.InXY(14, 17, 5, 5, 12, strI2S(Session.User.TempUser.Calls)));
|
||||
Session.User.TempUser.CallsToday := strS2I(Session.io.InXY(14, 18, 5, 5, 12, strI2S(Session.User.TempUser.CallsToday)));
|
||||
Session.User.TempUser.DLs := strS2I(Session.io.InXY(14, 19, 5, 5, 12, strI2S(Session.User.TempUser.DLs)));
|
||||
Session.User.TempUser.DLsToday := strS2I(Session.io.InXY(14, 20, 5, 5, 12, strI2S(Session.User.TempUser.DLsToday)));
|
||||
End;
|
||||
'2' : Begin
|
||||
Session.User.TempUser.FirstOn := DateStr2Dos(Session.io.InXY(40, 17, 8, 8, 15, DateDos2Str(Session.User.TempUser.FirstOn, Session.User.ThisUser.DateType)));
|
||||
Session.User.TempUser.LastOn := DateStr2Dos(Session.io.InXY(40, 18, 8, 8, 15, DateDos2Str(Session.User.TempUser.LastOn, Session.User.ThisUser.DateType)));
|
||||
Session.User.TempUser.DLK := strS2I(Session.io.InXY(40, 19, 10, 10, 12, strI2S(Session.User.TempUser.DLK)));
|
||||
Session.User.TempUser.DLKToday := strS2I(Session.io.InXY(40, 20, 10, 10, 12, strI2S(Session.User.TempUser.DLKToday)));
|
||||
End;
|
||||
'3' : Begin
|
||||
Session.User.TempUser.Posts := strS2I(Session.io.InXY(66, 17, 10, 10, 12, strI2S(Session.User.TempUser.Posts)));
|
||||
Session.User.TempUser.Emails := strS2I(Session.io.InXY(66, 18, 10, 10, 12, strI2S(Session.User.TempUser.Emails)));
|
||||
Session.User.TempUser.ULS := strS2I(Session.io.InXY(66, 19, 10, 10, 12, strI2S(Session.User.TempUser.ULS)));
|
||||
Session.User.TempUser.ULK := strS2I(Session.io.InXY(66, 20, 10, 10, 12, strI2S(Session.User.TempUser.ULK)));
|
||||
End;
|
||||
End;
|
||||
End Else Begin
|
||||
Session.io.OutRawLn ('A. Alias ' + strPadR(Session.User.TempUser.Handle, 32, ' ') +
|
||||
'V. Start Menu ' + Session.User.TempUser.StartMeNU);
|
||||
|
||||
Session.io.OutRawLn ('B. Real Name ' + strPadR(Session.User.TempUser.RealName, 32, ' ') +
|
||||
'W. Language ' + Session.User.TempUser.Theme);
|
||||
|
||||
Session.io.OutRawLn ('C. Address ' + strPadR(Session.User.TempUser.Address, 32, ' ') +
|
||||
'X. Hot Keys ' + Session.io.OutYN(Session.User.TempUser.HotKeys));
|
||||
|
||||
Session.io.OutRawLn ('D. City ' + strPadR(Session.User.TempUser.City, 32, ' ') +
|
||||
'Y. Date Type ' + DateTypeStr[Session.User.TempUser.DateType]);
|
||||
|
||||
Session.io.OutRawLn ('E. Zip Code ' + strPadR(Session.User.TempUser.ZipCode, 32, ' ') +
|
||||
'Z. FList Type ' + ModeTypeStr[Session.User.TempUser.FileList]);
|
||||
|
||||
Session.io.OutRaw ('F. Birthdate ' + DateJulian2Str(Session.User.TempUser.Birthday, Session.User.ThisUser.DateType) +
|
||||
' - Age ' + strPadR(strI2S(DaysAgo(Session.User.TempUser.Birthday) DIV 365), 17, ' ') +
|
||||
'1. Msg Editor ');
|
||||
|
||||
Case Session.User.TempUser.EditType of
|
||||
0 : Session.io.OutRawLn ('Line');
|
||||
1 : Session.io.OutRawLn ('Full');
|
||||
2 : Session.io.OutRawLn ('Ask');
|
||||
End;
|
||||
|
||||
Session.io.OutRawLn ('G. Gender ' + strPadR(Session.User.TempUser.Gender, 32, ' ') +
|
||||
'2. Msg Quote ' + ModeTypeStr[Ord(Session.User.TempUser.UseLBQuote)]);
|
||||
|
||||
Session.io.OutRawLn ('H. Home Phone ' + strPadR(Session.User.TempUser.HomePhone, 32, ' ') +
|
||||
'3. Msg Reader ' + ModeTypeStr[Session.User.TempUser.MReadType]);
|
||||
|
||||
Session.io.OutRawLn ('I. Data Phone ' + strPadR(Session.User.TempUser.DataPhone, 32, ' ') +
|
||||
'4. Index ' + Session.io.OutYN(Session.User.TempUser.UseLBIndex));
|
||||
|
||||
Session.io.OutRawLn ('J. E-mail ' + strPadR(Session.User.TempUser.Email, 32, ' ') +
|
||||
'5. Mail Index ' + Session.io.OutYN(Session.User.TempUser.UseLBMIdx));
|
||||
|
||||
Session.io.OutRawLn ('K. ' + strPadL(Config.OptionalField[1].Desc, 10, ' ') + ' ' + strPadR(Session.User.TempUser.Optional[1], 32, ' ') +
|
||||
'6. Time Left ' + strI2S(Session.User.TempUser.TimeLeft));
|
||||
|
||||
Session.io.OutRawLn ('L. ' + strPadL(Config.OptionalField[2].Desc, 10, ' ') + ' ' + strPadR(Session.User.TempUser.Optional[2], 32, ' ') +
|
||||
'7. Time Bank ' + strI2S(Session.User.TempUser.TimeBank));
|
||||
|
||||
Session.io.OutRawLn ('N. ' + strPadL(Config.OptionalField[3].Desc, 10, ' ') + ' ' + strPadR(Session.User.TempUser.Optional[3], 32, ' ') +
|
||||
'8. Screen Size ' + strI2S(Session.User.TempUser.ScreenSize));
|
||||
|
||||
Session.io.OutRawLn ('O. User Note ' + strPadR(Session.User.TempUser.UserInfo, 32, ' ') +
|
||||
'!. Ignore LC ' + Session.io.OutYN(Session.User.TempUser.Flags AND UserNoCaller <> 0));
|
||||
|
||||
Session.io.OutRawLn ('P. Security ' + strPadR(strI2S(Session.User.TempUser.Security), 36, ' ') +
|
||||
'Locked out ' + Session.io.OutYN(Session.User.TempUser.Flags AND UserLockedOut <> 0));
|
||||
|
||||
Session.io.OutRawLn ('R. Password ' + strPadR(strRep('*', Length(Session.User.TempUser.Password)), 39, ' ') +
|
||||
'Deleted ' + Session.io.OutYN(Session.User.TempUser.Flags AND UserDeleted <> 0));
|
||||
|
||||
Session.io.OutRawLn ('S. Flags #1 ' + DrawAccessFlags(Session.User.TempUser.AF1) + ' ' +
|
||||
'No Delete ' + Session.io.OutYN(Session.User.TempUser.Flags AND UserNoKill <> 0));
|
||||
|
||||
Session.io.OutRawLn ('T. Flags #2 ' + DrawAccessFlags(Session.User.TempUser.AF2) + ' ' +
|
||||
'No Ratios ' + Session.io.OutYN(Session.User.TempUser.Flags AND UserNoRatio <> 0));
|
||||
|
||||
Session.io.OutFullLn ('|08|$D79Ä');
|
||||
Session.io.OutFull ('|09([) Prev, (]) Next, (U)pgrade, (*) Search, (M)ore, (Q)uit: ');
|
||||
|
||||
If UserNode > 0 Then
|
||||
ValidStr := '[]*Q'
|
||||
Else
|
||||
ValidStr := '[]*ABCDEFGHIJKLMNOPQRSTUVWXYZ12345678!';
|
||||
|
||||
Case Session.io.OneKey(ValidStr, True) of
|
||||
'A' : Session.User.TempUser.Handle := Session.io.InXY(16, 3, 30, 30, 18, Session.User.TempUser.Handle);
|
||||
'B' : Session.User.TempUser.RealName := Session.io.InXY(16, 4, 30, 30, 18, Session.User.TempUser.RealName);
|
||||
'C' : Session.User.TempUser.Address := Session.io.InXY(16, 5, 30, 30, 18, Session.User.TempUser.Address);
|
||||
'D' : Session.User.TempUser.City := Session.io.InXY(16, 6, 25, 25, 18, Session.User.TempUser.City);
|
||||
'E' : Session.User.TempUser.ZipCode := Session.io.InXY(16, 7, 9, 9, 12, Session.User.TempUser.ZipCode);
|
||||
'F' : Session.User.TempUser.Birthday := DateStr2Julian(Session.io.InXY (16, 8, 8, 8, 15, DateJulian2Str(Session.User.TempUser.Birthday, Session.User.ThisUser.DateType)));
|
||||
'G' : If Session.User.TempUser.Gender = 'M' Then Session.User.TempUser.Gender := 'F' Else Session.User.TempUser.Gender := 'M';
|
||||
'H' : Session.User.TempUser.HomePhone := Session.io.InXY (16, 10, 15, 15, 12, Session.User.TempUser.HomePhone);
|
||||
'I' : Session.User.TempUser.DataPhone := Session.io.InXY (16, 11, 15, 15, 12, Session.User.TempUser.DataPhone);
|
||||
'J' : Session.User.TempUser.Email := Session.io.InXY (16, 12, 30, 35, 11, Session.User.TempUser.Email);
|
||||
'K' : Session.User.TempUser.Optional[1] := Session.io.InXY (16, 13, 30, 35, 11, Session.User.TempUser.Optional[1]);
|
||||
'L' : Session.User.TempUser.Optional[2] := Session.io.InXY (16, 14, 30, 35, 11, Session.User.TempUser.Optional[2]);
|
||||
'N' : Session.User.TempUser.Optional[3] := Session.io.InXY (16, 15, 30, 35, 11, Session.User.TempUser.Optional[3]);
|
||||
'O' : Session.User.TempUser.UserInfo := Session.io.InXY (16, 16, 30, 30, 11, Session.User.TempUser.UserInfo);
|
||||
'P' : Begin
|
||||
Session.User.TempUser.Security := strS2I(Session.io.InXY(16, 17, 3, 3, 12, strI2S(Session.User.TempUser.Security)));
|
||||
If (Session.User.TempUser.Security > 255) or (Session.User.TempUser.Security < 0) Then Session.User.TempUser.Security := 0;
|
||||
End;
|
||||
'R' : Session.User.TempUser.Password := Session.io.InXY (16, 18, 15, 15, 12, Session.User.TempUser.Password);
|
||||
'S' : EditAccessFlags(Session.User.TempUser.AF1);
|
||||
'T' : EditAccessFlags(Session.User.TempUser.AF2);
|
||||
'V' : Session.User.TempUser.StartMeNU := Session.io.InXY (64, 3, 8, 8, 11, Session.User.TempUser.StartMeNU);
|
||||
'W' : Session.User.TempUser.Theme := Session.io.InXY (64, 4, 8, 8, 11, Session.User.TempUser.Theme);
|
||||
'X' : Session.User.TempUser.HotKeys := Not Session.User.TempUser.HotKeys;
|
||||
'Y' : If Session.User.TempUser.DateType < 3 Then Inc (Session.User.TempUser.DateType) Else Session.User.TempUser.DateType := 1;
|
||||
'Z' : Session.User.TempUser.FileList := Ord(Not Boolean(Session.User.TempUser.FileList));
|
||||
'1' : If Session.User.TempUser.EditType < 2 Then Inc (Session.User.TempUser.EditType) Else Session.User.TempUser.EditType := 0;
|
||||
'2' : Session.User.TempUser.UseLBQuote := Not Session.User.TempUser.UseLBQuote;
|
||||
'3' : Session.User.TempUser.MReadType := Ord(Not Boolean(Session.User.TempUser.MReadType));
|
||||
'4' : Session.User.TempUser.UseLBIndex := Not Session.User.TempUser.UseLBIndex;
|
||||
'5' : Session.User.TempUser.UseLBMIdx := Not Session.User.TempUser.UseLBMIdx;
|
||||
'6' : Begin
|
||||
Session.User.TempUser.TimeLeft := strS2I(Session.io.InXY(64, 13, 3, 3, 12, strI2S(Session.User.TempUser.TimeLeft)));
|
||||
If OneUser or (Session.User.UserNum = FilePos(Session.User.UserFile)) Then
|
||||
Session.SetTimeLeft(Session.User.TempUser.TimeLeft);
|
||||
End;
|
||||
'7' : Session.User.TempUser.TimeBank := strS2I(Session.io.InXY(64, 14, 3, 3, 12, strI2S(Session.User.TempUser.TimeBank)));
|
||||
'8' : Session.User.TempUser.ScreenSize := strS2I(Session.io.InXY(64, 15, 2, 2, 12, strI2S(Session.User.TempUser.ScreenSize)));
|
||||
'!' : Begin
|
||||
Session.io.OutRaw ('(C)aller, (D)elete, (I)gnore Ratios, (L)ockOut, (N)oKill, (Q)uit: ');
|
||||
Case Session.io.OneKey('CDILNQ', True) of
|
||||
'C' : Session.User.TempUser.Flags := Session.User.TempUser.Flags XOR UserNoCaller;
|
||||
'D' : Session.User.TempUser.Flags := Session.User.TempUser.Flags XOR UserDeleted;
|
||||
'I' : Session.User.TempUser.Flags := Session.User.TempUser.Flags XOR UserNoRatio;
|
||||
'L' : Session.User.TempUser.Flags := Session.User.TempUser.Flags XOR UserLockedOut;
|
||||
'N' : Session.User.TempUser.Flags := Session.User.TempUser.Flags XOR UserNoKill;
|
||||
End;
|
||||
End;
|
||||
'[' : If Not OneUser Then Begin
|
||||
|
||||
If Session.User.UserNum = FilePos(Session.User.UserFile) Then
|
||||
Session.User.ThisUser := Session.User.TempUser;
|
||||
|
||||
Seek (Session.User.UserFile, Pred(FilePos(Session.User.UserFile)));
|
||||
Write (Session.User.UserFile, Session.User.TempUser);
|
||||
|
||||
If FilePos(Session.User.UserFile) > 1 Then Begin
|
||||
Seek (Session.User.UserFile, FilePos(Session.User.UserFile)-2);
|
||||
Read (Session.User.UserFile, Session.User.TempUser);
|
||||
End Else Begin
|
||||
Seek (Session.User.UserFile, FileSize(Session.User.UserFile) - 1);
|
||||
Read (Session.User.UserFile, Session.User.TempUser);
|
||||
End;
|
||||
End;
|
||||
']' : If Not OneUser Then Begin
|
||||
If Session.User.UserNum = FilePos(Session.User.UserFile) Then
|
||||
Session.User.ThisUser := Session.User.TempUser;
|
||||
|
||||
Seek (Session.User.UserFile, Pred(FilePos(Session.User.UserFile)));
|
||||
Write (Session.User.UserFile, Session.User.TempUser);
|
||||
If Eof(Session.User.UserFile) Then Reset(Session.User.UserFile);
|
||||
Read (Session.User.UserFile, Session.User.TempUser);
|
||||
End;
|
||||
'*' : If Not OneUser Then Begin
|
||||
Session.io.OutFull ('User name / number: ');
|
||||
Str := Session.io.GetInput(30, 30, 12, '');
|
||||
|
||||
If Session.User.UserNum = FilePos(Session.User.UserFile) Then
|
||||
Session.User.ThisUser := Session.User.TempUser;
|
||||
|
||||
A := FilePos(Session.User.UserFile) - 1;
|
||||
Seek (Session.User.UserFile, A);
|
||||
Write (Session.User.UserFile, Session.User.TempUser);
|
||||
|
||||
If (strS2I(Str) > 0) and (strS2I(Str) < FileSize(Session.User.UserFile)) Then
|
||||
A := strS2I(Str) - 1
|
||||
Else Begin
|
||||
Reset (Session.User.UserFile);
|
||||
While Not Eof(Session.User.UserFile) Do Begin
|
||||
Read (Session.User.UserFile, Session.User.TempUser);
|
||||
If (Pos(Str, strUpper(Session.User.TempUser.Handle)) > 0) or (Pos(Str, strUpper(Session.User.TempUser.RealName)) > 0) Then Begin
|
||||
Session.io.PromptInfo[1] := Session.User.TempUser.Handle;
|
||||
If Session.io.GetYN(Session.GetPrompt(155), True) Then Begin
|
||||
A := FilePos(Session.User.UserFile) - 1;
|
||||
Break;
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
|
||||
Seek (Session.User.UserFile, A);
|
||||
Read (Session.User.UserFile, Session.User.TempUser);
|
||||
End;
|
||||
'M' : More := True;
|
||||
'Q' : Break;
|
||||
'U' : Begin
|
||||
Session.io.OutFull ('|CR|09Upgrade to level (0-255): ');
|
||||
A := strS2I(Session.io.GetInput(3, 3, 12, strI2S(Session.User.TempUser.Security)));
|
||||
If (A > 255) or (A <= 0) Then A := 1;
|
||||
Upgrade_User_Level(False, Session.User.TempUser, A);
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
|
||||
Until False;
|
||||
|
||||
If Not OneUser Then Begin
|
||||
If Session.User.UserNum = FilePos(Session.User.UserFile) Then
|
||||
Session.User.ThisUser := Session.User.TempUser;
|
||||
|
||||
Seek (Session.User.UserFile, Pred(FilePos(Session.User.UserFile)));
|
||||
Write (Session.User.UserFile, Session.User.TempUser);
|
||||
End;
|
||||
|
||||
{$IFNDEF UNIX}
|
||||
If LocalEdit Then Begin
|
||||
Session.LocalMode := LocalSave;
|
||||
Session.User.ThisUser := Session.User.TempUser;
|
||||
|
||||
Screen.PutScreenImage(Image);
|
||||
|
||||
Session.SetTimeLeft (Session.User.TempUser.TimeLeft);
|
||||
Update_Status_Line (StatusPtr, '');
|
||||
End;
|
||||
{$ENDIF}
|
||||
|
||||
Close (Session.User.UserFile);
|
||||
|
||||
Session.InUserEdit := False;
|
||||
End;
|
||||
|
||||
End.
|
||||
144
mystic/bbs_cfg_vote.pas
Normal file
144
mystic/bbs_cfg_vote.pas
Normal file
|
|
@ -0,0 +1,144 @@
|
|||
Unit bbs_cfg_Vote;
|
||||
|
||||
{$I M_OPS.PAS}
|
||||
|
||||
Interface
|
||||
|
||||
Procedure Vote_Editor;
|
||||
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
m_Strings,
|
||||
bbs_Common,
|
||||
bbs_Core,
|
||||
bbs_User;
|
||||
|
||||
Procedure Vote_Editor;
|
||||
var
|
||||
A,
|
||||
B : Integer;
|
||||
C : Byte;
|
||||
Temp : String[2];
|
||||
Begin
|
||||
Session.SystemLog ('*VOTE EDITOR*');
|
||||
Repeat
|
||||
Session.io.OutFullLn ('|CL|14Voting Booth Editor|CR|CR|15## Question|CR|09-- ---------------------------------------');
|
||||
Reset (VoteFile);
|
||||
While Not Eof(VoteFile) do begin
|
||||
Read (VoteFile, Vote);
|
||||
Session.io.OutFullLn ('|15' + strPadR(strI2S(filepos(VoteFile)), 4, ' ') + '|14' + Vote.Question);
|
||||
End;
|
||||
Session.io.OutFull ('|CR|09(A)dd, (D)elete, (E)dit, (Q)uit? ');
|
||||
case Session.io.OneKey ('ADEQ', True) of
|
||||
'A' : If FileSize(VoteFile) = mysMaxVoteQuestion Then
|
||||
Session.io.OutFullLn ('|CR|14Max # of questions is ' + strI2S(mysMaxVoteQuestion))
|
||||
Else Begin
|
||||
Vote.Votes := 0;
|
||||
Vote.AnsNum := 1;
|
||||
Vote.ACS := 's999';
|
||||
Vote.AddACS := 's999';
|
||||
Vote.ForceACS := 's999';
|
||||
Vote.Question := 'New Question';
|
||||
Vote.Answer[1].Text := 'New voting answer';
|
||||
Vote.Answer[1].Votes := 0;
|
||||
Seek (VoteFile, FileSize(VoteFile));
|
||||
Write (VoteFile, Vote);
|
||||
End;
|
||||
'D' : begin
|
||||
Session.io.OutRaw ('Delete which? ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
If (A > 0) And (A <= FileSize(VoteFile)) Then Begin
|
||||
Session.io.OutFullLn ('|CRDeleting...');
|
||||
KillRecord (VoteFile, A, SizeOf(VoteRec));
|
||||
|
||||
Reset (Session.User.UserFile);
|
||||
While Not Eof(Session.User.UserFile) Do Begin
|
||||
Read (Session.User.UserFile, Session.User.TempUser);
|
||||
For C := A To 19 Do
|
||||
Session.User.TempUser.Vote[C] := Session.User.TempUser.Vote[C+1];
|
||||
Session.User.TempUser.Vote[20] := 0;
|
||||
Seek (Session.User.UserFile, FilePos(Session.User.UserFile) - 1);
|
||||
Write (Session.User.UserFile, Session.User.TempUser);
|
||||
End;
|
||||
Close (Session.User.UserFile);
|
||||
For C := A to 19 Do
|
||||
Session.User.ThisUser.Vote[C] := Session.User.ThisUser.Vote[C+1];
|
||||
Session.User.ThisUser.Vote[20] := 0;
|
||||
End;
|
||||
end;
|
||||
'E' : begin
|
||||
Session.io.OutRaw ('Edit which? ');
|
||||
a := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
if (a > 0) and (a <= filesize(VoteFile)) then begin
|
||||
seek (VoteFile, a-1);
|
||||
read (VoteFile, Vote);
|
||||
repeat
|
||||
Session.io.OutFullLn ('|CL|14Question ' + strI2S(FilePos(VoteFile)) + ' of ' + strI2S(FileSize(VoteFile)) + '|CR|03');
|
||||
Session.io.OutRawln ('A. Question : ' + strPadR(Vote.Question, 60, ' '));
|
||||
Session.io.OutRawLn ('B. Votes : ' + strI2S(Vote.Votes));
|
||||
Session.io.OutRawLn ('C. Vote ACS : ' + Vote.ACS);
|
||||
Session.io.OutRawLn ('E. Add ACS : ' + Vote.AddACS);
|
||||
Session.io.OutRawLn ('F. Forced ACS : ' + Vote.ForceACS);
|
||||
Session.io.OutFullLn ('|CR|15## Answer ## Answer');
|
||||
Session.io.OutFullLn ('|09-- ----------------------------------- -- ------------------------------------');
|
||||
For B := 1 to Vote.AnsNum Do Begin
|
||||
Session.io.OutFull ('|11' + strZero(B) + ' |14' + strPadR(Vote.Answer[B].Text, 35, ' ') + ' ');
|
||||
If (B Mod 2 = 0) or (B = Vote.AnsNum) Then Session.io.OutRawLn ('');
|
||||
End;
|
||||
Session.io.OutFull ('|CR|09(D)elete, (I)nsert, (Q)uit: ');
|
||||
Temp := Session.io.GetInput(2, 2, 12, '');
|
||||
If Temp = 'A' Then Vote.Question := Session.io.InXY(17, 3, 60, 70, 11, Vote.Question) Else
|
||||
If Temp = 'B' Then Vote.Votes := strS2I(Session.io.InXY(17, 4, 5, 5, 12, strI2S(Vote.Votes))) Else
|
||||
If Temp = 'C' Then Vote.ACS := Session.io.InXY(17, 5, 20, 20, 11, Vote.ACS) Else
|
||||
If Temp = 'D' Then Begin
|
||||
Session.io.OutFull ('Delete which answer? ');
|
||||
A := strS2I(Session.io.GetInput(2, 2, 12, ''));
|
||||
If (A > 0) and (A <= Vote.AnsNum) Then Begin
|
||||
For C := A to Vote.AnsNum-1 Do
|
||||
Vote.Answer[C] := Vote.Answer[C+1];
|
||||
Dec (Vote.AnsNum);
|
||||
|
||||
Reset (Session.User.UserFile);
|
||||
While Not Eof(Session.User.UserFile) Do Begin
|
||||
Read (Session.User.UserFile, Session.User.TempUser);
|
||||
If Session.User.TempUser.Vote[FilePos(VoteFile)] = A Then Begin
|
||||
Session.User.TempUser.Vote[FilePos(VoteFile)] := 0;
|
||||
Seek (Session.User.UserFile, FilePos(Session.User.UserFile) - 1);
|
||||
Write (Session.User.UserFile, Session.User.TempUser);
|
||||
End;
|
||||
End;
|
||||
Close (Session.User.UserFile);
|
||||
If Session.User.ThisUser.Vote[FilePos(VoteFile)] = A Then
|
||||
Session.User.ThisUser.Vote[FilePos(VoteFile)] := 0;
|
||||
End;
|
||||
End Else
|
||||
If Temp = 'E' Then Vote.AddACS := Session.io.InXY(17, 6, 20, 20, 11, Vote.AddACS) Else
|
||||
If Temp = 'F' Then Vote.ForceACS := Session.io.InXY(17, 7, 20, 20, 11, Vote.ForceACS) Else
|
||||
If (Temp = 'I') and (Vote.AnsNum < 15) Then Begin
|
||||
Inc (Vote.AnsNum);
|
||||
Vote.Answer[Vote.AnsNum].Text := '';
|
||||
Vote.Answer[Vote.AnsNum].Votes := 0;
|
||||
End Else
|
||||
If Temp = 'Q' Then Break Else Begin
|
||||
A := strS2I(Temp);
|
||||
If (A > 0) and (A < 21) Then Begin
|
||||
Session.io.OutRaw ('Answer: ');
|
||||
Vote.Answer[A].Text := Session.io.GetInput (40, 40, 11, Vote.Answer[A].Text);
|
||||
Session.io.OutRaw ('Votes : ');
|
||||
Vote.Answer[A].Votes := strS2I(Session.io.GetInput(5, 5, 12, strI2S(Vote.Answer[A].Votes)));
|
||||
End;
|
||||
End;
|
||||
until false;
|
||||
seek (VoteFile, filepos(VoteFile)-1);
|
||||
write (VoteFile, Vote);
|
||||
end;
|
||||
end;
|
||||
'Q' : break;
|
||||
end;
|
||||
|
||||
until False;
|
||||
close (VoteFile);
|
||||
End;
|
||||
|
||||
End.
|
||||
514
mystic/bbs_common.pas
Normal file
514
mystic/bbs_common.pas
Normal file
|
|
@ -0,0 +1,514 @@
|
|||
Unit bbs_Common;
|
||||
|
||||
{$I M_OPS.PAS}
|
||||
|
||||
Interface
|
||||
|
||||
Uses
|
||||
{$IFDEF UNIX}
|
||||
Unix,
|
||||
{$ENDIF}
|
||||
m_Types,
|
||||
m_Strings,
|
||||
m_Output,
|
||||
m_Input,
|
||||
m_DateTime,
|
||||
m_FileIO,
|
||||
m_Socket_Class;
|
||||
|
||||
{$I RECORDS.PAS}
|
||||
|
||||
// This unit is very old (like 1994) and its functions need to be phased out
|
||||
// This is the stuff that hasn't been worked into a class somewhere or
|
||||
// replace with MDL/FP RTL functions
|
||||
|
||||
Const
|
||||
WinConsoleTitle = 'Mystic Node ';
|
||||
{$IFDEF UNIX}
|
||||
FileMask = '*';
|
||||
{$ELSE}
|
||||
FileMask = '*.*';
|
||||
{$ENDIF}
|
||||
CopyID = 'Copyright (C) 1997-2012 By James Coyle. All Rights Reserved.';
|
||||
DateTypeStr : Array[1..4] of String[8] = ('MM/DD/YY', 'DD/MM/YY', 'YY/DD/MM', 'Ask ');
|
||||
GetKeyFunc : Function (Forced : Boolean) : Boolean = NIL;
|
||||
|
||||
Var
|
||||
Screen : TOutput;
|
||||
Input : TInput;
|
||||
// input will be gone, client and screen will be passed.
|
||||
|
||||
CurRoom : Byte;
|
||||
NodeMsgFile : File of NodeMsgRec;
|
||||
NodeMsg : NodeMsgRec;
|
||||
ConfigFile : File of RecConfig;
|
||||
ChatFile : File of ChatRec;
|
||||
RoomFile : File of RoomRec;
|
||||
VoteFile : File of VoteRec;
|
||||
Vote : VoteRec;
|
||||
Chat : ChatRec;
|
||||
Room : RoomRec;
|
||||
LastOnFile : File of LastOnRec;
|
||||
LastOn : LastOnRec;
|
||||
Config : RecConfig;
|
||||
StatusPtr : Byte = 1;
|
||||
|
||||
Procedure EditAccessFlags (Var Flags : AccessFlagType);
|
||||
Function DrawAccessFlags (Var Flags : AccessFlagType) : String;
|
||||
Function NoGetKeyFunc (Forced : Boolean) : Boolean;
|
||||
Function getColor (A: Byte) : Byte;
|
||||
Procedure KillRecord (var dFile; RecNum: LongInt; RecSize: Word);
|
||||
Procedure AddRecord (var dFile; RecNum: LongInt; RecSize: Word);
|
||||
Function Bool_Search (Mask: String; Str: String) : Boolean;
|
||||
Function strAddr2Str (Addr: RecEchoMailAddr) : String;
|
||||
Function strStr2Addr (S : String; Var Addr: RecEchoMailAddr) : Boolean;
|
||||
Procedure CleanDirectory (Path: String; Exempt: String);
|
||||
Function ChangeDir (Dir : String) : Boolean;
|
||||
Function CopyFile (Source, Target : String): Boolean;
|
||||
Function CheckPath (Str: String) : String;
|
||||
Function ShellDOS (ExecPath: String; Command: String) : LongInt;
|
||||
|
||||
{$IFNDEF UNIX}
|
||||
Procedure Update_Status_Line (Mode: Byte; Str: String);
|
||||
Procedure Process_Sysop_Cmd (Cmd: Char);
|
||||
{$ENDIF}
|
||||
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
DOS,
|
||||
bbs_Core,
|
||||
{$IFNDEF UNIX}
|
||||
bbs_SysOpChat,
|
||||
{$ENDIF}
|
||||
bbs_cfg_UserEdit,
|
||||
bbs_General,
|
||||
MPL_Execute;
|
||||
|
||||
Function DrawAccessFlags (Var Flags : AccessFlagType) : String;
|
||||
Var
|
||||
S : String;
|
||||
Ch : Char;
|
||||
Begin
|
||||
S := '';
|
||||
|
||||
For Ch := 'A' to 'Z' Do
|
||||
If Ord(Ch) - 64 in Flags Then S := S + Ch Else S := S + '-';
|
||||
|
||||
DrawAccessFlags := S;
|
||||
End;
|
||||
|
||||
Procedure EditAccessFlags (Var Flags : AccessFlagType);
|
||||
Var
|
||||
Ch : Char;
|
||||
Begin
|
||||
Repeat
|
||||
Session.io.OutFull ('Toggle: [' + DrawAccessFlags(Flags) + '] (Enter/Done): ');
|
||||
|
||||
Ch := Session.io.OneKey('ABCDEFGHIJKLMNOPQRSTUVWXYZ'#13, True);
|
||||
|
||||
If Ch = #13 Then Break;
|
||||
|
||||
If Ord(Ch) - 64 in Flags Then
|
||||
Flags := Flags - [Ord(Ch) - 64]
|
||||
Else
|
||||
Flags := Flags + [Ord(Ch) - 64];
|
||||
Until False;
|
||||
End;
|
||||
|
||||
Function GetColor (A: Byte) : Byte;
|
||||
{ Used by SYSOPx.PAS files only }
|
||||
Var
|
||||
FG,
|
||||
BG : Byte;
|
||||
Begin
|
||||
Session.io.OutFull ('|CRFG Color: ');
|
||||
FG := strS2I(Session.io.GetInput(2, 2, 12, strI2S(A AND $F)));
|
||||
Session.io.OutFull ('BG Color: ');
|
||||
BG := strS2I(Session.io.GetInput(2, 2, 12, strI2S((A SHR 4) AND 7)));
|
||||
getColor := FG + BG * 16;
|
||||
End;
|
||||
|
||||
Procedure AddRecord (var dFile; RecNum: LongInt; RecSize: Word);
|
||||
Var
|
||||
F : File Absolute dFile;
|
||||
A : LongInt;
|
||||
Buffer : Pointer;
|
||||
Begin
|
||||
If (RecNum < 1) or (RecNum > FileSize(F) + 1) Then Exit;
|
||||
|
||||
GetMem (Buffer, RecSize);
|
||||
|
||||
Dec (RecNum);
|
||||
|
||||
For A := FileSize(F) - 1 DownTo RecNum Do Begin
|
||||
Seek (F, A);
|
||||
BlockRead (F, Buffer^, 1);
|
||||
BlockWrite (F, Buffer^, 1);
|
||||
End;
|
||||
|
||||
Seek (F, RecNum);
|
||||
|
||||
FreeMem (Buffer, RecSize);
|
||||
End;
|
||||
|
||||
Procedure KillRecord (var dFile; RecNum: LongInt; RecSize: Word);
|
||||
Var
|
||||
F : File Absolute dFile;
|
||||
Count : LongInt;
|
||||
Buffer : Pointer;
|
||||
Begin
|
||||
If (RecNum < 1) or (RecNum > FileSize(F)) Then Exit;
|
||||
|
||||
GetMem (Buffer, RecSize);
|
||||
|
||||
Dec (RecNum);
|
||||
|
||||
For Count := RecNum to FileSize(F) - 2 Do Begin
|
||||
Seek (F, Count + 1);
|
||||
BlockRead (F, Buffer^, 1);
|
||||
Seek (F, Count);
|
||||
BlockWrite (F, Buffer^, 1);
|
||||
End;
|
||||
|
||||
Seek (F, FileSize(F) - 1);
|
||||
Truncate (F);
|
||||
|
||||
FreeMem (Buffer, RecSize);
|
||||
End;
|
||||
|
||||
Function Bool_Search (Mask: String; Str: String) : Boolean;
|
||||
{ place holder for this functionality someday... need to pass in a buffer }
|
||||
{ to search }
|
||||
Begin
|
||||
Bool_Search := True;
|
||||
If Mask = '' Then Exit;
|
||||
Bool_Search := Pos(strUpper(Mask), strUpper(Str)) > 0;
|
||||
End;
|
||||
|
||||
Function strStr2Addr (S : String; Var Addr: RecEchoMailAddr) : Boolean;
|
||||
{ converts address string to type. returns false is invalid string }
|
||||
Var
|
||||
A : Byte;
|
||||
B : Byte;
|
||||
C : Byte;
|
||||
Point : Boolean;
|
||||
Begin
|
||||
Result := False;
|
||||
Point := True;
|
||||
|
||||
A := Pos(':', S);
|
||||
B := Pos('/', S);
|
||||
C := Pos('.', S);
|
||||
|
||||
If (A = 0) or (B = 0) Then Exit;
|
||||
|
||||
If C = 0 Then Begin
|
||||
Point := False;
|
||||
C := Length(S) + 1;
|
||||
Addr.Point := 0;
|
||||
End;
|
||||
|
||||
Addr.Zone := strS2I(Copy(S, 1, A - 1));
|
||||
Addr.Net := strS2I(Copy(S, A + 1, B - 1 - A));
|
||||
Addr.Node := strS2I(Copy(S, B + 1, C - 1 - B));
|
||||
|
||||
If Point Then Addr.Point := strS2I(Copy(S, C + 1, Length(S)));
|
||||
|
||||
Result := True;
|
||||
End;
|
||||
|
||||
Function strAddr2Str (Addr : RecEchoMailAddr) : String;
|
||||
Var
|
||||
Temp : String[20];
|
||||
Begin
|
||||
Temp := strI2S(Addr.Zone) + ':' + strI2S(Addr.Net) + '/' +
|
||||
strI2S(Addr.Node);
|
||||
|
||||
If Addr.Point <> 0 Then Temp := Temp + '.' + strI2S(Addr.Point);
|
||||
|
||||
Result := Temp;
|
||||
End;
|
||||
|
||||
Function NoGetKeyFunc (Forced : Boolean): Boolean;
|
||||
Begin
|
||||
Result := False;
|
||||
End;
|
||||
|
||||
Function CopyFile (Source, Target : String): Boolean;
|
||||
Var
|
||||
SF,
|
||||
TF : File;
|
||||
BRead,
|
||||
BWrite : LongInt;
|
||||
FileBuf : Array[1..4096] of Char;
|
||||
begin
|
||||
CopyFile := False;
|
||||
|
||||
Assign(SF, Source);
|
||||
{$I-} Reset(SF, 1); {$I+}
|
||||
|
||||
If IOResult <> 0 Then Exit;
|
||||
|
||||
Assign(TF, Target);
|
||||
{$I-} ReWrite(TF, 1); {$I+}
|
||||
|
||||
If IOResult <> 0 then Exit;
|
||||
|
||||
Repeat
|
||||
BlockRead (SF, FileBuf, SizeOf(FileBuf), BRead);
|
||||
BlockWrite (TF, FileBuf, Bread, BWrite);
|
||||
Until (BRead = 0) or (BRead <> BWrite);
|
||||
|
||||
Close(SF);
|
||||
Close(TF);
|
||||
|
||||
If BRead = BWrite Then CopyFile := True;
|
||||
End;
|
||||
|
||||
Procedure CleanDirectory (Path: String; Exempt: String);
|
||||
Var
|
||||
DirInfo: SearchRec;
|
||||
Begin
|
||||
FindFirst(Path + '*.*', Archive, DirInfo);
|
||||
While DosError = 0 Do Begin
|
||||
If strUpper(Exempt) <> strUpper(DirInfo.Name) Then
|
||||
FileErase(Path + DirInfo.Name);
|
||||
FindNext(DirInfo);
|
||||
End;
|
||||
FindClose(DirInfo);
|
||||
End;
|
||||
|
||||
Function ChangeDir (Dir : String) : Boolean;
|
||||
Begin
|
||||
{ fpc linux needs trailing backslash}
|
||||
{ fpc and vp windows doesnt matter}
|
||||
{ tpx cannot have trailing backslash }
|
||||
|
||||
While Dir[Length(Dir)] = PathChar Do Dec(Dir[0]);
|
||||
|
||||
Dir := Dir + PathChar;
|
||||
|
||||
{$I-} ChDir(Dir); {$I+}
|
||||
|
||||
ChangeDir := IoResult = 0;
|
||||
End;
|
||||
|
||||
Function CheckPath (Str: String) : String;
|
||||
Begin
|
||||
While Str[Length(Str)] = PathChar Do Dec(Str[0]);
|
||||
|
||||
If Not FileDirExists(Str) Then Begin
|
||||
If Session.io.GetYN ('|CR|12Directory doesn''t exist. Create? |11', True) Then Begin
|
||||
|
||||
{$I-} MkDir (Str); {$I+}
|
||||
|
||||
If IoResult <> 0 Then
|
||||
Session.io.OutFull ('|CR|14Error creating directory!|CR|PA');
|
||||
End;
|
||||
End;
|
||||
|
||||
CheckPath := Str + PathChar;
|
||||
End;
|
||||
|
||||
Function ShellDOS (ExecPath: String; Command: String) : LongInt;
|
||||
Var
|
||||
RetVal : Integer;
|
||||
{$IFNDEF UNIX}
|
||||
Image : TConsoleImageRec;
|
||||
{$ENDIF}
|
||||
Begin
|
||||
{$IFDEF WINDOWS}
|
||||
ExecInheritsHandles := True;
|
||||
{$ENDIF}
|
||||
|
||||
If Session.User.UserNum <> -1 Then Begin
|
||||
Reset (Session.User.UserFile);
|
||||
Seek (Session.User.UserFile, Session.User.UserNum - 1);
|
||||
Write (Session.User.UserFile, Session.User.ThisUser);
|
||||
Close (Session.User.UserFile);
|
||||
End;
|
||||
|
||||
{$IFNDEF UNIX}
|
||||
Screen.GetScreenImage(1, 1, 80, 25, Image);
|
||||
Screen.SetWindow (1, 1, 80, 25, False);
|
||||
Screen.TextAttr := 7;
|
||||
Screen.ClearScreen;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF UNIX}
|
||||
Screen.SetRawMode(False);
|
||||
{$ENDIF}
|
||||
|
||||
If ExecPath <> '' Then ChangeDir(ExecPath);
|
||||
|
||||
{$IFDEF UNIX}
|
||||
RetVal := Shell (Command);
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF WINDOWS}
|
||||
If Command <> '' Then Command := '/C' + Command;
|
||||
Exec (GetEnv('COMSPEC'), Command);
|
||||
RetVal := DosExitCode;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF UNIX}
|
||||
Screen.SetRawMode(True);
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF WIN32}
|
||||
Screen.SetWindowTitle (WinConsoleTitle + strI2S(Session.NodeNum));
|
||||
{$ENDIF}
|
||||
|
||||
ChangeDir(Config.SystemPath);
|
||||
|
||||
If Session.User.UserNum <> -1 Then Begin
|
||||
Reset (Session.User.UserFile);
|
||||
Seek (Session.User.UserFile, Session.User.UserNum - 1);
|
||||
Read (Session.User.UserFile, Session.User.ThisUser);
|
||||
Close (Session.User.UserFile);
|
||||
End;
|
||||
|
||||
Reset (Session.PromptFile);
|
||||
|
||||
{$IFNDEF UNIX}
|
||||
Screen.PutScreenImage(Image);
|
||||
Update_Status_Line(StatusPtr, '');
|
||||
{$ENDIF}
|
||||
|
||||
Session.TimeOut := TimerSeconds;
|
||||
ShellDOS := RetVal;
|
||||
End;
|
||||
|
||||
{$IFNDEF UNIX}
|
||||
Procedure Update_Status_Line (Mode: Byte; Str: String);
|
||||
Begin
|
||||
If Not Config.UseStatusBar Then Exit;
|
||||
|
||||
Screen.SetWindow (1, 1, 80, 25, False);
|
||||
|
||||
Case Mode of
|
||||
0 : Screen.WriteXY (1, 25, 120, strPadC(Str, 80, ' '));
|
||||
1 : Begin
|
||||
Screen.WriteXY ( 1, 25, 112, ' [Alias] [Baud] [Sec] [Time] ');
|
||||
Screen.WriteXY (10, 25, 112, Session.User.ThisUser.Handle);
|
||||
Screen.WriteXY (48, 25, 112, strI2S(Session.Baud));
|
||||
Screen.WriteXY (63, 25, 112, strI2S(Session.User.ThisUser.Security));
|
||||
Screen.WriteXY (76, 25, 112, strI2S(Session.TimeLeft));
|
||||
End;
|
||||
2 : Begin
|
||||
Screen.WriteXY ( 1, 25, 112, ' [Name] [Flag1] ');
|
||||
Screen.WriteXY ( 9, 25, 112, Session.User.ThisUser.RealName);
|
||||
Screen.WriteXY (48, 25, 112, DrawAccessFlags(Session.User.ThisUser.AF1));
|
||||
End;
|
||||
3 : Begin
|
||||
Screen.WriteXY ( 1, 25, 112, ' [Address] ');
|
||||
Screen.WriteXY (12, 25, 112, Session.User.ThisUser.Address);
|
||||
Screen.WriteXY (43, 25, 112, Session.User.ThisUser.City);
|
||||
Screen.WriteXY (69, 25, 112, Session.User.ThisUser.ZipCode);
|
||||
End;
|
||||
4 : Begin
|
||||
Screen.WriteXY ( 1, 25, 112, ' [BDay] [Sex] [Home PH] [Data PH] ');
|
||||
Screen.WriteXY ( 9, 25, 112, DateDos2Str(Session.User.ThisUser.Birthday, Session.User.ThisUser.DateType));
|
||||
Screen.WriteXY (25, 25, 112, Session.User.ThisUser.Gender);
|
||||
Screen.WriteXY (39, 25, 112, Session.User.ThisUser.HomePhone);
|
||||
Screen.WriteXY (65, 25, 112, Session.User.ThisUser.DataPhone);
|
||||
End;
|
||||
5 : Begin
|
||||
Screen.WriteXY ( 1, 25, 112, ' [Email] [Flag2] ');
|
||||
Screen.WriteXY (10, 25, 112, Session.User.ThisUser.Email);
|
||||
Screen.WriteXY (54, 25, 112, DrawAccessFlags(Session.User.ThisUser.AF2));
|
||||
End;
|
||||
6 : Screen.WriteXY ( 1, 25, 112, ' ALT (C)hat (S)plit (E)dit (H)angup (J) DOS (U)pgrade (B) Status Bar ');
|
||||
End;
|
||||
|
||||
Screen.SetWindow (1, 1, 80, 24, False);
|
||||
End;
|
||||
|
||||
Procedure Process_Sysop_Cmd (Cmd: Char);
|
||||
Var
|
||||
A : Integer;
|
||||
X,
|
||||
Y : Byte;
|
||||
LS : Boolean;
|
||||
Begin
|
||||
If Not Screen.Active And (Cmd <> #47) Then Exit;
|
||||
|
||||
Case Cmd of
|
||||
{U} #22 : Begin
|
||||
X := Screen.CursorX;
|
||||
Y := Screen.CursorY;
|
||||
Update_Status_Line (0, 'Upgrade Security Level: ');
|
||||
Screen.SetWindow (1, 25, 80, 25, False);
|
||||
Screen.TextAttr := 8 + 7 * 16;
|
||||
Screen.CursorXY (52, 2);
|
||||
LS := Session.LocalMode;
|
||||
Session.LocalMode := True;
|
||||
A := strS2I(Session.io.GetInput(3, 3, 9, strI2S(Session.User.ThisUser.Security)));
|
||||
Session.LocalMode := LS;
|
||||
If (A > 0) and (A < 256) Then Begin
|
||||
Upgrade_User_Level (True, Session.User.ThisUser, A);
|
||||
Session.SetTimeLeft(Session.User.ThisUser.TimeLeft);
|
||||
End;
|
||||
|
||||
Update_Status_Line(StatusPtr, '');
|
||||
|
||||
Screen.CursorXY (X, Y);
|
||||
End;
|
||||
{E} #18 : If (Not Session.InUserEdit) and (Session.User.UserNum <> -1) Then User_Editor(True, True);
|
||||
{T} #20 : Begin
|
||||
// X := Screen.CursorX;
|
||||
// Y := Screen.CursorY;
|
||||
|
||||
Config.UseStatusBar := Not Config.UseStatusBar;
|
||||
|
||||
If Not Config.UseStatusBar Then Begin
|
||||
Screen.WriteXY (1, 25, 0, strRep(' ', 80));
|
||||
Screen.SetWindow (1, 1, 80, 25, False);
|
||||
End Else
|
||||
Update_Status_Line (StatusPtr, '');
|
||||
End;
|
||||
{S} #31 : If Not Session.User.InChat Then OpenChat(True);
|
||||
{H} #35 : Begin
|
||||
Session.SystemLog('SysOp hungup on user.');
|
||||
Halt(0);
|
||||
End;
|
||||
{C} #46 : If Not Session.User.InChat Then OpenChat(False);
|
||||
{V} #47 : If Screen.Active Then
|
||||
Session.io.LocalScreenDisable
|
||||
Else
|
||||
Session.io.LocalScreenEnable;
|
||||
{B} #48 : Begin
|
||||
If StatusPtr < 6 Then
|
||||
Inc (StatusPtr)
|
||||
Else
|
||||
StatusPtr := 1;
|
||||
|
||||
Update_Status_Line (StatusPtr, '');
|
||||
End;
|
||||
#59..
|
||||
#62 : Begin
|
||||
Session.io.InMacroStr := Config.SysopMacro[Ord(Cmd) - 58];
|
||||
|
||||
If Session.io.InMacroStr[1] = '!' Then
|
||||
ExecuteMPL (NIL, Copy(Session.io.InMacroStr, 2, 255))
|
||||
Else Begin
|
||||
Session.io.InMacroPos := 1;
|
||||
Session.io.InMacro := Session.io.InMacroStr <> '';
|
||||
End;
|
||||
End;
|
||||
{+} #130: If Session.TimeLeft > 1 Then Begin
|
||||
Session.SetTimeLeft(Session.TimeLeft-1);
|
||||
Update_Status_Line(StatusPtr, '');
|
||||
End;
|
||||
{-} #131: If Session.TimeLeft < 999 Then Begin
|
||||
Session.SetTimeLeft(Session.TimeLeft+1);
|
||||
Update_Status_Line(StatusPtr, '');
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
{$ENDIF}
|
||||
|
||||
Begin
|
||||
GetKeyFunc := NoGetKeyFunc;
|
||||
End.
|
||||
348
mystic/bbs_doors.pas
Normal file
348
mystic/bbs_doors.pas
Normal file
|
|
@ -0,0 +1,348 @@
|
|||
Unit bbs_Doors;
|
||||
|
||||
{$I M_OPS.PAS}
|
||||
|
||||
Interface
|
||||
|
||||
Procedure ExecuteDoor (Format: Byte; Cmd: String);
|
||||
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
{$IFDEF WIN32}
|
||||
Windows,
|
||||
{$ENDIF}
|
||||
m_Types,
|
||||
m_Strings,
|
||||
m_DateTime,
|
||||
bbs_Common,
|
||||
bbs_Core,
|
||||
bbs_User;
|
||||
|
||||
Const
|
||||
Ending : String[2] = #13#10;
|
||||
|
||||
Procedure Write_DOOR32 (cHandle : LongInt);
|
||||
Var
|
||||
tFile : Text;
|
||||
Begin
|
||||
Assign (tFile, Session.TempPath + 'door32.sys');
|
||||
ReWrite (tFile);
|
||||
|
||||
If Session.LocalMode Then
|
||||
Write (tFile, '0' + Ending)
|
||||
Else
|
||||
Write (tFile, '2' + Ending);
|
||||
|
||||
If Session.LocalMode Then
|
||||
Write (tFile, '0' + Ending)
|
||||
Else
|
||||
Write (tFile, cHandle, Ending);
|
||||
|
||||
Write (tFile, Session.Baud, Ending);
|
||||
Write (tFile, 'Mystic ' + mysVersion + Ending);
|
||||
Write (tFile, Session.User.UserNum, Ending);
|
||||
Write (tFile, Session.User.ThisUser.RealName + Ending);
|
||||
Write (tFile, Session.User.ThisUser.Handle + Ending);
|
||||
Write (tFile, Session.User.ThisUser.Security, Ending);
|
||||
Write (tFile, Session.TimeLeft, Ending);
|
||||
Write (tFile, Session.io.Graphics, Ending);
|
||||
Write (tFile, Session.NodeNum, Ending);
|
||||
|
||||
Close (tFile);
|
||||
End;
|
||||
|
||||
Procedure Write_DORINFO;
|
||||
Var
|
||||
tFile : Text;
|
||||
A : Byte;
|
||||
Begin
|
||||
Assign (tFile, Session.TempPath + 'DORINFO1.DEF');
|
||||
Rewrite (tFile);
|
||||
|
||||
Write (tFile, Config.BBSName + Ending);
|
||||
|
||||
A := Pos(' ', Config.SysopName);
|
||||
If A > 0 Then
|
||||
Write (tFile, Copy(Config.SysopName, 1, A-1) + Ending)
|
||||
Else
|
||||
Write (tFile, Config.SysopName + Ending);
|
||||
|
||||
If A > 0 Then
|
||||
Write (tFile, Copy(Config.SysopName, A+1, 255) + Ending)
|
||||
Else
|
||||
Write (tFile, '' + Ending);
|
||||
|
||||
If Session.LocalMode Then Write (tFile, 'COM0' + Ending) Else Write (tFile, 'COM1', Ending);
|
||||
Write (tFile, Session.Baud, ' BAUD,N,8,1' + Ending);
|
||||
Write (tFile, '0' + Ending);
|
||||
|
||||
A := Pos(' ', Session.User.ThisUser.Handle);
|
||||
If A > 0 Then
|
||||
Write (tFile, Copy(Session.User.ThisUser.Handle, 1, A-1) + Ending)
|
||||
Else
|
||||
Write (tFile, Session.User.ThisUser.Handle + Ending);
|
||||
|
||||
If A > 0 Then
|
||||
Write (tFile, Copy(Session.User.ThisUser.Handle, A+1, 255) + Ending)
|
||||
Else
|
||||
Write (tFile, '' + Ending);
|
||||
|
||||
Write (tFile, Session.User.ThisUser.City + Ending);
|
||||
Write (tFile, Session.io.Graphics, Ending);
|
||||
Write (tFile, Session.User.ThisUser.Security, Ending);
|
||||
Write (tFile, Session.TimeLeft, Ending);
|
||||
Write (tFile, '-1' + Ending); {-1 FOSSIL, 0=NOT... ???}
|
||||
|
||||
Close (tFile);
|
||||
End;
|
||||
|
||||
Procedure Write_CHAINTXT;
|
||||
Var
|
||||
tFile : Text;
|
||||
Begin
|
||||
Assign (tFile, Session.TempPath + 'CHAIN.TXT');
|
||||
ReWrite (tFile);
|
||||
|
||||
Write (tFile, Session.User.UserNum, Ending);
|
||||
Write (tFile, Session.User.ThisUser.Handle + Ending);
|
||||
Write (tFile, Session.User.ThisUser.RealName + Ending);
|
||||
Write (tFile, '' + Ending);
|
||||
Write (tFile, DaysAgo(Session.User.ThisUser.Birthday) DIV 365, Ending); { User's AGE }
|
||||
Write (tFile, Session.User.ThisUser.Gender + Ending);
|
||||
Write (tFile, '0' + Ending); { User's gold }
|
||||
Write (tFile, DateDos2Str(Session.User.ThisUser.LastOn, 1) + Ending);
|
||||
Write (tFile, '80' + Ending);
|
||||
Write (tFile, Session.User.ThisUser.ScreenSize, Ending);
|
||||
Write (tFile, Session.User.ThisUser.Security, Ending);
|
||||
Write (tFile, '0' + Ending);
|
||||
Write (tFile, '0' + Ending);
|
||||
Write (tFile, Session.io.Graphics, Ending);
|
||||
Write (tFile, Ord(Not Session.LocalMode), Ending);
|
||||
Write (tFile, (Session.TimeLeft * 60), Ending);
|
||||
Write (tFile, Session.Lang.TextPath + Ending);
|
||||
Write (tFile, Config.DataPath + Ending);
|
||||
Write (tFile, 'SYSOP.', Session.NodeNum, Ending);
|
||||
If Session.LocalMode Then
|
||||
Write (tFile, 'KB' + Ending)
|
||||
Else
|
||||
Write (tFile, Session.Baud, Ending);
|
||||
Write (tFile, '1', Ending);
|
||||
Write (tFile, Config.BBSName + Ending);
|
||||
Write (tFile, Config.SysopName + Ending);
|
||||
Write (tFile, TimerSeconds, Ending);
|
||||
Write (tFile, '0' + Ending); {seconds online}
|
||||
Write (tFile, Session.User.ThisUser.ULk, Ending);
|
||||
Write (tFile, Session.User.ThisUser.ULs, Ending);
|
||||
Write (tFile, Session.User.ThisUser.DLk, Ending);
|
||||
Write (tFile, Session.User.ThisUser.DLs, Ending);
|
||||
Write (tFile, '8N1' + Ending);
|
||||
Close (tFile);
|
||||
End;
|
||||
|
||||
Procedure Write_DOORSYS;
|
||||
Var
|
||||
tFile : Text;
|
||||
{ Temp : LongInt;}
|
||||
Begin
|
||||
Assign (tFile, Session.TempPath + 'DOOR.SYS');
|
||||
Rewrite (tFile);
|
||||
|
||||
If Session.LocalMode Then Write (tFile, 'COM0:' + Ending) Else Write (tFile, 'COM1:' + Ending);
|
||||
Write (tFile, Session.Baud, Ending);
|
||||
Write (tFile, '8' + Ending);
|
||||
Write (tFile, Session.NodeNum, Ending);
|
||||
Write (tFile, Session.Baud, Ending); {locked rate}
|
||||
Write (tFile, 'Y' + Ending); {screen display}
|
||||
Write (tFile, 'N' + Ending);
|
||||
Write (tFile, 'Y' + Ending); {page bell}
|
||||
Write (tFile, 'Y' + Ending);
|
||||
Write (tFile, Session.User.ThisUser.RealName + Ending);
|
||||
Write (tFile, Session.User.ThisUser.City + Ending);
|
||||
Write (tFile, Session.User.ThisUser.HomePhone + Ending);
|
||||
Write (tFile, Session.User.ThisUser.DataPhone + Ending);
|
||||
Write (tFile, Session.User.ThisUser.Password + Ending);
|
||||
Write (tFile, Session.User.ThisUser.Security, Ending);
|
||||
Write (tFile, Session.User.ThisUser.Calls, Ending);
|
||||
Write (tFile, DateDos2Str(Session.User.ThisUser.LastOn, 1) + Ending);
|
||||
|
||||
Write (tFile, (Session.TimeLeft * 60), Ending); {seconds left}
|
||||
Write (tFile, Session.TimeLeft, Ending); {mins left}
|
||||
|
||||
If Session.io.Graphics = 1 Then Write (tFile, 'GR' + Ending) Else Write (tFile, 'NG' + Ending);
|
||||
|
||||
Write (tFile, Session.User.ThisUser.ScreenSize, Ending); {page length}
|
||||
Write (tFile, 'N' + Ending); {Y=expert, N=novice}
|
||||
Write (tFile, '' + Ending);
|
||||
Write (tFile, '' + Ending);
|
||||
Write (tFile, '' + Ending); {user account expiration date}
|
||||
Write (tFile, Session.User.UserNum, Ending); {user record number}
|
||||
Write (tFile, '' + Ending); {default protocol}
|
||||
Write (tFile, Session.User.ThisUser.ULs, Ending);
|
||||
Write (tFile, Session.User.ThisUser.DLs, Ending);
|
||||
Write (tFile, Session.User.ThisUser.DLk, Ending);
|
||||
Write (tFile, Session.User.Security.MaxDLk, Ending);
|
||||
Write (tFile, Session.User.ThisUser.Birthday, Ending);
|
||||
Write (tFile, Config.DataPath + Ending);
|
||||
Write (tFile, Config.MsgsPath + Ending);
|
||||
Write (tFile, Config.SysopName + Ending);
|
||||
Write (tFile, Session.User.ThisUser.Handle + Ending);
|
||||
Write (tFile, TimeDos2Str(Session.NextEvent.ExecTime, False) + Ending); {next event start time hh:mm}
|
||||
Write (tFile, 'Y' + Ending); {error-free connection}
|
||||
Write (tFile, 'N' + Ending); {ansi in NG mode}
|
||||
Write (tFile, 'Y' + Ending); {record locking}
|
||||
Write (tFile, '3' + Ending); {default BBS color}
|
||||
Write (tFile, '0' + Ending); {time credits per minute}
|
||||
Write (tFile, '00/00/00' + Ending); {last new filescan date}
|
||||
Write (tFile, TimeDos2Str(Session.User.ThisUser.LastOn, False) + Ending); {time of this call}
|
||||
Write (tFile, TimeDos2Str(Session.User.ThisUser.LastOn, False) + Ending); {time of last call}
|
||||
Write (tFile, '32768' + Ending); {max daily files (??) }
|
||||
Write (tFile, Session.User.ThisUser.DLsToday, Ending);
|
||||
Write (tFile, Session.User.ThisUser.ULk, Ending);
|
||||
Write (tFile, Session.User.ThisUser.DLk, Ending);
|
||||
Write (tFile, '' + Ending); {user comment}
|
||||
Write (tFile, '0' + Ending); {total doors opened}
|
||||
Write (tFile, Session.User.ThisUser.Posts, Ending); {total posts}
|
||||
Close (tFile);
|
||||
End;
|
||||
|
||||
{$IFDEF WIN32}
|
||||
Procedure Shell_DOOR32 (Cmd : String);
|
||||
Var
|
||||
PI : TProcessInformation;
|
||||
SI : TStartupInfo;
|
||||
Image : TConsoleImageRec;
|
||||
PassHandle : LongInt;
|
||||
Begin
|
||||
PassHandle := 0;
|
||||
|
||||
If Not Session.LocalMode Then
|
||||
PassHandle := Session.Client.FSocketHandle;
|
||||
|
||||
If Session.User.UserNum <> -1 Then Begin
|
||||
Reset (Session.User.UserFile);
|
||||
Seek (Session.User.UserFile, Session.User.UserNum - 1);
|
||||
Write (Session.User.UserFile, Session.User.ThisUser);
|
||||
Close (Session.User.UserFile);
|
||||
End;
|
||||
|
||||
WRITE_DOOR32(PassHandle);
|
||||
|
||||
Screen.GetScreenImage(1,1,80,25, Image);
|
||||
|
||||
Cmd := Cmd + #0;
|
||||
|
||||
FillChar(SI, SizeOf(SI), 0);
|
||||
FillChar(PI, SizeOf(PI), 0);
|
||||
|
||||
SI.CB := SizeOf(TStartupInfo);
|
||||
SI.wShowWindow := SW_SHOWMINNOACTIVE;
|
||||
SI.dwFlags := SI.dwFlags or STARTF_USESHOWWINDOW;
|
||||
|
||||
If CreateProcess(NIL, @Cmd[1],
|
||||
NIL,
|
||||
NIL,
|
||||
True,
|
||||
CREATE_SEPARATE_WOW_VDM,
|
||||
NIL,
|
||||
NIL,
|
||||
SI,
|
||||
PI) Then
|
||||
WaitForSingleObject (PI.hProcess, INFINITE);
|
||||
|
||||
ChangeDir(Config.SystemPath);
|
||||
|
||||
If Session.User.UserNum <> -1 Then Begin
|
||||
Reset (Session.User.UserFile);
|
||||
Seek (Session.User.UserFile, Session.User.UserNum - 1);
|
||||
Read (Session.User.UserFile, Session.User.ThisUser);
|
||||
Close (Session.User.UserFile);
|
||||
End;
|
||||
|
||||
Screen.SetWindowTitle(WinConsoleTitle + strI2S(Session.NodeNum));
|
||||
Screen.PutScreenImage(Image);
|
||||
|
||||
Update_Status_Line(StatusPtr, '');
|
||||
|
||||
Session.TimeOut := TimerSeconds;
|
||||
End;
|
||||
{$ENDIF}
|
||||
|
||||
Procedure ExecuteDoor (Format: Byte; Cmd: String);
|
||||
{Format:
|
||||
0 = None
|
||||
1 = DORINFO1.DEF
|
||||
2 = DOOR.SYS
|
||||
3 = CHAIN.TXT
|
||||
}
|
||||
Var
|
||||
A : LongInt;
|
||||
Temp : String;
|
||||
Begin
|
||||
A := Pos('/DOS', strUpper(Cmd));
|
||||
|
||||
If A > 0 Then Begin
|
||||
Delete (Cmd, A, 4);
|
||||
Ending := #13#10;
|
||||
End Else
|
||||
Ending := LineTerm;
|
||||
|
||||
Temp := '';
|
||||
A := 1;
|
||||
|
||||
While A <= Length(Cmd) Do Begin
|
||||
If Cmd[A] = '%' Then Begin
|
||||
Inc(A);
|
||||
{$IFDEF UNIX}
|
||||
If Cmd[A] = '0' Then Temp := Temp + '1' Else
|
||||
{$ELSE}
|
||||
If Cmd[A] = '0' Then Temp := Temp + strI2S(Session.Client.FSocketHandle) Else
|
||||
{$ENDIF}
|
||||
If Cmd[A] = '1' Then Temp := Temp + '1' Else
|
||||
If Cmd[A] = '2' Then Temp := Temp + strI2S(Session.Baud) Else
|
||||
If Cmd[A] = '3' Then Temp := Temp + strI2S(Session.NodeNum) Else
|
||||
If Cmd[A] = '4' Then Temp := Temp + Session.UserIPInfo Else
|
||||
If Cmd[A] = '5' Then Temp := Temp + Session.UserHostInfo Else
|
||||
If Cmd[A] = '#' Then Temp := Temp + strI2S(Session.User.ThisUser.PermIdx) Else
|
||||
If Cmd[A] = 'T' Then Temp := Temp + strI2S(Session.TimeLeft) Else
|
||||
If Cmd[A] = 'P' Then Temp := Temp + Session.TempPath Else
|
||||
If Cmd[A] = 'U' Then Temp := Temp + strReplace(Session.User.ThisUser.Handle, ' ', '_');
|
||||
End Else
|
||||
Temp := Temp + Cmd[A];
|
||||
|
||||
Inc (A);
|
||||
End;
|
||||
|
||||
Session.SystemLog ('Executed Door: ' + Temp);
|
||||
|
||||
A := TimerMinutes; { save current timer for event check after door }
|
||||
|
||||
Case Format of
|
||||
1 : Write_DORINFO;
|
||||
2 : Write_DOORSYS;
|
||||
3 : Write_CHAINTXT;
|
||||
{$IFDEF UNIX}
|
||||
4 : Write_DOOR32(0);
|
||||
{$ENDIF}
|
||||
End;
|
||||
|
||||
{$IFDEF WIN32}
|
||||
If Format = 4 Then
|
||||
Shell_DOOR32(Temp)
|
||||
Else
|
||||
If ShellDOS ('', Temp) = 0 Then;
|
||||
{$ELSE}
|
||||
If ShellDOS ('', Temp) = 0 Then;
|
||||
{$ENDIF}
|
||||
|
||||
{ Check to see if event was missed while user was in door }
|
||||
|
||||
If Session.NextEvent.Active Then
|
||||
If (TimerMinutes < A) and (A < Session.NextEvent.ExecTime) Then Begin { midnight roll over }
|
||||
If Session.MinutesUntilEvent(Session.NextEvent.ExecTime) = 0 Then;
|
||||
End Else
|
||||
If (A < Session.NextEvent.ExecTime) and (TimerMinutes > Session.NextEvent.ExecTime) Then
|
||||
If Session.MinutesUntilEvent(Session.NextEvent.ExecTime) = 0 Then;
|
||||
End;
|
||||
|
||||
End.
|
||||
848
mystic/bbs_edit_full.pas
Normal file
848
mystic/bbs_edit_full.pas
Normal file
|
|
@ -0,0 +1,848 @@
|
|||
Unit bbs_Edit_Full;
|
||||
|
||||
{ this editor really should be rewritten from scratch again, since i wrote }
|
||||
{ it sooo many years ago. i'm sure i could do a better job now! in any }
|
||||
{ case, some things which could be added or included in new editor: }
|
||||
{ }
|
||||
{ 1. cut/paste line functions }
|
||||
{ 2. move word left/right commands }
|
||||
{ 3. optional spell checker? }
|
||||
{ 4. reformat paragraph command }
|
||||
{ 5. tag lines? }
|
||||
{ 6. ability to show embedded ansi/pipes }
|
||||
{ 7. ability to toggle off word wrap? }
|
||||
{ 8. ability to set foreground/background color }
|
||||
{ 9. ability to change extended character sets }
|
||||
{ 10. maybe remove Squish msgbase support and add a OWNER field to each }
|
||||
{ message. Owners can be assigned by Sysop ACS or the original poster }
|
||||
{ Ownership allows message editing but not deleting. this combined with }
|
||||
{ the above allows artists to collaborate ANSIs in the message bases with}
|
||||
{ the FSE. totally badass feature no one has ever done. }
|
||||
{ CTRL-A = change attribute CTRL-C change character set? CTRL-W on off}
|
||||
{ then ahve a PUBLISH feature which can allow downloads or moving to the}
|
||||
{ ANSI gallery? }
|
||||
{ add SAUCE editor if this happens too }
|
||||
{ how will message quoting work though? has to strip colors }
|
||||
{ hmm what happens if two users want to work together though? }
|
||||
|
||||
{$I M_OPS.PAS}
|
||||
|
||||
Interface
|
||||
|
||||
Function AnsiEditor (Var Lines: SmallInt; WrapPos: Byte; MaxLines: SmallInt; TEdit, Forced: Boolean; Var Subj: String) : Boolean;
|
||||
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
m_Strings,
|
||||
bbs_Common,
|
||||
bbs_Core;
|
||||
|
||||
Procedure Print (S: String);
|
||||
Begin
|
||||
{$IFNDEF UNIX}
|
||||
If Not Session.LocalMode Then Session.io.BufAddStr(S);
|
||||
{$ENDIF}
|
||||
|
||||
Screen.WriteStr(S);
|
||||
End;
|
||||
|
||||
Procedure PrintLn (S: String);
|
||||
Begin
|
||||
Print (S + #13#10);
|
||||
End;
|
||||
|
||||
Function AnsiEditor (Var Lines: Integer; WrapPos: Byte; MaxLines: Integer; TEdit, Forced: Boolean; Var Subj: String) : Boolean;
|
||||
Const
|
||||
WinStart : Byte = 2;
|
||||
WinEnd : Byte = 22;
|
||||
InsertMode : Boolean = True;
|
||||
|
||||
Var
|
||||
Done : Boolean;
|
||||
Save : Boolean;
|
||||
Ch : Char;
|
||||
tColor : Byte;
|
||||
CurX : Byte;
|
||||
CurY : Integer;
|
||||
CurLine : Integer;
|
||||
TotalLine : Integer;
|
||||
QuoteCurLine : Integer;
|
||||
QuoteTopPage : Integer;
|
||||
|
||||
Procedure UpdatePosition;
|
||||
Begin
|
||||
If CurLine > TotalLine Then TotalLine := CurLine;
|
||||
If CurX > Length(Session.Msgs.MsgText[CurLine]) Then CurX := Length(Session.Msgs.MsgText[CurLine]) + 1;
|
||||
Session.io.AnsiGotoXY (CurX, CurY);
|
||||
End;
|
||||
|
||||
Procedure ReFresh_Part;
|
||||
Var
|
||||
A,
|
||||
B : Integer;
|
||||
Begin
|
||||
Session.io.AnsiGotoXY (1, CurY);
|
||||
|
||||
A := CurY;
|
||||
B := CurLine;
|
||||
|
||||
Repeat
|
||||
If B <= TotalLine Then Print(Session.Msgs.MsgText[B]);
|
||||
If B <= TotalLine + 1 Then Begin
|
||||
Session.io.AnsiClrEOL;
|
||||
PrintLn('');
|
||||
End;
|
||||
|
||||
Inc (A);
|
||||
Inc (B);
|
||||
Until A > WinEnd;
|
||||
|
||||
UpdatePosition;
|
||||
End;
|
||||
|
||||
Procedure Refresh_Text;
|
||||
Var
|
||||
A,
|
||||
B : Integer;
|
||||
Begin
|
||||
{ b = first line at top of window }
|
||||
{ cury = yposition of last line. }
|
||||
|
||||
CurY := WinStart + 5;
|
||||
B := CurLine - 5;
|
||||
|
||||
If B < 1 Then Begin
|
||||
CurY := WinStart + (5 + B - 1);
|
||||
B := 1;
|
||||
End;
|
||||
|
||||
Session.io.AnsiGotoXY (1, WinStart);
|
||||
|
||||
A := WinStart;
|
||||
|
||||
Repeat
|
||||
If B <= TotalLine Then Print(Session.Msgs.MsgText[B]);
|
||||
Session.io.AnsiClrEOL;
|
||||
PrintLn('');
|
||||
Inc (A);
|
||||
Inc (B);
|
||||
Until A > WinEnd;
|
||||
|
||||
UpdatePosition;
|
||||
End;
|
||||
|
||||
Procedure Insert_Line (Num: Integer);
|
||||
Var
|
||||
A : Integer;
|
||||
Begin
|
||||
Inc (TotalLine);
|
||||
|
||||
For A := TotalLine DownTo Num + 1 Do
|
||||
Session.Msgs.MsgText[A] := Session.Msgs.MsgText[A - 1];
|
||||
|
||||
Session.Msgs.MsgText[Num] := '';
|
||||
End;
|
||||
|
||||
Procedure Format_Text;
|
||||
Var
|
||||
OldStr : String; { holds the line text to be wrapped }
|
||||
NewStr : String;
|
||||
Line : Integer; { holds current line number being wrapped }
|
||||
A : Integer;
|
||||
NewY : Integer; { holds new y position on screen }
|
||||
NewLine : Integer; { holds new line number }
|
||||
Moved : Boolean;
|
||||
Begin
|
||||
If TotalLine = MaxLines Then Exit;
|
||||
|
||||
Line := CurLine;
|
||||
OldStr := Session.Msgs.MsgText[Line];
|
||||
NewY := CurY;
|
||||
NewLine := CurLine;
|
||||
Moved := False;
|
||||
|
||||
Repeat
|
||||
If Pos(' ', OldStr) = 0 Then Begin
|
||||
Inc (Line);
|
||||
Insert_Line (Line);
|
||||
|
||||
Session.Msgs.MsgText[Line] := Copy(OldStr, CurX, Length(OldStr));
|
||||
Session.Msgs.MsgText[Line-1][0] := Chr(CurX - 1);
|
||||
|
||||
If CurX > WrapPos Then Begin
|
||||
Inc (NewLine);
|
||||
Inc (NewY);
|
||||
CurX := 1;
|
||||
End;
|
||||
|
||||
If NewY <= WinEnd Then Refresh_Part;
|
||||
|
||||
CurY := NewY;
|
||||
CurLine := NewLine;
|
||||
|
||||
If CurY > WinEnd Then Refresh_Text Else UpdatePosition;
|
||||
|
||||
Exit;
|
||||
End Else Begin
|
||||
A := strWrap (OldStr, NewStr, WrapPos);
|
||||
|
||||
If (A > 0) And (Not Moved) And (CurX > Length(OldStr) + 1) Then Begin
|
||||
CurX := CurX - A;
|
||||
Moved := True;
|
||||
Inc (NewLine);
|
||||
Inc (NewY);
|
||||
End;
|
||||
|
||||
Session.Msgs.MsgText[Line] := OldStr;
|
||||
Inc (Line);
|
||||
|
||||
If (Session.Msgs.MsgText[Line] = '') or ((Pos(' ', Session.Msgs.MsgText[Line]) = 0) And (Length(Session.Msgs.MsgText[Line]) >= WrapPos)) Then Begin
|
||||
Insert_Line(Line);
|
||||
OldStr := NewStr;
|
||||
End Else
|
||||
OldStr := NewStr + ' ' + Session.Msgs.MsgText[Line];
|
||||
End;
|
||||
Until Length(OldStr) <= WrapPos;
|
||||
|
||||
Session.Msgs.MsgText[Line] := OldStr;
|
||||
|
||||
If NewY <= WinEnd Then Begin
|
||||
Session.io.AnsiGotoXY(1, CurY);
|
||||
|
||||
A := CurLine;
|
||||
|
||||
Repeat
|
||||
If (CurY + (A - CurLine) <= WinEnd) and (A <= TotalLine) Then Begin
|
||||
Print(Session.Msgs.MsgText[A]);
|
||||
Session.io.AnsiClrEOL;
|
||||
PrintLn('');
|
||||
End Else
|
||||
Break;
|
||||
|
||||
Inc (A);
|
||||
Until False;
|
||||
End;
|
||||
|
||||
CurY := NewY;
|
||||
CurLine := NewLine;
|
||||
|
||||
If CurY > WinEnd Then Refresh_Text Else UpdatePosition;
|
||||
End;
|
||||
|
||||
Procedure Do_Enter;
|
||||
Begin
|
||||
If TotalLine = MaxLines Then Exit;
|
||||
|
||||
Insert_Line (CurLine + 1);
|
||||
|
||||
If CurX < Length(Session.Msgs.MsgText[CurLine]) + 1 Then Begin
|
||||
Session.Msgs.MsgText[CurLine+1] := Copy(Session.Msgs.MsgText[CurLine], CurX, Length(Session.Msgs.MsgText[CurLine]));
|
||||
Delete (Session.Msgs.MsgText[CurLine], CurX, Length(Session.Msgs.MsgText[CurLine]));
|
||||
End;
|
||||
|
||||
If CurY + 1 > WinEnd Then Refresh_Text Else Refresh_Part;
|
||||
|
||||
CurX := 1;
|
||||
|
||||
Inc(CurY);
|
||||
Inc(CurLine);
|
||||
|
||||
UpdatePosition;
|
||||
End;
|
||||
|
||||
Procedure Down_Key;
|
||||
Begin
|
||||
If CurLine = TotalLine Then Exit;
|
||||
|
||||
If CurY = WinEnd Then
|
||||
ReFresh_Text
|
||||
Else Begin
|
||||
Inc (CurY);
|
||||
Inc (CurLine);
|
||||
UpdatePosition;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure Up_Key (EOL: Boolean);
|
||||
Begin
|
||||
{ if curline = 1 then exit;}
|
||||
{ appearently, exit is larger and slower than the statement below: }
|
||||
|
||||
If CurLine > 1 Then Begin
|
||||
If EOL then begin
|
||||
CurX := Length(Session.Msgs.MsgText[CurLine - 1]) + 1;
|
||||
If CurX > WrapPos Then CurX := WrapPos + 1;
|
||||
End;
|
||||
|
||||
If CurY = WinStart Then
|
||||
Refresh_Text
|
||||
Else Begin
|
||||
Dec (CurY);
|
||||
Dec (CurLine);
|
||||
UpdatePosition;
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure Delete_Line (Num : Integer);
|
||||
Var
|
||||
A : Integer;
|
||||
Begin
|
||||
For A := Num To TotalLine - 1 Do
|
||||
Session.Msgs.MsgText[A] := Session.Msgs.MsgText[A + 1];
|
||||
|
||||
Session.Msgs.MsgText[TotalLine] := '';
|
||||
Dec (TotalLine);
|
||||
End;
|
||||
|
||||
Procedure Backspace;
|
||||
Var
|
||||
A : Integer;
|
||||
Begin
|
||||
If CurX > 1 Then Begin
|
||||
Session.io.OutBS(1, True);
|
||||
Dec (CurX);
|
||||
Delete (Session.Msgs.MsgText[CurLine], CurX, 1);
|
||||
If CurX < Length(Session.Msgs.MsgText[CurLine]) + 1 Then Begin
|
||||
Print (Copy(Session.Msgs.MsgText[CurLine], CurX, Length(Session.Msgs.MsgText[CurLine])) + ' ');
|
||||
UpdatePosition;
|
||||
End;
|
||||
End Else
|
||||
If CurLine > 1 Then Begin
|
||||
If Length(Session.Msgs.MsgText[CurLine - 1]) + Length(Session.Msgs.MsgText[CurLine]) <= WrapPos Then Begin
|
||||
CurX := Length(Session.Msgs.MsgText[CurLine - 1]) + 1;
|
||||
Session.Msgs.MsgText[CurLine - 1] := Session.Msgs.MsgText[CurLine - 1] + Session.Msgs.MsgText[CurLine];
|
||||
Delete_Line (CurLine);
|
||||
Dec (CurLine);
|
||||
Dec (CurY);
|
||||
If CurY < WinStart Then Refresh_Text Else Refresh_Part;
|
||||
End Else
|
||||
If Pos(' ', Session.Msgs.MsgText[CurLine]) > 0 Then Begin
|
||||
For A := Length(Session.Msgs.MsgText[CurLine]) DownTo 1 Do
|
||||
If (Session.Msgs.MsgText[CurLine][A] = ' ') and (Length(Session.Msgs.MsgText[CurLine - 1]) + A - 1 <= WrapPos) Then Begin
|
||||
CurX := Length(Session.Msgs.MsgText[CurLine - 1]) + 1;
|
||||
Session.Msgs.MsgText[CurLine - 1] := Session.Msgs.MsgText[CurLine - 1] + Copy(Session.Msgs.MsgText[CurLine], 1, A - 1);
|
||||
Delete (Session.Msgs.MsgText[CurLine], 1, A);
|
||||
Dec (CurLine);
|
||||
Dec (CurY);
|
||||
If CurY < WinStart Then Refresh_Text Else Refresh_Part;
|
||||
Exit;
|
||||
End;
|
||||
Up_Key(True);
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
|
||||
procedure left_key;
|
||||
begin
|
||||
if curx > 1 then Begin
|
||||
Dec (CurX);
|
||||
UpdatePosition;
|
||||
end else
|
||||
up_key(true);
|
||||
End;
|
||||
|
||||
procedure right_key;
|
||||
Begin
|
||||
if curx < length(Session.Msgs.MsgText[curline])+1 then begin
|
||||
Inc (CurX);
|
||||
UpdatePosition;
|
||||
end else begin
|
||||
if curY < totalline then curx := 1;
|
||||
down_key;
|
||||
end;
|
||||
End;
|
||||
|
||||
Procedure Insert_Ch (Ch: Char);
|
||||
Begin
|
||||
If InsertMode Then Begin
|
||||
Insert (Ch, Session.Msgs.MsgText[Curline], CurX);
|
||||
Print (Copy(Session.Msgs.MsgText[CurLine], CurX, Length(Session.Msgs.MsgText[CurLine])));
|
||||
End Else Begin
|
||||
If CurX > Length(Session.Msgs.MsgText[CurLine]) Then Inc(Session.Msgs.MsgText[CurLine][0]);
|
||||
Session.Msgs.MsgText[CurLine][CurX] := Ch;
|
||||
Print (Ch); {outchar}
|
||||
End;
|
||||
Inc (CurX);
|
||||
UpdatePosition;
|
||||
End;
|
||||
|
||||
Procedure ToggleInsert (Toggle: Boolean);
|
||||
Begin
|
||||
If Toggle Then InsertMode := Not InsertMode;
|
||||
|
||||
Session.io.AnsiColor (Session.io.ScreenInfo[3].A);
|
||||
Session.io.AnsiGotoXY (Session.io.ScreenInfo[3].X, Session.io.ScreenInfo[3].Y);
|
||||
|
||||
If InsertMode Then Print('INS') else Print('OVR'); { ++lang }
|
||||
|
||||
Session.io.AnsiGotoXY (CurX, CurY);
|
||||
Session.io.AnsiColor (tColor);
|
||||
End;
|
||||
|
||||
Procedure Draw_Screen;
|
||||
Begin
|
||||
If TEdit Then Session.io.OutFile ('ansitext', True, 0) Else Session.io.OutFile ('ansiedit', True, 0);
|
||||
|
||||
WinStart := Session.io.ScreenInfo[1].Y;
|
||||
WinEnd := Session.io.ScreenInfo[2].Y;
|
||||
tColor := Session.io.ScreenInfo[1].A;
|
||||
|
||||
ToggleInsert (False);
|
||||
|
||||
Refresh_Text;
|
||||
End;
|
||||
|
||||
Procedure Quote;
|
||||
Var
|
||||
InFile : Text;
|
||||
Start,
|
||||
Finish : Integer;
|
||||
NumLines : Integer;
|
||||
Text : Array[1..mysMaxMsgLines] of String[80];
|
||||
PI1 : String;
|
||||
PI2 : String;
|
||||
Begin
|
||||
Assign (InFile, Session.TempPath + 'msgtmp');
|
||||
{$I-} Reset (InFile); {$I+}
|
||||
If IoResult <> 0 Then Begin
|
||||
Session.io.OutFullLn (Session.GetPrompt(158));
|
||||
Exit;
|
||||
End;
|
||||
|
||||
NumLines := 0;
|
||||
Session.io.AllowPause := True;
|
||||
|
||||
While Not Eof(InFile) Do Begin
|
||||
Inc (NumLines);
|
||||
ReadLn (InFile, Text[NumLines]);
|
||||
End;
|
||||
|
||||
Close (InFile);
|
||||
|
||||
PI1 := Session.io.PromptInfo[1];
|
||||
PI2 := Session.io.PromptInfo[2];
|
||||
|
||||
Session.io.OutFullLn(Session.GetPrompt(452));
|
||||
|
||||
For Start := 1 to NumLines Do Begin
|
||||
Session.io.PromptInfo[1] := strI2S(Start);
|
||||
Session.io.PromptInfo[2] := Text[Start];
|
||||
|
||||
Session.io.OutFullLn (Session.GetPrompt(341));
|
||||
|
||||
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.AllowPause := True;
|
||||
|
||||
Session.io.OutFull (Session.GetPrompt(159));
|
||||
Start := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
|
||||
Session.io.OutFull (Session.GetPrompt(160));
|
||||
Finish := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
|
||||
If (Start > 0) and (Start <= NumLines) and (Finish <= NumLines) Then Begin
|
||||
If Finish = 0 Then Finish := Start;
|
||||
For NumLines := Start to Finish Do Begin
|
||||
If TotalLine = mysMaxMsgLines Then Break;
|
||||
If Session.Msgs.MsgText[CurLine] <> '' Then Begin
|
||||
Inc (CurLine);
|
||||
Insert_Line (CurLine);
|
||||
End;
|
||||
Session.Msgs.MsgText[CurLine] := Text[NumLines];
|
||||
End;
|
||||
If CurLine < MaxLines then Inc(CurLine);
|
||||
End;
|
||||
|
||||
Session.io.PromptInfo[1] := PI1;
|
||||
Session.io.PromptInfo[2] := PI2;
|
||||
End;
|
||||
|
||||
Procedure QuoteWindow;
|
||||
Var
|
||||
QText : Array[1..mysMaxMsgLines] of String[80];
|
||||
InFile : Text;
|
||||
QuoteLines : Integer;
|
||||
NoMore : Boolean;
|
||||
|
||||
Procedure UpdateBar (On: Boolean);
|
||||
Begin
|
||||
Session.io.AnsiGotoXY (1, QuoteCurLine + Session.io.ScreenInfo[2].Y);
|
||||
If On Then
|
||||
Session.io.AnsiColor (Session.Lang.QuoteColor)
|
||||
Else
|
||||
Session.io.AnsiColor (Session.io.ScreenInfo[2].A);
|
||||
|
||||
Print (strPadR(QText[QuoteTopPage + QuoteCurLine], 79, ' '));
|
||||
End;
|
||||
|
||||
Procedure UpdateWindow;
|
||||
Var
|
||||
A : Integer;
|
||||
Begin
|
||||
Session.io.AnsiGotoXY (1, Session.io.ScreenInfo[2].Y);
|
||||
Session.io.AnsiColor (Session.io.ScreenInfo[2].A);
|
||||
For A := QuoteTopPage to QuoteTopPage + 5 Do Begin
|
||||
If A <= QuoteLines Then Print (QText[A]);
|
||||
Session.io.AnsiClrEOL;
|
||||
If A <= QuoteLines Then PrintLn('');
|
||||
End;
|
||||
UpdateBar(True);
|
||||
End;
|
||||
|
||||
Var
|
||||
Scroll : Integer;
|
||||
Temp1 : Integer;
|
||||
Ch : Char;
|
||||
Added : Boolean;
|
||||
Begin
|
||||
Added := False;
|
||||
|
||||
Assign (InFile, Session.TempPath + 'msgtmp');
|
||||
{$I-} Reset(InFile); {$I+}
|
||||
If IoResult <> 0 Then Exit;
|
||||
|
||||
QuoteLines := 0;
|
||||
NoMore := False;
|
||||
Scroll := CurLine + 4;
|
||||
|
||||
While Not Eof(InFile) Do Begin
|
||||
Inc (QuoteLines);
|
||||
ReadLn (InFile, QText[QuoteLines]);
|
||||
End;
|
||||
|
||||
Close (InFile);
|
||||
|
||||
Session.io.OutFile ('ansiquot', True, 0);
|
||||
|
||||
If CurY >= Session.io.ScreenInfo[1].Y Then Begin
|
||||
Session.io.AnsiColor(tColor);
|
||||
Temp1 := WinEnd;
|
||||
WinEnd := Session.io.ScreenInfo[1].Y;
|
||||
Refresh_Text;
|
||||
WinEnd := Temp1;
|
||||
End;
|
||||
|
||||
UpdateWindow;
|
||||
|
||||
Repeat
|
||||
Ch := Session.io.GetKey;
|
||||
|
||||
If Session.io.IsArrow Then Begin
|
||||
Case Ch of
|
||||
#71 : If QuoteCurLine > 0 Then Begin
|
||||
QuoteTopPage := 1;
|
||||
QuoteCurLine := 0;
|
||||
UpdateWindow;
|
||||
End;
|
||||
#72 : Begin
|
||||
If QuoteCurLine > 0 Then Begin
|
||||
UpdateBar(False);
|
||||
Dec(QuoteCurLine);
|
||||
UpdateBar(True);
|
||||
End Else
|
||||
If QuoteTopPage > 1 Then Begin
|
||||
Dec (QuoteTopPage);
|
||||
UpdateWindow;
|
||||
End;
|
||||
NoMore := False;
|
||||
End;
|
||||
#73,
|
||||
#75 : Begin
|
||||
If QuoteTopPage > 6 Then
|
||||
Dec (QuoteTopPage, 6)
|
||||
Else Begin
|
||||
QuoteTopPage := 1;
|
||||
QuoteCurLine := 0;
|
||||
End;
|
||||
NoMore := False;
|
||||
UpdateWindow;
|
||||
End;
|
||||
#79 : Begin
|
||||
If QuoteLines <= 6 Then
|
||||
QuoteCurLine := QuoteLines - QuoteTopPage
|
||||
Else Begin
|
||||
QuoteTopPage := QuoteLines - 5;
|
||||
QuoteCurLine := 5;
|
||||
End;
|
||||
|
||||
UpdateWindow;
|
||||
End;
|
||||
#80 : If QuoteTopPage + QuoteCurLine < QuoteLines Then Begin
|
||||
If QuoteCurLine = 5 Then Begin
|
||||
Inc (QuoteTopPage);
|
||||
UpdateWindow;
|
||||
End Else Begin
|
||||
UpdateBar(False);
|
||||
Inc (QuoteCurLine);
|
||||
UpdateBar(True);
|
||||
End;
|
||||
End;
|
||||
#77,
|
||||
#81 : Begin
|
||||
If QuoteLines <= 6 Then
|
||||
QuoteCurLine := QuoteLines - QuoteTopPage
|
||||
Else
|
||||
If QuoteTopPage + 6 < QuoteLines - 6 Then
|
||||
Inc (QuoteTopPage, 6)
|
||||
Else Begin
|
||||
QuoteTopPage := QuoteLines - 5;
|
||||
QuoteCurLine := 5;
|
||||
End;
|
||||
|
||||
UpdateWindow;
|
||||
End;
|
||||
End;
|
||||
End Else
|
||||
Case Ch of
|
||||
#27 : Break;
|
||||
#13 : If (TotalLine < mysMaxMsgLines) and (Not NoMore) Then Begin
|
||||
Added := True;
|
||||
|
||||
If QuoteTopPage + QuoteCurLine = QuoteLines Then NoMore := True;
|
||||
|
||||
Insert_Line (CurLine);
|
||||
Session.Msgs.MsgText[CurLine] := QText[QuoteTopPage + QuoteCurLine];
|
||||
Inc (CurLine);
|
||||
|
||||
Session.io.AnsiColor(tColor);
|
||||
|
||||
Temp1 := WinEnd;
|
||||
WinEnd := Session.io.ScreenInfo[1].Y;
|
||||
If CurLine - Scroll + WinStart + 4 >= WinEnd Then Begin
|
||||
Refresh_Text;
|
||||
Scroll := CurLine;
|
||||
End Else Begin
|
||||
Dec (CurLine);
|
||||
Refresh_Part;
|
||||
Inc (CurLine);
|
||||
Inc (CurY);
|
||||
End;
|
||||
WinEnd := Temp1;
|
||||
|
||||
If QuoteTopPage + QuoteCurLine < QuoteLines Then
|
||||
If QuoteCurLine = 5 Then Begin
|
||||
Inc (QuoteTopPage);
|
||||
UpdateWindow;
|
||||
End Else Begin
|
||||
UpdateBar(False);
|
||||
Inc (QuoteCurLine);
|
||||
UpdateBar(True);
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
Until False;
|
||||
Session.io.OutFull('|16');
|
||||
If (CurLine < mysMaxMsgLines) And Added Then Inc(CurLine);
|
||||
End;
|
||||
|
||||
Procedure Commands;
|
||||
Var
|
||||
Ch : Char;
|
||||
Str : String;
|
||||
Begin
|
||||
Done := False;
|
||||
Save := False;
|
||||
|
||||
Repeat
|
||||
Session.io.OutFull (Session.GetPrompt(354));
|
||||
Ch := Session.io.OneKey ('?ACHQRSTU', True);
|
||||
Case Ch of
|
||||
'?' : Session.io.OutFullLn (Session.GetPrompt(355));
|
||||
'A' : If Forced Then Begin
|
||||
Session.io.OutFull (Session.GetPrompt(307));
|
||||
Exit;
|
||||
End Else Begin
|
||||
Done := Session.io.GetYN(Session.GetPrompt(356), False);
|
||||
Exit;
|
||||
End;
|
||||
'C' : Exit;
|
||||
'H' : Begin
|
||||
Session.io.OutFile ('fshelp', True, 0);
|
||||
Exit;
|
||||
End;
|
||||
'Q' : Begin
|
||||
If Session.User.ThisUser.UseLBQuote Then
|
||||
QuoteWindow
|
||||
Else
|
||||
Quote;
|
||||
Exit;
|
||||
End;
|
||||
'R' : Exit;
|
||||
'S' : Begin
|
||||
Save := True;
|
||||
Done := True;
|
||||
End;
|
||||
'T' : Begin
|
||||
Session.io.OutFull(Session.GetPrompt(463));
|
||||
Str := Session.io.GetInput(60, 60, 11, Subj);
|
||||
If Str <> '' Then Subj := Str;
|
||||
Session.io.PromptInfo[2] := Subj;
|
||||
Exit;
|
||||
End;
|
||||
'U' : Begin
|
||||
Session.Msgs.MessageUpload(CurLine);
|
||||
TotalLine := CurLine;
|
||||
Exit;
|
||||
End;
|
||||
End;
|
||||
Until Done;
|
||||
End;
|
||||
|
||||
Procedure Page_Up;
|
||||
Begin
|
||||
If CurLine > 1 Then Begin
|
||||
If LongInt(CurLine - (WinEnd - WinStart)) >= 1 Then
|
||||
Dec (CurLine, (WinEnd - WinStart)) {scroll one page up}
|
||||
Else
|
||||
CurLine := 1;
|
||||
Refresh_Text;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure Page_Down;
|
||||
Begin
|
||||
If CurLine < TotalLine Then Begin
|
||||
If CurLine + (WinEnd - WinStart) <= TotalLine Then
|
||||
Inc (CurLine, (WinEnd - WinStart))
|
||||
Else
|
||||
CurLine := TotalLine;
|
||||
Refresh_Text;
|
||||
End;
|
||||
End;
|
||||
|
||||
Var
|
||||
A : Integer;
|
||||
Begin
|
||||
QuoteCurLine := 0;
|
||||
QuoteTopPage := 1;
|
||||
|
||||
CurLine := Lines;
|
||||
If Lines = 0 Then CurLine := 1;
|
||||
Done := False;
|
||||
CurX := 1;
|
||||
CurY := WinStart;
|
||||
TotalLine := CurLine;
|
||||
|
||||
Dec (WrapPos); { Kludge to make sure text length = WrapPos length }
|
||||
|
||||
For A := Lines + 1 to mysMaxMsgLines Do Session.Msgs.MsgText[A] := '';
|
||||
|
||||
Draw_Screen;
|
||||
|
||||
Session.io.AllowArrow := True;
|
||||
|
||||
Repeat
|
||||
Ch := Session.io.GetKey;
|
||||
If Session.io.IsArrow Then Begin
|
||||
Case Ch of
|
||||
#71 : Begin
|
||||
CurX := 1;
|
||||
UpdatePosition;
|
||||
End;
|
||||
#72 : Up_Key(False);
|
||||
#73 : Page_Up;
|
||||
#75 : Left_Key;
|
||||
#77 : Right_Key;
|
||||
#79 : Begin
|
||||
CurX := Length(Session.Msgs.MsgText[CurLine]) + 1;
|
||||
If CurX > WrapPos Then CurX := WrapPos + 1; {since we DEC(WrapPos) on start}
|
||||
UpdatePosition;
|
||||
End;
|
||||
#80 : Down_Key;
|
||||
#81 : Page_Down;
|
||||
#82 : ToggleInsert (True);
|
||||
#83 : If CurX <= Length(Session.Msgs.MsgText[CurLine]) Then Begin
|
||||
Delete (Session.Msgs.MsgText[CurLine], CurX, 1);
|
||||
Print (Copy(Session.Msgs.MsgText[CurLine], CurX, Length(Session.Msgs.MsgText[CurLine])) + ' ');
|
||||
UpdatePosition;
|
||||
End Else
|
||||
If CurLine < TotalLine Then
|
||||
If (Session.Msgs.MsgText[CurLine] = '') and (TotalLine > 1) Then Begin
|
||||
Delete_Line (CurLine);
|
||||
Refresh_Part;
|
||||
End Else
|
||||
If TotalLine > 1 Then
|
||||
If Length(Session.Msgs.MsgText[CurLine]) + Length(Session.Msgs.MsgText[CurLine + 1]) <= WrapPos Then Begin
|
||||
Session.Msgs.MsgText[CurLine] := Session.Msgs.MsgText[CurLine] + Session.Msgs.MsgText[CurLine + 1];
|
||||
Delete_Line (CurLine + 1);
|
||||
Refresh_Part;
|
||||
End Else
|
||||
For A := Length(Session.Msgs.MsgText[CurLine + 1]) DownTo 1 Do
|
||||
If (Session.Msgs.MsgText[CurLine + 1][A] = ' ') and (Length(Session.Msgs.MsgText[CurLine]) + A <= WrapPos) Then Begin
|
||||
Session.Msgs.MsgText[CurLine] := Session.Msgs.MsgText[CurLine] + Copy(Session.Msgs.MsgText[CurLine + 1], 1, A - 1);
|
||||
Delete (Session.Msgs.MsgText[CurLine + 1], 1, A);
|
||||
Refresh_Part;
|
||||
End;
|
||||
End;
|
||||
End Else
|
||||
Case Ch of
|
||||
^A : Begin
|
||||
Done := True;
|
||||
Save := False;
|
||||
End;
|
||||
{B} #2 : Draw_Screen;
|
||||
#8 : Backspace;
|
||||
{I} #9,
|
||||
#13 : Begin
|
||||
Session.io.PurgeInputBuffer;
|
||||
Do_Enter;
|
||||
End;
|
||||
^Q : Begin
|
||||
If Session.User.ThisUser.UseLBQuote Then
|
||||
QuoteWindow
|
||||
Else
|
||||
Quote;
|
||||
Draw_Screen;
|
||||
End;
|
||||
^V : ToggleInsert (True);
|
||||
{Y} #25 : begin
|
||||
delete_line (curline);
|
||||
refresh_part;
|
||||
end;
|
||||
#27 : Begin
|
||||
Commands;
|
||||
If (Not Save) and (Not Done) Then Draw_Screen;
|
||||
Session.io.AllowArrow := True; { just in case... }
|
||||
End;
|
||||
#32..
|
||||
#254: Begin
|
||||
If Length(Session.Msgs.MsgText[CurLine]) >= WrapPos Then begin
|
||||
If TotalLine < MaxLines Then Begin
|
||||
insert_ch (ch);
|
||||
format_text;
|
||||
End;
|
||||
End Else
|
||||
If (CurX = 1) and (Ch = '/') Then begin
|
||||
Commands;
|
||||
If (Not Save) and (Not Done) Then Draw_Screen;
|
||||
Session.io.AllowArrow := True; { just in case ... }
|
||||
End Else
|
||||
insert_ch (ch);
|
||||
End;
|
||||
End;
|
||||
Until Done;
|
||||
|
||||
Session.io.AllowArrow := False;
|
||||
|
||||
If Save Then Begin
|
||||
A := TotalLine;
|
||||
While (Session.Msgs.MsgText[A] = '') and (A > 1) Do Begin
|
||||
Dec(A);
|
||||
Dec(TotalLine);
|
||||
End;
|
||||
Lines := TotalLine;
|
||||
End;
|
||||
|
||||
AnsiEditor := (Save = True);
|
||||
Session.io.AnsiGotoXY (1, Session.User.ThisUser.ScreenSize);
|
||||
{ Session.io.AnsiGotoXY (1, WinEnd + 1);}
|
||||
End;
|
||||
|
||||
End.
|
||||
200
mystic/bbs_edit_line.pas
Normal file
200
mystic/bbs_edit_line.pas
Normal file
|
|
@ -0,0 +1,200 @@
|
|||
Unit bbs_Edit_Line;
|
||||
|
||||
{$I M_OPS.PAS}
|
||||
|
||||
Interface
|
||||
|
||||
Function LineEditor (Var Lines : SmallInt; MaxLen: Byte; MaxLine: SmallInt; TEdit: Boolean; Forced: Boolean;
|
||||
Var Subj: String) : Boolean;
|
||||
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
m_Strings,
|
||||
bbs_Common,
|
||||
bbs_Core,
|
||||
bbs_FileBase,
|
||||
bbs_User;
|
||||
|
||||
Var
|
||||
CurLine : Integer;
|
||||
Done,
|
||||
Save : Boolean;
|
||||
|
||||
Procedure Quote;
|
||||
Var
|
||||
InFile : Text;
|
||||
Start,
|
||||
Finish : Integer;
|
||||
Lines : Integer;
|
||||
Text : Array[1..mysMaxMsgLines] of String[80];
|
||||
Begin
|
||||
Assign (InFile, Session.TempPath + 'msgtmp');
|
||||
{$I-} Reset (InFile); {$I+}
|
||||
If IoResult <> 0 Then Begin
|
||||
Session.io.OutFullLn (Session.GetPrompt(158));
|
||||
Exit;
|
||||
End;
|
||||
|
||||
Lines := 0;
|
||||
Session.io.AllowPause := True;
|
||||
|
||||
While Not Eof(InFile) Do Begin
|
||||
Inc (Lines);
|
||||
ReadLn (InFile, Text[Lines]);
|
||||
End;
|
||||
|
||||
Close (InFile);
|
||||
|
||||
Session.io.OutFullLn(Session.GetPrompt(452));
|
||||
|
||||
For Start := 1 to Lines Do Begin
|
||||
Session.io.PromptInfo[1] := strI2S(Start);
|
||||
Session.io.PromptInfo[2] := Text[Start];
|
||||
|
||||
Session.io.OutFullLn (Session.GetPrompt(341));
|
||||
|
||||
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.AllowPause := True;
|
||||
|
||||
Session.io.OutFull (Session.GetPrompt(159));
|
||||
Start := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
|
||||
Session.io.OutFull (Session.GetPrompt(160));
|
||||
Finish := strS2I(Session.io.GetInput(3, 3, 11, ''));
|
||||
|
||||
If (Start > 0) and (Start <= Lines) and (Finish <= Lines) Then Begin
|
||||
If Finish = 0 Then Finish := Start;
|
||||
For Lines := Start to Finish Do Begin
|
||||
If CurLine = mysMaxMsgLines Then Break;
|
||||
Session.Msgs.MsgText[CurLine] := Text[Lines];
|
||||
Inc (CurLine);
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
|
||||
Function LineEditor (Var Lines : Integer; MaxLen: Byte; MaxLine: Integer; TEdit, Forced : Boolean; Var Subj: String) : Boolean;
|
||||
|
||||
Procedure Commands;
|
||||
Var
|
||||
Ch : Char;
|
||||
Begin
|
||||
Done := False;
|
||||
Save := False;
|
||||
Repeat
|
||||
Session.io.OutFull (Session.GetPrompt(166));
|
||||
Ch := Session.io.OneKey ('?ACQRSU', True);
|
||||
Case Ch of
|
||||
'?' : Session.io.OutFullLn (Session.GetPrompt(167));
|
||||
'A' : If Forced Then Begin
|
||||
Session.io.OutFull (Session.GetPrompt(307));
|
||||
Exit;
|
||||
End Else
|
||||
Done := Session.io.GetYN(Session.GetPrompt(168), False);
|
||||
'C' : Exit;
|
||||
'Q' : Begin
|
||||
Quote;
|
||||
Exit;
|
||||
End;
|
||||
'R' : Exit;
|
||||
'S' : Begin
|
||||
Save := True;
|
||||
Done := True;
|
||||
End;
|
||||
'U' : Begin
|
||||
Session.Msgs.MessageUpload(CurLine);
|
||||
Exit;
|
||||
End;
|
||||
End;
|
||||
Until Done;
|
||||
End;
|
||||
|
||||
Procedure FullReDraw;
|
||||
Var
|
||||
A : Integer;
|
||||
Begin
|
||||
Session.io.PromptInfo[1] := strI2S(MaxLen);
|
||||
Session.io.PromptInfo[2] := strI2S(MaxLine);
|
||||
|
||||
Session.io.OutFullLn(Session.GetPrompt(162));
|
||||
|
||||
Session.io.OutFullLn(Session.GetPrompt(163));
|
||||
For A := 1 to CurLine Do Begin
|
||||
Session.io.OutRaw (Session.Msgs.MsgText[A]);
|
||||
If A <> CurLine Then Session.io.OutRawLn('');
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure GetText;
|
||||
Var
|
||||
Ch : Char;
|
||||
Begin
|
||||
Repeat
|
||||
Ch := Session.io.GetKey;
|
||||
Case Ch of
|
||||
^R : FullReDraw;
|
||||
#8 : If Length(Session.Msgs.MsgText[CurLine]) > 0 Then Begin
|
||||
Session.io.OutBS(1, True);
|
||||
Dec(Session.Msgs.MsgText[CurLine][0]);
|
||||
End Else If CurLine > 1 Then Begin
|
||||
Dec(CurLine);
|
||||
Session.io.PromptInfo[1] := strI2S(CurLine);
|
||||
Session.io.OutFullLn (Session.GetPrompt(165));
|
||||
Session.io.OutRaw (Session.Msgs.MsgText[CurLine]);
|
||||
If Session.Msgs.MsgText[CurLine] <> '' Then Begin
|
||||
Session.io.OutBS(1, True);
|
||||
Dec(Session.Msgs.MsgText[CurLine][0]);
|
||||
End;
|
||||
End;
|
||||
#13 : Begin
|
||||
If CurLine < MaxLine Then Begin
|
||||
Inc(CurLine);
|
||||
Session.io.OutRaw (#13#10);
|
||||
End;
|
||||
End;
|
||||
Else
|
||||
If (Ch = '/') and (Length(Session.Msgs.MsgText[CurLine]) = 0) Then Begin
|
||||
Commands;
|
||||
If (Not Save) and (Not Done) Then FullReDraw;
|
||||
End Else
|
||||
If Ch in [#32..#254] Then Begin
|
||||
If Length(Session.Msgs.MsgText[Curline]) < MaxLen Then Begin
|
||||
Session.Msgs.MsgText[CurLine] := Session.Msgs.MsgText[CurLine] + Ch;
|
||||
Session.io.BufAddChar (Ch);
|
||||
End;
|
||||
If (Length(Session.Msgs.MsgText[CurLine]) > MaxLen-1) and (CurLine < MaxLine) Then Begin
|
||||
strWrap (Session.Msgs.MsgText[CurLine], Session.Msgs.MsgText[Succ(CurLine)], MaxLen);
|
||||
Inc(CurLine);
|
||||
Session.io.OutBS (Length(Session.Msgs.MsgText[CurLine]), True);
|
||||
Session.io.OutRawLn ('');
|
||||
Session.io.OutRaw (Session.Msgs.MsgText[CurLine]);
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
Until Done;
|
||||
End;
|
||||
|
||||
Var
|
||||
A : Integer;
|
||||
Begin
|
||||
CurLine := Lines;
|
||||
If CurLine < MaxLine Then Inc(CurLine);
|
||||
Done := False;
|
||||
For A := Lines + 1 to mysMaxMsgLines Do Session.Msgs.MsgText[A] := '';
|
||||
FullReDraw;
|
||||
GetText;
|
||||
|
||||
If Save Then Begin
|
||||
Lines := CurLine - 1;
|
||||
LineEditor := True;
|
||||
End Else
|
||||
LineEditor := False;
|
||||
End;
|
||||
|
||||
End.
|
||||
3408
mystic/bbs_filebase.pas
Normal file
3408
mystic/bbs_filebase.pas
Normal file
File diff suppressed because it is too large
Load diff
1560
mystic/bbs_general.pas
Normal file
1560
mystic/bbs_general.pas
Normal file
File diff suppressed because it is too large
Load diff
1824
mystic/bbs_io.pas
Normal file
1824
mystic/bbs_io.pas
Normal file
File diff suppressed because it is too large
Load diff
3664
mystic/bbs_msgbase.pas
Normal file
3664
mystic/bbs_msgbase.pas
Normal file
File diff suppressed because it is too large
Load diff
608
mystic/bbs_msgbase_abs.pas
Normal file
608
mystic/bbs_msgbase_abs.pas
Normal file
|
|
@ -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.
|
||||
486
mystic/bbs_msgbase_ansi.pas
Normal file
486
mystic/bbs_msgbase_ansi.pas
Normal file
|
|
@ -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.
|
||||
1831
mystic/bbs_msgbase_jam.pas
Normal file
1831
mystic/bbs_msgbase_jam.pas
Normal file
File diff suppressed because it is too large
Load diff
1582
mystic/bbs_msgbase_squish.pas
Normal file
1582
mystic/bbs_msgbase_squish.pas
Normal file
File diff suppressed because it is too large
Load diff
497
mystic/bbs_nodechat.pas
Normal file
497
mystic/bbs_nodechat.pas
Normal file
|
|
@ -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.
|
||||
196
mystic/bbs_nodeinfo.pas
Normal file
196
mystic/bbs_nodeinfo.pas
Normal file
|
|
@ -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.
|
||||
292
mystic/bbs_sysopchat.pas
Normal file
292
mystic/bbs_sysopchat.pas
Normal file
|
|
@ -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.
|
||||
1316
mystic/bbs_user.pas
Normal file
1316
mystic/bbs_user.pas
Normal file
File diff suppressed because it is too large
Load diff
Loading…
Reference in a new issue