FreeBasic

Данный пример хорош тем, что кроме всего прочего, покажет вашу рабочую сеть WORKGROUP и все подключенные к ней компьютеры, в том числе общие папки.

Платформа: Windows
Автор: Microsoft (на freebasic код перевел Станислав Будинов)

#INCLUDE "windows.bi"
#INCLIB "mpr"

Sub DisplayStruct(i As Long, lpnrLocal As LPNETRESOURCE)

    Static As Long iTemp
    Static As String sProvider,sTab,sTabTemp

    If *lpnrLocal->lpProvider <> sProvider Then
        sTab = ""
        sTabTemp = ""
        sProvider = *lpnrLocal->lpProvider
    Else
        If i = 0 Then
            sTab = sTabTemp & "  "
            sTabTemp = sTab
            iTemp = i
        Elseif iTemp>=i Then    
            sTab = Mid(sTabTemp,1,Len(sTabTemp)-(2+(iTemp-i)*2))
            sTabTemp = sTab         
        Elseif iTemp<i Then
            sTab = sTabTemp
            iTemp = i
        Endif
    Endif

    Print sTab & "NETRESOURCE[" & i & "] Scope: ";
    Select Case lpnrLocal->dwScope
        Case RESOURCE_CONNECTED
            Print "connected"
        Case RESOURCE_GLOBALNET
            Print "all resources"
        Case RESOURCE_REMEMBERED
            Print "remembered"
        Case Else
            Print "unknown scope "; lpnrLocal->dwScope
    End Select

    Print sTab & "NETRESOURCE[" & i & "] Type: ";
    Select Case lpnrLocal->dwType
        Case RESOURCETYPE_ANY
            Print "any"
        Case RESOURCETYPE_DISK
            Print "disk"
        Case RESOURCETYPE_PRINT
            Print "print"
        Case Else
            Print "unknown type "; lpnrLocal->dwType
    End Select

    Print sTab & "NETRESOURCE[" & i & "] DisplayType: ";
    Select Case lpnrLocal->dwDisplayType
        Case RESOURCEDISPLAYTYPE_GENERIC
            Print "generic"
        Case RESOURCEDISPLAYTYPE_DOMAIN
            Print "domain"
        Case RESOURCEDISPLAYTYPE_SERVER
            Print "server"
        Case RESOURCEDISPLAYTYPE_SHARE
            Print "share"
        Case RESOURCEDISPLAYTYPE_FILE
            Print "file"
        Case RESOURCEDISPLAYTYPE_GROUP
            Print "group"
        Case RESOURCEDISPLAYTYPE_NETWORK
            Print "network"
        Case Else
            Print "unknown display type "; lpnrLocal->dwDisplayType
    End Select

    Print sTab & "NETRESOURCE[" & i & "] Usage: " & Hex(lpnrLocal->dwUsage) & " = ";
    If (lpnrLocal->dwUsage And RESOURCEUSAGE_CONNECTABLE) Then
        Print "connectable "
    Endif
    If (lpnrLocal->dwUsage And RESOURCEUSAGE_CONTAINER) Then
        Print "container "
    Endif

    Print sTab & "NETRESOURCE[" & i & "] Localname: "; *lpnrLocal->lpLocalName
    Print sTab & "NETRESOURCE[" & i & "] Remotename: "; *lpnrLocal->lpRemoteName
    Print sTab & "NETRESOURCE[" & i & "] Comment: "; *lpnrLocal->lpComment
    Print sTab & "NETRESOURCE[" & i & "] Provider: "; *lpnrLocal->lpProvider
    Print ""
End Sub

Function EnumerateFunc(lpnr As LPNETRESOURCE) As BOOL

    Dim As DWORD dwResult, dwResultEnum
    Dim As HANDLE hEnum
    Dim As DWORD cbBuffer = 16384
    Dim As DWORD cEntries = -1
    Dim As LPNETRESOURCE lpnrLocal
    Dim As DWORD i

    dwResult = WNetOpenEnum(RESOURCE_GLOBALNET,_
    RESOURCETYPE_ANY,_
    0,_
    lpnr,_
    @hEnum)

    If  dwResult <> NO_ERROR Then
        Print "WnetOpenEnum failed with error "; dwResult
        Return FALSE
    Endif

    lpnrLocal = Callocate(cbBuffer)
    If lpnrLocal = NULL Then
        Print "WnetOpenEnum failed with error "; dwResult
        Return FALSE
    Endif

    Do
        ZeroMemory(lpnrLocal, cbBuffer)

        dwResultEnum = WNetEnumResource(hEnum,_
        @cEntries,_
        lpnrLocal,_
        @cbBuffer)

        If dwResultEnum = NO_ERROR Then
            For i = 0 To cEntries-1
                DisplayStruct(i, @lpnrLocal[i])
                If RESOURCEUSAGE_CONTAINER = (lpnrLocal[i].dwUsage _
                    And RESOURCEUSAGE_CONTAINER) Then
                    If EnumerateFunc(@lpnrLocal[i])=0 Then
                        Print "EnumerateFunc returned FALSE"
                    Endif
                Endif
            Next
        Elseif dwResultEnum <> ERROR_NO_MORE_ITEMS Then
            Print "WNetEnumResource failed with error "; dwResultEnum
            Exit Do
        Endif
    Loop While dwResultEnum <> ERROR_NO_MORE_ITEMS

    Deallocate(lpnrLocal)

    dwResult = WNetCloseEnum(hEnum)

    If dwResult <> NO_ERROR Then
        Print "WNetCloseEnum failed with error "; dwResult
        Return FALSE
    Endif

    Return TRUE
End Function

Dim As LPNETRESOURCE lpnr = NULL

If EnumerateFunc(lpnr) = FALSE Then
    Print "Call to EnumerateFunc failed"
Endif
Sleep