Initial import
This commit is contained in:
mysticbbs
parent
0fc68847ac
commit
e98cf71497
|
|
@ -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.
|
||||
|
|
@ -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>
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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 ----------------------------------------------------------- }
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue