Page 1 sur 1

Lister les ressources du réseau

Publié : jeu. 05/mai/2005 19:23
par Flype

Code : Tout sélectionner

;-
;- 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)
Dim hIcon.l(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

Procedure.l EnumNetworkEx(Gadget.l,Type.l,*item.NETRESOURCE)
  
  If WNetOpenEnum_(#RESOURCE_GLOBALNET,#RESOURCETYPE_ANY,#Null,*item,@hEnum) <> #NO_ERROR
    ProcedureReturn #False
  EndIf
  
  hBuf.NETRESOURCE_BUFFER
  
  iBuf.l = -1
  lBuf.l = 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.l EnumNetwork(Gadget.l,Type.l,RemoteName.s)
  
  ClearGadgetItemList(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,#PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_ScreenCentered,"WNetEnumResource")
  
  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)
    ChangeListIconGadgetDisplay(0,3)
    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()-10,WindowHeight()-10)
        Case #PB_Event_Gadget
      EndSelect
    ForEver
    
  EndIf
  
EndIf

Publié : jeu. 05/mai/2005 19:34
par Flype
donc çà, çà marche bien...

maintenant si à la ligne 44 je change :

Code : Tout sélectionner

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

par

Code : Tout sélectionner

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

Debug SizeOf(NETRESOURCE_BUFFER)
le programme plante quand on initialise une variable
dont la taille de la structure dépasse environ 10000 octets.
( dans le source à la ligne 56 : hBuf.NETRESOURCE_BUFFER )
embêtant :roll: