Description :
DOSChat is chatting program for DOS. It uses simple interface for transfering
messages. All messages are written in one file on one computer (or server),
others read the messages from it. So that's why it should be faster computer.
Needed is to look at paths. If they're not right, you won't see the messages.
That's why i prefer one common disk, it's easier to access it. To change the
path/file with messages run this program with parameter. For example:
DOSChat \myroom
creates or uses myroom.msg in root directory
DOSChat myroom
creates (or uses) myroom.msg in current directory

History :
1.0  : The first version.
1.1  : Fixed some bugs
1.11 : Color difference in system mesagges (like %Login somebody)
1.2  : Colored messages available
1.21 : Fixed some bugs and prepared for changing colors of background etc.

System Requirements :
80286 processor or better.
4 kB of disk space
Network : One common disk.

Homepage :
http://fog.home-page.org

e-mail : mnebel@email.cz

Snail-mail :
Mojmir Nebel
Budovatelska 530
742 13 Studenka 2
Czech Republic
}
Program DOSChat;

Const MessNumber=20;
      NameLength=30;
      MessLength=120;
      { File Constants }
      ChatFile:String='\DOSChat.msg';
      WriteFile:String='\DOSChat.wri';
      ReadFile:String='\DOSChat.rea';
      ChatFileSize=MessNumber*(NameLength+Messlength); { Velikost souboru v Bytech }
      { Base Chat Constants }
      Time:word=5; { Number of seconds to delay }
      Ver='1.21';
      { Screen Constants }
      ScreenSeg=$B800; { Screen segment }
      DefaultBCKLow=$1;
      DefaultBCK:Byte=DefaultBCKLow*16;
      DefaultNameCol:Byte=$C;
      DefaultMessCol:Byte=$A;
      Loginout='%08';     { - should be the same }
      Systemsgcol=8;      { / }
      BackGroundCol=$78;
      Linestring:string='DOSChat (C)1998-1999 Mojmir Nebel (fog.home-page.org)';
      { Pro nacitani retezce }
      texy:byte=24;

Type ChatFileRec = record
                    Name:String[NameLength];
                    mess:string[MessLength];
                   end;
     ChatFileType = Array [1..MessNumber] of ChatFileRec;

Var f:file;
    fw,fr:file of byte;
    here:ChatFileType;      { Current messages }
    i,a,Count,timer:word;   { For Timer }
    OldInt1c:Procedure;     {***     ***}
    ReadFileFlag:boolean;
    Name,Message:String;    { Current user, message }
    TextAttribut,cnt,DefColor,DefNameColor,DefaultBCKL:byte;
    Extended:Boolean;
    ch:char;

{*-*-*-*-*-*-* File access procedures *-*-*-*-*-*-*-*}
Procedure MoveMessages;
var xx:byte;
begin
   for xx:=1 to messnumber-1 do
   begin
     here[xx].mess:=here[xx+1].mess;
     here[xx].name:=here[xx+1].name;
   end;
   here[messnumber].mess:=message;
   here[messnumber].name:=name;
end;
Function ExistFile(what:string):boolean;
var ff:file of byte;
    IORes:Integer;
begin
   Assign(ff,what);
   {$I-}
   Reset(ff);
   {$I+}
   if IOResult=0 then
   begin
     Close(ff);
     ExistFile:=True
   end else ExistFile:=False;
end;
Procedure ReadChatFile;
begin
   Assign(fr,ReadFile);
   {$I-}
   If not ExistFile(ReadFile) then
   begin
     Rewrite(fr);
     Close(fr);
   end;
   Assign(f,ChatFile);
   Reset(f,ChatFileSize);
   BlockRead(f,here,1);
   Close(f);
   Assign(fr,ReadFile);
   Erase(fr);
   {$I+}
end;
Procedure WriteChatFile;
begin
   repeat until not ExistFile(ReadFile);
   repeat until not ExistFile(WriteFile);
   Assign(fw,WriteFile);
   {$I-}
   Rewrite(fw);
   Close(fw);
   ReadChatFile;
   MoveMessages;
   Assign(f,ChatFile);
   Rewrite(f,ChatFileSize);
   Blockwrite(f,here,1);
   Close(f);
   Assign(fw,WriteFile);
   Erase(fw);
   {$I+}
end;
{*-*-*-*-*-*-*-* CRT procedures *-*-*-*-*-*-*}
Procedure MoveCursor(x,y:byte); Assembler;
asm
  mov ah,2
  xor bh,bh
  mov dl,x
  mov dh,y
  int 10h
end;
Procedure FastPutChar(offst:word;color:byte; Character:char); Assembler;
asm
    mov  ax,ScreenSeg
    mov  es,ax
    mov  di,offst
    cld
    mov  al,character
    stosb
    mov  al,color
    stosb
end;
Procedure ClrScr;Assembler;
asm
   mov ax,screenseg
   mov es,ax
   xor di,di
   cld
   mov cx,2000
@1:
   mov al,32
   stosb
   mov al,textattribut
   stosb
   loop @1
end;
Procedure wrxy(x,y:byte; s:string); { Write-on-X,Y }
var position,i:word;
Begin
   position:=(x*2)+(y*160)-160;
   for i:=1 to length(s) do
   begin
     FastPutChar(position,TextAttribut,s[i]);
     inc(position,2);
   end;
End;
Procedure ColorWrxy(x,y,col:byte; s:string);
begin
   textattribut:=col;
   wrxy(x,y,s);
end;
Procedure pozadi;
Var i:integer;
Begin
   textattribut:=Backgroundcol;
   clrscr;
   wrxy(40-(Length(Linestring) div 2),1,Linestring);
   for i:=80 to 1839 do FastPutChar(i*2,DefaultBCK,#32);
End;

Function UpcaseStr(s:string):string;
var st:string;
    zz:byte;
begin
   st:='';
   for zz:=1 to length(s) do st[zz]:=Upcase(s[zz]);
   st[0]:=Chr(length(s));
   Upcasestr:=st;
end;

Function GetColor(s:string; def:byte; sup:boolean):byte;
Const hexchars='0123456789ABCDEF';
var col:byte;
    cccc:integer;
    ss:string;
begin
   If s[1]<>'%' then
   begin
      GetColor:=Def;
      exit;
   end;
   if sup then
   begin
      GetColor:=Systemsgcol;
      exit;
   end;
   ss:=Copy(s,2,2);
   col:=((Pos(Upcase(ss[1]),hexchars)-1)*16)+(Pos(Upcase(ss[2]),hexchars)-1);
   GetColor:=col;
end;

Function GetStringWNumber(s:string; sup:boolean):String;
begin
   If (s[1]='%') and not sup
      then GetStringWNumber:=Copy(s,4,Length(s)-3)
      else GetStringWNumber:=s;
end;
Function IsLogInOut(n:string):boolean;
begin
   If (n='%Login') or (n='%Logout') then
      IsLogInOut:=True else
      IsLogInOut:=False;
end;
Function GetPos(s:string):shortint;
begin
   if s[1]<>'%' then
   begin
      GetPos:=0;
      exit;
   end;
   If IsLogInOut(s) then
   begin
      GetPos:=0;
      exit;
   end;
   GetPos:=-3;
end;
{*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* REFRESH *-*-*-*-*-*-*-*-*-*-*}
{-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*- REFRESH -*-*-*-*-*-*-*-*-*-*-}
{*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* REFRESH *-*-*-*-*-*-*-*-*-*-*}
Procedure RefreshDisplay;
var c:word;
    posit,y:byte;
    ss,who:string;
    supcommand:boolean;
begin
   for c:=160 to 3679 do
   begin
     FastPutChar(c,DefaultBCK,#32);
     inc(c);
   end;
   c:=1;
   y:=2;
   repeat
   With here[c] do
   begin
     textattribut:=DefaultBCK+GetColor(Name,DefaultNameCol,IsLogInOut(name));
     Wrxy(0,y,GetStringWNumber(name,IsLogInOut(name)));
     Wrxy(length(name)+GetPos(name),y,':');
     textattribut:=DefaultBCK+GetColor(Mess,DefaultMessCol,IsLogInOut(name));
     Wrxy(length(name)+GetPos(name)+2,y,GetStringWNumber(mess,false));
     Inc(y);
     If Length(name)+Length(mess)+2 > 79 then Inc(y);
   end;
   inc(c);
   until (c=24) or (c=messnumber+1) or (y>22);
   textattribut:=$74;
   If (y>22) and (c<>messnumber+1) then Wrxy(46,25,'!!') else Wrxy(46,25,'  ');
end;
{*-*-*-*-*-*-*-* Interrupt procedures *-*-*-*-*-*-*-*}
Procedure GetVector(var OldTimer:Pointer);Assembler;
asm
    push ds
    cld
    mov ax,351ch
    int 21h
    mov ax,es
    les di,OldTimer
    xchg ax,bx
    stosw
    xchg ax,bx
    stosw
    pop ds
end;

Procedure SetVector(OldTimer:Pointer); Assembler;
asm
   push ds
   lds  dx,OldTimer
   mov  ax,251ch
   int  21h
   pop  ds
end;

{$F+}
Procedure MyInt1c; Interrupt;
begin
   asm
     push ax
     add  a,55
     cmp  a,1000
     jna  @OK
     sub  a,1000
     inc  count
@OK:
     mov  ax,count
     cmp  ax,time
     jnae @Go
     mov  al,1
     mov  ReadFileFlag,al
     xor  ax,ax
     mov  count,ax
@Go:
     pop  ax
   end;
   Inline($9C);               { Push Flags }
   OldInt1c;
end;
{$F-}
{*-*-*-*-*-*-* Keyboard *-*-*-*-*-*-*-*-*}
Function Keypressed:boolean; Assembler;
asm
  mov ah,0bh
  int 21h
end;
Function ReadKey:char; Assembler;
asm
   mov ah,7
   int 21h
end;
{*-*-*-*-*-*-* Other procedures *-*-*-*-*-*-*}
Procedure CommandLine;
Var sss:string;
begin
   If (Paramstr(1)='/?') or (ParamStr(1)='/h') or (ParamStr(1)='/H') then
   begin
      Writeln('DOSChat '+ver);
      Writeln;
      Writeln('DOSChat /?       ...this help.');
      Writeln('DOSChat filename ...another chat group (filename should be without extension)');
      Writeln;
      Writeln('Comments:');
      Writeln('This program is FREEWARE. DOSChat must NOT serve business.');
      Writeln;
      Writeln('(C)1998-1999 Mojmir Nebel');
      Writeln('Homepage: fog.home-page.org');
      Writeln('E-mail  : mnebel@email.cz');
      Writeln;
      Writeln('********* Mail **********');
      Writeln('Mojmir Nebel');
      Writeln('Budovatelska 530');
      Writeln('Studenka 2');
      Writeln('742 13');
      Writeln('Czech Republic');
      Writeln;
      Writeln('Send me tons of postcards !');
      halt;
   end;
   sss:=Paramstr(1);
   If Pos('.',sss)<>0 then
      delete(sss,Pos('.',sss),length(sss)-Pos('.',sss)+1);
   ChatFile:=sss+'.msg';
   WriteFile:=sss+'.msw';
   ReadFile:=sss+'.msr';
   Writeln('*********** DOSChat '+ver+' ***********');
   Writeln('Command line parameter entered, using this file:');
   Writeln(ChatFile);
   Writeln('Are you sure ? (Y/N)');
   If UpCase(Readkey)<>'Y' then halt;
   asm
     mov ax,3
     int 10h
   end;
end;
Procedure SelectColor(Name:string);
Var i,nc,mc:byte;
    nchange:boolean;
    cc:char;
begin
   textattribut:=7;
   Wrxy(0,5,'Select your color: ...change item, ...change color, ENTER...Continue');
   nc:=DefaultNameCol;
   mc:=DefaultMessCol;
   nchange:=True;
   ColorWrxy(1,7,$0b,'');
   ColorWrxy(Length(Name)+3,7,$07,' ');
   Repeat
    ColorWrxy(0,6,nc+DefaultBCK,Name+':');
    ColorWrxy(Length(name)+2,6,mc+DefaultBCK,'[This is a message]');
    cc:=Readkey;
    Case cc of
     #75: begin
            nchange:=True;
            ColorWrxy(1,7,$0b,'');
            ColorWrxy(Length(Name)+3,7,$07,'   ');
          end;
     #77: begin
            nchange:=False;
            ColorWrxy(1,7,$07,' ');
            ColorWrxy(Length(Name)+3,7,$0b,'');
          end;
     #72: If nchange then
          begin
             nc:=nc+1;
             if nc=DefaultBCKL then nc:=nc+1;
             if nc=$10 then nc:=0;
             if nc=DefaultBCKL then nc:=nc+1;
          end else
          begin
             mc:=mc+1;
             if mc=DefaultBCKL then mc:=mc+1;
             if mc=$10 then mc:=0;
             if mc=DefaultBCKL then mc:=mc+1;
          end;
     #80: If nchange then
          begin
             nc:=nc-1;
             if nc=DefaultBCKL then nc:=nc-1;
             if nc=$FF then nc:=$F;
             if nc=DefaultBCKL then nc:=nc-1;
          end else
          begin
             mc:=mc-1;
             if mc=DefaultBCKL then mc:=mc-1;
             if mc=$FF then mc:=$F;
             if mc=DefaultBCKL then mc:=mc-1;
          end;
    end;
   Until cc=#13;
   DefColor:=mc;
   DefNameColor:=nc;
end;

Function Setmycolor(cc:byte):string;
Const hexchars:String='0123456789ABCDEF';
begin
   Setmycolor:='%'+hexchars[(cc div 16)+1]+hexchars[(cc mod 16)+1];
end;

BEGIN
   asm
     mov ax,3
     int 10h
   end;
   textattribut:=7;
   if Test8086=0 then
   begin
      Wrxy(0,1,'Sorry, but you need better processor for this program !');
      MoveCursor(1,2);
      halt;
   end;
   a:=0;
   Count:=0;
   DefaultBCKL:=DefaultBCKLow;
   ReadFileFlag:=False;
   message:='';
   If ParamCount<>0 then CommandLine;

   repeat
     Wrxy(0,1,'***** DOSChat, version '+ver+' *****');
     Wrxy(0,2,'Enter your Name :          ');
     MoveCursor(18,1);
     readln(name);
     if name='' then write(^G);
     if (Pos('%',name)<>0) or
        (Pos('#',name)<>0) or
        (Pos('$',name)<>0) then
     begin
        write(^G);
        name:='';
     end;
   until name<>'';
   SelectColor(Name);
   MoveCursor(0,25);
   For i:=1 to MessNumber do
   begin
     here[i].name:=Loginout+'%Free';
     here[i].mess:=' ';
   end;
   If Not ExistFile(ChatFile) then WriteChatFile;
   ReadChatFile;
   Pozadi;
   GetVector(@OldInt1c);
   SetVector(Addr(MyInt1c));
   message:=Loginout+name;
   name:=+'%Login';
   MoveMessages;
   WriteChatFile;
   name:=Setmycolor(defnamecolor)+GetStringWNumber(message,false);
   message:='';
   RefreshDisplay;
   textattribut:=$74;
   Wrxy(49,25,'F10....Exit to OS');
   textattribut:=$7d;
   Wrxy(38,25,'< MAX');

   REPEAT
    repeat
     If ReadFileFlag then
     begin
       ReadChatFile;
       RefreshDisplay;
       ReadFileFlag:=false;
     end;
    until keypressed;

     textattribut:=Backgroundcol;
     ch:=readkey;
     if Ch=#0 then
     begin
       Extended:=True;
       ch:=readkey;
     end else Extended:=False;
     if not(ch=#13) and not(ch=#8) and not Extended and (cnt+2<messlength) then
     begin
       Message:=message+ch;
       Wrxy(cnt,texy,ch);
       Inc(cnt);
     end;
     if (ch=#8) and (cnt>0) then
     begin
        Dec(cnt);
        message[0]:=Chr(ord(message[0])-1);
        Wrxy(cnt,texy,' ');
     end;
     if ch=#13 then
     begin
       If message[1]<>'%' then message:=Setmycolor(DefColor)+message;
       If message[1]='%' then
       begin
         If (not (message[2] in ['0'..'9','a'..'f','A'..'F']) or
             not (message[3] in ['0'..'9','a'..'f','A'..'F'])) then
             message:=Setmycolor(DefColor)+message;
       end;
       MoveMessages;
       WriteChatFile;
       message:='';
       cnt:=0;
       For i:=0 to messlength-3 do Wrxy(i,texy,' ');
     end;

   UNTIL (Extended and (Ch='D')); { End while F10 pressed }

   SetVector(@OldInt1c);
   Randomize;
   message:=Loginout+GetStringWNumber(Name,false);
   name:=Loginout+'%Logout';
   MoveMessages;
   WriteChatFile;
   textattribut:=$07;
   clrscr;
   MoveCursor(0,0);
   Writeln('DOSChat, version '+ver+', (C)1998-99 Mojmir Nebel');
END.

This is translated version (Translated comments only)

Send me message to my e-mail if you don't understand something in this
source. You can (should) also send me Bug-reports.

Greetings:
All PAS-coders