Programmer 7500

home *** CD-ROM | disk | FTP | other *** search

/ Programmer 7500 / MAX_PROGRAMMERS.iso / VISUAL_B / CODIGO_1 / BCC101 / PBCODE.ZIP / NET001.BAS

Wrap

BASIC Source File | 1993-03-19 | 12.0 KB | 319 lines

' This FILE: "NET001.BAS" is placed in the public domain by the author: ' Lewis Balentine, 19 March 1993. The author specificly denies all warranties, ' exspressed or implied, of fittness or function. ' ->>>> use or abuse as you see fit <<<<- '---------------------------------------------------------------------------- ' The code in this file is intended to be compiled with Spectra Publishing's ' Power Basic version 3.0. It provides functions that interface the Novell ' Netware connection API. Sample program code prints this information to ' the screen. (FYI: TABS set to 4) ' ' Functions included are: ' GetConnectNummber% -> Netware Logical Connection number ' GetConnectInfo% -> Information logged in user ' GetNode$ -> Stations physical node ' '---------------------------------------------------------------------------- 'PGN PAGE: XXX in this program remarks refers to a page in the book: ' "Programers Guide to Netware", Charles G. Rose, (c) 1990 McGraw Hill. '============================================================================ $compile exe $debug map on $dim array DECLARE FUNCTION GetStrLoc&(byval AllocHandle%) ' so ASM CALL can find it '---------------------------------------------------------------------------- ' Constants for use with PB3's REGS function/statement. %FLAGS = 0 %AX = 1 %BX = 2 %CX = 3 %DX = 4 %SI = 5 %DI = 6 %BP = 7 %DS = 8 %ES = 9 '---------------------------------------------------------------------------- type ConInfoReq ' Connection Information Request Buffer length as word ' (LoHi) Request buffer length (4 - 2 = 2) cll as byte ' Set to &H16 con as byte ' logical connection number end type type ConInfoRep ' Connection Information Reply Buffer length as word ' (LoHi) Reply buffer length (64 - 2 = 62) id as Dword ' (HiLo) Object ID tipe as word ' (HiLo) Object Type nam as string * 48 ' Object Name Yr as Byte ' Log in Year where 0 = 1980 Mo as Byte ' Month (1 to 12) Dy as Byte ' Day (1 to 31) Hr as Byte ' Hour (0 to 23) Mn as Byte ' Minute (0 to 59) Sc as Byte ' Second (0 to 59) Wk as Byte ' WeekDay where 0=Sunday Extra as Byte ' Undefined extra byte end type '---------------------------------------------------------------------------- ' the FourByte, TwoByte types and HiLoWord, HiLoDWord are used in the functions ' SwapBytesW and SwapBytesDW. Type FourByte B1 as Byte B2 as Byte B3 as Byte B4 as Byte end Type Type TwoByte B1 as Byte B2 as Byte end Type Union HiLoWord Wrd as Word BB as TwoByte end Union Union HiLoDWord DW as Dword BB as FourByte end Union '============================================================================ ' This is the "MAIN" code of the prgram. It prints Netware Connection ' Information about the workstation and logged on user. '============================================================================ start: dim info as ConInfoRep connect%=GetConnectNumber% print if connect%=0 then print "This workstation is not logged in to the network." end end if errr%=GetConnectInfo%(connect%,info) if errr%<>0 then print "Get Netware Connection Information failed." end else Print "Logical Connection number is (DEC): ";connect% Print " LogIn Name is: "; trim$(info.nam) print " Netware Object ID is (HEX): "; DWHex$(SwapBytesDW???(info.id)) print " Netware Object Type is (HEX): ";Right$(DWHex$(SwapBytesW??(info.tipe)),4) print " WorkStation Node is (HEX): "; getnode$ end if end '============================================================================= ' Below are the function used by the program. '============================================================================= ' function to return Netware Logical Connection number function GetConnectNumber% ' PGN PAGE: 274 ' if 0 then not logged in local c% !xor AX,AX ' zero AX !mov AH,&Hdc ' Netware API call for Connect # !int &H21 ' Call Netware (returns AX=&Hdc32) !xor AH,AH ' Mask off the high byte !mov c%,AX ' AL contains connection number GetConnectNumber%= c% end function '---------------------------------------------------------------------------- ' function to return info about the Netware object at a specific connection # ' PGN PAGE: 272 function GetConnectInfo% (con%, reply as coninforep) Local dim request as ConInfoReq request.length=2 request.cll=&H16 request.con=con% reply.length=62 reg %ES, varseg(reply) reg %DI, varptr(reply) reg %DS, varseg(request) reg %SI, varptr(request) reg %AX, &HE300 call interrupt &H21 reply.Extra = Reg(%AX) and &H00FF ' 0 indicates succesful call GetConnectInfo%=reply.extra end function '---------------------------------------------------------------------------- ' funtion to return 6 byte Physical Node Address of the requesting workstation ' PowerBasic does not have a 6 byte integer type so we are going to return ' a 12 byte string representation of the unsigned Hexidecimal number. ' There is probably a better way to do this, but .... function GetNode$ ' PGN PAGE: 276 temp$="000000000000" ' 6 bytes requires 12 characters ! push DI ; save Destination Index ! ! mov AX,&Hee00 ! int &H21 ; Call Netware ! ' ! mov AX,&h4321 ; for test of conversion ' ! mov BX,&h8765 ; for test of conversion ' ! mov CX,&hCBA9 ; for test of conversion ! ! push CX ; Node returned in CX,BX,AX ! push BX ! push AX ' setup our working string ! mov AX,temp$ ' string handle ! push AX ' now for location and length ! call getstrloc ' return: location=DX:AX, length=CX ! dec CX ' reduce count by one ! add AX, CX ' we need the end of the string ! mov ES, DX ' store our address of string ! mov DI, AX ' in ES:DI ! std ; set direction flag for decriment ! mov CX,&h0003 GetNodeLoop: ! pop BX ; get word from stack ! mov AH,4 ; (4 nibbles) ! call WHex ; translate ! loop GetNodeLoop ! pop DI ; restore resisters ! cld GetNode$=temp$ end function '---------------------------------------------------------------------------- ' functions to swap High and Low bytes of a Word/DWord ' Netware was origionally only available on a Motorola 6800 server. Motorola ' stores numbers with the most significant byte first. Intel stores numbers ' with the least significant byte first. This function is use to translate ' the old style unsigned wird values. Note that it does not change the input. function SwapBytesW?? (wrd??) Local dim temp as HiLoWord temp.Wrd=wrd?? swap temp.bb.b1 , temp.bb.b2 SwapBytesW??=temp.Wrd end function '---------------------------------------------------------------------------- function SwapBytesDW??? (DW???) Local dim temp as HiLoDWord temp.DW=DW??? 'print hex$(temp.bb.b1), hex$(temp.bb.b4) swap temp.bb.b1, temp.bb.b4 swap temp.bb.b2, temp.bb.b3 SwapBytesDW???=temp.DW end function '---------------------------------------------------------------------------- ' function to return the value of the string representation of Hexidecimal ' number. PB's "&Hxxxx" is limited to compile time and/or two bytes. ' NOTE: This function assumes unsigned strings ! ' NOTE: This function ignores the invalid characters! function DWHexVal???( DW as string) Local dim temp as string temp=ucase$(DW) while len(temp)>0 p= instr("0123456789ABCDEF",left$(temp$,1)) if p>0 then shift left t???,4 t???=t???+(p-1) end if ' print p,t???,temp temp=mid$(temp,2) wend DWHexVal???=t??? end function '---------------------------------------------------------------------------- ' function to return a 8 character Hexidecimal string representation of ' a four byte DoubleWord variable. (PB's HEX$ function is limited to 2 Bytes) function DWHex$ (DW as DWord) Local temp$="87654321" ' allocate 8 byte character string ' PAGE: 333 of PB3 Programers Guide ' " ... save the SI,DI,BP,DS,SS and SP registers." ' of these we only modify the DI register. ! push DI ; save Destination Index ' setup our working string ! mov AX,temp$ ' string handle ! push AX ' now for location and length ! call getstrloc ' return: location=DX:AX, length=CX ! dec CX ' reduce count by one ! add AX, CX ' we need the end of the string ' setup our DoubleWord Variable ! les di,[bp+6] ' get the address from the stack ! mov BX, es:[di] ' store lo word ! inc di ' move index foward ! inc di ' two bytes ! mov CX, es:[di] ' store hi word ! mov ES, DX ' store our address in of string ! mov DI, AX ' in ES:DI ! std ' set the direction flag ! mov AH,4 ' 1 word = 4 nibbles ! call Whex ' now convert ! mov BX,CX ' get the hi word ! mov AH,4 ' 1 word = 4 nibbles ! call WHex ' convert it ! pop DI ' restore Destination Index ' PAGE: 333 of PB3 Programers Guide ' " ... all these calls also require you clear ... the processor ' direction flag before returning to caller. ..." ! cld DWHex$=temp$ end function '---------------------------------------------------------------------------- ' This function trims the "white space" from both ends of string. ' It also removes ANY contol characters (0 to 31). function trim$(t$) dim temp as string for i=1 to len(t$) tt$=mid$(t$,i,1) if tt$=>" " then temp=temp+tt$ next i trim$=ltrim$(rtrim$(temp)) end function '============================================================================= ' below are misc ASSEMBLY soubroutines called from the inline ASM functions '============================================================================= ' Most, if not all, of this assembly work could have been done in pure Basic. ' The main reason I did it in assembly was to get some idea of what could ' be done (and how) with the INLINE ASM capability of PB3. ' Having gone to the trouble ..... I am going to use it. '----------------------------------------------------------------------------- ! ; ASM routine converts the WORD in BX to a Hex String representation ! ; on entry ! ; ES:DI = pointer to end of string (works right to left) ! ; BX = value to be converted ! ; AH = number of nibbles (hex digits) to convert (0 to 4) ! ; direction flag = set (decrement) ! ; on exit ! ; BX = undefined (contents rotated, 4 digits->BXin=BXout) ! ; AH = zero ! ; AL = last Hex Character ! ; AX = undefined (AH =0, AL last Hex digit) ! ; ES:DI = byte in front of hex string ! ; The only other register affected is the flag register. ! ; NOTES: ! ; NO ERROR CHECKING, THIS WILL WRITE OVER ANYTHING (or at least try)!! ! ; THIS ROUTINE USES A NEAR RETURN, MUST CALL FROM SAME CODE SEG !!!! WHex: ! cmp AH,0 ; if 0 then ! jz WHexExit ; out of here ! mov AL, BL ; get value from BX ! and AL, &h0F ; mask off low nibble ! dec AH ; sub one from our counter ! ror BX, 1 ; rotate the next nibble in BX ! ror BX, 1 ; four rotates are used so that ! ror BX, 1 ; this will work on an 8088 ! ror BX, 1 ; rotate is used to preserve BX ! cmp AL, &H0009 ; if greater than 9 then ! jg WHexAlpha ; jump to alpha character ! add AL, &h30 ; else add offset for numeric ! stosb ; store val in AL at ES:DI, DI=DI-1 ! jmp WHex ; do it again Sam ... WHexAlpha: ! add AL, &h37 ; add offset for alpha character ! stosb ; store val in AL at ES:DI, DI=DI-1 ! jmp WHex ; do it again Sam ... WHexExit: ! retn ; back to whince we came (I hope) '----------------------------------------------------------------------------- ' more to come, maybe .... ' End of File <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<