Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Copyright ?1996-2003 VBnet, Randy Birch, All Rights Reserved. ' Some pages may also contain other copyrights by the author. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Distribution: You can freely use this code in your own ' applications, but you may not reproduce ' or publish this code on any web site, ' online service, or distribute as source ' on any media without express permission. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Const MAX_ADAPTER_NAME_LENGTH As Long = 256 Private Const MAX_ADAPTER_DESCRIPTION_LENGTH As Long = 128 Private Const MAX_ADAPTER_ADDRESS_LENGTH As Long = 8 Private Const ERROR_SUCCESS As Long = 0Private Type IP_ADDRESS_STRING IpAddr(0 To 15) As Byte End TypePrivate Type IP_MASK_STRING IpMask(0 To 15) As Byte End TypePrivate Type IP_ADDR_STRING dwNext As Long IpAddress As IP_ADDRESS_STRING IpMask As IP_MASK_STRING dwContext As Long End TypePrivate Type IP_ADAPTER_INFO dwNext As Long ComboIndex As Long 'reserved sAdapterName(0 To (MAX_ADAPTER_NAME_LENGTH + 3)) As Byte sDescription(0 To (MAX_ADAPTER_DESCRIPTION_LENGTH + 3)) As Byte dwAddressLength As Long sIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1)) As Byte dwIndex As Long uType As Long uDhcpEnabled As Long CurrentIpAddress As Long IpAddressList As IP_ADDR_STRING GatewayList As IP_ADDR_STRING DhcpServer As IP_ADDR_STRING bHaveWins As Long PrimaryWinsServer As IP_ADDR_STRING SecondaryWinsServer As IP_ADDR_STRING LeaseObtained As Long LeaseExpires As Long End TypePrivate Declare Function GetAdaptersInfo Lib "iphlpapi.dll" _ (pTcpTable As Any, _ pdwSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" _ (dst As Any, _ src As Any, _ ByVal bcount As Long) Private Sub Command1_Click() 'pass a character to be used as the 'delimiter in the list of returned addresses. ' Text1.Text = LocalIPAddresses("+") End Sub Public Function LocalIPAddresses(ByVal sDelim As String) As String
'api vars Dim cbRequired As Long Dim buff() As Byte Dim Adapter As IP_ADAPTER_INFO Dim AdapterStr As IP_ADDR_STRING
'working vars Dim ptr1 As Long Dim sIPAddr As String Dim sAllAddr As String
Call GetAdaptersInfo(ByVal 0&, cbRequired) If cbRequired > 0 Then
ReDim buff(0 To cbRequired - 1) As Byte
If GetAdaptersInfo(buff(0), cbRequired) = ERROR_SUCCESS Then
'get a pointer to the data stored in buff() ptr1 = VarPtr(buff(0))
'ptr1 is 0 when no more adapters Do While (ptr1 <> 0)
'copy the data from the pointer to the 'first adapter into the IP_ADAPTER_INFO type CopyMemory Adapter, ByVal ptr1, LenB(Adapter)
With Adapter
'the DHCP IP address is in the 'IpAddress.IpAddr member sIPAddr = TrimNull(StrConv(.IpAddressList.IpAddress.IpAddr, vbUnicode)) sAllAddr = sAllAddr & sIPAddr & "+"
'more? ptr1 = .dwNext
End With 'With Adapter
Loop 'Do While (ptr1 <> 0) End If 'If GetAdaptersInfo End If 'If cbRequired > 0 'remove the last comma If Len(sAllAddr) > 0 Then sAllAddr = Left$(sAllAddr, Len(sAllAddr) - 1) End If
'return any string found LocalIPAddresses = sAllAddr
End Function Private Function TrimNull(item As String) Dim pos As Integer
'double check that there is a chr$(0) in the string pos = InStr(item, Chr$(0)) If pos Then TrimNull = Left$(item, pos - 1) Else: TrimNull = item End If
End Function '--end block--'
'取得服务器的IP地址(172段的) tIP = LocalIPAddresses("+") ss() = Split(tIP, "+", -1, vbTextCompare) i1 = UBound(ss(), 1) '取得动态数组的长度(个数) 'i = UBound(s()) - LBound(s()) + 1 For i2 = 0 To i1 '取得172段的IP(多IP的情况) If Left(ss(i2), 3) = "172" Then tIP = ss(i2) End If Next上面是我取得双网卡时提取172段的IP,你根据情况该就是.
Option Explicit Dim fileName As StringPrivate Sub Command1_Click() Dim strString As String, FileNo Dim sVar
If Winsock1.LocalPort = 0 Then strString = "连接端口编号尚未设定!" Else strString = Winsock1.LocalPort End If
Text1.Text = "您的主机名称为:" & Winsock1.LocalHostName & vbCrLf Text1.Text = Text1.Text & "IP 地址为:" & Winsock1.LocalIP & vbCrLf Text1.Text = Text1.Text & "连接端口为:" & strString & vbCrLf Text1.Text = Text1.Text & "通讯协议为:" & IIf(Winsock1.Protocol = 0, "TCP 协议", "UDP 协议") FileNo = FreeFile() Open fileName For Input As #FileNo While Not EOF(FileNo) Line Input #FileNo, sVar Text1.Text = Text1.Text & sVar & vbCrLf Wend Close #FileNoEnd SubPrivate Sub Command2_Click() Unload Me End SubPrivate Sub Form_Load()
fileName = "c:\IPDetail.txt"
Shell "command.com /c ipconfig.exe > " & fileName DoEvents Do While Trim(Dir(fileName)) = "" DoEvents LoopEnd Sub
tIP = LocalIPAddresses("+") ss() = Split(tIP, "+", -1, vbTextCompare) i1 = UBound(ss(), 1) '取得动态数组的长度(个数) 'i = UBound(s()) - LBound(s()) + 1 For i2 = 0 To i1 '取得172段的IP(多IP的情况) If Left(ss(i2), 3) = "172" Then tIP = ss(i2) End If Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ?1996-2003 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const MAX_ADAPTER_NAME_LENGTH As Long = 256
Private Const MAX_ADAPTER_DESCRIPTION_LENGTH As Long = 128
Private Const MAX_ADAPTER_ADDRESS_LENGTH As Long = 8
Private Const ERROR_SUCCESS As Long = 0Private Type IP_ADDRESS_STRING
IpAddr(0 To 15) As Byte
End TypePrivate Type IP_MASK_STRING
IpMask(0 To 15) As Byte
End TypePrivate Type IP_ADDR_STRING
dwNext As Long
IpAddress As IP_ADDRESS_STRING
IpMask As IP_MASK_STRING
dwContext As Long
End TypePrivate Type IP_ADAPTER_INFO
dwNext As Long
ComboIndex As Long 'reserved
sAdapterName(0 To (MAX_ADAPTER_NAME_LENGTH + 3)) As Byte
sDescription(0 To (MAX_ADAPTER_DESCRIPTION_LENGTH + 3)) As Byte
dwAddressLength As Long
sIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1)) As Byte
dwIndex As Long
uType As Long
uDhcpEnabled As Long
CurrentIpAddress As Long
IpAddressList As IP_ADDR_STRING
GatewayList As IP_ADDR_STRING
DhcpServer As IP_ADDR_STRING
bHaveWins As Long
PrimaryWinsServer As IP_ADDR_STRING
SecondaryWinsServer As IP_ADDR_STRING
LeaseObtained As Long
LeaseExpires As Long
End TypePrivate Declare Function GetAdaptersInfo Lib "iphlpapi.dll" _
(pTcpTable As Any, _
pdwSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(dst As Any, _
src As Any, _
ByVal bcount As Long)
Private Sub Command1_Click() 'pass a character to be used as the
'delimiter in the list of returned addresses.
' Text1.Text = LocalIPAddresses("+")
End Sub
Public Function LocalIPAddresses(ByVal sDelim As String) As String
'api vars
Dim cbRequired As Long
Dim buff() As Byte
Dim Adapter As IP_ADAPTER_INFO
Dim AdapterStr As IP_ADDR_STRING
'working vars
Dim ptr1 As Long
Dim sIPAddr As String
Dim sAllAddr As String
Call GetAdaptersInfo(ByVal 0&, cbRequired) If cbRequired > 0 Then
ReDim buff(0 To cbRequired - 1) As Byte
If GetAdaptersInfo(buff(0), cbRequired) = ERROR_SUCCESS Then
'get a pointer to the data stored in buff()
ptr1 = VarPtr(buff(0))
'ptr1 is 0 when no more adapters
Do While (ptr1 <> 0)
'copy the data from the pointer to the
'first adapter into the IP_ADAPTER_INFO type
CopyMemory Adapter, ByVal ptr1, LenB(Adapter)
With Adapter
'the DHCP IP address is in the
'IpAddress.IpAddr member
sIPAddr = TrimNull(StrConv(.IpAddressList.IpAddress.IpAddr, vbUnicode))
sAllAddr = sAllAddr & sIPAddr & "+"
'more?
ptr1 = .dwNext
End With 'With Adapter
Loop 'Do While (ptr1 <> 0) End If 'If GetAdaptersInfo
End If 'If cbRequired > 0 'remove the last comma
If Len(sAllAddr) > 0 Then
sAllAddr = Left$(sAllAddr, Len(sAllAddr) - 1)
End If
'return any string found
LocalIPAddresses = sAllAddr
End Function
Private Function TrimNull(item As String) Dim pos As Integer
'double check that there is a chr$(0) in the string
pos = InStr(item, Chr$(0))
If pos Then
TrimNull = Left$(item, pos - 1)
Else: TrimNull = item
End If
End Function
'--end block--'
tIP = LocalIPAddresses("+")
ss() = Split(tIP, "+", -1, vbTextCompare)
i1 = UBound(ss(), 1) '取得动态数组的长度(个数)
'i = UBound(s()) - LBound(s()) + 1
For i2 = 0 To i1 '取得172段的IP(多IP的情况)
If Left(ss(i2), 3) = "172" Then
tIP = ss(i2)
End If
Next上面是我取得双网卡时提取172段的IP,你根据情况该就是.
Dim fileName As StringPrivate Sub Command1_Click()
Dim strString As String, FileNo
Dim sVar
If Winsock1.LocalPort = 0 Then
strString = "连接端口编号尚未设定!"
Else
strString = Winsock1.LocalPort
End If
Text1.Text = "您的主机名称为:" & Winsock1.LocalHostName & vbCrLf
Text1.Text = Text1.Text & "IP 地址为:" & Winsock1.LocalIP & vbCrLf
Text1.Text = Text1.Text & "连接端口为:" & strString & vbCrLf
Text1.Text = Text1.Text & "通讯协议为:" & IIf(Winsock1.Protocol = 0, "TCP 协议", "UDP 协议") FileNo = FreeFile()
Open fileName For Input As #FileNo
While Not EOF(FileNo)
Line Input #FileNo, sVar
Text1.Text = Text1.Text & sVar & vbCrLf
Wend
Close #FileNoEnd SubPrivate Sub Command2_Click()
Unload Me
End SubPrivate Sub Form_Load()
fileName = "c:\IPDetail.txt"
Shell "command.com /c ipconfig.exe > " & fileName
DoEvents Do While Trim(Dir(fileName)) = ""
DoEvents
LoopEnd Sub
ss() = Split(tIP, "+", -1, vbTextCompare)
i1 = UBound(ss(), 1) '取得动态数组的长度(个数)
'i = UBound(s()) - LBound(s()) + 1
For i2 = 0 To i1 '取得172段的IP(多IP的情况)
If Left(ss(i2), 3) = "172" Then
tIP = ss(i2)
End If
Next