[Back to NETWORK SWAG index] [Back to Main SWAG index] [Original]
{
Ken Johnson's Novell unit.
kjohnso3@chat.carleton.ca
Some of this stuff may/maynot work. If something doesn't,
email me.
}
Unit kjnet;
interface
Var
error : byte;
Const
week : array[0..6] of string = ('Sunday','Monday','Tuesday','Wednesday'
,'Thursday','Friday','Saturday');
personal = $05;{used for GETMESSAGE}
broadcast = $01;
receiveall = $00;{used for SETBROADCASTMODE}
NoUsermessage = $01;
StoreServerMessage = $02;
StoreAllMessages = $03;
type
diskrec=record
clockticks:longint;
objectid:longint;
diskspace:longint;
enforced:Byte;
end;
diskspacerec = record
len : word;
clockticks : longint;
id : longint;
diskleft : longint;
restrict : byte;
end;
BinderyRec = Record
ID : longint;
objtype : word;
Name : String;
objectFlag : byte;
securitylevel : byte;
propertyflags : byte;
end;
NoReturn = record{when the function call}
Len : Word; {returns nothing.}
End;
Userrec = record
Name : string;
objtype : word;
id : longint;
logindate : string;
logintime : string;
weekday : string;
Connection: Byte;
end;
procedure delnulls(var s : string);
procedure Callint(Ahreg : byte;Var bufferin,bufferout;
Var error : Byte);
procedure getdisk(id:longint;var disk : diskrec);
Procedure GetBinderyAccess(var sec : byte;var id : longint);
Function upcaseStr(s : string) : String;
procedure logout;
function connectnum : byte;
procedure setbroadcastmode(mode : byte);
function Getbroadcastmode : byte;
Procedure SendBroadCastMessage(Con : Byte;Message : String);
Function GetMessage(Func : Byte) : String;
Procedure SendPersonalMessage(Con : Byte;Message : String);
procedure broadcastToConsole(message : string);
function idnumber : longint;
procedure Getconnectioninfo(Con : byte;Var U : userrec);
function Connect2ID(Con : byte) : longint;
{procedure getdiskspaceleft(id : longint;var bufferout : diskspacerec);}
procedure ClearConnection(c : byte);
procedure getopenfiles(c : word;var files : array of string;var numf : byte);
procedure scanbindery(objID : Longint;obj : word;name1 : string;
var Bin : binderyrec;var error:byte);
function name2id(name : string) : longint;
Function ConsoleOperator : Boolean;
function fullname(Name : string) : string;
procedure callFint(con : word;var bufferin,bufferout;
var e : word);
implementation
Function fullname(Name : string) : string;
Type
request = record
len : word;
sub : byte;
objtype : word;
data : array[1..65] of byte;
end;
reply = record
len : word;
value : array[1..128] of Byte;
s : byte;
f : byte;
end;
var
reaL:STRING;
prop:string;
bufferin : request;
bufferout : reply;
x,i : byte;
Begin
fillchar(Bufferin,sizeof(BUfferin),0);
Fillchar(BufferOut,Sizeof(Bufferout),0);
Bufferout.Len := Sizeof(BufferOut)-2;
prop := 'IDENTIFICATION';
with bufferin do
begin
Sub := $3d;
objtype := 256;{I guess tis could be different.}
i := 1;
bufferin.data[i] := Length(Name);
for x := 1 to length(name) do
begin
Inc(I);
bufferin.daTa[i] := ord(name[x]);
end;
inc(i);
bufferin.data[i] := 01;
inc(i);
bufferin.data[i] := length(Prop);
for x := 1 to length(Prop) do
begin
Inc(i);
bufferin.data[i] := ord(prop[x]);
end;
end;
bufferin.len := 3+I;
callint($e3,Bufferin,bufferout,error);
i := 1;
While Not(Chr(Bufferout.value[i]) = '') and not (I = 128)do
begin
real[i] := Chr(Bufferout.Value[i]);
Inc(I);
end;
real[0] := chr(I);
delnulls(real);
fullname:=real;
End;
{--------------------------------------------------------------------------}
procedure getpriv(Var bufferin,bufferout;Var e : Byte);Assembler;
asm
push ds
mov ah,$e3
lds si,bufferin
les di,bufferout
int $21
mov [byte ptr e],al
pop ds
end;
{----------------------------------------------------------------------}
function name2id(name : string) : longint;
type
request=record
len:word;
sub:byte;
obtype:word;
name:array[1..49] of char;
end;
reply = record
len:word;
id:longint;
objtype:word;
name : array[1..48] of char;
end;
var
bufferin:request;
bufferout:reply;
x:byte;
begin
bufferin.len := 3+Length(name)+1;
bufferin.sub:=$35;
bufferin.obtype:=(256);
for x := 0 to length(name) do
begin
bufferin.name[x+1] := name[x];
end;
fillchar(bufferout,sizeof(bufferout),0);
bufferout.len:=$36;
callint($e3,bufferin,bufferout,error);
name2id := (bufferout.id);
end;
{--------------------------------------------------------------------------}
Function ConsoleOperator : Boolean;
type
request = record
len : Word;
Sub : Byte;
end;
var
bufferin : request;
bufferout : noreturn;
begin
Bufferin.len := 1;
bufferin.Sub := $c8;
getpriv(bufferin,bufferout,error);
if error = $c6 Then consoleoperator := False
else consoleoperator := true;
end;
{--------------------------------------------------------------------------}
procedure getdisk(id:longint;var disk : diskrec);
type
request = record
len:word;
sub:byte;
id1:Longint;
end;
reply = record
len:word;
a:array[1..3]of longint;
enforced:byte;
end;
var
bufferin:request;
bufferout:reply;
u:userrec;
begin
bufferin.len:=5;
bufferin.sub:=$e6;
bufferin.id1:=(id);
fillchar(Bufferout,sizeof(bufferout),0);
bufferout.len:=sizeof(bufferout)-2;
callint($e3,bufferin,bufferout,error);
with bufferout do
begin
disk.clockticks := SWAP(a[1]);
disk.objectid:=SWAP(a[2]);
disk.diskspace:=swap(a[3]);
disk.enforced:=enforced;
end;
end;
{--------------------------------------------------------------------------}
procedure scanbindery(objID : Longint;obj : word;name1 : string;
var Bin : binderyrec;var error : byte);
type
request = record
len : word;
sub : byte;
id : longint;
ot : word;
namelen : byte;
namedata : array[1..47] of char;
end;
reply = record
len : word;
id : longint;
ot : word;
name : array[1..48] of char;
flag : byte;
lev : byte;
prop : byte;
end;
var{this works man}
bufferin : request;
bufferout : reply;
x,i : byte;
name:string;
begin
name:=name1;
upcaseStr(name);
fillchar(Bufferin,sizeof(Bufferin),0);
with bufferin do
begin
sub := $37;
id := objid;
ot := obj;
i := 0;
namelen := length(name);
for x := 1 to length(Name) do
begin
inc(i);
namedata[i] := name[x];
end;
len := length(Name)+8;
end;
bufferout.len := sizeof(Bufferout)-2;
callint($e3,bufferin,bufferout,error);
With BUfferout do
begin
bin.id := id;
bin.objtype := ot;
for i := 1 to 48 do
bin.name[i] := bufferout.name[i];
bin.name[0] := chr(i);
bin.objectflag := flag;
bin.securitylevel := lev;
bin.propertyflags := prop;
end;
end;
{------------------------------------------------------------------------}
procedure callFint(con : word;var bufferin,bufferout;
var e : word);assembler;
asm
push ds
mov ax,$f217
mov cx,con
lds si,bufferin
les di,bufferout
int $21
mov [word ptr e],ax
pop ds
end;
{------------------------------------------------------------------------}
procedure sortthese(num : word;B : array of byte;var files : array of string);
var
W,x,i : integer;
len : byte;
oldi : integer;
begin
i := 16;
x := -1;
repeat
INC(x);
files[x][0] := chr(B[i]);{length}
len := b[i];
inc(i);
OldI := i;
for w := 1 to len do
begin
files[x][w] := chr(b[i]);
inc(i);
if oldI > i+16 Then Break;
end;
inc(I,16);
until x = num;
end;
{------------------------------------------------------------------------}
procedure getopenfiles(c : word;var files : array of string;var numf : byte);
type
request = record
len : word;
sub : byte;
con : word;
lastrec : word;
end;
reply = record
nextrecord : word;
numberofrecords : word;
RawReplyData : array[1..508] of Byte;
end;
var
bufferin : request;
bufferout : reply;
i,x,l : word;
error : word;
begin
fillchar(files,sizeof(Files),0);
for i := 11 to 13 do
begin
fillchar(Bufferin,sizeof(Bufferin),0);
fillchar(Bufferout,sizeof(Bufferout),0);
with bufferin do
begin
len := $5;
sub := $eb;
con := c;
lastrec := $00;
end;
callFint(bufferin.con,bufferin,bufferout,error);
if (Bufferout.numberofrecords > 0) Then
begin
numf := bufferout.numberofrecords;
sortthese(bufferout.numberofrecords,bufferout.rawreplydata,files);
exit;
end;
end;
end;
{------------------------------------------------------------------------}
procedure ClearConnection(c : byte);
type
request = record
len : word;
sub : byte;
con : byte;
end;
var
bufferin : request;
bufferout : noreturn;
begin
bufferin.len := 2;
bufferin.sub := $d2;
bufferin.con := c;
callint($e3,bufferin,bufferout,error);
end;
{------------------------------------------------------------------------}
function Connect2ID(Con : byte) : longint;
var
u : userrec;
begin
getconnectioninfo(con,u);
connect2id := u.id;
end;
{------------------------------------------------------------------------}
procedure getdiskspaceleft(id : longint;var bufferout : diskspacerec);
type
request = record
len : word;
sub : byte;
oid : longint;
end; {works. page 367}
var
bufferin : request;
begin
with bufferin do
begin
len := 5;
sub := $e6;
oid := id;
end;
fillchar(Bufferout,sizeof(Bufferout),0);
bufferout.len := sizeof(Bufferout)-2;
callint($e3,bufferin,bufferout,error);
end;
{------------------------------------------------------------------------}
procedure delnulls(var s : string);
var
x : byte;
temp : string;
begin
for x := 1 to length(S) do
begin
if s[x] = #0 Then
Begin
s[0] := chr(X-1);
exit;
End;
end;
end;
{------------------------------------------------------------------------}
procedure Callint(Ahreg : byte;Var bufferin,bufferout;
Var error : Byte);assembler;
asm
xor ax,ax
push ds
mov ah,ahreg
lds si,bufferin
les di,bufferout
int 21h
pop ds
mov [byte ptr error],al
end;
{------------------------------------------------------------------------}
Procedure GetBinderyAccess(var sec : byte;var id : longint);
Type
request = record
len : word;
sub : byte;
end;
reply = record
len : word;
level : byte;
oid : longint;
end;
var
bufferin : request;
bufferout : reply;
Begin
bufferin.len := 1;{page 328. works}
bufferin.sub := $46;
fillchar(Bufferout,sizeof(bufferout),0);
bufferout.len := 5;
callint($e3,bufferin,bufferout,error);
sec := bufferout.level;
id := bufferout.oid;
End;
{------------------------------------------------------------------------}
Function upcaseStr(s : string) : String;
var x : byte;
begin
for x := 1 to Length(s) do
S[x] := Upcase(S[x]);
upcaseStr := s;
end;
{------------------------------------------------------------------------}
procedure logout;assembler;
asm
mov ah,$d7
int 21h
mov [byte ptr error],al
end;
{------------------------------------------------------------------------}
function connectnum : byte;assembler;
asm
mov ah,$dc
int 21h{connectnum stored in al. should return}
end;
{------------------------------------------------------------------------}
procedure setbroadcastmode(mode : byte);assembler;
asm
mov ah,$de
mov dl,mode{page 374}
int 21h
end;
{------------------------------------------------------------------------}
function Getbroadcastmode : byte;assembler;
asm
mov ah,$de
mov dl,$04 {page 374}
int 21h{broadcastmode stored in al}
end;
{------------------------------------------------------------------------}
Procedure SendBroadCastMessage(Con : Byte;Message : String);
Type
Request = Record
Len : Word;
sub : byte;
Stuff : array[1..157] of byte;
End;
reply = record
len : word;
num : byte;
list : array[1..100] of byte;
end;
Var
Bufferin : request;
bufferout : reply;
i,x : byte;
Begin
fillchar(Bufferin,Sizeof(Bufferin),0);
fillchar(BufferOut,Sizeof(BufferOut),0);
With Bufferin do
begin
len := Length(message)+4;
Sub := $00; {works. page 374}
I := 1;
Stuff[i] := 1;{connect num}
Inc(I);
Stuff[i] := Con;
Inc(I);
Stuff[i] := Length(Message);
Inc(I);
for x := 1 to Length(Message) do
Begin
stuff[i] := ord(Message[x]);
inc(I);
end;
end;
callInt($e1,Bufferin,Bufferout,Error);
End;
{------------------------------------------------------------------------}
Function GetMessage(Func : Byte) : String;
Type
Request = Record
Len : Word;
Sub : Byte;
End;
Reply = Record
Len : Word;
messlen : Byte;
mess : array[1..126] of byte;
End;
Var {page 376 & 375}
Bufferin : request;
BufferOut : Reply;
duh,x : byte;
Begin
getmessage := '';
fillchar(Bufferin,Sizeof(Bufferin),0);
Fillchar(Bufferout,Sizeof(Bufferout),0);
Bufferin.Len := 1;
Bufferin.Sub := Func;{a personal message or a broadcast message}
bufferout.Len := 128;
CallInt($e1,Bufferin,BufferOut,Error);
duh := bufferout.messlen;
getmessage[0] := chr(duh);
for x := 1to duh do
Getmessage[x] := chr(bufferout.mess[x]);
End;
{------------------------------------------------------------------------}
Procedure SendPersonalMessage(Con : Byte;Message : String);
Type
request = Record
Len : Word;
Sub : Byte;
Data : array[1..228] Of Byte;
End; {likely works. page 375-376}
Reply = Record
Len : word;
Num : Byte;
Results : Array[1..100] of byte;
End;
Var
Bufferin : request;
Bufferout : reply;
x,i : byte;
Begin
fillchar(Bufferin,Sizeof(Bufferin),0);
Fillchar(Bufferout,Sizeof(Bufferout),0);
Bufferin.sub := $04;
i := 1;
bufferin.data[i] := 1;{num of connections}
Inc(i);
Bufferin.Data[i] := Con;{which connection number?}
inc(I);
Bufferin.data[i] := length(message);{length of message}
Inc(i);
For X := 1 to Length(Message) do{actual message}
Begin
bufferin.data[i] := ord(message[x]);
inc(i);
End;
Bufferin.Len := 4+Length(message);
callint($e1,bufferin,bufferout,error);{call the int}
End;
{------------------------------------------------------------------------}
procedure broadcastToConsole(message : string);
Type
request = record
len : word;
sub : byte;
Messlen : byte;
mess : array[1..$3c] of byte;
end;
var
bufferin : request;
bufferout : noreturn;
x : byte;
Begin
fillchar(Bufferin,Sizeof(Bufferin),0);
Fillchar(Bufferout,Sizeof(Bufferout),0);
bufferin.len := 2+length(message);
bufferin.sub := $09;
Bufferin.messlen := Length(Message);
for x := 1 to Length(Message) do
Bufferin.Mess[x] := ord(message[x]);
callint($e1,bufferin,bufferout,error);
End;
{------------------------------------------------------------------------}
function idnumber : longint;
var
id : longint;
l : byte;
begin
getbinderyaccess(L,id);{just uses this routine}
idnumber := id;
end;
{------------------------------------------------------------------------}
procedure Getconnectioninfo(Con : byte;Var U : userrec);
type
request = record
len : word; {this routine}
sub : byte; {will get all}
connect : byte; {info about a}
end; {connection..}
reply = record
len : word;
id : longint;
ot :word;
stuff : array[1..48] of byte;
log : array[0..6] of byte;
end;
var
bufferin : request;
bufferout : reply;
x,i : byte;
t1,t2 : string;
year : string;
date : string;
begin
bufferin.len := 2;
bufferin.sub := $16;
bufferin.connect := con;
fillchar(Bufferout,sizeof(Bufferout),0);
bufferout.len := sizeof(Bufferout)-2;
callint($e3,bufferin,bufferout,error);
u.objtype := bufferout.ot;
u.id := bufferout.id;
t1 := '';
t1[0] := chr(48);
i := 1;
for x := 1 to 48 do
begin
t1[x] := chr(bufferout.stuff[i]);
inc(i);
end;
t2 := '';
t2[0] := chr(7);
i := 48;
u.name := t1;
t1 := '';
with bufferout do
begin
str(log[1],t1);{month}
date := t1+'\';
str(log[2],t1);
date := date+t1+'\'; {day}
str(log[0],t1); {year}
date := date+t1;
u.logindate := date;
str(log[3],t1);{hour}
date := t1+':';
str(log[4],t1);
date := date+T1+':';{min}
str(log[5],t1);{sec}
date := date+t1;
u.logintime := t1;
u.weekday := Week[log[6]];
end;
delnulls(u.name);
u.connection := con;
end;
{------------------------------------------------------------------------}
Begin
End.
[Back to NETWORK SWAG index] [Back to Main SWAG index] [Original]