MossieurPropre I d͟o̩n᷃'̵t͖ give a shit | the real mask a écrit a écrit :
Code :
- '--------------------------------------------------------------
- ' Copyright ©1996-2002 VBnet, Randy Birch, All Rights Reserved.
- ' Terms of use http://www.mvps.org/vbnet/terms/pages/terms.htm
- '--------------------------------------------------------------
- 'from LMMSG.H
- Private Const MAX_PREFERRED_LENGTH As Long = -1
- Private Const NERR_SUCCESS As Long = 0&
- Private Const ERROR_MORE_DATA As Long = 234&
- Private Const SV_TYPE_WORKSTATION As Long = &H1
- Private Const SV_TYPE_SERVER As Long = &H2
- Private Const SV_TYPE_SQLSERVER As Long = &H4
- Private Const SV_TYPE_DOMAIN_CTRL As Long = &H8
- Private Const SV_TYPE_DOMAIN_BAKCTRL As Long = &H10
- Private Const SV_TYPE_TIME_SOURCE As Long = &H20
- Private Const SV_TYPE_AFP As Long = &H40
- Private Const SV_TYPE_NOVELL As Long = &H80
- Private Const SV_TYPE_DOMAIN_MEMBER As Long = &H100
- Private Const SV_TYPE_PRINTQ_SERVER As Long = &H200
- Private Const SV_TYPE_DIALIN_SERVER As Long = &H400
- Private Const SV_TYPE_XENIX_SERVER As Long = &H800
- Private Const SV_TYPE_SERVER_UNIX As Long = SV_TYPE_XENIX_SERVER
- Private Const SV_TYPE_NT As Long = &H1000
- Private Const SV_TYPE_WFW As Long = &H2000
- Private Const SV_TYPE_SERVER_MFPN As Long = &H4000
- Private Const SV_TYPE_SERVER_NT As Long = &H8000
- Private Const SV_TYPE_POTENTIAL_BROWSER As Long = &H10000
- Private Const SV_TYPE_BACKUP_BROWSER As Long = &H20000
- Private Const SV_TYPE_MASTER_BROWSER As Long = &H40000
- Private Const SV_TYPE_DOMAIN_MASTER As Long = &H80000
- Private Const SV_TYPE_SERVER_OSF As Long = &H100000
- Private Const SV_TYPE_SERVER_VMS As Long = &H200000
- Private Const SV_TYPE_WINDOWS As Long = &H400000 'Windows95 and above
- Private Const SV_TYPE_DFS As Long = &H800000 'Root of a DFS tree
- Private Const SV_TYPE_CLUSTER_NT As Long = &H1000000 'NT Cluster
- Private Const SV_TYPE_TERMINALSERVER As Long = &H2000000 'Terminal Server
- Private Const SV_TYPE_DCE As Long = &H10000000 'IBM DSS
- Private Const SV_TYPE_ALTERNATE_XPORT As Long = &H20000000 'rtn alternate transport
- Private Const SV_TYPE_LOCAL_LIST_ONLY As Long = &H40000000 'rtn local only
- Private Const SV_TYPE_DOMAIN_ENUM As Long = &H80000000
- Private Const SV_TYPE_ALL As Long = &HFFFFFFFF
- Private Const SV_PLATFORM_ID_OS2 As Long = 400
- Private Const SV_PLATFORM_ID_NT As Long = 500
- 'Mask applied to svX_version_major in
- 'order to obtain the major version number.
- Private Const MAJOR_VERSION_MASK As Long = &HF
- Private Type SERVER_INFO_100
- sv100_platform_id As Long
- sv100_name As Long
- End Type
- Private Declare Function NetServerEnum Lib "netapi32" _
- (ByVal servername As Long, _
- ByVal level As Long, _
- buf As Any, _
- ByVal prefmaxlen As Long, _
- entriesread As Long, _
- totalentries As Long, _
- ByVal servertype As Long, _
- ByVal domain As Long, _
- resume_handle As Long) As Long
- Private Declare Function NetApiBufferFree Lib "netapi32" _
- (ByVal Buffer As Long) As Long
- Private Declare Sub CopyMemory 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
- Private Const ERROR_ACCESS_DENIED As Long = 5
- Private Const ERROR_BAD_NETPATH As Long = 53
- Private Const ERROR_INVALID_PARAMETER As Long = 87
- Private Const ERROR_NOT_SUPPORTED As Long = 50
- Private Const ERROR_INVALID_NAME As Long = 123
- Private Const NERR_BASE As Long = 2100
- Private Const NERR_NetworkError As Long = (NERR_BASE + 36)
- Private Const NERR_NameNotFound As Long = (NERR_BASE + 173)
- Private Const NERR_UseNotFound As Long = (NERR_BASE + 150)
- Private Const MAX_COMPUTERNAME As Long = 15
- Private Const VER_PLATFORM_WIN32s As Long = 0
- Private Const VER_PLATFORM_WIN32_WINDOWS As Long = 1
- Private Const VER_PLATFORM_WIN32_NT As Long = 2
- Private Type OSVERSIONINFO
- OSVSize As Long
- dwVerMajor As Long
- dwVerMinor As Long
- dwBuildNumber As Long
- PlatformID As Long
- szCSDVersion As String * 128
- End Type
- 'User-defined type for passing
- 'the data to the Send function
- Private Type NetMessageData
- sServerName As String
- sSendTo As String
- sSendFrom As String
- sMessage As String
- End Type
- 'NetMessageBufferSend parameters:
- 'servername: Unicode string specifying the name of the
- ' remote server on which the function is to
- ' execute. If this parameter is vbNullString,
- ' the local computer is used.
- '
- 'msgname: Unicode string specifying the message alias to
- ' which the message buffer should be sent.
- '
- 'fromname: Unicode string specifying who the message is from.
- ' This parameter is required to send interrupting messages
- ' from the computer name. If this parameter is NULL, the
- ' message is sent from the logged-on user.
- '
- 'msgbuf: Unicode string containing the message to send.
- '
- 'msgbuflen: value that contains the length, in bytes, of
- ' the message text pointed to by the msgbuf parameter.
- Private Declare Function NetMessageBufferSend Lib "netapi32" _
- (ByVal servername As String, _
- ByVal msgname As String, _
- ByVal fromname As String, _
- ByVal msgbuf As String, _
- ByRef msgbuflen As Long) As Long
- Private Declare Function GetComputerName Lib "kernel32" _
- Alias "GetComputerNameA" _
- (ByVal lpBuffer As String, _
- nSize As Long) As Long
- Private Declare Function GetVersionEx Lib "kernel32" _
- Alias "GetVersionExA" _
- (lpVersionInformation As OSVERSIONINFO) As Long
- Private Sub Form_Load()
- Dim tmp As String
- 'pre-load the text boxes with
- 'the local computer name for testing
- tmp = Space$(MAX_COMPUTERNAME + 1)
- Call GetComputerName(tmp, Len(tmp))
- Text1.Text = TrimNull(tmp)
- Text3.Text = TrimNull(tmp)
- Call GetServers(vbNullString)
- End Sub
- Private Sub Command1_Click()
- Dim msgData As NetMessageData
- Dim sSuccess As String
- For i = 0 To List1.ListCount - 1
- If List1.Selected(i) Then
- With msgData
- .sServerName = Text1.Text
- .sSendTo = List1.List(i)
- .sSendFrom = Text3.Text
- .sMessage = Text4.Text
- End With
- sSuccess = NetSendMessage(msgData)
- End If
- Next
- StatusBar1.Panels(2).Text = sSuccess
- End Sub
- Private Function IsWinNT() As Boolean
- 'returns True if running WinNT/Win2000/WinXP
- #If Win32 Then
- Dim OSV As OSVERSIONINFO
- OSV.OSVSize = Len(OSV)
- If GetVersionEx(OSV) = 1 Then
- 'PlatformId contains a value representing the OS.
- IsWinNT = (OSV.PlatformID = VER_PLATFORM_WIN32_NT)
- End If
- #End If
- End Function
- Private Function NetSendMessage(msgData As NetMessageData) As String
- Dim success As Long
- 'assure that the OS is NT ..
- 'NetMessageBufferSend can not
- 'be called on Win9x
- If IsWinNT() Then
- With msgData
- 'if To name omitted return error and exit
- If .sSendTo = "" Then
- NetSendMessage = GetNetSendMessageStatus(ERROR_INVALID_PARAMETER)
- Exit Function
- Else
- 'if there is a message
- If Len(.sMessage) Then
- 'convert the strings to unicode
- .sSendTo = StrConv(.sSendTo, vbUnicode)
- .sMessage = StrConv(.sMessage, vbUnicode)
- 'Note that the API could be called passing
- 'vbNullString as the SendFrom and sServerName
- 'strings. This would generate the message on
- 'the sending machine.
- If Len(.sServerName) > 0 Then
- .sServerName = StrConv(.sServerName, vbUnicode)
- Else: .sServerName = vbNullString
- End If
- If Len(.sSendFrom) > 0 Then
- .sSendFrom = StrConv(.sSendFrom, vbUnicode)
- Else: .sSendFrom = vbNullString
- End If
- 'change the cursor and show. Control won't return
- 'until the call has completed.
- Screen.MousePointer = vbHourglass
- success = NetMessageBufferSend(.sServerName, _
- .sSendTo, _
- .sSendFrom, _
- .sMessage, _
- ByVal Len(.sMessage))
- Screen.MousePointer = vbNormal
- NetSendMessage = GetNetSendMessageStatus(success)
- End If 'If Len(.sMessage)
- End If 'If .sSendTo
- End With 'With msgData
- End If 'If IsWinNT
- End Function
- Private Function GetNetSendMessageStatus(nError As Long) As String
- Dim msg As String
- Select Case nError
- Case NERR_SUCCESS: msg = "The message was successfully sent"
- Case NERR_NameNotFound: msg = "Send To not found"
- Case NERR_NetworkError: msg = "General network error occurred"
- Case NERR_UseNotFound: msg = "Network connection not found"
- Case ERROR_ACCESS_DENIED: msg = "Access to computer denied"
- Case ERROR_BAD_NETPATH: msg = "Sent From server name not found."
- Case ERROR_INVALID_PARAMETER: msg = "Invalid parameter(s) specified."
- Case ERROR_NOT_SUPPORTED: msg = "Network request not supported."
- Case ERROR_INVALID_NAME: msg = "Illegal character or malformed name."
- Case Else: msg = "Unknown error executing command."
- End Select
- GetNetSendMessageStatus = msg
- End Function
- Private Function TrimNull(item As String)
- 'return string before the terminating null
- Dim pos As Integer
- pos = InStr(item, Chr$(0))
- If pos Then
- TrimNull = Left$(item, pos - 1)
- Else: TrimNull = item
- End If
- End Function
- Private Function GetServers(sDomain As String) As Long
- 'lists all servers of the specified type
- 'that are visible in a domain.
- Dim bufptr As Long
- Dim dwEntriesread As Long
- Dim dwTotalentries As Long
- Dim dwResumehandle As Long
- Dim se100 As SERVER_INFO_100
- Dim success As Long
- Dim nStructSize As Long
- Dim cnt As Long
- nStructSize = LenB(se100)
- 'Call passing MAX_PREFERRED_LENGTH to have the
- 'API allocate required memory for the return values.
- '
- 'The call is enumerating all machines on the
- 'network (SV_TYPE_ALL); however, by Or'ing
- 'specific bit masks for defined types you can
- 'customize the returned data. For example, a
- 'value of 0x00000003 combines the bit masks for
- 'SV_TYPE_WORKSTATION (0x00000001) and
- 'SV_TYPE_SERVER (0x00000002).
- '
- 'dwServerName must be Null. The level parameter
- '(100 here) specifies the data structure being
- 'used (in this case a SERVER_INFO_100 structure).
- '
- 'The domain member is passed as Null, indicating
- 'machines on the primary domain are to be retrieved.
- 'If you decide to use this member, pass
- 'StrPtr("domain name" ), not the string itself.
- success = NetServerEnum(0&, _
- 100, _
- bufptr, _
- MAX_PREFERRED_LENGTH, _
- dwEntriesread, _
- dwTotalentries, _
- SV_TYPE_ALL, _
- 0&, _
- dwResumehandle)
- 'if all goes well
- If success = NERR_SUCCESS And _
- success <> ERROR_MORE_DATA Then
- 'loop through the returned data, adding each
- 'machine to the list
- For cnt = 0 To dwEntriesread - 1
- 'get one chunk of data and cast
- 'into an SERVER_INFO_100 struct
- 'in order to add the name to a list
- CopyMemory se100, ByVal bufptr + (nStructSize * cnt), nStructSize
- List1.AddItem GetPointerToByteStringW(se100.sv100_name)
- Next
- End If
- 'clean up regardless of success
- Call NetApiBufferFree(bufptr)
- 'return entries as sign of success
- GetServers = dwEntriesread
- End Function
- Public Function GetPointerToByteStringW(ByVal dwData As Long) As String
- Dim tmp() As Byte
- Dim tmplen As Long
- If dwData <> 0 Then
- tmplen = lstrlenW(dwData) * 2
- If tmplen <> 0 Then
- ReDim tmp(0 To (tmplen - 1)) As Byte
- CopyMemory tmp(0), ByVal dwData, tmplen
- GetPointerToByteStringW = tmp
- End If
- End If
- End Function
|
fonction en api
met un list view
sinon c sure pplanet source code
dans les news en vb
|
![[:wam]](https://forum-images.hardware.fr/images/perso/wam.gif "[:wam]")
je préfère le miens, lé + court kan même ... ---------------
www.novemberguitars.com
|
@+ 
, problème résolu a l'aide de net view 
allé fais toi pas prier misterproper 
thanks