program netcon;

{
Simple datagram based messaging system for NetBIOS
This prototype currently doesn't use pointers hence is very
limited and written to be linear. To gain the maximum from this program
it's best to run it on a fast machine such as a 386


Buffer format:-
16  bytes  -  Senders ID
1   byte   -  Packet type
13  bytes  -  Parameter bytes
Remaining  -  Data

Packet types:-

0 - Standard Text Packet
    The first Parameter byte contains the channel number for the message

}

{$I stdins}

const
buflen=65;
typeline=3;


type
ncb=record
    command:byte;
    retcode:byte;
    lsn:byte;
    num:byte;
    buffer:integer;
    bufferb:integer;
    length:integer;
    callname:array[1..16] of char;
    name:array[1..16] of char;
    rto:byte;
    sto:byte;
    post:array[1..4] of byte;
    lana_num:byte;
    cmd_cplt:byte;
    reserve:array[1..14] of byte;
    end;
nametype=string[16];

var
nb,nb2,nbp:ncb;
buffer:array[1..255] of char;
buffer2:array[1..255] of char;
id:nametype;
bufpos:byte;
leave,noname:boolean;


procedure scroll;

begin
recpack.ax:=$601;
recpack.bx:=0;
recpack.cx:=$0401;
recpack.dx:=$164e;
intr($10,recpack);
end;


procedure fillname(tofill:nametype);

var
l:byte;

begin
for l:=1 to length(tofill) do
   nb.name[l]:=copy(tofill,l,1);
end;



procedure fillcallname(tofill:nametype);

var
l:byte;

begin
for l:=1 to 16 do
   nb.callname[l]:=copy(tofill,l,1);
end;


procedure bufferprint;

var
l:integer;
c:char;

begin
scroll;
gotoxy(2,22);
for l:=1 to 16 do if (buffer2[l]<>' ') and (buffer2[l]<>#0) then write(buffer2[l]);
write('>');
for l:=30 to buflen do
    write(buffer2[l]);
gotoxy(1,typeline);
end;


procedure bufferblank;

var
l:byte;

begin
for l:=1 to buflen do buffer[l]:=#32;
for l:=1 to length(id) do buffer[l]:=copy(id,l,1);
end;


procedure blank_input_buffer;

var
l:byte;

begin
for l:=1 to buflen do buffer2[l]:=#0;
end;



procedure get_new_id;

var
new_id:nametype;

begin
repeat;
write(chr(13),'Logon ID:');
readln(new_id);
until length(new_id)>=1;
id:=new_id;
end;



procedure enter_name;

begin
write('Hang on a sec..........');
nb.command:=$30;
fillname(id);
nb.lana_num:=0;
recpack.es:=seg(nb);
recpack.bx:=ofs(nb);
intr($5c,recpack);
if nb.retcode=0 then noname:=false;
end;


procedure setup_screen;

begin
clrscr;
cursor(1,15);
lowvideo;
box(0,1,4,80,24);
gotoxy(1,1);
write(chr(27),'[7m');
centreline('Netcon Network Conference - '+id);
write(chr(27),'[0m');
gotoxy(1,24);
highvideo;
centreline('Press F10 to logoff from this Netcon session');
end;


procedure tx(size:byte);

begin
nb.command:=$22; {Send Broadcast Datagram}
nb.lana_num:=0;
nb.callname[1]:='*';
fillname(id);
nb.buffer:=ofs(buffer);
nb.bufferb:=seg(buffer);
nb.length:=30+size;
recpack.es:=seg(nb);
recpack.bx:=ofs(nb);
intr($5c,recpack);
gotoxy(1,5);
end;



procedure receive;

var
l:byte;

begin
nb2.command:=$A3;
nb2.callname[1]:='*';
nb2.num:=nb.num;
nb2.lana_num:=0;
for l:=1 to 4 do nb2.post[l]:=0;
fillname(id);
nb2.buffer:=ofs(buffer2);
nb2.bufferb:=seg(buffer2);
nb2.length:=buflen;
recpack.es:=seg(nb2);
recpack.bx:=ofs(nb2);
intr($5c,recpack);
end;



procedure check_ncb2;

begin
if nb2.cmd_cplt<>$ff then
   begin
   bufferprint;
   receive;
   blank_input_buffer;
   end;
end;


procedure checkkeys;

var
lp:byte;


begin
if press and (not funckey) then
   begin
   if (key in [#32..#122]) and (bufpos<buflen) then
      begin
      gotoxy(bufpos,typeline);
      buffer[bufpos+30]:=key;
      bufpos:=bufpos+1;
      write(key);
      end
   else if (key=#8) and (bufpos>1) then
      begin
      buffer[bufpos+30]:=#0;
      bufpos:=bufpos-1;
      gotoxy(bufpos,typeline);
      write(#32);
      gotoxy(bufpos,typeline);
      end
   else if (key=#13) then
      begin
    {  scroll;
      gotoxy(2,22);
      for lp:=30 to bufpos+30 do write(buffer[lp]);}
      tx(bufpos);
      gotoxy(1,typeline);
      write(combine(buflen,#32));
      gotoxy(1,typeline);
      bufpos:=1;
      bufferblank;
      end;
   end
else if funckey and (key='D') then leave:=true;
end;



procedure del_name;


begin
nb.command:=$31;
fillname(id);
nb.lana_num:=0;
recpack.es:=seg(nb);
recpack.bx:=ofs(nb);
intr($5c,recpack);
if nb.retcode=0 then writeln(id,' - Logged off')
else writeln('Unable to disconnect - ',id);
end;



procedure do_the_business;


begin
leave:=false;
bufpos:=1;
receive;
repeat
checkkeys;
check_ncb2;
until leave;
clrscr;
del_name;
end;


procedure title;

begin
writeln('NETCON - NetBIOS Conference System V0.1  (C)Veghead 1992');
end;


procedure setup;

begin
noname:=true;
if paramcount<1 then get_new_id
  else id:=paramstr(1);
enter_name;
while noname
    begin
    clrscr;
    writeln('Name not acceptable, please enter another');
    get_new_id;
    enter_name;
    end;
bufferblank;
blank_input_buffer;
end;



begin
title;
setup;
setup_screen;
do_the_business;
end.