1、vb 如何获取外网ip
vb 如何获取外网ip代码:
'获取公网IP
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" ( _
ByVal sAgent As String, ByVal lAccessType As Long, _
ByVal sProxyName As String, ByVal sProxyBypass As String, _
ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" ( _
ByVal hInternetSession As Long, ByVal sUrl As String, _
ByVal sHeaders As String, ByVal lHeadersLength As Long, _
ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" ( _
ByVal hFile As Long, ByVal sBuffer As String, _
ByVal lNumBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" ( _
ByVal hInet As Long) As Integer
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Public Function GetSub() As String
Dim wburl$, wburl2$, X1, X2, X3, X4
On Error GoTo err
wburl = "http://www.ip138.com/ip2city.asp"
wburl = GetUrlFile(wburl)
If InStr(1, wburl, "无法找到该页") = 0 Then
X1 = InStr(1, wburl, "[")
X2 = InStr(1, wburl, "]")
X1 = Mid(wburl, X1, X2 - X1)
X1 = Replace(X1, "[", "")
X1 = Replace(X1, " ", "")
X1 = Replace(X1, vbCrLf, "")
GetSub = X1
Exit Function
End If
wburl2 = "http://www.net.cn/static/customercare/yourIP.asp"
wburl2 = GetUrlFile(wburl2)
If InStr(1, wburl2, "无法找到该页") = 0 Then
X3 = InStr(1, wburl2, "<h2>")
X4 = InStr(1, wburl2, "</h2>")
X3 = Mid(wburl2, X3, X4 - X3)
X3 = Replace(X3, "<h2>", "")
X3 = Replace(X3, " ", "")
X3 = Replace(X3, vbCrLf, "")
GetSub = X3
Exit Function
Else
GetSub = "127.0.0.1"
End If
err:
GetSub = "127.0.0.1"
End Function
Private Function GetUrlFile(stUrl As String) As String
Dim lgInternet As Long, lgSession As Long
Dim stBuf As String * 1024
Dim inRes As Integer
Dim lgRet As Long
Dim stTotal As String
stTotal = vbNullString
lgSession = InternetOpen("VBTagEdit", 1, vbNullString, vbNullString, 0)
If lgSession Then
lgInternet = InternetOpenUrl(lgSession, stUrl, vbNullString, _
0, INTERNET_FLAG_NO_CACHE_WRITE, 0)
If lgInternet Then
Do
inRes = InternetReadFile(lgInternet, stBuf, 1024, lgRet)
stTotal = stTotal & Mid$(stBuf, 1, lgRet)
Loop While (lgRet <> 0)
End If
inRes = InternetCloseHandle(lgInternet)
End If
GetUrlFile = stTotal
End Function
使用方法:
在form中调用GetSub就行了。
List1.AddItem ("公网IP:" & GetSub + "..")。
2、VB 根据域名获得IP地址代码的解释
复制内存
3、vb在文本框输入网址,获取网址IP
呵呵
不会API,学嘛
对吧
搜搜 网络!
替你 找了找内!请看容
http://book.77169.org/ask7/ask144762.htm
4、vb中如何获取本机ip地址
定义以下过程即可获取本机ip地址
Sub GetMyIP()5、用VB 6.0怎样获得本机IP地址?
Private Sub Command1_Click()
Dim aa As String
Dim strLocalIP As String
Dim winIP As Object
aa = aa & "本机电脑名称:" & Environ("computername") & vbCrLf
aa = aa & "本机用回户名答称:" & Environ("username") & vbCrLf
Set winIP = CreateObject("MSWinsock.Winsock")
strLocalIP = winIP.localip
MsgBox aa & "本机IP:" & strLocalIP
End Sub
6、关于VB动态IP访问
调用浏览器应该会吧
在label的点击事件里用浏览器浏览"http://" & lblip.caption
不好意思,刚才没用VB试
这回可以了,你用我这个肯定可以了,刚给你写的
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long
Private Sub Label1_Click()
Call ShellExecute(Me.hwnd, "Open", "http://" & Label1.Caption, "", App.Path, 1)
End Sub
7、vb获取外网ip简单一点,最好通过判断网页代码那种来获取
'添加winsock控件
Dim Login_ip_str As String
Private Sub Winsock1_Connect()
Dim Header As String
Login_ip_str = ""
Header = "GET / HTTP/1.1" & vbCrLf
Header = Header & "Accept: */*" & vbCrLf
Header = Header & "Accept-Language: zh-cn,en;q=0.8,de;q=0.6,ar;q=0.4,ru;q=0.2" & vbCrLf
Header = Header & "Accept-Encoding: gzip, deflate" & vbCrLf
Header = Header & "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 2.0.50727)" & vbCrLf
Header = Header & "Host: www.ip.cn" & vbCrLf
Header = Header & "Connection: Keep-Alive" & vbCrLf & vbCrLf
Winsock1.SendData Header
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim str1 As String, i As Integer, j As Integer, tmpStr() As Byte
On Error GoTo aa:
With Winsock1
.GetData tmpStr(), vbByte
str1 = BytesToBstr(tmpStr, "utf-8")
Login_ip_str = Login_ip_str & str1
Debug.Print Login_ip_str
If InStr(Login_ip_str, "</html>") > 0 Then
.Close
i = InStr(Login_ip_str, "当前 IP:<code>") + Len("当前 IP:<code>")
j = InStr(i, Login_ip_str, "</code>")
Login_ip = Mid$(Login_ip_str, i, j - i)
i = InStr(i, Login_ip_str, "来自:") + Len("来自:")
j = InStr(i, Login_ip_str, "</p>")
Login_ip = Login_ip & " " & Mid$(Login_ip_str, i, j - i)
Me.Print Login_ip
End If
End With
Exit Sub
aa:
Winsock1.Close
End Sub
Private Sub Command1_Click()
Winsock1.Close
Winsock1.RemoteHost = "www.ip.cn"
Winsock1.RemotePort = 80
Winsock1.Connect
End Sub
Private Function BytesToBstr(body, Cset)
Dim objstream
Set objstream = CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode = 3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
Set objstream = Nothing
End Function
8、vb修改ip代码
在菜单中的【工程】—【引用】下,添加“Microsoft WMI Scripting V1.1 Library”,然后在Form1窗体上添加1个Combo1、Text1(0)、Text1(1)、Text1(2)、Text1(3)和Command1、Command2,代码如下:
Option Explicit
Dim objSWbemServices As SWbemServices
Dim objSWbemObjectSet As SWbemObjectSet
Dim objSWbemObject As SWbemObject
'Text1(0)为IP地址、Text1(1)为子网掩码、Text1(2)为缺省网关、Text1(3)为DNS
Private Sub Form_Load()
Set objSWbemServices = GetObject("winmgmts:")
Set objSWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")
For Each objSWbemObject In objSWbemObjectSet
Combo1.AddItem objSWbemObject.Description '添加本机上已经安装了TCP/IP协议的网卡
Next
Combo1.Text = Combo1.List(0)
Combo1.ListIndex = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set objSWbemServices = Nothing
Set objSWbemObjectSet = Nothing
Set objSWbemObject = Nothing
End Sub
'当选择了网卡后,显示当前所选网卡的设置
Private Sub Combo1_Click()
Set objSWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where Description='" & Combo1.Text & "'")
For Each objSWbemObject In objSWbemObjectSet
If objSWbemObject.DHCPEnabled Then
Text1(0).Text = ""
Text1(1).Text = ""
Text1(2).Text = ""
If IsNull(objSWbemObject.DNSServerSearchOrder) Then
Text1(3).Text = ""
Else
Text1(3).Text = objSWbemObject.DNSServerSearchOrder(0)
End If
Else
Text1(0).Text = objSWbemObject.IPAddress(0)
Text1(1).Text = objSWbemObject.IPSubnet(0)
Text1(2).Text = objSWbemObject.DefaultIPGateway(0)
Text1(3).Text = objSWbemObject.DNSServerSearchOrder(0)
End If
Next
End Sub
'设置网卡的IP地址、子网掩码、缺省网关和DNS
Private Sub Command1_Click()
Set objSWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where Description='" & Combo1.Text & "'")
For Each objSWbemObject In objSWbemObjectSet
objSWbemObject.EnableStatic Array(Text1(0).Text), Array(Text1(1).Text)
objSWbemObject.SetGateways Array(Text1(2).Text)
objSWbemObject.SetDNSServerSearchOrder Array(Text1(3).Text)
Next
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
9、如何用vb实现读取本地计算机的IP地址??
If InStr(sIP, ".") = 0 Then
GetMACAddress = "Invaild IP Address."
Exit Function
End If
aIP = Split(sIP, ".", -1, vbTextCompare)
If UBound(aIP()) <> 3 Then
GetMACAddress = "Invaild IP Address."
Exit Function
End If
For X = 0 To UBound(aIP())
If Len(aIP(X)) > 3 Then
GetMACAddress = "Invaild IP Address"
Exit Function
End If
If IsNumeric(aIP(X)) = False Then
GetMACAddress = "Invaild IP Address"
Exit Function
End If
If InStr(aIP(X), ",") <> 0 Then
GetMACAddress = "Invaild IP Address"
Exit Function
End If
If CLng(aIP(X)) > 255 Then
GetMACAddress = "Invaild IP Address"
Exit Function
End If
If nIP = "" Then
nIP = String(3 - Len(aIP(X)), "0") & aIP(X)
Else
nIP = nIP & "." & String(3 - Len(aIP(X)), "0") & aIP(X)
End If
Next
sRtn = ""
myNcb.ncb_command = NCBRESET
bRet = Netbios(myNcb)
myNcb.ncb_command = NCBASTAT
myNcb.ncb_lana_num = 0
myNcb.ncb_callname = nIP & Chr(0)
Dim myASTAT As ASTAT, tempASTAT As ASTAT
Dim pASTAT As Long
myNcb.ncb_length = Len(myASTAT)
pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, myNcb.ncb_length)
If pASTAT = 0 Then
GetMACAddress = "memory allcoation failed!"
Exit Function
End If
myNcb.ncb_buffer = pASTAT
bRet = Netbios(myNcb)
If bRet <> 0 Then
GetMACAddress = "Can not get the MAC Address from IP Address: " & sIP
Exit Function
End If
CopyMemory myASTAT, myNcb.ncb_buffer, Len(myASTAT)
Dim sTemp As String
Dim I As Long
For I = 0 To 5
sTemp = Hex(myASTAT.adapt.adapter_address(I))
If I = 0 Then
sRtn = IIf(Len(sTemp) < 2, "0" & sTemp, sTemp)
Else
sRtn = sRtn & Space(1) & IIf(Len(sTemp) < 2, "0" & sTemp, sTemp)
End If
Next
HeapFree GetProcessHeap(), 0, pASTAT
GetMACAddress = sRtn
End Function
Private Sub Command1_Click()
'修改地址即可
MsgBox GetMACAddress("192.168.0.1")
End Sub