Définir l'adresse IP du propriétaire d'un ordi

Bonjour,

Tu copies tout ce qui suit dans un module standard :
Élaboré et publié par Rob Bovet.

Option Explicit

''' *************************************************************************
''' Module Constant Declaractions Follow
''' *************************************************************************
Private Const WSADescription_Len As Long = 256
Private Const WSASYS_Status_Len As Long = 128
Private Const WS_VERSION_REQD As Long = &H101
Private Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD &H100 And &HFF
Private Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF
Private Const MIN_SOCKETS_REQD As Long = 1


''' *************************************************************************
''' Module Type Declaractions Follow
''' *************************************************************************
''' An intermediate type structure required by various API calls to obtain the IP address.
Private Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End Type

''' This type structure is required by the WSAStartup API.
Private Type WSADATA
wVersion As Integer ''' Low byte contains major version, High byte contains minor version.
wHighVersion As Integer
bytDescription(0 To WSADescription_Len) As Byte
bytSystemStatus(0 To WSASYS_Status_Len) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpszVendorInfo As Long
End Type


''' *************************************************************************
''' Module Variable Declarations Follow
''' *************************************************************************
''' It's critical for the Get IP Address procedure to trap for errors, but I
''' didn't want that to distract from the example, so I'm employing a very
''' rudimentary error handling scheme here. This variable is used to pass error
''' messages between procedures.
Public gszErrMsg As String


''' *************************************************************************
''' Module DLL Declarations Follow
''' *************************************************************************
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal Hostname As String) As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, ByRef lpWSAData As
WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Private Declare Sub RtlMoveMemoryAny Lib "kernel32" Alias "RtlMoveMemory" (ByRef hpvDest As Any, ByVal
hpvSource As Long, ByVal cbCopy As Long)
Private Declare Sub RtlMoveMemoryLong Lib "kernel32" Alias "RtlMoveMemory" (ByRef hpvDest As Long, ByVal
hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function GetComputerNameA Lib "kernel32" (ByVal lpBuffer As String, ByRef nSize As Long) As
Long


Public Sub DemoGetIPAddress()

Dim lIndex As Long
Dim szSuccessMsg As String
Dim aszIPAddresses() As String

If bGetIPAddresses(aszIPAddresses) Then
szSuccessMsg = "The IP address(es) assigned to this computer are:" & vbLf
For lIndex = LBound(aszIPAddresses) To UBound(aszIPAddresses)
szSuccessMsg = szSuccessMsg & aszIPAddresses(lIndex)
Next lIndex
MsgBox szSuccessMsg, vbInformation, "Get IP Address Demo"
Else
MsgBox gszErrMsg, vbCritical, "Get IP Address Demo"
End If

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Comments: Returns the IP address(es) assigned to the current computer.
'''
''' Arguments: aszIPArray() [out] An uninitialized string array that will
''' be loaded with all of the IP addresses assigned
''' to the computer this procedure is run on.
'''
''' NOTE: A computer can be assigned multiple IP
''' addresses. If you are sure the target computer
''' has only one IP address, simply use the first
''' element in this array.
'''
''' Returns: Boolean True on success, False on error.
'''
''' Date Developer Action
''' --------------------------------------------------------------------------
''' 05/20/05 Rob Bovey Created
'''
Public Function bGetIPAddresses(ByRef aszIPArray() As String) As Boolean

Dim bytTempBuffer() As Byte
Dim uHost As HOSTENT
Dim lStructPointer As Long
Dim lIPPointer As Long
Dim lNumIPs As Long
Dim lAddress As Long
Dim lOffset As Long
Dim lNumBytes As Long
Dim szHostName As String

On Error GoTo ErrorHandler

If Not bSocketsInitialize() Then Err.Raise 9999

''' Get the current computer name.
szHostName = szGetComputerName()

''' Get the memory location of the HOSTENT type structure.
lStructPointer = 0
lStructPointer = gethostbyname(szHostName)
If lStructPointer = 0 Then Err.Raise 9999, , "Winsock error: " & CStr(WSAGetLastError())

''' Load the HOSTENT type structure variable.
RtlMoveMemoryAny uHost, lStructPointer, LenB(uHost)

''' Get the memory location of the IP address.
RtlMoveMemoryLong lIPPointer, uHost.hAddrList, 4

''' Get the length of the IP Address list.
''' This works experimentally, I'm not sure if this is by accident or by design.
lNumBytes = uHost.hName - lIPPointer ''' It appears like uHost.hName begins at the memory address right
after the last IP list address.
lNumIPs = lNumBytes / 4 ''' Each IP address is 4 bytes long
ReDim bytTempBuffer(1 To lNumBytes)
ReDim aszIPArray(1 To lNumIPs)

''' Load the IP address into our byte buffer.
RtlMoveMemoryAny bytTempBuffer(1), lIPPointer, lNumBytes

lOffset = 0
For lAddress = 1 To lNumIPs
''' Each item in the byte array will be one of the octets in the IP address.
aszIPArray(lAddress) = bytTempBuffer(1 + lOffset) & "." & bytTempBuffer(2 + lOffset) & "." &
bytTempBuffer(3 + lOffset) & "." & bytTempBuffer(4 + lOffset)
lOffset = lOffset + 4
Next lAddress

''' Clean up the Winsock session.
WSACleanup

bGetIPAddresses = True
Exit Function

ErrorHandler:
If Len(gszErrMsg) = 0 Then gszErrMsg = Err.Description
If Err.Number <> 9999 Then gszErrMsg = gszErrMsg & " (bGetIPAddresses)"
bGetIPAddresses = False
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Comments: Initializes the Winsock session. This function must be called
''' before any other Winsock APIs are used.
'''
''' Returns: Boolean True on success, False on error.
'''
''' Date Developer Action
''' --------------------------------------------------------------------------
''' 05/20/05 Rob Bovey Created
'''
Private Function bSocketsInitialize() As Boolean

Dim iVersion As Integer
Dim lReturn As Long
Dim uWinsockDetail As WSADATA

On Error GoTo ErrorHandler

''' Call the Winsock startup API.
lReturn = WSAStartup(WS_VERSION_REQD, uWinsockDetail)
If lReturn <> 0 Then Err.Raise 9999, , "WSAStartup error: " & CStr(lReturn)

iVersion = uWinsockDetail.wVersion

If LowByte(iVersion) < WS_VERSION_MAJOR Or (LowByte(iVersion) = WS_VERSION_MAJOR And HighByte(iVersion) <
WS_VERSION_MINOR) Then
Err.Raise 9999, , "Required sockets version not supported by existing winsock.dll."
ElseIf uWinsockDetail.iMaxSockets < MIN_SOCKETS_REQD Then
Err.Raise 9999, , "Required sockets version not supported by existing winsock.dll."
End If

bSocketsInitialize = True
Exit Function

ErrorHandler:
If Len(gszErrMsg) = 0 Then gszErrMsg = Err.Description
If Err.Number <> 9999 Then gszErrMsg = gszErrMsg & " (bSocketsInitialize)"
''' Clean up the Winsock session.
WSACleanup
bSocketsInitialize = False
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Comments: Returns the NETBIOS name of the current computer.
'''
''' Returns: String The name of the computer, or an empty string on
''' error.
'''
''' Date Developer Action
''' --------------------------------------------------------------------------
''' 05/20/05 Rob Bovey Created
'''
Public Function szGetComputerName() As String

Dim lReturn As Long
Dim lLength As Long
Dim szNameBuffer As String

On Error GoTo ErrorHandler

''' Initialize variables.
lLength = 255
szNameBuffer = String$(lLength, vbNullChar)

''' Call the API function.
lReturn = GetComputerNameA(szNameBuffer, lLength)
If lReturn = 0 Then Err.Raise 9999

''' Strip out and return the computer name.
szGetComputerName = Left$(szNameBuffer, lLength)
Exit Function

ErrorHandler:
gszErrMsg = Err.Description
If Err.Number <> 9999 Then gszErrMsg = gszErrMsg & " (szGetComputerName)"
szGetComputerName = vbNullString
End Function


''' Retrieve the high byte from the specifed integer argument.
Private Function HighByte(ByVal iNum As Integer) As Integer
HighByte = iNum &H100 And &HFF
End Function


''' Retrieve the low byte from the specifed integer argument.
Private Function LowByte(ByVal iNum As Integer) As Integer
LowByte = iNum And &HFF
End Function



MichD
--------------------------------------------------------------
"Fredo P." a écrit dans le message de groupe de discussion : kd1ac3$ovk$1@speranza.aioe.org...

Bonjour
Est ce qqun pourrait m'adapter ce script pour VBA? , j'ai capté cela sur le
Web, j'ai seulement besoin de définir l'IP de l'ordi ou se trouve le
classeur XL.
Si il y a plus simple, ne vous en priver pas.
Set ObjNetWork = WScript.CreateObject("WScript.Network")
strComputer = ObjNetWork.ComputerName

Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\")._
ExecQuery("select * from Win32_PingStatus where address = '" &
strComputer & "'")

For Each objStatus in objPing
If objStatus.Statuscode = 0 Then
WScript.Echo "ProtocolAddress: " & objStatus.ProtocolAddress &vbCrLf&_
"nom: " & objStatus.Address &vbCrLf&_
"status= " &vbTab& objStatus.Statuscode &vbTab& "repond au ping
!"
else
WScript.Echo objStatus.Address &vbCrLf&_
"status= " &vbTab& objStatus.StatusCode &vbTab& "n'a pas
repondu au ping!"
End If
Next

Tu as aussi ceci :

Comme je ne travaille pas en réseau, je ne peux pas tester
explicitement ce que tu veux faire...

'---------------------------------------------
Sub Test()
Dim X As String
strComputer = "."
Set objWMIService = GetObject("winmgmts:\" & _
strComputer & "rootcimv2")
Set colAdapters = objWMIService.ExecQuery _
("SELECT * FROM Win32_NetworkAdapterConfiguration " & _
"WHERE IPEnabled = True")

For Each objadapter In colAdapters
If Not IsNull(objadapter.ipaddress) Then
For i = 0 To UBound(objadapter.ipaddress)
If IsNumeric(Left(objadapter.ipaddress(i), 1)) Then
MsgBox "Adresse IP: " & objadapter.ipaddress(i)
End If
Next
End If
Next
End Sub
'---------------------------------------------

MichD
--------------------------------------------------------------

Tu peux aussi utiliser la commande

IPConfig.exe dans une fenêtre de l'invite de commande
pour obtenir toutes les caractéristiques de la carte réseau
et des adresses IP.

MichD
--------------------------------------------------------------

Merci Denis, c symp.
"MichD" <michdenis@hotmail.com> a écrit dans le message de news:
kd1r58$551$1@speranza.aioe.org...

Tu peux aussi utiliser la commande

IPConfig.exe dans une fenêtre de l'invite de commande
pour obtenir toutes les caractéristiques de la carte réseau
et des adresses IP.

MichD
--------------------------------------------------------------

La 2ème (Test) me convient parfaitement, encore merci

"MichD" <michdenis@hotmail.com> a écrit dans le message de news:
kd1r58$551$1@speranza.aioe.org...

Tu peux aussi utiliser la commande

IPConfig.exe dans une fenêtre de l'invite de commande
pour obtenir toutes les caractéristiques de la carte réseau
et des adresses IP.

MichD
--------------------------------------------------------------