我看到好多取外网IP的都要借助一个外网服务器才能取到,问下各位高人除了借助外网服务器外还有没有更好的办法。多谢了!!!
解决方案 »
- VB树型结构问题
- 数据库动态更新问题!
- 寻工具条按钮:添加、编辑、删除、刷新、查找、过滤 图标
- 有什么方法讓combo或datacombo組合框彈出的下拉菜單中包含兩列?
- 请问谁用过vbaccelerator里的控件?
- datareport "datafield'(empty)'not found"报错
- MSHFlexGrid背景颜色的问题,请各位大侠助帮帮忙,100分送上!!!不够再加!谢谢!
- 做个广告-----程序太平洋诚聘版主
- 控件不如代码好用。
- 我把Form1.BorderStyle 设为 0,那我应如何使我的程序在最小化是在任务栏中的像是按钮的东东中加多显示一个图标?我指的不是系统托盘呀!
- 如何把数据转换后再输出?
- 修改sql命令,高手速进!
Public Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Public Const MIN_SOCKETS_REQD = 1
Public Const SOCKET_ERROR = -1
Public Const WSADescription_Len = 256
Public Const WSASYS_Status_Len = 128Public Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End TypePublic Type WSADATA
wversion As Integer
wHighVersion As Integer
szDescription(0 To WSADescription_Len) As Byte
szSystemStatus(0 To WSASYS_Status_Len) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpszVendorInfo As Long
End TypePublic Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Public Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired&, lpWSAData As WSADATA) As Long
Public Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Public Declare Function gethostname Lib "WSOCK32.DLL" (ByVal hostname$, ByVal HostLen As Long) As Long
Public Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal hostname$) As Long
Public Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)Function hibyte(ByVal wParam As Integer)
hibyte = wParam \ &H100 And &HFF&
End FunctionFunction lobyte(ByVal wParam As Integer)
lobyte = wParam And &HFF&
End FunctionPublic Function CurrentIP(ReturnExternalIP As Boolean)
Dim hostname As String * 256
Dim hostent_addr As Long
Dim host As HOSTENT
Dim hostip_addr As Long
Dim temp_ip_address() As Byte
Dim i As Integer
Dim ip_address As String
Dim IP As String If gethostname(hostname, 256) = SOCKET_ERROR Then
MsgBox "Windows Socket Error " & Str(WSAGetLastError())
Exit Function
Else
hostname = Trim$(hostname)
End If
hostent_addr = gethostbyname(hostname)
If hostent_addr = 0 Then
MsgBox "Winsock.dll error."
Exit Function
End If
RtlMoveMemory host, hostent_addr, LenB(host)
RtlMoveMemory hostip_addr, host.hAddrList, 4
Do
ReDim temp_ip_address(1 To host.hLength)
RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength
For i = 1 To host.hLength
ip_address = ip_address & temp_ip_address(i) & "."
Next
ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
internal = TheIP ' Send ONLY the External IP to the CurrentIP Function
external = ip_address ' Send the External IP to the function parameter External
TheIP = ip_address ' Send LAN IP to the function para Internal
ip_address = ""
host.hAddrList = host.hAddrList + LenB(host.hAddrList)
RtlMoveMemory hostip_addr, host.hAddrList, 4
Loop While (hostip_addr <> 0)
CurrentIP = IIf(ReturnExternalIP, external, internal)
End FunctionSub SocketsCleanup()
Dim lReturn As Long
lReturn = WSACleanup() If lReturn <> 0 Then
MsgBox "Socket Error " & Trim$(Str$(lReturn)) & " occurred In Cleanup "
End
End If
End Sub
使用方法:
Private Sub Command1_Click()
MsgBox CurrentIP(False)
MsgBox CurrentIP(True)
End Sub
TO 楼主 也许只有一楼你自己提到的方法才适合你。