home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / FAQSYS18.ZIP / FAQS.DAT / NOVELL.PAS < prev    next >
Pascal/Delphi Source File  |  1995-10-03  |  57KB  |  1,962 lines

  1. UNIT Novell;
  2.  
  3. {---------------------------------------------------------------------------}
  4. {                                                                           }
  5. {  This UNIT provides a method of obtaining Novell information from a user  }
  6. {  written program.  This UNIT was tested on an IBM AT running DOS 4.0 &    }
  7. {  using Netware 2.15.  The unit compiled cleanly under Turbo Pascal 6.0    }
  8. {                                                                           }
  9. {  Last Update:   8 Apr 91                                                  }
  10. {---------------------------------------------------------------------------}
  11. {                                                                           }
  12. {  Any questions can be directed to:                                        }
  13. {                                                                           }
  14. {  Mark Bramwell                                                            }
  15. {  University of Western Ontario                                            }
  16. {  London, Ontario, N6A 3K7                                                 }
  17. {                                                                           }
  18. {  Phone:  519-473-3618 [work]              519-473-3618 [home]             }
  19. {                                                                           }
  20. {  Bitnet: mark@hamster.business.uwo.ca     Packet: ve3pzr @ ve3gyq         }
  21. {                                                                           }
  22. {  Anonymous FTP Server Internet Address: 129.100.22.100                    }
  23. {                                                                           }
  24. {---------------------------------------------------------------------------}
  25.  
  26. { Any other Novell UNITS gladly accepted. }
  27.  
  28.  
  29. {
  30. mods February 1 1991, Ross Lazarus (rml@extro.ucc.su.AU.OZ)
  31.      var retcodes in procedure getservername, get_broadcast_message,
  32.      verify_object_password comments, password conversion to upper case,
  33.  
  34. Seems to work fine on a Netware 3.00 and on 3.01 servers -
  35. }
  36.  
  37.  
  38. INTERFACE
  39.  
  40. Uses Dos;
  41.  
  42. Const
  43.   Months : Array [1..12] of String[3] = ('JAN','FEB','MAR','APR','MAY','JUN',
  44.                                          'JUL','AUG','SEP','OCT','NOV','DEC');
  45.  
  46.   HEXDIGITS : Array [0..15] of char = '0123456789ABCDEF';
  47.  
  48. VAR
  49.  
  50. {----------------------------------------------------------------------}
  51. {  The following values can be pulled from an user written application }
  52. {                                                                      }
  53. {  The programmer would first call   GetServerInfo.                    }
  54. {  Then he could   writeln(serverinfo.name)   to print the server name }
  55. {----------------------------------------------------------------------}
  56.       ServerInfo    : Record
  57.                      ReturnLength    : Integer;
  58.                      Server          : Packed Array [1..48] of Byte;
  59.                      NetwareVers     : Byte;
  60.                      NetwareSubV     : Byte;
  61.                      ConnectionMax   : array [1..2] of byte;
  62.                      ConnectionUse   : array [1..2] of byte;
  63.                      MaxConVol       : array [1..2] of byte; {}
  64.                      OS_revision     : byte;
  65.                      SFT_level       : byte;
  66.                      TTS_level       : byte;
  67.                      peak_used       : array [1..2] of byte;
  68.                   accounting_version : byte;
  69.                      vap_version     : byte;
  70.                      queuing_version : byte;
  71.                 print_server_version : byte;
  72.              virtual_console_version : byte;
  73.        security_restrictions_version : byte;
  74.         Internetwork_version_version : byte;
  75.                         Undefined    : Packed Array [1..60] of Byte;
  76.                peak_connections_used : integer;
  77.                      Connections_max : integer;
  78.                   Connections_in_use : integer;
  79.                Max_connected_volumes : integer;
  80.                                 name : string;
  81.                    End;
  82.  
  83.  
  84. procedure GetConnectionInfo(var LogicalStationNo: integer;
  85.                             var name,hex_id:string;
  86.                             var conntype:integer;
  87.                             var datetime:string;
  88.                             var retcode:integer);
  89. { returns username and login date/time when you supply the station number. }
  90.  
  91. procedure clear_connection(connection_number : integer; var retcode : integer);
  92. { kicks the workstation off the server}
  93.  
  94. procedure GetHexID(var userid,hexid: string;
  95.                    var retcode: integer);
  96. { returns the novell hexid of an username when you supply the username. }
  97.  
  98. procedure GetServerInfo;
  99. { returns various info of the default server }
  100.  
  101. procedure GetUser( var _station: integer;
  102.                    var _username: string;
  103.                    var retcode:integer);
  104. { returns logged-in station username when you supply the station number. }
  105.  
  106. procedure GetNode( var hex_addr: string;
  107.                    var retcode: integer);
  108. { returns your physical network node in hex. }
  109.  
  110. procedure GetStation( var _station: integer;
  111.                       var retcode: integer);
  112. { returns the station number of your workstation }
  113.  
  114. procedure GetServerName(var servername : string;
  115.                         var retcode : integer);
  116.  
  117. { returns the name of the current server }
  118.  
  119. procedure Send_Message_to_Username(username,message : string;
  120.                                    var retcode: integer);
  121. { Sends a novell message to the userid's workstation }
  122.  
  123. procedure Send_Message_to_Station(station:integer;
  124.                                   message : string;
  125.                                   var retcode: integer);
  126. { Sends a message to the workstation station # }
  127.  
  128. procedure Get_Volume_Name(var volume_name: string;
  129.                           volume_number: integer;
  130.                           var retcode:integer);
  131. { Gets the Volume name from Novell network drive }
  132. { Example:  SYS    Note: default drive must be a }
  133. { network drive.                                 }
  134.  
  135. procedure get_realname(var userid:string;
  136.                        var realname:string;
  137.                        var retcode:integer);
  138. { You supply the userid, and it returns the realname as stored by syscon. }
  139. { Example:  userid=mbramwel   realname=Mark Bramwell }
  140.  
  141. procedure get_broadcast_mode(var bmode:integer);
  142.  
  143. procedure set_broadcast_mode(bmode:integer);
  144.  
  145. procedure get_broadcast_message(var bmessage: string;
  146.                                 var retcode : integer);
  147.  
  148. procedure get_server_datetime(var _year,_month,_day,_hour,_min,_sec,_dow:integer);
  149. { pulls from the server the date, time and Day Of Week }
  150.  
  151. procedure set_date_from_server;
  152. { pulls the date from the server and updates the workstation's clock }
  153.  
  154. procedure set_time_from_server;
  155. { pulls the time from the server and updates the workstation's clock }
  156.  
  157. procedure get_server_version(var _version : string);
  158.  
  159. procedure open_message_pipe(var _connection, retcode : integer);
  160.  
  161. procedure close_message_pipe(var _connection, retcode : integer);
  162.  
  163. procedure check_message_pipe(var _connection, retcode : integer);
  164.  
  165. procedure send_personal_message(var _connection : integer; var _message : string; var retcode : integer);
  166.  
  167. procedure get_personal_message(var _connection : integer; var _message : string; var retcode : integer);
  168.  
  169. procedure get_drive_connection_id(var drive_number,
  170.                                   server_number : integer);
  171. {pass the drive number - it returns the server number if a network volume}
  172.  
  173. procedure get_file_server_name(var server_number : integer;
  174.                                var server_name : string);
  175.  
  176. procedure get_directory_path(var handle : integer;
  177.                              var pathname : string;
  178.                              var retcode : integer);
  179.  
  180. procedure get_drive_handle_id(var drive_number, handle_number : integer);
  181.  
  182. procedure set_preferred_connection_id(server_num : integer);
  183.  
  184. procedure get_preferred_connection_id(var server_num : integer);
  185.  
  186. procedure set_primary_connection_id(server_num : integer);
  187.  
  188. procedure get_primary_connection_id(var server_num : integer);
  189.  
  190. procedure get_default_connection_id(var server_num : integer);
  191.  
  192. procedure Get_Internet_Address(station : integer;
  193.                                var net_number, node_addr, socket_number : string;
  194.                                var retcode : integer);
  195.  
  196. procedure login_to_file_server(obj_type:integer; _name,_password : string;var retcode:integer);
  197.  
  198. procedure logout;
  199.  
  200. procedure logout_from_file_server(var id: integer);
  201.  
  202. procedure down_file_server(flag:integer;var retcode : integer);
  203.  
  204. procedure detach_from_file_server(var id,retcode:integer);
  205.  
  206. procedure disable_file_server_login(var retcode : integer);
  207.  
  208. procedure enable_file_server_login(var retcode : integer);
  209.  
  210. procedure alloc_permanent_directory_handle(var _dir_handle : integer;
  211.                                            var _drive_letter : string;
  212.                                            var _dir_path_name : string;
  213.                                            var _new_dir_handle : integer;
  214.                                            var _effective_rights: byte;
  215.                                            var _retcode : integer);
  216.  
  217. procedure map(var drive_spec:string;
  218.               var _rights:byte;
  219.               var _retcode : integer);
  220.  
  221. procedure scan_object(var last_object: longint;
  222.                       var search_object_type: integer;
  223.                       var search_object : string;
  224.                       var replyid : longint;
  225.                       var replytype : integer; var replyname : string;
  226.                       var replyflag : integer; var replysecurity : byte;
  227.                       var replyproperties : integer; var retcode : integer);
  228.  
  229. procedure verify_object_password(var object_type:integer; var object_name,password : string; var retcode : integer);
  230.  
  231. {--------------------------------------------------------------------------}
  232. { file locking routines }
  233. {-----------------------}
  234.  
  235. procedure log_file(lock_directive:integer; log_filename: string; log_timeout:integer; var retcode:integer);
  236.  
  237. procedure clear_file_set;
  238.  
  239. procedure lock_file_set(lock_timeout:integer; var retcode:integer);
  240.  
  241. procedure release_file_set;
  242.  
  243. procedure release_file(log_filename: string; var retcode:integer);
  244.  
  245. procedure clear_file(log_filename: string; var retcode:integer);
  246.  
  247. {-----------------------------------------------------------------------------}
  248.  
  249. procedure open_semaphore( _name:string;
  250.                           _initial_value:shortint;
  251.                           var _open_count:integer;
  252.                           var _handle:longint;
  253.                           var retcode:integer);
  254.  
  255. procedure close_semaphore(var _handle:longint; var retcode:integer);
  256.  
  257. procedure examine_semaphore(var _handle:longint; var _value:shortint; var _count, retcode:integer);
  258.  
  259. procedure signal_semaphore(var _handle:longint; var retcode:integer);
  260.  
  261. procedure wait_on_semaphore(var _handle:longint; _timeout:integer; var retcode:integer);
  262.  
  263. {-----------------------------------------------------------------------------}
  264.  
  265.  
  266. IMPLEMENTATION
  267.  
  268. const
  269.      zero = '0';
  270.  
  271. var
  272.    retcode : byte; { return code for all functions }
  273.  
  274.  
  275. procedure get_volume_name(var volume_name: string; volume_number: integer;
  276.                           var retcode:integer);
  277. {
  278. pulls volume names from default server.  Use set_preferred_connection_id to
  279. set the default server.
  280. retcodes:  0=ok, 1=no volume assigned  98h= # out of range
  281. }
  282.  
  283. VAR
  284.    pcregs        : Registers;
  285.    count,count1  : integer;
  286.  
  287.    requestbuffer : record
  288.       len        : integer;
  289.       func       : byte;
  290.       vol_num    : byte;
  291.       end;
  292.  
  293.     replybuffer  : record
  294.       len        : integer;
  295.       vol_length : byte;
  296.       name       : packed array [1..16] of byte;
  297.       end;
  298.  
  299. begin
  300. With pcregs do
  301. begin
  302.   ah := $E2;
  303.   ds := seg(requestbuffer);
  304.   si := ofs(requestbuffer);
  305.   es := seg(replybuffer);
  306.   di := ofs(replybuffer);
  307.  end;
  308.  With requestbuffer do
  309.  begin
  310.   len  := 2;
  311.   func := 6;
  312.   vol_num := volume_number;  {passed from calling program}
  313.  end;
  314.  With replybuffer do
  315.  begin
  316.   len :=  17;
  317.   vol_length := 0;
  318.   for count := 1 to 16 do name[count] := $00;
  319.  end;
  320.  msdos(pcregs);
  321.  volume_name := '';
  322.  if replybuffer.vol_length > 0 then
  323.     for count := 1 to replybuffer.vol_length do
  324.         volume_name := volume_name + chr(replybuffer.name[count]);
  325.  retcode := pcregs.al;
  326. end;
  327.  
  328. procedure verify_object_password(var object_type:integer; var object_name,password : string; var retcode : integer);
  329. {
  330. for netware 3.xx remember to have previously (eg in the autoexec file )
  331. set allow unencrypted passwords = on
  332. on the console, otherwise this call always fails !
  333. Note that intruder lockout status is affected by this call !
  334. Netware security isn't that stupid....
  335. Passwords appear to need to be converted to upper case
  336.  
  337. retcode      apparent meaning as far as I can work out....
  338.  
  339. 0            verification of object_name/password combination
  340. 197          account disabled due to intrusion lockout
  341. 214          unencrypted password calls not allowed on this v3+ server
  342. 252          no such object_name on this server
  343. 255          failure to verify object_name/password combination
  344.  
  345. }
  346. var  regs : registers;
  347.  
  348.      request_buffer : record
  349.       buffer_length : integer;
  350.         subfunction : byte;
  351.            obj_type : array [1..2] of byte;
  352.     obj_name_length : byte;
  353.            obj_name : array [1..47] of byte;
  354.     password_length : byte;
  355.        obj_password : array [1..127] of byte;
  356.                 end;
  357.  
  358.        reply_buffer : record
  359.       buffer_length : integer;
  360.                 end;
  361.  
  362.               count : integer;
  363.  
  364. begin
  365.      With request_buffer do
  366.      begin
  367.           buffer_length := 179;
  368.           subfunction := $3F;
  369.           obj_type[1] := 0;
  370.           obj_type[2] := object_type;
  371.           obj_name_length := 47;
  372.           for count := 1 to 47 do
  373.               obj_name[count] := $00;
  374.           for count := 1 to length(object_name) do
  375.           obj_name[count] := ord(object_name[count]);
  376.           password_length := length(password);
  377.           for count := 1 to 127 do
  378.               obj_password[count] := $00;
  379.           if password_length > 0 then
  380.              for count := 1 to password_length do
  381.                  obj_password[count] := ord(upcase(password[count]));
  382.        end;
  383.        With reply_buffer do
  384.             buffer_length := 0;
  385.        With regs do
  386.        begin
  387.             Ah := $E3;
  388.             Ds := Seg(Request_Buffer);
  389.             Si := Ofs(Request_Buffer);
  390.             Es := Seg(Reply_Buffer);
  391.             Di := Ofs(Reply_Buffer);
  392.        End;
  393.        msdos(regs);
  394.        retcode := regs.al;
  395. end; { verify_object_password }
  396.  
  397.  
  398.  
  399. procedure scan_object(var last_object: longint; var search_object_type: integer;
  400.                       var search_object : string; var replyid : longint;
  401.                       var replytype : integer; var replyname : string;
  402.                       var replyflag : integer; var replysecurity : byte;
  403.                       var replyproperties : integer; var retcode : integer);
  404. var regs : registers;
  405.  
  406.     request_buffer : record
  407.      buffer_length : integer;
  408.        subfunction : byte;
  409.          last_seen : longint;
  410.        search_type : array [1..2] of byte;
  411.        name_length : byte;
  412.        search_name : array [1..47] of byte;
  413.                end;
  414.  
  415.       reply_buffer : record
  416.      buffer_length : integer;
  417.          object_id : longint;
  418.        object_type : array [1..2] of byte;
  419.        object_name : array [1..48] of byte;
  420.        object_flag : byte;
  421.           security : byte;
  422.         properties : byte;
  423.                end;
  424.  
  425.              count : integer;
  426.  
  427. begin
  428. with request_buffer do
  429. begin
  430.  buffer_length := 55;
  431.  subfunction := $37;
  432.  last_seen := last_object;
  433.  if search_object_type = -1 then { -1 = wildcard }
  434.    begin
  435.    search_type[1] := $ff;
  436.    search_type[2] := $ff;
  437.    end else
  438.    begin
  439.    search_type[1] := 0;
  440.    search_type[2] := search_object_type;
  441.    end;
  442. name_length := length(search_object);
  443. for count := 1 to 47 do search_name[count] := $00;
  444. if name_length > 0 then for count := 1 to name_length do
  445.    search_name[count] := ord(upcase(search_object[count]));
  446. end;
  447. With reply_buffer do
  448. begin
  449.  buffer_length := 57;
  450.  object_id:= 0;
  451.  object_type[1] := 0;
  452.  object_type[2] := 0;
  453.  for count := 1 to 48 do object_name[count] := $00;
  454.  object_flag := 0;
  455.  security := 0;
  456.  properties := 0;
  457. end;
  458. With Regs Do Begin
  459.  Ah := $E3;
  460.  Ds := Seg(Request_Buffer);
  461.  Si := Ofs(Request_Buffer);
  462.  Es := Seg(Reply_Buffer);
  463.  Di := Ofs(Reply_Buffer);
  464. End;
  465. msdos(regs);
  466. retcode := regs.al;
  467. With reply_buffer do
  468. begin
  469.  replyflag := object_flag;
  470.  replyproperties := properties;
  471.  replysecurity := security;
  472.  replytype := object_type[2];
  473.  replyid := object_id;
  474. end;
  475. count := 1;
  476. replyname := '';
  477. While (count <= 48)  and (reply_buffer.Object_Name[count] <> 0) Do Begin
  478.     replyName := replyname + Chr(reply_buffer.Object_name[count]);
  479.     count := count + 1;
  480.     End { while };
  481. end;
  482.  
  483.  
  484. procedure alloc_permanent_directory_handle
  485.   (var _dir_handle : integer; var _drive_letter : string;
  486.    var _dir_path_name : string; var _new_dir_handle : integer;
  487.    var _effective_rights: byte; var _retcode : integer);
  488.  
  489. var regs : registers;
  490.  
  491.     request_buffer : record
  492.      buffer_length : integer;
  493.        subfunction : byte;
  494.         dir_handle : byte;
  495.       drive_letter : byte;
  496.    dir_path_length : byte;
  497.      dir_path_name : packed array [1..255] of byte;
  498.                end;
  499.  
  500.       reply_buffer : record
  501.      buffer_length : integer;
  502.     new_dir_handle : byte;
  503.   effective_rights : byte;
  504.                end;
  505.  
  506.   count : integer;
  507.  
  508. begin
  509. With request_buffer do
  510. begin
  511.  buffer_length := 259;
  512.  subfunction := $12;
  513.  dir_handle := _dir_handle;
  514.  drive_letter := ord(upcase(_drive_letter[1]));
  515.  dir_path_length := length(_dir_path_name);
  516.  for count := 1 to 255 do dir_path_name[count] := $0;
  517.  if dir_path_length > 0 then for count := 1 to dir_path_length do
  518.     dir_path_name[count] := ord(upcase(_dir_path_name[count]));
  519. end;
  520. With reply_buffer do
  521. begin
  522.  buffer_length := 2;
  523.  new_dir_handle := 0;
  524.  effective_rights := 0;
  525. end;
  526. With Regs Do Begin
  527.  Ah := $E2;
  528.  Ds := Seg(Request_Buffer);
  529.  Si := Ofs(Request_Buffer);
  530.  Es := Seg(Reply_Buffer);
  531.  Di := Ofs(Reply_Buffer);
  532. End;
  533. msdos(regs);
  534. _retcode := regs.al;
  535. _effective_rights := $0;
  536. _new_dir_handle := $0;
  537. if _retcode = 0 then
  538. begin
  539.  _effective_rights := reply_buffer.effective_rights;
  540.  _new_dir_handle := reply_buffer.new_dir_handle;
  541. end;
  542. end;
  543.  
  544. procedure map(var drive_spec:string; var _rights:byte; var _retcode : integer);
  545. var
  546.     dir_handle : integer;
  547.      path_name : string;
  548.         rights : byte;
  549.   drive_number : integer;
  550.   drive_letter : string;
  551.     new_handle : integer;
  552.        retcode : integer;
  553.  
  554. begin
  555.  {first thing is we strip leading and trailing blanks}
  556.  while drive_spec[1]=' ' do  drive_spec := copy(drive_spec,2,length(drive_spec));
  557.  while drive_spec[length(drive_spec)]=' ' do  drive_spec := copy(drive_spec,1,length(drive_spec)-1);
  558.  drive_number := ord(upcase(drive_spec[1]))-65;
  559.  drive_letter := upcase(drive_spec[1]);
  560.  path_name := copy(drive_spec,4,length(drive_spec));
  561.  get_drive_handle_id(drive_number,dir_handle);
  562.  alloc_permanent_directory_handle(dir_handle,drive_letter,path_name,new_handle,rights,retcode);
  563.  _retcode := retcode;
  564.  _rights := rights;
  565. end;
  566.  
  567.  
  568.  
  569.  
  570. procedure down_file_server(flag:integer;var retcode : integer);
  571. var       regs : registers;
  572.  
  573. request_buffer : record
  574.  buffer_length : integer;
  575.    subfunction : byte;
  576.      down_flag : byte;
  577.            end;
  578.  
  579.   reply_buffer : record
  580.  buffer_length : integer;
  581.            end;
  582.  
  583. begin
  584. With request_buffer do
  585. begin
  586.  buffer_length := 2;
  587.  subfunction := $D3;
  588.  down_flag := flag;
  589. end;
  590. reply_buffer.buffer_length := 0;
  591. With Regs Do Begin
  592.  Ah := $E3;
  593.  Ds := Seg(Request_Buffer);
  594.  Si := Ofs(Request_Buffer);
  595.  Es := Seg(Reply_Buffer);
  596.  Di := Ofs(Reply_Buffer);
  597. End;
  598. msdos(regs);
  599. retcode := regs.al;
  600. end;
  601.  
  602.  
  603. procedure set_preferred_connection_id(server_num : integer);
  604. var regs : registers;
  605. begin
  606.  regs.ah := $F0;
  607.  regs.al := $00;
  608.  regs.dl := server_num;
  609.  msdos(regs);
  610. end;
  611.  
  612. procedure set_primary_connection_id(server_num : integer);
  613. var regs : registers;
  614. begin
  615.  regs.ah := $F0;
  616.  regs.al := $04;
  617.  regs.dl := server_num;
  618.  msdos(regs);
  619. end;
  620.  
  621. procedure get_primary_connection_id(var server_num : integer);
  622. var regs : registers;
  623. begin
  624.  regs.ah := $F0;
  625.  regs.al := $05;
  626.  msdos(regs);
  627.  server_num := regs.al;
  628. end;
  629.  
  630. procedure get_default_connection_id(var server_num : integer);
  631. var regs : registers;
  632. begin
  633.  regs.ah := $F0;
  634.  regs.al := $02;
  635.  msdos(regs);
  636.  server_num := regs.al;
  637. end;
  638.  
  639. procedure get_preferred_connection_id(var server_num : integer);
  640. var regs : registers;
  641. begin
  642.  regs.ah := $F0;
  643.  regs.al := $02;
  644.  msdos(regs);
  645.  server_num := regs.al;
  646. end;
  647.  
  648.  
  649. procedure get_drive_connection_id(var drive_number, server_number : integer);
  650. var     regs : registers;
  651.  drive_table : array [1..32] of byte;
  652.        count : integer;
  653.            p : ^byte;
  654.  
  655. begin
  656.   regs.ah := $EF;
  657.   regs.al := $02;
  658.   msdos(regs);
  659.   p := ptr(regs.es, regs.si);
  660.   move(p^,drive_table,32);
  661.   if ((drive_number < 0) or (drive_number > 32))  then drive_number := 1;
  662.   server_number := drive_table[drive_number];
  663. end;
  664.  
  665. procedure get_drive_handle_id(var drive_number, handle_number : integer);
  666. var     regs : registers;
  667.  drive_table : array [1..32] of byte;
  668.        count : integer;
  669.            p : ^byte;
  670.  
  671. begin
  672.   regs.ah := $EF;
  673.   regs.al := $00;
  674.   msdos(regs);
  675.   p := ptr(regs.es, regs.si);
  676.   move(p^,drive_table,32);
  677.   if ((drive_number < 0) or (drive_number > 32))  then drive_number := 1;
  678.   handle_number := drive_table[drive_number];
  679. end;
  680.  
  681.  
  682. procedure get_file_server_name(var server_number : integer; var server_name : string);
  683. var     regs : registers;
  684.   name_table : array [1..8*48] of byte;
  685.       server : array [1..8] of string;
  686.        count : integer;
  687.       count2 : integer;
  688.            p : ^byte;
  689.      no_more : integer;
  690.  
  691. begin
  692.   regs.ah := $EF;
  693.   regs.al := $04;
  694.   msdos(regs);
  695.   no_more := 0;
  696.   p := ptr(regs.es, regs.si);
  697.   move(p^,name_table,8*48);
  698.   for count := 1 to 8 do server[count] := '';
  699.   for count := 0 to 7 do
  700.   begin
  701.     no_more := 0;
  702.     for count2 := (count*48)+1 to (count*48)+48 do if name_table[count2] <> $00
  703.         then
  704.         begin
  705.         if no_more=0 then server[count+1] := server[count+1] + chr(name_table[count2]);
  706.         end else no_more:=1; {scan until 00h is found}
  707.   end;
  708.   if ((server_number<1) or (server_number>8)) then server_number := 1;
  709.   server_name := server[server_number];
  710. end;
  711.  
  712. procedure disable_file_server_login(var retcode : integer);
  713. var regs : registers;
  714.  
  715. request_buffer : record
  716.  buffer_length : integer;
  717.    subfunction : byte
  718.            end;
  719.  
  720.   reply_buffer : record
  721.  buffer_length : integer;
  722.            end;
  723.  
  724. begin
  725.   With Regs Do Begin
  726.     Ah := $E3;
  727.     Ds := Seg(Request_Buffer);
  728.     Si := Ofs(Request_Buffer);
  729.     Es := Seg(Reply_Buffer);
  730.     Di := Ofs(Reply_Buffer);
  731.   End;
  732.   With request_buffer do
  733.    begin
  734.    buffer_length := 1;
  735.    subfunction := $CB;
  736.    end;
  737.  reply_buffer.buffer_length := 0;
  738.  msdos(regs);
  739.  retcode := regs.al;
  740. end;
  741.  
  742. procedure enable_file_server_login(var retcode : integer);
  743. var regs : registers;
  744.  
  745. request_buffer : record
  746.  buffer_length : integer;
  747.    subfunction : byte
  748.            end;
  749.  
  750.   reply_buffer : record
  751.  buffer_length : integer;
  752.            end;
  753.  
  754. begin
  755.   With Regs Do Begin
  756.     Ah := $E3;
  757.     Ds := Seg(Request_Buffer);
  758.     Si := Ofs(Request_Buffer);
  759.     Es := Seg(Reply_Buffer);
  760.     Di := Ofs(Reply_Buffer);
  761.   End;
  762.   With request_buffer do
  763.    begin
  764.    buffer_length := 1;
  765.    subfunction := $CC;
  766.    end;
  767.  reply_buffer.buffer_length := 0;
  768.  msdos(regs);
  769.  retcode := regs.al;
  770. end;
  771.  
  772.  
  773. procedure get_directory_path(var handle : integer; var pathname : string; var retcode : integer);
  774. var  regs : registers;
  775.      count : integer;
  776.  
  777.    request_buffer : record
  778.               len : integer;
  779.       subfunction : byte;
  780.        dir_handle : byte;
  781.               end;
  782.  
  783.      reply_buffer : record
  784.               len : integer;
  785.          path_len : byte;
  786.         path_name : array [1..255] of byte;
  787.               end;
  788.  
  789. begin
  790.   With Regs Do Begin
  791.     Ah := $e2;
  792.     Ds := Seg(Request_Buffer);
  793.     Si := Ofs(Request_Buffer);
  794.     Es := Seg(Reply_Buffer);
  795.     Di := Ofs(Reply_Buffer);
  796.   End;
  797.   With request_buffer do
  798.    begin
  799.    len := 2;
  800.    subfunction := $01;
  801.    dir_handle := handle;
  802.    end;
  803.   With reply_buffer do
  804.    begin
  805.    len := 256;
  806.    path_len := 0;
  807.    for count := 1 to 255 do path_name[count] := $00;
  808.    end;
  809.   msdos(regs);
  810.   retcode := regs.al;
  811.   pathname := '';
  812.   if reply_buffer.path_len > 0 then for count := 1 to reply_buffer.path_len do
  813.      pathname := pathname + chr(reply_buffer.path_name[count]);
  814. end;
  815.  
  816. procedure detach_from_file_server(var id,retcode:integer);
  817. var regs : registers;
  818. begin
  819.  regs.ah := $F1;
  820.  regs.al := $01;
  821.  regs.dl := id;
  822.  msdos(regs);
  823.  retcode := regs.al;
  824. end;
  825.  
  826.  
  827. procedure getstation( var _station: integer; var retcode: integer);
  828. VAR
  829.    pcregs     : Registers;
  830.  
  831. begin
  832.    pcregs.ah := $DC;
  833.    MsDos( pcregs );
  834.    _station := pcregs.al;
  835.    retcode := 0;
  836.    end;
  837.  
  838.  
  839. procedure GetHexID( var userid,hexid: string; var retcode: integer);
  840. var
  841.     reg           : registers;
  842.     i,x           : integer;
  843.     hex_id        : string;
  844.     requestbuffer : record
  845.       len      : integer;
  846.       func     : byte;
  847.       conntype : packed array [1..2] of byte;
  848.       name_len : byte;
  849.       name     : packed array [1..47] of char;
  850.       end;
  851.     replybuffer   : record
  852.       len      : integer;
  853.       uniqueid1: packed array [1..2] of byte;
  854.       uniqueid2: packed array [1..2] of byte;
  855.       conntype : word;
  856.       name     : packed array [1..48] of byte;
  857.       end;
  858.  
  859. begin
  860.   reg.ah := $E3;
  861.   requestbuffer.func := $35;
  862.   reg.ds := seg(requestbuffer);
  863.   reg.si := ofs(requestbuffer);
  864.   reg.es := seg(replybuffer);
  865.   reg.di := ofs(replybuffer);
  866.   requestbuffer.len := 52;
  867.   replybuffer.len := 55;
  868.   requestbuffer.name_len := length(userid);
  869.   for i := 1 to length(userid) do requestbuffer.name[i] := userid[i];
  870.   requestbuffer.conntype[2] := $1;
  871.   requestbuffer.conntype[1] := $0;
  872.   replybuffer.conntype := 1;
  873.   msdos(reg);
  874.   retcode := reg.al;   {
  875.   if retcode = $96 then writeln('Server out of memory');
  876.   if retcode = $EF then writeln('Invalid name');
  877.   if retcode = $F0 then writeln('Wildcard not allowed');
  878.   if retcode = $FC then writeln('No such object *',userid,'*');
  879.   if retcode = $FE then writeln('Server bindery locked');
  880.   if retcode = $FF then writeln('Bindery failure'); }
  881.   hex_id := '';
  882.   if retcode = 0 then
  883.   begin
  884.    hex_id := hexdigits[replybuffer.uniqueid1[1] shr 4];
  885.    hex_id := hex_id + hexdigits[replybuffer.uniqueid1[1] and $0F];
  886.    hex_id := hex_id + hexdigits[replybuffer.uniqueid1[2] shr 4];
  887.    hex_id := hex_id + hexdigits[replybuffer.uniqueid1[2] and $0F];
  888.    hex_id := hex_id + hexdigits[replybuffer.uniqueid2[1] shr 4];
  889.    hex_id := hex_id + hexdigits[replybuffer.uniqueid2[1] and $0F];
  890.    hex_id := hex_id + hexdigits[replybuffer.uniqueid2[2] shr 4];
  891.    hex_id := hex_id + hexdigits[replybuffer.uniqueid2[2] and $0F];
  892.    { Now we chop off leading zeros }
  893.    while hex_id[1] = '0' do hex_id := copy(hex_id,2,length(hex_id));
  894.   end;
  895.    hexid := hex_id;
  896. end;
  897.  
  898.  
  899. Procedure GetConnectionInfo
  900. (Var LogicalStationNo: Integer; Var Name: String; Var HEX_ID: String;
  901.  Var ConnType : Integer; Var DateTime : String; Var retcode:integer);
  902.  
  903. Var
  904.   Reg            : Registers;
  905.   I,X            : Integer;
  906.   RequestBuffer  : Record
  907.                      PacketLength : Integer;
  908.                      FunctionVal  : Byte;
  909.                      ConnectionNo : Byte;
  910.                    End;
  911.   ReplyBuffer    : Record
  912.                      ReturnLength : Integer;
  913.                      UniqueID1    : Packed Array [1..2] of byte;
  914.                      UniqueID2    : Packed Array [1..2] of byte;
  915.                      ConnType     : Packed Array [1..2] of byte;
  916.                      ObjectName   : Packed Array [1..48] of Byte;
  917.                      LoginTime    : Packed Array [1..8] of Byte;
  918.                    End;
  919.   Month          : String[3];
  920.   Year,
  921.   Day,
  922.   Hour,
  923.   Minute         : String[2];
  924.  
  925. Begin
  926.   With RequestBuffer Do Begin
  927.     PacketLength := 2;
  928.     FunctionVal := 22;  { 22 = Get Station Info }
  929.     ConnectionNo := LogicalStationNo;
  930.   End;
  931.   ReplyBuffer.ReturnLength := 62;
  932.   With Reg Do Begin
  933.     Ah := $e3;
  934.     Ds := Seg(RequestBuffer);
  935.     Si := Ofs(RequestBuffer);
  936.     Es := Seg(ReplyBuffer);
  937.     Di := Ofs(ReplyBuffer);
  938.   End;
  939.   MsDos(Reg);
  940.   name := '';
  941.   hex_id := '';
  942.   conntype := 0;
  943.   datetime := '';
  944.   If Reg.al = 0 Then Begin
  945.     With ReplyBuffer Do Begin
  946.       I := 1;
  947.       While (I <= 48)  and (ObjectName[I] <> 0) Do Begin
  948.         Name[I] := Chr(Objectname[I]);
  949.         I := I + 1;
  950.       End { while };
  951.       Name[0] := Chr(I - 1);
  952.       if name<>'' then
  953.       begin
  954.        Str(LoginTime[1]:2,Year);
  955.        Month := Months[LoginTime[2]];
  956.        Str(LoginTime[3]:2,Day);
  957.        Str(LoginTime[4]:2,Hour);
  958.        Str(LoginTime[5]:2,Minute);
  959.        If Day[1] = ' ' Then Day[1] := '0';
  960.        If Hour[1] = ' ' Then Hour[1] := '0';
  961.        If Minute[1] = ' ' Then Minute[1] := '0';
  962.        DateTime := Day+'-'+Month+'-'+Year+' ' + Hour + ':' + Minute;
  963.       End;
  964.     End { with };
  965.   End;
  966.   retcode := reg.al;
  967.   if name<>'' then
  968.   begin
  969.    hex_id := '';
  970.    hex_id := hexdigits[replybuffer.uniqueid1[1] shr 4];
  971.    hex_id := hex_id + hexdigits[replybuffer.uniqueid1[1] and $0F];
  972.    hex_id := hex_id + hexdigits[replybuffer.uniqueid1[2] shr 4];
  973.    hex_id := hex_id + hexdigits[replybuffer.uniqueid1[2] and $0F];
  974.    hex_id := hex_id + hexdigits[replybuffer.uniqueid2[1] shr 4];
  975.    hex_id := hex_id + hexdigits[replybuffer.uniqueid2[1] and $0F];
  976.    hex_id := hex_id + hexdigits[replybuffer.uniqueid2[2] shr 4];
  977.    hex_id := hex_id + hexdigits[replybuffer.uniqueid2[2] and $0F];
  978.    ConnType := replybuffer.conntype[2];
  979.   { Now we chop off leading zeros }
  980.    while hex_id[1]='0' do hex_id := copy(hex_id,2,length(hex_id));
  981.  End;
  982. End { GetConnectInfo };
  983.  
  984. procedure login_to_file_server(obj_type:integer;_name,_password : string;var retcode:integer);
  985. var
  986.       regs : registers;
  987.  
  988.       request_buffer : record
  989.             B_length : integer;
  990.          subfunction : byte;
  991.               o_type : packed array [1..2] of byte;
  992.          name_length : byte;
  993.             obj_name : packed array [1..47] of byte;
  994.      password_length : byte;
  995.             password : packed array [1..27] of byte;
  996.                  end;
  997.  
  998.         reply_buffer : record
  999.             R_length : integer;
  1000.                  end;
  1001.  
  1002.                count : integer;
  1003.  
  1004. begin
  1005. With request_buffer do
  1006. begin
  1007.  B_length := 79;
  1008.  subfunction := $14;
  1009.  o_type[1] := 0;
  1010.  o_type[2] := obj_type;
  1011.  for count := 1 to 47 do obj_name[count] := $0;
  1012.  for count := 1 to 27 do password[count] := $0;
  1013.  if length(_name) > 0 then
  1014.     for count := 1 to length(_name) do obj_name[count]:=ord(upcase(_name[count]));
  1015.  if length(_password) > 0 then
  1016.     for count := 1 to length(_password) do password[count]:=ord(upcase(_password[count]));
  1017.  {set to full length of field}
  1018.  name_length := 47;
  1019.  password_length := 27;
  1020. end;
  1021. With reply_buffer do
  1022. begin
  1023.  R_length := 0;
  1024. end;
  1025.   With Regs Do Begin
  1026.     Ah := $e3;
  1027.     Ds := Seg(Request_Buffer);
  1028.     Si := Ofs(Request_Buffer);
  1029.     Es := Seg(reply_buffer);
  1030.     Di := Ofs(reply_buffer);
  1031.   End;
  1032.   MsDos(Regs);
  1033.   retcode := regs.al
  1034. end;
  1035.  
  1036. procedure logout;
  1037. {logout from all file servers}
  1038. var regs : registers;
  1039. begin
  1040.  regs.ah := $D7;
  1041.  msdos(regs);
  1042. end;
  1043.  
  1044. procedure logout_from_file_server(var id: integer);
  1045. {logout from one file server}
  1046. var regs : registers;
  1047. begin
  1048.  regs.ah := $F1;
  1049.  regs.al := $02;
  1050.  regs.dl := id;
  1051.  msdos(regs);
  1052. end;
  1053.  
  1054.  
  1055.  
  1056.  
  1057. procedure send_message_to_username(username,message : string; var retcode: integer);
  1058. VAR
  1059.    count1     : byte;
  1060.    userid     : string;
  1061.    stationid  : integer;
  1062.    ret_code   : integer;
  1063.  
  1064. begin
  1065.    ret_code := 1;
  1066.    for count1:= 1 to length(username) do
  1067.        username[count1]:=upcase(username[count1]); { Convert to upper case }
  1068.    getserverinfo;
  1069.    for count1:= 1 to serverinfo.connections_max do
  1070.    begin
  1071.      stationid := count1;
  1072.      getuser( stationid, userid, retcode);
  1073.       if userid = username then
  1074.         begin
  1075.         ret_code := 0;
  1076.         send_message_to_station(stationid, message, retcode);
  1077.       end;
  1078.      end; { end of count }
  1079.      retcode := ret_code;
  1080.      { retcode = 0 if sent,  1 if userid not found }
  1081. end; { end of procedure }
  1082.  
  1083.  
  1084. Procedure GetServerInfo;
  1085. Var
  1086.   Reg            : Registers;
  1087.   RequestBuffer  : Record
  1088.                      PacketLength : Integer;
  1089.                      FunctionVal  : Byte;
  1090.                    End;
  1091.   I              : Integer;
  1092.  
  1093. Begin
  1094.   With RequestBuffer Do Begin
  1095.     PacketLength := 1;
  1096.     FunctionVal := 17;  { 17 = Get Server Info }
  1097.   End;
  1098.   ServerInfo.ReturnLength := 128;
  1099.   With Reg Do Begin
  1100.     Ah := $e3;
  1101.     Ds := Seg(RequestBuffer);
  1102.     Si := Ofs(RequestBuffer);
  1103.     Es := Seg(ServerInfo);
  1104.     Di := Ofs(ServerInfo);
  1105.   End;
  1106.   MsDos(Reg);
  1107.   With serverinfo do
  1108.   begin
  1109.    connections_max := connectionmax[1]*256 + connectionmax[2];
  1110.    connections_in_use := connectionuse[1]*256 + connectionuse[2];
  1111.    max_connected_volumes := maxconvol[1]*256 + maxconvol[2];
  1112.    peak_connections_used := peak_used[1]*256 + peak_used[2];
  1113.    name := '';
  1114.    i := 1;
  1115.    while ((server[i] <> 0) and (i<>48)) do
  1116.     begin
  1117.     name := name + chr(server[i]);
  1118.     i := i + 1;
  1119.     end;
  1120.    end;
  1121. End;
  1122.  
  1123. procedure GetServerName(var servername : string; var retcode : integer);
  1124. {-----------------------------------------------------------------}
  1125. { This routine returns the same as GetServerInfo.  This routine   }
  1126. { was kept to maintain compatibility with the older  novell unit. }
  1127. {-----------------------------------------------------------------}
  1128. begin
  1129.   getserverinfo;
  1130.   servername := serverinfo.name;
  1131.   retcode := 0;
  1132.   end;
  1133.  
  1134. procedure send_message_to_station(station:integer; message : string; var retcode: integer);
  1135. VAR
  1136.    pcregs     : Registers;
  1137.  
  1138.    req_buffer : record
  1139.    buffer_len : integer;
  1140.    subfunction: byte;
  1141.       c_count : byte;
  1142.        c_list : byte;
  1143.    msg_length : byte;
  1144.           msg : packed array [1..55] of byte;
  1145.           end;
  1146.  
  1147.    rep_buffer : record
  1148.    buffer_len : integer;
  1149.       c_count : byte;
  1150.        r_list : byte;
  1151.           end;
  1152.  
  1153.    count1     : integer;
  1154.  
  1155. begin
  1156.         if length(message) > 55 then message:=copy(message,1,55);
  1157.         With PCRegs do
  1158.         begin
  1159.          ah := $E1;
  1160.          ds:=seg(req_buffer);
  1161.          si:=ofs(req_buffer);
  1162.          es:=seg(rep_buffer);
  1163.          di:=ofs(rep_buffer);
  1164.         End;
  1165.         With req_buffer do
  1166.         begin
  1167.          buffer_len := 59;
  1168.          subfunction := 00;
  1169.          c_count := 1;
  1170.          c_list := station;
  1171.          for count1:= 1 to 55 do msg[count1]:= $00; { zero the buffer }
  1172.          msg_length := length(message); { message length }
  1173.          for count1:= 1 to length(message) do msg[count1]:=ord(message[count1]);
  1174.         End;
  1175.         With rep_buffer do
  1176.         begin
  1177.          buffer_len := 2;
  1178.          c_count := 1;
  1179.          r_list := 0;
  1180.         End;
  1181.         msdos( pcregs );
  1182.         retcode:= rep_buffer.r_list;
  1183.    end;
  1184.  
  1185.  
  1186. procedure getuser( var _station: integer; var  _username: string; var retcode: integer);
  1187. {This procedure provides a shorter method of obtaining just the USERID.}
  1188. var
  1189.      gu_hexid : string;
  1190.   gu_conntype : integer;
  1191.   gu_datetime : string;
  1192.  
  1193. begin
  1194.   getconnectioninfo(_station,_username,gu_hexid,gu_conntype,gu_datetime,retcode);
  1195. end;
  1196.  
  1197.  
  1198. PROCEDURE GetNode( var hex_addr: string; var retcode: integer );
  1199. { get the physical station address }
  1200.  
  1201. Const
  1202.    Hex_Set  :packed array[0..15] of char = '0123456789ABCDEF';
  1203.  
  1204. Var
  1205.    Regs              :Registers;
  1206.  
  1207. Begin { GetNode }
  1208.    {Get the physical address from the Network Card}
  1209.    Regs.Ah := $EE;
  1210.    MsDos(Regs);
  1211.    hex_addr := '';
  1212.    hex_addr := hex_addr + hex_set[(regs.ch shr 4)];
  1213.    hex_addr := hex_addr + hex_set[(regs.ch and $0f)];
  1214.    hex_addr := hex_addr + hex_set[(regs.cl shr 4) ];
  1215.    hex_addr := hex_addr + hex_set[(regs.cl and $0f)];
  1216.    hex_addr := hex_addr + hex_set[(regs.bh shr 4)];
  1217.    hex_addr := hex_addr + hex_set[(regs.bh and $0f)];
  1218.    hex_addr := hex_addr + hex_set[(regs.bl shr 4)];
  1219.    hex_addr := hex_addr + hex_set[(regs.bl and $0f)];
  1220.    hex_addr := hex_addr + hex_set[(regs.ah shr 4)];
  1221.    hex_addr := hex_addr + hex_set[(regs.ah and $0f)];
  1222.    hex_addr := hex_addr + hex_set[(regs.al shr 4)];
  1223.    hex_addr := hex_addr + hex_set[(regs.al and $0f)];
  1224.    retcode := 0;
  1225. End; { Getnode }
  1226.  
  1227.  
  1228. PROCEDURE Get_Internet_Address(station : integer; var net_number, node_addr, socket_number : string; var retcode : integer);
  1229.  
  1230. Const
  1231.    Hex_Set  :packed array[0..15] of char = '0123456789ABCDEF';
  1232.  
  1233. Var
  1234.    Regs              :Registers;
  1235.  
  1236.    Request_buffer : record
  1237.            length : integer;
  1238.       subfunction : byte;
  1239.        connection : byte;
  1240.               end;
  1241.  
  1242.     Reply_Buffer : record
  1243.           length : integer;
  1244.          network : array [1..4] of byte;
  1245.             node : array [1..6] of byte;
  1246.           socket : array [1..2] of byte;
  1247.              end;
  1248.  
  1249.            count : integer;
  1250.       _node_addr : string;
  1251.   _socket_number : string;
  1252.      _net_number : string;
  1253.  
  1254. begin
  1255.  With Regs do
  1256.  begin
  1257.   ah := $E3;
  1258.   ds:=seg(request_buffer);
  1259.   si:=ofs(request_buffer);
  1260.   es:=seg(reply_buffer);
  1261.   di:=ofs(reply_buffer);
  1262.  End;
  1263.  With request_buffer do
  1264.  begin
  1265.   length := 2;
  1266.   subfunction := $13;
  1267.   connection := station;
  1268.  end;
  1269.  With reply_buffer do
  1270.  begin
  1271.   length := 12;
  1272.   for count := 1 to 4 do network[count] := 0;
  1273.   for count := 1 to 6 do node[count] := 0;
  1274.   for count := 1 to 2 do socket[count] := 0;
  1275.  end;
  1276.  msdos(regs);
  1277.  retcode := regs.al;
  1278.  _net_number := '';
  1279.  _node_addr := '';
  1280.  _socket_number := '';
  1281.  if retcode = 0 then
  1282.  begin
  1283.  for count := 1 to 4 do
  1284.      begin
  1285.      _net_number := _net_number + hex_set[ (reply_buffer.network[count] shr 4) ];
  1286.      _net_number := _net_number + hex_set[ (reply_buffer.network[count] and $0F) ];
  1287.      end;
  1288.  for count := 1 to 6 do
  1289.      begin
  1290.      _node_addr := _node_addr + (hex_set[ (reply_buffer.node[count] shr 4) ]);
  1291.      _node_addr := _node_addr + (hex_set[ (reply_buffer.node[count] and $0F) ]);
  1292.      end;
  1293.  for count := 1 to 2 do
  1294.      begin
  1295.      _socket_number := _socket_number + (hex_set[ (reply_buffer.socket[count] shr 4) ]);
  1296.      _socket_number := _socket_number + (hex_set[ (reply_buffer.socket[count] and $0F) ]);
  1297.      end;
  1298.  end; {end of retcode=0}
  1299.  net_number := _net_number;
  1300.  node_addr := _node_addr;
  1301.  socket_number := _socket_number;
  1302.  end;
  1303.  
  1304. procedure get_realname(var userid,realname:string; var retcode:integer);
  1305. var
  1306.     requestbuffer : record
  1307.     buffer_length : array [1..2] of byte;
  1308.       subfunction : byte;
  1309.       object_type : array [1..2] of byte;
  1310.     object_length : byte;
  1311.       object_name : array [1..47] of byte;
  1312.           segment : byte;
  1313.   property_length : byte;
  1314.     property_name : array [1..14] of byte;
  1315.     end;
  1316.  
  1317.       replybuffer : record
  1318.     buffer_length : array [1..2] of byte;
  1319.    property_value : array [1..128] of byte;
  1320.     more_segments : byte;
  1321.    property_flags : byte;
  1322.    end;
  1323.  
  1324.    count    : integer;
  1325.    id       : string;
  1326.    Regs     : registers;
  1327.    fullname : string;
  1328.  
  1329. begin
  1330.   id := 'IDENTIFICATION';
  1331.   With requestbuffer do begin
  1332.      buffer_length[2] := 0;
  1333.      buffer_length[1] := 69;
  1334.      subfunction  := $3d;
  1335.      object_type[1]:= 0;
  1336.      object_type[2]:= 01;
  1337.      segment := 1;
  1338.      object_length := 47;
  1339.      property_length := length(id);
  1340.      for count := 1 to 47 do object_name[count] := $0;
  1341.      for count := 1 to length(userid) do object_name[count] := ord(userid[count]);
  1342.      for count := 1 to 14 do property_name[count] := $0;
  1343.      for count := 1 to length(id) do property_name[count] := ord(id[count]);
  1344.      end;
  1345.   With replybuffer do begin
  1346.      buffer_length[1] := 130;
  1347.      buffer_length[2] := 0;
  1348.      for count := 1 to 128 do property_value[count] := $0;
  1349.      more_segments := 1;
  1350.      property_flags := 0;
  1351.      end;
  1352.   With Regs do begin
  1353.      Ah := $e3;
  1354.      Ds := Seg(requestbuffer);
  1355.      Si := Ofs(requestbuffer);
  1356.      Es := Seg(replybuffer);
  1357.      Di := Ofs(replybuffer);
  1358.      end;
  1359.   MSDOS(Regs);
  1360.   retcode := Regs.al;
  1361.   fullname := '';
  1362.   count := 1;
  1363.   repeat
  1364.    begin
  1365.    if replybuffer.property_value[count]<>0
  1366.       then fullname := fullname + chr(replybuffer.property_value[count]);
  1367.    count := count + 1;
  1368.    end;
  1369.    until ((count=128) or (replybuffer.property_value[count]=0));
  1370.   {if regs.al = $96 then writeln('server out of memory');
  1371.   if regs.al = $ec then writeln('no such segment');
  1372.   if regs.al = $f0 then writeln('wilcard not allowed');
  1373.   if regs.al = $f1 then writeln('invalid bindery security');
  1374.   if regs.al = $f9 then writeln('no property read priv');
  1375.   if regs.al = $fb then writeln('no such property');
  1376.   if regs.al = $fc then writeln('no such object');}
  1377.   if retcode=0 then realname := fullname else realname:='';
  1378. end;
  1379.  
  1380. procedure get_broadcast_mode(var bmode:integer);
  1381. var regs : registers;
  1382. begin
  1383.  regs.ah := $de;
  1384.  regs.dl := $04;
  1385.  msdos(regs);
  1386.  bmode := regs.al;
  1387. end;
  1388.  
  1389. procedure set_broadcast_mode(bmode:integer);
  1390. var regs : registers;
  1391. begin
  1392.  if ((bmode > 3) or (bmode < 0)) then bmode := 0;
  1393.  regs.ah := $de;
  1394.  regs.dl := bmode;
  1395.  msdos(regs);
  1396.  bmode := regs.al;
  1397. end;
  1398.  
  1399. procedure get_broadcast_message(var bmessage: string; var retcode : integer);
  1400. var regs : registers;
  1401.  
  1402.     requestbuffer : record
  1403.      bufferlength : array [1..2] of byte;
  1404.       subfunction : byte;
  1405.       end;
  1406.  
  1407.       replybuffer : record
  1408.      bufferlength : array [1..2] of byte;
  1409.     messagelength : byte;
  1410.           message : array [1..58] of byte;
  1411.           end;
  1412.     count : integer;
  1413.  
  1414. begin
  1415.   With Requestbuffer do begin
  1416.      bufferlength[1] := 1;
  1417.      bufferlength[2] := 0;
  1418.      subfunction := 1;
  1419.      end;
  1420.   With replybuffer do begin
  1421.      bufferlength[1] := 59;
  1422.      bufferlength[2] := 0;
  1423.      messagelength := 0;
  1424.      end;
  1425.      for count := 1 to 58 do replybuffer.message[count] := $0;
  1426.  
  1427.   With Regs do begin
  1428.      Ah := $e1;
  1429.      Ds := Seg(requestbuffer);
  1430.      Si := Ofs(requestbuffer);
  1431.      Es := Seg(replybuffer);
  1432.      Di := Ofs(replybuffer);
  1433.      end;
  1434.   MSDOS(Regs);
  1435.   retcode := Regs.al;
  1436.   bmessage := '';
  1437.   count := 0;
  1438.   if replybuffer.messagelength > 58 then replybuffer.messagelength := 58;
  1439.   if replybuffer.messagelength > 0 then
  1440.      for count := 1 to replybuffer.messagelength do
  1441.      bmessage := bmessage + chr(replybuffer.message[count]);
  1442.   { retcode = 0 if no message,  1 if message was retreived }
  1443.   if length(bmessage) = 0 then retcode := 1 else retcode := 0;
  1444.   end;
  1445.  
  1446. procedure get_server_datetime(var _year,_month,_day,_hour,_min,_sec,_dow:integer);
  1447. var replybuffer : record
  1448.            year : byte;
  1449.           month : byte;
  1450.             day : byte;
  1451.            hour : byte;
  1452.          minute : byte;
  1453.          second : byte;
  1454.             dow : byte;
  1455.             end;
  1456.      regs : registers;
  1457. begin
  1458.   With Regs do begin
  1459.      Ah := $e7;
  1460.      Ds := Seg(replybuffer);
  1461.      Dx := Ofs(replybuffer);
  1462.      end;
  1463.   MSDOS(Regs);
  1464.   retcode := Regs.al;
  1465.   _year := replybuffer.year;
  1466.   _month := replybuffer.month;
  1467.   _day := replybuffer.day;
  1468.   _hour := replybuffer.hour;
  1469.   _min := replybuffer.minute;
  1470.   _sec := replybuffer.second;
  1471.   _dow := replybuffer.dow;
  1472. end;
  1473.  
  1474. procedure set_date_from_server;
  1475. var replybuffer : record
  1476.            year : byte;
  1477.           month : byte;
  1478.             day : byte;
  1479.            hour : byte;
  1480.          minute : byte;
  1481.          second : byte;
  1482.             dow : byte;
  1483.             end;
  1484.      regs : registers;
  1485. begin
  1486.   With Regs do begin
  1487.      Ah := $e7;
  1488.      Ds := Seg(replybuffer);
  1489.      Dx := Ofs(replybuffer);
  1490.      end;
  1491.   MSDOS(Regs);
  1492.   setdate(replybuffer.year+1900,replybuffer.month,replybuffer.day);
  1493. end;
  1494.  
  1495. procedure set_time_from_server;
  1496. var replybuffer : record
  1497.            year : byte;
  1498.           month : byte;
  1499.             day : byte;
  1500.            hour : byte;
  1501.          minute : byte;
  1502.          second : byte;
  1503.             dow : byte;
  1504.             end;
  1505.      regs : registers;
  1506. begin
  1507.   With Regs do begin
  1508.      Ah := $e7;
  1509.      Ds := Seg(replybuffer);
  1510.      Dx := Ofs(replybuffer);
  1511.      end;
  1512.   MSDOS(Regs);
  1513.   settime(replybuffer.hour,replybuffer.minute,replybuffer.second,0);
  1514. end;
  1515.  
  1516. procedure get_server_version(var _version : string);
  1517. var
  1518.         regs : registers;
  1519.      count,x : integer;
  1520.  
  1521.        request_buffer : record
  1522.         buffer_length : integer;
  1523.           subfunction : byte;
  1524.           end;
  1525.  
  1526.          reply_buffer : record
  1527.         buffer_length : integer;
  1528.                 stuff : array [1..512] of byte;
  1529.                 end;
  1530.  
  1531.         strings : array [1..3] of string;
  1532. begin
  1533.   With Regs do begin
  1534.      Ah := $e3;
  1535.      Ds := Seg(request_buffer);
  1536.      Si := Ofs(request_buffer);
  1537.      Es := Seg(reply_buffer);
  1538.      Di := Ofs(reply_buffer);
  1539.      end;
  1540.   With request_buffer do
  1541.   begin
  1542.      buffer_length := 1;
  1543.      subfunction := $c9;
  1544.   end;
  1545.   With reply_buffer do
  1546.   begin
  1547.      buffer_length := 512;
  1548.      for count := 1 to 512 do stuff[count] := $00;
  1549.   end;
  1550.   MSDOS(Regs);
  1551.   for count := 1 to 3 do strings[count] := '';
  1552.   x := 1;
  1553.   With reply_buffer do
  1554.   begin
  1555.     for count := 1 to 256 do
  1556.     begin
  1557.      if stuff[count] <> $0 then
  1558.         begin
  1559.          if not ((stuff[count]=32) and (strings[x]='')) then strings[x] := strings[x] + chr(stuff[count]);
  1560.         end;
  1561.      if stuff[count] = $0 then if x <> 3 then x := x + 1;
  1562.     end;
  1563.   End; { end of with }
  1564.   _version := strings[2];
  1565. end;
  1566.  
  1567. procedure open_message_pipe(var _connection, retcode : integer);
  1568. var regs : registers;
  1569.  
  1570.     request_buffer : record
  1571.      buffer_length : integer;
  1572.        subfunction : byte;
  1573.   connection_count : byte;
  1574.    connection_list : byte;
  1575.                end;
  1576.  
  1577.       reply_buffer : record
  1578.      buffer_length : integer;
  1579.   connection_count : byte;
  1580.        result_list : byte;
  1581.                end;
  1582. begin
  1583.   With Regs do begin
  1584.      Ah := $e1;
  1585.      Ds := Seg(request_buffer);
  1586.      Si := Ofs(request_buffer);
  1587.      Es := Seg(reply_buffer);
  1588.      Di := Ofs(reply_buffer);
  1589.      end;
  1590.   With request_buffer do
  1591.   begin
  1592.      buffer_length := 3;
  1593.      subfunction := $06;
  1594.      connection_count := $01;
  1595.      connection_list := _connection;
  1596.   end;
  1597.   With reply_buffer do
  1598.   begin
  1599.      buffer_length := 2;
  1600.      connection_count := 0;
  1601.      result_list := 0;
  1602.   end;
  1603.   MSDOS(Regs);
  1604.   retcode := reply_buffer.result_list;
  1605. end;
  1606.  
  1607. procedure close_message_pipe(var _connection, retcode : integer);
  1608. var regs : registers;
  1609.  
  1610.     request_buffer : record
  1611.      buffer_length : integer;
  1612.        subfunction : byte;
  1613.   connection_count : byte;
  1614.    connection_list : byte;
  1615.                end;
  1616.  
  1617.       reply_buffer : record
  1618.      buffer_length : integer;
  1619.   connection_count : byte;
  1620.        result_list : byte;
  1621.                end;
  1622. begin
  1623.   With Regs do begin
  1624.      Ah := $e1;
  1625.      Ds := Seg(request_buffer);
  1626.      Si := Ofs(request_buffer);
  1627.      Es := Seg(reply_buffer);
  1628.      Di := Ofs(reply_buffer);
  1629.      end;
  1630.   With request_buffer do
  1631.   begin
  1632.      buffer_length := 3;
  1633.      subfunction := $07;
  1634.      connection_count := $01;
  1635.      connection_list := _connection;
  1636.   end;
  1637.   With reply_buffer do
  1638.   begin
  1639.      buffer_length := 2;
  1640.      connection_count := 0;
  1641.      result_list := 0;
  1642.   end;
  1643.   MSDOS(Regs);
  1644.   retcode := reply_buffer.result_list;
  1645. end;
  1646.  
  1647. procedure check_message_pipe(var _connection, retcode : integer);
  1648. var regs : registers;
  1649.  
  1650.     request_buffer : record
  1651.      buffer_length : integer;
  1652.        subfunction : byte;
  1653.   connection_count : byte;
  1654.    connection_list : byte;
  1655.                end;
  1656.  
  1657.       reply_buffer : record
  1658.      buffer_length : integer;
  1659.   connection_count : byte;
  1660.        result_list : byte;
  1661.                end;
  1662. begin
  1663.   With Regs do begin
  1664.      Ah := $e1;
  1665.      Ds := Seg(request_buffer);
  1666.      Si := Ofs(request_buffer);
  1667.      Es := Seg(reply_buffer);
  1668.      Di := Ofs(reply_buffer);
  1669.      end;
  1670.   With request_buffer do
  1671.   begin
  1672.      buffer_length := 3;
  1673.      subfunction := $08;
  1674.      connection_count := $01;
  1675.      connection_list := _connection;
  1676.   end;
  1677.   With reply_buffer do
  1678.   begin
  1679.      buffer_length := 2;
  1680.      connection_count := 0;
  1681.      result_list := 0;
  1682.   end;
  1683.   MSDOS(Regs);
  1684.   retcode := reply_buffer.result_list;
  1685. end;
  1686.  
  1687.  
  1688. procedure send_personal_message(var _connection : integer; var _message : string; var retcode : integer);
  1689. var regs : registers;
  1690.     count : integer;
  1691.  
  1692.       request_buffer : record
  1693.        buffer_length : integer;
  1694.          subfunction : byte;
  1695.     connection_count : byte;
  1696.      connection_list : byte;
  1697.       message_length : byte;
  1698.              message : array [1..126] of byte;
  1699.                  end;
  1700.  
  1701.         reply_buffer : record
  1702.        buffer_length : integer;
  1703.     connection_count : byte;
  1704.          result_list : byte;
  1705.                  end;
  1706.  
  1707. begin
  1708.   With Regs do begin
  1709.      Ah := $e1;
  1710.      Ds := Seg(request_buffer);
  1711.      Si := Ofs(request_buffer);
  1712.      Es := Seg(reply_buffer);
  1713.      Di := Ofs(reply_buffer);
  1714.      end;
  1715.   With request_buffer do
  1716.   begin
  1717.      subfunction := $04;
  1718.      connection_count := $01;
  1719.      connection_list := _connection;
  1720.      message_length := length(_message);
  1721.      buffer_length := length(_message) + 4;
  1722.      for count := 1 to 126 do message[count] := $00;
  1723.      if message_length > 0 then for count := 1 to message_length do
  1724.         message[count] := ord(_message[count]);
  1725.   end;
  1726.   With reply_buffer do
  1727.   begin
  1728.      buffer_length := 2;
  1729.      connection_count := 0;
  1730.      result_list := 0;
  1731.   end;
  1732.   MSDOS(Regs);
  1733.   retcode := reply_buffer.result_list;
  1734. end;
  1735.  
  1736.  
  1737. procedure get_personal_message(var _connection : integer; var _message : string; var retcode : integer);
  1738. var regs : registers;
  1739.     count : integer;
  1740.  
  1741.       request_buffer : record
  1742.        buffer_length : integer;
  1743.          subfunction : byte;
  1744.                  end;
  1745.  
  1746.         reply_buffer : record
  1747.        buffer_length : integer;
  1748.    source_connection : byte;
  1749.       message_length : byte;
  1750.       message_buffer : array [1..126] of byte;
  1751.                  end;
  1752.  
  1753. begin
  1754.     With Regs do begin
  1755.      Ah := $e1;
  1756.      Ds := Seg(request_buffer);
  1757.      Si := Ofs(request_buffer);
  1758.      Es := Seg(reply_buffer);
  1759.      Di := Ofs(reply_buffer);
  1760.      end;
  1761.   With request_buffer do
  1762.   begin
  1763.      buffer_length := 1;
  1764.      subfunction := $05;
  1765.   end;
  1766.   With reply_buffer do
  1767.   begin
  1768.      buffer_length := 128;
  1769.      source_connection := 0;
  1770.      message_length := 0;
  1771.      for count := 1 to 126 do message_buffer[count] := $0;
  1772.   end;
  1773.   MSDOS(Regs);
  1774.   _connection := reply_buffer.source_connection;
  1775.   _message := '';
  1776.   retcode := reply_buffer.message_length;
  1777.   if retcode > 0 then for count := 1 to retcode do
  1778.      _message := _message + chr(reply_buffer.message_buffer[count]);
  1779. end;
  1780.  
  1781. procedure log_file(lock_directive:integer; log_filename: string; log_timeout:integer; var retcode:integer);
  1782. var regs : registers;
  1783. begin
  1784.     With Regs do begin
  1785.      Ah := $eb;
  1786.      Ds := Seg(log_filename);
  1787.      Dx := Ofs(log_filename);
  1788.      BP := log_timeout;
  1789.      end;
  1790. msdos(regs);
  1791. retcode := regs.al;
  1792. end;
  1793.  
  1794. procedure release_file(log_filename: string; var retcode:integer);
  1795. var regs : registers;
  1796. begin
  1797.     With Regs do begin
  1798.      Ah := $ec;
  1799.      Ds := Seg(log_filename);
  1800.      Dx := Ofs(log_filename);
  1801.      end;
  1802. msdos(regs);
  1803. retcode := regs.al;
  1804. end;
  1805.  
  1806. procedure clear_file(log_filename: string; var retcode:integer);
  1807. var regs : registers;
  1808. begin
  1809.     With Regs do begin
  1810.      Ah := $ed;
  1811.      Ds := Seg(log_filename);
  1812.      Dx := Ofs(log_filename);
  1813.      end;
  1814. msdos(regs);
  1815. retcode := regs.al;
  1816. end;
  1817.  
  1818. procedure clear_file_set;
  1819. var regs : registers;
  1820. begin
  1821.  regs.Ah := $cf;
  1822.  msdos(regs);
  1823.  retcode := regs.al;
  1824. end;
  1825.  
  1826. procedure lock_file_set(lock_timeout:integer; var retcode:integer);
  1827. var regs : registers;
  1828. begin
  1829.  regs.ah := $CB;
  1830.  regs.bp := lock_timeout;
  1831.  msdos(regs);
  1832.  retcode := regs.al;
  1833. end;
  1834.  
  1835. procedure release_file_set;
  1836. var regs : registers;
  1837. begin
  1838.  regs.ah := $CD;
  1839.  msdos(regs);
  1840. end;
  1841.  
  1842. procedure open_semaphore( _name:string;
  1843.                           _initial_value:shortint;
  1844.                           var _open_count:integer;
  1845.                           var _handle:longint;
  1846.                           var retcode:integer);
  1847. var regs : registers;
  1848.     s_name : array [1..129] of byte;
  1849.     count : integer;
  1850.     semaphore_handle : array [1..2] of word;
  1851. begin
  1852.   if (_initial_value < 0) or (_initial_value > 127) then _initial_value := 0;
  1853.   for count := 1 to 129 do s_name[count] := $00; {zero buffer}
  1854.   if length(_name) > 127 then _name := copy(_name,1,127); {limit name length}
  1855.   if length(_name) > 0 then for count := 1 to length(_name) do s_name[count+1] := ord(_name[count]);
  1856.   s_name[1] := length(_name);
  1857.   regs.ah := $C5;
  1858.   regs.al := $00;
  1859.   move(_initial_value, regs.cl, 1);
  1860.   regs.ds := seg(s_name);
  1861.   regs.dx := ofs(s_name);
  1862.   msdos(regs);
  1863.   retcode := regs.al;
  1864.   _open_count := regs.bl;
  1865.   semaphore_handle[1]:=regs.cx;
  1866.   semaphore_handle[2]:=regs.dx;
  1867.   move(semaphore_handle,_handle,4);
  1868. end;
  1869.  
  1870. procedure close_semaphore(var _handle:longint; var retcode:integer);
  1871. var regs : registers;
  1872.     semaphore_handle : array [1..2] of word;
  1873. begin
  1874.  move(_handle,semaphore_handle,4);
  1875.  regs.ah := $C5;
  1876.  regs.al := $04;
  1877.  regs.cx := semaphore_handle[1];
  1878.  regs.dx := semaphore_handle[2];
  1879.  msdos(regs);
  1880.  retcode := regs.al;  { 00h=successful   FFh=Invalid handle}
  1881. end;
  1882.  
  1883. procedure examine_semaphore(var _handle:longint; var _value:shortint; var _count, retcode:integer);
  1884. var regs : registers;
  1885.     semaphore_handle : array [1..2] of word;
  1886. begin
  1887.     move(_handle,semaphore_handle,4);
  1888.     regs.ah := $C5;
  1889.     regs.al := $01;
  1890.     regs.cx := semaphore_handle[1];
  1891.     regs.dx := semaphore_handle[2];
  1892.     msdos(regs);
  1893.     retcode := regs.al; {00h=successful FFh=invalid handle}
  1894.     move(regs.cx, _value, 1);
  1895.     _count := regs.dl;
  1896. end;
  1897.  
  1898. procedure signal_semaphore(var _handle:longint; var retcode:integer);
  1899. var regs : registers;
  1900.     semaphore_handle : array [1..2] of word;
  1901. begin
  1902.     move(_handle,semaphore_handle,4);
  1903.     regs.ah := $C5;
  1904.     regs.al := $03;
  1905.     regs.cx := semaphore_handle[1];
  1906.     regs.dx := semaphore_handle[2];
  1907.     msdos(regs);
  1908.     retcode := regs.al;
  1909.     {00h=successful   01h=overflow value > 127   FFh=invalid handle}
  1910. end;
  1911.  
  1912. procedure wait_on_semaphore(var _handle:longint; _timeout:integer; var retcode:integer);
  1913. var regs : registers;
  1914.     semaphore_handle : array [1..2] of word;
  1915. begin
  1916.     move(_handle,semaphore_handle,4);
  1917.     regs.ah := $C5;
  1918.     regs.al := $02;
  1919.     regs.bp := _timeout; {units in 1/18 of second,   0 = no wait}
  1920.     regs.cx := semaphore_handle[1];
  1921.     regs.dx := semaphore_handle[2];
  1922.     msdos(regs);
  1923.     retcode := regs.al;
  1924.     {00h=successful   FEh=timeout failure   FFh=invalid handle}
  1925. end;
  1926.  
  1927. procedure clear_connection(connection_number : integer; var retcode : integer);
  1928. var con_num : byte;
  1929.     regs : registers;
  1930.  
  1931.     request_buffer : record
  1932.             length : integer;
  1933.        subfunction : byte;
  1934.            con_num : byte;
  1935.                end;
  1936.  
  1937.       reply_buffer : record
  1938.             length : integer;
  1939.                end;
  1940.  
  1941. begin
  1942.   with request_buffer do begin
  1943.      length := 4;
  1944.      con_num := connection_number;
  1945.      subfunction := $D2;
  1946.      end;
  1947.   reply_buffer.length := 0;
  1948.   with regs do begin
  1949.      Ah := $e3;
  1950.      Ds := Seg(request_buffer);
  1951.      Si := Ofs(request_buffer);
  1952.      Es := Seg(reply_buffer);
  1953.      Di := Ofs(reply_buffer);
  1954.      end;
  1955.   msdos(regs);
  1956.   retcode := regs.al;
  1957. end;
  1958.  
  1959.  
  1960. end. { end of unit novell }
  1961.  
  1962.