lestagef
|
'Option Explicit
'API types
Private Type USER_INFO
Name As String
Comment As String
UserComment As String
FullName As String
End Type
Private Type USER_INFO_API
Name As Long
Comment As Long
UserComment As Long
FullName As Long
End Type
Public UserInfo(0 To 1000) As USER_INFO
'API calls
Private Declare Function NetUserEnum Lib "netapi32" (lpServer As Any, ByVal Level As Long, ByVal Filter As Long, lpBuffer As Long, ByVal PrefMaxLen As Long, EntriesRead As Long, TotalEntries As Long, ResumeHandle As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32" (ByVal pBuffer As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
'API Constants
Private Const NERR_Success As Long = 0&
Private Const ERROR_MORE_DATA As Long = 234&
Private Const FILTER_TEMP_DUPLICATE_ACCOUNT As Long = &H1&
Private Const FILTER_NORMAL_ACCOUNT As Long = &H2&
Private Const FILTER_PROXY_ACCOUNT As Long = &H4&
Private Const FILTER_INTERDOMAIN_TRUST_ACCOUNT As Long = &H8&
Private Const FILTER_WORKSTATION_TRUST_ACCOUNT As Long = &H10&
Private Const FILTER_SERVER_TRUST_ACCOUNT As Long = &H20&
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Function NetServerEnum Lib "Netapi32.dll" (vServername As Any, ByVal lLevel As Long, vBufptr As Any, lPrefmaxlen As Long, lEntriesRead As Long, lTotalEntries As Long, vServerType As Any, ByVal sDomain As String, vResumeHandle As Any) As Long
Public Declare Sub RtlMoveMemory Lib "kernel32" (dest As Any, vSrc As Any, ByVal lSize&)
Public Declare Sub lstrcpyW Lib "kernel32" (vDest As Any, ByVal sSrc As Any)
Declare Sub lstrcpy Lib "kernel32" (vDest As Any, ByVal vSrc As Any)
Declare Sub lstrcpynW Lib "kernel32" (ByVal vDest As Any, ByVal vSrc As Any, lLength As Long)
Declare Function NetWkstaGetInfo Lib "Netapi32.dll" (ByVal sServerName$, ByVal lLevel&, vBuffer As Any) As Long
Declare Function NetMessageBufferSend Lib "Netapi32.dll" (ByVal sServerName$, ByVal sMsgName$, ByVal sFromName$, ByVal sMessageText$, ByVal lBufferLength&) As Long
Type SERVER_INFO_100
sv100_platform_id As Long
sv100_servername As Long
End Type
Public Type SERVER_INFO_101
dw_platform_id As Long
ptr_name As Long
dw_ver_major As Long
dw_ver_minor As Long
dw_type As Long
ptr_comment As Long
End Type
Type WKSTA_INFO_100
wki100_platform_id As Long
wki100_computername As Long
wki100_langroup As Long
wki100_ver_major As Long
wki100_ver_minor As Long
End Type
Public Const SV_TYPE_WORKSTATION = &H1
Public Const SV_TYPE_SERVER = &H2
Public Const SV_TYPE_SQLSERVER = &H4
Public Const SV_TYPE_DOMAIN_CTRL = &H8
Public Const SV_TYPE_DOMAIN_BAKCTRL = &H10
Public Const SV_TYPE_TIMESOURCE = &H20
Public Const SV_TYPE_AFP = &H40
Public Const SV_TYPE_NOVELL = &H80
Public Const SV_TYPE_DOMAIN_MEMBER = &H100
Public Const SV_TYPE_LOCAL_LIST_ONLY = &H40000000
Public Const SV_TYPE_PRINT = &H200
Public Const SV_TYPE_DIALIN = &H400
Public Const SV_TYPE_XENIX_SERVER = &H800
Public Const SV_TYPE_MFPN = &H4000
Public Const SV_TYPE_NT = &H1000
Public Const SV_TYPE_WFW = &H2000
Public Const SV_TYPE_SERVER_NT = &H8000
Public Const SV_TYPE_POTENTIAL_BROWSER = &H10000
Public Const SV_TYPE_BACKUP_BROWSER = &H20000
Public Const SV_TYPE_MASTER_BROWSER = &H40000
Public Const SV_TYPE_DOMAIN_MASTER = &H80000
Public Const SV_TYPE_DOMAIN_ENUM = &H80000000
Public Const SV_TYPE_WINDOWS = &H400000
Public Const SV_TYPE_ALL = &HFFFFFFFF
Public SERVERTYPE As Long
Public Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal sBuffer As String, lSize As Long) As Long
Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Public Function FillDomainTree(lType As Double, tvw As TreeView, Cmb0 As ComboBox, Cmb1 As ComboBox, Cmb2 As ComboBox) As Boolean
Dim lReturn As Long
Dim Server_Info As Long
Dim lEntries As Long
Dim lTotal As Long
Dim lMax As Long
Dim vResume As Variant
Dim tServer_info_101 As SERVER_INFO_101
Dim sServer As String
Dim sDomain As String
Dim lServerInfo101StructPtr As Long
Dim X As Long, i As Long
Dim bBuffer(512) As Byte
Dim nodex As Node
tvw.Nodes.Clear
Set nodex = tvw.Nodes.Add(, , "R", "Network Domains", "dm")
nodex.Expanded = True
lReturn = NetServerEnum(ByVal 0&, 101, Server_Info, lMax, lEntries, lTotal, ByVal lType, sDomain, vResume)
If lReturn <> 0 Then
Exit Function
End If
X = 1
lServerInfo101StructPtr = Server_Info
Do While X <= lTotal
DoEvents
RtlMoveMemory tServer_info_101, ByVal lServerInfo101StructPtr, Len(tServer_info_101)
lstrcpyW bBuffer(0), tServer_info_101.ptr_name
i = 0
Do While bBuffer(i) <> 0
sServer = sServer & Chr$(bBuffer(i))
i = i + 2
DoEvents
Loop
Set nodex = tvw.Nodes.Add("R", tvwChild, sServer, sServer, "dmmac")
nodex.Expanded = True
Call AddDomainServers(SERVERTYPE, tvw, sServer, Cmb0, Cmb1, Cmb2)
DoEvents
X = X + 1
sServer = ""
lServerInfo101StructPtr = lServerInfo101StructPtr + Len(tServer_info_101)
Loop
lReturn = NetApiBufferFree(Server_Info)
End Function
Private Sub AddDomainServers(lType As Long, tvw As TreeView, Parentkey As String, Cmb0 As ComboBox, Cmb1 As ComboBox, Cmb2 As ComboBox)
Dim lReturn As Long
Dim Server_Info As Long
Dim lEntries As Long
Dim lTotal As Long
Dim lMax As Long
Dim vResume As Variant
Dim tServer_info_101 As SERVER_INFO_101
Dim sServer As String
Dim sDomain As String
Dim lServerInfo101StructPtr As Long
Dim X As Long, i As Long
Dim bBuffer(512) As Byte
Dim nodex As Node
sDomain = StrConv(Parentkey, vbUnicode)
lReturn = NetServerEnum(ByVal 0&, 101, Server_Info, lMax, lEntries, lTotal, ByVal lType, sDomain, vResume)
If lReturn <> 0 Then
Exit Sub
End If
X = 1
lServerInfo101StructPtr = Server_Info
Do While X <= lTotal
DoEvents
RtlMoveMemory tServer_info_101, ByVal lServerInfo101StructPtr, Len(tServer_info_101)
lstrcpyW bBuffer(0), tServer_info_101.ptr_name
i = 0
Do While bBuffer(i) <> 0
sServer = sServer & Chr$(bBuffer(i))
i = i + 2
DoEvents
Loop
Cmb0.AddItem sServer
Cmb1.AddItem sServer
Cmb2.AddItem sServer
Set nodex = tvw.Nodes.Add(Parentkey, tvwChild, "W" + Parentkey + sServer, sServer, "cmac")
nodex.Expanded = True
DoEvents
X = X + 1
sServer = ""
lServerInfo101StructPtr = lServerInfo101StructPtr + Len(tServer_info_101)
Loop
lReturn = NetApiBufferFree(Server_Info)
End Sub
Public Function GetLocalSystemName()
Dim lReturnCode As Long
Dim bBuffer(512) As Byte
Dim i As Integer
Dim twkstaInfo100 As WKSTA_INFO_100, lwkstaInfo100 As Long
Dim lwkstaInfo100StructPtr As Long
Dim sLocalName As String
lReturnCode = NetWkstaGetInfo("", 100, lwkstaInfo100)
lwkstaInfo100StructPtr = lwkstaInfo100
If lReturnCode = 0 Then
RtlMoveMemory twkstaInfo100, ByVal _
lwkstaInfo100StructPtr, Len(twkstaInfo100)
lstrcpyW bBuffer(0), twkstaInfo100.wki100_computername
i = 0
Do While bBuffer(i) <> 0
sLocalName = sLocalName & Chr(bBuffer(i))
i = i + 2
Loop
GetLocalSystemName = sLocalName
End If
End Function
Public Function GetDomainName() As String
Dim lReturnCode As Long
Dim bBuffer(512) As Byte
Dim i As Integer
Dim twkstaInfo100 As WKSTA_INFO_100, lwkstaInfo100 As Long
Dim lwkstaInfo100StructPtr As Long
Dim sDomainName As String
lReturnCode = NetWkstaGetInfo("", 100, lwkstaInfo100)
lwkstaInfo100StructPtr = lwkstaInfo100
If lReturnCode = 0 Then
RtlMoveMemory twkstaInfo100, ByVal lwkstaInfo100StructPtr, Len(twkstaInfo100)
lstrcpyW bBuffer(0), twkstaInfo100.wki100_langroup
i = 0
Do While bBuffer(i) <> 0
sDomainName = sDomainName & Chr(bBuffer(i))
i = i + 2
Loop
GetDomainName = sDomainName
End If
End Function
Public Function NetSend(Msg As String, ToNode As String) As Boolean
Dim lReturnCode As Long
Dim sUnicodeToName As String
Dim sUnicodeFromName As String
Dim sUnicodeMessage As String
Dim lMessageLength As Long
sUnicodeFromName = StrConv(GetLocalSystemName, vbUnicode)
sUnicodeToName = StrConv(ToNode, vbUnicode)
sUnicodeMessage = StrConv(Msg + vbCrLf & vbCrLf & vbCrLf & "_______________________________________" & vbCrLf & UserName + "(" + GetDomainName + ")", vbUnicode)
lMessageLength = Len(sUnicodeMessage)
Screen.MousePointer = vbHourglass
lReturnCode = NetMessageBufferSend("", sUnicodeToName, sUnicodeFromName, sUnicodeMessage, lMessageLength)
If lReturnCode = 0 Then
Form1.StatusBar1.Panels(1).Text = "Your message was sent correct.."
Else
Form1.StatusBar1.Panels(1).Text = "Cannot Sent the message. Error No : " + CStr(lReturnCode)
End If
Screen.MousePointer = vbDefault
End Function
Public Property Get UserName() As Variant
Dim sBuffer As String
Dim lSize As Long
sBuffer = Space$(255)
lSize = Len(sBuffer)
Call GetUserName(sBuffer, lSize)
UserName = Left$(sBuffer, lSize)
End Property
Private Function PtrToString(lpwString As Long) As String
Dim Buffer() As Byte
Dim nLen As Long
If lpwString Then
nLen = lstrlenW(lpwString) * 2
If nLen Then
ReDim Buffer(0 To (nLen - 1)) As Byte
CopyMem Buffer(0), ByVal lpwString, nLen
PtrToString = Buffer
End If
End If
End Function
Public Function GetUsers(ByVal ServerName As String) As Long
Dim lpBuffer As Long
Dim nRet As Long
Dim EntriesRead As Long
Dim TotalEntries As Long
Dim ResumeHandle As Long
Dim uUser As USER_INFO_API
Dim bServer() As Byte
Dim i As Integer
If Trim(ServerName) = "" Then
bServer = vbNullString
Else
If InStr(ServerName, "\\") = 1 Then
bServer = ServerName & vbNullChar
Else
bServer = "\\" & ServerName & vbNullChar
End If
End If
i = 0
ResumeHandle = 0
Do
If Trim(ServerName) = "" Then
nRet = NetUserEnum(vbNullString, 10, FILTER_NORMAL_ACCOUNT, lpBuffer, 1, EntriesRead, TotalEntries, ResumeHandle)
Else
nRet = NetUserEnum(bServer(0), 10, FILTER_NORMAL_ACCOUNT, lpBuffer, 1, EntriesRead, TotalEntries, ResumeHandle)
End If
If nRet = ERROR_MORE_DATA Then
CopyMem uUser, ByVal lpBuffer, Len(uUser)
UserInfo(i).Name = PtrToString(uUser.Name)
UserInfo(i).Comment = PtrToString(uUser.Comment)
UserInfo(i).UserComment = PtrToString(uUser.UserComment)
UserInfo(i).FullName = PtrToString(uUser.FullName)
i = i + 1
End If
If lpBuffer Then
Call NetApiBufferFree(lpBuffer)
End If
Loop While nRet = ERROR_MORE_DATA
GetUsers = i
End Function
-------------------------------
Réponse au message :
-------------------------------
Bonjour,
je recherche un source qui utiliserait un Treeview pour parcourir le réseau
et afficher les repertoires partagés des machines connectés à celui ci.
Merci bcp, projet indus., urgent
|