Oct 242014
Had an application that communicated with test controller PC via Ethernet using NetBIOS. Basically, the test controller acted like a NetBIOS server waiting for connections and subsequent commands.
Below is the entire NetBIOS library. NOTE: In Windows 7 64-bit, found that compile w/ CPU as ANY resulted in runtime errors to the underlying Windows NetBios API. However, compiling with CPU as x86 worked fine.
Imports System.Runtime.InteropServices
' FILE HEADER ----------------------------------------------
' FILE : NETBIOS.BAS
' COPYRIGHT: 2000 to 2014 Reedholm Instruments Co.
' AUTHOR(s): Jon Reedholm
' VERSION : 1.05
' DATE : 5/23/2014
'-----------------------------------------------------------
' REVISION HISTORY------------------------------------------
' 1.00 JSR 8/03/2000 SPR 2/1/2000-01
' Created.
'...........................................................
' 1.01 JSR 9/26/2000 SPR 2/1/2000-01
' Modified to have public types & constants object
' class compatible.
'...........................................................
' 1.02 JSR 4/03/2001 SPR 2/1/2000-01
' Made into ActiveX DLL. Added notes mainly.
'..........................................................
' 1.03 JSR 4/11/2012 ECR 01/25/2011-1
' Started conversion for Windows 2.00
'...........................................................
' 1.04 JSR 6/25/2012
' Added NB_AdapterStat, netLoopUntilReady and modified
' NB_SessionStat during debugging of network issue
' with new server. Changes not used, but left in
' in case needed in future.
'..........................................................
' 1.05 JSR 5/23/2014 ECR 01/25/2011-1
' Got working with Win7 64bit.
'-----------------------------------------------------------
' REFERENCES -----------------------------------------------
' IBM NetBIOS Application Development Guide
'
' MSDN library on NetBIOS call, structures, & constants -
' of which a copy has been placed in the Web Project Notes
'-----------------------------------------------------------
' NOTES ----------------------------------------------------
' Low level NetBIOS subroutines used to communicate with
' the slave PC. These routines use the Windows
' NET32API.DLL for the actual NetBIOS call. Most of the
' following constants and structures were provided from
' the API viewer. However, the structures were incorrect
' by assigning a C syntax UCHAR as an integer, instead of
' a byte.
'
' Visual Basic moves variables in memory, thus extra care
' needs to be used when passing a buffer pointer to
' a API routine--such as NetBIOS. This is especially true
' for an array variable. To do this, marshalling and
' using unmanaged data types was required in VB 2010.
'
'...........................................................
' Have learned that NetBIOS appears to not look beyond first
' eight characters to see if NetBIOS names added to NetBIOS
' table are the same. Didn't look into this further, since
' ActiveX DLL only using one connection at a time.
'
'...........................................................
' Got it to work by the following:
' Making sure every item in NCB structure had Marshal setting.
' Compiled DLLs and EXEs with X86 CPU.
' Used Ctype for returning LANAS.
'
' Trick was making sure to have MarshalAs on every item in
' NCB structure and then switching to X86 for platform,
' since NETAPI32.DLL is 32-bit.
'
' Per Microsoft, NetBIOS is no longer supported after Win XP.
' They suggest using other comm. method such as named pipes.
'-----------------------------------------------------------
Public Module NetBios
'-----------------------------------------------------------
' Below constants are all used NetBIOS commands. More
' commands than those listed exist, but are not used.
'-----------------------------------------------------------
Private Const NCBNOWAIT As Byte = &H80 '[Sets command to not wait]
Private Const NCBACTION As Byte = &H77
Private Const NCBADDNAME As Byte = &H30
Private Const NCBASTAT As Byte = &H33
Private Const NCBCALL As Byte = &H10
Private Const NCBCANCEL As Byte = &H35
Private Const NCBDELNAME As Byte = &H31
Private Const NCBENUM As Byte = &H37
Private Const NCBHANGUP As Byte = &H12
Private Const NCBLANSTALERT As Byte = &H73
Private Const NCBLISTEN As Byte = &H11
Private Const NCBRECV As Byte = &H15
Private Const NCBRESET As Byte = &H32
Private Const NCBSEND As Byte = &H14
Private Const NCBSSTAT As Byte = &H34
'-----------------------------------------------------------
' Below constants are used with NCB commands
'-----------------------------------------------------------
Private Const ncbRcvTimeOut As Byte = 10 '[Set recv cmds timeout 5s]
Private Const ncbSndTimeOut As Byte = 60 '[Set send cmds timeout 30s]
'-----------------------------------------------------------
' The Lana_ENUM structure is used to store all the network
' adapter LAN #s found on the PC--used for NetBIOS calls
'-----------------------------------------------------------
Public Enum LANAenum
maxLANA = 254
End Enum
'-----------------------------------------------------------
' Below are all the possible NetBIOS errors
'-----------------------------------------------------------
Public Enum netbErrors As Byte
nrcACTSES = &HF
nrcBADDR = &H7
nrcBRIDGE = &H23
nrcLEN = &H1
nrcCANCEL = &H26
nrcCANOCCR = &H24
nrcCMDCAN = &HB
nrcCMDTMO = &H5
nrcDUPENV = &H30
nrcDUPNAME = &HD
nrcENVNOTDEF = &H34
nrcGOODRET = &H0
nrcIFBUSY = &H21
nrcILLCMD = &H3
nrcILLNN = &H13
nrcINCOMP = &H6
nrcINUSE = &H16
nrcINVADDRESS = &H39
nrcINVDDID = &H3B
nrcLOCKFAIL = &H3C
nrcLOCTFUL = &H11
nrcMAXAPPS = &H36
nrcNAMCONF = &H19
nrcNAMERR = &H17
nrcNAMTFUL = &HE
nrcNOCALL = &H14
nrcNORES = &H9
nrcNORESOURCES = &H38
nrcNOSAPS = &H37
nrcNOWILD = &H15
nrcOPENERR = &H3F
nrcOSRESNOTAV = &H35
nrcPENDING = &HFF
nrcREMTFUL = &H12
nrcSABORT = &H18
nrcSCLOSED = &HA
nrcSNUMOUT = &H8
nrcSYSTEM = &H40
nrcTOOMANY = &H22
End Enum
'-----------------------------------------------------------
' NetBIOS Network Control Block structure--which is used to
' issue all commands to the NetBIOS protocol
'-----------------------------------------------------------
Public Enum netbstrcs
netNameLen = 16 '[Length if name in bytes]
netresvLen = 11 '[Length of reserve array]
netbuffer = 32000 '[Total size of data butter]
netnumSess = 10 '[Total number of active sessions]
netMAC = 7 '[MAC address len]
netnumNames = 17 '[Number of netbios names in adapter table]
End Enum
'-----------------------------------------------------------
' Used IntPtr, but have to compile EXE (or atleast RICLIENT>DLL)
' as x86 platform for call to NetAPI32.DLL to work -
' otherwise get exception error inside NetBios call.
'-----------------------------------------------------------
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> _
Public Structure NCB
<MarshalAs(UnmanagedType.U1)> _
Public ncbCommand As Byte
<MarshalAs(UnmanagedType.U1)> _
Public ncbRetcode As Byte
<MarshalAs(UnmanagedType.U1)> _
Public ncbLSN As Byte
<MarshalAs(UnmanagedType.U1)> _
Public ncbNum As Byte
<MarshalAs(UnmanagedType.SysUInt)> _
Public ncbBuffer As IntPtr
<MarshalAs(UnmanagedType.U2)> _
Public ncbLength As Int16
<MarshalAs(UnmanagedType.ByValArray, ArraySubType:=UnmanagedType.U1, _
SizeConst:=netbstrcs.netNameLen)> Dim ncbCallname() As Byte
<MarshalAs(UnmanagedType.ByValArray, ArraySubType:=UnmanagedType.U1, _
SizeConst:=netbstrcs.netNameLen)> Dim ncbName() As Byte
<MarshalAs(UnmanagedType.U1)> _
Public ncbRTO As Byte
<MarshalAs(UnmanagedType.U1)> _
Public ncbSTO As Byte
<MarshalAs(UnmanagedType.U4)> _
Public ncbPost As UInt32 'IntPtr
<MarshalAs(UnmanagedType.U1)> _
Public ncbLANAnum As Byte
<MarshalAs(UnmanagedType.U1)> _
Public ncbCmdCplt As Byte
<MarshalAs(UnmanagedType.ByValArray, ArraySubType:=UnmanagedType.U1, _
SizeConst:=netbstrcs.netresvLen)> Dim ncbReserve() As Byte
<MarshalAs(UnmanagedType.U4)> _
Public ncbEvent As Int32 'IntPtr
End Structure
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> _
Public Structure LANA_ENUM
<MarshalAs(UnmanagedType.U1)> _
Public Length As Byte
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=LANAenum.maxLANA + 1)> Dim LANA() As Byte
End Structure
'-----------------------------------------------------------
' The SessionHeader and SessionBUFFER structures are used
' to get the status of an active NetBIOS session
'-----------------------------------------------------------
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> _
Private Structure SessionBuffer
Public LSN As Byte
Public State As Byte
<MarshalAs(UnmanagedType.ByValArray, ArraySubType:=UnmanagedType.U1, _
SizeConst:=netbstrcs.netNameLen)> Dim LocalName() As Byte
<MarshalAs(UnmanagedType.ByValArray, ArraySubType:=UnmanagedType.U1, _
SizeConst:=netbstrcs.netNameLen)> Dim RemoteName() As Byte
Public ReceivesOutstanding As Byte
Public SendsOutstanding As Byte
End Structure
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> _
Private Structure SessionHeader
Public SessName As Byte
Public NumSess As Byte
Public RcvDgOutstanding As Byte
Public RcvAnyOutstanding As Byte
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=netbstrcs.netnumSess)> Dim LocStatData() As SessionBuffer
End Structure
'-----------------------------------------------------------
' Adapter Status Buffer
'-----------------------------------------------------------
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> _
Private Structure Name_Buffer
<MarshalAs(UnmanagedType.ByValArray, ArraySubType:=UnmanagedType.U1, _
SizeConst:=netbstrcs.netNameLen)> Dim LocalName() As Byte
Public name_num As Byte
Public name_flags As Byte
End Structure
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> _
Private Structure Adapter_Status
<MarshalAs(UnmanagedType.ByValArray, ArraySubType:=UnmanagedType.U1, _
SizeConst:=netbstrcs.netMAC)> Dim adapter_address() As Byte
Public rev_major As Byte
Public reserved0 As Byte
Public adapter_type As Byte
Public rev_minor As Byte
Public duration As Int16
Public frmr_recv As Int16
Public frmr_xmit As Int16
Public iframe_recv_err As Int16
Public xmit_aborts As Int16
Public xmit_success As Int32
Public recv_success As Int32
Public iframe_xmit_err As Int16
Public recv_buff_unavail As Int16
Public t1_timeouts As Int16
Public ti_timeouts As Int16
Public reserved1 As Int32
Public free_ncbs As Int16
Public max_cfg_ncbs As Int16
Public max_ncbs As Int16
Public xmit_buf_unavail As Int16
Public max_dgram_size As Int16
Public pending_sess As Int16
Public max_cfg_sess As Int16
Public max_sess As Int16
Public max_sess_pkt_size As Int16
Public name_count As Int16
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=netbstrcs.netnumNames)> Dim NameTable() As Name_Buffer
End Structure
'-----------------------------------------------------------
' Used to store data being Sent/Receive from NetBIOS call
'-----------------------------------------------------------
'<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> _
Private Structure DataBuffer
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=32000)> Dim ncbBufStat() As Byte
End Structure
'-----------------------------------------------------------
'Reference to NetBIOS function in Windows Network API DLL
'-----------------------------------------------------------
Private Declare Ansi Function NetBios Lib "netapi32.dll" _
Alias "Netbios" (ByRef pncb As NCB) As Byte
Private Declare Ansi Function NetApiBufferAllocate Lib "netapi32.dll" _
Alias "NetApiBufferAllocate" (ByVal bytecount As Long, ByRef buffer As ULong) As Long
Private Declare Ansi Function NetApiBufferFree Lib "netapi32.dll" _
Alias "NetApiBufferFree" (ByRef buffer As ULong) As Long
'-----------------------------------------------------------
' End declarations
'-----------------------------------------------------------
'-----------------------------------------------------------
' VERSION: 1.02
' DATE : 4/11/2012
'...........................................................
' DEFINITION/NOTES:
' Used to init an NCB structure.
'-----------------------------------------------------------
Public Sub InitNCB(ByRef pncb As NCB)
With pncb
.ncbCommand = 0
.ncbRetcode = 0
.ncbLSN = 0
.ncbNum = 0
.ncbBuffer = 0
.ncbLength = 0
ReDim .ncbCallname(netbstrcs.netNameLen - 1)
ReDim .ncbName(netbstrcs.netNameLen - 1)
.ncbRTO = 0
.ncbSTO = 0
.ncbPost = 0
.ncbLANAnum = 0
.ncbCmdCplt = 0
ReDim .ncbReserve(netbstrcs.netresvLen - 1)
.ncbEvent = 0
End With
End Sub
'-----------------------------------------------------------
' VERSION: 1.02
' DATE : 4/11/2012
'...........................................................
' DEFINITION/NOTES:
' Initializes the LANAS array.
'-----------------------------------------------------------
Public Sub InitLANA_ENUM(ByRef LANAS As LANA_ENUM)
Dim Cnt As Int16
'STARTS ----------------------------------------------------
LANAS.Length = 0
ReDim LANAS.LANA(LANAenum.maxLANA)
For Cnt = 0 To LANAenum.maxLANA
LANAS.LANA(Cnt) = 0
Next
End Sub
'-----------------------------------------------------------
' VERSION: 1.02
' DATE : 4/11/2012
'...........................................................
' DEFINITION/NOTES:
' Converts a VB string into a char array for the netbios
' calls. Uses a varient type on purpose that it assumes is
' an array of bytes starting at 0.
'-----------------------------------------------------------
Public Sub NB_PutString(ByVal InString As String, _
ByVal MoveBytes As Int16, _
ByRef OutString As Object)
Dim Cnt As Integer '[Counter for the array]
Dim wStr As String '[Temp string to store 1 char]
'STARTS ----------------------------------------------------
While Len(InString) < MoveBytes '[Add spaces to end +1]
InString = InString & Chr(32)
End While
If TypeOf (OutString) Is String Then
OutString = ""
End If
For Cnt = 1 To Len(InString) '[ Move into 0 pos array]
wStr = Left(InString, 1)
InString = Right(InString, Len(InString) - 1)
'OutString(Cnt - 1) = wStr
If TypeOf (OutString) Is String Then
OutString = ""
Else
OutString(Cnt - 1) = Asc(wStr)
End If
Next Cnt
End Sub
'-----------------------------------------------------------
' VERSION: 1.02
' DATE : 4/11/2012
'...........................................................
' DEFINITION/NOTES:
' Converts a char array into a VB string.
' Uses a varient type on purpose that it assumes is an
' array of bytes starting at 0.
'-----------------------------------------------------------
Public Sub NB_GetString(ByRef InString As Object, _
ByVal MoveBytes As Int16, _
ByRef OutString As String)
Dim Cnt As Int16 '[Counter for the array]
'STARTS -----------------------------------------------------
OutString = ""
For Cnt = 0 To MoveBytes - 1
OutString = OutString & Chr(InString(Cnt))
Next Cnt
End Sub
'-----------------------------------------------------------
' VERSION: 1.02
' DATE : 4/12/2012
'...........................................................
' DEFINITION/NOTES:
' Generates a list of the adapter/protocol numbers (lanas).
' This list is stored in public and should only have to
' be issued once when starting program. However, with
' Windows plug-n-play it is possible that the network
' configuration will change without a reboot.
'
' Used in conjunction with NB_Listen or NB_Call to make a
' slave PC connection.
'-----------------------------------------------------------
Public Function callNetBios(ByRef wNCB As NCB) As Byte
Dim RVal As Byte '[Stores status NetBIOS call]
'STARTS ----------------------------------------------------
RVal = NetBios(wNCB) '[Call Windows NET32 API]
callNetBios = RVal
End Function
'-----------------------------------------------------------
' VERSION: 1.02
' DATE : 4/11/2012
'...........................................................
' DEFINITION/NOTES:
' NetBIOS call to add a NetBIOS name to the adapter table.
' Client is the name to add and LanaNum identifies the
' network adapter.
'-----------------------------------------------------------
Public Function NB_AddName(ByVal Client As String, _
ByVal LanaNum As Byte) As Byte
Dim RVal As Byte '[Stores status NetBIOS call]
Dim wNCB As New NCB '[NCB record used by NetBIOS call]
'START -----------------------------------------------------
Call InitNCB(wNCB)
With wNCB
.ncbCommand = NCBADDNAME '[Wait for finish]
Call NB_PutString(Client, netbstrcs.netNameLen, .ncbName)
.ncbLANAnum = LanaNum
End With
If slvStubIO Then
If slvStubIOPrompt Then
RVal = InputBox("Enter NB_AddName return", , netbErrors.nrcGOODRET)
Else : RVal = netbErrors.nrcGOODRET
End If
Else : RVal = callNetBios(wNCB) '[Call Windows NET32 API]
End If
NB_AddName = RVal
End Function
'-----------------------------------------------------------
' VERSION: 1.01
' DATE : 4/11/2012
'...........................................................
' DEFINITION/NOTES:
' NetBIOS call to delete a NetBIOS name from the adapter
' table. Hang up any active sessions before making this
' call.
' Client is the name to add and LanaNum identifies the
' network adapter.
'-----------------------------------------------------------
Public Function NB_DeleteName(ByVal Client As String, _
ByVal LanaNum As Byte) As Byte
Dim RVal As Byte '[Stores status NetBIOS call]
Dim wNCB As New NCB '[NCB record used by NetBIOS call]
'START -----------------------------------------------------
Call InitNCB(wNCB)
With wNCB
.ncbCommand = NCBDELNAME '[Wait for finish]
Call NB_PutString(Client, netbstrcs.netNameLen, .ncbName)
.ncbLANAnum = LanaNum
End With
If slvStubIO Then
If slvStubIOPrompt Then
RVal = InputBox("Enter NB_DeleteName return", , netbErrors.nrcGOODRET)
Else : RVal = netbErrors.nrcGOODRET
End If
Else : RVal = callNetBios(wNCB) '[Call Windows NET32 API]
End If
NB_DeleteName = RVal
End Function
'-----------------------------------------------------------
' VERSION: 1.04
' DATE : 6/25/2012
'...........................................................
' DEFINITION/NOTES:
' NetBIOS call to get the status of an active session. Only
' excepts local names, not remote names. Use "*" for all
' local names.
'
' Client is name of this PC (session) to check
' LanaNum is lana to use.
' SessStat is the status return.
'-----------------------------------------------------------
Public Function NB_SessionStat(ByVal Client As String, _
ByVal LanaNum As Byte, _
ByVal LSN As Byte, _
ByRef SessStat As Byte, _
ByRef OpenRecv As Byte, _
ByRef OpenSend As Byte) As Byte
Dim Lcnt As Byte '[Counter to check for desired LSN]
Dim RVal As Byte '[Stores status NetBIOS call]
Dim wNCB As New NCB '[NCB record used by NetBIOS call]
Dim ptr As IntPtr '[temporary memory pointer]
Dim SSDBuffer As New SessionHeader '[Variable passed to NetBIOS]
'START -----------------------------------------------------
SessStat = 0
With SSDBuffer
ReDim .LocStatData(netbstrcs.netnumSess - 1)
For Lcnt = 0 To netbstrcs.netnumSess - 1
.LocStatData(Lcnt) = New SessionBuffer
ReDim .LocStatData(Lcnt).RemoteName(netbstrcs.netNameLen - 1)
ReDim .LocStatData(Lcnt).LocalName(netbstrcs.netNameLen - 1)
Next
End With
ptr = Marshal.AllocHGlobal(Marshal.SizeOf(SSDBuffer))
Marshal.StructureToPtr(SSDBuffer, ptr, False)
Call InitNCB(wNCB)
With wNCB
.ncbCommand = NCBSSTAT '[Wait for finish]
Call NB_PutString(Client, netbstrcs.netNameLen, .ncbName)
.ncbLANAnum = LanaNum
.ncbLength = CShort(Marshal.SizeOf(SSDBuffer))
.ncbBuffer = ptr
End With
If slvStubIO Then
SessStat = 3 '[Session okay & active]
If slvStubIOPrompt Then
RVal = InputBox("Enter NB_SessionStat return", _
, netbErrors.nrcGOODRET)
SessStat = InputBox("Enter NB_SessionStat SessStat value", _
, SessStat)
Else
RVal = netbErrors.nrcGOODRET
End If
Else
RVal = callNetBios(wNCB) '[Call Windows NET32 API]
If RVal = netbErrors.nrcGOODRET Then
SSDBuffer = CType(Marshal.PtrToStructure(ptr, GetType(SessionHeader)), SessionHeader)
For Lcnt = 1 To SSDBuffer.NumSess
If LSN = SSDBuffer.LocStatData(Lcnt - 1).LSN Then
SessStat = SSDBuffer.LocStatData(Lcnt - 1).State
OpenRecv = SSDBuffer.LocStatData(Lcnt - 1).ReceivesOutstanding
OpenSend = SSDBuffer.LocStatData(Lcnt - 1).SendsOutstanding
End If
Next Lcnt
End If
End If
Marshal.FreeHGlobal(ptr)
NB_SessionStat = RVal
End Function
'-----------------------------------------------------------
' VERSION: 1.00
' DATE : 6/20/2012
'...........................................................
' DEFINITION/NOTES:
' NetBIOS call to get the status of an adapter. Only
' excepts local names, not remote names. Use "*" for all
' local names.
'
' Client is name of this PC (session) to check
' LanaNum is lana to use.
' SessStat is the status return.
'-----------------------------------------------------------
Public Function NB_AdapterStat(ByVal Adapter As String, _
ByVal LanaNum As Byte) As Byte
Dim Lcnt As Byte '[Counter to check for desired LSN]
Dim Rval As Byte '[Stores status NetBIOS call]
Dim wNCB As New NCB '[NCB record used by NetBIOS call]
Dim ptr As IntPtr '[temporary memory pointer]
Dim AdapterBuffer As New Adapter_Status '[Variable passed to NetBIOS]
'START -----------------------------------------------------
With AdapterBuffer
ReDim .adapter_address(netbstrcs.netMAC - 1)
ReDim .NameTable(netbstrcs.netnumNames - 1)
For Lcnt = 0 To netbstrcs.netnumNames - 1
.NameTable(Lcnt) = New Name_Buffer
ReDim .NameTable(Lcnt).LocalName(netbstrcs.netNameLen - 1)
Next
End With
ptr = Marshal.AllocHGlobal(Marshal.SizeOf(AdapterBuffer))
Marshal.StructureToPtr(AdapterBuffer, ptr, False)
Call InitNCB(wNCB)
With wNCB
.ncbCommand = NCBASTAT '[Wait for finish]
Call NB_PutString(Adapter, netbstrcs.netNameLen, .ncbCallname)
.ncbLANAnum = LanaNum
.ncbLength = CShort(Marshal.SizeOf(AdapterBuffer))
.ncbBuffer = ptr
End With
If slvStubIO Then
If slvStubIOPrompt Then
Rval = InputBox("Enter NB_AdapterStat return", _
, netbErrors.nrcGOODRET)
Else
Rval = netbErrors.nrcGOODRET
End If
Else
Rval = callNetBios(wNCB) '[Call Windows NET32 API]
If Rval = netbErrors.nrcGOODRET Then
AdapterBuffer = CType(Marshal.PtrToStructure(ptr, GetType(Adapter_Status)), Adapter_Status)
End If
End If
Marshal.FreeHGlobal(ptr)
NB_AdapterStat = Rval
End Function
'-----------------------------------------------------------
' VERSION: 1.00
' DATE : 6/21/2012
'...........................................................
' DEFINITION/NOTES:
' Loops until session and/or adapters are ready.
'
' Client is the name of the calling PC (this pc).
' Server is the name of PC being called (the slave).
' LanaNum identifies the network adapter.
' LSN is the session to check.
' AdapterOnly is true if only checking the adapter
'
' NOTE: This code was written but never implemented. It
' was used to try and solve issue with Freescale
' Windows 2003 Server that appeared to have
' corrupted the network stack, where after initial
' session connection the 'A' from the controller
' was read in the NB_Receive call in this code, but
' NetBIOS API also returned error hex 40, which
' stands for 'Unusual Network Condition'. This code
' never reported an error or that it I/F was busy,
' so it was not used. However, if problem arises
' and it is used, it needs to be modified to only
' look for and perhaps wait for pending Recv or
' Sends - instead of waiting until none exist.
' Might be best to wait until other I/F has pending
' Send before issuing Recv - except I think this is
' supposed to be handled at API level (if not NICs).
'-----------------------------------------------------------
Public Function netLoopUntilReady(ByVal Client As String, _
ByVal Slave As String, _
ByVal LanaNum As Byte, _
ByVal LSN As Byte, _
ByVal AdapterOnly As Boolean) As Byte
Dim Rval As Byte '[Stores status NetBIOS call for local adapter]
Dim Rval2 As Byte '[Stores status NetBIOS call for slave adapter]
Dim Rval3 As Byte '[Stores status NetBIOS call for session]
Dim Wcnt As Long '[Number of loops to wait for counter]
Dim SessStat As Byte '[Status from session - 3 is Session established]
Dim OpenRecv As Byte '[Number of pending receives]
Dim OpenSend As Byte '[Number of pending sends]
Dim ExitLoop As Boolean
'STARTS ----------------------------------------------------
If slvStubIO Then
netLoopUntilReady = netbErrors.nrcGOODRET
Else
Wcnt = 0
Rval = netbErrors.nrcGOODRET
Rval2 = netbErrors.nrcGOODRET
Rval3 = netbErrors.nrcGOODRET
ExitLoop = False
Do
DoEvents()
Rval = NB_AdapterStat(Client, LanaNum)
Rval2 = NB_AdapterStat(Slave, LanaNum)
'[Allow to exit of okay or error not one being looped on]
ExitLoop = (Rval = netbErrors.nrcGOODRET) Or _
((Rval <> netbErrors.nrcSYSTEM) And (Rval <> netbErrors.nrcIFBUSY) And _
(Rval <> netbErrors.nrcTOOMANY))
If (Rval = netbErrors.nrcGOODRET) Then
ExitLoop = (Rval2 = netbErrors.nrcGOODRET) Or _
((Rval2 <> netbErrors.nrcSYSTEM) And (Rval2 <> netbErrors.nrcIFBUSY) And _
(Rval2 <> netbErrors.nrcTOOMANY))
End If
If (AdapterOnly = False) And (Rval = netbErrors.nrcGOODRET) And (Rval2 = netbErrors.nrcGOODRET) Then
Rval3 = NB_SessionStat(Client, LanaNum, LSN, SessStat, OpenRecv, OpenSend)
If (Rval3 = netbErrors.nrcGOODRET) Then
If (OpenRecv > 0) Or (OpenSend > 0) Or (SessStat = 0) Or (SessStat = 1) Or (SessStat = 2) Then
'[Wait until pending sends/receives done, or session established]
Call MsgBox("TPJ OpenR=" + CStr(OpenRecv) + " OpenS=" + CStr(OpenSend) + " SessS=" + CStr(SessStat))
ExitLoop = False
Else
ExitLoop = True
End If
ElseIf (Rval3 = netbErrors.nrcIFBUSY) Or (Rval3 = netbErrors.nrcSYSTEM) Or _
(Rval3 = netbErrors.nrcTOOMANY) Then
'[Wait for this error state to clear]
ExitLoop = False
Call MsgBox("TPJ In session handling error state Rval3=" + CStr(Rval3))
Else
'[Error state beyond waiting for correction]
ExitLoop = True
End If
End If
Wcnt = Wcnt + 1
If (Rval <> 0) Or (Rval2 <> 0) Then Call MsgBox("TPJ inLoop Rval=" + CStr(Rval) + " Rval2=" + CStr(Rval2))
Loop Until (ExitLoop = True) Or (Wcnt > 6)
If (Wcnt > 6) Then
Call MsgBox("tpj Wcnt=" + CStr(Wcnt))
End If
If (Rval = netbErrors.nrcGOODRET) Then Rval = Rval2
If (AdapterOnly = False) And (Rval = netbErrors.nrcGOODRET) Then Rval = Rval3
End If
If Rval <> 0 Then Call MsgBox("TPJ Loop Rval=" + CStr(Rval))
netLoopUntilReady = Rval
End Function
'-----------------------------------------------------------
' VERSION: 1.02
' DATE : 4/11/2012
'...........................................................
' DEFINITION/NOTES:
' NetBIOS call to call another PC for a session connection.
'
' wNCB is the network control block to use.
' Client is the name of the calling PC (this pc).
' Server is the name of PC being called (the slave).
' LanaNum identifies the network adapter.
' If a connection is made, Lsn holds the session number.
'
' This command also sets the timeouts for all send/receive
' commands that use this LSN.
'-----------------------------------------------------------
Public Function NB_Call(ByRef wNCB As NCB, _
ByVal Client As String, _
ByVal Server As String, _
ByVal LanaNum As Byte) As Byte
Dim RVal As Byte '[Stores status NetBIOS call]
'STARTS ----------------------------------------------------
Call InitNCB(wNCB)
With wNCB
.ncbCommand = NCBCALL
Call NB_PutString(Client, netbstrcs.netNameLen, .ncbName)
Call NB_PutString(Server, netbstrcs.netNameLen, .ncbCallname)
.ncbRTO = ncbRcvTimeOut
.ncbSTO = ncbSndTimeOut
.ncbLANAnum = LanaNum
End With
If slvStubIO Then
wNCB.ncbCmdCplt = netbErrors.nrcGOODRET
wNCB.ncbLSN = 1
If slvStubIOPrompt Then
RVal = InputBox("Enter NB_Call return", , netbErrors.nrcGOODRET)
wNCB.ncbCmdCplt = RVal
wNCB.ncbLSN = InputBox("Enter NB_Call LSN value", , 1)
Else : RVal = netbErrors.nrcGOODRET
End If
Else : RVal = callNetBios(wNCB) '[Call Windows NET32 API]
End If
NB_Call = RVal
End Function
'-----------------------------------------------------------
' VERSION: 1.02
' DATE : 4/11/2012
'...........................................................
' DEFINITION/NOTES:
' Resets the adapter/protocol based upon the LanaNum passed
' in. LanaNum identifies the network adapter.
'
'-----------------------------------------------------------
Public Function NB_Reset(ByVal LanaNum As Byte) As Byte
Dim RVal As Byte '[Stores status NetBIOS call]
Dim wNCB As New NCB '[NCB record used by NetBIOS call]
'STARTS ----------------------------------------------------
Call InitNCB(wNCB)
With wNCB
.ncbCommand = NCBRESET
.ncbLSN = 0
.ncbLANAnum = LanaNum
.ncbCallname(0) = 254 '[Set maximum NetBIOS sessions]
.ncbCallname(2) = 254 '[Set maximum NetBIOS table names]
.ncbCallname(3) = 0 '[Use any name for commands]
End With
If slvStubIO Then
If slvStubIOPrompt Then
RVal = InputBox("Enter NB_Reset return", , netbErrors.nrcGOODRET)
Else : RVal = netbErrors.nrcGOODRET
End If
Else : RVal = callNetBios(wNCB) '[Call Windows NET32 API]
End If
NB_Reset = RVal
End Function
'-----------------------------------------------------------
' VERSION: 1.02
' DATE : 4/12/2012
'...........................................................
' DEFINITION/NOTES:
' Generates a list of the adapter/protocol numbers (lanas).
' This list is stored in public and should only have to
' be issued once when starting program. However, with
' Windows plug-n-play it is possible that the network
' configuration will change without a reboot.
'
' Used in conjunction with NB_Listen or NB_Call to make a
' slave PC connection.
'-----------------------------------------------------------
Public Function NB_EnumLanas(ByRef LANAS As LANA_ENUM) As Byte
Dim RVal As Byte '[Stores status NetBIOS call]
Dim wNCB As New NCB '[NCB record used by NetBIOS call]
Dim ptr As IntPtr '[temporary memory pointer]
'STARTS ----------------------------------------------------
Call InitNCB(wNCB)
Call InitLANA_ENUM(LANAS)
ptr = Marshal.AllocHGlobal(Marshal.SizeOf(LANAS))
Marshal.StructureToPtr(LANAS, ptr, True)
With wNCB
.ncbCommand = NCBENUM
.ncbLength = CShort(Marshal.SizeOf(LANAS))
.ncbBuffer = ptr '[Set global far ptr to Lanas]
End With
If slvStubIO Then
If slvStubIOPrompt Then
RVal = InputBox("Enter NB_EnumLanas return", , netbErrors.nrcGOODRET)
Else : RVal = netbErrors.nrcGOODRET
End If
LANAS.Length = 1 '[Setup a lana for "network" control]
LANAS.LANA(0) = 1
Else
RVal = callNetBios(wNCB) '[Call Windows NET32 API]
LANAS = CType(Marshal.PtrToStructure(ptr, GetType(LANA_ENUM)), LANA_ENUM)
End If
Marshal.FreeHGlobal(ptr)
wNCB = Nothing
NB_EnumLanas = RVal
End Function
'-----------------------------------------------------------
' VERSION: 1.02
' DATE : 4/11/2012
'...........................................................
' DEFINITION/NOTES:
' Listens on a given LanaNum for a connection.
'
' wNCB identifies the NCB to use for the command.
' LanaNum identifies the network adapter/protocol.
' Client identifies the name of the PC calling (slave).
' Server identifies the name of the PC listening (this PC).
' Wait indicates whether or not to wait for NetBIOS call
' to finish.
'
' Expects the calling routine to obtain the LSN and
' evaluate the wNCB contents for success.
' This command also sets the timeouts for all send/receive
' commands that use this LSN.
'-----------------------------------------------------------
Public Function NB_Listen(ByRef wNCB As NCB, _
ByVal LanaNum As Byte, _
ByVal Server As String, _
ByVal Client As String, _
ByVal Wait As Boolean) As Byte
Dim RVal As Byte '[Stores status NetBIOS call]
'STARTS ----------------------------------------------------
Call InitNCB(wNCB)
With wNCB
If Wait Then
.ncbCommand = NCBLISTEN
Else : .ncbCommand = NCBLISTEN + NCBNOWAIT
End If
.ncbLANAnum = LanaNum
Call NB_PutString(Server, netbstrcs.netNameLen, .ncbName)
Call NB_PutString(Client, netbstrcs.netNameLen, .ncbCallname)
.ncbRTO = ncbRcvTimeOut
.ncbSTO = ncbSndTimeOut
End With
If slvStubIO Then
If slvStubIOPrompt Then
RVal = InputBox("Enter NB_Listen return", , netbErrors.nrcGOODRET)
Else : RVal = netbErrors.nrcGOODRET
End If
Else : RVal = callNetBios(wNCB) '[Call Windows NET32 API]
End If
NB_Listen = RVal
End Function
'-----------------------------------------------------------
' VERSION: 1.02
' DATE : 4/18/2012
'...........................................................
' DEFINITION/NOTES:
' Sends a buffer of data based upon the LSN and LanaNum
' passed in. Unlike a receive command, a failed send
' command cause the session to be dropped, thus it has a
' longer time-out and no loop support.
'
' wNCB identifies the NCB to use for the command.
' LanaNum identifies the network adapter/protocol.
' LSN identifies the session to use.
' BufferSize contains the number of bytes to send.
' Buffer contains the data to be sent.
'
' Because VB variable pointer limitations, this routine
' must wait for the send to occur. See the notes at the
' top of this file for details.
'-----------------------------------------------------------
Public Function NB_Send(ByVal LanaNum As Byte, _
ByVal LSN As Byte, _
ByRef BufferSize As Int16, _
ByVal Buffer As String) As Byte
Dim RVal As Byte '[Stores status NetBIOS call]
Dim wNCB As New NCB '[NCB record used by NetBIOS call]
Dim ptr As IntPtr '[temporary memory pointer]
Dim wBuffer As New DataBuffer '[Structure for buffer]
'STARTS ----------------------------------------------------
Call InitNCB(wNCB)
ReDim wBuffer.ncbBufStat(netbstrcs.netbuffer - 1)
Call NB_PutString(Buffer, BufferSize, wBuffer.ncbBufStat)
ptr = Marshal.AllocHGlobal(Marshal.SizeOf(wBuffer))
Marshal.StructureToPtr(wBuffer, ptr, False)
With wNCB
.ncbCommand = NCBSEND '[Always wait with this command]
.ncbLANAnum = LanaNum
.ncbLSN = LSN
.ncbBuffer = ptr
.ncbLength = BufferSize '[Length to send, not entire buffer]
End With
If slvStubIO Then
If slvStubIOPrompt Then
RVal = InputBox("Enter NB_Send return", , netbErrors.nrcGOODRET)
Else : RVal = netbErrors.nrcGOODRET
End If
NB_Send = RVal
Else
RVal = callNetBios(wNCB)
BufferSize = wNCB.ncbLength '[Return number of bytes sent]
NB_Send = wNCB.ncbCmdCplt '[Return final command code]
End If
Marshal.FreeHGlobal(ptr)
End Function
'-----------------------------------------------------------
' VERSION: 1.02
' DATE : 4/11/2012
'...........................................................
' DEFINITION/NOTES:
' Receives a buffer of data based upon the LSN and LanaNum
' passed in.
'
' LanaNum identifies the network adapter/protocol.
' LSN identifies the session to use.
' BufferSize contains max. number of bytes to be received.
' Buffer is String where the received data is to be placed.
'
' Because VB variable pointer limitations, this routine
' must wait for the receive to occur.
'-----------------------------------------------------------
Public Function NB_Receive(ByVal LanaNum As Byte, _
ByVal LSN As Byte, _
ByRef BufferSize As Int16, _
ByRef Buffer As String) As Byte
Dim RVal As Byte '[Stores status NetBIOS call]
Dim wNCB As New NCB '[NCB record used by NetBIOS call]
Dim ptr As IntPtr '[temporary memory pointer]
Dim wBuffer As New DataBuffer '[Structure for buffer]
'STARTS ----------------------------------------------------
ReDim wBuffer.ncbBufStat(netbstrcs.netbuffer - 1)
ptr = Marshal.AllocHGlobal(Marshal.SizeOf(wBuffer))
Marshal.StructureToPtr(wBuffer, ptr, False)
Call InitNCB(wNCB)
With wNCB
.ncbCommand = NCBRECV '[Always wait for this command]
.ncbLANAnum = LanaNum
.ncbLSN = LSN
.ncbBuffer = ptr
.ncbLength = BufferSize
End With
If slvStubIO Then
Buffer = StrDup(BufferSize, "A") '[Always A for Ack stub calls]
If slvStubIOPrompt Then
RVal = InputBox("Enter NB_Receive return", , netbErrors.nrcGOODRET)
Buffer = InputBox("Enter NB_Receive Buffer value", , Buffer)
Else : RVal = netbErrors.nrcGOODRET
End If
BufferSize = Len(Buffer)
NB_Receive = RVal '[Return final status of command]
Else
Buffer = ""
BufferSize = 0
RVal = callNetBios(wNCB)
If (RVal = netbErrors.nrcGOODRET) Or _
(RVal = netbErrors.nrcINCOMP) Then
BufferSize = wNCB.ncbLength
wBuffer = CType(Marshal.PtrToStructure(ptr, GetType(DataBuffer)), DataBuffer)
Call NB_GetString(wBuffer.ncbBufStat, BufferSize, Buffer)
End If
NB_Receive = wNCB.ncbCmdCplt '[Return final status of command]
End If
Marshal.FreeHGlobal(ptr)
End Function
'-----------------------------------------------------------
' VERSION: 1.02
' DATE : 4/11/2012
'...........................................................
' DEFINITION/NOTES:
' Cancels any outstanding NetBIOS command. Check the
' NetBIOS documentation for commands that can be canceled.
'
' cNCB is the NCB of the command to be canceled.
' LanaNum identifies the adapter/protocol to use.
'
' WARNING: Cancelling a Send command causes the session
' to be dropped.
'-----------------------------------------------------------
Public Function NB_Cancel(ByRef cNCB As NCB, _
ByVal LanaNum As Byte) As Byte
Dim RVal As Byte '[Stores status NetBIOS call]
Dim wNCB As New NCB '[NCB record used by NetBIOS call]
Dim ptr As IntPtr '[temporary memory pointer]
'STARTS ----------------------------------------------------
ptr = Marshal.AllocHGlobal(Marshal.SizeOf(cNCB))
Marshal.StructureToPtr(cNCB, ptr, False)
Call InitNCB(wNCB)
With wNCB
.ncbCommand = NCBCANCEL
.ncbLANAnum = LanaNum
.ncbBuffer = ptr '[Set ptr to cNCB]
End With
If slvStubIO Then
If slvStubIOPrompt Then
RVal = InputBox("Enter NB_Cancel return", , netbErrors.nrcGOODRET)
Else : RVal = netbErrors.nrcGOODRET
End If
Else : RVal = callNetBios(wNCB) '[Call Windows NET32 API]
End If
NB_Cancel = RVal
Marshal.FreeHGlobal(ptr)
End Function
'-----------------------------------------------------------
' VERSION: 1.02
' DATE : 4/11/2012
'...........................................................
' DEFINITION/NOTES:
' Hangs up an existing session.
'
' LSN Identifies the session to close.
' LanaNum identifies the adapter/protocol to use.
'
'-----------------------------------------------------------
Public Function NB_HangUp(ByRef LSN As Byte, _
ByVal LanaNum As Byte) As Byte
Dim RVal As Byte '[Stores status NetBIOS call]
Dim wNCB As New NCB '[NCB record used by NetBIOS call]
'STARTS ----------------------------------------------------
Call InitNCB(wNCB)
With wNCB
.ncbCommand = NCBHANGUP
.ncbLANAnum = LanaNum
.ncbLSN = LSN
End With
If slvStubIO Then
If slvStubIOPrompt Then
RVal = InputBox("Enter NB_HangUp return", , netbErrors.nrcGOODRET)
Else : RVal = netbErrors.nrcGOODRET
End If
Else : RVal = callNetBios(wNCB) '[Call Windows NET32 API]
End If
LSN = 0
Call Netio.Fire_onCheckConnect()
NB_HangUp = RVal
End Function
End Module