Virtual Private Server (VPS)
Hosting provided by Central
Point Networking
cpnllc.com
Who's Online
For some reason, the
"Nodelist" and "Recent
Callers" features are
not working.
Recent Visitors
Ray Quinn Tue Feb 27 09:53:21 2024
from Visalia, CA
via HTTPS
Ray Quinn Sun Mar 3 17:23:06 2024
from Visalia, CA
via HTTPS
Ray Quinn Wed Mar 20 19:01:41 2024
from Visalia, CA
via HTTPS
Ray Quinn Mon Mar 25 19:54:41 2024
from Visalia, CA
via HTTP
System Info
Sysop:
Ray Quinn
Location:
Visalia, CA
Users:
50
Nodes:
10 (0
/
10)
Uptime:
76:28:14
Calls:
2
Files:
11,894
Messages:
148,410
Check out the US 99
menu above for links
to information about
US Highway 99, after
which the US 99 BBS
is named.
Be sure to click on
the Amateur Radio
menu item above for
packet BBSes, packet
software, packet
organizations, as
well as packet
how-to's. Also
included is links to
local and some
not-so-local Amateur
Radio Clubs.
From Alexander Grotewohl@1:218/530 to All on Tue Mar 9 01:55:56 2021
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;
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;
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.