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