问题:
1、我使用API函数NetMessageBufferSend Lib _
        "NETAPI32.DLL" _
            (Server As Any, _
             yToName As Byte, _
             yFromName As Any, _
             yMsg As Byte, _
             ByVal lSize As Long) As Long来实现类似winPopup功能,这个方法在win2000或winXP等操作系统上没问题,但在win9x平台上就出错,如何解决呢?
2、如何通过代码获取网上邻居中的计算机名称?

解决方案 »

  1.   

    第一个问题:msdn中说         Windows 95/98: Unsupported. 也就不支持该函数!
    第二个问题:一老外写的form的
    Option ExplicitPrivate NetRoot As NetResource
    Private Sub NodeExpand(Node As MSComctlLib.Node)
    ' Distinguish between expansion of a network object or a file system folder as seen over the networkDim FSO As Scripting.FileSystemObject
    Dim NWFolder As Scripting.Folder
    Dim FilX As Scripting.File, DirX As Scripting.Folder
    Dim tNod As Node, isFSFolder As Boolean' Remove the fake node used to force the treeview to show the "+" icon
    tvwNetwork.Nodes.Remove Node.Key + "_FAKE"' If this node is ed as a share is it a proper networked directory?
    ' need to make this check since NDS s some containers (wrongly, in my opinion) as shares when they're not applicable to
    ' file system directories (i.e. the two containers deing NDS and Novell FileServers are ed as shares)
    If Node.SelectedImage = "share" Then
        On Error Resume Next
        Set FSO = New FileSystemObject
        Set NWFolder = FSO.GetFolder(Node.Key)
        If Err <> 0 Then isFSFolder = False Else isFSFolder = True
        On Error GoTo 0
    End IfIf Node.SelectedImage = "folder" Or (Node.SelectedImage = "share" And isFSFolder = True) Then
        ' This node is a filesystem folder seen via a network UNC path
        ' Use FileSystemObjects to get files and directories since network objects (generally) can't see these
        '
        Set FSO = New Scripting.FileSystemObject
        Set NWFolder = FSO.GetFolder(Node.Key)  ' The node's key holds the UNC path to the directory
        ' Enumerate the files in this folder
        ' To save any more confusion I'm not querying the system to get an icon for each file and executable
        ' If there's a demand I'll do a modified version, but for the moment I'm just using a generic file icon
        For Each FilX In NWFolder.Files
            tvwNetwork.Nodes.Add Node.Key, tvwChild, Node.Key + "\" + FilX.Name, FilX.Name, "file", "file"
        Next
        ' Enumerate the folders
        For Each DirX In NWFolder.SubFolders
            Set tNod = tvwNetwork.Nodes.Add(Node.Key, tvwChild, Node.Key + "\" + DirX.Name, DirX.Name, "folder", "folder")
            tvwNetwork.Nodes.Add tNod.Key, tvwChild, tNod.Key + "_FAKE", "FAKE", "folder", "folder"
            tNod.Tag = "N"
        Next
        Node.Tag = "Y"
    Else
        ' Search up through the tree, noting the node keys so that we can then locate the NetResource object
        ' under NetRoot.
        Dim pS As String, kPath() As String, nX As NetResource, i As Integer, tX As NetResource
        Set tNod = Node ' Start at the node that was expanded
        Do While Not tNod.Parent Is Nothing ' Proceed up the tree using parent references, each time saving the node key to the string pS
            pS = tNod.Key + "|" + pS
            Set tNod = tNod.Parent
        Loop
        ' String pS is now of the form "<Node Key>|<Node Key>|<Node Key>"
        ' Split this into an array using the VB6 Split function
        kPath = Split(pS, "|")
        Set nX = NetRoot
        ' Now loop through this array, this time following down the tree of NetResource objects from NetRoot to the child NetResource object that corresponds to
        ' the node the user clicked
        For i = 0 To UBound(kPath) - 1
            Set nX = nX.Children(kPath(i))
        Next
        ' Now that we know both the node and the corresponding NetResource we can enumerate the children and add the nodes
        For Each tX In nX.Children
            Set tNod = tvwNetwork.Nodes.Add(nX.RemoteName, tvwChild, tX.RemoteName, tX.ShortName, LCase(tX.ResourceTypeName), LCase(tX.ResourceTypeName))
            tNod.Tag = "N"
            ' Add fake nodes to all new nodes except when they're printers (you can always be sure a printer never has children)
            If tX.ResourceType <> Printer Then tvwNetwork.Nodes.Add tX.RemoteName, tvwChild, tX.RemoteName + "_FAKE", "FAKE", "server", "server"
        Next
        tvwNetwork.Refresh  ' Refresh the view
        Node.Tag = "Y"  ' Set the tag to "Y" to denote that this node has been expanded and populated
    End IfEnd Sub
    Private Sub Form_Load()
    ' Centre the form on the screen
    Me.Top = (Screen.Height - Me.Height) / 2
    Me.Left = (Screen.Width - Me.Width) / 2Dim nX As NetResource, nodX As Node
    tvwNetwork.ImageList = imlNWImages
    Set NetRoot = New NetResource   ' Create a new NetResource object. By default it will be the network root
    Set nodX = tvwNetwork.Nodes.Add(, , "_ROOT", "Entire Network", "root", "root")  ' Add a node into the tree for it
    nodX.Tag = "Y"  ' Set populated flag to "Y" since we populate this one immediately
    ' Populate the top level of objects under "Entire Network"
    For Each nX In NetRoot.Children
        Set nodX = tvwNetwork.Nodes.Add("_ROOT", tvwChild, nX.RemoteName, nX.ShortName, LCase(nX.ResourceTypeName), LCase(nX.ResourceTypeName))
        nodX.Tag = "N"  ' We haven't populated the nodes underneath this one yet, so set its flag to "N"
        tvwNetwork.Nodes.Add nodX.Key, tvwChild, nodX.Key + "_FAKE", "FAKE", "server", "server" ' Create a fake node under it so that the treeview gives the "+" symbol
        nodX.EnsureVisible
    Next
    ' You can't get printers at this level, so there's no point in enumerating the NWPrinters collections yet
    End SubPrivate Sub Form_Resize()
    tvwNetwork.Width = Me.ScaleWidth
    tvwNetwork.Height = Me.ScaleHeight
    End Sub
    Private Sub tvwNetwork_Expand(ByVal Node As MSComctlLib.Node)
    If Node.Tag = "N" Then
        NodeExpand Node
    End If
    End Sub
      

  2.   

    Public Enum NetResourceTypes    ' Enum of possible types of NetResource
        Generic = 0
        Domain = 1
        Server = 2
        share = 3
        File = 4
        Group = 5
        Network = 6
        Root = 7
        ShareAdmin = 8
        Directory = 9
        Tree = 10
        NDSContainer = 11
        Printer = &HFF
    End EnumPrivate mvNetRes As NETRES2
    Private mvGotChildren As Boolean
    Private mvChildren As NetResources  ' Collection of child containers and disk objects (what you usually get in the Network Neighborhood tree)
    Private mvAmRoot As Boolean
    Private mvAmPrinter As BooleanPrivate Declare Function GlobalAlloc Lib "KERNEL32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    Private Declare Function GlobalFree Lib "KERNEL32" (ByVal hMem As Long) As Long
    Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
    Private Declare Function lstrcpyA Lib "KERNEL32" Alias "lstrcpy" (ByVal NewString As String, ByVal OldString As Long) As Long
    Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As Any, lphEnum As Long) As Long
    Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, ByVal lpBuffer As Long, ByRef lpBufferSize As Long) As Long
    Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As LongPrivate Type sNETRESOURCE ' API compatible NETRESOURCE structure
        dwScope As Long       ' All members expressed as Long pointers
        dwType As Long
        dwDisplayType As Long
        dwUsage As Long
        lpLocalName As Long
        lpRemoteName As Long
        lpComment As Long
        lpProvider As Long
    End Type
       
    Private Type NETRES2 ' VB compatible NETRESOURCE structure
        dwScope As Long  ' Members mapped back to VB datatypes
        dwType As Long
        dwDisplayType As Long
        dwUsage As Long
        lpLocalName As String
        lpRemoteName As String
        lpComment As String
        lpProvider As String
    End TypePrivate Const RESOURCE_CONNECTED = &H1
    Private Const RESOURCE_GLOBALNET = &H2
    Private Const RESOURCE_REMEMBERED = &H3
    Private Const RESOURCE_CONTEXT = &H5Private Const RESOURCETYPE_ANY = &H0
    Private Const RESOURCETYPE_DISK = &H1
    Private Const RESOURCETYPE_PRINT = &H2
    Private Const RESOURCETYPE_UNKNOWN = &HFFFFPrivate Const RESOURCEUSAGE_CONNECTABLE = &H1
    Private Const RESOURCEUSAGE_CONTAINER = &H2
    Private Const RESOURCEUSAGE_RESERVED = &H80000000Private Const GMEM_DDESHARE = &H2000
    Private Const GMEM_DISCARDABLE = &H100
    Private Const GMEM_DISCARDED = &H4000
    Private Const GMEM_FIXED = &H0
    Private Const GMEM_INVALID_HANDLE = &H8000
    Private Const GMEM_LOCKCOUNT = &HFF
    Private Const GMEM_MODIFY = &H80
    Private Const GMEM_MOVEABLE = &H2
    Private Const GMEM_NOCOMPACT = &H10
    Private Const GMEM_NODISCARD = &H20
    Private Const GMEM_NOT_BANKED = &H1000
    Private Const GMEM_NOTIFY = &H4000
    Private Const GMEM_SHARE = &H2000
    Private Const GMEM_VALID_FLAGS = &H7F72
    Private Const GMEM_ZEROINIT = &H40
    Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)Private Const ERROR_MORE_DATA = 234Private Const RESOURCEDISPLAYTYPE_GENERIC = 0
    Private Const RESOURCEDISPLAYTYPE_DOMAIN = 1
    Private Const RESOURCEDISPLAYTYPE_SERVER = 2
    Private Const RESOURCEDISPLAYTYPE_SHARE = 3
    Private Const RESOURCEDISPLAYTYPE_FILE = 4
    Private Const RESOURCEDISPLAYTYPE_GROUP = 5
    Private Const RESOURCEDISPLAYTYPE_NETWORK = 6
    Private Const RESOURCEDISPLAYTYPE_ROOT = 7
    Private Const RESOURCEDISPLAYTYPE_SHAREADMIN = 8
    Private Const RESOURCEDISPLAYTYPE_DIRECTORY = 9
    Private Const RESOURCEDISPLAYTYPE_TREE = &HA
    Private Const RESOURCEDISPLAYTYPE_NDSCONTAINER = &HBPrivate Sub GetPrinters()
    ' API wrangling...
    ' Basically the same routine as GetChildren but tweaked to only return printer objects
    ' It also discards all non-share objects since we only want printers for this enumeration' Initialise my collection and variables
    Dim hEnum As Long, lpBuff As Long
    Dim cbBuff As Long, cCount As Long
    Dim p As Long, res As Long, i As Long
    Dim EnumHTemp As Long
    Dim reqBufferSize As Long
    Dim nR As sNETRESOURCE  ' API friendly structure
    Dim tempRes As NETRES2  ' VB friendly structure
    Dim tChild As NetResource' If this object is the Network root then we need to make a slight adjustment to the starting values
    ' of our API friendly NETRESOURCE structure
    If mvAmRoot Then
        nR.dwUsage = RESOURCEUSAGE_CONNECTABLE
        nR.lpRemoteName = 0
    End If' Open a net enumeration
    ' Limit enumeration to connectable print resources (i.e. printer objects)
    res = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_PRINT, RESOURCEUSAGE_CONNECTABLE, mvNetRes, hEnum)' Check for errors
    If res <> 0 Then
        ' Error returned when trying to open the enumeration
        ' Probably means we don't have access to see its children.
        ' See the MSDN for more details on possible errors.
        ' Currently no trapping is done here and the routine just exits with an empty children collection
        Exit Sub
    End If' Now begin to enumerate the collection
    EnumHTemp = hEnum
    ' Allocate a default buffer for the NETRESOURCE structure returned from the enum routine, say 1K
    cbBuff = 1024&
    lpBuff = GlobalAlloc(GPTR, cbBuff)
    Do
        EnumHTemp = hEnum
        cCount = &HFFFFFFFF ' Number of entries to return from enumeration - &HFFFFFFFF causes all objects to be returned
        res = WNetEnumResource(hEnum, cCount, lpBuff, cbBuff)
        If res = ERROR_MORE_DATA Then
            ' The enumeration has reported that the lpBuff is not big enough to hold all of the information in the
            ' NETRESOURCE structure. cbBuff has been updated to hold the required amount of space.
            GlobalFree lpBuff   ' Free the memory we're using for the current small buffer
            lpBuff = GlobalAlloc(GPTR, cbBuff)  ' Allocate a new space of the size requested by the enumeration
        Else
            If res = 0 Then     ' No error
                p = lpBuff
                ' cCount holds the number of NETRESOURCE structures returned in this pass
                ' (The enumeration returns as many as will fit into the buffer)
                For i = 1 To cCount ' Loop through the buffer, tackling each structure in turn
                    CopyMemory nR, ByVal p, LenB(nR)    ' Copy the block of memory representing the structure into a local API friendly NETRESOURCE structure
                    p = p + LenB(nR)    ' Step forward in the buffer by the length of the copied structure
                    If nR.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE Then
                        tempRes.dwDisplayType = nR.dwDisplayType
                        tempRes.dwScope = nR.dwScope
                        tempRes.dwType = nR.dwType
                        tempRes.dwUsage = nR.dwUsage
                        tempRes.lpComment = lStrCpy(nR.lpComment)
                        tempRes.lpLocalName = lStrCpy(nR.lpLocalName)
                        tempRes.lpProvider = lStrCpy(nR.lpProvider)
                        tempRes.lpRemoteName = lStrCpy(nR.lpRemoteName)
                        Set tChild = New NetResource
                        tChild.NRStruct = tempRes
                        tChild.IsPrinter = True ' I know this is a bit of a fudge, but I didn't think it worth the effort to write polymorphic classes for such a small matter
                        mvChildren.Add tChild
                    End If
                Next
            End If
        End If
    Loop Until cCount = 0
    ' Close the enum
    WNetCloseEnum hEnum
    ' Free the memory
    GlobalFree lpBuffEnd Sub
      

  3.   


    Friend Property Let IsPrinter(pVal As Boolean)
    mvAmPrinter = pVal
    End PropertyPrivate Function lStrCpy(lStrPointer As Long) As String
    Dim TString As String
    TString = String(255, Chr$(0))
    lstrcpyA TString, lStrPointer
    lStrCpy = Left(TString, InStr(TString, Chr$(0)) - 1)
    End FunctionPublic Property Get Children() As NetResources
    If Not mvGotChildren Then GetChildren
    Set Children = mvChildren
    End PropertyPublic Property Get Comment() As String
    Comment = mvNetRes.lpComment
    End PropertyPrivate Sub GetChildren()
    ' API wrangling...' Initialise my collection and variables
    Set mvChildren = New NetResources
    Dim hEnum As Long, lpBuff As Long
    Dim cbBuff As Long, cCount As Long
    Dim p As Long, res As Long, i As Long
    Dim EnumHTemp As Long
    Dim reqBufferSize As Long
    Dim nR As sNETRESOURCE  ' API friendly structure
    Dim tempRes As NETRES2  ' VB friendly structure
    Dim tChild As NetResource' If this object is the Network root then we need to make a slight adjustment to the starting values
    ' of our API friendly NETRESOURCE structure
    If mvAmRoot Then
        nR.dwUsage = RESOURCEUSAGE_CONNECTABLE
        nR.lpRemoteName = 0
    End If' Open a net enumeration
    res = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0, mvNetRes, hEnum)' Check for errors
    If res <> 0 Then
        ' Error returned when trying to open the enumeration
        ' Probably means we don't have access to see its children.
        ' See the MSDN for more details on possible errors.
        ' Currently no trapping is done here and the routine just exits with an empty children collection
        Exit Sub
    End If' Now begin to enumerate the collection
    EnumHTemp = hEnum
    ' Allocate a default buffer for the NETRESOURCE structure returned from the enum routine, say 1K
    cbBuff = 1024&
    lpBuff = GlobalAlloc(GPTR, cbBuff)
    Do
        EnumHTemp = hEnum
        cCount = &HFFFFFFFF ' Number of entries to return from enumeration - &HFFFFFFFF causes all objects to be returned
        res = WNetEnumResource(hEnum, cCount, lpBuff, cbBuff)
        If res = ERROR_MORE_DATA Then
            ' The enumeration has reported that the lpBuff is not big enough to hold all of the information in the
            ' NETRESOURCE structure. cbBuff has been updated to hold the required amount of space.
            GlobalFree lpBuff   ' Free the memory we're using for the current small buffer
            lpBuff = GlobalAlloc(GPTR, cbBuff)  ' Allocate a new space of the size requested by the enumeration
        Else
            If res = 0 Then     ' No error
                p = lpBuff
                ' cCount holds the number of NETRESOURCE structures returned in this pass
                ' (The enumeration returns as many as will fit into the buffer)
                For i = 1 To cCount ' Loop through the buffer, tackling each structure in turn
                    CopyMemory nR, ByVal p, LenB(nR)    ' Copy the block of memory representing the structure into a local API friendly NETRESOURCE structure
                    p = p + LenB(nR)    ' Step forward in the buffer by the length of the copied structure
                    tempRes.dwDisplayType = nR.dwDisplayType    ' Begin copying the members of the API friendly structure to the VB friendly structure
                    tempRes.dwScope = nR.dwScope
                    tempRes.dwType = nR.dwType
                    tempRes.dwUsage = nR.dwUsage
                    tempRes.lpComment = lStrCpy(nR.lpComment)   ' String copies accomplished by using the lStrCpy routine
                    tempRes.lpLocalName = lStrCpy(nR.lpLocalName)
                    tempRes.lpProvider = lStrCpy(nR.lpProvider)
                    tempRes.lpRemoteName = lStrCpy(nR.lpRemoteName)
                    Set tChild = New NetResource    ' Create the new NetResource object that will be the new child
                    tChild.NRStruct = tempRes   ' Pass the current VB friendly NETRESOURCE structure to tbe force populate method of the NetResource object
                    mvChildren.Add tChild   ' Add the new object to my children collection
                Next
            End If
        End If
    Loop Until cCount = 0
    ' Close the enum
    WNetCloseEnum hEnum
    ' Free the memory
    GlobalFree lpBuff' In order to distinguish printers from other shares we need to enumerate them separately
    GetPrintersmvGotChildren = TrueEnd SubPublic Property Get LocalName() As String
    LocalName = mvNetRes.lpLocalNameEnd Property
    Friend Property Let NRStruct(RHS As NETRES2)
    ' Private force populate routine
    ' When a NetResource object it defaults to being the network root object
    ' The only way to change this is to call this routine and pass a VB friendly NETRES2 NETRESOURCE structure
    ' When this function is called correctly it populates the data for this NetResource and forces it to act as a child rather than
    ' a network root.
    ' When compiled as a COM DLL this function will not be visible to the user - it's intended for internal use only
    mvNetRes = RHS
    mvAmRoot = False
    End PropertyPublic Property Get Provider() As String
    Provider = mvNetRes.lpProvider
    End PropertyPublic Property Get RemoteName() As String
    RemoteName = mvNetRes.lpRemoteName
    End Property
    Public Property Get ResourceType() As NetResourceTypes
    If Not mvAmPrinter Then ResourceType = mvNetRes.dwDisplayType Else ResourceType = PrinterEnd PropertyPublic Property Get ResourceTypeName() As String
    ' Provides a friendly name for the resource type as an alternative to using the enumerated "ResourceType" property
    ' This can be used to quicky bind NetResource objects to named images in an imagelist control (for example)
    If mvAmPrinter Then
        ResourceTypeName = "Printer"
        Exit Property
    End If
    Select Case mvNetRes.dwDisplayType
        Case RESOURCEDISPLAYTYPE_GENERIC
            ResourceTypeName = "Generic"
        Case RESOURCEDISPLAYTYPE_DOMAIN
            ResourceTypeName = "Domain"
        Case RESOURCEDISPLAYTYPE_SERVER
            ResourceTypeName = "Server"
        Case RESOURCEDISPLAYTYPE_SHARE
            ResourceTypeName = "Share"
        Case RESOURCEDISPLAYTYPE_FILE
            ResourceTypeName = "File"
        Case RESOURCEDISPLAYTYPE_GROUP
            ResourceTypeName = "Group"
        Case RESOURCEDISPLAYTYPE_NETWORK
            ResourceTypeName = "Network"
        Case RESOURCEDISPLAYTYPE_ROOT
            ResourceTypeName = "Root"
        Case RESOURCEDISPLAYTYPE_SHAREADMIN
            ResourceTypeName = "AdminShare"
        Case RESOURCEDISPLAYTYPE_DIRECTORY
            ResourceTypeName = "Directory"
        Case RESOURCEDISPLAYTYPE_TREE
            ResourceTypeName = "Tree"
        Case RESOURCEDISPLAYTYPE_NDSCONTAINER
            ResourceTypeName = "NDSContainer"
    End Select
    End PropertyPublic Property Get ShortName() As String
    ' Return just the final part of the object's name (rather than a fully qualified path or context)
    Dim i As Integer
    i = InStrRev(mvNetRes.lpRemoteName, "\")
    ShortName = Right(mvNetRes.lpRemoteName, Len(mvNetRes.lpRemoteName) - i)
    End Property
    Private Sub Class_Initialize()
    mvAmRoot = True
    End Sub
    Private Sub Class_Terminate()
    Set mvChildren = Nothing
    End Sub
    '上面这段是class NetResource
      

  4.   

    下面是class NetResources的
    Option Explicit'local variable to hold collection
    Private mCol As CollectionFriend Function Add(objNewMember As NetResource) As NetResource
    ' Note : this function only allows adding of already extant objects. NetResource objects cannot be created
    ' by adding them to a NetResources collection since most of the network structure is hardware based and
    ' cannot be changed by software.
        
        'create a new object
        mCol.Add objNewMember, objNewMember.RemoteName
        'return the object created
        Set Add = objNewMemberEnd FunctionPublic Property Get Item(vntIndexKey As Variant) As NetResource
    ' This item routine is a slight modification from the norm
    ' If an invalid or unmatched key is passed then this property returns a Nothing object rather than an error
    Dim nrX As NetResource
    On Error Resume Next
    Set nrX = mCol(vntIndexKey)
    If Err <> 0 Then
        Set Item = Nothing
    Else
        Set Item = nrX
    End If
    'Set Item = mCol(vntIndexKey)
    End PropertyPublic Property Get Count() As Long
        'used when retrieving the number of elements in the
        'collection. Syntax: Debug.Print x.Count
        Count = mCol.Count
    End Property
    Public Sub Remove(vntIndexKey As Variant)
        'used when removing an element from the collection
        'vntIndexKey contains either the Index or Key, which is why
        'it is declared as a Variant
        'Syntax: x.Remove(xyz)
        mCol.Remove vntIndexKey
    End Sub
    Public Property Get NewEnum() As IUnknown
        'this property allows you to enumerate
        'this collection with the For...Each syntax
        Set NewEnum = mCol.[_NewEnum]
    End Property
    Private Sub Class_Initialize()
        'creates the collection when this class is created
        Set mCol = New Collection
    End Sub
    Private Sub Class_Terminate()
        'destroys collection when this class is terminated
        Set mCol = Nothing
    End Sub
      

  5.   

    谢谢各位!关于第1个问题如何解决呢?难道真象wwqna(york) 所说的那样无法实现吗?请高手赐教。