Here is some experimental code I was working on. I kind of lost interest after it got past the "proof of concept" phase. Perhaps someone else wants to finish it and run a single node internet bbs on a plain DOS machine ;)

sockets unit in the next message..


{$M $4000,0,0}
{x$DEFINE DEBUG}

uses
dos, crt, sockets;

var
h: word; { our socket handle }

IntTable : array[0..255] of Pointer absolute 0:0;
old14: pointer;

buf: array[1..1024] of char;
bcnt: word;
bmax: word;

{For debugging only}
Procedure ScreenStr(s:string;x,y:integer;attr:byte);
var
addr:word;
i:integer;
begin
addr:=(y-1)*160+(x-1)*2;
for i:=0 to length(s)-1 do begin
Mem[$b800:addr+i*2]:=ord(s[i+1]);
Mem[$b800:addr+(i*2)+1]:=attr;
end;
end;

type str10 = string[10];

Function NumStr(n,len:integer):str10;
var
addr:word;
i:integer;
s:str10;
begin
s:='';
for i:=len downto 1 do begin
s:=chr(n mod 10+ord('0'))+s;
n:=n div 10;
end;
NumStr:=s;
end;


const
funcstat : array[0..15] of integer = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
hex : string[16] = '0123456789ABCDEF';

Procedure DebugOut(func:word;active:boolean);
var i:integer;
begin
for i:=0 to 15 do
if active and (i=func) then begin
inc(funcstat[i]);
if funcstat[i]>99 then funcstat[i]:=0;
ScreenStr(hex[i+1]+':'+Numstr(funcstat[i],2),i*5+1,1,15);
end
else
ScreenStr(hex[i+1]+':'+Numstr(funcstat[i],2),i*5+1,1,7);
{ScreenStr('In:'+Numstr(InCount,2)+' Out:'+NumStr(OutCount,2)+
' Chk:'+Numstr(CheckInput,2)+' Stat:'+Numstr(LastStatus,2),1,2,7);} end;

function do_status: word;
var
tcp_state: byte;
rec: psession_info_rec;
t: word;
icnt, ocnt: word;
begin
tcp_status(h, tcp_state, icnt, ocnt, rec);
{ default }
t:=$08;
if (tcp_state=4) then
t:=t or $80;
if (icnt<>0) then
t:=t or $0100;
{ room avail }
t:=t or $2000;
{ buffer empty }
t:=t or $4000;
do_status:=t;
end;

procedure tcp14(flags, cs, ip, ax, bx, cx, dx, si, di, ds, es, bp: word); inter upt;
var
ch: char;
cnt: word;
icnt, ocnt: word;
begin
{$IFDEF DEBUG}
DebugOut(hi(ax),TRUE);
{$ENDIF}
driver_doio;
case hi(ax) of
$00: { set baud rate }
begin
{ we ignore the info they send because
we do not use it }
{ gotta send status tho}
ax:=do_status;
{ clear a buffer we keep? }
bcnt:=0;
bmax:=0;
end;
$01: { transmit wait }
begin
inc(bcnt);
buf[bcnt]:=char(lo(ax));
if (bcnt=sizeof(buf)) then
begin
tcp_put(h, @buf[1], bcnt, $FFFF, cnt);
bcnt:=0;
end;
ax:=do_status;
{ in:
al - character
dx - port
out:
ax - status bits }
end;
$02: { receive wait }
begin
if (bcnt<>0) then
begin
tcp_put(h, @buf[1], bcnt, $FFFF, cnt);
bcnt:=0;
end;
tcp_get(h, @ch, 1, $FFFF, cnt);
if (cnt<>0) then
ax:=byte(ch);
{ in:
dx - port
out:
ah = $00 - blah
al - character }
end;
$03: { status request }
begin
ax:=do_status;
if (bcnt<>0) then
inc(bmax);
if (bmax > 5) then
begin
tcp_put(h, @buf[1], bcnt, $FFFF, cnt);
bcnt:=0;
bmax:=0;
end;
{ in:
dx - port
out:
ax - status bits }
end;
$04: { init driver }
begin
{ in dx = port # }
ax:=$1954; { success message }
bx:=$100F; { duno about 10.. max func: $0C }
end;
$05: { deinit driver }
begin
{ kill socket? }
end;
$06: { raise/lower dtr }
begin
{ hang up! }
if (lo(ax)=$00) then
begin
tcp_close(h);
ax:=$00;
end else
ax:=$01;
end;
$07: { system timer params }
begin
{ ignoring... }
end;
$08: { flush output buffer }
begin
if (bcnt<>0) then
begin
tcp_put(h, @buf[1], bcnt, $FFFF, cnt);
bcnt:=0;
end;
{ in dx = port # }
end;
$09: { purge output buffer }
begin
{ in dx = port # }
end;
$0A: { purge input buffer }
begin
{ in dx = port # }
end;
$0B: { transmit no wait }
begin
inc(bcnt);
buf[bcnt]:=char(lo(ax));
if (bcnt=sizeof(buf)) then
begin
tcp_put(h, @buf[1], bcnt, $FFFF, cnt);
bcnt:=0;
end;
{ax:=do_status;}
ax:=1;
{ in:
al - character
dx - port
out:
ax - status bits }

{ in:
al - character
dx - port
out:
ax = 1 - sent
ax = 0 - not sent }
end;
$0C:
begin { peek ahead }
{ in:
dx - port
out:
ah = $00 - blah
al - character
ax = $FFFF- no character avail }
end;
$0D: { peek ahead keyboard }
begin
{ out:
ax - keyboard character
ax = $FFFF- no character avail }
end;
$0E: { read keyboard wait }
begin
{ out:
ax - keyboard character }
end;
$0F: { enable/disable flow control }
begin
{ ignoring.. }
end;
end;
{$IFDEF DEBUG}
DebugOut(hi(ax),FALSE);
{$ENDIF}
end;

var
done: boolean;
ch: char;

rec: pdriver_info_rec;
dh: byte;
icnt, ocnt: word;

rec2: psession_info_rec;
dead: boolean;

exit: boolean;

begin
clrscr;
exit:=false;

done:=false;
dead:=true;

bcnt:=0;
bmax:=0;

if (not driver_info(rec)) then
begin
writeln('Trumpet driver not loaded!');
halt(1);
end;

repeat
if (tcp_listen(h, 23)<>0) then
begin
writeln('Failed to connect! Waiting 5 seconds...');
{halt(1);}
delay(5000);
continue;
end;

clrscr;
writeln('TcpFos Waiting for call on port 23... Ctrl-Q to Exit');

repeat
driver_doio;
tcp_status(h, dh, icnt, ocnt, rec2);
if (dead=false) and (dh<>4) then
done:=true;
if (dh=4) then
begin
if (dead=true) then
dead:=false;
Old14:=IntTable[$14];
IntTable[$14]:=@tcp14;
SwapVectors;
exec(GetEnv('COMSPEC'),'/C c:\sbbs\node1\sbbs.bat qc38400');
if (doserror<>0) then
writeln('DOS error #: ', doserror);
SwapVectors;
IntTable[$14]:=Old14;
done:=true;
end else
if (keypressed) then
begin
ch:=readkey;
case ch of
#0:
begin
ch:=readkey;
case ch of
#45: ;
end;
end;
#17:
begin
done:=true;
exit:=true;
end;
end;
end else
delay(1);
until done;
tcp_close(h);
dead:=true;
until exit;
end.

--- Mystic BBS v1.12 A46 2020/08/26 (Windows/32)
* Origin: --[!dreamland BBS bbs.dreamlandbbs.org (1:218/530)