Page 1 of 1

List all LAN ressources...

Posted: Thu May 05, 2005 7:46 pm
by Flype
Code updated for 5.20+

Code: Select all

;-
;- WNetEnumRessource : List LAN ressources
;- For Purebasic 3.93 and Windows NT
;- 
;- By Flype, May 2005
;-

#Shell32 = "\Shell32.dll"

#EOL = Chr(10)

#IcoNetwork = 14  ; Index of icon in the Shell32.dll
#IcoDomain  = 18
#IcoServer  = 164
#IcoShare   = 158
#IcoGeneric = 158
#IcoPrint   = 230

;-
;- Shell32.dll Icons
;-

SystemPath.s = Space(#MAX_PATH)
GetSystemDirectory_(SystemPath,#MAX_PATH)
Ressource.s = SystemPath+#Shell32

nIcon = ExtractIconEx_(Ressource,-1,0,0,0)
Global Dim hIcon(nIcon)
ExtractIconEx_(Ressource,0,0,@hIcon(0),nIcon)

;-
;- Procedures Network / LAN
;-

Enumeration ; #TYPE_
  
  #TYPE_LIST ; EnumNetWork() for ListIconGadget()
  #TYPE_TREE ; EnumNetWork() for TreeIconGadget()
  
EndEnumeration

Structure NETRESOURCE_BUFFER
  item.NETRESOURCE[100] ; <-- Predefined maximum items
EndStructure

Debug SizeOf(NETRESOURCE_BUFFER)

Procedure EnumNetworkEx(Gadget,Type,*item.NETRESOURCE)
  
  If WNetOpenEnum_(#RESOURCE_GLOBALNET,#RESOURCETYPE_ANY,#Null,*item,@hEnum) <> #NO_ERROR
    ProcedureReturn #False
  EndIf
  
  hBuf.NETRESOURCE_BUFFER
  
  iBuf = -1
  lBuf = SizeOf(NETRESOURCE_BUFFER)
  
  Repeat
    
    ZeroMemory_(hBuf,lBuf)
    
    Select WNetEnumResource_(hEnum,@iBuf,hBuf,@lBuf)
        
      Case #ERROR_NO_MORE_ITEMS : Break
        
      Case #NO_ERROR
        
        For i = 0 To iBuf - 1
          
          If hBuf\item[i]\lpLocalName  : LocalName$  = PeekS(hBuf\item[i]\lpLocalName)  : EndIf
          If hBuf\item[i]\lpRemoteName : RemoteName$ = PeekS(hBuf\item[i]\lpRemoteName) : EndIf
          If hBuf\item[i]\lpComment    : comment$    = PeekS(hBuf\item[i]\lpComment)    : EndIf
          If hBuf\item[i]\lpProvider   : Provider$   = PeekS(hBuf\item[i]\lpProvider)   : EndIf
          
          line$ = RemoteName$ + #EOL + LocalName$ + #EOL + Provider$ + #EOL + comment$
          
          Select hBuf\item[i]\dwScope
            Case #RESOURCE_GLOBALNET  : line$ + #EOL + "GLOBALNET"
            Case #RESOURCE_CONNECTED  : line$ + #EOL + "CONNECTED"
            Case #RESOURCE_REMEMBERED : line$ + #EOL + "REMEMBERED"
          EndSelect
          
          Select hBuf\item[i]\dwDisplayType
            Case 6                            : line$ + #EOL + "NETWORK" : image = hIcon(#IcoNetwork)
            Case #RESOURCEDISPLAYTYPE_DOMAIN  : line$ + #EOL + "DOMAIN"  : image = hIcon(#IcoDomain)
            Case #RESOURCEDISPLAYTYPE_SERVER  : line$ + #EOL + "SERVER"  : image = hIcon(#IcoServer)
            Case #RESOURCEDISPLAYTYPE_GENERIC : line$ + #EOL + "GENERIC" : image = hIcon(#IcoGeneric)
            Case #RESOURCEDISPLAYTYPE_SHARE   : line$ + #EOL + "SHARE"   : image = hIcon(#IcoShare)
          EndSelect
          
          Select hBuf\item[i]\dwType
            Case #RESOURCETYPE_ANY   : line$ + #EOL + "ANY"
            Case #RESOURCETYPE_DISK  : line$ + #EOL + "DISK"
            Case #RESOURCETYPE_PRINT : line$ + #EOL + "PRINT" : image = hIcon(#IcoPrint)
          EndSelect
          
          Select hBuf\item[i]\dwUsage
            Case hBuf\item[i]\dwUsage | #RESOURCEUSAGE_CONNECTABLE : line$ + #EOL + "CONNECTABLE"
            Case hBuf\item[i]\dwUsage | #RESOURCEUSAGE_CONTAINER   : line$ + #EOL + "CONTAINER"
          EndSelect
          
          Select Type
            Case #TYPE_LIST
              AddGadgetItem(Gadget,-1,line$,image)
              If hBuf\item[i]\dwUsage & #RESOURCEUSAGE_CONTAINER
                EnumNetworkEx(Gadget,Type,hBuf\item[i])
              EndIf
            Case #TYPE_TREE
              AddGadgetItem(Gadget,-1,RemoteName$,image)
              If hBuf\item[i]\dwUsage & #RESOURCEUSAGE_CONTAINER
                ;OpenTreeGadgetNode(Gadget)
                EnumNetworkEx(Gadget,Type,hBuf\item[i])
                ;CloseTreeGadgetNode(Gadget)
              EndIf
          EndSelect
          
        Next
        
    EndSelect
    
  ForEver
  
  If WNetCloseEnum_(hEnum) = #NO_ERROR
    ProcedureReturn #True
  EndIf
  
EndProcedure
Procedure EnumNetwork(Gadget,Type,RemoteName.s)
  
  ClearGadgetItems(Gadget)
  
  If RemoteName <> ""
    
    item.NETRESOURCE
    item\lpRemoteName = @RemoteName
    
  EndIf
  
  ProcedureReturn EnumNetworkEx(Gadget,Type,item)
  
EndProcedure

;-
;- Example
;-

w = 600
h = 300

If OpenWindow(0,0,0,w,h,"WNetEnumResource",#PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_ScreenCentered)
  
  ;If CreateGadgetList(WindowID())
  
  ListIconGadget(0,0,0,0,0,"RemoteName",200,#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection)
  TreeGadget(1,0,0,0,0,#PB_Tree_AlwaysShowSelection)
  SplitterGadget(2,5,5,w-10,h-10,1,0,#PB_Splitter_Vertical)
  
  SetGadgetState(2,300)
  SetGadgetAttribute(0, #PB_ListIcon_DisplayMode, #PB_ListIcon_Report)
  AddGadgetColumn(0,1,"LocalName",80)
  AddGadgetColumn(0,2,"Provider",180)
  AddGadgetColumn(0,3,"Comment",140)
  AddGadgetColumn(0,4,"Scope",80)
  AddGadgetColumn(0,6,"DisplayType",75)
  AddGadgetColumn(0,5,"Type",75)
  AddGadgetColumn(0,7,"Usage",100)
  
  EnumNetwork(0,#TYPE_LIST,"") ; "WORKGROUP" or "\\MYCOMPUTER"
  EnumNetwork(1,#TYPE_TREE,"") ; or "\\MYCOMPUTER\SharedDocs\"
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow : Break
      Case #PB_Event_SizeWindow : ResizeGadget(2,-1,-1,WindowWidth(0)-10,WindowHeight(0)-10)
      Case #PB_Event_Gadget
    EndSelect
  ForEver
  
  ;EndIf
  
EndIf
all seems to work like a charm

but i encounter a bug at line 44
if we set the size of item.NETRESOURCE[100] to [315] or more the program stop.
it's as if Purebasic can't allocate structured variables bigger than about 10000 bytes... ?