[Back to NETWORK SWAG index] [Back to Main SWAG index] [Original]
UNIT Novell;
{---------------------------------------------------------------------------}
{ }
{ This UNIT provides a method of obtaining Novell information from a user }
{ written program. This UNIT was tested on an IBM AT running DOS 5.0 & }
{ using Netware 2.15. The unit compiled cleanly under Turbo Pascal 6.0 }
{ }
{ The UNIT has been updated to compile and run under Turbo Pascal for }
{ Windows. }
{ }
{ *** Tested ok with Netware 386 3.11 Sept/91 }
{ }
{ Last Update: 11 Dec 91 }
{ }
{---------------------------------------------------------------------------}
{ }
{ Any questions can be directed to: }
{ }
{ Mark Bramwell }
{ University of Western Ontario }
{ London, Ontario, N6A 3K7 }
{ }
{ Phone: 519-473-3618 [work] 519-473-3618 [home] }
{ }
{ Bitnet: mark@hamster.business.uwo.ca Packet: ve3pzr @ ve3gyq }
{ }
{ Anonymous FTP Server Internet Address: 129.100.22.100 }
{ }
{---------------------------------------------------------------------------}
{ Any other Novell UNITS gladly accepted. }
{
mods February 1 1991, Ross Lazarus (rml@extro.ucc.su.AU.OZ)
var retcodes in procedure getservername, get_broadcast_message,
verify_object_password comments, password conversion to upper case,
Seems to work fine on a Netware 3.00 and on 3.01 servers -
}
INTERFACE
{$IFDEF WINDOWS}
Uses WinDos;
{$ENDIF WINDOWS}
{$IFNDEF WINDOWS}
Uses Dos;
{$ENDIF WINDOWS}
Const
Months : Array [1..12] of String[3] = ('JAN','FEB','MAR','APR','MAY','JUN',
'JUL','AUG','SEP','OCT','NOV','DEC');
HEXDIGITS : Array [0..15] of char = '0123456789ABCDEF';
Type byte4 = array [1..4] of byte;
byte6 = array [1..6] of byte;
VAR
{----------------------------------------------------------------------}
{ The following values can be pulled from an user written application }
{ }
{ The programmer would first call GetServerInfo. }
{ Then he could writeln(serverinfo.name) to print the server name }
{----------------------------------------------------------------------}
ServerInfo : Record
ReturnLength : Integer;
Server : Packed Array [1..48] of Byte;
NetwareVers : Byte;
NetwareSubV : Byte;
ConnectionMax : array [1..2] of byte;
ConnectionUse : array [1..2] of byte;
MaxConVol : array [1..2] of byte; {}
OS_revision : byte;
SFT_level : byte;
TTS_level : byte;
peak_used : array [1..2] of byte;
accounting_version : byte;
vap_version : byte;
queuing_version : byte;
print_server_version : byte;
virtual_console_version : byte;
security_restrictions_version : byte;
Internetwork_version_version : byte;
Undefined : Packed Array [1..60] of Byte;
peak_connections_used : integer;
Connections_max : integer;
Connections_in_use : integer;
Max_connected_volumes : integer;
name : string;
End;
procedure get_server_lan_driver_information(var _lan_board_number : integer;
{ This will return info on what } var _text1,_text2:string;
{ type of network cards are being } var _network_address : byte4;
{ used in the server. } var _host_address : byte6;
var _driver_installed,
_option_number,
_retcode : integer);
procedure GetConnectionInfo(var LogicalStationNo: integer;
var name,hex_id:string;
var conntype:integer;
var datetime:string;
var retcode:integer);
{ returns username and login date/time when you supply the station number. }
procedure clear_connection(connection_number : integer; var retcode :
integer);
{ kicks the workstation off the server}
procedure GetHexID(var userid,hexid: string;
var retcode: integer);
{ returns the novell hexid of an username when you supply the username. }
procedure GetServerInfo;
{ returns various info of the default server }
procedure GetUser( var _station: integer;
var _username: string;
var retcode:integer);
{ returns logged-in station username when you supply the station number. }
procedure GetNode( var hex_addr: string;
var retcode: integer);
{ returns your physical network node in hex. }
procedure GetStation( var _station: integer;
var retcode: integer);
{ returns the station number of your workstation }
procedure GetServerName(var servername : string;
var retcode : integer);
{ returns the name of the current server }
procedure Send_Message_to_Username(username,message : string;
var retcode: integer);
{ Sends a novell message to the userid's workstation }
procedure Send_Message_to_Station(station:integer;
message : string;
var retcode: integer);
{ Sends a message to the workstation station # }
procedure Get_Volume_Name(var volume_name: string;
volume_number: integer;
var retcode:integer);
{ Gets the Volume name from Novell network drive }
{ Example: SYS Note: default drive must be a }
{ network drive. }
procedure get_realname(var userid:string;
var realname:string;
var retcode:integer);
{ You supply the userid, and it returns the realname as stored by syscon. }
{ Example: userid=mbramwel realname=Mark Bramwell }
procedure get_broadcast_mode(var bmode:integer);
procedure set_broadcast_mode(bmode:integer);
procedure get_broadcast_message(var bmessage: string;
var retcode : integer);
procedure get_server_datetime(var _year,_month,_day,_hour,_min,_sec,_dow:integer);
{ pulls from the server the date, time and Day Of Week }
procedure set_date_from_server;
{ pulls the date from the server and updates the workstation's clock }
procedure set_time_from_server;
{ pulls the time from the server and updates the workstation's clock }
procedure get_server_version(var _version : string);
procedure open_message_pipe(var _connection, retcode : integer);
procedure close_message_pipe(var _connection, retcode : integer);
procedure check_message_pipe(var _connection, retcode : integer);
procedure send_personal_message(var _connection : integer; var _message :
string; var retcode : integer);
procedure get_personal_message(var _connection : integer; var _message :
string; var retcode : integer);
procedure get_drive_connection_id(var drive_number,
server_number : integer);
{pass the drive number - it returns the server number if a network volume}
procedure get_file_server_name(var server_number : integer;
var server_name : string);
procedure get_directory_path(var handle : integer;
var pathname : string;
var retcode : integer);
procedure get_drive_handle_id(var drive_number, handle_number : integer);
procedure set_preferred_connection_id(server_num : integer);
procedure get_preferred_connection_id(var server_num : integer);
procedure set_primary_connection_id(server_num : integer);
procedure get_primary_connection_id(var server_num : integer);
procedure get_default_connection_id(var server_num : integer);
procedure Get_Internet_Address(station : integer;
var net_number, node_addr, socket_number :
string;
var retcode : integer);
procedure login_to_file_server(obj_type:integer; _name,_password : string;var
retcode:integer);
procedure logout;
procedure logout_from_file_server(var id: integer);
procedure down_file_server(flag:integer;var retcode : integer);
procedure detach_from_file_server(var id,retcode:integer);
procedure disable_file_server_login(var retcode : integer);
procedure enable_file_server_login(var retcode : integer);
procedure alloc_permanent_directory_handle(var _dir_handle : integer;
var _drive_letter : string;
var _dir_path_name : string;
var _new_dir_handle : integer;
var _effective_rights: byte;
var _retcode : integer);
procedure map(var drive_spec:string;
var _rights:byte;
var _retcode : integer);
procedure scan_object(var last_object: longint;
var search_object_type: integer;
var search_object : string;
var replyid : longint;
var replytype : integer; var replyname : string;
var replyflag : integer; var replysecurity : byte;
var replyproperties : integer; var retcode : integer);
procedure verify_object_password(var object_type:integer; var
object_name,password : string; var retcode : integer);
{--------------------------------------------------------------------------}
{ file locking routines }
{-----------------------}
procedure log_file(lock_directive:integer; log_filename: string;
log_timeout:integer; var retcode:integer);
procedure clear_file_set;
procedure lock_file_set(lock_timeout:integer; var retcode:integer);
procedure release_file_set;
procedure release_file(log_filename: string; var retcode:integer);
procedure clear_file(log_filename: string; var retcode:integer);
{--------------------------------------------------------------------------
---}
procedure open_semaphore( _name:string;
_initial_value:shortint;
var _open_count:integer;
var _handle:longint;
var retcode:integer);
procedure close_semaphore(var _handle:longint; var retcode:integer);
procedure examine_semaphore(var _handle:longint; var _value:shortint; var
_count, retcode:integer);
procedure signal_semaphore(var _handle:longint; var retcode:integer);
procedure wait_on_semaphore(var _handle:longint; _timeout:integer; var
retcode:integer);
procedure purge_all_erased_files(var retcode:integer);
procedure purge_erased_files(var retcode:integer);
{--------------------------------------------------------------------------
---}
IMPLEMENTATION
const
zero = '0';
var
retcode : byte; { return code for all functions }
{$IFDEF WINDOWS}
regs : TRegisters; { Turbo Pascal for Windows }
{$ENDIF WINDOWS}
{$IFNDEF WINDOWS}
regs : registers; { Turbo Pascal for Dos }
{$ENDIF WINDOWS}
procedure get_volume_name(var volume_name: string; volume_number: integer;
var retcode:integer);
{
pulls volume names from default server. Use set_preferred_connection_id to
set the default server.
retcodes: 0=ok, 1=no volume assigned 98h= # out of range
}
VAR
count,count1 : integer;
requestbuffer : record
len : integer;
func : byte;
vol_num : byte;
end;
replybuffer : record
len : integer;
vol_length : byte;
name : packed array [1..16] of byte;
end;
begin
With Regs do
begin
ah := $E2;
ds := seg(requestbuffer);
si := ofs(requestbuffer);
es := seg(replybuffer);
di := ofs(replybuffer);
end;
With requestbuffer do
begin
len := 2;
func := 6;
vol_num := volume_number; {passed from calling program}
end;
With replybuffer do
begin
len := 17;
vol_length := 0;
for count := 1 to 16 do name[count] := $00;
end;
msdos(Regs);
volume_name := '';
if replybuffer.vol_length > 0 then
for count := 1 to replybuffer.vol_length do
volume_name := volume_name + chr(replybuffer.name[count]);
retcode := Regs.al;
end;
procedure verify_object_password(var object_type:integer; var
object_name,password : string; var retcode : integer);
{
for netware 3.xx remember to have previously (eg in the autoexec file )
set allow unencrypted passwords = on
on the console, otherwise this call always fails !
Note that intruder lockout status is affected by this call !
Netware security isn't that stupid....
Passwords appear to need to be converted to upper case
retcode apparent meaning as far as I can work out....
0 verification of object_name/password combination
197 account disabled due to intrusion lockout
214 unencrypted password calls not allowed on this v3+ server
252 no such object_name on this server
255 failure to verify object_name/password combination
}
var request_buffer : record
buffer_length : integer;
subfunction : byte;
obj_type : array [1..2] of byte;
obj_name_length : byte;
obj_name : array [1..47] of byte;
password_length : byte;
obj_password : array [1..127] of byte;
end;
reply_buffer : record
buffer_length : integer;
end;
count : integer;
begin
With request_buffer do
begin
buffer_length := 179;
subfunction := $3F;
obj_type[1] := 0;
obj_type[2] := object_type;
obj_name_length := 47;
for count := 1 to 47 do
obj_name[count] := $00;
for count := 1 to length(object_name) do
obj_name[count] := ord(object_name[count]);
password_length := length(password);
for count := 1 to 127 do
obj_password[count] := $00;
if password_length > 0 then
for count := 1 to password_length do
obj_password[count] := ord(upcase(password[count]));
end;
With reply_buffer do
buffer_length := 0;
With regs do
begin
Ah := $E3;
Ds := Seg(Request_Buffer);
Si := Ofs(Request_Buffer);
Es := Seg(Reply_Buffer);
Di := Ofs(Reply_Buffer);
End;
msdos(regs);
retcode := regs.al;
end; { verify_object_password }
procedure scan_object(var last_object: longint; var search_object_type:
integer;
var search_object : string; var replyid : longint;
var replytype : integer; var replyname : string;
var replyflag : integer; var replysecurity : byte;
var replyproperties : integer; var retcode : integer);
var
request_buffer : record
buffer_length : integer;
subfunction : byte;
last_seen : longint;
search_type : array [1..2] of byte;
name_length : byte;
search_name : array [1..47] of byte;
end;
reply_buffer : record
buffer_length : integer;
object_id : longint;
object_type : array [1..2] of byte;
object_name : array [1..48] of byte;
object_flag : byte;
security : byte;
properties : byte;
end;
count : integer;
begin
with request_buffer do
begin
buffer_length := 55;
subfunction := $37;
last_seen := last_object;
if search_object_type = -1 then { -1 = wildcard }
begin
search_type[1] := $ff;
search_type[2] := $ff;
end else
begin
search_type[1] := 0;
search_type[2] := search_object_type;
end;
name_length := length(search_object);
for count := 1 to 47 do search_name[count] := $00;
if name_length > 0 then for count := 1 to name_length do
search_name[count] := ord(upcase(search_object[count]));
end;
With reply_buffer do
begin
buffer_length := 57;
object_id:= 0;
object_type[1] := 0;
object_type[2] := 0;
for count := 1 to 48 do object_name[count] := $00;
object_flag := 0;
security := 0;
properties := 0;
end;
With Regs Do Begin
Ah := $E3;
Ds := Seg(Request_Buffer);
Si := Ofs(Request_Buffer);
Es := Seg(Reply_Buffer);
Di := Ofs(Reply_Buffer);
End;
msdos(regs);
retcode := regs.al;
With reply_buffer do
begin
replyflag := object_flag;
replyproperties := properties;
replysecurity := security;
replytype := object_type[2];
replyid := object_id;
end;
count := 1;
replyname := '';
While (count <= 48) and (reply_buffer.Object_Name[count] <> 0) Do Begin
replyName := replyname + Chr(reply_buffer.Object_name[count]);
count := count + 1;
End { while };
end;
procedure alloc_permanent_directory_handle
(var _dir_handle : integer; var _drive_letter : string;
var _dir_path_name : string; var _new_dir_handle : integer;
var _effective_rights: byte; var _retcode : integer);
var request_buffer : record
buffer_length : integer;
subfunction : byte;
dir_handle : byte;
drive_letter : byte;
dir_path_length : byte;
dir_path_name : packed array [1..255] of byte;
end;
reply_buffer : record
buffer_length : integer;
new_dir_handle : byte;
effective_rights : byte;
end;
count : integer;
begin
With request_buffer do
begin
buffer_length := 259;
subfunction := $12;
dir_handle := _dir_handle;
drive_letter := ord(upcase(_drive_letter[1]));
dir_path_length := length(_dir_path_name);
for count := 1 to 255 do dir_path_name[count] := $0;
if dir_path_length > 0 then for count := 1 to dir_path_length do
dir_path_name[count] := ord(upcase(_dir_path_name[count]));
end;
With reply_buffer do
begin
buffer_length := 2;
new_dir_handle := 0;
effective_rights := 0;
end;
With Regs Do Begin
Ah := $E2;
Ds := Seg(Request_Buffer);
Si := Ofs(Request_Buffer);
Es := Seg(Reply_Buffer);
Di := Ofs(Reply_Buffer);
End;
msdos(regs);
_retcode := regs.al;
_effective_rights := $0;
_new_dir_handle := $0;
if _retcode = 0 then
begin
_effective_rights := reply_buffer.effective_rights;
_new_dir_handle := reply_buffer.new_dir_handle;
end;
end;
procedure map(var drive_spec:string; var _rights:byte; var _retcode :
integer);
var
dir_handle : integer;
path_name : string;
rights : byte;
drive_number : integer;
drive_letter : string;
new_handle : integer;
retcode : integer;
begin
{first thing is we strip leading and trailing blanks}
while drive_spec[1]=' ' do drive_spec :=
copy(drive_spec,2,length(drive_spec));
while drive_spec[length(drive_spec)]=' ' do drive_spec :=
copy(drive_spec,1,length(drive_spec)-1);
drive_number := ord(upcase(drive_spec[1]))-65;
drive_letter := upcase(drive_spec[1]);
path_name := copy(drive_spec,4,length(drive_spec));
get_drive_handle_id(drive_number,dir_handle);
alloc_permanent_directory_handle(dir_handle,drive_letter,path_name,new_handle,
rights,retcode);
_retcode := retcode;
_rights := rights;
end;
procedure down_file_server(flag:integer;var retcode : integer);
var
request_buffer : record
buffer_length : integer;
subfunction : byte;
down_flag : byte;
end;
reply_buffer : record
buffer_length : integer;
end;
begin
With request_buffer do
begin
buffer_length := 2;
subfunction := $D3;
down_flag := flag;
end;
reply_buffer.buffer_length := 0;
With Regs Do Begin
Ah := $E3;
Ds := Seg(Request_Buffer);
Si := Ofs(Request_Buffer);
Es := Seg(Reply_Buffer);
Di := Ofs(Reply_Buffer);
End;
msdos(regs);
retcode := regs.al;
end;
procedure set_preferred_connection_id(server_num : integer);
begin
regs.ah := $F0;
regs.al := $00;
regs.ds := 0;
regs.es := 0;
regs.dl := server_num;
msdos(regs);
end;
procedure set_primary_connection_id(server_num : integer);
begin
regs.ah := $F0;
regs.al := $04;
regs.ds := 0;
regs.es := 0;
regs.dl := server_num;
msdos(regs);
end;
procedure get_primary_connection_id(var server_num : integer);
begin
regs.ah := $F0;
regs.al := $05;
regs.es := 0;
regs.ds := 0;
msdos(regs);
server_num := regs.al;
end;
procedure get_default_connection_id(var server_num : integer);
begin
regs.ah := $F0;
regs.al := $02;
regs.es := 0;
regs.ds := 0;
msdos(regs);
server_num := regs.al;
end;
procedure get_preferred_connection_id(var server_num : integer);
begin
regs.ah := $F0;
regs.al := $02;
regs.ds := 0;
regs.es := 0;
msdos(regs);
server_num := regs.al;
end;
procedure get_drive_connection_id(var drive_number, server_number : integer);
var
drive_table : array [1..32] of byte;
count : integer;
p : ^byte;
begin
regs.ah := $EF;
regs.al := $02;
regs.es := 0;
regs.ds := 0;
msdos(regs);
p := ptr(regs.es, regs.si);
move(p^,drive_table,32);
if ((drive_number < 0) or (drive_number > 32)) then drive_number := 1;
server_number := drive_table[drive_number];
end;
procedure get_drive_handle_id(var drive_number, handle_number : integer);
var
drive_table : array [1..32] of byte;
count : integer;
p : ^byte;
begin
regs.ah := $EF;
regs.al := $00;
regs.ds := 0;
regs.es := 0;
msdos(regs);
p := ptr(regs.es, regs.si);
move(p^,drive_table,32);
if ((drive_number < 0) or (drive_number > 32)) then drive_number := 1;
handle_number := drive_table[drive_number];
end;
procedure get_file_server_name(var server_number : integer; var server_name :
string);
var
name_table : array [1..8*48] of byte;
server : array [1..8] of string;
count : integer;
count2 : integer;
p : ^byte;
no_more : integer;
begin
regs.ah := $EF;
regs.al := $04;
regs.ds := 0;
regs.es := 0;
msdos(regs);
no_more := 0;
p := ptr(regs.es, regs.si);
move(p^,name_table,8*48);
for count := 1 to 8 do server[count] := '';
for count := 0 to 7 do
begin
no_more := 0;
for count2 := (count*48)+1 to (count*48)+48 do if name_table[count2] <>
$00
then
begin
if no_more=0 then server[count+1] := server[count+1] +
chr(name_table[count2]);
end else no_more:=1; {scan until 00h is found}
end;
if ((server_number<1) or (server_number>8)) then server_number := 1;
server_name := server[server_number];
end;
procedure disable_file_server_login(var retcode : integer);
var request_buffer : record
buffer_length : integer;
subfunction : byte
end;
reply_buffer : record
buffer_length : integer;
end;
begin
With Regs Do Begin
Ah := $E3;
Ds := Seg(Request_Buffer);
Si := Ofs(Request_Buffer);
Es := Seg(Reply_Buffer);
Di := Ofs(Reply_Buffer);
End;
With request_buffer do
begin
buffer_length := 1;
subfunction := $CB;
end;
reply_buffer.buffer_length := 0;
msdos(regs);
retcode := regs.al;
end;
procedure enable_file_server_login(var retcode : integer);
var request_buffer : record
buffer_length : integer;
subfunction : byte
end;
reply_buffer : record
buffer_length : integer;
end;
begin
With Regs Do Begin
Ah := $E3;
Ds := Seg(Request_Buffer);
Si := Ofs(Request_Buffer);
Es := Seg(Reply_Buffer);
Di := Ofs(Reply_Buffer);
End;
With request_buffer do
begin
buffer_length := 1;
subfunction := $CC;
end;
reply_buffer.buffer_length := 0;
msdos(regs);
retcode := regs.al;
end;
procedure get_directory_path(var handle : integer; var pathname : string; var
retcode : integer);
var count : integer;
request_buffer : record
len : integer;
subfunction : byte;
dir_handle : byte;
end;
reply_buffer : record
len : integer;
path_len : byte;
path_name : array [1..255] of byte;
end;
begin
With Regs Do Begin
Ah := $e2;
Ds := Seg(Request_Buffer);
Si := Ofs(Request_Buffer);
Es := Seg(Reply_Buffer);
Di := Ofs(Reply_Buffer);
End;
With request_buffer do
begin
len := 2;
subfunction := $01;
dir_handle := handle;
end;
With reply_buffer do
begin
len := 256;
path_len := 0;
for count := 1 to 255 do path_name[count] := $00;
end;
msdos(regs);
retcode := regs.al;
pathname := '';
if reply_buffer.path_len > 0 then for count := 1 to reply_buffer.path_len do
pathname := pathname + chr(reply_buffer.path_name[count]);
end;
procedure detach_from_file_server(var id,retcode:integer);
begin
regs.ah := $F1;
regs.al := $01;
regs.dl := id;
msdos(regs);
retcode := regs.al;
end;
procedure getstation( var _station: integer; var retcode: integer);
begin
With Regs do
begin
ah := $DC;
ds := 0;
si := 0;
end;
MsDos( Regs );
_station := Regs.al;
retcode := 0;
end;
procedure GetHexID( var userid,hexid: string; var retcode: integer);
var
i,x : integer;
hex_id : string;
requestbuffer : record
len : integer;
func : byte;
conntype : packed array [1..2] of byte;
name_len : byte;
name : packed array [1..47] of char;
end;
replybuffer : record
len : integer;
uniqueid1: packed array [1..2] of byte;
uniqueid2: packed array [1..2] of byte;
conntype : word;
name : packed array [1..48] of byte;
end;
begin
regs.ah := $E3;
requestbuffer.func := $35;
regs.ds := seg(requestbuffer);
regs.si := ofs(requestbuffer);
regs.es := seg(replybuffer);
regs.di := ofs(replybuffer);
requestbuffer.len := 52;
replybuffer.len := 55;
requestbuffer.name_len := length(userid);
for i := 1 to length(userid) do requestbuffer.name[i] := userid[i];
requestbuffer.conntype[2] := $1;
requestbuffer.conntype[1] := $0;
replybuffer.conntype := 1;
msdos(regs);
retcode := regs.al; {
if retcode = $96 then writeln('Server out of memory');
if retcode = $EF then writeln('Invalid name');
if retcode = $F0 then writeln('Wildcard not allowed');
if retcode = $FC then writeln('No such object *',userid,'*');
if retcode = $FE then writeln('Server bindery locked');
if retcode = $FF then writeln('Bindery failure'); }
hex_id := '';
if retcode = 0 then
begin
hex_id := hexdigits[replybuffer.uniqueid1[1] shr 4];
hex_id := hex_id + hexdigits[replybuffer.uniqueid1[1] and $0F];
hex_id := hex_id + hexdigits[replybuffer.uniqueid1[2] shr 4];
hex_id := hex_id + hexdigits[replybuffer.uniqueid1[2] and $0F];
hex_id := hex_id + hexdigits[replybuffer.uniqueid2[1] shr 4];
hex_id := hex_id + hexdigits[replybuffer.uniqueid2[1] and $0F];
hex_id := hex_id + hexdigits[replybuffer.uniqueid2[2] shr 4];
hex_id := hex_id + hexdigits[replybuffer.uniqueid2[2] and $0F];
{ Now we chop off leading zeros }
while hex_id[1] = '0' do hex_id := copy(hex_id,2,length(hex_id));
end;
hexid := hex_id;
end;
Procedure GetConnectionInfo
(Var LogicalStationNo: Integer; Var Name: String; Var HEX_ID: String;
Var ConnType : Integer; Var DateTime : String; Var retcode:integer);
Var
I,X : Integer;
RequestBuffer : Record
PacketLength : Integer;
FunctionVal : Byte;
ConnectionNo : Byte;
End;
ReplyBuffer : Record
ReturnLength : Integer;
UniqueID1 : Packed Array [1..2] of byte;
UniqueID2 : Packed Array [1..2] of byte;
NWConnType : Packed Array [1..2] of byte;
ObjectName : Packed Array [1..48] of Byte;
LoginTime : Packed Array [1..8] of Byte;
End;
Month : String[3];
Year,
Day,
Hour,
Minute : String[2];
Begin
With RequestBuffer Do Begin
PacketLength := 2;
FunctionVal := 22; { 22 = Get Station Info }
ConnectionNo := LogicalStationNo;
End;
ReplyBuffer.ReturnLength := 62;
With Regs Do Begin
Ah := $e3;
ds := 0;
es := 0;
Ds := Seg(RequestBuffer);
Si := Ofs(RequestBuffer);
Es := Seg(ReplyBuffer);
Di := Ofs(ReplyBuffer);
End;
MsDos(Regs);
retcode := regs.al;
name := '';
hex_id := hexdigits[replybuffer.uniqueid1[1] shr 4];
hex_id := hex_id + hexdigits[replybuffer.uniqueid1[1] and $0F];
hex_id := hex_id + hexdigits[replybuffer.uniqueid1[2] shr 4];
hex_id := hex_id + hexdigits[replybuffer.uniqueid1[2] and $0F];
hex_id := hex_id + hexdigits[replybuffer.uniqueid2[1] shr 4];
hex_id := hex_id + hexdigits[replybuffer.uniqueid2[1] and $0F];
hex_id := hex_id + hexdigits[replybuffer.uniqueid2[2] shr 4];
hex_id := hex_id + hexdigits[replybuffer.uniqueid2[2] and $0F];
{ Now we chop off leading zeros }
while ( (hex_id[1]='0') and (length(hex_id) > 1) )
do hex_id := copy(hex_id,2,length(hex_id));
ConnType := replybuffer.nwconntype[2];
datetime := '';
If hex_id <> '0' Then Begin {Grab username}
With ReplyBuffer Do Begin
I := 1;
While (I <= 48) and (ObjectName[I] <> 0) Do
Begin
Name[I] := Chr(Objectname[I]);
I := I + 1;
End { while };
Name[0] := Chr(I - 1);
End; {With} End; {if}
If hex_id <> '0' then With replybuffer do {Grab login time}
begin
Str(LoginTime[1]:2,Year);
Month := Months[LoginTime[2]];
Str(LoginTime[3]:2,Day);
Str(LoginTime[4]:2,Hour);
Str(LoginTime[5]:2,Minute);
If Day[1] = ' ' Then Day[1] := '0';
If Hour[1] = ' ' Then Hour[1] := '0';
If Minute[1] = ' ' Then Minute[1] := '0';
DateTime := Day+'-'+Month+'-'+Year+' ' + Hour + ':' + Minute;
End;
End { GetConnectInfo };
procedure login_to_file_server(obj_type:integer;_name,_password : string;var
retcode:integer);
var request_buffer : record
B_length : integer;
subfunction : byte;
o_type : packed array [1..2] of byte;
name_length : byte;
obj_name : packed array [1..47] of byte;
password_length : byte;
password : packed array [1..27] of byte;
end;
reply_buffer : record
R_length : integer;
end;
count : integer;
begin
With request_buffer do
begin
B_length := 79;
subfunction := $14;
o_type[1] := 0;
o_type[2] := obj_type;
for count := 1 to 47 do obj_name[count] := $0;
for count := 1 to 27 do password[count] := $0;
if length(_name) > 0 then
for count := 1 to length(_name) do
obj_name[count]:=ord(upcase(_name[count]));
if length(_password) > 0 then
for count := 1 to length(_password) do
password[count]:=ord(upcase(_password[count]));
{set to full length of field}
name_length := 47;
password_length := 27;
end;
With reply_buffer do
begin
R_length := 0;
end;
With Regs Do Begin
Ah := $e3;
Ds := Seg(Request_Buffer);
Si := Ofs(Request_Buffer);
Es := Seg(reply_buffer);
Di := Ofs(reply_buffer);
End;
MsDos(Regs);
retcode := regs.al
end;
procedure logout;
{logout from all file servers}
begin
regs.ah := $D7;
msdos(regs);
end;
procedure logout_from_file_server(var id: integer);
{logout from one file server}
begin
regs.ah := $F1;
regs.al := $02;
regs.dl := id;
msdos(regs);
end;
procedure send_message_to_username(username,message : string; var retcode:
integer);
VAR
count1 : byte;
userid : string;
stationid : integer;
ret_code : integer;
begin
ret_code := 1;
for count1:= 1 to length(username) do
username[count1]:=upcase(username[count1]); { Convert to upper case }
getserverinfo;
for count1:= 1 to serverinfo.connections_max do
begin
stationid := count1;
getuser( stationid, userid, retcode);
if userid = username then
begin
ret_code := 0;
send_message_to_station(stationid, message, retcode);
end;
end; { end of count }
retcode := ret_code;
{ retcode = 0 if sent, 1 if userid not found }
end; { end of procedure }
Procedure GetServerInfo;
Var
RequestBuffer : Record
PacketLength : Integer;
FunctionVal : Byte;
End;
I : Integer;
Begin
With RequestBuffer Do Begin
PacketLength := 1;
FunctionVal := 17; { 17 = Get Server Info }
End;
ServerInfo.ReturnLength := 128;
With Regs Do Begin
Ah := $e3;
Ds := Seg(RequestBuffer);
Si := Ofs(RequestBuffer);
Es := Seg(ServerInfo);
Di := Ofs(ServerInfo);
End;
MsDos(Regs);
With serverinfo do
begin
connections_max := connectionmax[1]*256 + connectionmax[2];
connections_in_use := connectionuse[1]*256 + connectionuse[2];
max_connected_volumes := maxconvol[1]*256 + maxconvol[2];
peak_connections_used := peak_used[1]*256 + peak_used[2];
name := '';
i := 1;
while ((server[i] <> 0) and (i<>48)) do
begin
name := name + chr(server[i]);
i := i + 1;
end;
end;
End;
procedure GetServerName(var servername : string; var retcode : integer);
{-----------------------------------------------------------------}
{ This routine returns the same as GetServerInfo. This routine }
{ was kept to maintain compatibility with the older novell unit. }
{-----------------------------------------------------------------}
begin
getserverinfo;
servername := serverinfo.name;
retcode := 0;
end;
procedure send_message_to_station(station:integer; message : string; var retcode : integer);
VAR
req_buffer : record
buffer_len : integer;
subfunction: byte;
c_count : byte;
c_list : byte;
msg_length : byte;
msg : packed array [1..55] of byte;
end;
rep_buffer : record
buffer_len : integer;
c_count : byte;
r_list : byte;
end;
count1 : integer;
begin
if length(message) > 55 then message:=copy(message,1,55);
With Regs do
begin
ah := $E1;
ds:=seg(req_buffer);
si:=ofs(req_buffer);
es:=seg(rep_buffer);
di:=ofs(rep_buffer);
End;
With req_buffer do
begin
buffer_len := 59;
subfunction := 00;
c_count := 1;
c_list := station;
for count1:= 1 to 55 do msg[count1]:= $00; { zero the buffer }
msg_length := length(message); { message length }
for count1:= 1 to length(message) do
msg[count1]:=ord(message[count1]);
End;
With rep_buffer do
begin
buffer_len := 2;
c_count := 1;
r_list := 0;
End;
msdos( Regs );
retcode:= rep_buffer.r_list;
end;
procedure getuser( var _station: integer; var _username: string; var retcode:
integer);
{This procedure provides a shorter method of obtaining just the USERID.}
var
gu_hexid : string;
gu_conntype : integer;
gu_datetime : string;
begin
getconnectioninfo(_station,_username,gu_hexid,gu_conntype,gu_datetime,retcode);
end;
PROCEDURE GetNode( var hex_addr: string; var retcode: integer );
{ get the physical station address }
Const
Hex_Set :packed array[0..15] of char = '0123456789ABCDEF';
Begin { GetNode }
{Get the physical address from the Network Card}
Regs.Ah := $EE;
regs.ds := 0;
regs.es := 0;
MsDos(Regs);
hex_addr := '';
hex_addr := hex_addr + hex_set[(regs.ch shr 4)];
hex_addr := hex_addr + hex_set[(regs.ch and $0f)];
hex_addr := hex_addr + hex_set[(regs.cl shr 4) ];
hex_addr := hex_addr + hex_set[(regs.cl and $0f)];
hex_addr := hex_addr + hex_set[(regs.bh shr 4)];
hex_addr := hex_addr + hex_set[(regs.bh and $0f)];
hex_addr := hex_addr + hex_set[(regs.bl shr 4)];
hex_addr := hex_addr + hex_set[(regs.bl and $0f)];
hex_addr := hex_addr + hex_set[(regs.ah shr 4)];
hex_addr := hex_addr + hex_set[(regs.ah and $0f)];
hex_addr := hex_addr + hex_set[(regs.al shr 4)];
hex_addr := hex_addr + hex_set[(regs.al and $0f)];
retcode := 0;
End; { Getnode }
PROCEDURE Get_Internet_Address(station : integer; var net_number, node_addr,
socket_number : string; var retcode : integer);
Const
Hex_Set :packed array[0..15] of char = '0123456789ABCDEF';
Var Request_buffer : record
length : integer;
subfunction : byte;
connection : byte;
end;
Reply_Buffer : record
length : integer;
network : array [1..4] of byte;
node : array [1..6] of byte;
socket : array [1..2] of byte;
end;
count : integer;
_node_addr : string;
_socket_number : string;
_net_number : string;
begin
With Regs do
begin
ah := $E3;
ds:=seg(request_buffer);
si:=ofs(request_buffer);
es:=seg(reply_buffer);
di:=ofs(reply_buffer);
End;
With request_buffer do
begin
length := 2;
subfunction := $13;
connection := station;
end;
With reply_buffer do
begin
length := 12;
for count := 1 to 4 do network[count] := 0;
for count := 1 to 6 do node[count] := 0;
for count := 1 to 2 do socket[count] := 0;
end;
msdos(regs);
retcode := regs.al;
_net_number := '';
_node_addr := '';
_socket_number := '';
if retcode = 0 then
begin
for count := 1 to 4 do
begin
_net_number := _net_number + hex_set[ (reply_buffer.network[count] shr 4)
];
_net_number := _net_number + hex_set[ (reply_buffer.network[count] and
$0F) ];
end;
for count := 1 to 6 do
begin
_node_addr := _node_addr + (hex_set[ (reply_buffer.node[count] shr 4) ]);
_node_addr := _node_addr + (hex_set[ (reply_buffer.node[count] and $0F)
]);
end;
for count := 1 to 2 do
begin
_socket_number := _socket_number + (hex_set[ (reply_buffer.socket[count]
shr 4) ]);
_socket_number := _socket_number + (hex_set[ (reply_buffer.socket[count]
and $0F) ]);
end;
end; {end of retcode=0}
net_number := _net_number;
node_addr := _node_addr;
socket_number := _socket_number;
end;
procedure get_realname(var userid,realname:string; var retcode:integer);
var
requestbuffer : record
buffer_length : array [1..2] of byte;
subfunction : byte;
object_type : array [1..2] of byte;
object_length : byte;
object_name : array [1..47] of byte;
segment : byte;
property_length : byte;
property_name : array [1..14] of byte;
end;
replybuffer : record
buffer_length : array [1..2] of byte;
property_value : array [1..128] of byte;
more_segments : byte;
property_flags : byte;
end;
count : integer;
id : string;
fullname : string;
begin
id := 'IDENTIFICATION';
With requestbuffer do begin
buffer_length[2] := 0;
buffer_length[1] := 69;
subfunction := $3d;
object_type[1]:= 0;
object_type[2]:= 01;
segment := 1;
object_length := 47;
property_length := length(id);
for count := 1 to 47 do object_name[count] := $0;
for count := 1 to length(userid) do object_name[count] :=
ord(userid[count]);
for count := 1 to 14 do property_name[count] := $0;
for count := 1 to length(id) do property_name[count] := ord(id[count]);
end;
With replybuffer do begin
buffer_length[1] := 130;
buffer_length[2] := 0;
for count := 1 to 128 do property_value[count] := $0;
more_segments := 1;
property_flags := 0;
end;
With Regs do begin
Ah := $e3;
Ds := Seg(requestbuffer);
Si := Ofs(requestbuffer);
Es := Seg(replybuffer);
Di := Ofs(replybuffer);
end;
MSDOS(Regs);
retcode := Regs.al;
fullname := '';
count := 1;
if replybuffer.property_value[1] <> 0 then
repeat
begin
if replybuffer.property_value[count]<>0
then fullname := fullname + chr(replybuffer.property_value[count]);
count := count + 1;
end;
until ((count=128) or (replybuffer.property_value[count]=0));
{if regs.al = $96 then writeln('server out of memory');
if regs.al = $ec then writeln('no such segment');
if regs.al = $f0 then writeln('wilcard not allowed');
if regs.al = $f1 then writeln('invalid bindery security');
if regs.al = $f9 then writeln('no property read priv');
if regs.al = $fb then writeln('no such property');
if regs.al = $fc then writeln('no such object');}
if retcode=0 then realname := fullname else realname:='';
end;
procedure get_broadcast_mode(var bmode:integer);
begin
regs.ah := $de;
regs.dl := $04;
msdos(regs);
bmode := regs.al;
end;
procedure set_broadcast_mode(bmode:integer);
begin
if ((bmode > 3) or (bmode < 0)) then bmode := 0;
regs.ah := $de;
regs.dl := bmode;
msdos(regs);
bmode := regs.al;
end;
procedure get_broadcast_message(var bmessage: string; var retcode : integer);
var requestbuffer : record
bufferlength : array [1..2] of byte;
subfunction : byte;
end;
replybuffer : record
bufferlength : array [1..2] of byte;
messagelength : byte;
message : array [1..58] of byte;
end;
count : integer;
begin
With Requestbuffer do begin
bufferlength[1] := 1;
bufferlength[2] := 0;
subfunction := 1;
end;
With replybuffer do begin
bufferlength[1] := 59;
bufferlength[2] := 0;
messagelength := 0;
end;
for count := 1 to 58 do replybuffer.message[count] := $0;
With Regs do begin
Ah := $e1;
Ds := Seg(requestbuffer);
Si := Ofs(requestbuffer);
Es := Seg(replybuffer);
Di := Ofs(replybuffer);
end;
MSDOS(Regs);
retcode := Regs.al;
bmessage := '';
count := 0;
if replybuffer.messagelength > 58 then replybuffer.messagelength := 58;
if replybuffer.messagelength > 0 then
for count := 1 to replybuffer.messagelength do
bmessage := bmessage + chr(replybuffer.message[count]);
{ retcode = 0 if no message, 1 if message was retreived }
if length(bmessage) = 0 then retcode := 1 else retcode := 0;
end;
procedure get_server_datetime(var _year,_month,_day,_hour,_min,_sec,_dow:integer);
var replybuffer : record
year : byte;
month : byte;
day : byte;
hour : byte;
minute : byte;
second : byte;
dow : byte;
end;
begin
With Regs do begin
Ah := $e7;
Ds := Seg(replybuffer);
Dx := Ofs(replybuffer);
end;
MSDOS(Regs);
retcode := Regs.al;
_year := replybuffer.year;
_month := replybuffer.month;
_day := replybuffer.day;
_hour := replybuffer.hour;
_min := replybuffer.minute;
_sec := replybuffer.second;
_dow := replybuffer.dow;
end;
procedure set_date_from_server;
var replybuffer : record
year : byte;
month : byte;
day : byte;
hour : byte;
minute : byte;
second : byte;
dow : byte;
end;
begin
With Regs do begin
Ah := $e7;
Ds := Seg(replybuffer);
Dx := Ofs(replybuffer);
end;
MSDOS(Regs);
setdate(replybuffer.year+1900,replybuffer.month,replybuffer.day);
end;
procedure set_time_from_server;
var replybuffer : record
year : byte;
month : byte;
day : byte;
hour : byte;
minute : byte;
second : byte;
dow : byte;
end;
begin
With Regs do begin
Ah := $e7;
Ds := Seg(replybuffer);
Dx := Ofs(replybuffer);
end;
MSDOS(Regs);
settime(replybuffer.hour,replybuffer.minute,replybuffer.second,0);
end;
procedure get_server_version(var _version : string);
var count,x : integer;
request_buffer : record
buffer_length : integer;
subfunction : byte;
end;
reply_buffer : record
buffer_length : integer;
stuff : array [1..512] of byte;
end;
strings : array [1..3] of string;
begin
With Regs do begin
Ah := $e3;
Ds := Seg(request_buffer);
Si := Ofs(request_buffer);
Es := Seg(reply_buffer);
Di := Ofs(reply_buffer);
end;
With request_buffer do
begin
buffer_length := 1;
subfunction := $c9;
end;
With reply_buffer do
begin
buffer_length := 512;
for count := 1 to 512 do stuff[count] := $00;
end;
MSDOS(Regs);
for count := 1 to 3 do strings[count] := '';
x := 1;
With reply_buffer do
begin
for count := 1 to 256 do
begin
if stuff[count] <> $0 then
begin
if not ((stuff[count]=32) and (strings[x]='')) then strings[x] :=
strings[x] + chr(stuff[count]);
end;
if stuff[count] = $0 then if x <> 3 then x := x + 1;
end;
End; { end of with }
_version := strings[2];
end;
procedure open_message_pipe(var _connection, retcode : integer);
var request_buffer : record
buffer_length : integer;
subfunction : byte;
connection_count : byte;
connection_list : byte;
end;
reply_buffer : record
buffer_length : integer;
connection_count : byte;
result_list : byte;
end;
begin
With Regs do begin
Ah := $e1;
Ds := Seg(request_buffer);
Si := Ofs(request_buffer);
Es := Seg(reply_buffer);
Di := Ofs(reply_buffer);
end;
With request_buffer do
begin
buffer_length := 3;
subfunction := $06;
connection_count := $01;
connection_list := _connection;
end;
With reply_buffer do
begin
buffer_length := 2;
connection_count := 0;
result_list := 0;
end;
MSDOS(Regs);
retcode := reply_buffer.result_list;
end;
procedure close_message_pipe(var _connection, retcode : integer);
var request_buffer : record
buffer_length : integer;
subfunction : byte;
connection_count : byte;
connection_list : byte;
end;
reply_buffer : record
buffer_length : integer;
connection_count : byte;
result_list : byte;
end;
begin
With Regs do begin
Ah := $e1;
Ds := Seg(request_buffer);
Si := Ofs(request_buffer);
Es := Seg(reply_buffer);
Di := Ofs(reply_buffer);
end;
With request_buffer do
begin
buffer_length := 3;
subfunction := $07;
connection_count := $01;
connection_list := _connection;
end;
With reply_buffer do
begin
buffer_length := 2;
connection_count := 0;
result_list := 0;
end;
MSDOS(Regs);
retcode := reply_buffer.result_list;
end;
procedure check_message_pipe(var _connection, retcode : integer);
var request_buffer : record
buffer_length : integer;
subfunction : byte;
connection_count : byte;
connection_list : byte;
end;
reply_buffer : record
buffer_length : integer;
connection_count : byte;
result_list : byte;
end;
begin
With Regs do begin
Ah := $e1;
Ds := Seg(request_buffer);
Si := Ofs(request_buffer);
Es := Seg(reply_buffer);
Di := Ofs(reply_buffer);
end;
With request_buffer do
begin
buffer_length := 3;
subfunction := $08;
connection_count := $01;
connection_list := _connection;
end;
With reply_buffer do
begin
buffer_length := 2;
connection_count := 0;
result_list := 0;
end;
MSDOS(Regs);
retcode := reply_buffer.result_list;
end;
procedure send_personal_message(var _connection : integer; var _message :
string; var retcode : integer);
var count : integer;
request_buffer : record
buffer_length : integer;
subfunction : byte;
connection_count : byte;
connection_list : byte;
message_length : byte;
message : array [1..126] of byte;
end;
reply_buffer : record
buffer_length : integer;
connection_count : byte;
result_list : byte;
end;
begin
With Regs do begin
Ah := $e1;
Ds := Seg(request_buffer);
Si := Ofs(request_buffer);
Es := Seg(reply_buffer);
Di := Ofs(reply_buffer);
end;
With request_buffer do
begin
subfunction := $04;
connection_count := $01;
connection_list := _connection;
message_length := length(_message);
buffer_length := length(_message) + 4;
for count := 1 to 126 do message[count] := $00;
if message_length > 0 then for count := 1 to message_length do
message[count] := ord(_message[count]);
end;
With reply_buffer do
begin
buffer_length := 2;
connection_count := 0;
result_list := 0;
end;
MSDOS(Regs);
retcode := reply_buffer.result_list;
end;
procedure purge_erased_files(var retcode:integer);
var request_buffer : record
buffer_length : integer;
subfunction : byte;
end;
reply_buffer : record
buffer_length : integer;
end;
begin
With request_buffer do
begin
buffer_length := 1;
subfunction := $10;
end;
With reply_buffer do buffer_length := 0;
With Regs do begin
Ah := $E2;
Ds := Seg(request_buffer);
Si := Ofs(request_buffer);
Es := Seg(reply_buffer);
Di := Ofs(reply_buffer);
end;
msdos(regs);
retcode := regs.al;
end;
procedure purge_all_erased_files(var retcode:integer);
var request_buffer : record
buffer_length : integer;
subfunction : byte;
end;
reply_buffer : record
buffer_length : integer;
end;
begin
With request_buffer do
begin
buffer_length := 1;
subfunction := $CE;
end;
With reply_buffer do buffer_length := 0;
With Regs do begin
Ah := $E3;
Ds := Seg(request_buffer);
Si := Ofs(request_buffer);
Es := Seg(reply_buffer);
Di := Ofs(reply_buffer);
end;
msdos(regs);
retcode := regs.al;
end;
procedure get_personal_message(var _connection : integer; var _message :
string; var retcode : integer);
var count : integer;
request_buffer : record
buffer_length : integer;
subfunction : byte;
end;
reply_buffer : record
buffer_length : integer;
source_connection : byte;
message_length : byte;
message_buffer : array [1..126] of byte;
end;
begin
With Regs do begin
Ah := $e1;
Ds := Seg(request_buffer);
Si := Ofs(request_buffer);
Es := Seg(reply_buffer);
Di := Ofs(reply_buffer);
end;
With request_buffer do
begin
buffer_length := 1;
subfunction := $05;
end;
With reply_buffer do
begin
buffer_length := 128;
source_connection := 0;
message_length := 0;
for count := 1 to 126 do message_buffer[count] := $0;
end;
MSDOS(Regs);
_connection := reply_buffer.source_connection;
_message := '';
retcode := reply_buffer.message_length;
if retcode > 0 then for count := 1 to retcode do
_message := _message + chr(reply_buffer.message_buffer[count]);
end;
procedure log_file(lock_directive:integer; log_filename: string;
log_timeout:integer; var retcode:integer);
begin
With Regs do begin
Ah := $eb;
Ds := Seg(log_filename);
Dx := Ofs(log_filename);
BP := log_timeout;
end;
msdos(regs);
retcode := regs.al;
end;
procedure release_file(log_filename: string; var retcode:integer);
begin
With Regs do begin
Ah := $ec;
Ds := Seg(log_filename);
Dx := Ofs(log_filename);
end;
msdos(regs);
retcode := regs.al;
end;
procedure clear_file(log_filename: string; var retcode:integer);
begin
With Regs do begin
Ah := $ed;
Ds := Seg(log_filename);
Dx := Ofs(log_filename);
end;
msdos(regs);
retcode := regs.al;
end;
procedure clear_file_set;
begin
regs.Ah := $cf;
msdos(regs);
retcode := regs.al;
end;
procedure lock_file_set(lock_timeout:integer; var retcode:integer);
begin
regs.ah := $CB;
regs.bp := lock_timeout;
msdos(regs);
retcode := regs.al;
end;
procedure release_file_set;
begin
regs.ah := $CD;
msdos(regs);
end;
procedure open_semaphore( _name:string;
_initial_value:shortint;
var _open_count:integer;
var _handle:longint;
var retcode:integer);
var s_name : array [1..129] of byte;
count : integer;
semaphore_handle : array [1..2] of word;
begin
if (_initial_value < 0) or (_initial_value > 127) then _initial_value := 0;
for count := 1 to 129 do s_name[count] := $00; {zero buffer}
if length(_name) > 127 then _name := copy(_name,1,127); {limit name length}
if length(_name) > 0 then for count := 1 to length(_name) do s_name[count+1]
:= ord(_name[count]);
s_name[1] := length(_name);
regs.ah := $C5;
regs.al := $00;
move(_initial_value, regs.cl, 1);
regs.ds := seg(s_name);
regs.dx := ofs(s_name);
regs.es := 0;
msdos(regs);
retcode := regs.al;
if retcode = 0 then _open_count := regs.bl else _open_count := 0;
semaphore_handle[1]:=regs.cx;
semaphore_handle[2]:=regs.dx;
move(semaphore_handle,_handle,4);
end;
procedure close_semaphore(var _handle:longint; var retcode:integer);
var semaphore_handle : array [1..2] of word;
begin
move(_handle,semaphore_handle,4);
regs.ah := $C5;
regs.al := $04;
regs.ds := 0;
regs.es := 0;
regs.cx := semaphore_handle[1];
regs.dx := semaphore_handle[2];
msdos(regs);
retcode := regs.al; { 00h=successful FFh=Invalid handle}
end;
procedure examine_semaphore(var _handle:longint; var _value:shortint; var
_count, retcode:integer);
var semaphore_handle : array [1..2] of word;
begin
move(_handle,semaphore_handle,4);
regs.ah := $C5;
regs.al := $01;
regs.ds := 0;
regs.es := 0;
regs.cx := semaphore_handle[1];
regs.dx := semaphore_handle[2];
msdos(regs);
retcode := regs.al; {00h=successful FFh=invalid handle}
move(regs.cx, _value, 1);
_count := regs.dl;
end;
procedure signal_semaphore(var _handle:longint; var retcode:integer);
var semaphore_handle : array [1..2] of word;
begin
move(_handle,semaphore_handle,4);
regs.ah := $C5;
regs.al := $03;
regs.ds := 0;
regs.es := 0;
regs.cx := semaphore_handle[1];
regs.dx := semaphore_handle[2];
msdos(regs);
retcode := regs.al;
{00h=successful 01h=overflow value > 127 FFh=invalid handle}
end;
procedure wait_on_semaphore(var _handle:longint; _timeout:integer; var
retcode:integer);
var semaphore_handle : array [1..2] of word;
begin
move(_handle,semaphore_handle,4);
regs.ah := $C5;
regs.al := $02;
regs.ds := 0;
regs.es := 0;
regs.bp := _timeout; {units in 1/18 of second, 0 = no wait}
regs.cx := semaphore_handle[1];
regs.dx := semaphore_handle[2];
msdos(regs);
retcode := regs.al;
{00h=successful FEh=timeout failure FFh=invalid handle}
end;
procedure clear_connection(connection_number : integer; var retcode :
integer);
var con_num : byte;
request_buffer : record
length : integer;
subfunction : byte;
con_num : byte;
end;
reply_buffer : record
length : integer;
end;
begin
with request_buffer do begin
length := 4;
con_num := connection_number;
subfunction := $D2;
end;
reply_buffer.length := 0;
with regs do begin
Ah := $e3;
Ds := Seg(request_buffer);
Si := Ofs(request_buffer);
Es := Seg(reply_buffer);
Di := Ofs(reply_buffer);
end;
msdos(regs);
retcode := regs.al;
end;
procedure get_server_lan_driver_information(var _lan_board_number : integer;
{ This will return info on what } var _text1,_text2:string;
{ type of network cards are being } var _network_address : byte4;
{ used in the server. } var _host_address : byte6;
var _driver_installed,
_option_number,
_retcode : integer);
var count : integer;
text : array [1..3] of string;
x1 : integer;
request_buffer : record
length : integer;
subfunction : byte;
lan_board : byte;
end;
reply_buffer : record
length : integer;
network_address : byte4;
host_address : byte6;
lan_driver_installed : byte;
option_number : byte;
configuration_text : array [1..160] of byte;
end;
begin
with request_buffer do begin
length := 2;
subfunction := $E3;
lan_board := _lan_board_number; { 0 to 3 }
end;
with reply_buffer do begin
length := 174;
for count := 1 to 4 do network_address[count] := $0;
for count := 1 to 6 do host_address[count] := $0;
lan_driver_installed := 0;
option_number := 0;
for count := 1 to 160 do configuration_text[count] := $0;
end;
with regs do begin
Ah := $E3;
Ds := Seg(request_buffer);
Si := Ofs(request_buffer);
Es := Seg(reply_buffer);
Di := Ofs(reply_buffer);
end;
msdos(regs);
retcode := regs.al;
_text1 := '';
_text2 := '';
if retcode <> 0 then exit;
_driver_installed := reply_buffer.lan_driver_installed;
if reply_buffer.lan_driver_installed = 0 then exit;
{-- set some values ---}
for count := 1 to 3 do text[count] := '';
x1 := 1;
with reply_buffer do begin
_network_address := network_address;
_host_address := host_address;
_option_number := option_number;
for count := 1 to 160 do
begin
if ((configuration_text[count] = 0) and (x1 <> 3)) then x1 := x1+1;
if configuration_text[count] <> 0 then
text[x1] := text[x1] + chr(configuration_text[count]);
end;
end;
_text1 := text[1];
_text2 := text[2];
end;
end. { end of unit novell }
[Back to NETWORK SWAG index] [Back to Main SWAG index] [Original]