here's the promised sockets unit. the documentation for the trumpet lib is kinda hard to find nowadays, but if you find an old URL you can fetch it from archive.org

Alex


{ trumpet sockets unit for bp7 }
{ needs work.. outbound ip currently hardcoded }

unit sockets;

interface

uses
crt, dos;

type
pdriver_info_rec = ^driver_info_rec;
driver_info_rec = record
myip: array[0..3] of byte;
netmask: array[0..3] of byte;
gateway: array[0..3] of byte;
dnsserver: array[0..3] of byte;
timeserver: array[0..3] of byte;
mtu: integer;
def_ttl: byte;
def_tos: byte;
tcp_mss: integer;
tcp_rwin: integer;
debug: integer;
domain: array[0..255] of char;
end;

psession_info_rec = ^session_info_rec;
session_info_rec = record
ip_srce: array[0..3] of byte;
ip_dest: array[0..3] of byte;
ip_prot: byte;
active : byte;
end;

function driver_info(var rec: pdriver_info_rec): boolean;
function driver_doio: byte;

function tcp_open(var h: word; port: word; listen: boolean): byte;
function tcp_connect(var h: word; port: word): byte;
function tcp_listen(var h: word; port: word): byte;
function tcp_close(h: word): byte;
function tcp_get(h: word; buf: pchar; cnt: word; timeout: word; var res: word): byte;
function tcp_put(h: word; buf: pchar; cnt: word; timeout: word; var res: word): byte;
function tcp_status(h: word; var tcp_state: byte; var incnt, outcnt: word; var ec: psession_info_rec): byte;

implementation

function driver_info(var rec: pdriver_info_rec): boolean;
var
regs: registers;
begin
driver_info:=false;
rec:=nil;
fillchar(regs, sizeof(regs), 0);
regs.ah:=$00;
regs.al:=$FF;
intr($61, regs);
{ should actually check for TCP_DRVR lol }
if (regs.al=0) then
begin
rec:=Ptr(regs.es, regs.di);
driver_info:=true;
end;
writeln(rec^.myip[0], ' ', rec^.myip[1], ' ', rec^.myip[2], ' ', rec^.myip[3 );
end;

function driver_doio: byte;
var
regs: registers;
begin
fillchar(regs, sizeof(regs), 0);
regs.ah:=$02;
intr($61, regs);
driver_doio:=regs.dl;
end;

type
tip = array[0..3] of byte;

function tcp_open(var h: word; port: word; listen: boolean): byte;
var
regs: registers;
ip: tip;
begin
fillchar(regs, sizeof(regs), 0);
regs.ah:=$10;
{ normal }
if (listen) then
begin
regs.al:=1;
regs.bx:=port;
regs.cx:=0;
{ dx = timeout, $00 = non-blocking, $FFFF = infinite }
regs.dx:=$FFFF;
{ in this case we might be able to bind
a specific ip address? }
regs.si:=0;
regs.di:=0;
end else
begin
regs.al:=0;
regs.bx:=0;
regs.cx:=port;
regs.dx:=60;


{ some temp test stuff }
ip[0]:=192;
ip[1]:=168;
ip[2]:=1;
ip[3]:=10;

regs.si:=(ip[3] shl 8) or ip[2];
regs.di:=(ip[1] shl 8) or ip[0];
end;

intr($61, regs);
h:=regs.bx;
tcp_open:=regs.dl;
end;

{ needs ip.. }
function tcp_connect(var h: word; port: word): byte;
begin
tcp_connect:=tcp_open(h, port, false);
end;

function tcp_listen(var h: word; port: word): byte;
begin
tcp_listen:=tcp_open(h, port, true);
end;

function tcp_close(h: word): byte;
var
regs: registers;
begin
fillchar(regs, sizeof(regs), 0);
regs.ah:=$11;
regs.al:=$01;
regs.bx:=h;
{ per docs timeout must be non-zero to release handle }
{regs.dx:=$01;}
regs.dx:=$02; { 1 = abort so.. try 2?}

intr($61, regs);
tcp_close:=regs.dl;
end;

function tcp_get(h: word; buf: pchar; cnt: word; timeout: word; var res: word): byte;
var
regs: registers;
begin
fillchar(regs, sizeof(regs), 0);
regs.ah:=$12;
regs.al:=$01;
regs.bx:=h;
regs.cx:=cnt;
regs.dx:=timeout;

regs.es:=seg(buf^);
regs.di:=ofs(buf^);

intr($61, regs);
res:=regs.ax;
tcp_get:=regs.dl;
end;

function tcp_put(h: word; buf: pchar; cnt: word; timeout: word; var res: word): byte;
var
regs: registers;
begin
fillchar(regs, sizeof(regs), 0);
regs.ah:=$13;
regs.al:=$04;
{regs.al:=$00;}
regs.bx:=h;
regs.cx:=cnt;
regs.dx:=timeout;

regs.es:=seg(buf^);
regs.di:=ofs(buf^);

intr($61, regs);
res:=regs.ax;
tcp_put:=regs.dl;
end;

function tcp_status(h: word; var tcp_state: byte; var incnt, outcnt: word; var ec: psession_info_rec): byte;
var
regs: registers;
begin
fillchar(regs, sizeof(regs), 0);
regs.ah:=$14;
regs.al:=$00;
regs.bx:=h;

intr($61, regs);
tcp_state:=regs.dh; { 1 = not connected, 4 = connected.. others? }
incnt:=regs.ax;
outcnt:=regs.cx;

rec:=Ptr(regs.es, regs.di);

tcp_status:=regs.dl;
end;

end.

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