虚拟主机教程

'第一种是用winsock控件来获得，对于独立主机独立ip接入的还好，但对于局域网或小区宽带中的电脑就取不到正确ip了
Private Sub Command1_Click()
Dim winIP As Object
Set winIP = CreateObject("MSWinsock.Winsock")
MsgBox "本机IP:" & winIP.LocalIP
End Sub
'一般用下面这种方法来取得，原理就是请求一个网页，网页上会返回ip文本，然后读下来。
'为了能引用正则和XMLHTTP，首先在VB中请先引用 Microsoft VBScript Regular Expressions 5.5和Microsoft XML, v6.0<span id="more-1743"></span>

Function GetNetip()   '原理是模拟访问ip138的一个网页，读取网页上显示的ip，再将多余字符去掉。
    'On Error Resume Next
    ipurl = "http://www.ip138.com/ip2city.asp"
    Set xmlhttp = New MSXML2.ServerXMLHTTP
    xmlhttp.setTimeouts 10000, 10000, 10000, 30000
    xmlhttp.Open "GET", ipurl, False
    xmlhttp.send
    ipstr = xmlhttp.responseText & ""
    Set xmlhttp = Nothing
    '得到文本之后还要提取有用部分，我们直接用正则。
    Set oreg = New RegExp
    oreg.Global = True
    oreg.IgnoreCase = True
    oreg.Pattern = "\[(\d+\.\d+\.\d+\.\d+)\]"
    Set matches = oreg.Execute(ipstr)
    For Each match In matches
        GetNetip = match.Submatches(0)
    Next
    Set oreg = Nothing
End Function

'其实我们可以自己写个asp网页，如果你有虚拟主机。asp代码如下。
response.write  getLocalip()
Function getLocalip()
	Dim strIPAddr 
	If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then 
	strIPAddr = Request.ServerVariables("REMOTE_ADDR") 
	ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then 
	strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1) 
	ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then 
	strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1) 
	Else 
	strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR") 
	End If
	getLocalip = Trim(Mid(strIPAddr, 1, 30))
	if not isip(getLocalip) then getLocalip=""
End Function
Function isip(ipstr)
	Dim oreg:Set oreg=New RegExp
	oreg.Pattern="^((25[0-5]|2[0-4]\d|1?\d?\d)\.){3}(25[0-5]|2[0-4]\d|1?\d?\d)$"
	isip=oreg.Test(ipstr)
	Set oreg=Nothing
End Function