{$IFDEF WIN32}
{$P+,S-,W-,R-,I-}
{$ELSE}
{$F+,I-,V+,B-,X+,T-,P-,N-,E+,A+,R-,S+,Q-}
{$ENDIF}

Unit
  tGlob;

{*********************************************************}
{*                      TGLOB.PAS                        *}
{*                                                       *}
{*  Copyright (c) Konstantin Klyagin, 1998,              *}
{*                exspecially for Tornado BBS System     *}
{*                                                       *}
{*********************************************************}

Interface

Uses
{$IFDEF OS2}
  Os2Base,
  Os2Def,
  Os2PmApi,
  VPutils,
  Strings,
{$ENDIF}
{$IFDEF MSDOS}
  Streams,
{$ENDIF}
{$IFNDEF WIN32}
  DOS,
  OpInline,
{$IFNDEF NOT_TOR}
  ApSame,
  ApTimer,
  ApAbsPcl,
{$ENDIF}
{$ELSE}

{$IFNDEF NOT_TOR}
  Console,
  TB97,
  AppExec,
  AdModem,
{$ENDIF}

  OpCrt,
  Classes,
  ooMisc,
  SysUtils,
  Windows,
  AdProtcl,
  AdPort,
  Messages,
  StdCtrls,
  Forms,
  Dialogs,
{$ENDIF}

  tMisc,
  Objects,
  TimeTask;

{$I INC\misc.inc}
{$IFNDEF NOT_TOR}
{$I INC\users.inc}

Const
  MTaskerz: Array  [0..10]  Of  String [13] =
  ('MS DOS', 'MS Windows', 'IBM OS/2', 'DESQview', 'TopView',
   'PC-MOS/386', 'Linux DOSEMU', 'IBM OS/2 Warp', 'Windows''95',
   'European MS-DOS', 'DoubleDOS');

  ULorDL : Array [TransferModeType] Of String [8] = ('DownLoad', 'UpLoad');
  uNum : LongInt = 0;

  kbUp    = #1;
  kbDown  = #2;
  kbRight = #3;
  kbLeft  = #4;
  kbDel   = #127;
  kbHome  = #5;
  kbEnd   = #6;

  trcSysMsgPrefix = #11;

  Open_Access_ReadOnly  = 0;
  Open_Access_ReadWrite = 2;

  Xmodem      = 0;
  XmodemCRC   = 1;
  Xmodem1K    = 2;
  Xmodem1KG   = 3;
  Ymodem      = 4;
  YmodemG     = 5;
  Zmodem      = 6;
  Zmodem8K    = 7;

  {-Options}
  ofSpaceAdd    = $01;
  ofAllowEmpty  = $02;
  ofFramed      = $04;
  ofHistory     = $08;
  ofNoCR        = $12;

  {-emu Options}
  eoMacro       = $01;
  eoSlashCode   = $02;
  eoColorCode   = $04;
  eoDisable01   = $08;
  eoCodes       = eoSlashCode + eoColorCode;

  {Convenient protocol string constants}
  ProtocolTypeString : Array [XModem..ZModem8K] Of String [10] = (
  'Xmodem', 'XmodemCRC', 'Xmodem1K', 'Xmodem1KG',
  'Ymodem', 'YmodemG', 'Zmodem', 'Zmodem8K');

{$IFDEF WIN32}
  ProtTypeStr : Array [ptNoProtocol..ptZModem8K] Of String [9] =
                ('None', 'XModem', 'XModemCRC', 'XModem1K', 'XModem1KG',
                 'YModem', 'YModemG', 'ZModem', 'ZModem8K');
  ProtN2T     : Array ['1'..'8'] Of TProtocolType =
                (ptXmodem, ptXmodemCRC, ptXmodem1K, ptXmodem1KG, ptYmodem,
                 ptYmodemG, ptZmodem, ptZmodem8K);

  TotalBytesTrans : LongInt = 0;
  AfterCommand : String = '';

{$ENDIF}
  mCommand : String = '';
  LocalOffHook : Boolean = False;
  AllChars     : Set Of Char = [' '..#255];
  LettersOnly  : Set Of Char =
    ['A'..'Z', 'a'..'z', 'А'..'п', 'р'..'я',
     ' ', '.', ',', '*', '_', '-', '''',
     #240, #241, #247];

  NumbersOnly  : Set Of Char = ['0'..'9'];
  InputAccept  : Set Of Char = [];

  ManualChat   : Boolean = False;

{$I INC\menus.inc}

{$ENDIF}

{$IFNDEF NOT_TOR}
{$I INC\ver.inc}
{$ELSE}
{$I ver.inc}
{$ENDIF}

Type
  tFlagType = (ftUserBase, ftSystem, ftLines, ftConference, ftConfList);
  tArr255 = Array [0..255] Of Char;

  PXLATrec = ^TXLATrec;
  TXLATrec = Record
    FileName : PathStr;
    Name : String [100];
    Table : tArr255;
  End;

  PBigCollection = ^TBigCollection;

{$IFDEF MSDOS}
  TBigCollection = Object (TCollection)
    Usual: Boolean;
    DataStream: PStream;
    Constructor Init (AMax, AStep: Integer);
    Procedure InsLine (S: String);
    Procedure AtPutLine (Index: Integer; S: String);
    Procedure AtInsLine (Index: Integer; S: String);
    Procedure AtRemove (Index: Integer);
    Procedure FreeItem (Item: Pointer); Virtual;
    Procedure Insert (Item: Pointer); Virtual;
    Procedure AtPut (Index: Integer; Item: Pointer); Virtual;
    Procedure AtInsert (Index: Integer; Item: Pointer); Virtual;
    Function At (Index: Integer): Pointer;
    Destructor Done; Virtual;
  End;
{$ELSE}
  TBigCollection = Object (TCollection)
    Procedure InsLine (S: String);
    Procedure AtInsLine (Index: Integer; S: String);
    Procedure AtRemove (Index: Integer);
    Procedure AtPutLine (Index: Integer; S: String);
    Function At (Index: Integer): Pointer;
    Procedure FreeItem (Item: Pointer); Virtual;
    Procedure Insert (Item: Pointer); Virtual;
    Procedure AtPut (Index: Integer; Item: Pointer); Virtual;
    Procedure AtInsert (Index: Integer; Item: Pointer); Virtual;
  End;
{$ENDIF}

{$IFNDEF WIN32}

  PNotSortedCollection = ^TNotSortedCollection;
  TNotSortedCollection = Object (TStringCollection)
    Function Compare (Key1, Key2: Pointer):
    {$IFNDEF OS2} Integer; {$ELSE} LongInt; {$ENDIF} Virtual;
    Procedure AtPut (Index: Integer; Item: Pointer); Virtual;
    Function Contains (S: String): Boolean;
    Destructor Done; Virtual;
    Procedure FreeAll; Virtual;
    Procedure DeleteAll; Virtual;
  End;

{$IFNDEF NOT_TOR}

  pFileItemCollection = ^tFileItemCollection;
  tFileItemCollection = Object (TSortedCollection)
    Function Compare (Key1, Key2: Pointer):
    {$IFNDEF OS2} Integer; {$ELSE} LongInt; {$ENDIF} Virtual;
    Procedure AtPut (Index: Integer; Item: Pointer); Virtual;
    Destructor Done; Virtual;
  End;

  PTagFilesCollection = ^TTagFilesCollection;
  TTagFilesCollection = Object (TSortedCollection)
    Function Compare (Key1, Key2: Pointer):
    {$IFNDEF OS2} Integer; {$ELSE} LongInt; {$ENDIF} Virtual;
    Procedure AtPut (Index: Integer; Item: Pointer); Virtual;
    Procedure DeleteAll;
  End;

  PMenuItemsCollection = ^TMenuItemsCollection;
  TMenuItemsCollection = Object (TNotSortedCollection)
    Procedure DeleteAll; {$IFNDEF WIN32} Virtual {$ENDIF};
  End;

{$ENDIF}

{$ELSE}

  PNotSortedCollection = ^TNotSortedCollection;
  TNotSortedCollection = Object (TWNotSortedCollection)
    Function Contains (S: String): Boolean;
    Destructor Done; Virtual;
    Procedure FreeAll; Virtual;
    Procedure DeleteAll; Virtual;
  End;

{$IFNDEF NOT_TOR}

  pFileItemCollection = ^tFileItemCollection;
  tFileItemCollection = Object (TNotSortedCollection)
    Destructor Done; Virtual;
  End;

  PTagFilesCollection = ^TTagFilesCollection;
  TTagFilesCollection = Object (TSortedCollection)
    Function Compare (Key1, Key2: Pointer): Integer; Virtual;
  End;

  PMenuItemsCollection = ^TMenuItemsCollection;
  TMenuItemsCollection = Object (TNotSortedCollection)
    Procedure DeleteAll; Virtual;
  End;

{$ENDIF}

{$ENDIF}

{$IFNDEF NOT_TOR}
Const
  ComRead       : Procedure (Var S: String; Max: Integer; Options: Byte) = nil;
  ComReadLn     : Procedure (Var S: String; Max: Integer; Options: Byte) = nil;
  ComMenu       : Function (Header, ChoiceStr: String; Items: PNotSortedCollection): String = nil;
  SetProtocol   : Procedure (C: Char) = nil;
  GetAnswer     : Function (Quest: String; Len, Options: Byte; Default: String): String = nil;
  Query         : Function (What: String; IsYes: Boolean; Flags: Byte): Boolean = nil;
  Query_YNQ     : Function (What: String): Char = nil;
  MenuBar       : Function (Text, Hot: String): Byte = nil;
  SmartLine     : Procedure = nil;
  ComSaveScreen : Procedure = nil;
  ComRestoreScreen : Procedure (WaitForKey: Boolean) = nil;
  ComWrite      : Procedure (Str: String; Options: Byte) = nil;
  ComWriteLn    : Procedure (Str: String; Options: Byte) = nil;
  Message       : Procedure (Mess: String) = nil;
  Cls           : Procedure = nil;
  EmuColor      : Function (Attr: Byte): String = nil;
  EmuGotoXY     : Function (X, Y: Byte): String = nil;
  EmuCursorLeft : Function (X: Byte): String = nil;
  EmuCursorRight: Function (X: Byte): String = nil;
  EmuCursorUp   : Function (X: Byte): String = nil;
  EmuCursorDown : Function (X: Byte): String = nil;
  EmuCls        : Function: String = nil;
  EmuClrEoL     : Function: String = nil;
  EmuDispFile   : Function (F: String): Boolean = nil;
  mL_Init       : Function (LineNo: Byte): Boolean = nil;
  mL_MsgWaiting : Function: Boolean = nil;
  mL_GetMsg     : Function (Var Msg: tMsg; MsgType: tMsgType): Boolean = nil;
  mL_GetUserName: Function (LineNo: Byte): String = nil;
  mL_GetMesgStat: Function (LineNo: Byte): Boolean = nil;
  mL_SendMsg    : Procedure  (LineNo: Byte; MsgText: String; MsgType: tMsgType) = nil;
  mL_WhoDo      : Procedure (ListMode: tListMode) = nil;
  mL_ChooseLine : Function: Byte = nil;
  mL_RealTimeConference : Procedure = nil;
  mL_DisableMsg : Procedure = nil;
  mL_EnableMsg  : Procedure = nil;
  mL_LineMsg    : Procedure = nil;
  mL_Done       : Procedure = nil;
  NormExit      : Procedure = nil;
  SetSecurity   : Procedure = nil;
  Gluck         : Procedure = nil;
  SuspendTime   : Procedure = nil;
  UnSuspendTime : Procedure = nil;
  GoTelnet      : Procedure (Host: String) = nil;
  GetConnectSpeed : Function: LongInt = nil;
  MsgBaseLetter : Array [btJam..btFido] Of Char = ('J', 'S', 'H', 'F');
  DosShell      : Function (Prg: String; CommandCom, LogErrorLevel: Boolean): Word = nil;
  TranslateExecParams : Function (Param: String): String = nil;
  UserInfo      : Procedure (Name: String) = nil;
  CurrentDebugFile : String = '';
  qwkListChanged: Boolean = False;
  ExecScript    : Function (fName: PathStr): Boolean = nil;
  ExecRexx      : Function (fName: PathStr): Boolean = nil;
  News          : Procedure (Logon: Boolean) = nil;
  DrawAborted   : Function: Boolean = nil;
  UsedMinus     : LongInt = 0;
  InLightBarMenu : Boolean = False;
{$IFDEF WIN32}
  ScrX          : Byte = 79;
  ScrY          : Byte = 24;
{$ENDIF}

Type
  tCoord = Record
    X1, X2, Y1, Y2 : Byte;
  End;

  tBinaryHdr = Record
    Version : String [30];
    ExeName : PathStr;
  End;

  pLongInt = ^LongInt;

Var
  WX, WY, WXG, WYG, WX2, WY2, RegLet            : Byte;
  Flag                                          : Text;
  Cnf                                           : ConfigRecord;
  PhysFileArea,
  PhysMsgArea,
  fAreasGroup,    { File Areas in Group           }
  mAreasGroup,    { Msg Areas in Group            }
  mAreasAmount,   { Msg Areas Total Amount        }
  mmAreasAmount,  { Areas Count (security used)   }
  fAreasAmount,   { File Areas Total Amount       }
  ffAreasAmount,  { Areas Count (security used)   }
  fGroupsAmount,  { File Groups Total Amount      }
  ffGroupsAmount, { Groups Amount (security used) }
  mGroupsAmount,  { Msg Groups Total Amount       }
  mmGroupsAmount  { Groups Count (security used)  } : Word;

  {$IFDEF SOUND}
  {$IFDEF MSDOS}
  UseWav,
  {$ENDIF}
  {$ENDIF}
  Local, NetMailEntered, WantsChat, Probegat,
  InChat, EchoMailEntered, FromKeyBoard,
  StatusBar, InConference, NeedThreadClose,
  StatusBarEnable, TimeCount, InShell, AutoDL,
  Registering, InAction, EnteringPass,
  StopCodeEnable, ThreadLocked, FuncKey         : Boolean;

  P                                             : {$IFNDEF WIN32} PortRecPtr
                                                  {$ELSE} TApdComPort {$ENDIF};
  Prot                                          : {$IFNDEF WIN32} ProtocolRecPtr
                                                  {$ELSE} TApdProtocol {$ENDIF};
  R                                             : tUser;
  ioRez                                         : Integer;
  LC                                            : tLastCaller;
  Sys                                           : SystemType;
  EnterTime, enTime, reqBaud, LastConfKey,
  i, Ent                                        : LongInt;
  EntT                                          : Word;
  Lim                                           : LimitRec;
  trMode                                        : TransferModeType;
  AutoMode, Answer, CtrlCState, Exeption,
  DnsFinished, Manual                           : Boolean;
  oDir, ConfigName, OvrName, TorDir             : PathStr;
  FileArea, tFA                                 : tFileArea;
  MsgArea, tMA                                  : tMsgArea;
  tMG, MsgGroup                                 : tMsgGroup;
  tFG, FileGroup                                : tFileGroup;
  KeyBuffer                                     : String [80];
  WaitReturn                                    : Procedure;
  EMSI                                          : tEMSI;
  ProtocolDef                                   : tProtocolConfig;
  UpFiles, Reps, ReadHistory,
  Language, ParamNames                          : PBigCollection; {strings only!}
  F2Transfer                                    : PTagFilesCollection;
  Menus, Screens, XLATs                         : PNotSortedCollection;
{$IFDEF WIN32}
  LookUpResult                                  : Word;
{$ENDIF}

Const
  InitError      : Boolean = False;
  Suxx           : Boolean = False;
  SaveTitle      : String = '';
  exCommand      : Boolean = True;
  exDirect       : Boolean = False;
  Kill_Line_Flag : Boolean = True;
  RunScript      : PathStr = '';
  RunRexx        : PathStr = '';
  TimeSusp       : Boolean = False;

Function lang (LangItem: LongInt): String;
Function NewFileItem (Const S: tFileItem): PFileItem;
Procedure DisposeFileItem (P: PFileItem);

Function NewPLongInt (i: LongInt): Pointer;
Procedure DisposePLongInt (P: Pointer);

Function NewTagFile (Const S: TTagFileRec): PTagFileRec;
Procedure DisposeTagFile (P: PTagFileRec);

Function NewMenuItem (Const S: tMenuItem): PMenuItem;
Procedure DisposeMenuItem (P: PMenuItem);

Function GetStr (P: PString): String;
Function PhoneValid (S: String): Boolean;

Function keyScrollLock: Boolean;
Function InList (FName: PathStr; Name: String): Boolean;
Function ReadList (FName: PathStr; List: PNotSortedCollection): Boolean;

Function IsToday (LastD, LastT: LongInt): Boolean;

{* Flags manipulating functions *}

Procedure MakeFlag (Name: PathStr);
Function ChkFlag (Name: PathStr): Boolean;
Procedure EraseFlag (Name: PathStr);

Procedure SetFlag (Name: PathStr);
Procedure DelFlag (Name: PathStr);
Function CheckFlag (Name: PathStr): Boolean;
Procedure Wait4Flag (Name: PathStr);
Function LineUsed: Boolean;
Function LineExt: String;
Procedure ClearInputHistory;

Function InFilesBBS (Name: String): Boolean;
Function BinaryHdrValid (Hdr: tBinaryHdr): Boolean;

Procedure SetEmulation;
Procedure SetDebugFile (S: String);
Procedure SetTitle (Title: String);
Function GetTitle: String;
Procedure SetCrtColor;

{$IFDEF OS2}
Function GetFileDateCreation (FN: PathStr): String;
{$ENDIF}

{$IFDEF WIN32}
Procedure ProcessMessages;
Function SaveWindow (XLow, YLow, XHigh, YHigh : Byte; Allocate : Boolean; var Covers : Pointer) : Boolean;
Procedure RestoreWindow (XLow, YLow, XHigh, YHigh : Byte; Deallocate : Boolean; var Covers : Pointer);
{$ENDIF}

{$ENDIF}

Const
{$IFNDEF WIN32}
  RNotSortedCollection: TStreamRec = (
  ObjType: 1002;
  VmtLink: Ofs (TypeOf (TNotSortedCollection)^);
  Load: @TNotSortedCollection. Load;
  Store: @TNotSortedCollection. Store);
{$ENDIF}

{$IFNDEF NOT_TOR}
  RunFlag  = 'tor_run';
  PageFlag = 'tor_ncht';
  MailFlag = 'tor_mail';
  FileFlag = 'tor_file';

  secMisc      = 'Miscellaneous';
  secSyst      = 'System';
  secFileDirs  = 'Files&Dirs';
  secNewUsers  = 'NewUsers';
  secModem     = 'Modem';
  secMsgs      = 'Messages';
  secFAreas    = 'FileAreas';
  secColors    = 'Colors';
  secMain      = 'Main';
  secFiles     = 'Files';
  secLang      = 'Language_Section';
  secMsgArea   = 'MsgArea';
  secMsgGroup  = 'MsgGroup';
  secFileArea  = 'FileArea';
  secFileGroup = 'FileGroup';
  secLimit     = 'Limit';
  secUpgr      = 'Upgrade';
  secQuest     = 'Question';
  secRestrict  = 'Restrictions';
  secExtProt   = 'External';
  secMsgAreas  = 'MsgAreas';

  OrigHdr       : tBinaryHdr = (Version: ''; ExeName: '');

  EmuName       : Array [teAnsi..teAvatar] Of String [6] =
                  ('ANSI', 'TTY', 'AVATAR');

  BbsLine       : Byte = 0;
{$ENDIF}
  Copyright     : String = '(c) Konstantin Klyagin, 1995-99';

Implementation

{$IFDEF WIN32}
{$IFNDEF NOT_TOR}
Uses
  tor32u;
{$ENDIF}
{$ENDIF}

{$IFDEF MSDOS}
Constructor TBigCollection. Init;
Begin
  Inherited Init (AMax, AStep);
  DataStream := nil;
  DataStream := New (PXMSStream, Init (256, 512));

  If (DataStream = Nil) Or (DataStream^. Status <> stOk) Then
  Begin
    If DataStream <> Nil Then Dispose (DataStream, Done);
    DataStream := New (PEMSStream2, Init (1024, 2048));
  End;

  Usual := (DataStream = Nil) Or (DataStream^. Status <> stOk);
End;

Destructor TBigCollection. Done;
Begin
  If Not Usual Then Dispose (DataStream, Done) Else
  While Count > 0 Do
  Begin
    DisposeStr (At (0));
    AtDelete (0);
  End;

  Inherited Done;
End;

Procedure TBigCollection. FreeItem (Item: Pointer);
Begin
  If Usual And (Item <> Nil) And (PString (Item)^ <> '') Then DisposeStr (Item);
End;

Procedure TBigCollection. InsLine;
Var
  L : LongInt;

Begin
  If Not Usual Then
  Begin
    L := DataStream^. GetSize;
    DataStream^. Seek (L);
    DataStream^. Write (S, SizeOf (S));
    Inherited Insert (Pointer (L));
  End Else
    Inherited Insert (NewStr (S));
End;

Procedure TBigCollection. AtPutLine;
Begin
  AtRemove (Index);
  AtInsLine (Index, S);
End;

Procedure TBigCollection. AtInsLine;
Var
  L : LongInt;

Begin
  If Not Usual Then
  Begin
    L := DataStream^. GetSize;
    DataStream^. Seek (L);
    DataStream^. Write (S, SizeOf (S));
    Inherited AtInsert (Index, Pointer (L));
  End Else
    Inherited AtInsert (Index, NewStr (S));
End;

Procedure TBigCollection. AtRemove (Index: Integer);
Begin
  FreeItem (At (Index));
  AtDelete (Index);
End;

Function TBigCollection. At (Index: Integer): Pointer;
Var
  L : LongInt;
  _Dat : String;
  P : PString;

Begin
  If Not Usual Then
  Begin
    L := LongInt (Inherited At (Index));
    DataStream^. Seek (L);
    DataStream^. Read (_Dat, SizeOf (String));
    At := @_Dat;
  End Else
  Begin
    _Dat := '';
    P := Inherited At (Index);
    If P = Nil Then At := @_Dat Else At := P;
  End;
End;

{$ELSE}

Procedure TBigCollection. InsLine;
Begin
  Inherited Insert (NewStr (S));
End;

Procedure TBigCollection. AtInsLine;
Begin
  Inherited AtInsert (Index, NewStr (S));
End;

Procedure TBigCollection. AtPutLine;
Begin
  AtRemove (Index);
  AtInsLine (Index, S);
End;

Function TBigCollection. At;
Var
  P : PString;
  S : String;

Begin
  S := '';
  P := Inherited At (Index);
  If P = Nil Then At := @S Else At := P;
End;

Procedure TBigCollection. FreeItem (Item: Pointer);
Begin
  If (Item <> Nil) And (PString (Item)^ <> '') Then DisposeStr (Item);
End;

Procedure TBigCollection. AtRemove (Index: Integer);
Begin
  FreeItem (At (Index));
  AtDelete (Index);
End;

{$ENDIF}

Procedure TBigCollection. Insert (Item: Pointer);
Begin
  RunError (200);
End;

Procedure TBigCollection. AtInsert (Index: Integer; Item: Pointer);
Begin
  RunError (200);
End;

Procedure TBigCollection. AtPut (Index: Integer; Item: Pointer);
Begin
  RunError (200);
End;

{$IFNDEF NOT_TOR}
Function lang (LangItem: LongInt): String;
Begin
  If LangItem <= Language^. Count-1 Then lang := GetStr (Language^. At (LangItem)) Else lang := '';
End;

Function InList (FName: PathStr; Name: String): Boolean;
Var
  VIP   : Text;
  FStr  : String;

Begin
  InList := False;
  If (Not FileExists (FName)) Or (Trim (FName) = '') Then Exit;
  FStr := '';

  System. FileMode := Open_Access_ReadOnly;

  Assign (VIP, FName);
  ReSet (VIP);
  If IOResult <> 0 Then Exit;

  System. FileMode := Open_Access_ReadWrite;

  While Not Eof (VIP) Do
  Begin
    ReadLn (VIP, FStr);
    If Pos (';', FStr) <> 0 Then FStr := Copy (FStr, 1, Pos (';', FStr) - 1);

    If (Trim (FStr) <> '') and (Trim (UpString (FStr)) =
       Trim (UpString (Name))) Then
    Begin
      InList := True;
      Break;
    End;
  End;

  Close (VIP);
End;

Function ReadList (FName: PathStr; List: PNotSortedCollection): Boolean;
Var
  VIP   : Text;
  FStr  : String;

Begin
  ReadList := False;
  FStr := '';

  System. FileMode := Open_Access_ReadOnly;

  Assign (VIP, FName);
  ReSet (VIP);
  If IOResult <> 0 Then Exit;

  System. FileMode := Open_Access_ReadWrite;
  While Not Eof (VIP) Do
  Begin
    ReadLn (VIP, FStr);
    If Pos (';', FStr) <> 0 Then FStr := Copy (FStr, 1, Pos (';', FStr) - 1);
    If Trim (FStr) <> '' Then List^. Insert (NewStr (FStr));
  End;
  Close (VIP);
  ReadList := True;
End;

Function LineExt: String;
Begin
  LineExt := Copy ('.bin', 1, 4-Length (Long2Str (BbsLine))) + Long2Str (BbsLine);
End;

Function IsToday (LastD, LastT: LongInt): Boolean;
Var
  NowD, NowT : LongInt;

Begin
  Dec (LastT, Cnf. BBSMidnight);
  NowD := DateL;
  NowT := Time2Long(StrTime);
  Dec (NowT, Cnf. BBSMidnight);

  While NowT >= SecondsInDay Do
  Begin
    Dec (NowT, SecondsInDay);
    Inc (NowD);
  End;
  While LastT >= SecondsInDay Do
  Begin
    Dec (LastT, SecondsInDay);
    Inc (LastD);
  End;
  While NowT < 0 Do
  Begin
    Inc (NowT, SecondsInDay);
    Dec (NowD);
  End;
  While LastT < 0 Do
  Begin
    Inc (LastT, SecondsInDay);
    Dec (LastD);
  End;
  IsToday := (LastD = NowD); {Это было "сегодня"}
End;

Procedure SetFlag;
Begin
  If BbsLine = 0 Then Exit;
  Assign (Flag, Cnf. FlagsDir + Name);
  ReWrite (Flag);
  Close (Flag);
End;

Procedure MakeFlag;
Begin
  Assign (Flag, Cnf. FlagsDir + Name + '.' + LeftPadCh (Long2Str (BbsLine), '0', 3));
  ReWrite (Flag);
  Close (Flag);
  If IOResult <> 0 Then;
End;

Function ChkFlag;
Var
  Res   : Boolean;

Begin
  Assign (Flag, Cnf. FlagsDir + Name + '.' + LeftPadCh (Long2Str (BbsLine), '0', 3));
  ReSet (Flag);
  Res := (IOResult = 0);
  If Res Then Close (Flag);
  ChkFlag := Res;
End;

Procedure DelFlag;
Begin
  If BbsLine = 0 Then Exit;
  tDeleteFile (Cnf. FlagsDir + Name);
End;

Procedure EraseFlag;
Begin
  tDeleteFile (Cnf. FlagsDir + Name + '.' + LeftPadCh (Long2Str (BbsLine), '0', 3));
End;

Function CheckFlag;
Begin
  CheckFlag := False;
  If BbsLine = 0 Then Exit;
  Assign (Flag, Cnf. FlagsDir + Name);
  ReSet (Flag);
  CheckFlag := (IOResult = 0);
  Close (Flag);
  If IOResult <> 0 Then;
End;

Procedure Wait4Flag;
Var
  ET    : EventTimer;
  i     : Byte;

Begin
  If BbsLine = 0 Then Exit;
  i := 1;
  NewTimerSecs (ET, 0);
  While True Do
  Begin
    TimeSlice;
    If TimerExpired (ET) Then
    Begin
      If Not CheckFlag (Name) Then Exit;
      NewTimerSecs (ET, 5); Inc (i);
      If i >= 4 Then
      Begin
        DelFlag (Name);
        Exit;
      End;
    End;
  End;
End;

Procedure ClearInputHistory;
Begin
  ReadHistory^. FreeAll;
  ReadHistory^. DeleteAll;
End;

{$ENDIF}

{$IFNDEF WIN32}

Function TNotSortedCollection. Compare (Key1, Key2: Pointer):
         {$IFNDEF OS2} Integer; {$ELSE} LongInt; {$ENDIF}
Begin
  Compare := -1;
End;

Procedure TNotSortedCollection. AtPut (Index: Integer; Item: Pointer);
Begin
  DisposeStr (At (Index));
  Inherited AtPut (Index, Item);
End;

{$ENDIF}

Procedure TNotSortedCollection. FreeAll;
Var
  i     : LongInt;

Begin
  If Count > 0 Then
  For i := 0 To Count-1 Do
  If At (i) <> nil Then DisposeStr (At (i));
End;

Procedure TNotSortedCollection. DeleteAll;
Begin
  If Count > 0 Then
  While Count > 0 Do AtDelete (0);
End;

Destructor TNotSortedCollection. Done;
Begin
  FreeAll;
  DeleteAll;
  Inherited Done;
End;

Function TNotSortedCollection. Contains (S: String): Boolean;
Const
  Name : String = '';

Function Matches (P: PString): Boolean;
Begin
  Matches := P^ = Name;
End;

Begin
  Name := S;
  Contains := FirstThat (@Matches) <> Nil;
End;

{$IFNDEF NOT_TOR}
{$IFNDEF WIN32}

Function TFileItemCollection. Compare (Key1, Key2: Pointer): {$IFNDEF OS2} Integer; {$ELSE} LongInt; {$ENDIF}
Begin
  Compare := -1;
End;

Procedure TFileItemCollection. AtPut (Index: Integer; Item: Pointer);
Begin
  DisposeFileItem (At (Index));
  Inherited AtPut (Index, Item);
End;

Procedure TTagFilesCollection. AtPut (Index: Integer; Item: Pointer);
Begin
  DisposeTagFile (At (Index));
  Inherited AtPut (Index, Item);
End;

Procedure TTagFilesCollection. DeleteAll;
Begin
  While Count > 0 Do
  Begin
    DisposeTagFile (At (0));
    AtDelete (0);
  End;
End;

{$ENDIF}

Destructor TFileItemCollection. Done;
Begin
  While Count > 0 Do
  Begin
    DisposeFileItem (At (0));
    AtDelete (0);
  End;

  Inherited Done;
End;

Procedure TMenuItemsCollection. DeleteAll;
Begin
  While Count > 0 Do
  Begin
    DisposeMenuItem (At (0));
    AtDelete (0);
  End;
End;

Function TTagFilesCollection. Compare (Key1, Key2: Pointer): {$IFNDEF OS2} Integer; {$ELSE} LongInt; {$ENDIF}
Var
  i  : ShortInt;
  K1 : PTagFileRec Absolute Key1;
  K2 : PTagFileRec Absolute Key2;

Begin
  i := 0;

  If K1^. GroupNum < K2^. GroupNum Then i := -1;
  If K1^. GroupNum > K2^. GroupNum Then i :=  1;

  If i = 0 Then
  Begin
    If K1^. AreaNum < K2^. AreaNum Then i := -1;
    If K1^. AreaNum > K2^. AreaNum Then i :=  1;

    If i = 0 Then
    Begin
      If JustFileName (K1^. PathName) < JustFileName (K2^. PathName) Then i := -1;
      If JustFileName (K1^. PathName) = JustFileName (K2^. PathName) Then i :=  0;
      If JustFileName (K1^. PathName) > JustFileName (K2^. PathName) Then i :=  1;
    End;
  End;

  Compare := i;
End;

{$ENDIF}

{$IFNDEF NOT_TOR}

Function NewPLongInt (i: LongInt): Pointer;
Var
  P     : pLongInt;

Begin
  GetMem (P, 4);
  P^ := i;
  NewPLongInt := P;
End;

Procedure DisposePLongInt (P: Pointer);
Begin
  If P <> nil Then FreeMem (P, 4);
  P := nil;
End;

Function NewFileItem (Const S: tFileItem): PFileItem;
Var
  P     : PFileItem;

Begin
  GetMem (P, SizeOf (tFileItem));
  P^ := S;
  NewFileItem := P;
End;

Procedure DisposeFileItem (P: PFileItem);
Begin
  If P <> nil Then FreeMem (P, SizeOf (tFileItem));
  P := Nil;
End;

Function NewMenuItem (Const S: tMenuItem): PMenuItem;
Var
  P     : PMenuItem;

Begin
  GetMem (P, SizeOf (tMenuItem));
  P^ := S;
  NewMenuItem := P;
End;

Procedure DisposeMenuItem (P: PMenuItem);
Begin
  If P <> nil Then FreeMem (P, SizeOf (tMenuItem));
  P := nil;
End;

Function NewTagFile (Const S: TTagFileRec): PTagFileRec;
Var
  P     : PTagFileRec;

Begin
  GetMem (P, SizeOf (TTagFileRec));
  P^ := S;
  NewTagFile := P;
End;

Procedure DisposeTagFile (P: PTagFileRec);
Begin
  If P <> nil Then FreeMem (P, SizeOf (TTagFileRec));
  P := nil;
End;

Function GetStr (P: PString): String;
Begin
  If P <> Nil Then GetStr := PString (P)^ Else GetStr := '';
End;

Function PhoneValid (S: String): Boolean;
Begin
  If (Length (S) = 0) or (Length (S) < Cnf. PhoneMinLength) or (Length (S) > Cnf. PhoneMaxLength) Then
  Begin
    PhoneValid := False;
    Exit;
  End;

  PhoneValid := ConsistsOf (S, ['0'..'9', '-', '+', '(', ')', ' ', '[', ']']);
End;

Function keyScrollLock: Boolean;
{$IFDEF OS2}
Var
  Key : KbdInfo;
{$ENDIF}

Begin
{$IFDEF MSDOS}
  If FlagIsSet (Mem [0000:$0417], 16) Then
    keyScrollLock := True
  Else
    keyScrollLock := False;

{$ENDIF}

{$IFDEF OS2}
  Key. CB := SizeOf (KbdInfo);
  Key. fsMask := keyboard_Shift_report;
  KbdGetStatus (Key, 0);

  If FlagIsSet (Key. fsState, 16) Then
    keyScrollLock := True
  Else
    keyScrollLock := False;

{$ENDIF}

{$IFDEF WIN32}
  keyScrollLock := False;
{$ENDIF}

End;

Function LineUsed: Boolean;
Var
  Cargo                 : {$IFNDEF WIN32} SysInt {$ELSE} Word {$ENDIF};
  F                     : {$IFNDEF WIN32} File; {$ELSE} THandle; {$ENDIF}
  FlagName              : PathStr;
  Time                  : {$IFNDEF WIN32} LongInt; {$ELSE} TDateTime; {$ENDIF}
  DT, cDT               : {$IFNDEF WIN32} DOS. DateTime; {$ELSE} DateTime; {$ENDIF}

Begin
  LineUsed := False;

  FlagName := Cnf. FlagsDir + RunFlag + '.' + LeftPadCh (Long2Str (BbsLine), '0', 3);
  If FileExists (FlagName) Then
  Begin
  {$IFNDEF WIN32}
    Assign (F, FlagName);
    ReSet (F);

    If IOResult <> 0 Then
    Begin
      LineUsed := True;
      Exit;
    End;

    GetFTime (F, Time);
    DOS. UnPackTime (Time, DT);

    GetDate (cDT. Year, cDT. Month, cDT. Day, Cargo);
    GetTime (cDT. Hour, cDT. Min, cDT. Sec, Cargo);

  {$ELSE}
    F := FileOpen (FlagName, fmOpenRead or fmShareDenyNone);
    Time := FileDateToDateTime (FileGetDate (F));
    DecodeDate (Time, Word (DT. Year), Word (DT. Month), Word (DT. Day));
    DecodeTime (Time, Word (DT. Hour), Word (DT. Min), Word (DT. Sec), Word (Cargo));
    Time := Now;
    DecodeDate (Time, Word (cDT. Year), Word (cDT. Month), Word (cDT. Day));
    DecodeTime (Time, Word (cDT. Hour), Word (cDT. Min), Word (cDT. Sec), Word (Cargo));
  {$ENDIF}

    If HoursDiff (DT, cDT) >= Cnf. IgnoreOldFlags Then
    Begin
    {$IFNDEF WIN32}
      Close (F);
      Erase (F);
    {$ELSE}
      SysUtils. DeleteFile (FlagName);
    {$ENDIF}
    End Else
    Begin
      LineUsed := True;
    {$IFNDEF WIN32}
      Close (F);
    {$ENDIF}
      Exit;
    End;
  End;
End;

Function InFilesBBS (Name: String): Boolean;
Var
  F     : Text;
  S     : String [80];

Begin
  InFilesBBS := False;
  If FileArea. FileList = '' Then Exit;

  Assign (F, FileArea. FileList);
  Reset (F);
  If IOResult <> 0 Then Exit;

  While Not EoF (F) Do
  Begin
    ReadLn (F, S);
    S := Trim (ExtractWord (1, S, [' ']));
    If Trim (UpString (S)) = Trim (UpString (Name)) Then
    Begin
      InFilesBBS := True;
      Break;
    End;
  End;
  Close (F);
End;

Procedure SetCrtColor;
Begin
{$IFDEF WIN32}
  MainForm. Console1. SetCrtColor (TextAttr);
{$ENDIF}
End;

Function BinaryHdrValid (Hdr: tBinaryHdr): Boolean;
Begin
  BinaryHdrValid := (Hdr. Version = OrigHdr. Version) And
                    (Hdr. ExeName = OrigHdr. ExeName);
End;

{$IFDEF WIN32}

Function SaveWindow (XLow, YLow, XHigh, YHigh : Byte; Allocate : Boolean; var Covers : Pointer) : Boolean;
Begin
  SaveWindow := MainForm. Console1. SaveWindow (XLow, YLow, XHigh, YHigh, Allocate, Covers);
End;

Procedure RestoreWindow (XLow, YLow, XHigh, YHigh : Byte; Deallocate : Boolean; var Covers : Pointer);
Begin
  MainForm. Console1. RestoreWindow (XLow, YLow, XHigh, YHigh, Deallocate, Covers);
End;

Procedure ProcessMessages;

Function ProcMsg: Boolean;
Var
  Msg    : Windows. TMsg;

Begin
  Result := False;
  if PeekMessage (Msg, 0, 0, 0, PM_REMOVE) then
  begin
    Result := True;
    if Msg.Message <> WM_QUIT then
    begin
      {if not IsKeyMsg (Msg) then}
      begin
        TranslateMessage (Msg);
        DispatchMessage (Msg);
      end;
    end
    else
      {do something} ;
  end;
End;

Begin
  While ProcMsg Do {Sleep (0)};
End;

{$ENDIF}

Procedure SetEmulation;
Const
  FIndex : Array [teAnsi..teAvatar] Of Byte = (2, 4, 3);

Begin
{$IFDEF OS2}
  {SetANSI (R. Emu = teAnsi);}
{$ENDIF}
{$IFDEF WIN32}
  MainForm. ShowDlg. FilterIndex := FIndex [R. Emu];
{$ENDIF}
End;

Procedure SetDebugFile (S: String);
Begin
  CurrentDebugFile := LeftPadCh (Trim (NiceFileName (AddBackSlash (
  CompletePath (JustPathName (S))) + JustFileName (S), 28)), ' ', 28);
End;

Procedure SetTitle (Title: String);
{$IFDEF OS2}
Var
  SwHandle              : hSwitch;
  T                     : PTib;
  P                     : PPib;
  Data                  : SwCntrl;

Begin
  If Title = '' Then Title := 'idle';
  If Title <> SaveTitle Then Title := 'Tornado: ' + Title;

  DosGetInfoBlocks (T, P);
  SwHandle := WinQuerySwitchHandle (NULLHANDLE, P^. Pib_ulPid);

  If SwHandle <> NULLHANDLE Then
  If WinQuerySwitchEntry (SwHandle, @Data) = 0 Then
  Begin
    WinQuerySwitchEntry (SwHandle, @Data);
    FillChar (Data. szSwtitle, SizeOf (Data. szSwtitle), #0);

    Move (Title [1], Data. szSwtitle, Length (Title));
    WinChangeSwitchEntry (SwHandle, @Data);
  End;
{$ENDIF}
{$IFDEF WIN32}
Var
  S, S1 : PChar;

Begin
  If Title = '' Then Title := R. Name;

  GetMem (S, 256);
  GetMem (S1, 256);
  StrPCopy (S, Title);
  OemToAnsi (S, S1);
  Title := S1;
  FreeMem (S, 256);
  FreeMem (S1, 256);

  Application. Title := Title;
  MainForm. RxTrayIcon1. Hint := 'Tornado BBS: ' + Title;

{$ENDIF}
{$IFDEF MSDOS}
Begin
{$ENDIF}
End;

Function GetTitle: String;
{$IFDEF OS2}
Var
  SwHandle              : hSwitch;
  T                     : PTib;
  P                     : PPib;
  Data                  : SwCntrl;
  Title                 : String;
  i                     : ULong;

Begin
  Title := '';
  DosGetInfoBlocks (T, P);
  SwHandle := WinQuerySwitchHandle (NULLHANDLE, P^. Pib_ulPid);

  If SwHandle <> NULLHANDLE Then
  If WinQuerySwitchEntry (SwHandle, @Data) = 0 Then
  Begin
    WinQuerySwitchEntry (SwHandle, @Data);
    For i := 1 To MaxNameL+3 Do If Data. szSwtitle [i] = #0 Then Break;
    Move (Data. szSwtitle, Title [1], i);
    Title [0] := Chr (i);
  End;

  GetTitle := Title;
{$ELSE}
Begin
{$ENDIF}
End;

{$IFDEF OS2}
Function GetFileDateCreation (FN: PathStr): String;
Var
  S     : String;
  rc    : ApiRet;
  Info  : FileStatus3;
  FName : PChar;

Begin
  GetMem (FName, Length (FN)+1);
  StrPCopy (FName, FN);

  rc := DosQueryPathInfo (FName, 1, Info, SizeOf (Info));
  With Info Do
  S := LeftPadCh (Long2Str ((fdateCreation and mfdDay) shr sfdDay), '0', 2) + '-' +
       LeftPadCh (Long2Str ((fdateCreation and mfdMonth) shr sfdMonth), '0', 2) + '-' +
       Long2Str ((fdateCreation and mfdYear) shr sfdYear+1980) + ' ' +
       LeftPadCh (Long2Str ((fdateCreation and mftHours) shr sfdDay), '0', 2) + ':' +
       LeftPadCh (Long2Str ((fdateCreation and mftMinutes) shr sfdDay), '0', 2);

  GetFileDateCreation := S;

  FreeMem (FName, Length (FN)+1);
End;

{$ENDIF}

Begin
  OrigHdr. Version := ExtractWord (2, NameVer, [' ']);
  OrigHdr. ExeName := UpString (ParamStr (0));
{$ENDIF}

End.