home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / CUNIT_20 / COMUNIT.PAS < prev    next >
Pascal/Delphi Source File  |  1992-03-18  |  33KB  |  1,362 lines
  1. Unit COMUNIT;
  2.  
  3. INTERFACE
  4.  
  5. Type CharSet = Set of Char;
  6.  
  7.      UserRec = Record
  8.                  Name: String[35];     { Name of the User online   }
  9.                  City: String[25];     { City where User lives     }
  10.                  TimeLeft: word;       { Time user has left        }
  11.                  TimeOut : byte;       { Inactivity time for user  }
  12.                  Ansi    : Boolean;    { Does the user support ANSI}
  13.                end;
  14.  
  15. var Port    : byte;               {comm port 0-3}
  16.     Baud    : word;               {current connect speed}
  17.     Online  : boolean;            {whether it's a local/remote login}
  18.     Mstatus : word;               {Modem status, word}
  19.     Foreground: byte;             {foreground color, so you can check and change...}
  20.     Background: byte;             {background color so you can check and change...}
  21.     Stop      : Boolean;          {variable used for some stop procedures.}
  22.  
  23.     ModemOnly : Boolean;          {If True then output will only be sent to
  24.                                    the modem!}
  25.  
  26.     SysopName : String;           {Name of the System Operator}
  27.  
  28.     ShowStatWin: Boolean;
  29.     User       : UserRec;
  30.  
  31. Procedure Send(s: string);        {modem equivalent of write}
  32. Procedure SendLn(s: string);      {modem equivalent of writeln}
  33. Procedure ReadStr(var s  : string;
  34.                       len: byte); {read a string with max length = len}
  35. Procedure ReadInt(var int: word;
  36.                       len: byte); {read a word with max number of chars = len}
  37. Procedure EditStr(var s  : string;
  38.                       len: byte); {edit a string with max length = len,
  39.                                    if the string s has a length > len then
  40.                                    len := length(s) !! }
  41. Procedure PortColor(f: byte);     {modem equivalent of textcolor}
  42. Procedure PortBackGround(b: byte);{modem equivalent of textbackground}
  43. Procedure ClrPortScr;             {modem equivalent of clrscr}
  44. Procedure ClrPortEol;             {modem equivalent of clreol}
  45. Procedure AutoAnsiDetect;         {detect if remote has User.Ansi support}
  46. Procedure PurgeInBuffer;          {purge input buffer}
  47. Procedure PortXY(x,y: byte);      {modem equivalent of gotoXY}
  48. Procedure DisplayFile(Fname: string;
  49.                       StopKeys: CharSet;
  50.                       PauseKeys: CharSet;
  51.                       Var Ch   : Char);
  52.                                   {display a file with hotkeys in set HotKeys}
  53. Function  WaitChar(Cset: CharSet): Char;
  54.                                   {waits till a key has been pressed in
  55.                                    Cset and returns that key}
  56.  
  57. Procedure InitTimes;              {you MUST run this after assign the
  58.                                    User.TimeLeft, and User.TimeOut variables in order
  59.                                    for the unit to start counting down...}
  60. Function  PortX: byte;            {modem equivalent of wherex}
  61. Function  PortY: byte;            {modem equivalent of wherey}
  62. Function  ReadChar: Char;         {modem equivalent of readch}
  63. Function  GetStatus: word;        {returns modem status}
  64. Function  PortKeyPressed: Boolean;{modem equivalent of keypressed}
  65.  
  66. Procedure ResetCounter(num: byte;Col: byte);
  67.                                   {reset line counter to num lines
  68.                                    and with prompt color = col}
  69. Procedure StopCounter;            {stop the line counter.}
  70. Procedure HangUp;                 {Hang up the modem!}
  71.  
  72. {Other helpfull functions and procedures}
  73.  
  74. Function  Ms(l: longint): string;     {convert a word to a string fast}
  75. Function  Rep(Ch: char;b: byte): string;
  76.                                   {Return a string with filled with Ch and
  77.                                    with length b}
  78. Function  UprCase(s: string): string;
  79.                                   {convert a string to uprcase}
  80. Procedure Trim(var s: string);    {Trim all leading and trailing #0 and #32}
  81. Function  Byte_Set(b,bit: byte): Boolean;
  82.                                   {Checks to see if bit is set in b}
  83. Function  Lz(w: word): String;    {Aka Leading Zero, adds a 0 before one digit
  84.                                    numbers, handy for dates!}
  85. Procedure Chat(Full: Boolean);    {Full refers to FULL screen chat or normal
  86.                                    mode}
  87. Procedure ShowSysopStatWin;       {show sysop status window}
  88.                                   {This option isn't really finished yet, but
  89.                                    the part that is done works...}
  90. Procedure Delay(Num: byte);       {A replacement for the Delay in the CRT
  91.                                    unit. This Delay works with seconds, and
  92.                                    it works in and outside of DV}
  93.  
  94. IMPLEMENTATION
  95.  
  96. {$M 5000, 0, 262144}
  97.  
  98. {$R-}
  99.  
  100. uses dos, crt,pdl, AnsiUnit;
  101.  
  102. const  Esc = #27;
  103.  
  104.        Fore: array[0..15] of string[5] = (
  105.              '[0;30', '[0;34', '[0;32', '[0;36', '[0;31', '[0;35', '[0;33', '[0;37',
  106.              '[1;30', '[1;34', '[1;32', '[1;36', '[1;31', '[1;35', '[1;33', '[1;37');
  107.  
  108.        Back: array[0..7]  of string[4] = (
  109.              ';40m', ';44m', ';42m', ';46m', ';41m', ';45m', ';43m', ';47m');
  110.  
  111. Var StartTime,
  112.     EndTime  ,
  113.     Inactivity,
  114.     InactLimit : Longint;
  115.  
  116.     _2warned,
  117.     _1warned : boolean;
  118.     _Iwarned : Boolean;
  119.  
  120.     _CountLine: boolean;
  121.     _LineCount: byte;
  122.     _PauseCount: byte;
  123.     _CheckTime : Boolean;
  124.  
  125.     PromptColor: byte;
  126.  
  127. Procedure Delay(Num: byte);
  128.  
  129.   var StopTime,
  130.       CurTime : Longint;
  131.       Regs    : Registers;
  132.  
  133.   begin
  134.     regs.ah := $00;
  135.     intr($1A,regs);
  136.     StopTime := regs.CX*65536 + regs.DX + (Num * 18);
  137.     if StopTime > $1800B0 then StopTime := StopTime - $1800B0;
  138.     Repeat
  139.       regs.ah := $00;
  140.       intr($1A,regs);
  141.       CurTime := regs.CX*65536 + regs.DX;
  142.    Until CurTime >= StopTime;
  143.   end;
  144.  
  145. Procedure ShowSysopStatWin;
  146.  
  147.   begin
  148.     Window(1,24,80,25);
  149.     TextColor(Yellow);
  150.     TextBackGround(7);
  151.     ClrScr;
  152.     GotoXY(1,1);
  153.     Write(User.Name,', From ',User.City);
  154.     GotoXY(64,1);
  155.     Write('Baud: ',Baud);
  156.     GotoXY(1,2);
  157.     Write('Time left: ',User.TimeLeft);
  158.     Window(1,1,80,23);
  159.     TextAttr := 7;
  160.   end;
  161.  
  162. Function Lz(w: word): String;
  163.  
  164.   var s: string;
  165.  
  166.   begin
  167.     str(w,s);
  168.     if length(s) < 2 then s := '0'+s;
  169.     Lz := s;
  170.   end;
  171.  
  172. Function Byte_Set(b,bit: byte): Boolean;
  173.  
  174.   var V: byte;
  175.  
  176.   begin
  177.     V := 1 shl bit;
  178.     Byte_Set := V = V and b;
  179.   end;
  180.  
  181. Function GetBTime: Longint;
  182.  
  183.   var regs: registers;
  184.  
  185.   begin
  186.     fillchar(regs,sizeof(regs),$00);
  187.  
  188.     intr($1A,regs);
  189.     GetBTime := Regs.cx*65536+Regs.dx;
  190.   end;
  191.  
  192. Procedure InitTimes;
  193.  
  194.   begin
  195.     StartTime  := GetBTime;
  196.     EndTime    := (User.TimeLeft*60*18)+((User.TimeLeft*60*2) div 10)+GetBTime;
  197.     if EndTime > $1800B0 then EndTime := EndTime - $1800B0;
  198.     Inactivity := GetBTime;
  199.     InactLimit := User.TimeOut*60*18;
  200.     _CheckTime := True;
  201.   end;
  202.  
  203. Function Ms(l: longint): string;
  204.  
  205.   var s: string;
  206.  
  207.   begin
  208.     str(l,s);
  209.     Ms := s;
  210.   end;
  211.  
  212. Function Rep(Ch: Char;b: byte): string;
  213.  
  214.   var s: string;
  215.  
  216.   begin
  217.     fillchar(s,sizeof(s),Ch);
  218.     s[0] := chr(b);
  219.     Rep := s;
  220.   end;
  221.  
  222. Function UprCase(s: string): string;
  223.  
  224.   var j: byte;
  225.  
  226.   begin
  227.     for j := 1 to length(s) do
  228.       s[j] := upcase(s[j]);
  229.     UprCase := s;
  230.   end;
  231.  
  232. Function GetStatus: word;
  233.  
  234.   var regs: registers;
  235.  
  236.   begin
  237.     fillchar(regs,sizeof(regs),$00);
  238.  
  239.     regs.AH := $03;
  240.  
  241.     intr($14,regs);
  242.     GetStatus := regs.AH*256+regs.AL;
  243.     writeln(regs.ah);
  244.   end;
  245.  
  246. Procedure Trim(var s: string);
  247.  
  248.   begin
  249.     While (s[1] in [' ',#0]) do Delete(s,1,1);
  250.     While (s[Length(s)] in [' ',#0]) do Delete(s,Length(s),1);
  251.   end;
  252.  
  253. Procedure CarrierLost;
  254.  
  255.   begin
  256.     writeln('Carrier lost, returning to board...');
  257.     halt;
  258.   end;
  259.  
  260. Procedure CheckCarrier;
  261.  
  262.   var regs: registers;
  263.  
  264.   begin
  265.     fillchar(regs,sizeof(regs),$0);
  266.  
  267.     regs.ah := $03;
  268.     regs.dx := port;
  269.  
  270.     intr($14,regs);
  271.  
  272.     if not byte_set(regs.al, 7) then CarrierLost;
  273.   end;
  274.  
  275. Procedure ResetCounter(num: byte;Col: byte);
  276.  
  277.   begin
  278.     PromptColor := Col;
  279.     Stop := False;
  280.     _PauseCount := num;
  281.     _CountLine  := True;
  282.     _LineCount  := 0;
  283.   end;
  284.  
  285. Procedure StopCounter;
  286.  
  287.   begin
  288.     _CountLine := False;
  289.     Stop       := False;
  290.   end;
  291.  
  292. Procedure PromptContinue;
  293.  
  294.   var cnt: byte;
  295.       s  : string;
  296.       ch : char;
  297.       OldF: byte;
  298.       OldB: byte;
  299.  
  300.   begin
  301.     OldF := Foreground;
  302.     OldB := BackGround;
  303.     PortColor(PromptColor);
  304.     PortBackground(0);
  305.     Send('More [Y/n]');
  306.     ch := #255;
  307.     repeat
  308.       if PortKeyPressed then Ch := ReadChar;
  309.       ch := upcase(ch);
  310.     until ch in [#13,'Y','N'];
  311.     Stop := ch = 'N';
  312.     _LineCount := 0;
  313.     Send(Rep(#08,10)+rep(#32,10)+rep(#08,10));
  314.     PortColor(OldF);
  315.     PortBackGround(OldB);
  316.   end;
  317.  
  318. Procedure ClickCounter;
  319.  
  320.   begin
  321.     Inc(_LineCount);
  322.     if _Linecount = _PauseCount then PromptContinue;
  323.   end;
  324.  
  325. Procedure SendChar(ch: char);
  326.  
  327.   var regs: registers;
  328.  
  329.   begin
  330.     if Online then
  331.     begin
  332.       CheckCarrier;
  333.  
  334.       fillchar(regs,sizeof(regs),$00);
  335.  
  336.       regs.AH := $01;
  337.       regs.AL := ord(ch);
  338.       regs.DX := port;
  339.  
  340.       intr($14,regs);
  341.  
  342.     end;
  343.     if not ModemOnly then write(ch);
  344.   end;
  345.  
  346. Procedure Send(s: string);
  347.  
  348.   var cnt: byte;
  349.  
  350.   begin
  351.     for cnt := 1 to length(s) do
  352.       SendChar(s[cnt]);
  353.   end;
  354.  
  355. Procedure SendLn(s: string);
  356.  
  357.   var cnt: byte;
  358.  
  359.   begin
  360.     for cnt := 1 to length(s) do
  361.       SendChar(s[cnt]);
  362.     SendChar(#13);
  363.     SendChar(#10);
  364.     if _CountLine then ClickCounter;
  365.   end;
  366.  
  367. Procedure CheckTime;
  368.  
  369.   var Now: Longint;
  370.       Dtime: Longint;
  371.       Itime: Longint;
  372.       OldFore,
  373.       OldBack : byte;
  374.  
  375.   begin
  376.     if _CheckTime then
  377.     begin
  378.       Now := GetBTime;
  379.       if Now > EndTime then Dtime := $1800B0 - Now + EndTime else
  380.         Dtime := EndTime-now;
  381.       Itime := Now-InActivity;
  382.       if (Itime >= 3 * (InactLimit div 4)) and not _Iwarned then
  383.       begin
  384.         OldFore := Foreground;
  385.         OldBack := BackGround;
  386.         PortColor(12);
  387.         PortBackGround(0);
  388.         Sendln('');
  389.         Sendln('Hello?? You still alive??');
  390.         _Iwarned := True;
  391.         PortColor(OldFore);
  392.         PortBackGround(OldBack);
  393.       end;
  394.       if (Itime >= InactLimit) then
  395.       begin
  396.         OldFore := Foreground;
  397.         OldBack := BackGround;
  398.         PortColor(12);
  399.         PortBackGround(OldBack);
  400.         Sendln('');
  401.         SendLn('Inactivity time expired, returning to BBS!');
  402.         Halt;
  403.       end;
  404.       if (Dtime >= 2184) and (Dtime <= 3276) and not _2warned then
  405.       begin
  406.         OldFore := Foreground;
  407.         OldBack := BackGround;
  408.         PortColor(12);
  409.         PortBackGround(0);
  410.         Sendln('');
  411.         Sendln('Warning only 2 minutes left!');
  412.         _2warned := True;
  413.         PortColor(OldFore);
  414.         PortBackGround(OldBack);
  415.       end;
  416.       if (Dtime >= 1092) and (Dtime <= 2184) and not _1warned then
  417.       begin
  418.         OldFore := Foreground;
  419.         OldBack := BackGround;
  420.         PortColor(12);
  421.         PortBackGround(0);
  422.         Sendln('');
  423.         SendLn('Warning only 1 minute left!');
  424.         _1warned := True;
  425.         PortColor(OldFore);
  426.         PortBackGround(OldBack);
  427.       end;
  428.       if (Dtime < 500) then
  429.       begin
  430.         OldFore := Foreground;
  431.         OldBack := BackGround;
  432.         PortColor(12);
  433.         PortBackGround(0);
  434.         Sendln('');
  435.         SendLn('Less than 30 seconds left, returning to BBS');
  436.         Halt;
  437.       end;
  438.     end;
  439.   end;
  440.  
  441. Procedure PurgeInBuffer;
  442.  
  443.   var regs: registers;
  444.  
  445.   begin
  446.     fillchar(regs,sizeof(regs),$00);
  447.  
  448.     regs.AH := $0A;
  449.     regs.DX := port;
  450.  
  451.     intr($14,regs);
  452.   end;
  453.  
  454. Function PortPressed: Boolean;
  455.  
  456.   var regs: registers;
  457.  
  458.   begin
  459.     PortPressed := False;
  460.     fillchar(regs,sizeof(regs),$00);
  461.  
  462.     if Online then
  463.     begin
  464.       regs.AH := $03;
  465.       regs.DX := port;
  466.  
  467.       intr($14,regs);
  468.  
  469.       PortPressed := Byte_Set(regs.ah,0);
  470.       if not Byte_Set(regs.al,7) then CarrierLost;
  471.       if Byte_Set(regs.ah,0) then Inactivity := GetBTime;
  472.     end;
  473.   end;
  474.  
  475. Function PortKeyPressed: Boolean;
  476.  
  477.   Var Ok: Boolean;
  478.  
  479.   begin
  480.     CheckTime;
  481.     Ok := Keypressed or PortPressed;
  482.     if Ok then
  483.     begin
  484.       _1warned := False;
  485.       _2warned := False;
  486.     end;
  487.     PortKeyPressed := Ok;
  488.   end;
  489.  
  490. Procedure JumpToDos;
  491.  
  492.   Var Y: byte;
  493.  
  494.   begin
  495.     PortColor(15);
  496.     PortBackGround(0);
  497.     sendln('');
  498.     Y := WhereY;
  499.     sendln('Sysop is jumping to DOS, please wait...');
  500.     textattr := 7;
  501.     ClrScr;
  502.     swapvectors;
  503.     exec(GetEnv('COMSPEC'),'');
  504.     swapvectors;
  505.     if ShowStatWin then ShowSysopStatWin;
  506.     PortXY(1,Y);
  507.     PortColor(15);
  508.     PortBackGround(0);
  509.     sendln('Sysop has returned, thank you for waiting.');
  510.  
  511.   end;
  512.  
  513. Function ReadChar: char;
  514.  
  515.   var regs: registers;
  516.       ch  : char;
  517.  
  518.   begin
  519.     if Online and PortPressed then
  520.     begin
  521.       CheckCarrier;
  522.  
  523.       fillchar(regs,sizeof(regs),$00);
  524.  
  525.       regs.AH := $02;
  526.       regs.DX := port;
  527.  
  528.       intr($14,regs);
  529.       ReadChar := chr(regs.AL);
  530.  
  531.     end else if keypressed then
  532.     begin
  533.       Ch := readkey;
  534.       if Ch = #0 then
  535.       begin
  536.         Ch := readkey;
  537.         case Ch of
  538.           #46: Chat(not LeftShift);
  539.           #35: HangUp;
  540.           #36: JumpToDos;
  541.         end;
  542.         ReadChar := #255;
  543.       end else ReadChar := Ch;
  544.     end;
  545.   end;
  546.  
  547. Procedure ReadStr(var s  : string;
  548.                       len: byte);
  549.  
  550.   var ch: char;
  551.  
  552.   begin
  553.     s := '';
  554.     ch := #0;
  555.  
  556.     repeat
  557.       if PortKeyPressed then
  558.       begin
  559.         ch := ReadChar;
  560.  
  561.         if (ch = #08) and (length(s) > 0) then
  562.         begin
  563.           delete(s,length(s),1);
  564.           Send(#08#32#08);
  565.         end;
  566.  
  567.         if (ch = #0) then
  568.         begin
  569.           Ch := Readkey;
  570.           ch := #255;
  571.         end;
  572.  
  573.         if (ch = #27) then
  574.         begin
  575.           if PortKeyPressed then Ch := ReadChar;
  576.           if Ch = '[' then if PortKeyPressed then Ch := ReadChar;
  577.           ch := #255;
  578.         end;
  579.  
  580.         if (ch <> #08) and (ch <> #13) and (length(s) < len) and
  581.            (ch > #31) and (ch < #127) then
  582.         begin
  583.           s := s + ch;
  584.           Send(ch);
  585.         end;
  586.       end;
  587.     until (length(s) > len) or (ch = #13);
  588.   end;
  589.  
  590. Procedure ReadInt(var int: word;
  591.                       len: byte);
  592.  
  593.   var ch: char;
  594.       s : string;
  595.       code: integer;
  596.  
  597.   begin
  598.     s := '';
  599.     ch := #0;
  600.  
  601.     repeat
  602.       if PortKeyPressed then
  603.       begin
  604.         ch := ReadChar;
  605.  
  606.         if (ch = #08) and (length(s) > 0) then
  607.         begin
  608.           delete(s,length(s),1);
  609.           Send(#08#32#08);
  610.         end;
  611.  
  612.         if (ch <> #08) and (ch <> #13) and (length(s) < len) and
  613.            (ch > #47) and (ch < #58) then
  614.         begin
  615.           s := s + ch;
  616.           Send(ch);
  617.         end;
  618.       end;
  619.     until (length(s) > len) or (ch = #13);
  620.  
  621.     val(s,int,code);
  622.  
  623.   end;
  624.  
  625.  
  626. Procedure EditStr(var s  : string;
  627.                       len: byte);
  628.  
  629.   var ch: char;
  630.  
  631.   begin
  632.     ch := #0;
  633.  
  634.     Send(s);
  635.     if len < length(s) then len := length(s);
  636.  
  637.     repeat
  638.       if PortKeyPressed then
  639.       begin
  640.         ch := ReadChar;
  641.  
  642.         if (ch = #08) and (length(s) > 0) then
  643.         begin
  644.           delete(s,length(s),1);
  645.           Send(#08#32#08);
  646.         end;
  647.  
  648.         if (ch <> #08) and (ch <> #13) and (length(s) < len) and
  649.            (ch > #31) and (ch < #127) then
  650.         begin
  651.           s := s + ch;
  652.           Send(ch);
  653.         end;
  654.       end;
  655.     until (length(s) > len) or (ch = #13);
  656.   end;
  657.  
  658.  
  659. Procedure PortColor(f: byte);
  660.  
  661.   begin
  662.     if (f < 16) and User.Ansi then
  663.     begin
  664.       TextColor(f);
  665.       Foreground := f;
  666.  
  667.       ModemOnly := True;
  668.       if f < 8 then send(Esc+'[0m');
  669.       send(Esc+Fore[Foreground]+Back[BackGround]);
  670.       ModemOnly := False;
  671.     end;
  672.   end;
  673.  
  674. Procedure PortBackGround(b: byte);
  675.  
  676.   begin
  677.     if (b < 8) and User.Ansi then
  678.     begin
  679.       TextBackGround(b);
  680.       Background := b;
  681.  
  682.       ModemOnly := True;
  683.       send(Esc+'[0m');
  684.       send(Esc+Fore[Foreground]+Back[BackGround]);
  685.       ModemOnly := False;
  686.     end;
  687.   end;
  688.  
  689. Procedure ClrPortScr;
  690.  
  691.   begin
  692.     ClrScr;
  693.     ModemOnly := True;
  694.     Send(Esc+'[2J');
  695.     ModemOnly := False;
  696.   end;
  697.  
  698. Procedure ClrPortEol;
  699.  
  700.   begin
  701.     ClrEol;
  702.     ModemOnly := True;
  703.     If User.Ansi then Send(Esc+'[K');
  704.     ModemOnly := False;
  705.   end;
  706.  
  707. Procedure AutoAnsiDetect;
  708.  
  709.   var ch: char;
  710.       j : longint;
  711.  
  712.   begin
  713.     PurgeInBuffer;
  714.  
  715.     User.Ansi := False;
  716.  
  717.     if Online then
  718.     begin
  719.       ModemOnly := True;
  720.       Send(Esc+'[6n');
  721.       Send(Rep(#08,4));
  722.       ModemOnly := False;
  723.  
  724.       Delay(1);
  725.  
  726.       if PortPressed then
  727.       begin
  728.         Ch := ReadChar;
  729.         User.Ansi := Ch = 'R';
  730.       end;
  731.     end else User.Ansi := True;
  732.   end;
  733.  
  734. Procedure PortXY(x,y: byte);
  735.  
  736.   begin
  737.     if not Online then
  738.       GotoXY(x,y)
  739.     else if User.Ansi then
  740.     begin
  741.       GotoXY(x,y);
  742.       ModemOnly := True;
  743.       Send(Esc+'['+ms(y)+';'+ms(x)+'H');
  744.       ModemOnly := False;
  745.     end else
  746.     begin
  747.       if y > WhereY then Send(Rep(#10,WhereY-y));
  748.       if x > WhereX then Send(Rep(#32,WhereX-x));
  749.       if x < WhereX then Send(Rep(#08,x-WhereX));
  750.     end;
  751.   end;
  752.  
  753. Procedure DisplayFile(Fname: string;
  754.                       Stopkeys: CharSet;
  755.                       PauseKeys: CharSet;
  756.                       Var Ch   : Char);
  757.  
  758.   var f  : file;
  759.       j  : byte;
  760.       s  : string;
  761.       nr : word;
  762.       Buf: array[1..10] of char;
  763.       IO : Byte;
  764.  
  765.       Function HotKeyPressed: boolean;
  766.  
  767.         Var Ch2: Char;
  768.  
  769.         begin
  770.           HotKeyPressed := False;
  771.           if StopKeys <> [] then
  772.             if PortKeyPressed then
  773.             begin
  774.               Ch2 := Upcase(ReadChar);
  775.               if Ch2 in StopKeys then
  776.               begin
  777.                 HotKeyPressed := True;
  778.                 Ch := Ch2;
  779.               end;
  780.             end;
  781.           if PauseKeys <> [] then
  782.             if PortKeyPressed then
  783.             begin
  784.               Ch2 := Upcase(Readchar);
  785.               if Ch2 in PauseKeys then
  786.               begin
  787.                 repeat until portkeypressed;
  788.                 Ch2 := readchar;
  789.               end;
  790.             end;
  791.         end;
  792.  
  793.   begin
  794.     if Fname <> '' then
  795.     begin
  796.       if Pos('.',Fname) > 0 then Delete(Fname,pos('.',Fname),4);
  797.       if User.Ansi then Fname := Fname + '.ANS' else Fname := Fname + '.ASC';
  798.       assign(f,Fname);
  799.       {$I-} reset(f,1); {$I+}
  800.       IO := IOresult;
  801.       if (IO <> 0) and User.Ansi then
  802.       begin
  803.         if User.Ansi then Fname := copy(Fname,1,pos('.',Fname))+'ASC';
  804.         {$I-} reset(f,1); {$I+}
  805.         IO := IOresult;
  806.       end;
  807.  
  808.       If IO = 0 then
  809.       begin
  810.         ModemOnly := True;
  811.         repeat
  812.           s := '';
  813.           Blockread(f,Buf,10,nr);
  814.           For j := 1 to nr do
  815.           begin
  816.             Send(Buf[j]);
  817.             AnsiWrite(Buf[j]);
  818.           end;
  819.         Until (nr = 0) or HotKeyPressed;
  820.         ModemOnly := False;
  821.         Close(f);
  822.       end else writeln('Error: ',fname, ' not found');
  823.     end;
  824.   end;
  825.  
  826. Function PortX: byte;
  827.  
  828.   begin
  829.     PortX := WhereX;
  830.   end;
  831.  
  832. Function PortY: byte;
  833.  
  834.   begin
  835.     PortY := WhereY;
  836.   end;
  837.  
  838. Function WaitChar(Cset: CharSet): Char;
  839.  
  840.   var ch: char;
  841.  
  842.   begin
  843.     ch := #255;
  844.     repeat
  845.       if PortKeyPressed then Ch := ReadChar;
  846.       ch := Upcase(ch);
  847.     until ch in Cset;
  848.     WaitChar := Ch;
  849.   end;
  850.  
  851. Procedure HangUP;
  852.  
  853.   var regs: registers;
  854.  
  855.   begin
  856.     with Regs do
  857.     begin
  858.       Ah := $06;
  859.       Dx := Port;
  860.       Al := $00;
  861.       intr($14,regs);
  862.     end;
  863.     Halt;
  864.   end;
  865.  
  866. Procedure Chat(Full: Boolean);
  867.  
  868.   Const InfoColor = 14;
  869.         SysopChat = 14;
  870.         UserChat  = 3;
  871.  
  872.   Var SysopScreen: Array[2..11] of String[80];
  873.       UserScreen : Array[13..22] of String[80];
  874.       NormalLine : String[80];
  875.  
  876.       SysopX,SysopY: Byte;
  877.       UserX,UserY  : Byte;
  878.  
  879.       Ch           : Char;
  880.  
  881.       Procedure ScrollSysopScreen;
  882.  
  883.         Var cnt: byte;
  884.  
  885.         begin
  886.           For cnt := 2 to 6 do
  887.             SysopScreen[Cnt] := SysopScreen[Cnt+5];
  888.  
  889.           For Cnt := 7 to 11 do
  890.             Fillchar(SysopScreen[Cnt],Sizeof(SysopScreen[Cnt]),0);
  891.  
  892.           For Cnt := 11 downto 2 do
  893.           begin
  894.             PortXY(1,Cnt);
  895.             ClrPortEol;
  896.             if Cnt < 7 then
  897.               Sendln(SysopScreen[Cnt]);
  898.           end;
  899.  
  900.           SysopY := 7;
  901.         end;
  902.  
  903.       Procedure WrapSysopScreen;
  904.  
  905.         Var cnt: byte;
  906.  
  907.         begin
  908.           cnt := 81;
  909.  
  910.           Repeat
  911.             dec(Cnt);
  912.           until (SysopScreen[SysopY-1][Cnt] = #32) or (Cnt = 1);
  913.  
  914.           if cnt > 1 then
  915.           begin
  916.             SysopScreen[SysopY] := Copy(SysopScreen[SysopY-1],Cnt+1,80-Cnt);
  917.             Delete(SysopScreen[SysopY-1],Cnt,80-cnt);
  918.             PortXY(Cnt,SysopY-1);
  919.             Send(Rep(#32,81-Cnt));
  920.             PortXY(1,SysopY);
  921.             Send(SysopScreen[SysopY]);
  922.           end;
  923.         end;
  924.  
  925.       Procedure ScrollUserScreen;
  926.  
  927.         Var cnt: byte;
  928.  
  929.         begin
  930.           For cnt := 13 to 17 do
  931.             UserScreen[Cnt] := UserScreen[Cnt+5];
  932.  
  933.           For Cnt := 18 to 22 do
  934.             Fillchar(UserScreen[Cnt],Sizeof(UserScreen[Cnt]),0);
  935.  
  936.           For Cnt := 22 downto 13 do
  937.           begin
  938.             PortXY(1,Cnt);
  939.             ClrPortEol;
  940.             if Cnt < 18 then
  941.               Sendln(UserScreen[Cnt]);
  942.           end;
  943.  
  944.           UserY := 18;
  945.         end;
  946.  
  947.       Procedure ClearSysopScreen;
  948.  
  949.         var cnt : byte;
  950.  
  951.         begin
  952.           for cnt := 2 to 11 do
  953.             Fillchar(SysopScreen[Cnt],sizeof(SysopScreen[cnt]),0);
  954.  
  955.           For cnt := 11 downto 2 do
  956.           begin
  957.             PortXY(1,Cnt);
  958.             ClrPortEol;
  959.           end;
  960.  
  961.           SysopY := 2;
  962.         end;
  963.  
  964.       Procedure ClearUserScreen;
  965.  
  966.         var cnt : byte;
  967.  
  968.         begin
  969.           for cnt := 13 to 22 do
  970.             Fillchar(UserScreen[Cnt],sizeof(UserScreen[cnt]),0);
  971.  
  972.           For cnt := 22 downto 13 do
  973.           begin
  974.             PortXY(1,Cnt);
  975.             ClrPortEol;
  976.           end;
  977.  
  978.           UserY := 13;
  979.         end;
  980.  
  981.  
  982.       Procedure WrapUserScreen;
  983.  
  984.         Var cnt: byte;
  985.  
  986.         begin
  987.           cnt := 81;
  988.  
  989.           Repeat
  990.             dec(Cnt);
  991.           until (UserScreen[UserY-1][Cnt] = #32) or (Cnt = 1);
  992.  
  993.           if cnt > 1 then
  994.           begin
  995.             UserScreen[UserY] := Copy(UserScreen[UserY-1],Cnt+1,80-Cnt);
  996.             Delete(UserScreen[UserY-1],Cnt,80-cnt);
  997.             PortXY(Cnt,UserY-1);
  998.             Send(Rep(#32,81-Cnt));
  999.             PortXY(1,UserY);
  1000.             Send(UserScreen[UserY]);
  1001.           end;
  1002.         end;
  1003.  
  1004.       Procedure WordWrapNormal;
  1005.  
  1006.         Var cnt: byte;
  1007.  
  1008.         begin
  1009.           cnt := 81;
  1010.  
  1011.           Repeat
  1012.             dec(Cnt);
  1013.           until (NormalLine[Cnt] = #32) or (Cnt = 1);
  1014.  
  1015.           if cnt > 1 then
  1016.           begin
  1017.             NormalLine := Copy(NormalLine,Cnt+1,80-Cnt);
  1018.             PortXY(Cnt,WhereY);
  1019.             Send(Rep(#32,81-Cnt));
  1020.             Send(NormalLine);
  1021.           end;
  1022.         end;
  1023.  
  1024.       Procedure RedrawScreen(Sysop: Boolean);
  1025.  
  1026.         var cnt: byte;
  1027.  
  1028.         begin
  1029.           if Sysop then
  1030.           begin
  1031.             ModemOnly := True;
  1032.             ClrScr;
  1033.             TextColor(15);
  1034.             TextBackGround(1);
  1035.             ClrEol;
  1036.             Write(#32+SysopName);
  1037.             GotoXY(1,12);
  1038.             ClrEol;
  1039.             Write(#32+User.Name);
  1040.             GotoXY(1,23);
  1041.             ClrEol;
  1042.             TextColor(14);
  1043.             Write('Press Ctrl + R to re-draw screen and Ctrl + W to clear your screen');
  1044.             TextBackGround(0);
  1045.             GotoXY(1,2);
  1046.  
  1047.             TextColor(14);
  1048.             GotoXY(1,2);
  1049.             For Cnt := 2 to SysopY do
  1050.               Writeln(SysopScreen[Cnt]);
  1051.  
  1052.             TextColor(3);
  1053.             GotoXY(1,13);
  1054.             For Cnt := 13 to UserY do
  1055.               Writeln(UserScreen[Cnt]);
  1056.           end else
  1057.           begin
  1058.             ClrPortScr;
  1059.             PortColor(15);
  1060.             PortBackGround(1);
  1061.             ClrPortEol;
  1062.             Send(#32+SysopName);
  1063.             PortXY(1,12);
  1064.             ClrPortEol;
  1065.             Send(#32+User.Name);
  1066.             PortXY(1,23);
  1067.             ClrPortEol;
  1068.             PortColor(14);
  1069.             Send('Press Ctrl + R to re-draw screen and Ctrl + W to clear your screen');
  1070.             PortBackGround(0);
  1071.             PortXY(1,2);
  1072.  
  1073.             PortColor(14);
  1074.             PortXY(1,2);
  1075.             For Cnt := 2 to SysopY do
  1076.               Sendln(SysopScreen[Cnt]);
  1077.  
  1078.             PortColor(3);
  1079.             PortXY(1,13);
  1080.             For Cnt := 13 to UserY do
  1081.               Sendln(UserScreen[Cnt]);
  1082.           end;
  1083.  
  1084.           if Sysop then
  1085.             PortXY(Length(SysopScreen[SysopY])+1,SysopY)
  1086.           else
  1087.             PortXY(Length(UserScreen[UserY])+1,UserY);
  1088.         end;
  1089.  
  1090.         Function ReadMChar: Char;
  1091.  
  1092.           var regs: registers;
  1093.  
  1094.           begin
  1095.             CheckCarrier;
  1096.  
  1097.             regs.AH := $02;
  1098.             regs.DX := port;
  1099.  
  1100.             intr($14,regs);
  1101.             ReadMChar := chr(regs.AL);
  1102.           end;
  1103.  
  1104.   begin
  1105.     Ch := #255;
  1106.     PortColor(InfoColor);
  1107.     PortBackGround(0);
  1108.     Sendln('');
  1109.     Sendln('');
  1110.     Sendln('SysOp entering chat mode...');
  1111.     if User.Ansi and Full then
  1112.     begin
  1113.       PortBackGround(0);
  1114.       ClrPortScr;
  1115.       PortColor(15);
  1116.       PortBackGround(1);
  1117.       ClrPortEol;
  1118.       Send(#32+SysopName);
  1119.       PortXY(1,12);
  1120.       ClrPortEol;
  1121.       Send(#32+User.Name);
  1122.       PortXY(1,23);
  1123.       ClrPortEol;
  1124.       PortColor(14);
  1125.       Send('Press Ctrl + R to re-draw screen and Ctrl + W to clear your screen');
  1126.       PortBackGround(0);
  1127.       PortXY(1,2);
  1128.  
  1129.       SysopY := 2;
  1130.       UserY  := 13;
  1131.  
  1132.       Fillchar(SysopScreen,sizeof(SysopScreen),0);
  1133.       Fillchar(UserScreen ,sizeof(UserScreen) ,0);
  1134.  
  1135.       Repeat
  1136.         if KeyPressed then
  1137.         begin
  1138.           Ch := ReadKey;
  1139.  
  1140.           if Ch = #0 then
  1141.           begin
  1142.             Ch := readkey;
  1143.             case Ch of
  1144.               #46: Chat(not LeftShift);
  1145.               #35: HangUp;
  1146.               #36: JumpToDos;
  1147.             end;
  1148.           end else
  1149.           begin
  1150.             if ForeGround <> SysopChat then PortColor(SysopChat);
  1151.  
  1152.             PortXY(Length(SysopScreen[SysopY])+1,SysopY);
  1153.  
  1154.             if (ch = #08) then
  1155.             begin
  1156.               if (Length(SysopScreen[SysopY]) = 0) and (SysopY > 2) then
  1157.               begin
  1158.                 Dec(SysopY);
  1159.                 if Length(SysopScreen[SysopY]) = 80 then
  1160.                 begin
  1161.                   PortXY(80,SysopY);
  1162.                   Send(#32);
  1163.                   PortXY(80,SysopY);
  1164.                 end else
  1165.                 begin
  1166.                   PortXY(Length(SysopScreen[SysopY])+1,SysopY);
  1167.                   delete(SysopScreen[SysopY],length(SysopScreen[SysopY]),1);
  1168.                   Send(#08#32#08);
  1169.                 end;
  1170.               end else if length(SysopScreen[SysopY]) > 0 then
  1171.               begin
  1172.                 delete(SysopScreen[SysopY],length(SysopScreen[SysopY]),1);
  1173.                 Send(#08#32#08);
  1174.               end;
  1175.             end;
  1176.  
  1177.             if (Ch > #27) and (Ch <> #255) Then
  1178.             begin
  1179.  
  1180.               SysopScreen[SysopY] := SysopScreen[SysopY] + ch;
  1181.               Send(ch);
  1182.  
  1183.               if Length(SysopScreen[SysopY]) = 80 then
  1184.               begin
  1185.                 if SysopY = 11 then ScrollSysopScreen else
  1186.                   inc(SysopY);
  1187.                 if SysopScreen[SysopY-1][80] > #32 then WrapSysopScreen;
  1188.  
  1189.               end;
  1190.             end;
  1191.  
  1192.             if Ch = #23 then
  1193.             begin
  1194.               ClearSysopScreen;
  1195.             end;
  1196.  
  1197.             if Ch = #18 then
  1198.               RedrawScreen(True);
  1199.  
  1200.             if Ch = #13 then
  1201.             begin
  1202.               if SysopY = 11 then ScrollSysopScreen else
  1203.               Inc(SysopY);
  1204.               PortXY(1,SysopY);
  1205.             end;
  1206.           end;
  1207.         end;
  1208.  
  1209.         if PortPressed then
  1210.         begin
  1211.           Ch := ReadMChar;
  1212.  
  1213.           if ForeGround <> UserChat then PortColor(UserChat);
  1214.  
  1215.           PortXY(Length(UserScreen[UserY])+1,UserY);
  1216.  
  1217.           if (ch = #08) then
  1218.           begin
  1219.             if (Length(UserScreen[UserY]) = 0) and (UserY > 2) then
  1220.             begin
  1221.               Dec(UserY);
  1222.               if Length(UserScreen[UserY]) = 80 then
  1223.               begin
  1224.                 PortXY(80,UserY);
  1225.                 Send(#32);
  1226.                 PortXY(80,UserY);
  1227.               end else
  1228.               begin
  1229.                 PortXY(Length(UserScreen[UserY])+1,UserY);
  1230.                 delete(UserScreen[UserY],length(UserScreen[UserY]),1);
  1231.                 Send(#08#32#08);
  1232.               end;
  1233.             end else if length(UserScreen[UserY]) > 0 then
  1234.             begin
  1235.               delete(UserScreen[UserY],length(UserScreen[UserY]),1);
  1236.               Send(#08#32#08);
  1237.             end;
  1238.           end;
  1239.  
  1240.           if (ch = #0) then
  1241.           begin
  1242.             Ch := Readkey;
  1243.             ch := #255;
  1244.           end;
  1245.  
  1246.           if (ch <> #08) and (ch <> #13) and (Ch > #27) and (Ch <> #255) Then
  1247.           begin
  1248.  
  1249.             UserScreen[UserY] := UserScreen[UserY] + ch;
  1250.             Send(ch);
  1251.  
  1252.             if Length(UserScreen[UserY]) = 80 then
  1253.             begin
  1254.               if UserY = 22 then ScrollUserScreen else
  1255.                 inc(UserY);
  1256.               if UserScreen[UserY-1][80] > #32 then WrapUserScreen;
  1257.  
  1258.             end;
  1259.           end;
  1260.  
  1261.           if Ch = #13 then
  1262.           begin
  1263.             if UserY = 22 then ScrollUserScreen else
  1264.             Inc(UserY);
  1265.             PortXY(1,UserY);
  1266.           end;
  1267.  
  1268.           if Ch = #18 then RedrawScreen(False);
  1269.           if Ch = #23 then ClearUserScreen;
  1270.  
  1271.         end;
  1272.       until (ch = #27);
  1273.     end else
  1274.     begin
  1275.       Sendln('Hi there, '+User.Name+' this is your Sysop.');
  1276.       NormalLine := '';
  1277.       Repeat
  1278.         if KeyPressed then
  1279.         begin
  1280.           Ch := ReadKey;
  1281.  
  1282.           if ForeGround <> SysopChat then PortColor(SysopChat);
  1283.  
  1284.           if (ch = #08) and (length(NormalLine) > 0) then
  1285.           begin
  1286.             delete(NormalLine,length(NormalLine),1);
  1287.             Send(#08#32#08);
  1288.           end;
  1289.  
  1290.           if (ch <> #08) and (ch <> #13) and (length(NormalLine) < 80) and
  1291.              (ch > #31) and (ch < #127) then
  1292.           begin
  1293.             NormalLine := NormalLine + ch;
  1294.             if Length(NormalLine) = 80 then WordWrapNormal;
  1295.             Send(ch);
  1296.           end;
  1297.  
  1298.           if (Ch = #13) then
  1299.           begin
  1300.             Sendln('');
  1301.             NormalLine := '';
  1302.           end;
  1303.  
  1304.         end;
  1305.         if PortPressed then
  1306.         begin
  1307.           Ch := ReadMChar;
  1308.  
  1309.           if ForeGround <> UserChat then PortColor(UserChat);
  1310.  
  1311.           if (ch = #08) and (length(NormalLine) > 0) then
  1312.           begin
  1313.             delete(NormalLine,length(NormalLine),1);
  1314.             Send(#08#32#08);
  1315.           end;
  1316.  
  1317.           if (ch <> #08) and (ch <> #13) and (length(NormalLine) < 80) and
  1318.              (ch > #31) and (ch < #127) then
  1319.           begin
  1320.             NormalLine := NormalLine + ch;
  1321.             if Length(NormalLine) = 80 then WordWrapNormal;
  1322.             Send(ch);
  1323.           end;
  1324.  
  1325.           if (Ch = #13) then
  1326.           begin
  1327.             Sendln('');
  1328.             NormalLine := '';
  1329.           end;
  1330.  
  1331.           if Ch = #27 then Ch := #255;
  1332.  
  1333.         end;
  1334.       Until Ch = #27;
  1335.     end;
  1336.  
  1337.     PortBackGround(0);
  1338.     ClrPortScr;
  1339.     PortColor(InfoColor);
  1340.     Sendln('Chat mode ended.');
  1341.     Sendln('');
  1342.   end;
  1343.  
  1344.  
  1345.  
  1346. begin
  1347.   _2warned    := False;
  1348.   _1warned    := False;
  1349.   _Iwarned    := False;
  1350.   User.Ansi   := False;
  1351.   port        := 1;
  1352.   foreground  := 7;
  1353.   background  := 0;
  1354.   ModemOnly   := False;
  1355.   _Countline  := False;
  1356.   _LineCount  := 0;
  1357.   _PauseCount := 0;
  1358.   Stop        := False;
  1359.   _CheckTime  := False;
  1360.   ShowStatWin := True;
  1361. end.
  1362.