{$IFNDEF OS2}
{$F+,B-}
{$ENDIF}
{$I-}

Unit MainComm;

{*********************************************************}
{*                    MAINCOMM.PAS                       *}
{*                                                       *}
{*  Copyright (c) Konstantin Klyagin, 1995-98,           *}
{*                exspecially for Tornado BBS System     *}
{*                                                       *}
{*********************************************************}

Interface

Uses

{$IFDEF MSDOS}
  ApPort,
{$ENDIF}

{$IFDEF OS2}
  ApOS2,
  Os2Base,
{$ENDIF}

{$IFNDEF WIN32}
  DOS,
  ApSame,
  ApTimer,
  ApCom,
  ApAbsPcl,
  tWin,
{$ELSE}
  Classes,
  ooMisc,
  AdProtcl,
  AdPort,
  AwAbsPcl,
  Windows,
  SysUtils,
  Forms,
  WApro,
  Console,
{$ENDIF}

  Users,
  Parse,
  tMisc,
  TGlob,
  torMacro,
  torInOut,
  Objects,
  OpCrt,
  Log,
  tModem,
  Ansi,
  Avatar,
  Resource,
  TimeTask;

Type
  tPadMode = (pmPadLeft, pmPadRight, pmNone);

Const
  HotLength = 27;
  EmuExt : Array [teAnsi..teAvatar] Of String [3] = ('ans', 'asc', 'avt');
{$IFNDEF WIN32}
  ComPorts : Array [Com1..Com8] Of Char = ('1', '2', '3', '4', '5', '6', '7', '8');
  ComNames : Array [1..36] Of ComNameType =
    (Com1, Com2, Com3, Com4, Com5, Com6, Com7, Com8, Com9, Com10, Com11,
     Com12, Com13, Com14, Com15, Com16, Com17, Com18, Com19, Com20, Com21,
     Com22, Com23, Com24, Com25, Com26, Com27, Com28, Com29, Com30, Com31,
     Com32, Com33, Com34, Com35, Com36);
{$ENDIF}

Var
  KeyBoardFunc             : Function (C: Char): Boolean;
  AnalyzeProc              : Procedure (C: Char);
  reqPort                  : {$IFNDEF OS2} Byte {$ELSE} String [20] {$ENDIF};
  Mode                     : CaseType;
  MoreLines                : Byte;
  HotKeysStr               : String;
  ToEventTime              : Word;
  ChatLog                  : Text;
  Err                      : SysInt;
  Timer, InactTimer        : EventTimer;
  InAllow                  : tInAllow;
  ScreenOut                : PTorInOut;
  UserText, SysOpText      : PNotSortedCollection;

  ChatStartTime, SizeOfAll,
  SessionDL, SessionUL,
  LastClock, deltaTime     : LongInt;

{$IFDEF WIN32}
  S1, S2 : PChar;
{$ENDIF}

Procedure InitMore (StartLine: Byte);
Function More: Boolean;
Function MoreNums (Var Nums: String; EnterNums: String): Boolean;

Procedure ProcessChoices;
Function Incoming: Boolean;
Function ComReadKey: Char;
Function ComReadKeyE: Char;

Procedure SetInput (Con, Rem: Boolean);
Procedure SetOutput (Con, Rem: Boolean);
Procedure SetInputCap (CurMode: CaseType; AcceptSet: CharSet);

Procedure Clock2;
Procedure DispFile (Name: String);
Procedure mWriteLen (S: String; L: Byte; Pad: tPadMode);

Procedure oScreen (B: Byte);
Procedure soScreen (S: String);
Procedure oPort (B: Byte);
Procedure soPort (S: String);

Procedure Frame;
Procedure KeyBufAdd (S: String);
Procedure UpdateUserMacro;

Function RemoteAnsiDetected : Boolean;
Function ZeroMsg (Param: String; CR: Boolean): String;
Function ZeroBackGround (Param: String): String;
Function Bool2Lang (What: Boolean): String;
Procedure TorSoundBell;

Procedure ShowTimeLeft;
Procedure ShowStatusBar;
Procedure DoCommand (S: String);
Procedure ClearBuffer;
Procedure LostCarrier;
Procedure HangUp;
Procedure Chat;
Procedure RetWait;
Procedure SlashRotate;

(* Macro tables managment *)

(* System status managment *)
Procedure ReadSystemStatus (Var System: SystemType; FN: String);
Procedure WriteSystemStatus (System: SystemType; FN: String);

(* LastCall.Tor *)
Function ReadLastCaller (Var LC: tLastCaller; Mode: tRLCmode): Boolean;
Procedure SaveLastCaller (Name: String; Line: Byte; LoginTime: String;
                          Date, TimeOnLine, ULkb, DLkb: LongInt);

Procedure SaveTime;

{$IFDEF WIN32}
Procedure GetString (P: TApdComPort; Var S: String; Delims: CharSet);
{$ELSE}
Function KbdAbort: Boolean;
Procedure SwitchStatusBar;
{$ENDIF}

Implementation

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

Var
  lcFile                : File Of tLastCaller;

{$IFDEF WIN32}

Procedure GetString (P: TApdComPort; Var S: String; Delims: CharSet);
Var
 C : Char;

Begin
  S := '';
  Repeat
    C := P. GetChar;
    S := S + C;
  Until C in Delims;
End;

{$ELSE}

Function KbdAbort;
Var
  CH : Char;

Begin
  KbdAbort := False;

  If KeyPressed Then
  Case ReadKey Of
     #0 : KbdAbort := ReadKey = #35;
    #27 : KbdAbort := True;
  End;

  If Not Local Then
  If ProtocolInProgress (P) Then
  If Not CheckDCD (P) Then
  Begin
    NewTimerSecs (Timer, {$IFNDEF OS2} Cnf. CDLostDelay {$ELSE} 5 {$ENDIF} );
    While Not TimerExpired (Timer) Do
    Begin
      If CheckDCD (P) Then Exit;
      If Cnf. Clock Then FastWrite (StrTime, 1, ScrX-6, Cnf. ColorScheme [cmClock]);
      TimeSlice;
    End;
    KbdAbort := True;
  End;
End;

{$ENDIF}

Procedure LostCarrier;
Begin
{$IFNDEF WIN32}
  If ProtocolInProgress (P) Then Exit;
{$ENDIF}
  NewTimerSecs (Timer, Cnf. CDLostDelay);

  While Not TimerExpired (Timer) Do
  Begin
    If CheckDCD (P) Then Exit;
  {$IFNDEF WIN32}
    If Cnf. Clock Then
    FastWrite (StrTime, 1, ScrX-6, Cnf. ColorScheme [cmClock])
  {$ENDIF};
    TimeSlice;
  End;

  {LogWrite ('&', 'Carrier lost');}
  NormExit;
End;

Procedure ShowTimeLeft;
Var
  S : String;

Begin
  If TimeCount Then
  If (R. TotalTime - (MidSec - EnterTime)) <= 0
  Then
     S := sm (smStatSecurity) + Long2Str (R. Security) + ' ' +
     sm (smTimeLeft) + '0 ' + sm (smsMin) + '          '
  Else
     S := sm (smStatSecurity) + Long2Str (R. Security) + ' ' +
     sm (smTimeLeft) + Long2Str (Round ((R. TotalTime - MidSec +
     EnterTime)/60)) + ' ' + sm (smsMin) + '          '
  Else
     S := Replicate (' ', 51);

{$IFNDEF WIN32}
  FastWrite (S, ScrY + 1, 1, Cnf. ColorScheme [cmStatusLine])
{$ELSE}
  MainForm. Label2. Caption := TrimTrail (S);
{$ENDIF}
End;

Procedure ShowStatusBar;

Procedure TimeExit;
Begin
  If Local Or (Not ProtocolInProgress (P)) Then
    ComWriteLn (lang (laTimeLimit), eoMacro + eoCodes);

  LogWrite ('+', sm (smTimeLimit));
  Pause (2000);
  NormExit;
End;

Function CheckProt: Boolean;
Var
  Progr : Boolean;

Begin
  If Local Then
  Begin
    CheckProt := True;
    Exit;
  End;

  Progr := ProtocolInProgress (P);
  CheckProt := (Not Progr) Or (Progr And
    ((trMode = Transmit) And Cnf. AbortDownLoad) Or
    ((trMode = Receive) And Cnf. AbortUpLoad And (Cnf. UploadTimePlus = 0)));
End;

Var
{$IFNDEF WIN32}
  Stat          : String [50];
{$ENDIF}
  i             : Word;

Begin
  TimeSlice;
{$IFNDEF WIN32}
  If Cnf. Clock Then FastWrite (StrTime, 1, ScrX-6, Cnf. ColorScheme [cmClock]);
  If StatusBar And Not EnteringPass Then
  Begin
    If Trim (R. Name) <> '' Then
    Begin
      Stat := Trim (R. Name);
      If R. Location <> '' Then Stat := Stat + sm (smStatusFrom) + R. Location;
      Stat := Stat + sm (smStatusAtBPS);
    End Else
      Stat := ' ';

    Stat := Stat + Long2Str (GetConnectSpeed) + sm (smBaud);

    If Length (Stat) >= 48 Then Stat := Copy (Stat, 1, 48) + '..';
    FastWrite (Stat + Replicate (' ', 80 - Length (Stat)), ScrY, 1,
    Cnf. ColorScheme [cmStatusLine]);

    If Cnf. DebugFiles
    Then FastWrite (CurrentDebugFile, ScrY, 52, Cnf. ColorScheme [cmStatusLine])
    Else Begin
{$IFDEF DEBUG}
{$IFDEF MSDOS}
      FastWrite (LeftPadCh (Long2Str (MemAvail), ' ', 8), ScrY, 73,
                Cnf. ColorScheme [cmStatusLine])
{$ENDIF}
{$ENDIF};

      If WantsChat
      Then FastWrite ('[Wants Chat]', ScrY, 61, Cnf. ColorScheme [cmStatusFlags])
      Else FastWrite (Replicate (' ', 12), ScrY, 61, Cnf. ColorScheme [cmStatusLine]);
    End;

    FastWrite (Replicate (' ', ScrX - 64), ScrY + 1, 37, Cnf. ColorScheme [cmStatusLine]);

    If Not Local Then
    Begin
      {$IFDEF MSDOS}
      FastWrite (' Com' + ComPorts [GetComName (P)] + ' ', ScrY + 1, 51, Cnf. ColorScheme [cmLamps]);
      {$ELSE}
      FastWrite (CenterCh (Cnf. ComPort, ' ', 6), ScrY + 1, 51, Cnf. ColorScheme [cmLamps]);
      {$ENDIF}

      If CheckCTS (P)
      Then FastWrite ('CTS ', ScrY + 1, 57, Cnf. ColorScheme [cmHighlight])
      Else FastWrite ('CTS ', ScrY + 1, 57, Cnf. ColorScheme [cmLamps]);

      If CheckDSR (P)
      Then FastWrite ('DSR ', ScrY + 1, 61, Cnf. ColorScheme [cmHighlight])
      Else FastWrite ('DSR ', ScrY + 1, 61, Cnf. ColorScheme [cmLamps]);

      If CheckDataReady (P)
      Then FastWrite ('DR ', ScrY + 1, 65, Cnf. ColorScheme [cmHighlight])
      Else FastWrite ('DR ', ScrY + 1, 65, Cnf. ColorScheme [cmLamps]);

      If OutBuffUsed (P) > 0
      Then FastWrite ('SD ', ScrY + 1, 68, Cnf. ColorScheme [cmHighlight])
      Else FastWrite ('SD ', ScrY + 1, 68, Cnf. ColorScheme [cmLamps]);

      If InBuffUsed (P) > 0
      Then FastWrite ('RD ', ScrY + 1, 71, Cnf. ColorScheme [cmHighlight])
      Else FastWrite ('RD ', ScrY + 1, 71, Cnf. ColorScheme [cmLamps]);

      If CheckRI (P)
      Then FastWrite ('RI ', ScrY + 1, 74, Cnf. ColorScheme [cmHighlight])
      Else FastWrite ('RI ', ScrY + 1, 74, Cnf. ColorScheme [cmLamps]);

      If CheckDCD (P)
      Then FastWrite ('CD  ', ScrY + 1, 77, Cnf. ColorScheme [cmHighlight])
      Else FastWrite ('CD  ', ScrY + 1, 77, Cnf. ColorScheme [cmLamps]);
    End Else
      FastWrite (CenterCh (sm (smLocalModeStat), ' ', 29), ScrY + 1, 52, Cnf. ColorScheme [cmStatusLine]);
  End;

  If StatusBar Then
{$ENDIF}
  If Not EnteringPass Then ShowTimeLeft;

  If Not Local Then
  If Not ProtocolInProgress (P) And Not CheckDCD (P) Then LostCarrier;
{$IFDEF WIN32}
  If Application. Terminated Then Exit;
{$ENDIF}

  If (ToEventTime > 0) And (Round ((MidSec - EnterTime)/60) >= ToEventTime) And CheckProt Then
  If Not (Cnf. ChatTimeSuspend And InChat) Then
  Begin
    If Not ProtocolInProgress (P) Then
    Begin
      ComWriteLn ('|' + lang (laEventExit), eoMacro + eoCodes);
      Pause (2000);
    End;

    NormExit;
  End;

  If Not Local Then
  If Not Registering Then
  Begin
    If (Lim. SessionTime > 0) And TimeCount Then
    If Round ((MidSec - EnterTime)/60) >= Lim. SessionTime Then
    If CheckProt Then NormExit;
  End Else
    If Cnf. RegisterTime > 0 Then
    If Round ((MidSec - EnterTime)/60) >= Cnf. RegisterTime Then
    If Not (Cnf. ChatTimeSuspend And InChat) Then
    If CheckProt Then TimeExit;

  If TimeCount And (R. TotalTime-(MidSec-EnterTime) <= 0) And CheckProt Then TimeExit;

  If Suxx Then
  Begin
    i := Random (120);
    If i in [10, 29, 37, 49, 57, 66, 69, 72, 74, 77, 80, 97, 110, 112] Then Gluck Else
    If i in [31, 102] Then NormExit;
  End;

  TimeSlice;
End;

Procedure Clock2;
Begin
  If (MidSec - deltaTime < 0) and (Not Registering) Then
  Begin
    EnterTime := 0;
    R. TotalTime := Lim. Time * 60;
    R. TimeUsedToday := 0;
    R. TodayK := 0;
    R. DailySize := Lim. KBLimit;
    SaveUser (R);
    LastClock := 0;
    ChatStartTime := 0;
    ShowStatusBar;
  End;
  deltaTime := MidSec;

  If MidSec - LastClock = 0 Then Exit;
  LastClock := MidSec;

  ShowStatusBar;

  If InConference And (MidSec - LastConfKey >= 7) Then
  Begin
    KeyBufAdd (#9);
    LastConfKey := MidSec;
  End;
End;

Function fDrawAborted: Boolean;
Var
  Key   : Char;
  Att   : Byte;

Begin
  Clock2;
{$IFDEF WIN32}
  If Application. Terminated Then
  Begin
    fDrawAborted := True;
    Exit;
  End;
{$ENDIF}

  fDrawAborted := False;
  Key := #0;

  If InAllow. ConIn Then
  If KeyPressed Then
  Begin
    If Cnf. AbortKey <> akNone Then Key := ReadKey;

    If (Key = #27) and (Cnf. AbortKey = akEsc) Then   { €¡®àâ ¯® ESC    }
    Begin
      fDrawAborted := True;
      ComWriteLn (#13 + PadCh (lang (laAborted), ' ', 79), eoMacro + eoCodes);
      Exit;
    End;

    If (Key <> #0) Then                               { €¡®àâ ¯® anykey }
    Begin
      KeyBufAdd (Key);
      If Cnf. AbortKey = akAny Then
      Begin
        fDrawAborted := True;
        ComWriteLn (#13 + PadCh (lang (laAborted), ' ', 79), eoMacro + eoCodes);
        Exit;
      End;
    End;

    Att := TextAttr;
  {$IFNDEF WIN32}
    AnalyzeProc (Key);
  {$ENDIF}
    TextAttr := Att;
  End;

  If InAllow. RemIn Then
  If CharReady (P) Then
  Begin
    Key := ComReadKey;
    If (Key = #27) and (Cnf. AbortKey = akEsc) Then   { €¡®àâ ¯® ESC    }
    Begin
      fDrawAborted := True;
      ComWriteLn (#13 + PadCh (lang (laAborted), ' ', 79), eoMacro + eoCodes);
      Exit;
    End;

    If (Key <> #0) Then                               { €¡®àâ ¯® anykey }
    Begin
      KeyBufAdd (Key);
      If Cnf. AbortKey = akAny Then
      Begin
        fDrawAborted := True;
        ComWriteLn (#13 + PadCh (lang (laAborted), ' ', 79), eoMacro + eoCodes);
        Exit;
      End;
    End;
  End;
End;

Procedure fComWrite (Str: String; Options: Byte);
Var
  i     : Byte;

Begin
  ScreenOut^. UseMacroTable1 := (Options and eoMacro <> 0);
  ScreenOut^. UseMacroTable2 := (Options and eoColorCode <> 0);
  ScreenOut^. UseMacroTable3 := (Options and eoColorCode <> 0);
  StopCodeEnable := (Options and eoDisable01 = 0);

  If (Options and eoColorCode <> 0) And
     (Options and eoSlashCode <> 0)
  Then Str := PlaceSubStr (Str, '|', #13#10);

  With ScreenOut^ Do
  Begin
    ioTextAttr := TextAttr;
    StartBuffering;
    For i := 1 To Length (Str) Do OutByte (Byte (Str [i]));
    StopBuffering;
  End;

  ScreenOut^. UseMacroTable1 := False;
  ScreenOut^. UseMacroTable2 := False;
  ScreenOut^. UseMacroTable3 := False;
End;

Procedure fComWriteLn (Str: String; Options: Byte);
Begin
  ComWrite (Str + #13#10, Options);
End;

Function Incoming;
Var
  L1, L2        : Boolean;

Begin
  If InAllow. ConIn Then L1 := KeyPressed Else L1 := False;
  If InAllow. RemIn
  Then L2 := CharReady (P)
  Else L2 := False;

  Incoming := (L1 Or L2 Or (KeyBuffer <> ''));
End;

Function Bool2Lang (What: Boolean): String;
Begin
  If What Then Bool2Lang := ZeroMsg (lang (laYes), True)
          Else Bool2Lang := ZeroMsg (lang (laNo), True);
End;

Procedure Inact;
Var
  Att  : Byte;

Begin
  Att := TextAttr;

  ComWrite (lang (laInactive), eoMacro + eoColorCode);
  ComWrite (Replicate (#7, Length (ZeroMsg (lang (laInactive), False))), 0);

  NewTimerSecs (Timer, Round (Cnf. InactiveTime / 2));

  While Not Incoming {$IFDEF WIN32} And Not Application. Terminated {$ENDIF} Do
  Begin
    Clock2;
    TimeSlice;
    If TimerExpired (Timer) Then
    Begin
      ComWrite (Replicate (#8, Length (ZeroMsg (lang (laInactive), True))) +
      lang (laHangUpInactive) + Replicate (#8,
      Length (ZeroMsg (lang (laHangUpInactive),
      True))), eoMacro + eoCodes);

      EmuDispFile ('~inactive');
      NormExit;
      Exit;
    End;
  End;

  ComWrite (EmuColor (Att) + EmuClrEoL, 0);
End;

Function ComReadKey;
Var
  Pressed       : Boolean;
  C             : Char;
  T             : EventTimer;
  S             : String;

Begin
  Clock2;
{$IFDEF WIN32}
  MainForm. Console1. ShowCursor;
  If Not Local And Not P. Open Then Exit;
{$ENDIF}
  FuncKey := False;
  Pressed := False;
  NewTimerSecs (InactTimer, Round (Cnf. InactiveTime / 2));

  While {$IFNDEF WIN32} True {$ELSE} Not Application. Terminated {$ENDIF} Do
  Begin
    Clock2;

    If KeyBuffer <> '' Then
    Begin
      ComReadKey := KeyBuffer [1];
      If Length (KeyBuffer) > 1 Then
        KeyBuffer := Copy (KeyBuffer, 2, 255)
      Else
        KeyBuffer := '';
      Exit;
    End;

    If InAllow. ConIn Then
    While KeyPressed Do
    Begin
      C := ReadKey;
      ComReadKey := C;
      FromKeyboard := True;

      If C = #0 Then
      Begin
        C := ReadKey;

        If C in [#71, #72, #80, #77, #79, #75, #83] Then
        Begin
          Case C Of
            #72 : ComReadKey := kbUp;
            #80 : ComReadKey := kbDown;
            #77 : ComReadKey := kbRight;
            #75 : ComReadKey := kbLeft;
            #83 : ComReadKey := kbDel;
            #71 : ComReadKey := kbHome;
            #79 : ComReadKey := kbEnd;
          End;

          Exit;
        End Else
        If Assigned (KeyBoardFunc) And KeyBoardFunc (C) Then
        Begin
          Pressed := False;
          FuncKey := True;
          NewTimerSecs (InactTimer, Round (Cnf. InactiveTime / 2));
          If InAction Then Exit Else Continue;
        End;
      End Else
      Begin
      {$IFDEF WIN32}
        S1 [0] := C;
        AnsiToOem (S1, S2);
        ComReadKey := S2 [0];
      {$ENDIF}
        Exit;
      End;
    End;

    If InAllow. RemIn Then
    If CharReady (P) Then
    Begin
      GetChar (P, C);
      FromKeyboard := False;

      If C = #27 Then
      Begin
        NewTimer (T, 22);
        S := #27;

        While (Not TimerExpired (T)) And (Length (S) < 3) Do
        If CharReady (P) Then
        Begin
          GetChar (P, C);
          S := S + C;
          TimeSlice;
        End;

        If Length (S) = 3 Then
        Begin
          If Copy (S, 1, 2) = '[' Then
          Begin
            If S [3] in ['A'..'D', 'H', 'Y'] Then
            Begin
              Case S [3] Of
                'A' : ComReadKey := kbUp;
                'B' : ComReadKey := kbDown;
                'C' : ComReadKey := kbRight;
                'D' : ComReadKey := kbLeft;
                'H' : ComReadKey := kbHome;
                'Y' : ComReadKey := kbEnd;
              End;
              Exit;
            End Else
            Begin
              ComReadKey := S [1];
              KeyBufAdd (Copy (S, 2, 255));
              Exit;
            End;
          End;
        End Else
        Begin
          ComReadKey := S [1];
          KeyBufAdd (Copy (S, 2, 255));
          Exit;
        End;
      End;

      ComReadKey := C;
      Pressed := True;
    End;

    If Pressed Then
    If C In [#7, #12] Then
    Begin
      ComWrite (C, 0);
      Pressed := False;
    End Else
      Exit;

    If (Cnf. InactiveTime <> 0) And Not Local And Not InChat Then
    If TimerExpired (InactTimer) Then
    Begin
      Inact;
      NewTimerSecs (InactTimer, Round (Cnf. InactiveTime/2));
    End;

    TimeSlice;
  {$IFDEF WIN32}
    Application. HandleMessage;
  {$ENDIF}
  End;
End;

Function ComReadKeyE;
Var
  C     : Char;

Begin
  C := ComReadKey;
{$IFDEF WIN32}
  If Application. Terminated Then Exit;
{$ENDIF}
  ComWrite (C, 0);
  ComReadKeyE := C;
End;

Procedure InitMore (StartLine: Byte);
Begin
  If StartLine in [0, 1]
  Then
    MoreLines := 1
  Else
    MoreLines := StartLine;
End;

Function More: Boolean;
Var
  ATT   : Byte;

Begin
  More := True;
  If Not R. More Then Exit;
  Inc (MoreLines);

  If MoreLines < R. Lines Then Exit;
  MoreLines := 1;

  ATT := TextAttr;
  ScreenOut^. StopBuffering;

  Case MenuBar (lang (laMore) + ' ' + lang (laYesNo), lang (laYesNoKeys)+#13) Of
    1, 3 : ;
    2    : More := False;
  End;

{$IFDEF WIN32}
  If Application. Terminated Then Exit;
{$ENDIF}

  ComWrite (#13, 0);
  ComWrite (EmuClrEoL + EmuColor (Att), 0);
  ComWrite (#13, 0);
End;

Function MoreNums (Var Nums: String; EnterNums: String): Boolean;
Var
  ATT, i        : Byte;
  S             : String;

Label
  ReChoice,
  EoP;

Begin
  MoreNums := True;
  If Not R. More Then Exit;
  Inc (MoreLines);

  If MoreLines < R. Lines Then Exit;
  MoreLines := 1;

  ATT := TextAttr;
  ScreenOut^. StopBuffering;

  ReChoice:
  i := MenuBar (#13+lang (laMoreNums), '1234567890'#13 + lang (laYesNoKeys));
{$IFDEF WIN32}
  If Application. Terminated Then Exit;
{$ENDIF}

  Case i Of
    1..10  : Begin
               ComWrite (#13 + EmuClrEoL, 0);
               ComWrite (EnterNums, eoCodes + eoMacro);
               If i = 10 Then i := 0;
               S := Long2Str (i);

               If R. HotKeys Then
                 KeyBufAdd (S [1])
               Else
                 HotKeysStr := S + HotKeysStr;

               ComRead (Nums, 45, ofAllowEmpty);
               Nums := Trim (Nums);

             {$IFDEF WIN32}
               If Application. Terminated Then Exit;
             {$ENDIF}

               If (Nums = '') Or (Not ConsistsOf (Nums, ['0'..'9', '-', ' '])) Then
               Begin
                 ComWrite (#13 + EmuClrEoL, 0);
                 GoTo ReChoice;
               End Else
                 GoTo EoP;
             End;
    11, 12 : ;
    13     : MoreNums := False;
  End;

  EoP:
  ComWrite (#13 + EmuClrEoL + EmuColor (Att), 0);
End;

Procedure SetInput;
Begin
  InAllow. RemIn := Rem;
  InAllow. ConIn := Con;
End;

Procedure SetOutput;
Begin
  ScreenOut^. EnablePortOut := Rem;
  ScreenOut^. EnableScreenOut := Con;
End;

Procedure SetInputCap;
Begin
  Mode := CurMode;
  InputAccept := AcceptSet;
End;

Procedure DispFile;
Const
  dFileBuf = 1024;

Var
  File2Disp  : File;
  rBuf       : Array [1..dFileBuf] Of Byte;
  rResult, i : SysInt;

Label
  EoP;

Begin
  System. FileMode := Open_Access_ReadOnly;
  SetDebugFile (Name);

  Assign (File2disp, Name);
  Reset (File2disp, 1);

  If IOResult <> 0 Then
  Begin
    LogWrite ('!', sm (smFileOpenErr) + Name);
    Exit;
  End;

  System. FileMode := Open_Access_ReadWrite;

  UpdateUserMacro;
  ScreenOut^. StartBuffering;
  ScreenOut^. UseMacroTable1 := True;

  Repeat
    BlockRead (File2Disp, rBuf, dFileBuf, rResult);
    Clock2;
    If DrawAborted Then GoTo EoP;
    For i := 1 To rResult Do ScreenOut^. OutByte (rBuf [i]);
  Until (rResult <> dFileBuf);

  EoP:
  ScreenOut^. StopBuffering;
  ScreenOut^. UseMacroTable1 := False;
  Close (File2disp);

{$IFDEF WIN32}
  MainForm. Console1. ShowCursor;
  MainForm. Console1. Paint;
{$ENDIF}
End;

Function fEmuDispFile (F: String): Boolean;
Const
  Displayed     : Boolean = False;
  Reserved      : Boolean = False;

Var
  F1            : PathStr;
  i             : Byte;

Begin
  If F [1] = '~' Then
  Begin
    F := Copy (F, 2, 255);
    Reserved := True;
  End Else
    Reserved := False;

  If Reserved and (Length (F) < 8) Then
  For i := 0 To 9 Do
  Begin
    If i > 0 Then F1 := F + Long2Str (i) Else F1 := F;
    F1 := DefaultName (F1, EmuExt [R. Emu], lang (laTxtFiles));
    If FileExists (F1) Then DispFile (F1);
  End Else
  Begin
    F1 := DefaultName (F, EmuExt [R. Emu], lang (laTxtFiles));
    Displayed := FileExists (F1);
    If Displayed Then DispFile (F1);
  End;

  fEmuDispFile := Displayed;
End;

Procedure Frame;
Var
  ATT: Byte;

Begin
  If R. Frames and (EmuGoToXY (1, 1) <> '') Then
  Begin
    ATT := TextAttr;
    ComWriteLn (EmuColor (Cnf. ColorScheme [scFrames]) + EmuGotoXY (1, R. Lines - 4) +
                'Ö' + Replicate ('Ä', 76) + '·', 0);
    ComWriteLn ('º' + Replicate (' ', 76) + 'º', 0);
    ComWriteLn ('Ó' + Replicate ('Ä', 76) + '½' + EmuColor (Att), 0);

    ComWrite (EmuCursorUp (2) + EmuCursorRight (2), 0);
  End;
End;

Function fEmuColor (Attr: Byte): String;
Begin
  If R. Emu = teAnsi        Then fEmuColor := ANSIColor (Lo4 (Attr), Hi4 (Attr))
  Else If R. Emu = teAvatar Then fEmuColor := AvtColor (Lo4 (Attr), Hi4 (Attr))
  Else If R. Emu = teTty    Then fEmuColor := '';
End;

Function fEmuGotoXY (X, Y: Byte): String;
Begin
  If R. Emu = teAnsi        Then fEmuGotoXY := ANSIGotoXY (X, Y)
  Else If R. Emu = teAvatar Then fEmuGotoXY := AvtGotoXY (X, Y)
  Else If R. Emu = teTty    Then fEmuGotoXY := '';
End;

Function fEmuCursorLeft (X: Byte): String;
Begin
  If R. Emu = teAnsi        Then fEmuCursorLeft := ANSILeft (X)
  Else If R. Emu = teAvatar Then fEmuCursorLeft := AvtLeft (X)
  Else If R. Emu = teTty    Then fEmuCursorLeft := Replicate (#8, X);
End;

Function fEmuCursorRight (X: Byte): String;
Begin
  If R. Emu = teAnsi        Then fEmuCursorRight := ANSIRight (X)
  Else If R. Emu = teAvatar Then fEmuCursorRight := AvtRight (X)
  Else If R. Emu = teTty    Then fEmuCursorRight := Replicate (' ', X);
End;

Function fEmuCursorUp (X: Byte): String;
Begin
  If R. Emu = teAnsi        Then fEmuCursorUp := ANSIUp (X)
  Else If R. Emu = teAvatar Then fEmuCursorUp := AvtUp (X)
  Else If R. Emu = teTty    Then fEmuCursorUp := '';
End;

Function fEmuCursorDown (X: Byte): String;
Begin
  If R. Emu = teAnsi        Then fEmuCursorDown := ANSIDown (X)
  Else If R. Emu = teAvatar Then fEmuCursorDown := AvtDown (X)
  Else If R. Emu = teTty    Then fEmuCursorDown := '';
End;

Function fEmuCls: String;
Begin
  If R. Emu = teAnsi        Then fEmuCls := #27'[2J'
  Else If R. Emu = teAvatar Then fEmuCls := ^L
  Else If R. Emu = teTty    Then fEmuCls := ^L;
End;

Function fEmuClrEoL: String;
Begin
  If R. Emu = teAnsi        Then fEmuClrEoL := #27'[K'
  Else If R. Emu = teAvatar Then fEmuClrEoL := ^V^G
  Else If R. Emu = teTty    Then fEmuClrEoL := Replicate (' ', 79-WhereX) + Replicate (#8, 79-WhereX);
End;

Procedure oPort (B: Byte);
Begin
  PutChar (P, Chr (B));
End;

Procedure soPort (S: String);
Begin
  PutString (P, S);
End;

Procedure oScreen (B: Byte);
Begin
  If R. Emu = teAnsi Then
  Begin
    WriteCharAnsi (Chr (B));
    Exit;
  End Else
  If R. Emu = teTty Then
  Begin
    If B = 7 Then TorSoundBell Else Write (Chr (B));
    Exit;
  End Else
  If R. Emu = teAvatar Then WriteCharAvt (Chr (B));
End;

Procedure soScreen (S: String);
Var
{$IFDEF WIN32}
  i : Byte;
{$ENDIF}
  S1 : String;

Begin
  If R. Emu = teAnsi Then WriteStringAnsi (S) Else
  If R. Emu = teTty Then
  Begin
    i := 1;

    While i <> 0 Do
    Begin
      i := Pos (#12, S);

      If i <> 0 Then
      Begin
        S1 := Copy (S, 1, i-1);
        S := Copy (S, i+1, 255);
      End Else
        S1 := S;

      If i <> 0 Then ClrScr Else Write (S1);
    End;

  End Else
  If R. Emu = teAvatar Then WriteStringAvt (S);
End;

Procedure ProcessChoices;
Begin
  If Not R. HotKeys Then
  Begin
    InputAccept := AllChars;
    Mode := NoCaps;

    If (Length (HotKeysStr) > 0) {and (KeyBuffer <> '')} Then
    Begin
      KeyBufAdd (HotKeysStr [1]);
      HotKeysStr := Copy (HotKeysStr, 2, 255);
    End Else
    Begin
      HotKeysStr := '';
      ComRead (HotKeysStr, HotLength, ofAllowEmpty);
    {$IFDEF WIN32}
      If Application. Terminated Then Exit;
    {$ENDIF}
      ComWrite (Replicate (#8, Length (HotKeysStr)), 0);

      If HotKeysStr <> '' Then
      Begin
        KeyBufAdd (HotKeysStr [1]);
        HotKeysStr := Copy (HotKeysStr, 2, 255);
      End Else KeyBufAdd (#13);
    End;
  End;
End;

Function ZeroMsg (Param: String; CR: Boolean): String;
Var
  Msg   : String;

Begin
  Msg := param;
  Msg := PlaceSubStr (Msg, '\00', '');
  Msg := PlaceSubStr (Msg, '\01', '');
  Msg := PlaceSubStr (Msg, '\02', '');
  Msg := PlaceSubStr (Msg, '\03', '');
  Msg := PlaceSubStr (Msg, '\04', '');
  Msg := PlaceSubStr (Msg, '\05', '');
  Msg := PlaceSubStr (Msg, '\06', '');
  Msg := PlaceSubStr (Msg, '\07', '');
  Msg := PlaceSubStr (Msg, '\08', '');
  Msg := PlaceSubStr (Msg, '\09', '');
  Msg := PlaceSubStr (Msg, '\10', '');
  Msg := PlaceSubStr (Msg, '\11', '');
  Msg := PlaceSubStr (Msg, '\12', '');
  Msg := PlaceSubStr (Msg, '\13', '');
  Msg := PlaceSubStr (Msg, '\14', '');
  Msg := PlaceSubStr (Msg, '\15', '');
  Msg := PlaceSubStr (Msg, '%00', '');
  Msg := PlaceSubStr (Msg, '%01', '');
  Msg := PlaceSubStr (Msg, '%02', '');
  Msg := PlaceSubStr (Msg, '%03', '');
  Msg := PlaceSubStr (Msg, '%04', '');
  Msg := PlaceSubStr (Msg, '%05', '');
  Msg := PlaceSubStr (Msg, '%06', '');
  Msg := PlaceSubStr (Msg, '%07', '');
  Msg := PlaceSubStr (Msg, '%08', '');
  Msg := PlaceSubStr (Msg, '%09', '');
  Msg := PlaceSubStr (Msg, '%10', '');
  Msg := PlaceSubStr (Msg, '%11', '');
  Msg := PlaceSubStr (Msg, '%12', '');
  Msg := PlaceSubStr (Msg, '%13', '');
  Msg := PlaceSubStr (Msg, '%14', '');
  Msg := PlaceSubStr (Msg, '%15', '');
  If CR Then Msg := PlaceSubStr (Msg, '|', '');
  ZeroMsg := Msg;
End;

Function ZeroBackGround (Param: String): String;
Var
  Msg   : String;

Begin
  Msg := param;
  Msg := PlaceSubStr (Msg, '%00', '');
  Msg := PlaceSubStr (Msg, '%01', '');
  Msg := PlaceSubStr (Msg, '%02', '');
  Msg := PlaceSubStr (Msg, '%03', '');
  Msg := PlaceSubStr (Msg, '%04', '');
  Msg := PlaceSubStr (Msg, '%05', '');
  Msg := PlaceSubStr (Msg, '%06', '');
  Msg := PlaceSubStr (Msg, '%07', '');
  Msg := PlaceSubStr (Msg, '%08', '');
  Msg := PlaceSubStr (Msg, '%09', '');
  Msg := PlaceSubStr (Msg, '%10', '');
  Msg := PlaceSubStr (Msg, '%11', '');
  Msg := PlaceSubStr (Msg, '%12', '');
  Msg := PlaceSubStr (Msg, '%13', '');
  Msg := PlaceSubStr (Msg, '%14', '');
  Msg := PlaceSubStr (Msg, '%15', '');
  Msg := PlaceSubStr (Msg, '|', '');
  ZeroBackGround := Msg;
End;

{$IFNDEF WIN32}
Procedure SwitchStatusBar;
Var
  WYZ, WXZ      : Byte;

Begin
  If StatusBarEnable Then
  Begin
    WXZ := WhereX;
    WYZ := WhereY;
    If ScreenOut^. EnableScreenOut Then HiddenCursor;

    StatusBar := (Not StatusBar);

    If StatusBar Then
    If WYZ > ScrY - 1 Then
    Begin
      ScrollWindowUp (1, 1, ScrX, ScrY + 1, 2);
      Dec (WYZ, 2);
    End;

    If StatusBar Then
      Window (1, 1, ScrX + 1, ScrY - 1)
    Else
      Window (1, 1, ScrX + 1, ScrY + 1);

    If Not StatusBar Then
    Begin
      FastWrite (Replicate (' ', ScrX + 1), ScrY, 1, $00);
      FastWrite (Replicate (' ', ScrX + 1), ScrY + 1, 1, $00);
    End Else
    Begin
      FastWrite (Replicate (' ', ScrX + 1), ScrY, 1, $70);
      FastWrite (Replicate (' ', ScrX + 1), ScrY + 1, 1, $70);
    End;

    ShowStatusBar;
    If ScreenOut^. EnableScreenOut Then NormalCursor;
    GotoXY (WXZ, WYZ);
  End;
End;
{$ENDIF}

Procedure DoCommand (S: String);
Var
  k : Byte;
  C : Char;

Begin
  For k := 1 To Length (S) Do
  Begin

    C := S [k];

    Case C Of
      '|' : PutChar (P, #13);
      '^' : SetDTR (P, True);
      'v' : SetDTR (P, False);
      '~' : Pause (500);
      '''': Pause (100);
    Else
      PutChar (P, C);
    End;

  End;
End;

Procedure HangUp;
Begin
  SetModem (P, True, True);
  If CheckDCD (P) Or LocalOffHook Then DoCommand (Cnf. HangUpString);
  SetModem (P, False, False);
End;

Procedure ClearBuffer;
Var
  C     : Char;

Begin
  If InAllow. ConIn Then While KeyPressed Do ReadKey;
  If InAllow. RemIn Then While CharReady (P) Do GetChar (P, C);
End;

Function RemoteAnsiDetected : Boolean;
Var
  Tmp   : String [20];
  C     : Char;
  Timer : EventTimer;

Begin
  PutString (P, #27'[6n'#13'    '#13);
  NewTimerSecs (Timer, 2);
  Tmp := '';

  While Not TimerExpired (Timer) Do
  Begin
  {$IFDEF WIN32}
    Application. ProcessMessages;
  {$ENDIF}
    If CharReady (P) Then
    Begin
      NewTimerSecs (Timer, 2);
      GetChar (P, C);
      Tmp := Tmp + C;
    End;
  End;

(*
  NewTimerSecs (Timer, 7);

  While (Not {$IFNDEF WIN32} CharReady (P) {$ELSE} P. CharReady {$ENDIF}) And
             {$IFNDEF WIN32} CheckDCD (P) {$ELSE} P. DCD {$ENDIF} Do
  Begin
    TimeSlice;
    If TimerExpired (Timer) Then
    Begin
      RemoteAnsiDetected := False;
      Exit;
    End;
  End;
  Tmp := '';

  NewTimerSecs (Timer, 4);
  While {$IFNDEF WIN32} CheckDCD (P) {$ELSE} P. DCD {$ENDIF} Do
  Begin
    TimeSlice;
    If TimerExpired (Timer) Then Break;
    If {$IFNDEF WIN32} CharReady (P) {$ELSE} P. CharReady {$ENDIF} And
       {$IFNDEF WIN32} CheckDCD (P) {$ELSE} P. DCD {$ENDIF} Then
    Begin
      {$IFNDEF WIN32} GetChar (P, C); {$ELSE} C := P. GetChar; {$ENDIF}
      Tmp := Tmp + C;
      If Length (Tmp) > 19 Then Break;
      NewTimerSecs (Timer, 4);
    End;
  End;
*)

  RemoteAnsiDetected := (Tmp [1] = #27);
End;

Procedure Chat;
Var
  k                            : Char;
  oLRColor, OnSysOpSide        : Boolean;
  S, UsrS, SysS, NoneS         : String;
  sLineNum, uLineNum           : LongInt;
  SysOpX1, SysOpY1, SysOpX2,
  SysOpY2, UserX1, UserY1,
  UserX2, UserY2               : Byte;

Type
  tDoChar = (dcSysOp, dcUser, dcNone);

Procedure EndOfLine (Mode: tDoChar);
Var
  i : LongInt;

Begin
  Case Mode Of

    dcSysOp : Begin
                Inc (sLineNum);
                SysOpText^. Insert (NewStr (sysS));
                SysS := '';

                If sLineNum > SysOpY2-Cnf. ChatSysY1 Then
                Begin
                  For i := SysOpText^. Count-SysOpY2+Cnf. ChatSysY1 To SysOpText^. Count-1 Do
                  Begin
                    ComWrite (EmuGoToXY (Cnf. ChatSysX1, Cnf. ChatSysY1+i-(
                      SysOpText^. Count-SysOpY2+Cnf. ChatSysY1)), 0);
                    ComWrite (PadCh (GetStr (SysOpText^. At (i)), ' ',
                      SysOpX2-Cnf. ChatSysX1), 0);
                  End;
                  ComWrite (EmuGoToXY (Cnf. ChatSysX1, SysOpY2), 0);
                  ComWrite (Replicate (' ', SysOpX2-Cnf. ChatSysX1) + Replicate (#8, SysOpX2-Cnf. ChatSysX1), 0);
                  Dec (sLineNum);
                End;

                ComWrite (EmuGoToXY (Cnf. ChatSysX1, Cnf. ChatSysY1+sLineNum), 0);
              End;

     dcUser : Begin
                Inc (uLineNum);
                UserText^. Insert (NewStr (UsrS));
                UsrS := '';

                If uLineNum > UserY2-Cnf. ChatUserY1 Then
                Begin
                  For i := UserText^. Count-UserY2+Cnf. ChatUserY1 To UserText^. Count-1 Do
                  Begin
                    ComWrite (EmuGoToXY (Cnf. ChatUserX1, Cnf. ChatUserY1+i-(
                      UserText^. Count-UserY2+Cnf. ChatUserY1)), 0);
                    ComWrite (PadCh (GetStr (UserText^. At (i)), ' ',
                      UserX2-Cnf. ChatUserX1), 0);
                  End;
                  ComWrite (EmuGoToXY (Cnf. ChatUserX1, UserY2), 0);

                  ComWrite (Replicate (' ', UserX2-Cnf. ChatUserX1) +
                    Replicate (#8, UserX2-Cnf. ChatUserX1), 0);

                  Dec (uLineNum);
                End;

                ComWrite (EmuGoToXY (Cnf. ChatUserX1, Cnf. ChatUserY1+uLineNum), 0);
              End;

     dcNone : Begin
                If Cnf. ChatLog <> '' Then WriteLn (ChatLog, noneS);
                noneS := '';
                ComWriteLn ('', 0);
              End;
  End;
End;

Procedure DoChar (K: Char; Mode: tDoChar);
Var
  LastWord, S   : String;
  maxLen        : Byte;
  i, LastItem   : LongInt;

Begin
  Case Mode Of
    dcSysOp : Begin
                S := sysS;
                maxLen := SysOpX2-Cnf. ChatSysX1;
              End;
     dcUser : Begin
                S := usrS;
                maxLen := UserX2-Cnf. ChatUserX1;
              End;
     dcNone : Begin
                S := noneS;
                maxLen := 78;
              End;
  End;

  Case K Of

    #7 : ComWrite (#7, 0);

    #8 : If Length (S) > 0 Then
         Begin
           SetLength (S, Length (S) - 1);
           ComWrite (#8#32#8, 0);
         End;

   #13 : Begin
           EndOfLine (Mode);
           S := '';
         End;

   #24 : Begin
           ComWrite (
             Replicate (#8, Length (S)) +
             Replicate (' ', Length (S)) +
             Replicate (#8, Length (S)),
           0);

           S := '';
         End;

   #18 : If Mode <> dcNone Then
         Begin
           If OnSysOpSide Then
           Begin
             SysOpX1 := WhereX;
             SysOpY1 := WhereY;
           End Else
           Begin
             UserX1 := WhereX;
             UserY1 := WhereY;
           End;

           EmuDispFile ('chtframe');
           ComWrite (EmuColor (Cnf. ColorScheme [chtText]), 0);

           LastItem := SysOpText^. Count-SysOpY2+Cnf. ChatSysY1;
           If LastItem < 0 Then LastItem := 0;

           For i := SysOpText^. Count-1 DownTo LastItem Do
           Begin
             ComWrite (fEmuGoToXY (Cnf. ChatSysX1, Cnf. ChatSysY1+i-LastItem), 0);
             ComWrite (PadCh (GetStr (SysOpText^. At (i)), ' ', SysOpX2-Cnf. ChatSysX1), 0);
           End;

           ComWrite (fEmuGoToXY (Cnf. ChatSysX1, SysOpY1) + SysS, 0);

           LastItem := UserText^. Count-UserY2+Cnf. ChatUserY1;
           If LastItem < 0 Then LastItem := 0;

           For i := UserText^. Count-1 DownTo LastItem Do
           Begin
             ComWrite (fEmuGoToXY (Cnf. ChatUserX1, Cnf. ChatUserY1+i-LastItem), 0);
             ComWrite (PadCh (GetStr (UserText^. At (i)), ' ', UserX2-Cnf. ChatUserX1), 0);
           End;

           ComWrite (fEmuGoToXY (Cnf. ChatUserX1, UserY1) + UsrS, 0);

           OnSysOpSide := False;
         End;
  Else
    If K in [#32..#255] Then
    Begin
      S := S + K;
      ComWrite (K, 0);

      If Length (S) > maxLen Then
      Begin
        If WordCount (S, [' ']) > 1 Then
        Begin
          If S [maxLen+1] = ' ' Then LastWord := '' Else LastWord := ExtractWord (WordCount (S, [' ']), S, [' ']);
          SetLength (S, Length (S) - Length (LastWord));
        End Else
        Begin
          LastWord := Copy (S, maxLen+1, 255);
          SetLength (S, maxLen);
        End;

        ComWrite (Replicate (#8, Length (LastWord)) +
        Replicate (' ', Length (LastWord)), 0);

        Case Mode Of
         dcSysOp : sysS := S;
          dcUser : usrS := S;
          dcNone : noneS := S;
        End;

        EndOfLine (Mode);
        S := LastWord;
        ComWrite (S, 0);
      End;
    End;

  End;

  Case Mode Of
    dcSysOp : sysS := S;
     dcUser : usrS := S;
     dcNone : noneS := S;
  End;
End;

Procedure FramedChat;
Var
  C : Char;
  i : LongInt;

Begin
  SysOpX1 := Cnf. ChatSysX1;  SysOpY1 := Cnf. ChatSysY1;
  SysOpX2 := Cnf. ChatSysX2;  SysOpY2 := Cnf. ChatSysY2;
  UserX1  := Cnf. ChatUserX1; UserY1  := Cnf. ChatUserY1;
  UserX2  := Cnf. ChatUserX2; UserY2  := Cnf. ChatUserY2;

  EmuDispFile ('chtframe');
  ComWrite (EmuGoToXY (SysOpX1, SysOpY1) + EmuColor (Cnf. ColorScheme [chtText]), 0);
  OnSysOpSide := True; sysS := ''; usrS := '';
  sLineNum := 0; uLineNum := 0;
  SysOpText := New (PNotSortedCollection, Init (10, 2));
  UserText := New (PNotSortedCollection, Init (10, 2));

  Repeat
    C := ComReadKey;

    If FromKeyBoard Then
    Begin
      If C = #27 Then Break;

      If Not OnSysOpSide Then
      Begin
        UserX1 := WhereX;
        UserY1 := WhereY;
        ComWrite (EmuGoToXY (SysOpX1, SysOpY1), 0);
        OnSysOpSide := Not OnSysOpSide;
      End;

      DoChar (C, dcSysOp);
    End Else
    Begin
      If OnSysOpSide Then
      Begin
        SysOpX1 := WhereX;
        SysOpY1 := WhereY;
        ComWrite (EmuGoToXY (UserX1, UserY1), 0);
        OnSysOpSide := Not OnSysOpSide;
      End;

      DoChar (C, dcUser);
    End;

  Until {$IFDEF WIN32} Application. Terminated {$ELSE} False {$ENDIF};

  WriteLn (ChatLog, '*** [ ' + Cnf. SysOp + ' ]');
  With SysOpText^ Do For i := 0 To Count-1 Do WriteLn (ChatLog, GetStr (At (i)));
  WriteLn (ChatLog);
  WriteLn (ChatLog, '*** [ ' + R. Name + ' ]');
  With UserText^ Do For i := 0 To Count-1 Do WriteLn (ChatLog, GetStr (At (i)));

  WriteLn (ChatLog);
  Dispose (SysOpText, Done);
  Dispose (UserText, Done);
End;

Procedure InternalChat;
Begin
  InChat := True;
  oLRColor := False;

  If Cnf. ChatLog <> '' Then
  Begin
    Assign (ChatLog, Cnf. ChatLog);
    ReSet (ChatLog);
    If IOResult = 0 Then
    Begin
      Append (ChatLog);
      WriteLn (ChatLog);
    End Else
      ReWrite (ChatLog);
  End;

  If IOResult <> 0 Then
  Begin
  {$IFNDEF WIN32}
    HiddenCursor;
    CenterTempBox (Cnf. ColorScheme [cdFrame], Cnf. ColorScheme [cdButton],
    1, sm (smInvalidFN), ZoomSpeed, sm (smWarningWinTitle));
    NormalCursor;
  {$ENDIF}
    Cnf. ChatLog := '';
  End;

  S := PlaceSubStr (sm (smChatLogOpened), '%ver%', NameVer);
  S := PlaceSubStr (S, '%username%', R. Name);
  S := PlaceSubStr (S, '%timestamp%', ReFormatDate (StrDate, 'DD-MM-YYYY',
  Cnf. DateMask) + ' ' + StrTime);

  ComWrite (lang (laBeginChat), eoMacro + eoCodes);
  If Cnf. ChatLog <> '' Then WriteLn (ChatLog, S);
  { *** End of chat prepare *** }

  If (R. Emu = teTTY) Or Not Cnf. ChatStyle Then
  Begin
    noneS := '';
    If Cnf. ChatLog <> '' Then WriteLn (ChatLog);
    ComWrite (EmuColor ($0E), 0);

    Repeat
      K := ComReadKey;
    {$IFDEF WIN32}
      If Application. Terminated Then Exit;
    {$ENDIF}

      If Not (K In [#10, #0]) Then
      If K in [#8, #13, #32..#255] Then
      Begin
        If FromKeyBoard <> oLRColor Then
        If FromKeyboard Then ComWrite (EmuColor ($0F), 0) Else ComWrite (EmuColor ($0E), 0);
        oLRColor := FromKeyBoard;
        DoChar (K, dcNone);
      End;

    Until (FromKeyboard And (K = #27));
  End Else
    FramedChat;

  ComWrite (lang (laEndChat), eoMacro + eoCodes);
  InChat := False;

  If Cnf. ChatLog <> '' Then
  Begin
    WriteLn (ChatLog, #13#10 + sm (smChatLogClosed));
    Close (ChatLog);
  End;
End;

Begin
  If ManualChat Then ComSaveScreen;
  ComWrite (EmuColor ($07), 0);
  If InLightBarMenu And ManualChat Then Cls Else SmartLine;
  If Cnf. ChatTimeSuspend Then SuspendTime;
  If Cnf. ExternalChat = '' Then InternalChat Else DosShell (TranslateExecParams (Cnf. ExternalChat), exCommand, False);
  If Cnf. ChatTimeSuspend Then UnSuspendTime;
  If ManualChat Then ComRestoreScreen (False);
  WantsChat := False;
End;

Procedure ReadSystemStatus;
Var
  F     : File Of SystemType;
  S1    : SystemType;

Begin
  Wait4Flag  ('sysfile.tbf');
  SetFlag ('sysfile.tbf');

  FileMode := Open_Access_ReadOnly;

  Assign (F, FN);
  Reset (F);

  FileMode := Open_Access_ReadWrite;

  Read (F, S1);

  If IOResult = 100 Then
  Begin
    Close (F);
    Erase (F);
  End Else
  Begin
    System := S1;
    Close (F);
  End;

  DelFlag ('sysfile.tbf');
End;

Procedure WriteSystemStatus;
Var
  F     : File Of SystemType;

Begin
  Wait4Flag  ('sysfile.tbf');
  SetFlag ('sysfile.tbf');

  Assign (F, FN);
  Rewrite (F);
  Write (F, System);
  Close (F);

  DelFlag ('sysfile.tbf');
End;

Procedure SaveLastCaller (Name: String; Line: Byte; LoginTime: String;
                          Date, TimeOnLine, ULkb, DLkb: LongInt);
Var
  LastCallFile, tLastCallFile   : File Of tLastCaller;
{$IFDEF WIN32}
  H                             : THandle;
{$ENDIF}
  LC, tLC                       : tLastCaller;
  FTime                         : {$IFNDEF WIN32} LongInt {$ELSE} Integer {$ENDIF};
  FDate                         : DateTime;
  Year, Month, Day
  {$IFNDEF WIN32}, DayOfWeek
  {$ENDIF}                      : {$IFNDEF WIN32} SysInt {$ELSE} Word {$ENDIF};

Label
  EoP;

Begin
  Wait4Flag ('lcfile.tbf');
  SetFlag ('lcfile.tbf');

{$IFDEF WIN32}
  H := FileOpen (Cnf. Path + 'lastcall.tor', fmOpenRead or fmShareDenyNone);
  FTime := FileGetDate (H);
  FileClose (H);
{$ENDIF}

  Assign (LastCallFile, Cnf. Path + 'lastcall.tor');
  If FileExists (Cnf. Path + 'lastcall.tor') Then ReSet (LastCallFile) Else ReWrite (LastCallFile);

{$IFNDEF WIN32}
  GetFTime (LastCallFile, FTime);
  GetDate (Year, Month, Day, DayOfWeek);
{$ELSE}
  DecodeDate (Now, Word (Year), Word (Month), Word (Day));
{$ENDIF}
  UnPackTime (FTime, FDate);

  If (FDate. Day <> Day) Or
     (FDate. Month <> Month) Or
     (FDate. Year <> Year)
  Then ReWrite (LastCallFile);

  LC. Name := Name;
  LC. Line := Line;
  LC. LoginTime := LoginTime;
  LC. Date := Date;
  LC. TimeOnLine := TimeOnLine;
  LC. ULkb := ULkb;
  LC. DLkb := DLkb;

  Assign (tLastCallFile, Cnf. TempDir + 'lastcall.t$$');
  ReWrite (tLastCallFile);
  If IOResult <> 0 Then
  Begin
    Close (LastCallFile);
    GoTo EoP;
  End;

  While Not EoF (LastCallFile) Do
  Begin
    Read (LastCallFile, tLC);
    Write (tLastCallFile, tLC);
  End;

  Write (tLastCallFile, LC); Close (tLastCallFile);
  Close (LastCallFile); Erase (LastCallFile);
  tRenameFile (Cnf. TempDir + 'lastcall.t$$', Cnf. Path + 'lastcall.tor');
  If IOResult <> 0 Then;

  EoP:
  DelFlag ('lcfile.tbf');
End;

Function ReadLastCaller (Var LC: tLastCaller; Mode: tRLCmode): Boolean;
Var
  FTime, Poz                    : LongInt;
  FDate                         : DateTime;
  Year, Month, Day
{$IFNDEF WIN32},
  DayOfWeek
{$ENDIF}                        : {$IFNDEF WIN32} SysInt {$ELSE} Word {$ENDIF};
{$IFDEF WIN32}
  H                             : THandle;
{$ENDIF}

Begin
  ReadLastCaller := True;

  Case Mode Of
    trlcOpen4Stat, trlcOpen4All :
                  Begin
                    Wait4Flag  ('lcfile.tbf');
                    SetFlag ('lcfile.tbf');
                  {$IFDEF WIN32}
                    H := FileOpen (Cnf. Path + 'lastcall.tor', fmOpenRead or fmShareDenyNone);
                    FTime := FileGetDate (H);
                    FileClose (H);
                  {$ENDIF}
                    Assign (lcFile, Cnf. Path + 'lastcall.tor');
                    ReSet (lcFile);

                    If IOResult <> 0 Then
                    Begin
                      ReadLastCaller := False;
                      Exit;
                    End;

                    If Mode = trlcOpen4Stat Then
                    Begin
                      Poz := FileSize (lcFile);
                    {$IFNDEF WIN32}
                      If Poz <=8 Then Poz := 0 Else Dec (Poz, 8);
                    {$ELSE}
                      Poz := 0;
                    {$ENDIF}
                      Seek (lcFile, Poz);
                    End;

                    If IOResult <> 0 Then
                    Begin
                      ReadLastCaller := False;
                      Exit;
                    End;
                  {$IFNDEF WIN32}
                    GetFTime (lcFile, FTime);
                    GetDate (Year, Month, Day, DayOfWeek);
                  {$ELSE}
                    DecodeDate (Now, Word (Year), Word (Month), Word (Day));
                  {$ENDIF}
                    UnPackTime (FTime, FDate);
                    If FDate. Day <> Day Then ReWrite (lcFile);
                  End;

    trlcRead    : Begin
                    Read (lcFile, LC);
                    If IOResult <> 0 Then ReadLastCaller := False;
                  End;

    trlcClose   : Begin
                    Close (lcFile);
                    DelFlag ('lcfile.tbf');
                  End;
  End;
End;

Procedure UpdateUserMacro;
Var
  SelNum        : Word;

Begin
  With ScreenOut^. MacroTable1^ Do
  Begin
    ReplaceMacro ('NAME', R. Name);
    ReplaceMacro ('FNAM', ExtractWord (1, R. Name, [' ']));
    ReplaceMacro ('LNAM', Copy (R. Name, Pos (' ', R. Name)+1, 255));
    ReplaceMacro ('ALAS', R. Alias);
    ReplaceMacro ('PSWD', R. Password);
    ReplaceMacro ('DAOB', ReFormatDate (Long2Date (R. BirthDate), DefaultDateMask, Cnf. DateMask));
    ReplaceMacro ('LOCA', R. Location);
    ReplaceMacro ('ORGZ', R. Organization);
    ReplaceMacro ('HPHN', R. HPhone);
    ReplaceMacro ('BPHN', R. BPhone);
    ReplaceMacro ('ADR1', R. Address1);
    ReplaceMacro ('ADR2', R. Address2);
    ReplaceMacro ('ADR3', R. Address3);
    ReplaceMacro ('CMNT', R. Comment);
    ReplaceMacro ('LINS', Long2Str (R. Lines));
    ReplaceMacro ('SECR', Long2Str (R. Security));
    ReplaceMacro ('FARE', FileArea. Name);
    ReplaceMacro ('MARE', MsgArea. Name);
    ReplaceMacro ('FNUM', Long2Str (R. FileArea));
    ReplaceMacro ('FGRN', Long2Str (R. FileGroup));
    ReplaceMacro ('MNUM', Long2Str (R. MsgArea));
    ReplaceMacro ('MGRN', Long2Str (R. MsgGroup));
    ReplaceMacro ('FGRP', FileGroup. Name);
    ReplaceMacro ('MGRP', MsgGroup. Name);
    ReplaceMacro ('FGRN', Long2Str (R. FileGroup));
    ReplaceMacro ('MGRN', Long2Str (R. MsgGroup));
    ReplaceMacro ('ULDS', Long2Str (R. UpLoads));
    ReplaceMacro ('DNLS', Long2Str (R. DownLoads));
    ReplaceMacro ('TTME', Long2Str (Lim. Time));
    ReplaceMacro ('ETME', Long2Str (Round ((R. TotalTime - MidSec + EnterTime)/60)));
    ReplaceMacro ('CALN', Long2Str (R. NoCalls));
    ReplaceMacro ('FDTE', ReFormatDate (Long2Date (R. FirstDate), DefaultDateMask, Cnf. DateMask));
    ReplaceMacro ('LDTE', ReFormatDate (Long2Date (R. LastDate), DefaultDateMask, Cnf. DateMask));
    ReplaceMacro ('LTME', Word2Time (R. LastTime));
    ReplaceMacro ('PROT', ProtocolDef. Name);
    ReplaceMacro ('EMUL', EmuName [R. Emu]);
    ReplaceMacro ('MORE', Bool2Lang (R. More));
    ReplaceMacro ('HKEY', Bool2Lang (R. HotKeys));
    ReplaceMacro ('FRAM', Bool2Lang (R. Frames));
    ReplaceMacro ('FSED', Bool2Lang (R. FSEditor));
    ReplaceMacro ('LANG', lang (laName));
    ReplaceMacro ('DATE', ReFormatDate (StrDate, 'DD-MM-YYYY', Cnf. DateMask));
    ReplaceMacro ('TIME', StrTime);
    ReplaceMacro ('SELK', Long2Str (Round (SizeOfAll/1024)));

    If (F2Transfer^. Count = 0) and (SizeOfAll > 0)
    Then SelNum := 1 Else SelNum := F2Transfer^. Count;

    ReplaceMacro ('SELN', Long2Str (SelNum));
    ReplaceMacro ('LIMK', Long2Str (R. DailySize));
    ReplaceMacro ('ETTM', Long2Str (Round (EstimatedTransferTime (SizeOfAll, R. AvgCPS, GetConnectSpeed)/60)));
    ReplaceMacro ('DLKB', Long2Str (R. DownLoadsK));
    ReplaceMacro ('ULKB', Long2Str (R. UpLoadsK));
    ReplaceMacro ('LFKB', Long2Str (R. DailySize - (R. TodayK + Trunc (SizeOfAll/1024))));
    ReplaceMacro ('FLGS', R. Flags);
    ReplaceMacro ('OTME', Long2Str (Round ((MidSec - EnterTime)/60)));
    ReplaceMacro ('DLTK', Long2Str (R. TodayK));
    ReplaceMacro ('MSGP', Long2Str (R. MsgsPosted));

    ReplaceMacro ('FAGR', Long2Str (fAreasGroup));
    ReplaceMacro ('FAMT', Long2Str (fAreasAmount));
    ReplaceMacro ('FGAM', Long2Str (ffGroupsAmount));
    ReplaceMacro ('MAGR', Long2Str (mAreasGroup));
    ReplaceMacro ('MAMT', Long2Str (mAreasAmount));
    ReplaceMacro ('MGAM', Long2Str (mmGroupsAmount));
  End;
End;

Procedure TorSoundBell;
Begin
  If Cnf. Sound Then {$IFNDEF WIN32} PlaySound (220, 200) {$ELSE} Beep {$ENDIF};
End;

Procedure SaveTime;
Var
  SessionDuration : LongInt;

Begin
  If (R. Name = '') Or Registering Then Exit;
  SessionDuration := MidSec-enTime;
  If TimeSusp Then UnSuspendTime;

  If TimeCount Then
  Begin
    Dec (R. TotalTime, SessionDuration);
    Inc (R. TimeUsedToday, SessionDuration-UsedMinus);

    If R. TotalTime < 0 Then R. TotalTime := 0;
    If R. TimeUsedToday < 0 Then R. TimeUsedToday := 0;
  End;

  SaveLastCaller (R. Name, BbsLine, Copy (StrTime, 1, 5), Ent,
  Round (SessionDuration/60), SessionUL, SessionDL);

  R. LastDate := Ent;
  R. LastTime := Time2Word (StrTime);
  SaveUser (R);
End;

Procedure KeyBufAdd (S: String);
Begin
  KeyBuffer := KeyBuffer + S;
End;

Procedure RetWait;
Begin
  While (ComReadKey <> #13) {$IFDEF WIN32} And Not Application. Terminated {$ENDIF} Do;
End;

Procedure fSetSecurity;
Begin
  ReadLimit (Lim, R. Security);
  R. TotalTime := Lim. Time * 60 - ((MidSec - EnterTime) + R. TimeUsedToday);
  R. DailySize := Lim. KBLimit;
  EnterTime := MidSec;
End;

Procedure mWriteLen (S: String; L: Byte; Pad: tPadMode);
Var
  x, i : Byte;

Begin
  i := 1;
  x := WhereX;
  If Pad = pmPadLeft Then ComWrite (Replicate (' ', L-Length (ZeroMsg (S, True))), 0);

  While (WhereX < x+L) And (Length (S) >= i) Do
  Begin
    ComWrite (S [i], eoMacro+eoCodes);
    Inc (i);
  End;

  Inc (x, L);
  L := WhereX;

  If Pad = pmPadRight Then
  If L < x Then ComWrite (Replicate (' ', x-L), 0);
End;

Procedure SlashRotate;
Const
  SmCount   = 4;
  Smiles    : Array [1..SmCount] Of Char = ('|', '/', '-', '\');
  j         : Byte = 1;
  LastGluck : LongInt = 0;

Begin
  If (MidSec-LastGluck > 1) Or (MidSec-LastGluck < 0) Then
  Begin
    Inc (j);
    If j > SmCount Then j := 1;
    ComWrite (Smiles [j] + #8, 0);
    LastGluck := MidSec;
  End;
End;

Begin
  ComWrite := fComWrite;
  ComWriteLn := fComWriteLn;
  EmuColor := fEmuColor;
  EmuGotoXY := fEmuGotoXY;
  EmuCursorLeft := fEmuCursorLeft;
  EmuCursorRight := fEmuCursorRight;
  EmuCursorUp := fEmuCursorUp;
  EmuCursorDown := fEmuCursorDown;
  EmuCls := fEmuCls;
  EmuClrEoL := fEmuClrEoL;
  EmuDispFile := fEmuDispFile;
  SetSecurity := fSetSecurity;
  DrawAborted := fDrawAborted;
{$IFDEF WIN32}
  GetMem (S1, 2);
  GetMem (S2, 2);
{$ENDIF}
End.