eric
/
Renegade-1.19
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
Renegade-1.19/SOURCE/COMMON.PAS

5077 lines
141 KiB
Plaintext
Raw Normal View History

Reset
2022-06-21 17:11:35 -07:00
{$IFDEF WIN32}
{$I DEFINES.INC}
{$ENDIF}
{$A+,B-,D-,E-,F+,I-,L-,N+,O-,R-,S-,V-}
UNIT Common;
INTERFACE
USES
Crt,
Dos,
MyIO,
TimeFunc;
{$I RECORDS.PAS}
CONST
StrLen = 119;
TYPE
MCIFunctionType = FUNCTION(CONST s: AStr; Data1, Data2: Pointer): STRING;
MemMenuRec = RECORD { Menu Record }
LDesc: ARRAY[1..3] OF STRING[100]; { menu name }
ACS: ACString; { access requirements }
NodeActivityDesc: STRING[50];
MenuFlags: MenuFlagSet; { menu status variables }
LongMenu: STRING[12]; { displayed IN place OF long menu }
MenuNum: Byte; { menu number }
MenuPrompt: STRING[120]; { menu Prompt }
Password: STRING[20]; { password required }
FallBack: Byte; { fallback menu }
Directive: STRING[12];
ForceHelpLevel: Byte; { forced help Level FOR menu }
GenCols: Byte; { generic menus: # OF columns }
GCol: ARRAY[1..3] OF Byte; { generic menus: colors }
END;
MemCmdRec = RECORD { Command records }
LDesc: STRING[100]; { long command description }
ACS: ACString; { access requirements }
NodeActivityDesc: STRING[50];
CmdFlags: CmdFlagSet; { command status variables }
SDesc: STRING[35]; { short command description }
CKeys: STRING[14]; { command-execution keys }
CmdKeys: STRING[2]; { command keys: type OF command }
Options: STRING[50]; { MString: command data }
END;
LightBarRecordType = RECORD
XPos,
YPos: Byte;
CmdToExec: SmallInt;
CmdToShow: STRING[40];
END;
States =
(Waiting,
Bracket,
Get_Args,
Get_Param,
Eat_Semi,
In_Param,
GetAvCmd,
GetAvAttr,
GetAvRLE1,
GetAvRLE2,
GetAvX,
GetAvY);
StorageType =
(Disk,
CD,
Copied);
TransferFlagType =
(lIsAddDLBatch,
IsFileAttach,
IsUnlisted,
IsTempArc,
IsQWK,
IsNoFilePoints,
IsNoRatio,
IsCheckRatio,
IsCDRom,
IsPaused,
IsAutoLogOff,
IsKeyboardAbort,
IsTransferOk);
TransferFlagSet = SET OF TransferFlagType;
BatchDLRecordType = RECORD
BDLFileName: Str52;
BDLOwnerName: Str36;
BDLStorage: StorageType;
BDLUserNum,
BDLSection,
BDLPoints,
BDLUploader: SmallInt;
BDLFSize,
BDLTime: LongInt;
BDLFlags: TransferFlagSet;
END;
BatchULRecordType = RECORD
BULFileName: Str12;
BULUserNum,
BULSection: SmallInt;
BULDescription: Str50;
BULVPointer: LongInt;
BULVTextSize: SmallInt;
END;
ExtendedDescriptionArray = ARRAY [1..99] OF Str50;
IEMSIRecord = RECORD
UserName,
Handle: STRING[36];
CityState: STRING[30];
Ph: STRING[12];
PW: STRING[20];
BDate: STRING[10];
END;
StrPointerRec = RECORD
Pointer,
TextSize: LongInt;
END;
MemCmdPointer = ^MemCmdArray;
MemCmdArray = ARRAY [1..MaxCmds] OF MemCmdRec;
MCIBufferType = ARRAY [1..MaxConfigurable] OF Char;
MCIBufferPtr = ^MCIBufferType;
Multitasker =
(None, (* Dos 5 thu 9 *)
DV,
Win,
OS2,
Win32,
DOS5N);
InputFlagType =
(UpperOnly, { Uppercase only }
ColorsAllowed, { Colors allowed }
NoLineFeed, { Linefeeds OFF - no linefeed after <CR> pressed }
ReDisplay, { Display old IF no change }
CapWords, { Capitalize characters }
InterActiveEdit, { Interactive editing }
NumbersOnly,
DisplayValue,
NegativeAllowed); { Numbers only }
InputFlagSet = SET OF InputFlagType;
ValidationKeyType = SET OF '!'..'~'; (* Remove q and Q *)
ConferenceKeyType = SET OF '@'..'Z';
CompArrayType = ARRAY[0..1] OF SMALLINT;
CONST
MCIBuffer: MCIBufferPtr = NIL;
DieLater: Boolean = FALSE; { IF TRUE, Renegade locks up }
F_HOME = 18176; { 256 * Scan Code }
F_UP = 18432;
F_PGUP = 18688;
F_LEFT = 19200;
F_RIGHT = 19712;
F_END = 20224;
F_DOWN = 20480;
F_PGDN = 20736;
F_INS = 20992;
F_DEL = 21248;
F_CTRLLEFT = 29440;
F_CTRLRIGHT = 29696;
NoCallInitTime = (30 * 60); { thirty minutes between modem inits }
Tasker: Multitasker = None;
LastScreenSwap: LongInt = 0;
ParamArr: ARRAY [1..5] OF Word = (0,0,0,0,0);
Params: Word = 0; { number OF parameters }
NextState: States = Waiting; { Next state FOR the parser }
TempSysOp: Boolean = FALSE; { is temporary sysop? }
Reverse: Boolean = FALSE; { TRUE IF Text attributes are reversed }
TimeLock: Boolean = FALSE; { IF TRUE, DO NOT HangUp due TO time! }
SaveX: Byte = 0; { FOR ANSI driver}
SaveY: Byte = 0; { FOR ANSI driver}
TempPause: Boolean = TRUE; { is Pause on OR off? Set at prompts, OneK, used everywhere }
OfflineMail: Boolean = FALSE; { are we IN the offline mail system? }
MultiNodeChat: Boolean = FALSE; { are we IN MultiNode chat?}
ChatChannel: Integer = 0; { What chat channel are we IN? }
DisplayingMenu: Boolean = FALSE; { are we displaying a menu? }
InVisEdit: Boolean = FALSE; { are we IN the visual editor? }
MenuAborted: Boolean = FALSE; { was the menu Aborted? }
AllowAbort: Boolean = TRUE; { are Aborts allowed? }
MCIAllowed: Boolean = TRUE; { is mci allowed? }
ColorAllowed: Boolean = TRUE; { is color allowed? }
Echo: Boolean = TRUE; { is Text being echoed? (FALSE=use echo Chr)}
HangUp: Boolean = TRUE; { is User offline now? }
TimedOut: Boolean = FALSE; { has he timed out? }
NoFile: Boolean = TRUE; { did last pfl() FILE NOT Exist? }
SLogging: Boolean = TRUE; { are we outputting TO the SysOp log? }
SysOpOn: Boolean = TRUE; { is SysOp logged onto the WFC menu? }
WantOut: Boolean = TRUE; { output Text locally? }
WColor: Boolean = TRUE; { IN chat: was last key pressed by SysOp? }
BadDLPath: Boolean = FALSE; { is the current DL path BAD? }
BadUlPath: Boolean = FALSE; { is the current UL path BAD? }
BeepEnd: Boolean = FALSE; { whether TO beep after caller logs off }
FileAreaNameDisplayed: Boolean = FALSE; { was FILE area name printed yet? }
CFO: Boolean = FALSE; { is chat FILE open? }
InChat: Boolean = FALSE; { are we IN chat Mode? }
ChatCall: Boolean = FALSE; { is the chat call "noise" on? }
ContList: Boolean = FALSE; { continuous message listing Mode on? }
CROff: Boolean = FALSE; { are CRs turned off? }
CtrlJOff: Boolean = FALSE; { turn color TO #1 after ^Js?? }
DoneAfterNext: Boolean = FALSE; { offhook AND Exit after Next logoff? }
DoneDay: Boolean = FALSE; { are we done now? ready TO drop TO DOS?}
DOSANSIOn: Boolean = FALSE; { output chrs TO DOS FOR ANSI codes?!!? }
FastLogon: Boolean = FALSE; { IF a FAST LOGON is requested }
HungUp: Boolean = FALSE; { did User drop carrier? }
InCom: Boolean = FALSE; { accepting input from com? }
InWFCMenu: Boolean = FALSE; { are we IN the WFC menu? }
LastCommandGood: Boolean = FALSE;{ was last command a REAL command? }
LastCommandOvr: Boolean = FALSE; { override Pause? (NO Pause?) }
LocalIOOnly: Boolean = FALSE; { local I/O ONLY? }
MakeQWKFor: Integer = 0; { make a qwk packet ONLY? }
UpQWKFor: Integer = 0; { upload a qwk packet ONLY? }
RoomNumber: Integer = 0; { Room OF teleconference }
PackBasesOnly: Boolean = FALSE; { pack message bases ONLY? }
SortFilesOnly: Boolean = FALSE; { sort FILE bases ONLY? }
FileBBSOnly: Boolean = FALSE;
NewMenuToLoad: Boolean = FALSE; { menu command returns TRUE IF new menu TO load }
OvrUseEMS: Boolean = TRUE;
OverLayLocation: Byte = 0; { 0=Normal, 1=EMS, 2=XMS }
OutCom: Boolean = FALSE; { outputting TO com? }
DirFileopen1: Boolean = TRUE; { whether DirFile has been opened before }
ExtFileOpen1: Boolean = TRUE;
PrintingFile: Boolean = FALSE; { are we printing a FILE? }
AllowContinue: Boolean = FALSE; { Allow Continue prompts? }
QuitAfterDone: Boolean = FALSE; { quit after Next User logs off? }
Reading_A_Msg: Boolean = FALSE; { is User reading a message? }
ReadingMail: Boolean = FALSE; { reading private mail? }
ShutUpChatCall: Boolean = FALSE; { was chat call "SHUT UP" FOR this call? }
Trapping: Boolean = FALSE; { are we Trapping users Text? }
UserOn: Boolean = FALSE; { is there a User on right now? }
WasNewUser: Boolean = FALSE; { did a NEW User log on? }
Write_Msg: Boolean = FALSE; { is User writing a message? }
NewEchoMail: Boolean = FALSE; { has new echomail been entered? }
TimeWarn: Boolean = FALSE; { has User been warned OF time shortage? }
TellUserEvent: Byte = 0; { has User been told about the up-coming event? }
ExitErrors: Byte = 1; { errorLEVEL FOR Critical error Exit }
ExitNormal: Byte = 0; { errorLEVEL FOR Normal Exit }
TodayCallers: Integer = 0; { new system callers }
lTodaynumUsers: Integer = 0; { new number OF users }
ThisNode: Byte = 0; { node number }
AnswerBaud: LongInt = 0; { baud rate TO answer the phone at }
ExtEventTime: Word = 0; { # minutes before External event }
IsInvisible: Boolean = FALSE; { Run IN invisible Mode? }
SaveNDescription: STRING[50] = 'Miscellaneous';
SaveNAvail: Boolean = FALSE;
LastWFCX: Byte = 1;
LastWFCY: Byte = 1;
ANSIDetected: Boolean = FALSE;
{ Added June 21, 2013 //sk5 }
PauseIsNull : Boolean = FALSE; { Added for null pause }
BuildDate : Array [1..5] of Word = ( 5, 27, 2013, 9, 19 ); { Build date MM, DD, YYYY, HR, MIN }
VAR
LightBarArray: ARRAY[1..50] OF LightBarRecordType;
LightBarCmd,
LightBarCounter: Byte;
LightBarFirstCmd: Boolean;
Telnet: Boolean;
HangUpTelnet: Boolean;
DatFilePath: STRING[40];
Interrupt14: Pointer; { far ptr TO interrupt 14 }
{$IFDEF MSDOS}
Ticks: LongInt ABSOLUTE $0040:$006C;
{$ENDIF}
IEMSIRec: IEMSIRecord;
FossilPort: Word;
SockHandle: STRING; { Telnet Handle }
CallerIDNumber: STRING[40]; { Caller ID STRING obtained from modem }
ActualSpeed: LongInt; { Actual connect rate }
Reliable: Boolean; { error correcting connection? }
ComPortSpeed: LongInt; { com port rate }
LastError: Integer; { Results from last IOResult, when needed }
General: GeneralRecordType; { configuration information }
DirInfo: SearchRec;
{ LastCallers }
LastCallerFile : FILE OF LastCallerRec;
LastCallers : LastCallerRec;
{ Today's History }
HistoryFile : FILE OF HistoryRecordType;
HistoryRec : HistoryRecordType;
{ Voting Variables }
VotingFile: FILE OF VotingRecordType;
Topic: VotingRecordType;
NumVotes: Byte;
BBSListFile: FILE OF BBSListRecordType; { bbslist.dat }
{ Conference Variables }
ConferenceFile: FILE OF ConferenceRecordType; { CONFRENC.DAT }
Conference: ConferenceRecordType; { Conferences }
ConfKeys: ConferenceKeyType;
NumConfKeys: Integer;
CurrentConf: Char; { Current conference tag }
ConfSystem: Boolean; { is the conference system enabled? }
{ Validation Variables }
ValidationFile: FILE OF ValidationRecordType;
Validation: ValidationRecordType;
NumValKeys: Byte;
ValKeys: ValidationKeyType;
NumArcs: Byte;
NodeFile: FILE OF NodeRecordType; { multi node FILE }
NodeR: NodeRecordType;
NodeChatLastRec: LongInt; { last record IN group chat FILE Read }
Liner: LineRec;
SysOpLogFile, { SYSOP.LOG }
SysOpLogFile1, { SLOGxxxx.LOG }
TrapFile, { TRAP*.MSG }
ChatFile: Text; { CHAT*.MSG }
{ User Variables }
UserFile: FILE OF UserRecordType; { User.LST }
UserIDXFile: FILE OF UserIDXRec; { User.IDX }
ThisUser: UserRecordType; { User's account records }
{ Color Scheme Variables }
SchemeFile: FILE OF SchemeRec; { SCHEME.DAT }
Scheme: SchemeRec;
NumSchemes: Integer;
{ Event Variables }
EventFile: FILE OF EventRecordType;
MemEventArray: ARRAY [1..MaxEvents] OF ^EventRecordType;
Event: EventRecordType;
NumEvents: Integer; { # OF events }
{ Protocol Variables }
ProtocolFile: FILE OF ProtocolRecordType; { PROTOCOL.DAT }
Protocol: ProtocolRecordType; { protocol IN memory }
NumProtocols: Integer;
{ File Variables }
FileAreaFile: FILE OF FileAreaRecordType; { FBASES.DAT }
MemFileArea,
TempMemFileArea: FileAreaRecordType; { File area and temporary file area in memory }
FileInfoFile: FILE OF FileInfoRecordType; { *.DIR }
ExtInfoFile: FILE; { *.EXT }
FileInfo: FileInfoRecordType;
ExtendedArray: ExtendedDescriptionArray;
NewFilesF: Text; { For NEWFILES.DAT in the qwk system }
FileArea, { File base User is in }
NumFileAreas, { Max number OF FILE bases }
ReadFileArea, { current uboard # IN memory }
LowFileArea,
HighFileArea: Integer;
NewScanFileArea: Boolean; { New scan this base? }
{ Batch Download Variables }
BatchDLFile: FILE OF BatchDLRecordType;
BatchDL: BatchDLRecordType;
NumBatchDLFiles: Byte; { # files IN DL batch queue }
BatchDLSize,
BatchDLPoints,
BatchDLTime: LongInt; { }
{ Batch Upload Variables }
BatchULFile: FILE OF BatchULRecordType;
BatchULF: FILE;
BatchUL: BatchULRecordType;
NumBatchULFiles: Byte; { # files IN UL batch queue }
{ Message Variables }
EmailFile: FILE OF MessageAreaRecordType;
MsgAreaFile: FILE OF MessageAreaRecordType; { MBASES.DAT }
MemMsgArea: MessageAreaRecordType; { MsgArea IN memory }
MsgHdrF: FILE OF MHeaderRec; { *.HDR }
MsgTxtF: FILE; { *.DAT }
LastReadRecord: ScanRec;
LastAuthor, { Author # OF the last message }
NumMsgAreas, { Max number OF msg bases }
MsgArea,
ReadMsgArea,
LowMsgArea,
HighMsgArea: Integer;
Msg_On: Word; { current message being Read }
{ Menu Variables }
MenuFile: FILE OF MenuRec;
MenuR: MenuRec;
MemMenu: MemMenuRec; { menu information }
MemCmd: MemCmdPointer; { Command information }
MenuRecNumArray: ARRAY [1..MaxMenus] OF Integer;
CmdNumArray: ARRAY [1..MaxMenus] OF Byte;
MenuStack: ARRAY [1..MaxMenus] OF Byte; { menu stack }
MenuKeys: AStr; { keys TO Abort menu display WITH }
NumMenus,
NumCmds,
GlobalCmds,
MenuStackPtr,
FallBackMenu,
CurMenu,
CurHelpLevel: Byte;
Buf: STRING[255]; { macro buffer }
MLC: STRING[255]; { multiline FOR chat }
ChatReason, { last chat reason }
LastLineStr, { "last-line" STRING FOR Word-wrapping }
StartDir: AStr; { Directory BBS was executed from }
TempDir, { Temporary Directory base name }
InResponseTo: STRING[40]; { reason FOR reply }
LastDIRFileName: Str12; { last filename FOR recno/nrecno }
CurrentColor, { current ANSI color }
ExiterrorLevel, { errorLEVEL TO Exit WITH }
TShuttleLogon, { type OF special Shuttle Logon command }
TFilePrompt, { type OF special FILE Prompt command }
TReadPrompt, { type OF special Read Prompt command }
PublicPostsToday, { posts made by User this call }
FeedBackPostsToday, { feedback sent by User this call }
PrivatePostsToday: Byte; { E-mail sent by User this call }
LastDIRRecNum, { last record # FOR recno/nrecno }
ChatAttempts, { number chat attempts made by User }
LIL, { lines on screen since last PauseScr() }
PublicReadThisCall, { # public messages has Read this call }
UserNum: Integer; { User's User number }
Rate: Word; { cps FOR FILE transfers }
NewFileDate, { NewScan Pointer date }
DownloadsToday, { download sent TO User this call }
UploadsToday, { uploads sent by User this call }
DownloadKBytesToday, { download k by User this call }
UploadKBytesToday, { upload k by User this call }
CreditsLastUpdated, { Time Credits last updated }
TimeOn, { time User logged on }
LastBeep,
LastKeyHit,
ChopTime, { time TO chop off FOR system events }
ExtraTime, { extra time - given by F7/F8, etc }
CreditTime, { credit time adjustment }
FreeTime: LongInt; { free time }
BlankMenuNow, { is the wfcmenu blanked out? }
Abort,
Next, { global Abort AND Next }
RQArea,
FQArea,
MQArea,
VQArea: Boolean;
{$IFDEF WIN32}
procedure Sound(hz: Word; duration: Word);
function Ticks: LongInt;
{$ENDIF}
FUNCTION GetC(c: Byte): STRING;
PROCEDURE ShowColors;
FUNCTION CheckDriveSpace(S,Path: AStr; MinSpace: Integer): Boolean;
FUNCTION StripLeadSpace(S: STRING): STRING;
FUNCTION StripTrailSpace(S: STRING): STRING;
FUNCTION SemiCmd(S: AStr; B: Byte): STRING;
FUNCTION ExistDrive(Drive: Char): Boolean;
PROCEDURE RenameFile(DisplayStr: AStr; OldFileName,NewFileName: AStr; VAR ReNameOk: Boolean);
FUNCTION GetFileSize(FileName: AStr): LongInt;
PROCEDURE GetFileDateTime(CONST FileName: AStr; VAR FileTime: LongInt);
PROCEDURE SetFileDateTime(CONST FileName: AStr; FileTime: LongInt);
FUNCTION PHours(CONST DisplayStr: AStr; LoTime,HiTime: Integer): AStr;
FUNCTION RGSysCfgStr(StrNum: LongInt; PassValue: Boolean): AStr;
FUNCTION RGNoteStr(StrNum: LongInt; PassValue: Boolean): AStr;
FUNCTION RGMainStr(StrNum: LongInt; PassValue: Boolean): AStr;
FUNCTION lRGLNGStr(StrNum: LongInt; PassValue: Boolean): AStr;
PROCEDURE GetPassword(VAR PW: AStr; Len: Byte);
PROCEDURE MakeDir(VAR Path: PathStr; AskMakeDir: Boolean);
PROCEDURE Messages(Msg,MaxRecs: Integer; AreaName: AStr);
PROCEDURE DisplayBuffer(MCIFunction: MCIFunctionType; Data1, Data2:Pointer);
FUNCTION ReadBuffer(FileName: AStr): Boolean;
FUNCTION chinkey: Char;
FUNCTION FormatNumber(L: LongInt): STRING;
FUNCTION ConvertBytes(BytesToConvert: LongInt; OneChar: Boolean): STRING;
FUNCTION ConvertKB(KBToConvert: LongInt; OneChar: Boolean): STRING;
PROCEDURE WriteWFC(c: Char);
FUNCTION AccountBalance: LongInt;
PROCEDURE AdjustBalance(Adjustment: LongInt);
PROCEDURE BackErase(Len: Byte);
FUNCTION UpdateCRC32(CRC: LongInt; VAR Buffer; Len: Word): LongInt;
FUNCTION CRC32(s: AStr): LongInt;
FUNCTION FunctionalMCI(CONST s: AStr; FileName,InternalFileName: AStr): STRING;
FUNCTION MCI(CONST s: STRING): STRING;
FUNCTION Plural(InString: STRING; Number: Byte): STRING;
FUNCTION FormattedTime(TimeUsed: LongInt): STRING;
FUNCTION SearchUser(Uname: Str36; RealNameOK: Boolean): Integer;
PROCEDURE PauseScr(IsCont: Boolean);
PROCEDURE Com_Send_Str(CONST InString: AStr);
PROCEDURE dophoneHangup(ShowIt: Boolean);
PROCEDURE DoTelnetHangUp(ShowIt: Boolean);
PROCEDURE DoPhoneOffHook(ShowIt: Boolean);
PROCEDURE InputPath(CONST DisplayStr: AStr; VAR DirPath: Str40; CreateDir,AllowExit: Boolean; VAR Changed: Boolean);
FUNCTION StripName(InString: STRING): STRING;
PROCEDURE PurgeDir(s: AStr; SubDirs: Boolean);
PROCEDURE DOSANSI(CONST c: Char);
FUNCTION HiMsg: Word;
FUNCTION OnNode(UserNumber: Integer): Byte;
FUNCTION MaxUsers: Integer;
PROCEDURE Kill(CONST FileName: AStr);
PROCEDURE ScreenDump(CONST FileName: AStr);
PROCEDURE ScanInput(VAR s: AStr; CONST Allowed: AStr);
PROCEDURE Com_Flush_Recv;
PROCEDURE Com_Flush_Send;
PROCEDURE Com_Purge_Send;
FUNCTION Com_Carrier: Boolean;
FUNCTION Com_Recv: Char;
FUNCTION Com_IsRecv_Empty: Boolean;
FUNCTION Com_IsSend_Empty: Boolean;
PROCEDURE Com_Send(c: Char);
PROCEDURE Com_Set_Speed(Speed: LongInt);
PROCEDURE Com_DeInstall;
PROCEDURE Com_Install;
PROCEDURE CheckHangup;
PROCEDURE SerialOut(s: STRING);
FUNCTION Empty:Boolean;
PROCEDURE DTR(Status: Boolean);
PROCEDURE BackSpace;
PROCEDURE DoBackSpace(Start,Finish: Byte);
FUNCTION LennMCI(CONST InString: STRING): Integer;
FUNCTION MsgSysOp: Boolean;
FUNCTION FileSysOp: Boolean;
FUNCTION CoSysOp: Boolean;
FUNCTION SysOp: Boolean;
FUNCTION Timer: LongInt;
PROCEDURE TeleConfCheck;
FUNCTION Substitute(Src: STRING; CONST old,New: STRING): STRING;
PROCEDURE NewCompTables;
FUNCTION OkANSI: Boolean;
FUNCTION OkAvatar: Boolean;
FUNCTION OkRIP: Boolean;
FUNCTION OkVT100: Boolean;
FUNCTION NSL: LongInt;
FUNCTION AgeUser(CONST BirthDate: LongInt): Word;
FUNCTION AllCaps(Instring: STRING): STRING;
FUNCTION Caps(Instring: STRING): STRING;
PROCEDURE Update_Screen;
FUNCTION PageLength: Word;
PROCEDURE lStatus_Screen(WhichScreen: Byte; Message: AStr; OneKey: Boolean; VAR Answer: AStr);
FUNCTION CInKey: Char;
FUNCTION CheckPW: Boolean;
FUNCTION StripColor(CONST InString: STRING): STRING;
PROCEDURE sl1(s: AStr);
PROCEDURE SysOpLog(s: AStr);
FUNCTION StrToInt(S: Str11): LongInt;
FUNCTION RealToStr(R: Real; W,D: Byte): STRING;
FUNCTION ValueR(S: AStr): REAL;
PROCEDURE ShellDos(MakeBatch: Boolean; CONST Command: AStr; VAR ResultCode: Integer);
PROCEDURE SysOpShell;
PROCEDURE RedrawForANSI;
PROCEDURE Star(InString: AStr);
FUNCTION GetKey: Word;
PROCEDURE SetC(C: Byte);
PROCEDURE UserColor(Color: Byte);
PROCEDURE Prompt(CONST InString: STRING);
FUNCTION SQOutSp(InString: STRING): STRING;
FUNCTION ExtractDriveNumber(s: AStr): Byte;
FUNCTION PadLeftStr(InString: STRING; MaxLen: Byte): STRING;
FUNCTION PadRightStr(InString: STRING; MaxLen: Byte): STRING;
FUNCTION PadLeftInt(L: LongInt; MaxLen: Byte): STRING;
FUNCTION PadRightInt(L: LongInt; MaxLen: Byte): STRING;
PROCEDURE Print(CONST InString: STRING);
PROCEDURE NL;
PROCEDURE Prt(CONST Instring: STRING);
PROCEDURE MPL(MaxLen: Byte);
FUNCTION CTP(t,b: LongInt): STRING;
PROCEDURE TLeft;
PROCEDURE LoadNode(NodeNumber: Byte);
PROCEDURE Update_Node(NActivityDesc: AStr; SaveVars: Boolean);
FUNCTION MaxNodes: Byte;
FUNCTION MaxChatRec: LongInt;
PROCEDURE SaveNode(NodeNumber: Byte);
PROCEDURE LoadURec(VAR User: UserRecordType; UserNumber: Integer);
PROCEDURE SaveURec(User: UserRecordType; UserNumber:Integer);
FUNCTION MaxIDXRec: Integer;
FUNCTION InKey: Word;
PROCEDURE OutKey(c: Char);
PROCEDURE CLS;
PROCEDURE Wait(b: Boolean);
FUNCTION DisplayARFlags(AR: ARFlagSet; C1,C2: Char): AStr;
PROCEDURE ToggleARFlag(Flag: Char; VAR AR: ARFlagSet; VAR Changed: Boolean);
FUNCTION DisplayACFlags(Flags: FlagSet; C1,C2: Char): AStr;
PROCEDURE ToggleACFlag(Flag: FlagType; VAR Flags: FlagSet);
PROCEDURE ToggleACFlags(Flag: Char; VAR Flags: FlagSet; VAR Changed: Boolean);
PROCEDURE ToggleStatusFlag(Flag: StatusFlagType; VAR SUFlags: StatusFlagSet);
PROCEDURE ToggleStatusFlags(Flag: Char; VAR SUFlags: StatusFlagSet);
FUNCTION TACCH(Flag: Char): FlagType;
PROCEDURE LCmds(Len,c: Byte; c1,c2: AStr);
PROCEDURE LCmds3(Len,c: Byte; c1,c2,c3: AStr);
PROCEDURE InitTrapFile;
FUNCTION AOnOff(b: Boolean; CONST s1,s2: AStr): STRING;
FUNCTION ShowOnOff(b: Boolean): STRING;
FUNCTION ShowYesNo(b: Boolean): STRING;
FUNCTION YN(Len: Byte; DYNY: Boolean): Boolean;
FUNCTION PYNQ(CONST InString: AStr; MaxLen: Byte; DYNY: Boolean): Boolean;
PROCEDURE InputLongIntWC(S: AStr; VAR L: LongInt; InputFlags: InputFlagSet; LowNum,HighNum: LongInt; VAR Changed: Boolean);
PROCEDURE InputLongIntWOC(S: AStr; VAR L: LongInt; InputFlags: InputFlagSet; LowNum,HighNum: LongInt);
PROCEDURE InputWordWC(S: AStr; VAR W: SmallWord; InputFlags: InputFlagSet; LowNum,HighNum: Word; VAR Changed: Boolean);
PROCEDURE InputWordWOC(S: AStr; VAR W: SmallWord; InputFlags: InputFlagSet; LowNum,HighNum: Word);
PROCEDURE InputIntegerWC(S: AStr; VAR I: SmallInt; InputFlags: InputFlagSet; LowNum,HighNum: Integer; VAR Changed: Boolean);
PROCEDURE InputIntegerWOC(S: AStr; VAR I: SmallInt; InputFlags: InputFlagSet; LowNum,HighNum: Integer);
PROCEDURE InputByteWC(S: AStr; VAR B: Byte; InputFlags: InputFlagSet; LowNum,HighNum: Byte; VAR Changed: Boolean);
PROCEDURE InputByteWOC(S: AStr; VAR B: Byte; InputFlags: InputFlagSet; LowNum,HighNum: Byte);
PROCEDURE InputDefault(VAR S: STRING; v: STRING; MaxLen: Byte; InputFlags: InputFlagSet; LineFeed: Boolean);
PROCEDURE InputFormatted(DisplayStr: AStr; VAR InputStr: STRING; v: STRING; Abortable: Boolean);
PROCEDURE InputWN1(DisplayStr: AStr; VAR InputStr: AStr; MaxLen: Byte; InputFlags: InputFlagSet; VAR Changed: Boolean);
PROCEDURE InputWNWC(DisplayStr: AStr; VAR InputStr: AStr; MaxLen: Byte; VAR Changed: Boolean);
PROCEDURE InputMain(VAR s: STRING; MaxLen: Byte; InputFlags: InputFlagSet);
PROCEDURE InputWC(VAR s: STRING; MaxLen: Byte);
PROCEDURE Input(VAR s: STRING; MaxLen: Byte);
PROCEDURE InputL(VAR s: STRING; MaxLen: Byte);
PROCEDURE InputCaps(VAR s: STRING; MaxLen: Byte);
PROCEDURE OneK(VAR C: Char; ValidKeys: AStr; DisplayKey,LineFeed: Boolean);
PROCEDURE OneK1(VAR C: Char; ValidKeys: AStr; DisplayKey,LineFeed: Boolean);
PROCEDURE LOneK(DisplayStr: AStr; VAR C: Char; ValidKeys: AStr; DisplayKey,LineFeed: Boolean);
PROCEDURE Local_Input1(VAR S: STRING; MaxLen: Byte; LowerCase: Boolean);
PROCEDURE Local_Input(VAR S: STRING; MaxLen: Byte);
PROCEDURE Local_InputL(VAR S: STRING; MaxLen: Byte);
PROCEDURE Local_OneK(VAR C: Char; S: STRING);
FUNCTION Centre(InString: AStr): STRING;
PROCEDURE WKey;
PROCEDURE PrintMain(CONST ss: STRING);
PROCEDURE PrintACR(InString: STRING);
PROCEDURE SaveGeneral(X: Boolean);
PROCEDURE pfl(FN: AStr);
PROCEDURE PrintFile(FileName: AStr);
FUNCTION BSlash(InString: AStr; b: Boolean): AStr;
FUNCTION Exist(FileName: AStr): Boolean;
FUNCTION ExistDir(Path: PathStr): Boolean;
PROCEDURE PrintF(FileName: AStr);
PROCEDURE SKey1(VAR c: Char);
FUNCTION VerLine(B: Byte): STRING;
FUNCTION AACS1(User: UserRecordType; UNum: Integer; S: ACString): Boolean;
FUNCTION AACS(s: ACString): Boolean;
FUNCTION DiskKBFree(DrivePath: AStr): LongInt;
FUNCTION IntToStr(L: LongInt): STRING;
IMPLEMENTATION
USES
Common1,
Common2,
Common3,
Common4,
Events,
File0,
File11,
Mail0,
MultNode,
{$IFDEF MSDOS}
SpawnO,
{$ENDIF}
SysOp12,
Vote
{$IFDEF WIN32}
,VPSysLow
,VPUtils
,Windows
{$ENDIF}
;
{$IFDEF WIN32}
procedure Sound(hz: Word; duration: Word);
begin
Windows.Beep(hz, duration);
end;
function Ticks: LongInt;
begin
Ticks := GetTimeMSec div 55;
end;
{$ENDIF}
{$IFDEF MSDOS}
FUNCTION UpdateCRC32(CRC: LongInt; VAR Buffer; Len: Word): LongInt; EXTERNAL;
{$L CRC32.OBJ }
{$ENDIF}
{$IFDEF WIN32}
CONST
CRC_32_TAB : array[0..255] of LongInt = (
$00000000, $77073096, $ee0e612c, $990951ba, $076dc419,
$706af48f, $e963a535, $9e6495a3, $0edb8832, $79dcb8a4,
$e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07,
$90bf1d91, $1db71064, $6ab020f2, $f3b97148, $84be41de,
$1adad47d, $6ddde4eb, $f4d4b551, $83d385c7, $136c9856,
$646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9,
$fa0f3d63, $8d080df5, $3b6e20c8, $4c69105e, $d56041e4,
$a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b,
$35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3,
$45df5c75, $dcd60dcf, $abd13d59, $26d930ac, $51de003a,
$c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599,
$b8bda50f, $2802b89e, $5f058808, $c60cd9b2, $b10be924,
$2f6f7c87, $58684c11, $c1611dab, $b6662d3d, $76dc4190,
$01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f,
$9fbfe4a5, $e8b8d433, $7807c9a2, $0f00f934, $9609a88e,
$e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01,
$6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed,
$1b01a57b, $8208f4c1, $f50fc457, $65b0d9c6, $12b7e950,
$8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3,
$fbd44c65, $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2,
$4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb, $4369e96a,
$346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5,
$aa0a4c5f, $dd0d7cc9, $5005713c, $270241aa, $be0b1010,
$c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f,
$5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17,
$2eb40d81, $b7bd5c3b, $c0ba6cad, $edb88320, $9abfb3b6,
$03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615,
$73dc1683, $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8,
$e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1, $f00f9344,
$8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb,
$196c3671, $6e6b06e7, $fed41b76, $89d32be0, $10da7a5a,
$67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5,
$d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1,
$a6bc5767, $3fb506dd, $48b2364b, $d80d2bda, $af0a1b4c,
$36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef,
$4669be79, $cb61b38c, $bc66831a, $256fd2a0, $5268e236,
$cc0c7795, $bb0b4703, $220216b9, $5505262f, $c5ba3bbe,
$b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31,
$2cd99e8b, $5bdeae1d, $9b64c2b0, $ec63f226, $756aa39c,
$026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713,
$95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b,
$e5d5be0d, $7cdcefb7, $0bdbdf21, $86d3d2d4, $f1d4e242,
$68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1,
$18b74777, $88085ae6, $ff0f6a70, $66063bca, $11010b5c,
$8f659eff, $f862ae69, $616bffd3, $166ccf45, $a00ae278,
$d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7,
$4969474d, $3e6e77db, $aed16a4a, $d9d65adc, $40df0b66,
$37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,
$bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605,
$cdd70693, $54de5729, $23d967bf, $b3667a2e, $c4614ab8,
$5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b,
$2d02ef8d);
FUNCTION UpdateCRC32(CRC: LongInt; VAR Buffer; Len: Word): LongInt;
VAR
i: Integer;
Octet: ^Byte;
BEGIN
Octet := @buffer;
for i := 1 to Len do
begin
CRC := CRC_32_TAB[Byte(Crc XOR LongInt(Octet^))] XOR ((Crc SHR 8) AND $00FFFFFF);
Inc(Octet);
end;
UpdateCRC32 := CRC;
END;
{$ENDIF}
FUNCTION CheckPW: Boolean;
BEGIN
CheckPW := Common1.CheckPW;
END;
PROCEDURE NewCompTables;
BEGIN
Common1.NewCompTables;
END;
PROCEDURE Wait(B: Boolean);
BEGIN
Common1.Wait(B);
END;
PROCEDURE InitTrapFile;
BEGIN
Common1.InitTrapFile;
END;
PROCEDURE Local_Input1(VAR S: STRING; MaxLen: Byte; LowerCase: Boolean);
BEGIN
Common1.Local_Input1(S,MaxLen,LowerCase);
END;
PROCEDURE Local_Input(VAR S: STRING; MaxLen: Byte);
BEGIN
Common1.Local_Input(S,MaxLen);
END;
PROCEDURE Local_InputL(VAR S: STRING; MaxLen: Byte);
BEGIN
Common1.Local_InputL(S,MaxLen);
END;
PROCEDURE Local_OneK(VAR C: Char; S: STRING);
BEGIN
Common1.Local_OneK(C,S);
END;
PROCEDURE SysOpShell;
BEGIN
Common1.SysOpShell;
END;
PROCEDURE RedrawForANSI;
BEGIN
Common1.RedrawForANSI;
END;
PROCEDURE SKey1(VAR C: Char);
BEGIN
Common2.SKey1(C);
END;
PROCEDURE SaveGeneral(X: Boolean);
BEGIN
Common2.SaveGeneral(X);
END;
PROCEDURE Update_Screen;
BEGIN
Common2.Update_Screen;
END;
PROCEDURE lStatus_Screen(WhichScreen: Byte; Message: AStr; OneKey: Boolean; VAR Answer:AStr);
BEGIN
Common2.lStatus_Screen(WhichScreen,Message,OneKey,Answer);
END;
PROCEDURE TLeft;
BEGIN
Common2.TLeft;
END;
PROCEDURE InputLongIntWC(S: AStr; VAR L: LongInt; InputFlags: InputFlagSet; LowNum,HighNum: LongInt; VAR Changed: Boolean);
BEGIN
Common3.InputLongIntWC(S,L,InputFlags,LowNum,HighNum,Changed);
END;
PROCEDURE InputLongIntWOC(S: AStr; VAR L: LongInt; InputFlags: InputFlagSet; LowNum,HighNum: LongInt);
BEGIN
Common3.InputLongIntWOC(S,L,InputFlags,LowNum,HighNum);
END;
PROCEDURE InputWordWC(S: AStr; VAR W: SmallWord; InputFlags: InputFlagSet; LowNum,HighNum: Word; VAR Changed: Boolean);
BEGIN
Common3.InputWordWC(S,W,InputFlags,LowNum,HighNum,Changed);
END;
PROCEDURE InputWordWOC(S: AStr; VAR W: SmallWord; InputFlags: InputFlagSet; LowNum,HighNum: Word);
BEGIN
Common3.InputWordWOC(S,W,InputFlags,LowNum,HighNum);
END;
PROCEDURE InputIntegerWC(S: AStr; VAR I: SmallInt; InputFlags: InputFlagSet; LowNum,HighNum: Integer; VAR Changed: Boolean);
BEGIN
Common3.InputIntegerWC(S,I,InputFlags,LowNum,HighNum,Changed);
END;
PROCEDURE InputIntegerWOC(S: AStr; VAR I: SmallInt; InputFlags: InputFlagSet; LowNum,HighNum: Integer);
BEGIN
Common3.InputIntegerWOC(S,I,Inputflags,LowNum,HighNum);
END;
PROCEDURE InputByteWC(S: AStr; VAR B: Byte; InputFlags: InputFlagSet; LowNum,HighNum: Byte; VAR Changed: Boolean);
BEGIN
Common3.InputByteWC(S,B,InputFlags,LowNum,HighNum,Changed);
END;
PROCEDURE InputByteWOC(S: AStr; VAR B: Byte; InputFlags: InputFlagSet; LowNum,HighNum: Byte);
BEGIN
Common3.InputByteWOC(S,B,InputFlags,LowNum,HighNum)
END;
PROCEDURE InputDefault(VAR S: STRING; v: STRING; MaxLen: Byte; InputFlags: InputFlagSet; LineFeed: Boolean);
BEGIN
Common3.InputDefault(S,v,MaxLen,InputFlags,LineFeed);
END;
PROCEDURE InputFormatted(DisplayStr: AStr; VAR InputStr: STRING; v: STRING; Abortable: Boolean);
BEGIN
Common3.InputFormatted(DisplayStr,InputStr,v,Abortable);
END;
PROCEDURE InputWN1(DisplayStr: AStr; VAR InputStr: AStr; MaxLen: Byte; InputFlags: InputFlagSet; VAR Changed: Boolean);
BEGIN
Common3.InputWN1(DisplayStr,InputStr,MaxLen,InputFlags,Changed);
END;
PROCEDURE InputWNWC(DisplayStr: AStr; VAR InputStr: AStr; MaxLen: Byte; VAR Changed: Boolean);
BEGIN
Common3.InputWNWC(DisplayStr,InputStr,MaxLen,Changed);
END;
PROCEDURE InputMain(VAR s: STRING; MaxLen: Byte; InputFlags: InputFlagSet);
BEGIN
Common3.InputMain(s,MaxLen,InputFlags);
END;
PROCEDURE InputWC(VAR s: STRING; MaxLen: Byte);
BEGIN
Common3.InputWC(s,MaxLen);
END;
PROCEDURE Input(VAR s: STRING; MaxLen: Byte);
BEGIN
Common3.Input(s,MaxLen);
END;
PROCEDURE InputL(VAR s: STRING; MaxLen: Byte);
BEGIN
Common3.InputL(s,MaxLen);
END;
PROCEDURE InputCaps(VAR s: STRING; MaxLen: Byte);
BEGIN
Common3.InputCaps(s,MaxLen);
END;
PROCEDURE Com_Flush_Recv;
BEGIN
Common4.Com_Flush_Recv;
END;
PROCEDURE Com_Flush_Send;
BEGIN
Common4.Com_Flush_Send;
END;
PROCEDURE Com_Purge_Send;
BEGIN
Common4.Com_Purge_Send;
END;
FUNCTION Com_Carrier: Boolean;
BEGIN
Com_Carrier := Common4.Com_Carrier;
END;
FUNCTION Com_Recv: Char;
BEGIN
Com_Recv := Common4.Com_Recv;
END;
FUNCTION Com_IsRecv_Empty: Boolean;
BEGIN
Com_IsRecv_Empty := Common4.Com_IsRecv_Empty;
END;
FUNCTION Com_IsSend_Empty: Boolean;
BEGIN
Com_IsSend_Empty := Common4.Com_IsSend_Empty;
END;
PROCEDURE Com_Send(c: Char);
BEGIN
Common4.Com_Send(c);
END;
PROCEDURE Com_Set_Speed(Speed: LongInt);
BEGIN
Common4.Com_Set_Speed(Speed);
END;
PROCEDURE Com_DeInstall;
BEGIN
Common4.Com_DeInstall;
END;
PROCEDURE Com_Install;
BEGIN
Common4.Com_Install;
END;
PROCEDURE CheckHangup;
BEGIN
Common4.checkhangup;
END;
PROCEDURE SerialOut(s: STRING);
BEGIN
Common4.SerialOut(s);
END;
FUNCTION Empty: Boolean; BEGIN
Empty := Common4.Empty;
END;
PROCEDURE DTR(Status: Boolean);
BEGIN
Common4.DTR(Status);
END;
PROCEDURE ShowColors;
VAR
Counter: Byte;
BEGIN
FOR Counter := 1 TO 10 DO
BEGIN
SetC(Scheme.Color[Counter]);
Prompt(IntToStr(Counter - 1));
SetC(7);
Prompt(' ');
END;
NL;
END;
FUNCTION CheckDriveSpace(S,Path: AStr; MinSpace: Integer): Boolean;
VAR
Drive: Char;
MinSpaceOk: Boolean;
BEGIN
MinSpaceOk := TRUE;
IF (DiskKBFree(Path) <= MinSpace) THEN
BEGIN
NL;
Star('Insufficient disk space.');
Drive := Chr(ExtractDriveNumber(Path) + 64);
IF (Drive = '@') THEN
SysOpLog('^8--->^3 '+S+' failure: Main BBS drive full.')
ELSE
SysOpLog('^8--->^3 '+S+' failure: '+Drive+' Drive full.');
MinSpaceOk := FALSE;
END;
CheckDriveSpace := MinSpaceOk;
END;
FUNCTION StripLeadSpace(S: STRING): STRING;
BEGIN
WHILE (S[1] = ' ') DO
Delete(S,1,1);
StripLeadSpace := S;
END;
FUNCTION StripTrailSpace(S: STRING): STRING;
BEGIN
WHILE (S[1] = ' ') DO
Delete(S,1,1);
StripTrailSpace := S;
END;
FUNCTION SemiCmd(S: AStr; B: Byte): STRING;
VAR
i,
p: Byte;
BEGIN
i := 1;
WHILE (i < B) AND (s <> '') DO
BEGIN
p := Pos(';',s);
IF (p <> 0) THEN
s := Copy(s,(p + 1),(Length(s) - p))
ELSE
s := '';
Inc(i);
END;
WHILE (Pos(';',s) <> 0) DO
s := Copy(s,1,(Pos(';',s) - 1));
SemiCmd := s;
END;
FUNCTION ExistDrive(Drive: Char): Boolean;
VAR
Found: Boolean;
BEGIN
ChDir(Drive+':');
IF (IOResult <> 0) THEN
Found := FALSE
ELSE
BEGIN
ChDir(StartDir);
Found := TRUE;
END;
ExistDrive := Found;
END;
PROCEDURE RenameFile(DisplayStr: AStr; OldFileName,NewFileName: AStr; VAR RenameOk: Boolean);
VAR
F: FILE;
BEGIN
Print(DisplayStr);
IF (NOT Exist(OldFileName)) THEN
BEGIN
NL;
Print('"'+OldFileName+'" does not exist, can not rename file.');
ReNameOk := FALSE;
END
ELSE IF (Exist(NewFileName)) THEN
BEGIN
NL;
Print('"'+NewFileName+'" exists, file can not be renamed to "'+OldFileName+'".');
ReNameOk := FALSE;
END
ELSE
BEGIN
Assign(F,OldFileName);
ReName(F,NewFileName);
LastError := IOResult;
IF (LastError <> 0) THEN
BEGIN
NL;
Print('Error renaming file '+OldFileName+'.');
ReNameOK := FALSE;
END;
END;
END;
FUNCTION GetFileSize(FileName: AStr): LongInt;
VAR
DirInfo1: SearchRec;
FSize: LongInt;
BEGIN
FindFirst(FileName,AnyFile - Directory - VolumeID - DOS.Hidden - SysFile,DirInfo1);
IF (DosError <> 0) THEN
FSize := -1
ELSE
FSize := DirInfo1.Size;
GetFileSize := FSize;
END;
PROCEDURE GetFileDateTime(CONST FileName: AStr; VAR FileTime: LongInt);
VAR
F: FILE;
BEGIN
FileTime := 0;
IF Exist(SQOutSp(FileName)) THEN
BEGIN
Assign(F,SQOutSp(FileName));
Reset(F);
GetFTime(F,FileTime);
Close(F);
LastError := IOResult;
END;
END;
PROCEDURE SetFileDateTime(CONST FileName: AStr; FileTime: LongInt);
VAR
F: FILE;
BEGIN
IF Exist(SQOutSp(FileName)) THEN
BEGIN
Assign(F,SQOutSp(FileName));
Reset(F);
SetFTime(F,FileTime);
Close(F);
LastError := IOResult;
END;
END;
FUNCTION PHours(CONST DisplayStr: AStr; LoTime,HiTime: Integer): AStr;
BEGIN
IF (LoTime <> HiTime) THEN
PHours := ZeroPad(IntToStr(LoTime DIV 60))+':'+ZeroPad(IntToStr(LoTime MOD 60))+'....'+
ZeroPad(IntToStr(HiTime DIV 60))+':'+ZeroPad(IntToStr(HiTime MOD 60))
ELSE
PHours := DisplayStr;
END;
FUNCTION RGSysCfgStr(StrNum: LongInt; PassValue: Boolean): AStr;
VAR
StrPointerFile: FILE OF StrPointerRec;
StrPointer: StrPointerRec;
RGStrFile: FILE;
S: STRING;
TotLoad: LongInt;
BEGIN
Assign(StrPointerFile,General.LMultPath+'RGSCFGPR.DAT');
Reset(StrPointerFile);
Seek(StrPointerFile,StrNum);
Read(StrPointerFile,StrPointer);
Close(StrPointerFile);
LastError := IOResult;
TotLoad := 0;
Assign(RGStrFile,General.LMultPath+'RGSCFGTX.DAT');
Reset(RGStrFile,1);
Seek(RGStrFile,(StrPointer.Pointer - 1));
REPEAT
BlockRead(RGStrFile,S[0],1);
BlockRead(RGStrFile,S[1],Ord(S[0]));
Inc(TotLoad,(Length(S) + 1));
IF (PassValue) THEN
BEGIN
IF (S[Length(s)] = '@') THEN
Dec(S[0]);
END
ELSE
BEGIN
IF (S[Length(S)] = '@') THEN
BEGIN
Dec(S[0]);
Prt(S);
END
ELSE
PrintACR(S);
END;
UNTIL (TotLoad >= StrPointer.TextSize) OR (Abort) OR (HangUp);
Close(RGStrFile);
LastError := IOResult;
RGSysCfgStr := S;
END;
FUNCTION RGNoteStr(StrNum: LongInt; PassValue: Boolean): AStr;
VAR
StrPointerFile: FILE OF StrPointerRec;
StrPointer: StrPointerRec;
RGStrFile: FILE;
S: STRING;
TotLoad: LongInt;
BEGIN
Assign(StrPointerFile,General.LMultPath+'RGNOTEPR.DAT');
Reset(StrPointerFile);
Seek(StrPointerFile,StrNum);
Read(StrPointerFile,StrPointer);
Close(StrPointerFile);
LastError := IOResult;
TotLoad := 0;
Assign(RGStrFile,General.LMultPath+'RGNOTETX.DAT');
Reset(RGStrFile,1);
Seek(RGStrFile,(StrPointer.Pointer - 1));
REPEAT
BlockRead(RGStrFile,S[0],1);
BlockRead(RGStrFile,S[1],Ord(S[0]));
Inc(TotLoad,(Length(S) + 1));
IF (PassValue) THEN
BEGIN
IF (S[Length(s)] = '@') THEN
Dec(S[0]);
END
ELSE
BEGIN
IF (S[Length(S)] = '@') THEN
BEGIN
Dec(S[0]);
Prt(S);
END
ELSE
PrintACR(S);
END;
UNTIL (TotLoad >= StrPointer.TextSize) OR (Abort) OR (HangUp);
Close(RGStrFile);
LastError := IOResult;
RGNoteStr := S;
END;
FUNCTION RGMainStr(StrNum: LongInt; PassValue: Boolean): AStr;
VAR
StrPointerFile: FILE OF StrPointerRec;
StrPointer: StrPointerRec;
RGStrFile: FILE;
S: STRING;
TotLoad: LongInt;
BEGIN
Assign(StrPointerFile,General.LMultPath+'RGMAINPR.DAT');
Reset(StrPointerFile);
Seek(StrPointerFile,StrNum);
Read(StrPointerFile,StrPointer);
Close(StrPointerFile);
LastError := IOResult;
TotLoad := 0;
Assign(RGStrFile,General.LMultPath+'RGMAINTX.DAT');
Reset(RGStrFile,1);
Seek(RGStrFile,(StrPointer.Pointer - 1));
REPEAT
BlockRead(RGStrFile,S[0],1);
BlockRead(RGStrFile,S[1],Ord(S[0]));
Inc(TotLoad,(Length(S) + 1));
IF (PassValue) THEN
BEGIN
IF (S[Length(s)] = '@') THEN
Dec(S[0]);
END
ELSE
BEGIN
IF (S[Length(S)] = '@') THEN
BEGIN
Dec(S[0]);
Prt(S);
END
ELSE
PrintACR(S);
END;
UNTIL (TotLoad >= StrPointer.TextSize) OR (Abort) OR (HangUp);
Close(RGStrFile);
LastError := IOResult;
RGMainStr := S;
END;
FUNCTION lRGLngStr(StrNum: LongInt; PassValue: Boolean): AStr;
VAR
StrPointerFile: FILE OF StrPointerRec;
StrPointer: StrPointerRec;
RGStrFile: FILE;
S: STRING;
TotLoad: LongInt;
BEGIN
Assign(StrPointerFile,General.LMultPath+'RGLNGPR.DAT');
Reset(StrPointerFile);
Seek(StrPointerFile,StrNum);
Read(StrPointerFile,StrPointer);
Close(StrPointerFile);
LastError := IOResult;
TotLoad := 0;
Assign(RGStrFile,General.LMultPath+'RGLNGTX.DAT');
Reset(RGStrFile,1);
Seek(RGStrFile,(StrPointer.Pointer - 1));
REPEAT
BlockRead(RGStrFile,S[0],1);
BlockRead(RGStrFile,S[1],Ord(S[0]));
Inc(TotLoad,(Length(S) + 1));
IF (PassValue) THEN
BEGIN
IF (S[Length(s)] = '@') THEN
Dec(S[0]);
END
ELSE
BEGIN
IF (S[Length(S)] = '@') THEN
BEGIN
Dec(S[0]);
Prt(S);
END
ELSE
PrintACR(S);
END;
UNTIL (TotLoad >= StrPointer.TextSize) OR (Abort) OR (HangUp);
Close(RGStrFile);
LastError := IOResult;
lRGLNGStr := S;
END;
PROCEDURE GetPassword(VAR PW: AStr; Len: Byte);
BEGIN
PW := '';
Echo := FALSE;
Input(PW,Len);
Echo := TRUE;
END;
PROCEDURE MakeDir(VAR Path: PathStr; AskMakeDir: Boolean);
VAR
CurDir: PathStr;
Counter: Byte;
BEGIN
IF (Path = '') THEN
BEGIN
NL;
Print('^7A valid path must be specified!^1');
END
ELSE IF (NOT (Path[1] IN ['A'..'Z'])) OR (Length(Path) < 3) OR
(NOT (Path[2] = ':')) OR (NOT (Path[3] = '\')) THEN
BEGIN
NL;
Print('^7Invalid drive specification: "'+Path+'"^1');
END
ELSE
BEGIN
GetDir(0,CurDir);
ChDir(Path[1]+':');
IF (IOResult <> 0) THEN
BEGIN
NL;
Print('^7Drive does not exist: "'+Path[1]+'"^1');
END
ELSE
ChDir(CurDir);
END;
Path := BSlash(Path,TRUE);
IF (Length(Path) > 3) AND (NOT ExistDir(Path)) THEN
BEGIN
NL;
IF (NOT AskMakeDir) OR PYNQ('Directory does not exist, create it? ',0,FALSE) THEN
BEGIN
Counter := 2;
WHILE (Counter <= Length(Path)) DO
BEGIN
IF (Path[Counter] = '\') THEN
BEGIN
IF (Path[Counter - 1] <> ':') THEN
BEGIN
IF (NOT ExistDir(Copy(Path,1,(Counter - 1)))) THEN
BEGIN
MkDir(Copy(Path,1,(Counter - 1)));
LastError := IOResult;
IF (LastError <> 0) THEN
BEGIN
NL;
Print('^7Error creating directory!^1');
SysOpLog('^7Error creating directory: '+Copy(Path,1,(Counter - 1)));
PauseScr(FALSE);
END;
END;
END;
END;
Inc(Counter);
END;
END;
END;
END;
PROCEDURE Messages(Msg,MaxRecs: Integer; AreaName: AStr);
VAR
MsgStr: AStr;
BEGIN
MsgStr := '';
NL;
CASE Msg OF
1 : MsgStr := '^7Invalid record number!^1';
2 : MsgStr := '^7You are at the first valid record!^1';
3 : MsgStr := '^7You are at the last valid record!^1';
4 : MsgStr := '^7No '+AreaName+' exist!^1';
5 : MsgStr := '^7No more then '+IntToStr(MaxRecs)+' '+AreaName+' can exist!^1';
6 : MsgStr := '^7No '+AreaName+' to position!^1';
7 : MsgStr := '^7Invalid drive!^1';
8 : MsgStr := '^7Invalid record number order!^1';
END;
PrintACR('^1'+MsgStr);
PauseScr(FALSE);
END;
FUNCTION ReadBuffer(FileName: AStr): Boolean;
VAR
BufferFile: FILE;
MCIBufferSize,
NumRead: Integer;
BEGIN
IF (MCIBuffer = NIL) THEN
New(MCIBuffer);
ReadBuffer := FALSE;
IF ((Pos('\',FileName) = 0) AND (Pos(':', FileName) = 0)) THEN
FileName := General.MiscPath+FileName;
IF (Pos('.',FileName) = 0) THEN
BEGIN
IF (OkRIP) AND Exist(FileName+'.RIP') THEN
FileName := FileName+'.RIP'
ELSE IF (OkAvatar) AND Exist(FileName+'.AVT') THEN
FileName := FileName+'.AVT'
ELSE IF (OkANSI) AND Exist(FileName+'.ANS') THEN
FileName := FileName+'.ANS'
ELSE IF (Exist(FileName+'.ASC')) THEN
FileName := FileName+'.ASC';
END;
IF (NOT Exist(FileName)) THEN
Exit;
Assign(BufferFile,FileName);
Reset(BufferFile,1);
IF (IOResult <> 0) THEN
Exit;
IF (FileSize(BufferFile) < MaxConfigurable) THEN
MCIBufferSize := FileSize(BufferFile)
ELSE
MCIBufferSize := MaxConfigurable;
FillChar(MCIBuffer^,SizeOf(MCIBuffer^),0);
BlockRead(BufferFile,MCIBuffer^,MCIBufferSize,NumRead);
IF (NumRead <> MCIBufferSize) THEN
Exit;
Close(BufferFile);
ReadBuffer := TRUE;
END;
PROCEDURE DisplayBuffer(MCIFunction: MCIFunctionType; Data1,Data2: Pointer);
VAR
TempStr: STRING;
cs: AStr;
Justify: Byte; {0=Right, 1=Left, 2=Center}
Counter,
X2: Integer;
BEGIN
Counter := 1;
WHILE (Counter <= MaxConfigurable) AND (MCIBuffer^[Counter] <> #0) DO
BEGIN
TempStr := '';
WHILE (Counter <= MaxConfigurable) AND (MCIBuffer^[Counter] <> #13) DO
IF (MCIBuffer^[Counter] = '~') AND (Counter + 2 <= MaxConfigurable) THEN
BEGIN
cs := MCIFunction(MCIBuffer^[Counter + 1] + MCIBuffer^[Counter + 2],Data1,Data2);
IF (cs = MCIBuffer^[Counter + 1] + MCIBuffer^[Counter + 2]) THEN
BEGIN
TempStr := TempStr + '~';
Inc(Counter);
Continue;
END;
Inc(Counter,3);
IF ((Counter + 1) <= MaxConfigurable) AND (MCIBuffer^[Counter] IN ['#','{','}']) THEN
BEGIN
IF (MCIBuffer^[Counter] = '}') THEN
Justify := 0
ELSE IF (MCIBuffer^[Counter] = '{') THEN
Justify := 1
ELSE
Justify := 2;
IF (MCIBuffer^[Counter + 1] IN ['0'..'9']) THEN
BEGIN
X2 := Ord(MCIBuffer^[Counter + 1]) - 48;
Inc(Counter, 2);
IF (MCIBuffer^[Counter] IN ['0'..'9']) THEN
BEGIN
X2 := X2 * 10 + Ord(MCIBuffer^[Counter]) - 48;
Inc(Counter,1);
END;
IF (X2 > 0) THEN
CASE Justify OF
0 : cs := PadRightStr(cs,X2);
1 : cs := PadLeftStr(cs,X2);
2 : WHILE (Length(cs) < X2) DO
BEGIN
cs := ' ' + cs;
IF (Length(cs) < X2) THEN
cs := cs + ' ';
END;
END;
END;
END;
IF ((Length(cs) + Length(TempStr)) <= 255) THEN
BEGIN
Move(cs[1],TempStr[Length(TempStr)+1],Length(cs));
Inc(TempStr[0],Length(cs));
END
ELSE
IF (Length(TempStr) < 255) THEN
BEGIN
Move(cs[1],TempStr[Length(TempStr) + 1],(255 - Length(TempStr)));
TempStr[0] := #255;
END;
END
ELSE
BEGIN
Inc(TempStr[0]);
TempStr[Length(TempStr)] := MCIBuffer^[Counter];
Inc(Counter);
END;
IF (Counter <= MaxConfigurable) AND (MCIBuffer^[Counter] = #13) THEN
Inc(Counter,2);
CROff := TRUE;
PrintACR(TempStr);
END;
END;
FUNCTION Chinkey: Char;
VAR
C: Char;
BEGIN
C := #0;
Chinkey := #0;
IF (KeyPressed) THEN
BEGIN
C := ReadKey;
IF (NOT WColor) THEN
UserColor(General.SysOpColor);
WColor := TRUE;
IF (C = #0) THEN
IF (KeyPressed) THEN
BEGIN
C := ReadKey;
SKey1(C);
IF (C = #31) OR (C = #46) THEN
C := #1
ELSE IF (Buf <> '') THEN
BEGIN
C := Buf[1];
Buf := Copy(Buf,2,(Length(Buf) - 1));
END
ELSE
C := #0
END;
Chinkey := C;
END
ELSE IF ((NOT Com_IsRecv_Empty) AND (InCom)) THEN
BEGIN
C := CInKey;
IF (WColor) THEN
UserColor(General.UserColor);
WColor := FALSE;
Chinkey := C;
END;
END;
FUNCTION FormatNumber(L: LongInt): STRING;
VAR
S: STRING;
StrLen,
Counter: Byte;
BEGIN
S := '';
Str(L,S);
StrLen := Length(S);
Counter := 0;
WHILE (StrLen > 1) DO
BEGIN
Inc(Counter);
IF (Counter = 3) THEN
BEGIN
Insert(',',S,StrLen);
Counter := 0;
END;
Dec(StrLen);
END;
FormatNumber := S;
END;
FUNCTION ConvertBytes(BytesToConvert: LongInt; OneChar: Boolean): STRING;
CONST
InByte = 1;
InKilo = 1024;
InMega = 1048576;
InGiga = 1073741824;
VAR
InSize,
InMod: LongInt;
InTypes: Str5;
BEGIN
InMod := 0;
InTypes := '';
IF (BytesToConvert < 0) THEN
Exit;
IF (BytesToConvert < InKilo) THEN {Bytes Convertion}
BEGIN
InSize := BytesToConvert;
InTypes := 'Bytes';
END
ELSE IF (BytesToConvert < InMega) THEN {Kilo Convertion}
BEGIN
InSize := (BytesToConvert DIV InKilo);
InMod := Trunc(((BytesToConvert Mod InKilo) / InKilo) * 10.0);
InTypes := 'KB';
END
ELSE IF (BytesToConvert < InGiga) THEN {Mega Convertion}
BEGIN
InSize := (BytesToConvert DIV InMega);
InMod := Trunc(((BytesToConvert Mod InMega) / InMega) * 10.0);
InTypes := 'MB';
END
ELSE IF ((BytesToConvert - 1) > InGiga) THEN {GigaByte Conversion}
BEGIN
InSize := (BytesToConvert DIV InGiga);
InMod := Trunc(((BytesToConvert Mod InGiga) / InGiga) * 10.0);
InTypes := 'GB';
END;
IF (InMod = 0) THEN
ConvertBytes := AOnOff(OneChar,IntToStr(InSize),FormatNumber(InSize)+' ')
+AOnOff(OneChar,Char(Ord(InTypes[1]) + 32),InTypes)
ELSE
ConvertBytes := AOnOff(OneChar,IntToStr(InSize),FormatNumber(InSize))+'.'
+AOnOff(OneChar,IntToStr(InMod),IntToStr(InMod)+' ')
+AOnOff(OneChar,Char(Ord(InTypes[1]) + 32),InTypes);
END;
FUNCTION ConvertKB(KBToConvert: LongInt; OneChar: Boolean): STRING;
CONST
InKilo = 1;
InMega = 1024;
InGiga = 1048576;
InTera = 1073741824;
VAR
InSize,
InMod: LongInt;
InTypes: Str5;
BEGIN
InMod := 0;
InTypes := '';
IF (KBToConvert < 0) THEN
Exit;
IF (KBToConvert < InMega) THEN {KILO Convertion}
BEGIN
InSize := KBToConvert;
InTypes := 'KB';
END
ELSE IF (KBToConvert < InGiga) THEN {MEGA Convertion}
BEGIN
InSize := (KBToConvert DIV InMega);
InMod := Trunc(((KBToConvert Mod InMega) / InMega) * 10.0);
InTypes := 'MB';
END
ELSE IF (KBToConvert < InTera) THEN {Giga Convertion}
BEGIN
InSize := (KBToConvert DIV InGiga);
InMod := Trunc(((KBToConvert Mod InGiga) / InGiga) * 10.0);
InTypes := 'GB';
END
ELSE IF ((KBToConvert - 1) > InTera) THEN {TeraByte Conversion}
BEGIN
InSize := (KBToConvert DIV InTera);
InMod := Trunc(((KBToConvert Mod InTera) / InTera) * 10.0);
InTypes := 'TB';
END;
IF (InMod = 0) THEN
ConvertKB := AOnOff(OneChar,IntToStr(InSize),FormatNumber(InSize)+' ')
+AOnOff(OneChar,Char(Ord(InTypes[1]) + 32),InTypes)
ELSE
ConvertKB := AOnOff(OneChar,IntToStr(InSize),FormatNumber(InSize))+'.'
+AOnOff(OneChar,IntToStr(InMod),IntToStr(InMod)+' ')
+AOnOff(OneChar,Char(Ord(InTypes[1]) + 32),InTypes);
END;
PROCEDURE WriteWFC(c: Char);
VAR
LastAttr: Byte;
BEGIN
IF (BlankMenuNow) THEN
Exit;
Window(23,11,78,15);
GotoXY(LastWFCX,LastWFCY);
LastAttr := TextAttr;
TextAttr := 7;
Write(c);
TextAttr := LastAttr;
LastWFCX := WhereX;
LastWFCY := WhereY;
Window(1,1,MaxDisplayCols,MaxDisplayRows);
END;
FUNCTION AccountBalance: LongInt;
BEGIN
AccountBalance := (ThisUser.lCredit - ThisUser.Debit);
END;
PROCEDURE AdjustBalance(Adjustment: LongInt);
BEGIN
IF (Adjustment > 0) THEN
Inc(ThisUser.Debit,Adjustment) { Add TO debits }
ELSE
Dec(ThisUser.lCredit,Adjustment); { Add TO credits }
END;
FUNCTION CRC32(S: AStr): LongInt;
BEGIN
CRC32 := NOT (UpdateCRC32($FFFFFFFF,S[1],Length(S)));
END;
PROCEDURE Kill(CONST FileName: AStr);
VAR
F: FILE;
BEGIN
Assign(F,FileName);
Erase(F);
LastError := IOResult;
END;
PROCEDURE BackSpace;
BEGIN
IF (OutCom) THEN
SerialOut(^H' '^H);
IF (WantOut) THEN
Write(^H' '^H);
END;
PROCEDURE DoBackSpace(Start,Finish: Byte);
VAR
Counter: Byte;
BEGIN
FOR Counter := Start TO Finish DO
BEGIN
IF (OutCom) THEN
SerialOut(^H' '^H);
IF (WantOut) THEN
Write(^H' '^H);
END;
END;
FUNCTION Substitute(Src: STRING; CONST old,New: STRING): STRING;
VAR
p,
Diff,
LastP: Integer;
BEGIN
IF (old <> New) THEN
BEGIN
LastP := 0;
Diff := Length(New) - Length(old);
REPEAT
p := Pos(old,Copy(Src,LastP,255));
IF (p > 0) THEN
BEGIN
IF (Diff <> 0) THEN
BEGIN
Move(Src[p + Length(old)],Src[p + Length(New)],(Length(Src) - p));
Inc(Src[0],Diff);
END;
Move(New[1],Src[p],Length(New));
LastP := p + Length(New);
END;
UNTIL (p = 0);
END;
Substitute := Src;
END;
PROCEDURE DOSANSI(CONST c:Char);
VAR
i:Word;
label Command;
BEGIN
IF (c = #27) AND (NextState IN [Waiting..In_Param]) THEN
BEGIN
NextState := Bracket;
Exit;
END;
IF (c = ^V) AND (NextState = Waiting) THEN
BEGIN
NextState := GetAvCmd;
Exit;
END;
IF (c = ^y) AND (NextState = Waiting) THEN
BEGIN
NextState := GetAvRLE1;
Exit;
END;
CASE NextState OF
Waiting : IF (c = #9) THEN
GotoXY((WhereX + 8),WhereY)
ELSE
Write(c);
GetAvRLE1:
BEGIN
ParamArr[1] := Ord(c);
NextState := GetAvRLE2;
END;
GetAvRLE2:
BEGIN
FOR i := 1 TO Ord(c) DO
Write(Chr(ParamArr[1]));
NextState := Waiting;
END;
GetAvAttr:
BEGIN
TextAttr := Ord(c) AND $7f;
NextState := Waiting;
END;
GetAvY:
BEGIN
ParamArr[1] := Ord(c);
NextState := GetAvX;
END;
GetAvX:
BEGIN
GotoXY(Ord(c),ParamArr[1]);
NextState := Waiting;
END;
GetAvCmd: CASE c OF
^A : NextState := GetAvAttr;
^B : BEGIN
TextAttr := TextAttr OR $80;
NextState := Waiting;
END;
^C : BEGIN
GotoXY(WhereX,(WhereY - 1));
NextState := Waiting;
END;
^d : BEGIN
GotoXY(WhereX,(WhereY + 1));
NextState := Waiting;
END;
^E : BEGIN
GotoXY((WhereX - 1),WhereY);
NextState := Waiting;
END;
^F :
BEGIN
GotoXY((WhereX + 1),WhereY);
NextState := Waiting;
END;
^G :
BEGIN
ClrEOL;
NextState := Waiting;
END;
^H : NextState := GetAvY;
ELSE
NextState := Waiting;
END;
Bracket :
BEGIN
IF c <> '[' THEN
BEGIN
NextState := Waiting;
Write(c);
END
ELSE
BEGIN
Params := 1;
FillChar(ParamArr,5,0);
NextState := Get_Args;
END;
END;
Get_Args,Get_Param,Eat_Semi :
BEGIN
IF (NextState = Eat_Semi) AND (c = ';') THEN
BEGIN
IF (Params < 5) THEN
Inc(Params);
NextState := Get_Param;
Exit;
END;
CASE c OF
'0'..'9' :
BEGIN
ParamArr[Params] := Ord(c) - 48;
NextState := In_Param;
END;
';' :
BEGIN
IF (Params < 5) THEN
Inc(Params);
NextState := Get_Param;
END;
ELSE
goto Command;
END {CASE c} ;
END;
In_Param : { last Char was a digit }
BEGIN
{ looking FOR more digits, a semicolon, OR a command Char }
CASE c OF
'0'..'9' :
BEGIN
ParamArr[Params] := ParamArr[Params] * 10 + Ord(c) - 48;
NextState := In_Param;
Exit;
END;
';' :
BEGIN
IF (Params < 5) THEN
Inc(Params);
NextState := Eat_Semi;
Exit;
END;
END {CASE c} ;
Command:
NextState := Waiting;
CASE c OF
{ Note: the order OF commands is optimized FOR execution speed }
'm' : {sgr}
BEGIN
FOR i := 1 TO Params DO
BEGIN
IF (Reverse) THEN
TextAttr := TextAttr SHR 4 + TextAttr SHL 4;
CASE ParamArr[i] OF
0 :
BEGIN
Reverse := FALSE;
TextAttr := 7;
END;
1 : TextAttr := TextAttr AND $FF OR $08;
2 : TextAttr := TextAttr AND $F7 OR $00;
4 : TextAttr := TextAttr AND $F8 OR $01;
5 : TextAttr := TextAttr OR $80;
7 : IF NOT Reverse THEN
BEGIN
{
TextAttr := TextAttr SHR 4 + TextAttr SHL 4;
}
Reverse := TRUE;
END;
22 : TextAttr := TextAttr AND $F7 OR $00;
24 : TextAttr := TextAttr AND $F8 OR $04;
25 : TextAttr := TextAttr AND $7F OR $00;
27 : IF Reverse THEN
BEGIN
Reverse := FALSE;
{
TextAttr := TextAttr SHR 4 + TextAttr SHL 4;
}
END;
30 : TextAttr := TextAttr AND $F8 OR $00;
31 : TextAttr := TextAttr AND $F8 OR $04;
32 : TextAttr := TextAttr AND $F8 OR $02;
33 : TextAttr := TextAttr AND $F8 OR $06;
34 : TextAttr := TextAttr AND $F8 OR $01;
35 : TextAttr := TextAttr AND $F8 OR $05;
36 : TextAttr := TextAttr AND $F8 OR $03;
37 : TextAttr := TextAttr AND $F8 OR $07;
40 : TextAttr := TextAttr AND $8F OR $00;
41 : TextAttr := TextAttr AND $8F OR $40;
42 : TextAttr := TextAttr AND $8F OR $20;
43 : TextAttr := TextAttr AND $8F OR $60;
44 : TextAttr := TextAttr AND $8F OR $10;
45 : TextAttr := TextAttr AND $8F OR $50;
46 : TextAttr := TextAttr AND $8F OR $30;
47 : TextAttr := TextAttr AND $8F OR $70;
END {CASE} ;
{ fixup FOR reverse }
IF (Reverse) THEN
TextAttr := TextAttr SHR 4 + TextAttr SHL 4;
END;
END;
'A' : {cuu}
BEGIN
IF (ParamArr[1] = 0) THEN
ParamArr[1] := 1;
{IF (WhereY - ParamArr[1] >= 1)
THEN} GotoXY(WhereX,(WhereY - ParamArr[1]))
{ELSE GotoXY(WhereX, 1);}
END;
'B' : {cud}
BEGIN
IF ParamArr[1] = 0 THEN ParamArr[1] := 1;
{IF (WhereY + ParamArr[1] <= Hi(WindMax) - Hi(WindMin) + 1)
THEN }GotoXY(WhereX, WhereY + ParamArr[1])
{ELSE GotoXY(WhereX, Hi(WindMax) - Hi(WindMin) + 1);}
END;
'C' : {cuf}
BEGIN
IF ParamArr[1] = 0 THEN ParamArr[1] := 1;
{IF (WhereX + ParamArr[1] <= Lo(WindMax) - Lo(WindMin) + 1)
THEN} GotoXY(WhereX + ParamArr[1], WhereY)
{ELSE GotoXY(Lo(WindMax) - Lo(WindMin) + 1, WhereY);}
END;
'D' : {cub}
BEGIN
IF (ParamArr[1] = 0) THEN ParamArr[1] := 1;
{IF (WhereX - ParamArr[1] >= 1)
THEN} GotoXY(WhereX - ParamArr[1], WhereY)
{ELSE GotoXY(1, WhereY);}
END;
'H', 'f' : {cup,hvp}
BEGIN
IF (ParamArr[1] = 0) THEN ParamArr[1] := 1;
IF (ParamArr[2] = 0) THEN ParamArr[2] := 1;
{IF (ParamArr[2] > Lo(WindMax) + 1)
THEN ParamArr[2] := Lo(WindMax) - Lo(WindMin) + 1;
IF (ParamArr[1] > Hi(WindMax) + 1)
THEN ParamArr[1] := Hi(WindMax) - Hi(WindMin) + 1;}
GotoXY(ParamArr[2], ParamArr[1]) ;
END;
'J' : IF (ParamArr[1] = 2) THEN ClrScr
ELSE
FOR i := WhereY TO 25 DO delline; { some terms use others! }
'K' : ClrEOL;
'L' : IF (ParamArr[1] = 0) THEN
insline
ELSE
FOR i := 1 TO ParamArr[1] DO insline; { must NOT Move cursor }
'M' : IF (ParamArr[1] = 0) THEN
delline
ELSE
FOR i := 1 TO ParamArr[1] DO delline; { must NOT Move cursor }
'P' : {dc }
BEGIN
END;
's' : {scp}
BEGIN
SaveX := WhereX;
SaveY := WhereY;
END;
'u' : {rcp} GotoXY(SaveX,SaveY);
'@':; { Some unknown code appears TO DO nothing }
ELSE
Write(c);
END {CASE c} ;
END;
END {CASE NextState} ;
END {AnsiWrite} ;
PROCEDURE ShellDos(MakeBatch: Boolean; CONST Command: AStr; VAR ResultCode: Integer);
VAR
BatFile: Text;
FName,
s: AStr;
BEGIN
IF (NOT MakeBatch) THEN
FName := Command
ELSE
BEGIN
FName := 'TEMP'+IntToStr(ThisNode)+'.BAT';
Assign(BatFile,FName);
ReWrite(BatFile);
WriteLn(BatFile,Command);
Close(BatFile);
LastError := IOResult;
END;
IF (FName <> '') THEN
FName := ' /c '+FName;
Com_Flush_Send;
Com_DeInstall;
CursorOn(TRUE);
SwapVectors;
{$IFDEF MSDOS}
IF (General.SwapShell) THEN
BEGIN
s := GetEnv('TEMP');
IF (s = '') THEN
s := StartDir;
Init_SpawNo(s,General.SwapTo,20,10);
ResultCode := Spawn(GetEnv('COMSPEC'),FName,0);
END;
{$ENDIF}
{$IFDEF WIN32}
ResultCode := -1;
{$ENDIF}
IF (NOT General.SwapShell) OR (ResultCode = -1) THEN
BEGIN
Exec(GetEnv('COMSPEC'),FName);
ResultCode := Lo(DOSExitCode);
LastError := IOResult;
END;
SwapVectors;
IF (MakeBatch) THEN
Kill(FName);
Com_Install;
IF (NOT LocalIOOnly) AND NOT (lockedport IN Liner.mflags) THEN
Com_Set_Speed(ComPortSpeed);
Update_Screen;
TextAttr := CurrentColor;
LastKeyHit := Timer;
END;
FUNCTION LennMCI(CONST InString: STRING): Integer;
VAR
TempStr: STRING;
Counter,
StrLen: Byte;
BEGIN
StrLen := Length(InString);
Counter := 0;
WHILE (Counter < Length(InString)) DO
BEGIN
Inc(Counter);
CASE InString[Counter] OF
^S : BEGIN
Dec(StrLen,2);
Inc(Counter);
END;
'^' : IF (Length(InString) > Counter) AND (InString[Counter + 1] IN ['0'..'9']) THEN
BEGIN
Dec(StrLen,2);
Inc(Counter);
END;
'|' : IF (Length(InString) > (Counter + 1)) AND (InString[Counter + 1] IN ['0'..'9']) AND
(Instring[Counter + 2] IN ['0'..'9']) THEN
BEGIN
Dec(StrLen,3);
Inc(Counter);
END;
'%' : IF (MCIAllowed) AND (Length(InString) > (Counter + 1)) THEN
BEGIN
TempStr := AllCaps(MCI('%' + InString[Counter + 1] + InString[Counter + 2]));
IF (Copy(TempStr,1,3) <> '%' + UpCase(InString[Counter + 1]) + UpCase(InString[Counter + 2])) THEN
Inc(StrLen,Length(TempStr) - 3);
END;
END;
END;
LennMCI := StrLen;
END;
{$V-}
PROCEDURE LCmds3(Len,c: Byte; c1,c2,c3: AStr);
VAR
s: AStr;
BEGIN
s := '';
s := s+'^1(^'+Chr(c + Ord('0'))+c1[1]+'^1)'+PadLeftStr(Copy(c1,2,LennMCI(c1)-1),Len-1);
IF (c2 <> '') THEN
s := s+'^1(^'+Chr(c + Ord('0')) + c2[1]+'^1)'+PadLeftStr(Copy(c2,2,LennMCI(c2)-1),Len-1);
IF (c3 <> '') THEN
s := s+'^1(^'+Chr(c + Ord('0')) + c3[1]+'^1)'+Copy(c3,2,LennMCI(c3)-1);
PrintACR(s);
END;
PROCEDURE LCmds(Len,c: Byte; c1,c2: AStr);
VAR
s: AStr;
BEGIN
s := Copy(c1,2,LennMCI(c1) - 1);
IF (c2 <> '') THEN
s := PadLeftStr(s,Len - 1);
Prompt('^1(^' + IntToStr(c) + c1[1] + '^1)' + s);
IF (c2 <> '') THEN
Prompt('^1(^' + IntToStr(c) + c2[1] + '^1)' + Copy(c2,2,LennMCI(c2) - 1));
NL;
END;
FUNCTION MsgSysOp: Boolean;
BEGIN
MsgSysOp := (CoSysOp) OR (AACS(General.MSOP)) OR (AACS(MemMsgArea.SysOpACS));
END;
FUNCTION FileSysOp: Boolean;
BEGIN
FileSysOp := ((CoSysOp) OR (AACS(General.FSOP)));
END;
FUNCTION CoSysOp: Boolean;
BEGIN
CoSysOp := ((SysOp) OR (AACS(General.CSOP)));
END;
FUNCTION SysOp: Boolean;
BEGIN
SysOp := (AACS(General.SOP));
END;
FUNCTION Timer: LongInt;
BEGIN
Timer := ((Ticks * 5) DIV 91); { 2.5 times faster than Ticks DIV 18.2 }
END;
FUNCTION OkVT100: Boolean;
BEGIN
OkVT100 := (VT100 IN ThisUser.Flags);
END;
FUNCTION OkANSI: Boolean;
BEGIN
OkANSI := (ANSI IN ThisUser.Flags);
END;
FUNCTION OkRIP: Boolean;
BEGIN
OkRIP := (RIP IN ThisUser.SFlags);
END;
FUNCTION OkAvatar: Boolean;
BEGIN
OkAvatar := (Avatar IN ThisUser.Flags);
END;
FUNCTION NSL: LongInt;
VAR
BeenOn: LongInt;
BEGIN
IF ((UserOn) OR (NOT InWFCMenu)) THEN
BEGIN
BeenOn := (GetPackDateTime - TimeOn);
NSL := ((LongInt(ThisUser.TLToday) * 60 + ExtraTime + FreeTime) - (BeenOn + ChopTime + CreditTime));
END
ELSE
NSL := 3600;
END;
FUNCTION StripColor(CONST InString: STRING): STRING;
VAR
TempStr: STRING;
Counter: Byte;
BEGIN
TempStr := '';
Counter := 0;
WHILE (Counter < Length(InString)) DO
BEGIN
Inc(Counter);
CASE InString[Counter] OF
^S : Inc(Counter);
'^' : IF (InString[Counter + 1] IN ['0'..'9']) THEN
Inc(Counter)
ELSE
TempStr := TempStr + '^';
'|' : IF (InString[Counter + 1] IN ['0'..'9']) AND (InString[Counter + 2] IN ['0'..'9']) THEN
Inc(Counter,2)
ELSE
TempStr := TempStr + '|';
ELSE
TempStr := TempStr + InString[Counter];
END;
END;
StripColor := TempStr;
END;
PROCEDURE sl1(s: AStr);
BEGIN
IF (SLogging) THEN
BEGIN
S := S + '^1';
IF (General.StripCLog) THEN
s := StripColor(s);
Append(SysOpLogFile);
IF (IOResult = 0) THEN
BEGIN
WriteLn(SysOpLogFile,s);
Close(SysOpLogFile);
LastError := IOResult;
END;
IF (SLogSeparate IN ThisUser.SFlags) THEN
BEGIN
Append(SysOpLogFile1);
IF (IOResult = 0) THEN
BEGIN
WriteLn(SysOpLogFile1,s);
Close(SysOpLogFile1);
LastError := IOResult;
END;
END;
END;
END;
PROCEDURE SysOpLog(s:AStr);
BEGIN
sl1(' '+s);
END;
FUNCTION StrToInt(S: Str11): LongInt;
VAR
I: Integer;
L: LongInt;
BEGIN
Val(S,L,I);
IF (I > 0) THEN
BEGIN
S[0] := Chr(I - 1);
Val(S,L,I)
END;
IF (S = '') THEN
StrToInt := 0
ELSE
StrToInt := L;
END;
FUNCTION RealToStr(R: Real; W,D: Byte): STRING;
VAR
S: STRING[11];
BEGIN
Str(R:W:D,S);
RealToStr := S;
END;
FUNCTION ValueR(S: AStr): REAL;
VAR
Code: Integer;
R: REAL;
BEGIN
Val(S,R,Code);
IF (Code <> 0) THEN
BEGIN
S := Copy(S,1,(Code - 1));
Val(S,R,Code)
END;
ValueR := R;
IF (S = '') THEN
ValueR := 0;
END;
FUNCTION AgeUser(CONST BirthDate: LongInt): Word;
VAR
DT1,
DT2: DateTime;
Year: Word;
BEGIN
PackToDate(DT1,BirthDate);
GetDateTime(DT2);
Year := (DT2.Year - DT1.Year);
IF (DT2.Month < DT1.Month) THEN
Dec(Year);
IF (DT2.Month = DT1.Month) AND (DT2.Day < DT1.Day) THEN
Dec(Year);
AgeUser := Year;
END;
FUNCTION AllCaps(InString: STRING): STRING;
VAR
Counter: Byte;
BEGIN
FOR Counter := 1 TO Length(InString) DO
IF (InString[Counter] IN ['a'..'z']) THEN
InString[Counter] := Chr(Ord(InString[Counter]) - Ord('a')+Ord('A'));
AllCaps := InString;
END;
FUNCTION Caps(Instring: STRING): STRING;
VAR
Counter: Integer; { must be Integer }
BEGIN
IF (InString[1] IN ['a'..'z']) THEN
Dec(InString[1],32);
FOR Counter := 2 TO Length(Instring) DO
IF (InString[Counter - 1] IN ['a'..'z','A'..'Z']) THEN
IF (InString[Counter] IN ['A'..'Z']) THEN
Inc(InString[Counter],32)
ELSE
ELSE
IF (InString[Counter] IN ['a'..'z']) THEN
Dec(InString[Counter],32);
Caps := InString;
END;
FUNCTION GetC(c: Byte): STRING;
CONST
xclr: ARRAY [0..7] OF Char = ('0','4','2','6','1','5','3','7');
VAR
s: STRING[10];
b: Boolean;
PROCEDURE adto(ss: str8);
BEGIN
IF (s[Length(s)] <> ';') AND (s[Length(s)] <> '[') THEN
s := s + ';';
s := s + ss;
b := TRUE;
END;
BEGIN
b := FALSE;
IF ((CurrentColor AND (NOT c)) AND $88) <> 0 THEN
BEGIN
s := #27+'[0';
CurrentColor := $07;
END
ELSE
s := #27+'[';
IF (c AND 7 <> CurrentColor AND 7) THEN
adto('3'+xclr[c AND 7]);
IF (c AND $70 <> CurrentColor AND $70) THEN
adto('4'+xclr[(c SHR 4) AND 7]);
IF (c AND 128 <> 0) THEN
adto('5');
IF (c AND 8 <> 0) THEN
adto('1');
IF (NOT b) THEN
adto('3'+xclr[c AND 7]);
s := s + 'm';
GetC := s;
END;
PROCEDURE SetC(C: Byte);
BEGIN
IF (NOT (OkANSI OR OkAvatar)) THEN
BEGIN
TextAttr := 7;
Exit;
END;
IF (C <> CurrentColor) THEN
BEGIN
IF (NOT (Color IN ThisUser.Flags)) THEN
IF ((C AND 8) = 8) THEN
C := 15
ELSE
C := 7;
IF (OutCom) THEN
IF (OkAvatar) THEN
SerialOut(^V^A+Chr(C AND $7f))
ELSE
SerialOut(GetC(C));
TextAttr := C;
CurrentColor := C;
END;
END;
PROCEDURE UserColor(Color: Byte);
BEGIN
IF (Color IN [0..9]) THEN
IF (OkANSI OR OkAvatar) THEN
SetC(Scheme.Color[Color + 1]);
END;
FUNCTION SQOutSp(InString: STRING): STRING;
BEGIN
WHILE (Pos(' ',InString) > 0) DO
Delete(InString,Pos(' ',InString),1);
SQOutSp := InString;
END;
FUNCTION ExtractDriveNumber(s: AStr): Byte;
BEGIN
s := FExpand(s);
ExtractDriveNumber := (Ord(s[1]) - 64);
END;
FUNCTION PadLeftStr(InString: STRING; MaxLen: Byte): STRING;
VAR
StrLen,
Counter: Byte;
BEGIN
StrLen := LennMCI(InString);
IF (StrLen > MaxLen) THEN
WHILE (StrLen > MaxLen) DO
BEGIN
InString[0] := Chr(MaxLen + (Length(InString) - StrLen));
StrLen := LennMCI(InString);
END
ELSE
FOR Counter := StrLen TO (MaxLen - 1) DO
InString := InString + ' ';
PadLeftStr := Instring;
END;
FUNCTION PadRightStr(InString: STRING; MaxLen: Byte): STRING;
VAR
StrLen,
Counter: Byte;
BEGIN
StrLen := LennMCI(InString);
FOR Counter := StrLen TO (MaxLen - 1) DO
InString := ' ' + InString;
IF (StrLen > MaxLen) THEN
InString[0] := Chr(MaxLen + (Length(InString) - StrLen));
PadRightStr := Instring;
END;
FUNCTION PadLeftInt(L: LongInt; MaxLen: Byte): STRING;
BEGIN
PadLeftInt := PadLeftStr(IntToStr(L),MaxLen);
END;
FUNCTION PadRightInt(L: LongInt; MaxLen: Byte): STRING;
BEGIN
PadRightInt := PadRightStr(IntToStr(L),MaxLen);
END;
PROCEDURE Prompt(CONST InString: STRING);
VAR
SaveAllowAbort: Boolean;
BEGIN
SaveAllowAbort := AllowAbort;
AllowAbort := FALSE;
PrintMain(InString);
AllowAbort := SaveAllowAbort;
END;
PROCEDURE Print(CONST Instring: STRING);
BEGIN
Prompt(InString+^M^J);
END;
PROCEDURE NL;
BEGIN
Prompt(^M^J);
END;
PROCEDURE Prt(CONST Instring: STRING);
BEGIN
UserColor(4);
Prompt(Instring);
UserColor(3);
END;
PROCEDURE MPL(MaxLen: Byte);
VAR
Counter,
SaveWhereX : Byte;
BEGIN
IF (OkANSI OR OkAvatar) THEN
BEGIN
UserColor(6);
SaveWhereX := WhereX;
IF (OutCom) THEN
FOR Counter := 1 TO MaxLen DO
Com_Send(' ');
IF (WantOut) THEN
FOR Counter := 1 TO MaxLen DO
Write(' ');
GotoXY(SaveWhereX,WhereY);
IF (OutCom) THEN
IF (OkAvatar) THEN
SerialOut(^y+^H+Chr(MaxLen))
ELSE
SerialOut(#27+'['+IntToStr(MaxLen)+'D');
END;
END;
FUNCTION InKey: Word;
VAR
c: Char;
l: LongInt;
BEGIN
c := #0;
InKey := 0;
CheckHangup;
IF (KeyPressed) THEN
BEGIN
c := ReadKey;
IF (c = #0) AND (KeyPressed) THEN
BEGIN
c := ReadKey;
SKey1(c);
IF (c = #31) OR (C = #46) THEN
c := #1
ELSE
BEGIN
InKey := (Ord(c) * 256); { Return scan code IN MSB }
Exit;
END;
END;
IF (Buf <> '') THEN
BEGIN
c := Buf[1];
Buf := Copy(Buf,2,255);
END;
InKey := Ord(c);
END
ELSE IF (InCom) THEN
BEGIN
c := CInKey;
IF (c = #27) THEN
BEGIN
IF (Empty) THEN
Delay(100);
IF (c = #27) AND (NOT Empty) THEN
BEGIN
c := CInKey;
IF (c = '[') OR (c = 'O') THEN
BEGIN
l := (Ticks + 4);
c := #0;
WHILE (l > Ticks) AND (c = #0) DO
c := CInKey;
END;
CASE Char(c) OF
'A' : InKey := F_UP; {UpArrow}
'B' : InKey := F_DOWN; {DownArrow}
'C' : InKey := F_RIGHT; {RightArrow}
'D' : InKey := F_LEFT; {LeftArrow}
'H' : InKey := F_HOME; {Home}
'K' : InKey := F_END; {END - PROCOMM+}
'R' : InKey := F_END; {END - GT}
'4' : BEGIN
InKey := F_END;
c := CInKey;
END;
'r' : InKey := F_PGUP; {PgUp}
'q' : InKey := F_PGDN; {PgDn}
'n' : InKey := F_INS; {Ins}
END;
Exit;
END;
END;
IF (c = #127) THEN
InKey := F_DEL
ELSE
InKey := Ord(c);
END;
END;
PROCEDURE OutTrap(c: Char);
BEGIN
IF (c <> ^G) THEN
Write(TrapFile,c);
IF (IOResult <> 0) THEN
BEGIN
SysOpLog('Error writing to trap file.');
Trapping := FALSE;
END;
END;
PROCEDURE OutKey(c: Char);
VAR
S: Str1;
BEGIN
IF (NOT Echo) THEN
IF (General.LocalSec) AND (c IN [#32..#255]) THEN
BEGIN
s := lRGLNGStr(1,TRUE); {FString.EchoC;}
c := s[1];
END;
IF (c IN [#27,^V,^y]) THEN
DOSANSIOn := TRUE;
IF (WantOut) AND (DOSANSIOn) AND (NextState <> Waiting) THEN
BEGIN
DOSANSI(c);
IF (OutCom) THEN
Com_Send(c);
Exit;
END
ELSE IF (c <> ^J) AND (c <> ^L) THEN
IF (WantOut) AND (NOT DOSANSIOn) AND NOT ((c = ^G) AND InCom) THEN
Write(c)
ELSE IF (WantOut) AND NOT ((c = ^G) AND InCom) THEN
DOSANSI(c);
IF (NOT Echo) AND (c IN [#32..#255]) THEN
BEGIN
S := lRGLNGStr(1,TRUE); {FString.EchoC;}
c := S[1];
END;
CASE c OF
^J : BEGIN
IF (NOT InChat) AND (NOT Write_Msg) AND (NOT CtrlJOff) AND (NOT DOSANSIOn) THEN
BEGIN
IF (((CurrentColor SHR 4) AND 7) > 0) OR (CurrentColor AND 128 = 128) THEN
SetC(Scheme.Color[1])
END
ELSE
LIL := 1;
IF (Trapping) THEN
OutTrap(c);
IF (WantOut) THEN
Write(^J);
IF (OutCom) THEN
Com_Send(^J);
Inc(LIL);
IF (LIL >= PageLength) THEN
BEGIN
LIL := 1;
IF (TempPause) THEN
PauseScr(TRUE);
END;
END;
^L : BEGIN
IF (WantOut) THEN
ClrScr;
IF (OutCom) THEN
Com_Send(^L);
LIL := 1;
END;
ELSE
BEGIN
IF (OutCom) THEN
Com_Send(c);
IF (Trapping) THEN
OutTrap(c);
END;
END;
END;
FUNCTION PageLength: Word;
BEGIN
IF (InCom) THEN
PageLength := ThisUser.PageLen
ELSE IF (General.WindowOn) AND NOT (InWFCMenu) THEN
PageLength := (MaxDisplayRows - 2)
ELSE
PageLength := MaxDisplayRows;
END;
PROCEDURE TeleConfCheck;
VAR
f: FILE;
s: STRING;
Counter: Byte;
SaveMCIAlllowed: Boolean;
{ Only check IF we're bored AND NOT slicing }
BEGIN
IF (MaxChatRec > NodeChatLastRec) THEN
BEGIN
FOR Counter := 1 TO (LennMCI(MLC) + 5) DO
BackSpace;
Assign(f,General.TempPath+'MSG'+IntToStr(ThisNode)+'.TMP');
Reset(f,1);
Seek(f,NodeChatLastRec);
WHILE NOT EOF(f) DO
BEGIN
BlockRead(f,s[0],1);
BlockRead(f,s[1],Ord(s[0]));
MultiNodeChat := FALSE; {avoid recursive calls during Pause!}
SaveMCIAlllowed := MCIAllowed;
MCIAllowed := FALSE;
Print(s);
MCIAllowed := SaveMCIAlllowed;
MultiNodeChat := TRUE;
END;
Close(f);
LastError := IOResult;
NodeChatLastRec := MaxChatRec;
Prompt('^3'+MLC);
END;
END;
FUNCTION GetKey: Word;
CONST
LastTimeSlice: LongInt = 0;
LastCheckTimeSlice: LongInt = 0;
VAR
{$IFDEF MSDOS}
Killme: Pointer ABSOLUTE $0040 :$F000;
{$ENDIF}
Tf: Boolean;
I: Integer;
C: Word;
TempTimer: LongInt;
BEGIN
IF (DieLater) THEN
{$IFDEF MSDOS}
ASM
Call Killme
END;
{$ENDIF}
{$IFDEF WIN32}
Halt;
{$ENDIF}
LIL := 1;
IF (Buf <> '') THEN
BEGIN
C := Ord(Buf[1]);
Buf := Copy(Buf,2,255);
END
ELSE
BEGIN
IF (NOT Empty) THEN
BEGIN
IF (InChat) THEN
C := Ord(Chinkey)
ELSE
C := InKey;
END
ELSE
BEGIN
Tf := FALSE;
LastKeyHit := Timer;
C := 0;
WHILE ((C = 0) AND (NOT HangUp)) DO
BEGIN
TempTimer := Timer;
IF (LastScreenSwap > 0) THEN
BEGIN
IF ((TempTimer - LastScreenSwap) < 0) THEN
LastScreenSwap := ((Timer - LastScreenSwap) + 86400);
IF ((TempTimer - LastScreenSwap) > 10) THEN
Update_Screen;
END;
IF (Alert IN ThisUser.Flags) OR ((NOT ShutUpChatCall) AND (General.ChatCall) AND (ChatReason <> '')) THEN
BEGIN
IF ((TempTimer - LastBeep) < 0) THEN
LastBeep := ((TempTimer - LastBeep) + 86400);
IF ((Alert IN ThisUser.Flags) AND ((TempTimer - LastBeep) >= General.Alertbeep)) OR
((ChatReason <> '') AND (SysOpAvailable) AND ((TempTimer - LastBeep) >= 5)) THEN
BEGIN
FOR I := 1 TO 100 DO
BEGIN
{$IFDEF MSDOS}
Sound(500 + (I * 10));
Delay(2);
Sound(100 + (I * 10));
Delay(2);
NoSound;
{$ENDIF}
{$IFDEF WIN32}
Sound(500, 200);
Sound(1500, 200);
{$ENDIF}
END;
LastBeep := TempTimer;
END;
END;
IF ((TempTimer - LastKeyHit) < 0) THEN
LastKeyHit := ((TempTimer - LastKeyHit) + 86400);
IF (General.TimeOut <> - 1) AND ((TempTimer - LastKeyHit) > (General.TimeOut * 60)) AND (NOT TimedOut)
AND (ComPortSpeed <> 0) THEN
BEGIN
TimedOut := TRUE;
PrintF('TIMEOUT');
IF (NoFile) THEN
Print(^M^J^M^J'Time out - disconnecting.'^M^J^M^J);
HangUp := TRUE;
SysOpLog('Inactivity timeout at '+TimeStr);
END;
IF (General.TimeOutBell <> - 1) AND ((TempTimer - LastKeyHit) > (General.TimeOutBell * 60)) AND
(NOT Tf) THEN
BEGIN
Tf := TRUE;
OutKey(^G);
Delay(100);
OutKey(^G);
END;
IF (Empty) THEN
BEGIN
IF (ABS((Ticks - LastTimeSlice)) >= General.Slicetimer) THEN
BEGIN
{$IFDEF MSDOS}
CASE Tasker OF
None : ASM
int 28h
END;
DV : ASM
Mov ax, 1000h
int 15h
END;
Win,Win32,DOS5N : ASM (* Added Win32 & DOS5N *)
Mov ax, 1680h
int 2Fh
END;
Os2 : ASM
Push dx
XOR dx, dx
Mov ax, 0
Sti
Hlt
Db 035h, 0Cah
Pop dx
END;
END;
{$ENDIF}
{$IFDEF WIN32}
Sleep(1);
{$ENDIF}
LastTimeSlice := Ticks;
END
ELSE IF (MultiNodeChat) AND (NOT InChat) AND (ABS(Ticks - LastCheckTimeSlice) > 9) THEN
BEGIN
LastCheckTimeSlice := Ticks;
TeleConfCheck;
LIL := 1;
END;
END;
IF (InChat) THEN
C := Ord(Chinkey)
ELSE
C := InKey;
END;
IF (UserOn) AND ((GetPackDateTime - CreditsLastUpdated) > 60) AND NOT (FNoCredits IN ThisUser.Flags) THEN
BEGIN
Inc(ThisUser.Debit,General.Creditminute * ((GetPackDateTime - CreditsLastUpdated) DIV 60));
CreditsLastUpdated := GetPackDateTime;
END;
END;
END;
GetKey := C;
END;
PROCEDURE CLS;
BEGIN
IF (OkANSI OR OkVT100) THEN
SerialOut(^[+'[1;1H'+^[+'[2J')
ELSE
OutKey(^L);
IF (WantOut) THEN
ClrScr;
IF (Trapping) THEN
OutTrap(^L);
UserColor(1);
LIL := 1;
END;
FUNCTION DisplayARFlags(AR: ARFlagSet; C1,C2: Char): AStr;
VAR
Flag: Char;
TempStr: AStr;
BEGIN
TempStr := '';
FOR Flag := 'A' TO 'Z' DO
IF Flag IN AR THEN
TempStr := TempStr + '^'+C1+Flag
ELSE
TempStr := TempStr + '^'+C2+'-';
DisplayArFlags := TempStr;
END;
PROCEDURE ToggleARFlag(Flag: Char; VAR AR: ARFlagSet; VAR Changed: Boolean);
VAR
SaveAR: ARFlagSet;
BEGIN
SaveAR := AR;
IF (Flag IN ['A'..'Z']) THEN
IF (Flag IN AR) THEN
Exclude(AR,Flag)
ELSE
Include(AR,Flag);
IF (SaveAR <> AR) THEN
Changed := TRUE;
END;
FUNCTION DisplayACFlags(Flags: FlagSet; C1,C2: Char): AStr;
VAR
Flag: FlagType;
TempS: AStr;
BEGIN
TempS := '';
FOR Flag := RLogon TO RMsg DO
IF (Flag IN Flags) THEN
TempS := TempS + '^'+C1+Copy('LCVUA*PEKM',(Ord(Flag) + 1),1)
ELSE
TempS := TempS + '^'+C2+'-';
TempS := TempS + '^'+C2+'/';
FOR Flag := FNoDLRatio TO FNoDeletion DO
IF (Flag IN Flags) THEN
TempS := TempS + '^'+C1+Copy('1234',(Ord(Flag) - 19),1)
ELSE
TempS := TempS + '^'+C2+'-';
DisplayACFlags := TempS;
END;
PROCEDURE ToggleACFlag(Flag: FlagType; VAR Flags: FlagSet);
BEGIN
IF (Flag IN Flags) THEN
Exclude(Flags,Flag)
ELSE
Include(Flags,Flag);
END;
PROCEDURE ToggleACFlags(Flag: Char; VAR Flags: FlagSet; VAR Changed: Boolean);
VAR
SaveFlags: FlagSet;
BEGIN
SaveFlags := Flags;
CASE Flag OF
'L' : ToggleACFlag(RLogon,Flags);
'C' : ToggleACFlag(RChat,Flags);
'V' : ToggleACFlag(RValidate,Flags);
'U' : ToggleACFlag(RUserList,Flags);
'A' : ToggleACFlag(RAMsg,Flags);
'*' : ToggleACFlag(RPostAn,Flags);
'P' : ToggleACFlag(RPost,Flags);
'E' : ToggleACFlag(REmail,Flags);
'K' : ToggleACFlag(RVoting,Flags);
'M' : ToggleACFlag(RMsg,Flags);
'1' : ToggleACFlag(FNoDLRatio,Flags);
'2' : ToggleACFlag(FNoPostRatio,Flags);
'3' : ToggleACFlag(FNoCredits,Flags);
'4' : ToggleACFlag(FNoDeletion,Flags);
END;
IF (SaveFlags <> Flags) THEN
Changed := TRUE;
END;
PROCEDURE ToggleStatusFlag(Flag: StatusFlagType; VAR SUFlags: StatusFlagSet);
BEGIN
IF (Flag IN SUFlags) THEN
Exclude(SUFlags,Flag)
ELSE
Include(SUFlags,Flag);
END;
PROCEDURE ToggleStatusFlags(Flag: Char; VAR SUFlags: StatusFlagSet);
BEGIN
CASE Flag OF
'A' : ToggleStatusFlag(LockedOut,SUFlags);
'B' : ToggleStatusFlag(Deleted,SUFlags);
'C' : ToggleStatusFlag(TrapActivity,SUFlags);
'D' : ToggleStatusFlag(TrapSeparate,SUFlags);
'E' : ToggleStatusFlag(ChatAuto,SUFlags);
'F' : ToggleStatusFlag(ChatSeparate,SUFlags);
'G' : ToggleStatusFlag(SLogSeparate,SUFlags);
'H' : ToggleStatusFlag(CLSMsg,SUFlags);
'I' : ToggleStatusFlag(RIP,SUFlags);
'J' : ToggleStatusFlag(FSEditor,SUFlags);
'K' : ToggleStatusFlag(AutoDetect,SUFlags);
END;
END;
FUNCTION TACCH(Flag: Char): FlagType;
BEGIN
CASE Flag OF
'L': TACCH := RLogon;
'C': TACCH := RChat;
'V': TACCH := RValidate;
'U': TACCH := RUserList;
'A': TACCH := RAMsg;
'*': TACCH := RPostAN;
'P': TACCH := RPost;
'E': TACCH := REmail;
'K': TACCH := RVoting;
'M': TACCH := RMsg;
'1': TACCH := FNoDLRatio;
'2': TACCH := FNoPostRatio;
'3': TACCH := FNoCredits;
'4': TACCH := FNoDeletion;
END;
END;
{$IFDEF MSDOS}
FUNCTION AOnOff(b: Boolean; CONST s1,s2:AStr): STRING; ASSEMBLER;
ASM
PUSH ds
Test b, 1
JZ @@1
LDS si, s1
JMP @@2
@@1: LDS si, s2
@@2: LES di, @Result
XOR Ch, Ch
MOV cl, Byte ptr ds:[si]
MOV Byte ptr es:[di], cl
Inc di
Inc si
CLD
REP MOVSB
POP ds
END;
{$ENDIF}
{$IFDEF WIN32}
FUNCTION AOnOff(b: Boolean; CONST s1,s2:AStr): STRING;
BEGIN
if (b) then
AOnOff := s1
else
AOnOff := s2;
END;
{$ENDIF}
FUNCTION ShowOnOff(b: Boolean): STRING;
BEGIN
IF (b) THEN
ShowOnOff := 'On '
ELSE
ShowOnOff := 'Off';
END;
FUNCTION ShowYesNo(b: Boolean): STRING;
BEGIN
IF (b) THEN
ShowYesNo := 'Yes'
ELSE
ShowYesNo := 'No ';
END;
FUNCTION YN(Len: Byte; DYNY: Boolean): Boolean;
VAR
Cmd: Char;
BEGIN
IF (NOT HangUp) THEN
BEGIN
UserColor(3);
Prompt(SQOutSp(ShowYesNo(DYNY)));
REPEAT
Cmd := UpCase(Char(GetKey));
UNTIL (Cmd IN ['Y','N',^M]) OR (HangUp);
IF (DYNY) AND (Cmd <> 'N') THEN
Cmd := 'Y';
IF (DYNY) AND (Cmd = 'N') THEN
Prompt(#8#8#8'^3No ')
ELSE IF (NOT DYNY) AND (Cmd = 'Y') THEN
Prompt(#8#8'^3Yes');
IF (Cmd = 'N') AND (Len <> 0) THEN
DoBackSpace(1,Len)
ELSE
NL;
UserColor(1);
YN := (Cmd = 'Y') AND (NOT HangUp);
END;
END;
FUNCTION PYNQ(CONST InString: AStr; MaxLen: Byte; DYNY: Boolean): Boolean;
BEGIN
UserColor(7);
Prompt(InString);
PYNQ := YN(MaxLen,DYNY);
END;
PROCEDURE OneK(VAR C: Char; ValidKeys: AStr; DisplayKey,LineFeed: Boolean);
BEGIN
MPL(1);
TempPause := (Pause IN ThisUser.Flags);
REPEAT
C := UpCase(Char(GetKey));
UNTIL (Pos(C,ValidKeys) > 0) OR (HangUp);
IF (HangUp) THEN
C := ValidKeys[1];
IF (DisplayKey) THEN
OutKey(C);
IF (Trapping) THEN
OutTrap(C);
UserColor(1);
IF (LineFeed) THEN
NL;
END;
PROCEDURE OneK1(VAR C: Char; ValidKeys: AStr; DisplayKey,LineFeed: Boolean);
BEGIN
MPL(1);
TempPause := (Pause IN ThisUser.Flags);
REPEAT
C := Char(GetKey);
IF (C = 'q') THEN
C := UpCase(C);
UNTIL (Pos(C,ValidKeys) > 0) OR (HangUp);
IF (HangUp) THEN
C := ValidKeys[1];
IF (DisplayKey) THEN
OutKey(C);
IF (Trapping) THEN
OutTrap(C);
UserColor(1);
IF (LineFeed) THEN
NL;
END;
PROCEDURE LOneK(DisplayStr: AStr; VAR C: Char; ValidKeys: AStr; DisplayKey,LineFeed: Boolean);
BEGIN
Prt(DisplayStr);
MPL(1);
TempPause := (Pause IN ThisUser.Flags);
REPEAT
C := UpCase(Char(GetKey));
UNTIL (Pos(C,ValidKeys) > 0) OR (HangUp);
IF (HangUp) THEN
C := ValidKeys[1];
IF (DisplayKey) THEN
OutKey(C);
IF (Trapping) THEN
OutTrap(C);
UserColor(1);
IF (LineFeed) THEN
NL;
END;
FUNCTION Centre(InString: AStr): STRING;
VAR
StrLen,
Counter: Integer;
BEGIN
StrLen := LennMCI(Instring);
IF (StrLen < ThisUser.LineLen) THEN
BEGIN
Counter := ((ThisUser.LineLen - StrLen) DIV 2);
Move(Instring[1],Instring[Counter + 1],Length(Instring));
Inc(Instring[0],Counter);
FillChar(InString[1],Counter,#32);
END;
Centre := InString;
END;
PROCEDURE WKey;
VAR
Cmd: Char;
BEGIN
IF (NOT AllowAbort) OR (Abort) OR (HangUp) OR (Empty) THEN
Exit;
Cmd := Char(GetKey);
IF (DisplayingMenu) AND (Pos(UpCase(Cmd),MenuKeys) > 0) THEN
BEGIN
MenuAborted := TRUE;
Abort := TRUE;
Buf := Buf + UpCase(Cmd);
END
ELSE
CASE UpCase(Cmd) OF
' ',^C,^X,^K :
Abort := TRUE;
'N',^N :
IF (Reading_A_Msg) THEN
BEGIN
Abort := TRUE;
Next := TRUE;
END;
'P',^S :
Cmd := Char(GetKey);
ELSE IF (Reading_A_Msg) OR (PrintingFile) THEN
IF (Cmd <> #0) THEN
Buf := Buf + Cmd;
END;
IF (Abort) THEN
BEGIN
Com_Purge_Send;
NL;
END;
END;
PROCEDURE PrintMain(CONST ss:STRING);
VAR
i,
X: Word;
X2: Byte;
c: Char;
cs: STRING;
s: STRING;
Justify: Byte;
BEGIN
IF (Abort) AND (AllowAbort) THEN
Exit;
IF (HangUp) THEN
BEGIN
Abort := TRUE;
Exit;
END;
IF (NOT MCIAllowed) THEN
s := ss
ELSE
BEGIN
s := '';
FOR i := 1 TO Length(ss) DO
IF (ss[i] = '%') AND (i + 2 <= Length(ss)) THEN
BEGIN
cs := MCI(Copy(ss,i,3)); { faster than adding }
IF (cs = Copy(ss,i,3)) THEN
BEGIN
s := s + '%';
Continue;
END;
Inc(i,2);
IF (Length(ss) >= i + 2) AND (ss[i + 1] IN ['#','{','}']) THEN
BEGIN
IF (ss[i + 1] = '}') THEN
Justify := 0
ELSE IF (ss[i + 1] = '{') THEN
Justify := 1
ELSE
Justify := 2;
IF (ss[i + 2] IN ['0'..'9']) THEN
BEGIN
X2 := Ord(ss[i + 2]) - 48;
Inc(i, 2);
IF (ss[i + 1] IN ['0'..'9']) THEN
BEGIN
X2 := X2 * 10 + Ord(ss[i + 1]) - 48;
Inc(i, 1);
END;
IF (X2 > 0) THEN
CASE Justify OF
0 : cs := PadRightStr(cs,X2);
1 : cs := PadLeftStr(cs,X2);
2 : WHILE (Length(cs) < X2) DO
BEGIN
cs := ' ' + cs;
IF (Length(cs) < X2) THEN
cs := cs + ' ';
END;
END;
END;
END;
{ s := s + cs; }
IF (Length(cs) + Length(s) <= 255) THEN
BEGIN
Move(cs[1],s[Length(s)+1],Length(cs));
Inc(s[0],Length(cs));
END
ELSE
IF (Length(s) < 255) THEN
BEGIN
Move(cs[1],s[Length(s)+1],(255 - Length(s)));
s[0] := #255;
END;
END
ELSE
IF (Length(s) < 255) THEN { s := s + ss[i]; }
BEGIN
Inc(s[0]);
s[Length(s)] := ss[i];
END;
END;
IF NOT (OkANSI OR OkAvatar) THEN
s := StripColor(s);
i := 1;
IF ((NOT Abort) OR (NOT AllowAbort)) AND (NOT HangUp) THEN { can't change IN loop }
WHILE (i <= Length(s)) DO
BEGIN
CASE s[i] OF
'%' : IF MCIAllowed AND (i + 1 < Length(s)) THEN
BEGIN
IF (UpCase(s[i + 1]) = 'P') AND (UpCase(s[i + 2]) = 'A') THEN { %PA Pause }
BEGIN
Inc(i,2);
PauseScr(FALSE)
END
ELSE IF (UpCase(s[i + 1]) = 'P') AND (UpCase(s[i + 2]) = 'E') THEN { %PE Null Pause }
BEGIN
Inc(i,2);
PauseIsNull := TRUE;
PauseScr(FALSE);
PauseIsNull := FALSE;
END
ELSE IF (UpCase(s[i + 1]) = 'D') THEN
IF (UpCase(s[i + 2]) = 'E') THEN { %DE Delay }
BEGIN
Inc(i,2);
OutKey(' '); OutKey(#8); { guard against +++ }
Delay(800);
END
ELSE IF ((UpCase(s[i + 2]) = 'F') AND (NOT PrintingFile)) THEN { %DF File Include }
BEGIN
cs := ''; Inc(i, 3);
WHILE (i < Length(s)) AND (s[i] <> '%') DO
BEGIN
cs := cs + s[i];
Inc(i);
END;
PrintF(StripName(cs));
END
ELSE
ELSE
OutKey('%');
END
ELSE
OutKey('%');
^S:IF (i < Length(s)) AND (NextState = Waiting) THEN BEGIN
IF (Ord(s[i + 1]) <= 200) THEN SetC(Scheme.Color[Ord(s[i + 1])]); Inc(i);
END
ELSE OutKey('');
'|':IF (ColorAllowed) AND (i + 1 < Length(s)) AND
(s[i + 1] IN ['0'..'9']) AND (s[i + 2] IN ['0'..'9'])
THEN
BEGIN
X := StrToInt(Copy(s,i + 1,2));
CASE X OF
0..15:SetC(CurrentColor - (CurrentColor MOD 16) + X);
16..23:SetC(((X - 16) * 16) + (CurrentColor MOD 16));
END;
Inc(i,2);
END
ELSE
OutKey('|');
#9:FOR X := 1 TO 5 DO
OutKey(' ');
'^':IF (ColorAllowed) AND (i < Length(s)) AND (s[i+1] IN ['0'..'9']) THEN
BEGIN
Inc(i);
UserColor(Ord(s[i]) - 48);
END
ELSE
OutKey('^');
ELSE
OutKey(s[i]);
END;
Inc(i);
X2 := i;
WHILE (X2 < Length(s)) AND
NOT (s[X2] IN [^S,'^','|','%',^G,^L,^V,^y,^J,^[])
DO
Inc(X2);
IF (X2 > i) THEN
BEGIN
cs[0] := Chr(X2 - i);
Move(s[i], cs[1], X2 - i); { twice as fast as Copy(s,i,x2-i); }
i := X2;
IF (Trapping) THEN
Write(TrapFile,cs);
IF (WantOut) THEN
IF (NOT DOSANSIOn) THEN
Write(cs)
ELSE
FOR X2 := 1 TO Length(cs) DO
DOSANSI(cs[X2]);
SerialOut(cs);
END;
END;
WKey;
END;
PROCEDURE PrintACR(InString: STRING);
VAR
TurnOff: Boolean;
BEGIN
IF (AllowAbort) AND (Abort) THEN
Exit;
Abort := FALSE;
TurnOff := (InString[Length(Instring)] = #29);
IF (TurnOff) THEN
Dec(InString[0]);
CheckHangup;
IF (NOT CROff) AND NOT (TurnOff) THEN
InString := InString + ^M^J;
PrintMain(InString);
IF (Abort) THEN
BEGIN
CurrentColor := (255 - CurrentColor);
UserColor(1);
END;
CROff := FALSE;
END;
PROCEDURE pfl(FN: AStr);
VAR
fil: Text;
ls: STRING[255];
ps: Byte;
c: Char;
SaveTempPause,
ToggleBack,
SaveAllowAbort: Boolean;
BEGIN
PrintingFile := TRUE;
SaveAllowAbort := AllowAbort;
AllowAbort := TRUE;
Abort := FALSE;
Next := FALSE;
ToggleBack := FALSE;
SaveTempPause := TempPause;
FN := AllCaps(FN);
IF (General.WindowOn) AND (Pos('.AN',FN) > 0) OR (Pos('.AV',FN) > 0) THEN
BEGIN
TempPause := FALSE;
ToggleBack := TRUE;
ToggleWindow(FALSE);
IF (OkRIP) THEN
SerialOut('!|*|');
END;
IF (Pos('.RI',FN) > 0) THEN
TempPause := FALSE;
IF (NOT HangUp) THEN
BEGIN
Assign(fil,SQOutSp(FN));
Reset(fil);
IF (IOResult <> 0) THEN
NoFile := TRUE
ELSE
BEGIN
Abort := FALSE;
Next := FALSE;
WHILE (NOT EOF(fil)) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
ps := 0;
REPEAT
Inc(ps);
Read(fil,ls[ps]);
IF EOF(fil) THEN {check again incase avatar parameter}
BEGIN
Inc(ps);
Read(fil,ls[ps]);
IF EOF(fil) THEN
Dec(ps);
END;
UNTIL ((ls[ps] = ^J) AND (NextState IN [Waiting..In_Param])) OR (ps = 255) OR EOF(fil);
ls[0] := Chr(ps);
CROff := TRUE;
CtrlJOff := ToggleBack;
PrintACR(ls);
END;
Close(fil);
END;
NoFile := FALSE;
END;
AllowAbort := SaveAllowAbort;
PrintingFile := FALSE;
CtrlJOff := FALSE;
IF (ToggleBack) THEN
ToggleWindow(TRUE);
RedrawForANSI;
IF (NOT TempPause) THEN
LIL := 0;
TempPause := SaveTempPause;
END;
FUNCTION BSlash(InString: AStr; b: Boolean): AStr;
BEGIN
IF (b) THEN
BEGIN
WHILE (Copy(InString,(Length(InString) - 1),2) = '\\') DO
InString := Copy(Instring,1,(Length(InString) - 2));
IF (Copy(InString,Length(InString),1) <> '\') THEN
InString := InString + '\';
END
ELSE
WHILE (InString[Length(InString)] = '\') DO
Dec(InString[0]);
BSlash := Instring;
END;
FUNCTION Exist(FileName: AStr): Boolean;
VAR
DirInfo1: SearchRec;
BEGIN
FindFirst(SQOutSp(FileName),AnyFile,DirInfo1);
Exist := (DOSError = 0);
END;
FUNCTION ExistDir(Path: PathStr): Boolean;
VAR
DirInfo1: SearchRec;
BEGIN
Path := AllCaps(BSlash(Path,FALSE));
FindFirst(Path,AnyFile,DirInfo1);
ExistDir := (DOSError = 0) AND (DirInfo1.Attr AND $10 = $10);
END;
PROCEDURE PrintFile(FileName: AStr);
VAR
s: AStr;
dayofweek: Byte;
i: Integer;
BEGIN
FileName := AllCaps(FileName);
s := FileName;
IF (Copy(FileName,Length(FileName) - 3,4) = '.ANS') THEN
BEGIN
IF (Exist(Copy(FileName,1,Length(FileName) - 4)+'.AN1')) THEN
REPEAT
i := Random(10);
IF (i = 0) THEN
FileName := Copy(FileName,1,Length(FileName) - 4)+'.ANS'
ELSE
FileName := Copy(FileName,1,Length(FileName) - 4)+'.AN'+IntToStr(i);
UNTIL (Exist(FileName));
END
ELSE IF (Copy(FileName,Length(FileName) - 3,4) = '.AVT') THEN
BEGIN
IF (Exist(Copy(FileName,1,Length(FileName) - 4)+'.AV1')) THEN
REPEAT
i := Random(10);
IF (i = 0) THEN
FileName := Copy(FileName,1,Length(FileName) - 4)+'.AVT'
ELSE
FileName := Copy(FileName,1,Length(FileName) - 4)+'.AV'+IntToStr(i);
UNTIL (Exist(FileName));
END
ELSE IF (Copy(FileName,Length(FileName) - 3,4) = '.RIP') THEN
BEGIN
IF (Exist(Copy(FileName,1,Length(FileName) - 4)+'.RI1')) THEN
REPEAT
i := Random(10);
IF (i = 0) THEN
FileName := Copy(FileName,1,Length(FileName) - 4)+'.RIP'
ELSE
FileName := Copy(FileName,1,Length(FileName) - 4)+'.RI'+IntToStr(i);
UNTIL (Exist(FileName));
END;
GetDayOfWeek(DayOfWeek);
s := FileName;
s[Length(s) - 1] := Chr(DayOfWeek + 48);
IF (Exist(s)) THEN
FileName := s;
pfl(FileName);
END;
PROCEDURE PrintF(FileName: AStr);
VAR
FFN,
Path: PathStr;
Name: NameStr;
Ext: ExtStr;
j: Integer; (* doesn't seem to do anything *)
BEGIN
NoFile := TRUE;
FileName := SQOutSp(FileName);
IF (FileName = '') THEN
Exit;
IF (Pos('\',FileName) <> 0) THEN (* ??? *)
j := 1
ELSE
BEGIN
j := 2;
FSplit(FExpand(FileName),Path,Name,Ext);
IF (NOT Exist(General.MiscPath+Name+'.*')) THEN
Exit;
END;
FFN := FileName;
IF ((Pos('\',FileName) = 0) AND (Pos(':',FileName) = 0)) THEN
FFN := General.MiscPath+FFN;
FFN := FExpand(FFN);
IF (Pos('.',FileName) <> 0) THEN
PrintFile(FFN)
ELSE
BEGIN
IF (OkRIP) AND Exist(FFN+'.RIP') THEN
PrintFile(FFN+'.RIP');
IF (NoFile) AND (OkAvatar) AND Exist(FFN+'.AVT') THEN
PrintFile(FFN+'.AVT');
IF (NoFile) AND (OkANSI) AND Exist(FFN+'.ANS') THEN
PrintFile(FFN+'.ANS');
IF (NoFile) AND (Exist(FFN+'.ASC')) THEN
PrintFile(FFN+'.ASC');
END;
END;
FUNCTION VerLine(B: Byte): STRING;
BEGIN
CASE B OF
1 : VerLine := '|09The |14Renegade Bulletin Board System|09, Version |15'+General.Version;
2 : VerLine := '|09Brought to you by |10The Renegade Development Team|09.';
3 : VerLine := '|09Copyright (c) |151991-2009|09';
END;
END;
FUNCTION AACS1(User: UserRecordType; UNum: Integer; s: ACString): Boolean;
VAR
s1,
s2: AStr;
c,
c1,
c2: Char;
i,
p1,
p2,
j: Integer;
b: Boolean;
PROCEDURE GetRest;
VAR
incre: Byte;
BEGIN
s1 := c;
p1 := i;
incre := 0;
IF ((i <> 1) AND (s[i - 1] = '!')) THEN
BEGIN
s1 := '!' + s1;
Dec(p1);
END;
IF (c IN ['N','C','E','F','G','I','J','M','O','R','V','Z']) THEN
BEGIN
s1 := s1 + s[i + 1];
Inc(i);
IF c IN ['N'] THEN
WHILE s[i + 1 + incre] IN ['0'..'9'] DO
BEGIN
Inc (incre);
s1 := s1 + s[i +1 +incre];
END;
END
ELSE
BEGIN
j := i + 1;
WHILE (j <= Length(s)) AND (s[j] IN ['0'..'9']) DO
BEGIN
s1 := s1 + s[j];
Inc(j);
END;
i := (j - 1);
END;
p2 := i;
END;
FUNCTION ArgStat(s: AStr): Boolean;
VAR
VS: AStr;
c: Char;
DayOfWeek: Byte;
RecNum1,
RecNum,
VSI: Integer;
Hour,
Minute,
Second,
Sec100: Word;
BoolState,
ACS: Boolean;
BEGIN
BoolState := (s[1] <> '!');
IF (NOT BoolState) THEN
s := Copy(s,2,(Length(s) - 1));
VS := Copy(s,2,(Length(s) - 1));
VSI := StrToInt(VS);
CASE s[1] OF
'A' : ACS := (AgeUser(User.BirthDate) >= VSI);
'B' : ACS := ((ActualSpeed >= (VSI * 100)) AND (VSI > 0)) OR (ComPortSpeed = 0);
'C' : BEGIN
ACS := (CurrentConf = VS);
C := VS[1];
IF (NOT ConfSystem) AND (C IN ConfKeys) THEN
BEGIN
IF FindConference(C,Conference) THEN
ACS := AACS1(ThisUser,UserNum,Conference.ACS)
ELSE
ACS := FALSE;
END;
END;
'D' : ACS := (User.DSL >= VSI) OR (TempSysOp);
'E' : CASE UpCase(VS[1]) OF
'A' : ACS := OkANSI;
'N' : ACS := NOT (OkANSI OR OkAvatar OR OkVT100);
'V' : ACS := OkAvatar;
'R' : ACS := OkRIP;
'1' : ACS := OkVT100;
END;
'F' : ACS := (UpCase(VS[1]) IN User.AR);
'G' : ACS := (User.Sex = UpCase(VS[1]));
'H' : BEGIN
GetTime(Hour,Minute,Second,Sec100);
ACS := (Hour = VSI);
END;
'I' : ACS := IsInvisible;
'J' : ACS := (Novice IN User.Flags);
'K' : ACS := (ReadMsgArea = VSI);
'L' : ACS := (ReadFileArea = VSI);
'M' : ACS := (UnVotedTopics = 0);
'N' : ACS := (ThisNode = VSI);
'O' : ACS := SysOpAvailable;
'P' : ACS := ((User.lCredit - User.Debit) >= VSI);
'R' : ACS := (TACCH(UpCase(VS[1])) IN User.Flags);
'S' : ACS := (User.SL >= VSI) OR (TempSysOp);
'T' : ACS := (NSL DIV 60 >= VSI);
'U' : ACS := (UNum = VSI);
'V' : BEGIN
Reset(ValidationFile);
RecNum1 := -1;
RecNum := 1;
WHILE (RecNum <= NumValKeys) AND (RecNum1 = -1) DO
BEGIN
Seek(ValidationFile,(RecNum - 1));
Read(ValidationFile,Validation);
IF (Validation.Key = '!') THEN
RecNum1 := RecNum;
Inc(RecNum);
END;
Close(ValidationFile);
ACS := (RecNum1 <> -1) AND (User.SL > Validation.NewSL);
END;
'W' : BEGIN
GetDayOfWeek(DayOfWeek);
ACS := (DayOfWeek = Ord(s[2]) - 48);
END;
'X' : ACS := (((User.Expiration DIV 86400) - (GetPackDateTime DIV 86400)) <= VSI) AND (User.Expiration > 0);
'Y' : ACS := (Timer DIV 60 >= VSI);
'Z' : IF (FNoPostRatio IN User.Flags) THEN
ACS := TRUE
ELSE IF (General.PostRatio[User.SL] > 0) AND (User.LoggedOn > 100 / General.PostRatio[User.SL]) THEN
ACS := ((User.MsgPost / User.LoggedOn * 100) >= General.PostRatio[User.SL])
ELSE
ACS := TRUE;
END;
IF (NOT BoolState) THEN
ACS := NOT ACS;
ArgStat := ACS;
END;
BEGIN
i := 0;
s := AllCaps(s);
WHILE (i < Length(s)) DO
BEGIN
Inc(i);
c := s[i];
IF (c IN ['A'..'Z']) AND (i <> Length(s)) THEN
BEGIN
GetRest;
b := ArgStat(s1);
Delete(s,p1,Length(s1));
IF (b) THEN
s2 := '^'
ELSE
s2 := '%';
Insert(s2,s,p1);
Dec(i,(Length(s1) - 1));
END;
END;
s := '(' + s + ')';
WHILE (Pos('&', s) <> 0) DO
Delete(s,Pos('&',s),1);
WHILE (Pos('^^', s) <> 0) DO
Delete(s,Pos('^^',s),1);
WHILE (Pos('(', s) <> 0) DO
BEGIN
i := 1;
WHILE ((s[i] <> ')') AND (i <= Length(s))) DO
BEGIN
IF (s[i] = '(') THEN
p1 := i;
Inc(i);
END;
p2 := i;
s1 := Copy(s,(p1 + 1),((p2 - p1) - 1));
WHILE (Pos('|',s1) <> 0) DO
BEGIN
i := Pos('|',s1);
c1 := s1[i - 1];
c2 := s1[i + 1];
s2 := '%';
IF ((c1 IN ['%','^']) AND (c2 IN ['%','^'])) THEN
BEGIN
IF ((c1 = '^') OR (c2 = '^')) THEN
s2 := '^';
Delete(s1,(i - 1),3);
Insert(s2,s1,(i - 1));
END
ELSE
Delete(s1,i,1);
END;
WHILE (Pos('%%',s1) <> 0) DO
Delete(s1,Pos('%%',s1),1); {leave only "%"}
WHILE (Pos('^^', s1) <> 0) DO
Delete(s1,Pos('^^',s1),1); {leave only "^"}
WHILE (Pos('%^', s1) <> 0) DO
Delete(s1,Pos('%^',s1)+1,1); {leave only "%"}
WHILE (Pos('^%', s1) <> 0) DO
Delete(s1,Pos('^%',s1),1); {leave only "%"}
Delete(s,p1,((p2 - p1) + 1));
Insert(s1,s,p1);
END;
AACS1 := (Pos('%',s) = 0);
END;
FUNCTION AACS(s: ACString): Boolean;
BEGIN
AACS := AACS1(ThisUser,UserNum,s);
END;
PROCEDURE LoadNode(NodeNumber: Byte);
BEGIN
IF (General.MultiNode) THEN
BEGIN
Reset(NodeFile);
IF (NodeNumber >= 1) AND (NodeNumber <= FileSize(NodeFile)) AND (IOResult = 0) THEN
BEGIN
Seek(NodeFile,(NodeNumber - 1));
Read(NodeFile,NodeR);
END;
Close(NodeFile);
LastError := IOResult;
END;
END;
PROCEDURE Update_Node(NActivityDesc: AStr; SaveVars: Boolean);
BEGIN
IF (General.MultiNode) THEN
BEGIN
LoadNode(ThisNode);
IF (SaveVars) THEN
BEGIN
SaveNDescription := NodeR.ActivityDesc;
NodeR.ActivityDesc := NActivityDesc
END
ELSE
NodeR.ActivityDesc := SaveNDescription;
(*
IF (UserOn) THEN
BEGIN
*)
NodeR.User := UserNum;
NodeR.UserName := ThisUser.Name;
NodeR.Sex := ThisUser.Sex;
NodeR.Age := AgeUser(ThisUser.BirthDate);
NodeR.CityState := ThisUser.CityState;
NodeR.LogonTime := TimeOn;
NodeR.Channel := ChatChannel;
(*
END;
*)
SaveNode(ThisNode);
END;
END;
FUNCTION MaxChatRec: LongInt;
VAR
DirInfo1: SearchRec;
BEGIN
FindFirst(General.TempPath+'MSG'+IntToStr(ThisNode)+'.TMP',AnyFile,DirInfo1);
IF (DOSError = 0) THEN
MaxChatRec := DirInfo1.Size
ELSE
MaxChatRec := 0;
END;
FUNCTION MaxNodes: Byte;
VAR
DirInfo1: SearchRec;
BEGIN
FindFirst(General.DataPath+'MULTNODE.DAT',AnyFile,DirInfo1);
IF (DOSError = 0) THEN
MaxNodes := (DirInfo1.Size DIV SizeOf(NodeRecordType))
ELSE
MaxNodes := 0;
END;
PROCEDURE SaveNode(NodeNumber: Byte);
BEGIN
IF (General.MultiNode) THEN
BEGIN
Reset(NodeFile);
IF (NodeNumber >= 1) AND (NodeNumber <= FileSize(NodeFile)) AND (IOResult = 0) THEN
BEGIN
Seek(NodeFile,(NodeNumber - 1));
Write(NodeFile,NodeR);
END;
Close(NodeFile);
LastError := IOResult;
END;
END;
PROCEDURE LoadURec(VAR User: UserRecordType; UserNumber: Integer);
VAR
FO: Boolean;
BEGIN
FO := (FileRec(UserFile).Mode <> FMClosed);
IF (NOT FO) THEN
BEGIN
Reset(UserFile);
IF (IOResult <> 0) THEN
BEGIN
SysOpLog('Error opening USERS.DAT.');
Exit;
END;
END;
IF (UserNumber <> UserNum) OR (NOT UserOn) THEN
BEGIN
Seek(UserFile,UserNumber);
Read(UserFile,User);
END
ELSE
User := ThisUser;
IF (NOT FO) THEN
Close(UserFile);
LastError := IOResult;
END;
PROCEDURE SaveURec(User: UserRecordType; UserNumber: Integer);
VAR
FO: Boolean;
NodeNumber: Byte;
BEGIN
FO := (FileRec(UserFile).Mode <> FMClosed);
IF (NOT FO) THEN
BEGIN
Reset(UserFile);
IF (IOResult <> 0) THEN
BEGIN
SysOpLog('Error opening USERS.DAT.');
Exit;
END;
END;
Seek(UserFile,UserNumber);
Write(UserFile,User);
IF (NOT FO) THEN
Close(UserFile);
IF (UserNumber = UserNum) THEN
ThisUser := User
ELSE
BEGIN
IF (General.MultiNode) THEN
BEGIN
NodeNumber := OnNode(UserNumber);
IF (NodeNumber > 0) THEN
BEGIN
LoadNode(NodeNumber);
Include(NodeR.Status,NUpdate);
SaveNode(NodeNumber);
END;
END;
END;
LastError := IOResult;
END;
FUNCTION MaxUsers: Integer;
VAR
DirInfo1: SearchRec;
BEGIN
FindFirst(General.DataPath+'USERS.DAT',AnyFile,DirInfo1);
IF (DOSError = 0) THEN
MaxUsers := (DirInfo1.Size DIV SizeOf(UserRecordType))
ELSE
MaxUsers := 0;
END;
FUNCTION MaxIDXRec: Integer;
VAR
DirInfo1: SearchRec;
BEGIN
FindFirst(General.DataPath+'USERS.IDX',AnyFile,DirInfo1);
IF (DOSError = 0) THEN
MaxIDXRec := (DirInfo1.Size DIV SizeOf(UserIDXRec))
ELSE
MaxIDXRec := 0;
IF (NOT UserOn) AND (DirInfo1.Size MOD SizeOf(UserIDXRec) <> 0) THEN
MaxIDXRec := -1; { UserOn is so it'll only show during boot up }
END;
FUNCTION HiMsg: Word;
VAR
DirInfo1: SearchRec;
BEGIN
FindFirst(General.MsgPath+MemMsgArea.FileName+'.HDR',AnyFile,DirInfo1);
IF (DOSError = 0) THEN
HiMsg := (DirInfo1.Size DIV SizeOf(MHeaderRec))
ELSE
HiMsg := 0;
END;
PROCEDURE ScanInput(VAR S: AStr; CONST Allowed: AStr);
VAR
SaveS: AStr;
c: Char;
Counter: Byte;
GotCmd: Boolean;
BEGIN
GotCmd := FALSE;
s := '';
REPEAT
c := UpCase(Char(GetKey));
SaveS := s;
IF ((Pos(c,Allowed) <> 0) AND (s = '')) THEN
BEGIN
GotCmd := TRUE;
s := c;
END
ELSE IF (Pos(c,'0123456789') > 0) OR (c = '-') THEN
BEGIN
IF ((Length(s) < 6) OR ((Pos('-',s) > 0) AND (Length(s) < 11))) THEN
s := s + c;
END
ELSE IF ((s <> '') AND (c = ^H)) THEN
Dec(s[0])
ELSE IF (c = ^X) THEN
BEGIN
FOR Counter := 1 TO Length(s) DO
BackSpace;
s := '';
SaveS := '';
END
ELSE IF (c = #13) THEN
GotCmd := TRUE;
IF (Length(s) < Length(SaveS)) THEN
BackSpace;
IF (Length(s) > Length(SaveS)) THEN
Prompt(s[Length(s)]);
UNTIL (GotCmd) OR (HangUp);
UserColor(1);
NL;
END;
PROCEDURE ScreenDump(CONST FileName: AStr);
VAR
ScreenFile: Text;
TempStr: AStr;
c: Char;
XPos,
YPos: Byte;
VidSeg: Word;
BEGIN
Assign(ScreenFile,FileName);
Append(ScreenFile);
IF (IOResult = 2) THEN
ReWrite(ScreenFile);
IF (MonitorType = 7) THEN
VidSeg := $B000
ELSE
VidSeg := $B800;
FOR YPos := 1 TO MaxDisplayRows DO
BEGIN
TempStr := '';
FOR XPos := 1 TO MaxDisplayCols DO
BEGIN
{$IFDEF MSDOS}
c := Chr(Mem[VidSeg:(160 * (YPos - 1) + 2 * (XPos - 1))]);
{$ENDIF}
{$IFDEF WIN32}
c := SysReadCharAt(XPos - 1, YPos - 1);
{$ENDIF}
IF (c = #0) THEN
c := #32;
IF ((XPos = WhereX) AND (YPos = WhereY)) THEN
c := #178;
TempStr := TempStr + c;
END;
WHILE (TempStr[Length(TempStr)] = ' ') DO
Dec(TempStr[0]);
WriteLn(ScreenFile,TempStr);
END;
Close(ScreenFile);
LastError := IOResult;
END;
PROCEDURE InputPath(CONST DisplayStr: AStr; VAR DirPath: Str40; CreateDir,AllowExit: Boolean; VAR Changed: Boolean);
VAR
TempDirPath: Str40;
CurDir: PathStr;
Counter: Byte;
BEGIN
REPEAT
TempDirPath := DirPath;
Changed := FALSE;
InputWN1(DisplayStr,TempDirPath,39,[UpperOnly,InterActiveEdit],Changed);
TempDirPath := SQOutSp(TempDirPath);
IF (Length(TempDirPath) = 1) THEN
TempDirPath := TempDirPath + ':\'
ELSE IF (Length(TempDirPath) = 2) AND (TempDirPath[2] = ':') THEN
TempDirPath := TempDirPath + '\';
IF (AllowExit) AND (TempDirPath = '') THEN
BEGIN
NL;
Print('Aborted!');
END
ELSE IF (TempDirPath = '') THEN
BEGIN
NL;
Print('^7A valid path must be specified!^1');
END
ELSE IF (NOT (TempDirPath[1] IN ['A'..'Z'])) OR (Length(TempDirPath) < 3) OR
(NOT (TempDirPath[2] = ':')) OR (NOT (TempDirPath[3] = '\')) THEN
BEGIN
NL;
Print('^7Invalid drive specification: "'+Copy(TempDirPath,1,3)+'"^1');
TempDirPath := '';
END
ELSE
BEGIN
GetDir(0,CurDir);
ChDir(TempDirPath[1]+':');
IF (IOResult <> 0) THEN
BEGIN
NL;
Print('^7Drive does not exist: "'+Copy(TempDirPath,1,3)+'"^1');
TempDirPath := '';
END
ELSE
BEGIN
ChDir(CurDir);
IF (CreateDir) THEN
BEGIN
TempDirPath := BSlash(TempDirPath,TRUE);
IF (Length(TempDirPath) > 3) AND (NOT ExistDir(TempDirPath)) THEN
BEGIN
NL;
IF PYNQ('Directory does not exist, create it? ',0,FALSE) THEN
BEGIN
Counter := 2;
WHILE (Counter <= Length(TempDirPath)) DO
BEGIN
IF (TempDirPath[Counter] = '\') THEN
BEGIN
IF (TempDirPath[Counter - 1] <> ':') THEN
BEGIN
IF (NOT ExistDir(Copy(TempDirPath,1,(Counter - 1)))) THEN
BEGIN
MkDir(Copy(TempDirPath,1,(Counter - 1)));
LastError := IOResult;
IF (LastError <> 0) THEN
BEGIN
NL;
Print('Error creating directory: '+Copy(TempDirPath,1,(Counter - 1)));
SysOpLog('^7Error creating directory: '+Copy(TempDirPath,1,(Counter - 1)));
TempDirPath := '';
END;
END;
END;
END;
Inc(Counter);
END;
END;
END;
END;
END;
END;
UNTIL (TempDirPath <> '') OR (AllowExit) OR (HangUp);
IF (TempDirPath <> '') THEN
TempDirPath := BSlash(TempDirPath,TRUE);
IF (TempDirPath <> DirPath) THEN
Changed := TRUE;
DirPath := TempDirPath;
END;
FUNCTION OnNode(UserNumber: Integer): Byte;
VAR
NodeNumber: Byte;
BEGIN
OnNode := 0;
IF (General.MultiNode) AND (UserNumber > 0) THEN
FOR NodeNumber := 1 TO MaxNodes DO
BEGIN
LoadNode(NodeNumber);
IF (NodeR.User = UserNumber) THEN
BEGIN
OnNode := NodeNumber;
Exit;
END;
END;
END;
PROCEDURE PurgeDir(s: AStr; SubDirs: Boolean);
VAR
(*
DirInfo1: SearchRec;
*)
odir: STRING[80];
BEGIN
s := FExpand(s);
WHILE (s[Length(s)] = '\') DO
Dec(s[0]);
GetDir(ExtractDriveNumber(s),odir);
ChDir(s);
IF (IOResult <> 0) THEN
BEGIN
ChDir(odir);
Exit;
END;
FindFirst('*.*',AnyFile - Directory - VolumeID,DirInfo); (* Directory & VolumnID added *)
WHILE (DOSError = 0) DO
BEGIN
Kill(FExpand(DirInfo.Name));
FindNext(DirInfo);
END;
ChDir(odir);
IF (SubDirs) THEN
RmDir(s);
LastError := IOResult;
ChDir(StartDir);
END;
FUNCTION StripName(InString: STRING): STRING;
VAR
StrLen: Byte;
BEGIN
StrLen := Length(InString);
WHILE (StrLen > 0) AND (Pos(InString[StrLen],':\/') = 0) DO
Dec(StrLen);
Delete(InString,1,StrLen);
StripName := InString;
END;
PROCEDURE Star(InString: AStr);
BEGIN
IF (OkANSI OR OkAvatar) THEN
Prompt('^4<> ')
ELSE
Prompt('* ');
IF (InString[Length(InString)] = #29) THEN
Dec(InString[0])
ELSE
InString := InString + ^M^J;
Prompt('^3'+InString+'^1');
END;
FUNCTION ctp(t,b: LongInt): STRING;
VAR
s: AStr;
n: LongInt;
BEGIN
IF ((t = 0) OR (b = 0)) THEN
n := 0
ELSE
n := (t * 100) DIV b;
Str(n:6,s);
ctp := s;
END;
FUNCTION CInKey: Char;
BEGIN
IF (NOT LocalIOOnly) AND (NOT Com_IsRecv_Empty) THEN
CInKey := Com_Recv
ELSE
CInKey := #0;
END;
PROCEDURE Com_Send_Str(CONST InString: AStr);
VAR
Counter: Byte;
BEGIN
FOR Counter := 1 TO Length(InString) DO
CASE InString[Counter] OF
'~' : Delay(250);
'|' : BEGIN
Com_Send(^M);
IF (InWFCMenu) THEN
WriteWFC(^M);
END;
'^' : BEGIN
DTR(FALSE);
Delay(250);
DTR(TRUE);
END;
ELSE
BEGIN
Com_Send(InString[Counter]);
Delay(2);
IF (InWFCMenu) THEN
WriteWFC(InString[Counter]);
END;
END;
END;
PROCEDURE DoTelnetHangUp(ShowIt: Boolean);
BEGIN
IF (NOT LocalIOOnly) THEN
BEGIN
IF (ShowIt) AND (NOT BlankMenuNow) THEN
BEGIN
TextColor(15);
TextBackGround(1);
GotoXY(32,17);
Prt('Hanging up node..');
END;
Com_Flush_Recv;
DTR(FALSE);
END;
IF (ShowIt) AND (SysOpOn) AND (NOT BlankMenuNow) THEN
BEGIN
TextColor(15);
TextBackGround(1);
GotoXY(1,17);
ClrEOL;
END;
END;
PROCEDURE dophoneHangup(ShowIt: Boolean);
VAR
c: Char;
Try: Integer;
SaveTimer: LongInt;
BEGIN
IF (NOT LocalIOOnly) THEN
BEGIN
IF (ShowIt) AND (NOT BlankMenuNow) THEN
BEGIN
TextColor(15);
TextBackGround(1);
GotoXY(32,17);
Write('Hanging up phone...');
END;
Try := 0;
WHILE (Try < 3) AND (NOT KeyPressed) DO
BEGIN
Com_Flush_Recv;
Com_Send_Str(Liner.HangUp);
SaveTimer := Timer;
WHILE (ABS(Timer - SaveTimer) <= 2) AND (Com_Carrier) DO
BEGIN
c := CInKey;
IF (c > #0) AND (InWFCMenu) THEN
WriteWFC(c);
END;
Inc(Try);
END;
END;
IF (ShowIt) AND (SysOpOn) AND (NOT BlankMenuNow) THEN
BEGIN
TextColor(15);
TextBackGround(1);
GotoXY(1,17);
ClrEOL;
END;
END;
PROCEDURE DoPhoneOffHook(ShowIt: Boolean);
VAR
TempStr: AStr;
c: Char;
Done: Boolean;
SaveTimer: LongInt;
BEGIN
IF (ShowIt) AND (NOT BlankMenuNow) AND (SysOpOn) THEN
BEGIN
TextColor(15);
TextBackGround(1);
GotoXY(33,17);
Write('Phone off hook');
END;
Com_Flush_Recv;
Com_Send_Str(Liner.OffHook);
SaveTimer := Timer;
REPEAT
c := CInKey;
IF (c > #0) THEN
BEGIN
IF (InWFCMenu) THEN
WriteWFC(c);
IF (Length(TempStr) >= 160) THEN
Delete(TempStr,1,120);
TempStr := TempStr + c;
IF (Pos(Liner.OK,TempStr) > 0) THEN
Done := TRUE;
END;
UNTIL (ABS(Timer - SaveTimer) > 2) OR (Done) OR (KeyPressed);
Com_Flush_Recv;
END;
PROCEDURE PauseScr(IsCont: Boolean);
VAR
Cmd: Char;
SaveCurCo,
Counter: Byte;
SaveMCIAllowed: Boolean;
BEGIN
SaveCurCo := CurrentColor;
SaveMCIAllowed := MCIAllowed;
MCIAllowed := TRUE;
{$IFDEF MSDOS}
NoSound;
{$ENDIF}
IF (NOT AllowContinue) AND NOT (PrintingFile AND AllowAbort) THEN
IsCont := FALSE;
IF (IsCont) THEN
{ Prompt(FString.Continue) }
lRGLngStr(44,FALSE)
ELSE
BEGIN
IF NOT (PauseIsNull) THEN
{ Prompt({FString.lPause); }
lRGLngStr(5,FALSE);
END;
LIL := 1;
IF (IsCont) THEN
BEGIN
REPEAT
Cmd := UpCase(Char(GetKey));
CASE Cmd OF
'C' : IF (IsCont) THEN
TempPause := FALSE;
'N' : Abort := TRUE;
END;
UNTIL (Cmd IN ['Y','N','Q','C',^M]) OR (HangUp);
END
ELSE
Cmd := Char(GetKey);
IF (IsCont) THEN
FOR Counter := 1 TO LennMCI(lRGLngStr(44,TRUE){FString.Continue}) DO
BackSpace
ELSE
FOR Counter := 1 TO LennMCI(lRGLNGStr(5,TRUE){FString.lPause}) DO
BackSpace;
IF (Abort) THEN
NL;
IF (NOT HangUp) THEN
SetC(SaveCurCo);
MCIAllowed := SaveMCIAllowed;
END;
FUNCTION SearchUser(Uname: Str36; RealNameOK: Boolean): Integer;
VAR
UserIDX: UserIDXRec;
Current: Integer;
Done: Boolean;
BEGIN
SearchUser := 0;
Reset(UserIDXFile);
IF (IOResult <> 0) THEN
BEGIN
SysOpLog('Error opening USERS.IDX.');
Exit;
END;
WHILE (Uname[Length(Uname)] = ' ') DO
Dec(Uname[0]);
Uname := AllCaps(Uname);
Current := 0;
Done := FALSE;
IF (FileSize(UserIDXFile) > 0) THEN
REPEAT
Seek(UserIDXFile,Current);
Read(UserIDXFile,UserIDX);
IF (Uname < UserIDX.Name) THEN
Current := UserIDX.Left
ELSE IF (Uname > UserIDX.Name) THEN
Current := UserIDX.Right
ELSE
Done := TRUE;
UNTIL (Current = -1) OR (Done);
Close(UserIDXFile);
IF (Done) AND (RealNameOK OR NOT UserIDX.RealName) AND (NOT UserIDX.Deleted) THEN
SearchUser := UserIDX.Number;
LastError := IOResult;
END;
FUNCTION Plural(InString: STRING; Number: Byte): STRING;
BEGIN
IF (Number <> 1) THEN
Plural := InString + 's'
ELSE
Plural := InString;
END;
FUNCTION FormattedTime(TimeUsed: LongInt): STRING;
VAR
s: AStr;
BEGIN
s := '';
IF (TimeUsed > 3600) THEN
BEGIN
s := IntToStr(TimeUsed DIV 3600)+' '+Plural('Hour',TimeUsed DIV 3600) + ' ';
TimeUsed := (TimeUsed MOD 3600);
END;
IF (TimeUsed > 60) THEN
BEGIN
s := s + IntToStr(TimeUsed DIV 60)+' '+Plural('Minute',TimeUsed DIV 60) + ' ';
TimeUsed := (TimeUsed MOD 60);
END;
IF (TimeUsed > 0) THEN
s := s + IntToStr(TimeUsed)+' '+Plural('Second',TimeUsed);
IF (s = '') THEN
s := 'no time';
WHILE (s[Length(s)] = ' ') DO
Dec(s[0]);
FormattedTime := s;
END;
FUNCTION FunctionalMCI(CONST S: AStr; FileName,InternalFileName: AStr): STRING;
VAR
Temp: STRING;
Add: AStr;
Index: Byte;
BEGIN
Temp := '';
FOR Index := 1 TO Length(S) DO
IF (S[Index] = '%') THEN
BEGIN
CASE UpCase(S[Index + 1]) OF
'A' : Add := AOnOff(LocalIOOnly,'0',IntToStr(ActualSpeed));
'B' : Add := IntToStr(ComPortSpeed);
'C' : Add := Liner.Address;
'D' : Add := FunctionalMCI(Protocol.DLFList,'','');
'E' : Add := Liner.IRQ;
'F' : Add := SQOutSp(FileName);
'G' : Add := AOnOff((OkAvatar OR OkANSI),'1','0');
'H' : Add := SockHandle;
'I' : BEGIN
IF (S[Index + 2] = 'P') THEN
BEGIN
Add := ThisUser.CallerID;
Inc(Index,1);
END
ELSE
BEGIN
Add := InternalFileName;
END;
END;
'K' : BEGIN
LoadFileArea(FileArea);
IF (FADirDLPath IN MemFileArea.FAFlags) THEN
Add := MemFileArea.DLPath+MemFileArea.FileName+'.DIR'
ELSE
Add := General.DataPath+MemFileArea.FileName+'.DIR';
END;
'L' : Add := FunctionalMCI(Protocol.TempLog,'','');
'M' : Add := StartDir;
'N' : Add := IntToStr(ThisNode);
'O' : Add := Liner.DoorPath;
'P' : Add := IntToStr(Liner.ComPort);
'R' : Add := ThisUser.RealName;
'T' : Add := IntToStr(NSL DIV 60);
'U' : Add := ThisUser.Name;
'#' : Add := IntToStr(UserNum);
'1' : Add := Copy(Caps(ThisUser.RealName),1,Pos(' ',ThisUser.RealName) - 1);
'2' : IF (Pos(' ', ThisUser.RealName) = 0) THEN
Add := Caps(ThisUser.RealName)
ELSE
Add := Copy(Caps(ThisUser.RealName),Pos(' ',ThisUser.RealName) + 1,255);
ELSE
Add := '%' + S[Index + 1];
END;
Temp := Temp + Add;
Inc(Index);
END
ELSE
Temp := Temp + S[Index];
FunctionalMCI := Temp;
END;
FUNCTION MCI(CONST S: STRING): STRING;
VAR
Temp: STRING;
Add: AStr;
Index: Byte;
I: Integer;
BEGIN
Temp := '';
FOR Index := 1 TO Length(S) DO
IF (S[Index] = '%') AND (Index + 1 < Length(S)) THEN
BEGIN
Add := '%' + S[Index + 1] + S[Index + 2];
WITH ThisUser DO
CASE UpCase(S[Index + 1]) OF
'A' : CASE UpCase(S[Index + 2]) OF
'1' : Add := IntToStr(LowFileArea);
'2' : Add := IntToStr(HighFileArea);
'3' : Add := IntToStr(LowMsgArea);
'4' : Add := IntToStr(HighMsgArea);
'B' : Add := FormatNumber(lCredit - Debit);
'C' : Add := Copy(Ph,1,3);
'D' : Add := Street;
'O' : BEGIN
IF (PrintingFile) OR (Reading_A_Msg) THEN
AllowAbort := FALSE;
Add := '';
END;
END;
'B' : CASE UpCase(S[Index + 2]) OF
'D' : Add := IntToStr(ActualSpeed);
'L' : Add := PHours('Always allowed',General.MinBaudLowTime,General.MinBaudHiTime);
'M' : Add := PHours('Always allowed',General.MinBaudDLLowTime,General.MinBaudDLHiTime);
'N' : Add := General.BBSName;
'P' : Add := General.BBSPhone;
END;
'C' : CASE UpCase(S[Index + 2]) OF
'A' : Add := FormatNumber(General.CallAllow[SL]);
'D' : Add := AOnOff(General.PerCall,'call','day ');
'L' : Add := ^L;
'M' : Add := IntToStr(Msg_On);
'N' : IF FindConference(CurrentConf,Conference) THEN
Add := Conference.Name
ELSE
Add:= '';
'R' : Add := FormatNumber(lCredit);
'S' : Add := PHours('Always allowed',General.lLowTime,General.HiTime);
'T' : Add := CurrentConf;
'+' : BEGIN
Add := '';
CursorOn(TRUE);
END;
'-' : BEGIN
Add := '';
CursorOn(FALSE);
END;
END;
'D' : CASE UpCase(S[Index + 2]) OF
'1'..'3' :
Add := UsrDefStr[Ord(S[Index + 2]) - 48];
'A' : Add := DateStr;
'B' : Add := FormatNumber(Debit);
'D' : Add := FormatNumber(General.DlOneDay[SL]);
'H' : Add := PHours('Always allowed',General.DLLowTime,General.DLHiTime);
'K' : Add := FormatNumber(DK);
'L' : Add := FormatNumber(Downloads);
'S' : Add := IntToStr(DSL);
'T' : BEGIN
IF (Timer > 64800) THEN
Add := 'evening'
ELSE IF (Timer > 43200) THEN
Add := 'afternoon'
ELSE
Add := 'morning'
END;
END;
'E' : CASE UpCase(S[Index + 2]) OF
'D' : Add := AOnOff((Expiration = 0),'Never',ToDate8(PD2Date(Expiration)));
'S' : Add := FormatNumber(EmailSent);
'T' : Add := IntToStr(General.EventWarningTime);
'W' : Add := FormatNumber(Waiting);
'X' : IF (Expiration > 0) THEN
Add := IntToStr((Expiration DIV 86400) - (GetPackDateTime DIV 86400))
ELSE
Add := 'Never';
END;
'F' : CASE UpCase(S[Index + 2]) OF
'#' : Add := IntToStr(CompFileArea(FileArea,0));
'B' : BEGIN
LoadFileArea(FileArea);
Add := MemFileArea.AreaName;
END;
'D' : Add := ToDate8(PD2Date(FirstOn));
'K' : Add := FormatNumber(DiskFree(ExtractDriveNumber(MemFileArea.ULPath)) DIV 1024);
'N' : Add := Copy(RealName,1,(Pos(' ', RealName) - 1));
'P' : Add := FormatNumber(FilePoints);
'S' : Add := AOnOff(NewScanFileArea,'','not ');
'T' : Add := IntToStr(NumFileAreas);
END;
'G' : CASE UpCase(S[Index + 2]) OF
'N' : AOnOff((Sex = 'M'),'Mr.','Ms.');
END;
'H' : CASE UpCase(S[Index + 2]) OF
'1' : Add := CTim(General.lLowTime); (* Verify All CTim *)
'2' : Add := CTim(General.HiTime);
'3' : Add := CTim(General.MinBaudLowTime);
'4' : Add := CTim(General.MinBaudHiTime);
'5' : Add := CTim(General.DLLowTime);
'6' : Add := CTim(General.DLHiTime);
'7' : Add := CTim(General.MinBaudDLLowTime);
'8' : add := CTim(General.MinBaudDLHiTime);
'M' : Add := IntToStr(HiMsg);
END;
'I' : CASE UpCase(S[Index + 2]) OF
'L' : Add := IntToStr(Illegal);
'P' : Add := ThisUser.CallerID;
END;
'K' : CASE UpCase(S[Index + 2]) OF
'D' : Add := FormatNumber(General.DLKOneday[SL]);
'R' : IF (DK > 0) THEN
Str((UK / DK):3:3,Add)
ELSE
Add := '0';
END;
'L' : CASE UpCase(S[Index + 2]) OF
'C' : Add := ToDate8(PD2Date(LastOn));
'F' : Add := ^M^J;
'N' : BEGIN
I := Length(RealName);
WHILE ((RealName[i] <> ' ') AND (i > 1)) DO
Dec(i);
Add := Copy(Caps(RealName),(i + 1),255);
END;
'O' : Add := CityState;
END;
'M' : CASE UpCase(S[Index + 2]) OF
'#' : Add := IntToStr(CompMsgArea(MsgArea,0));
'1' : Add := IntToStr(General.GlobalMenu);
'2' : Add := IntToStr(General.AllStartMenu);
'3' : Add := IntToStr(General.ShuttleLogonMenu);
'4' : Add := IntToStr(General.NewUserInformationMenu);
'5' : Add := IntToStr(General.MessageReadMenu);
'6' : Add := IntToStr(General.FileListingMenu);
'7' : Add := IntToStr(General.MinimumBaud);
'B' : BEGIN
i := ReadMsgArea;
IF (i <> MsgArea) THEN
LoadMsgArea(MsgArea);
Add := MemMsgArea.Name;
END;
'L' : Add := IntToStr(NSL DIV 60);
'N' : Add := ShowOnOff(General.MultiNode);
'O' : Add := IntToStr((GetPackDateTime - TimeOn) DIV 60);
'R' : Add := IntToStr(HiMsg - Msg_On);
'S' : Add := AOnOff(LastReadRecord.NewScan,'','not ');
'T' : Add := IntToStr(NumMsgAreas);
END;
'N' : CASE UpCase(S[Index + 2]) OF
'D' : Add := IntToStr(ThisNode);
'L' : Add := '';
'M' : Add := ShowOnOff(General.NetworkMode);
'R' : IF (Downloads > 0) THEN
Str((Uploads / Downloads):3:3,Add)
ELSE
Add := '0';
END;
'O' : CASE UpCase(S[Index + 2]) OF
'1' : IF (RIP IN SFlags) THEN
Add := 'RIP'
ELSE IF (Avatar IN Flags) THEN
Add := 'Avatar'
ELSE IF (ANSI IN Flags) THEN
Add := 'ANSI'
ELSE IF (VT100 IN Flags) THEN
Add := 'VT-100'
ELSE
Add := 'None';
'2' : Add := IntToStr(LineLen)+'x'+IntToStr(PageLen);
'3' : Add := ShowOnOff(ClsMsg IN SFlags);
'4' : Add := ShowOnOff(FSEditor IN SFlags);
'5' : Add := ShowOnOff(Pause IN Flags);
'6' : Add := ShowOnOff(HotKey IN Flags);
'7' : Add := ShowOnOff(NOT (Novice IN Flags));
'8' : IF (ForUsr > 0) THEN
Add := 'Forwarded - '+IntToStr(ForUsr)
ELSE IF (Nomail IN Flags) THEN
Add := 'Closed'
ELSE
Add := 'Open';
'9' : Add := ShowOnOff(Color IN Flags);
'S' : BEGIN
CASE Tasker OF
None : Add := 'DOS';
DV : Add := 'DV';
Win : Add := 'Windows';
OS2 : Add := 'OS/2';
Win32 : Add := 'Windows 32bit';
Dos5N : Add := 'DOS/N';
END;
END;
END;
'P' : CASE UpCase(S[Index + 2]) OF
'1' : Add := General.MsgPath;
'2' : Add := General.NodePath;
'3' : Add := General.LMultPath;
'4' : Add := General.SysOpPW;
'5' : Add := General.NewUserPW;
'6' : Add := General.MinBaudOverride;
'7' : Add := General.ArcsPath;
'B' : Add := General.BulletPrefix;
'C' : IF (LoggedOn > 0) THEN
Str((MsgPost / LoggedOn) * 100:3:2,Add)
ELSE
Add := '0';
'D' : Add := General.DataPath;
'F' : Add := General.FileAttachPath;
'L' : Add := General.LogsPath;
'M' : Add := General.MiscPath;
'N' : Add := Ph;
'O' : BEGIN
IF (PrintingFile) OR (Reading_A_Msg) THEN
TempPause := FALSE;
Add := '';
END;
'P' : Add := General.ProtPath;
'S' : Add := FormatNumber(MsgPost);
'T' : Add := General.TempPath;
END;
'Q' : CASE UpCase(S[Index + 2]) OF
'D' : Add := IntToStr(NumBatchDLFiles);
'U' : Add := IntToStr(NumBatchULFiles);
END;
'R' : CASE UpCase(S[Index + 2]) OF
'N' : Add := Caps(RealName);
END;
'S' : CASE UpCase(S[Index + 2]) OF
'1' : Add := lRGLngStr(41,TRUE); {FString.UserDefEd[Ord(S[Index + 2]) - 48]; }
'2' : Add := lRGLngStr(42,TRUE); {FString.UserDefEd[Ord(S[Index + 2]) - 48]; }
'3' : Add := lRGLngStr(43,TRUE); {FString.UserDefEd[Ord(S[Index + 2]) - 48]; }
'A' : Add := AOnOff((SysOpAvailable), 'available','unavailable' );
'C' : Add := FormatNumber(General.CallerNum);
'D' : Add := IntToStr(General.TotalDloads);
'L' : Add := IntToStr(SL);
'M' : Add := IntToStr(General.TotalUsage);
'N' : Add := General.SysopName;
'P' : Add := IntToStr(General.TotalPosts);
'U' : Add := IntToStr(General.TotalUloads);
'X' : Add := AOnOff((Sex = 'M'),'Male','Female');
END;
'T' : CASE UpCase(S[Index + 2]) OF
'1' : Add := FormatNumber(General.TimeAllow[SL]);
'A' : Add := FormatNumber(TimeBankAdd);
'B' : Add := FormatNumber(TimeBank);
'C' : Add := FormatNumber(LoggedOn);
'D' : Add := FormatNumber(DLToday);
'G' : Add := GetTagLine;
'I' : Add := TimeStr;
'K' : Add := ConvertBytes(DLKToday * 1024,FALSE);
'L' : Add := CTim(NSL);
'N' : Add := Liner.NodeTelnetURL;
'O' : Add := IntToStr(General.TimeAllow[SL] - TLToday);
'S' : BEGIN
Assign(HistoryFile, General.DataPath+'HISTORY.DAT');
{$I-} Reset(HistoryFile); {$I+}
IF (IOResult <> 0) THEN
BEGIN
Add := 'Error With HISTORY.DAT, Inform ' + General.SysOpName + '!';
END
ELSE
BEGIN
Seek(HistoryFile, (FileSize(HistoryFile)-1));
Read(HistoryFile, HistoryRec);
Add := IntToStr(HistoryRec.Callers);
Close(HistoryFile);
END;
END;
'T' : Add := FormatNumber(TTimeOn);
'U' : Add := IntToStr(General.NumUsers);
END;
'U' : CASE UpCase(S[Index + 2]) OF
'A' : Add := IntToStr(AgeUser(BirthDate));
'B' : Add := ToDate8(PD2Date(BirthDate));
'C' : Add := IntToStr(OnToday);
'F' : Add := FormatNumber(Feedback);
'K' : Add := FormatNumber(UK);
'L' : Add := FormatNumber(Uploads);
'M' : Add := IntToStr(MaxUsers - 1);
'N' : Add := Caps(Name);
'U' : Add := IntToStr(UserNum);
END;
'V' : CASE UpCase(S[Index + 2]) OF
'R' : Add := General.Version;
END;
'Z' : CASE UpCase(S[Index + 2]) OF
'P' : Add := ZipCode;
END;
END;
Temp := Temp + Add;
Inc(Index,2);
END
ELSE
Temp := Temp + S[Index];
MCI := Temp;
END;
PROCEDURE BackErase(Len: Byte);
VAR
Counter: Byte;
BEGIN
IF (OkANSI) OR (OkVT100) THEN
SerialOut(^[+'['+IntToStr(Len)+'D'+^[+'[K')
ELSE IF (OkAvatar) THEN
BEGIN
FOR Counter := 1 TO Len DO
Com_Send(^H);
SerialOut(^V^G);
END
ELSE
FOR Counter := 1 TO Len DO
BEGIN
Com_Send(^H);
Com_Send(' ');
Com_Send(^H);
END;
GotoXY((WhereX - Len),WhereY);
ClrEOL;
END;
FUNCTION DiskKBFree(DrivePath: AStr): LongInt;
VAR
F: TEXT;
{$IFDEF MSDOS}
Regs: Registers;
{$ENDIF}
S,
S1: STRING;
Counter: Integer;
C,
C1,
C2: Comp;
BEGIN
C2 := 0.0; (* RGCMD *)
SwapVectors;
Exec(GetEnv('RGCMD'),' /C DIR '+DrivePath[1]+': > FREE.TXT');
SwapVectors;
IF (EXIST('FREE.TXT')) THEN
BEGIN
Assign(F,'FREE.TXT');
Reset(F);
WHILE NOT EOF(F) DO
BEGIN
ReadLn(F,S);
IF (Pos('bytes free',s) <> 0) THEN
BEGIN
WHILE (S[1] = ' ') DO
Delete(S,1,1);
Delete(S,1,Pos(')',s));
WHILE (S[1] = ' ') DO
Delete(S,1,1);
S := COPY(S,1,Pos(' ',S) - 1);
S1 := '';
FOR Counter := 1 TO Length(S) DO
IF (S[Counter] <> ',') THEN
S1 := S1 + S[Counter];
END;
END;
Close(F);
Erase(F);
Val(S1,C2,Counter);
END
ELSE
BEGIN
{$IFDEF MSDOS}
FillChar(Regs,SizeOf(Regs),#0);
Regs.Ah := $36;
Regs.Dl := ExtractDriveNumber(DrivePath);
Intr($21,Regs);
C := (1.0 * Regs.Ax);
C1 := ((1.0 * Regs.Cx) * C);
C2 := ((1.0 * Regs.Bx) * C1);
{$ENDIF}
{$IFDEF WIN32}
C2 := DiskFree(ExtractDriveNumber(DrivePath));
{$ENDIF}
END;
DiskKBFree := Round(C2 / 1024.0);
END;
FUNCTION IntToStr(L: LongInt): STRING;
VAR
S: STRING[11];
BEGIN
Str(L,S);
IntToStr := S;
END;
PROCEDURE MyDelay(WaitFor: LongInt);
VAR
CheckMS: LongInt;
BEGIN
CheckMS := (Ticks + WaitFor);
REPEAT
UNTIL (Ticks > CheckMS);
END;
END.