Discussion :

[locutus33]

Bonjour tout le monde

J'ai réussi à récupérer les adresses IP de mes postes sur le réseau, et j'aurai voulu savoir s'il était possible de récupérer également le nom de la machine sur ce même réseau.

Par avance, merci à tous et toutes

[cafeine]

Bonjour et bienvenue sur le forum,

merci cependant de consulter la FAQ, en effet la réponse à ta question s'y trouve : http://access.developpez.com/faq/?page=API#nommachine

[locutus33]

Merci, j'ai bien vu cette faq, mais (à moins que je ne trompe), j'ai pensé que c'était uniquement pour connaitre le nom de la machine où était lancé le programme Access et non pas le nom des machines distantes.

[cafeine]

est-ce que ce code :
http://access.developpez.com/faq/?pa...UnicodeLecteur

ou celui ci :
http://access.developpez.com/faq/?page=system#domaine

ne rejoignent pas ta question ?

[locutus33]

J'ai vu aussi ces codes mais je pensais qu'il y avait une solution plus simple à partir du moment ou l'on connaissait l'adresse IP d'un poste.

[cafeine]

simple, simple ... c'est vite dit :

utilise fGetHostName()

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
Option Compare Database
Option Explicit
 
' ******** Code Start ********
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128
Private Const AF_INET = 2
 
Private Type WSADATA
    wversion As Integer
    wHighVersion As Integer
    szDescription(MAX_WSADescription) As Byte
    szSystemStatus(MAX_WSASYSStatus) As Byte
    wMaxSockets As Long
    wMaxUDPDG As Long
    dwVendorInfo As Long
End Type
 
Private Type HOSTENT
    hName As Long
    hAliases As Long
    hAddrType As Integer
    hLength As Integer
    hAddrList As Long
End Type
 
' returns the standard host name for the local machine
Private Declare Function apiGetHostName _
    Lib "wsock32" Alias "gethostname" _
    (ByVal name As String, _
    ByVal nameLen As Long) _
    As Long
 
' retrieves host information corresponding to a host name
' from a host database
Private Declare Function apiGetHostByName _
    Lib "wsock32" Alias "gethostbyname" _
    (ByVal hostname As String) _
    As Long
 
' retrieves the host information corresponding to a network address
Private Declare Function apiGetHostByAddress _
    Lib "wsock32" Alias "gethostbyaddr" _
    (addr As Long, _
    ByVal dwLen As Long, _
    ByVal dwType As Long) _
    As Long
 
' moves memory either forward or backward, aligned or unaligned,
' in 4-byte blocks, followed by any remaining bytes
Private Declare Sub sapiCopyMem _
    Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, _
    ByVal Length As Long)
 
' converts a string containing an (Ipv4) Internet Protocol
' dotted address into a proper address for the IN_ADDR structure
Private Declare Function apiInetAddress _
    Lib "wsock32" Alias "inet_addr" _
    (ByVal cp As String) _
    As Long
 
' function initiates use of Ws2_32.dll by a process
Private Declare Function apiWSAStartup _
    Lib "wsock32" Alias "WSAStartup" _
    (ByVal wVersionRequired As Integer, _
    lpWsaData As WSADATA) _
    As Long
 
Private Declare Function apilstrlen _
    Lib "kernel32" Alias "lstrlen" _
    (ByVal lpString As Long) _
    As Long
 
Private Declare Function apilstrlenW _
    Lib "kernel32" Alias "lstrlenW" _
    (ByVal lpString As Long) _
    As Long
 
' function terminates use of the Ws2_32.dll
Private Declare Function apiWSACleanup _
    Lib "wsock32" Alias "WSACleanup" _
    () As Long
 
Function fGetHostIPAddresses(strHostName As String) As Collection
'
' Resolves the English HostName and returns
' a collection with all the IPs bound to the card
'
On Error GoTo ErrHandler
Dim lngRet As Long
Dim lpHostEnt As HOSTENT
Dim strOut As String
Dim colOut As Collection
Dim lngIPAddr As Long
Dim abytIPs() As Byte
Dim i As Integer
 
    Set colOut = New Collection
 
    If fInitializeSockets() Then
        strOut = String$(255, vbNullChar)
        lngRet = apiGetHostByName(strHostName)
        If lngRet Then
 
            Call sapiCopyMem( _
                    lpHostEnt, _
                    ByVal lngRet, _
                    Len(lpHostEnt))
 
            Call sapiCopyMem( _
                    lngIPAddr, _
                    ByVal lpHostEnt.hAddrList, _
                    Len(lngIPAddr))
 
            Do While (lngIPAddr)
                With lpHostEnt
                    ReDim abytIPs(0 To .hLength - 1)
                    strOut = vbNullString
                    Call sapiCopyMem( _
                        abytIPs(0), _
                        ByVal lngIPAddr, _
                        .hLength)
                    For i = 0 To .hLength - 1
                        strOut = strOut & abytIPs(i) & "."
                    Next
                    strOut = Left$(strOut, Len(strOut) - 1)
                    .hAddrList = .hAddrList + Len(.hAddrList)
                    Call sapiCopyMem( _
                            lngIPAddr, _
                            ByVal lpHostEnt.hAddrList, _
                            Len(lngIPAddr))
                    If Len(trim$(strOut)) Then colOut.add strOut
                End With
            Loop
        End If
    End If
    Set fGetHostIPAddresses = colOut
ExitHere:
    Call apiWSACleanup
    Set colOut = Nothing
    Exit Function
ErrHandler:
    With Err
        MsgBox "Error: " & .Number & vbCrLf & .Description, _
            vbOKOnly Or vbCritical, _
            .Source
    End With
    Resume ExitHere
End Function
 
Function fGetHostName(strIPAddress As String) As String
'
' Looks up a given IP address and returns the
' machine name it's bound to
'
On Error GoTo ErrHandler
Dim lngRet As Long
Dim lpAddress As Long
Dim strOut As String
Dim lpHostEnt As HOSTENT
 
    If fInitializeSockets() Then
        lpAddress = apiInetAddress(strIPAddress)
        lngRet = apiGetHostByAddress(lpAddress, 4, AF_INET)
        If lngRet Then
            Call sapiCopyMem( _
                lpHostEnt, _
                ByVal lngRet, _
                Len(lpHostEnt))
            fGetHostName = fStrFromPtr(lpHostEnt.hName, False)
        End If
    End If
ExitHere:
    Call apiWSACleanup
    Exit Function
ErrHandler:
    With Err
        MsgBox "Error: " & .Number & vbCrLf & .Description, _
            vbOKOnly Or vbCritical, _
            .Source
    End With
    Resume ExitHere
End Function
 
Private Function fInitializeSockets() As Boolean
Dim lpWsaData As WSADATA
Dim wVersionRequired As Integer
 
    wVersionRequired = fMakeWord(2, 2)
    fInitializeSockets = ( _
        apiWSAStartup(wVersionRequired, lpWsaData) = 0)
 
End Function
 
Private Function fMakeWord( _
                            ByVal low As Integer, _
                            ByVal hi As Integer) _
                            As Integer
Dim intOut As Integer
    Call sapiCopyMem( _
        ByVal VarPtr(intOut) + 1, _
        ByVal VarPtr(hi), _
        1)
    Call sapiCopyMem( _
        ByVal VarPtr(intOut), _
        ByVal VarPtr(low), _
        1)
    fMakeWord = intOut
End Function
 
Private Function fStrFromPtr( _
                                    pBuf As Long, _
                                    Optional blnIsUnicode As Boolean) _
                                    As String
Dim lngLen As Long
Dim abytBuf() As Byte
 
    If blnIsUnicode Then
        lngLen = apilstrlenW(pBuf) * 2
    Else
        lngLen = apilstrlen(pBuf)
    End If
    ' if it's not a ZLS
    If lngLen Then
        ReDim abytBuf(lngLen)
        ' return the buffer
        If blnIsUnicode Then
            'blnIsUnicode is True not tested
            Call sapiCopyMem(abytBuf(0), ByVal pBuf, lngLen)
            fStrFromPtr = abytBuf
        Else
            ReDim Preserve abytBuf(UBound(abytBuf) - 1)
            Call sapiCopyMem(abytBuf(0), ByVal pBuf, lngLen)
            fStrFromPtr = StrConv(abytBuf, vbUnicode)
        End If
    End If
End Function
' ******** Code End ********

[locutus33]

Oups oui effectivement ça n'a pas l'air simple.

Je teste ça.

Merci

[locutus33]

Bravo pour le code et la rapidité de la réponse.

Cela fonctionne parfaitement

Encore merci