'=========================================================================== ' Subject: NOVELL NETWARE FUNCTIONS FOR PB Date: 09-13-97 (23:51) ' Author: Scott Slater Code: PB ' Origin: captain@usaor.net Packet: NETWORK.ABC '=========================================================================== ' 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� ' Program Title: NWCALLS.BAS ' Copyright: Donated to PUBLIC DOMAIN By Scott Slater ' Author: Scott Slater ' Last Modified: 09/14/1997 ' 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� ' Description: Some Novell NetWare functions for PowerBASIC ' 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� %EXEFILE = 1 ' change to 0 to compile as a unit $cpu 8086 ' program works on any CPU $optimize size ' make smallest possible executable $if %EXEFILE ' if we're making an EXE $compile exe ' compile to an EXE $else ' otherwise $compile unit ' compile to a unit $endif $debug map off ' turn off map file generation $debug pbdebug off ' don't include pbdebug support in our executable $lib all off ' turn off PowerBASIC's internal libraries. $error all off ' turn off all error checking $com 0 ' set communications buffer to nothing $string 16 ' set largest string size at 16k $stack 2048 ' use a 2k stack $sound 1 ' smallest music buffer possible $dim all ' force all variables to be pre-dimensioned before ' they can be used $dynamic ' all arrays will be dynamic by default $option cntlbreak off ' don't allow Ctrl-Break to exit program type FullNetAddress ' full net address buffer type NetWork as string * 4 Node as string * 6 Socket as string * 2 end type type ReqPack1 ' request packet type 1 for function length as word ' E3h calls funct as byte end type type RplPack1 ' reply packet type 1 for function length as word ' E3h calls SrvName as string * 48 Major as byte Minor as byte totconn as word usedconn as word maxvols as word enumm as word reserved as string * 88 end type type ReqPack2 ' request packet type 2 for function length as word ' E3h calls funct as byte connect as byte end type type RplPack2 ' reply packet type 2 for function length as word ' E3h calls beID as dword UserType as word UserName as string * 48 LoginTime as string * 8 end type declare function NWGetConn() as word declare function strim(wordvar as word) as string declare function strimb(bytevar as byte) as string declare function Str2Hex(StrVar as string) as string $if %EXEFILE ' TEST CODE HERE! declare function IPXInstalled() as byte declare function NWGetVer() as single declare function NWGetServerName() as string declare function NWGetFullAddress() as string declare function NWGetUserName() as string declare function NWGetLoginTime(style as byte) as string declare function NWGetNodeAddress() as string declare function NWGetNetworkNumber() as string dim us as string if IPXInstalled then if NWGetVer then Print Print NWGetServerName;" is running NetWare";NWGetVer Print "This station's connection number is";NWGetConn Print "and its full IPX address is ";NWGetFullAddress Print us = NWGetUserName if us = "Not Logged In" then Print "Currently ";us else Print "User ";us;" logged in on ";NWGetLoginTime(3) Print "from node ";NWGetNodeAddress;" on Network ";NWGetNetworkNumber end if else Print "IPX is installed, but no server information is available." end if else Print "No IPX Installed on this station." end if Print end $endif '-------------------------------------------------------------------------- ' NetWare CONNECTION SERVICES - GET CONNECTION NUMBER Function DCh '-------------------------------------------------------------------------- function NWGetConn() public as word ! push ds ; save ds for PowerBASIC ! mov ah, &HDC ; function DCh ! int &H21 ; call interrupt 21h ! pop ds ; restore the ds ! mov function, al ; al holds the connection number end function '-------------------------------------------------------------------------- ' NetWare SERVER INFO SERVICES - GET CURRENT VERSION Function E3h '-------------------------------------------------------------------------- function NWGetVer() public as single dim request as reqpack1 dim reply as rplpack1 dim seg1 as word dim seg2 as word dim off1 as word dim off2 as word request.length = len(request) ' length of request buffer request.funct = &H11 ' sub function 11h reply.length = len(reply) ' length of the reply buffer seg1 = varseg(request) ' segment address of request buffer off1 = varptr(request) ' offset of request buffer seg2 = varseg(reply) ' segment address of reply buffer off2 = varptr(reply) ' offset of reply buffer ! push ds ; save the ds for PowerBASIC ! mov ax, &HE300 ; function E3h ! mov ds, seg1 ; address of request buffer goes ! mov si, off1 ; into ds:si ! mov es, seg2 ; address of reply buffer goes ! mov di, off2 ; into es:di ! int &H21 ; interrupt 21h ! pop ds ; restore the ds ! cmp al, 0 ; is al = 0 ? ! jne ver_err ; if not we have an error ! jmp ver_ok ; if so we are successful ver_err: function = 0 exit function ver_ok: function = reply.major + (reply.minor/100) ' return version info end function '-------------------------------------------------------------------------- ' NetWare SERVER INFO SERVICES - GET SERVER NAME Function E3h SubFunc 11h '-------------------------------------------------------------------------- function NWGetServerName() public as string dim request as reqpack1 dim reply as rplpack1 dim seg1 as word dim seg2 as word dim off1 as word dim off2 as word dim temp as string request.length = len(request) ' length of request buffer request.funct = &H11 ' sub function 11h reply.length = len(reply) ' length of reply buffer seg1 = varseg(request) ' segment address of request buffer off1 = varptr(request) ' offset of request buffer seg2 = varseg(reply) ' segment address of reply buffer off2 = varptr(reply) ' offset of reply buffer ! push ds ; save the ds for PowerBASIC ! mov ax, &HE300 ; function E3h ! mov ds, seg1 ; address of request buffer goes ! mov si, off1 ; into ds:si ! mov es, seg2 ; address of reply buffer goes ! mov di, off2 ; into es:di ! int &H21 ; interrupt 21h ! pop ds ; restore the ds ! cmp al, 0 ; is al = 0? ! jne srv_err ; if not we have an error ! jmp srv_ok ; if so, we are done srv_err: function = "Not Attached" ' we weren't successful so we must exit function ' not be attached to a server srv_ok: temp = reply.SrvName function = left$(temp, instr(temp, chr$(0)) - 1) 'return the server name end function '-------------------------------------------------------------------------- ' NETWARE SHELL SERVICES - GET NODE ADDRESS Function EEh '-------------------------------------------------------------------------- function NWGetNodeAddress() public as string dim part1 as word dim part2 as word dim part3 as word dim temp as string ! push ds ; save the ds for PowerBASIC ! xor ax, ax ; 0 the ax register ! mov ah, &HEE ; function EEh ! int &H21 ; interrupt 21h ! mov part3, ax ; copy contents of ax to part3 ! mov part2, bx ; copy contents of bx to part2 ! mov part1, cx ; copy contents of cx to part1 ! pop ds ; restore the ds temp = right$("0000" + hex$(part1),4) ' build the node address temp = temp +right$("0000" + hex$(part2),4) ' from all 3 parts temp = temp +right$("0000" + hex$(part3),4) function = temp ' return the node address end function '-------------------------------------------------------------------------- ' IPX SERVICES - GET NETWORK NUMBER Function 9h, of Int 7Ah '-------------------------------------------------------------------------- function NWGetNetworkNumber() public as string dim NetAdd as FullNetAddress dim seg1 as word dim off1 as word dim temp as string seg1 = varseg(NetAdd) off1 = varptr(NetAdd) ! push ds ; save the ds for PowerBASIC ! xor bx, bx ; 0 the bx register ! mov bx, &H9 ; put 9h into bx ! mov es, seg1 ; address of NetAdd (Buffer) goes ! mov si, off1 ; into es:si ! int &H7A ; interrupt 7Ah ! pop ds ; restore the ds temp = NetAdd.Network function = Str2Hex(temp) ' return network address end function '-------------------------------------------------------------------------- ' IPX SERVICES - GET FULL ADDRESS Function 9h, of Int 7Ah '-------------------------------------------------------------------------- function NWGetFullAddress() public as string dim NetAdd as FullNetAddress dim seg1 as word dim off1 as word dim temp1 as string dim temp2 as string seg1 = varseg(NetAdd) off1 = varptr(NetAdd) ! push ds ; save the ds for PowerBASIC ! xor bx, bx ; 0 the bx ! mov bx, &H9 ; copy 9h to bx ! mov es, seg1 ; address of NetAdd (Buffer) goes ! mov si, off1 ; into es:si ! int &H7A ; interrupt 7Ah ! pop ds ; restore the ds temp1 = NetAdd.NetWork ' build the entire network address temp2 = Str2Hex(temp1) ' as follows; temp1 = NetAdd.Node ' XXXXXXXX:NNNNNNNNNNNN:SSSS temp2 = temp2 + ":" + Str2Hex(temp1) ' where X is the Network Number temp1 = NetAdd.Socket ' N is the node address temp2 = temp2 + ":" + Str2Hex(temp1) ' S is the Socket Number function = temp2 ' return the full address end function '-------------------------------------------------------------------------- ' IPX SERVICES - IPX DETECTION Function 7Ah '-------------------------------------------------------------------------- ' ' Returns FFh (255) if IPX is installed, 0 if not. ' function IPXInstalled() public as byte ! push ds ; save the ds for PowerBASIC ! xor ax, ax ; 0 the ax register ! mov ah, &H7A ; function 7Ah ! int &H2F ; interrupt 2Fh ! pop ds ; restore ds ! mov function, al ; result is in al FFh=TRUE 0h=FALSE end function '-------------------------------------------------------------------------- ' NetWare CONNECTION SERVICES - GET USER NAME Function E3h SubFunc 16h '-------------------------------------------------------------------------- function NWGetUserName() public as string dim request as reqpack2 dim reply as rplpack2 dim seg1 as word dim seg2 as word dim off1 as word dim off2 as word dim temp as string request.length = len(request) ' length of request buffer request.funct = &H16 ' subfunction 16h request.connect = (NWGetConn AND &HFF) ' connection number reply.length = len(reply) ' length of reply buffer seg1 = varseg(request) ' segment address of request buffer off1 = varptr(request) ' offset of request buffer seg2 = varseg(reply) ' segment address of reply buffer off2 = varptr(reply) ' offset of reply buffer ! push ds ; save ds for PowerBASIC ! xor ax, ax ; 0 the ax register ! mov ah, &HE3 ; function E3h ! mov ds, seg1 ; address of Request buffer goes ! mov si, off1 ; into ds:si ! mov es, seg2 ; address of reply buffer goes ! mov di, off2 ; into es:di ! int &H21 ; interrupt 21h ! pop ds ; restore the ds ! cmp al, 0 ; is the al set to 0? ! jne usr_err ; if not we have an error ! jmp usr_ok ; if so, we were successful usr_err: function = "Not Logged In" exit function usr_ok: temp = reply.UserName function = left$(temp, instr(temp, chr$(0)) - 1) 'return user name end function '-------------------------------------------------------------------------- ' NetWare CONNECTION SERVICES - GET LOGIN TIME Function E3h SubFunc 16h '-------------------------------------------------------------------------- ' ' Syntax: PRINT NWGetLoginTime(x) ' ' where x = 0, 1, 2, or 3 to produce different output styles function NWGetLoginTime(style as byte) public as string dim request as reqpack2 dim reply as rplpack2 dim seg1 as word dim seg2 as word dim off1 as word dim off2 as word dim temp1 as string dim temp2 as string dim year as word dim month as byte dim day as byte dim day_of_week as byte dim hour as byte dim minute as byte dim sec as byte request.length = len(request) ' length of request buffer request.funct = &H16 ' sub function 16h request.connect = (NWGetConn AND &HFF) ' connection number reply.length = len(reply) ' length of reply buffer seg1 = varseg(request) ' segment address of request buffer off1 = varptr(request) ' offset of request buffer seg2 = varseg(reply) ' segment address of reply buffer off2 = varptr(reply) ' offset of reply buffer ! push ds ; save the ds for PowerBASIC ! xor ax, ax ; 0 the ax register ! mov ah, &HE3 ; function E3h ! mov ds, seg1 ; address of request buffer goes ! mov si, off1 ; into ds:si ! mov es, seg2 ; address of reply buffer goes ! mov di, off2 ; into es:di ! int &H21 ; interrupt 21h ! pop ds ; restore the ds ! cmp al, 0 ; is al = 0 ? ! jne lit_err ; if not we have an error ! jmp lit_ok ; if so, we were successful lit_err: function = "" exit function lit_ok: ' construct the return string year = 1900 + cvbyt(mid$(reply.LogInTime,1,1)) month = cvbyt(mid$(reply.LogInTime,2,1)) day = cvbyt(mid$(reply.LogInTime,3,1)) hour = cvbyt(mid$(reply.LogInTime,4,1)) minute = cvbyt(mid$(reply.LogInTime,5,1)) sec = cvbyt(mid$(reply.LogInTime,6,1)) day_of_week = cvbyt(mid$(reply.LogInTime,7,1)) if (style and 2) then ' 12 hour time if hour > 12 then hour = hour - 12 temp1 = strimb(hour) + ":" + strimb(minute) temp1 = temp1 + ":" + strimb(sec) + " PM" else temp1 = strimb(hour) + ":" + strimb(minute) temp1 = temp1 + ":" + strimb(sec) + " AM" end if else ' 24 hour time temp1 = strimb(hour) + ":" + strimb(minute) temp1 = temp1 + ":" + strimb(sec) end if if (style and 1) then ' long date format select case month case 1 temp2 = "January " case 2 temp2 = "February " case 3 temp2 = "March " case 4 temp2 = "April " case 5 temp2 = "May " case 6 temp2 = "June " case 7 temp2 = "July " case 8 temp2 = "August " case 9 temp2 = "September " case 10 temp2 = "October " case 11 temp2 = "November " case 12 temp2 = "December " end select temp2 = temp2 + strimb(day) + ", " + strim(year) select case day_of_week case 0 temp2 = "Sunday " + temp2 case 1 temp2 = "Monday " + temp2 case 2 temp2 = "Tuesday " + temp2 case 3 temp2 = "Wednesday " + temp2 case 4 temp2 = "Thursday " + temp2 case 5 temp2 = "Friday " + temp2 case 6 temp2 = "Saturday " + temp2 end select else ' Short Date Format temp2 = strimb(month) + "/" + strimb(day) + "/" + strim(year) end if function = temp2 + " at " + temp1 end function ' used internaly to convert word to a string and remove spaces function strim(w as word) as string function = ltrim$(rtrim$(str$(w))) end function ' used internaly to convert byte to a string, remove spaces, and make ' propper length function strimB(b as byte) as string function = right$("00" + ltrim$(rtrim$(str$(b))),2) end function ' used internaly to convert IPX Call String values to hex function Str2Hex (strval as string) as string dim temp as string dim count as integer dim sng as single temp = "" for count = 1 to len(strval) sng = asc(mid$(strval, count, 1)) if sng < 15 then temp = temp + "0" + hex$(sng) else temp = temp + hex$(sng) end if next count function = temp end function