获得本机IP地址 方法一:利用Winsock控件 winsockip.localip 方法二: Private Const MAX_IP = 255 Private Type IPINFO dwAddr As Long dwIndex As Long dwMask As Long dwBCastAddr As Long dwReasmSize As Long unused1 As Integer unused2 As Integer End Type Private Type MIB_IPADDRTABLE dEntrys As Long mIPInfo(MAX_IP) As IPINFO End Type Private Type IP_Array mBuffer As MIB_IPADDRTABLE BufferLen As Long End Type Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long Dim strIP As String Private Function ConvertAddressToString(longAddr As Long) As String Dim myByte(3) As Byte Dim Cnt As Long CopyMemory myByte(0), longAddr, 4 For Cnt = 0 To 3 ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) + "." Next Cnt ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1) End Function
Public Sub Start() Dim Ret As Long, Tel As Long Dim bBytes() As Byte Dim Listing As MIB_IPADDRTABLE On Error GoTo END1 GetIpAddrTable ByVal 0&, Ret, True If Ret <= 0 Then Exit Sub ReDim bBytes(0 To Ret - 1) As Byte GetIpAddrTable bBytes(0), Ret, False CopyMemory Listing.dEntrys, bBytes(0), 4 strIP = "你机子上有 " & Listing.dEntrys & " 个 IP 地址。" & vbCrLf strIP = strIP & "------------------------------------------------" & vbCrLf & vbCrLf For Tel = 0 To Listing.dEntrys - 1 CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel)) strIP = strIP & "IP 地址 : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr) & vbCrLf Next Exit Sub END1: MsgBox "ERROR" End Sub Private Sub Form_Load() Start MsgBox strIP End Sub
Private Type IPINFO dwAddr As Long dwIndex As Long dwMask As Long dwBCastAddr As Long dwReasmSize As Long unused1 As Integer unused2 As Integer End Type
Private Type MIB_IPADDRTABLE dEntrys As Long mIPInfo(MAX_IP) As IPINFO End Type Private Type IP_Array mBuffer As MIB_IPADDRTABLE BufferLen As Long End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long Dim strIP As StringPrivate Declare Function apiGetComputerName Lib "kernel32" Alias _ "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As LongDeclare Function BlockInput Lib "user32.dll" (ByVal fBlockIt As Long) As Long Public Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long Public Declare Function IsWindowEnabled Lib "user32" (ByVal hwnd As Long) As Long Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long Public TaskBarHwnd As Long Public IstaskBarEnabled As Integer Public TaskBarMenuHwnd As Integer Sub fasttaskswitching(benabled As Boolean) Dim X As Long, bdisabled As Long bdisabled = Not benabled X = SystemParametersInfo(97, bdisabled, CStr(1), 0) End Sub Sub DisEnabledTaskbar() Dim Ewindow As Integer TaskBarHwnd = FindWindow("shell_traywnd", "") If TaskBarHwnd <> 0 Then Ewindow = IsWindowEnabled(TaskBarHwnd) If Ewindow = 1 Then IstaskBarEnabled = EnableWindow(TaskBarHwnd, 0) End If End If End Sub Sub EnabledTaskbar() If IstaskBarEnabled = 0 Then IstaskBarEnabled = EnableWindow(TaskBarHwnd, 1) End If End Sub Function fOSMachineName() As String ' 返回机器名 Dim lngLen As Long, lngX As Long Dim strCompName As String lngLen = 16 strCompName = String$(lngLen, 0) lngX = apiGetComputerName(strCompName, lngLen) If lngX <> 0 Then fOSMachineName = Left$(strCompName, lngLen) Else fOSMachineName = "" End If End Function Private Function ConvertAddressToString(longAddr As Long) As String Dim myByte(3) As Byte Dim Cnt As Long CopyMemory myByte(0), longAddr, 4 For Cnt = 0 To 3 ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) + "." Next Cnt ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1) End Function
Public Sub Start(CBox As ComboBox) Dim Ret As Long, Tel As Long Dim bBytes() As Byte Dim Listing As MIB_IPADDRTABLE On Error GoTo END1 GetIpAddrTable ByVal 0&, Ret, True If Ret <= 0 Then Exit Sub ReDim bBytes(0 To Ret - 1) As Byte GetIpAddrTable bBytes(0), Ret, False CopyMemory Listing.dEntrys, bBytes(0), 4 ' strIP = "你机子上有 " & Listing.dEntrys & " 个 IP 地址。" & vbCrLf ' strIP = strIP & "------------------------------------------------" & vbCrLf & vbCrLf For Tel = 0 To Listing.dEntrys - 1 CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel)) 'If ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr) <> "127.0.0.1" Then CBox.AddItem ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr) 'End If ' strIP = strIP & "IP 地址 : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr) & vbCrLf ' strIP = strIP & "子网掩码 : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwMask) & vbCrLf ' strIP = strIP & "广播地址 : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwBCastAddr) & vbCrLf ' strIP = strIP & "------------------------------------------------" & vbCrLf Next Exit Sub END1: MsgBox "ERROR" End Sub Public Function IP3(IPs As String) As String '返回IP地址前三位 Dim s As String, C As String Dim i As Integer, DonetC As Integer '记录小数点数目 For i = 1 To Len(IPs) C = Mid(IPs, i, 1) If DonetC = 3 Then Exit For If C = "." Then DonetC = DonetC + 1 s = s & C Next IP3 = s End FunctionPublic Function IP4(IPs As String) As String '返回IP地址第4位 Dim s As String, C As String Dim i As Integer, DonetC As Integer '记录小数点数目 For i = 1 To Len(IPs) C = Mid(IPs, i, 1) If C = "." Then DonetC = DonetC + 1 If DonetC = 3 Then s = s & C End If Next IP4 = Mid(s, 2, Len(s)) End FunctionPublic Function IsIp(IPs As String) As Boolean '判断IP地址是合法 Dim s As String, C As String Dim i As Integer, DonetC As Integer '记录小数点数目
IpIsLow = True '是合法IP地址 For i = 1 To Len(s)
C = Mid(IPs, i, 1)
If C = "." Then DonetC = DonetC + 1 If Not IsNumeric(s) Then IpIsLow = False
Exit Function ElseIf CInt(s) < 0 Or CInt(s) > 255 Then IpIsLow = False
方法一:利用Winsock控件
winsockip.localip
方法二:
Private Const MAX_IP = 255
Private Type IPINFO
dwAddr As Long
dwIndex As Long
dwMask As Long
dwBCastAddr As Long
dwReasmSize As Long
unused1 As Integer
unused2 As Integer
End Type
Private Type MIB_IPADDRTABLE
dEntrys As Long
mIPInfo(MAX_IP) As IPINFO
End Type
Private Type IP_Array
mBuffer As MIB_IPADDRTABLE
BufferLen As Long
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long
Dim strIP As String
Private Function ConvertAddressToString(longAddr As Long) As String
Dim myByte(3) As Byte
Dim Cnt As Long
CopyMemory myByte(0), longAddr, 4
For Cnt = 0 To 3
ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) + "."
Next Cnt
ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
End Function
Public Sub Start()
Dim Ret As Long, Tel As Long
Dim bBytes() As Byte
Dim Listing As MIB_IPADDRTABLE
On Error GoTo END1
GetIpAddrTable ByVal 0&, Ret, True
If Ret <= 0 Then Exit Sub
ReDim bBytes(0 To Ret - 1) As Byte
GetIpAddrTable bBytes(0), Ret, False
CopyMemory Listing.dEntrys, bBytes(0), 4
strIP = "你机子上有 " & Listing.dEntrys & " 个 IP 地址。" & vbCrLf
strIP = strIP & "------------------------------------------------" & vbCrLf & vbCrLf
For Tel = 0 To Listing.dEntrys - 1
CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel))
strIP = strIP & "IP 地址 : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr) & vbCrLf
Next
Exit Sub
END1:
MsgBox "ERROR"
End Sub
Private Sub Form_Load()
Start
MsgBox strIP
End Sub
或ip138之類的入手,
因為我至少也是個差不多的程序員了..這個我是懂的,
問題是我這里不可上WEB,但確實是上網了,因為只開通了SQL服務,別的都關了..
除了1433開放,別的都通過硬件防火牆鎖了(工作上的需求,以免小人工作偷著上網.
Private Const MAX_IP = 255
Private Type IPINFO
dwAddr As Long
dwIndex As Long
dwMask As Long
dwBCastAddr As Long
dwReasmSize As Long
unused1 As Integer
unused2 As Integer
End Type
Private Type MIB_IPADDRTABLE
dEntrys As Long
mIPInfo(MAX_IP) As IPINFO
End Type
Private Type IP_Array
mBuffer As MIB_IPADDRTABLE
BufferLen As Long
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long
Dim strIP As StringPrivate Declare Function apiGetComputerName Lib "kernel32" Alias _
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As LongDeclare Function BlockInput Lib "user32.dll" (ByVal fBlockIt As Long) As Long
Public Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
Public Declare Function IsWindowEnabled Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Public TaskBarHwnd As Long
Public IstaskBarEnabled As Integer
Public TaskBarMenuHwnd As Integer
Sub fasttaskswitching(benabled As Boolean)
Dim X As Long, bdisabled As Long
bdisabled = Not benabled
X = SystemParametersInfo(97, bdisabled, CStr(1), 0)
End Sub
Sub DisEnabledTaskbar()
Dim Ewindow As Integer
TaskBarHwnd = FindWindow("shell_traywnd", "")
If TaskBarHwnd <> 0 Then
Ewindow = IsWindowEnabled(TaskBarHwnd)
If Ewindow = 1 Then
IstaskBarEnabled = EnableWindow(TaskBarHwnd, 0)
End If
End If
End Sub
Sub EnabledTaskbar()
If IstaskBarEnabled = 0 Then
IstaskBarEnabled = EnableWindow(TaskBarHwnd, 1)
End If
End Sub
Function fOSMachineName() As String ' 返回机器名
Dim lngLen As Long, lngX As Long
Dim strCompName As String
lngLen = 16
strCompName = String$(lngLen, 0)
lngX = apiGetComputerName(strCompName, lngLen)
If lngX <> 0 Then
fOSMachineName = Left$(strCompName, lngLen)
Else
fOSMachineName = ""
End If
End Function Private Function ConvertAddressToString(longAddr As Long) As String
Dim myByte(3) As Byte
Dim Cnt As Long
CopyMemory myByte(0), longAddr, 4
For Cnt = 0 To 3
ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) + "."
Next Cnt
ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
End Function
Public Sub Start(CBox As ComboBox)
Dim Ret As Long, Tel As Long
Dim bBytes() As Byte
Dim Listing As MIB_IPADDRTABLE
On Error GoTo END1
GetIpAddrTable ByVal 0&, Ret, True
If Ret <= 0 Then Exit Sub
ReDim bBytes(0 To Ret - 1) As Byte
GetIpAddrTable bBytes(0), Ret, False
CopyMemory Listing.dEntrys, bBytes(0), 4
' strIP = "你机子上有 " & Listing.dEntrys & " 个 IP 地址。" & vbCrLf
' strIP = strIP & "------------------------------------------------" & vbCrLf & vbCrLf
For Tel = 0 To Listing.dEntrys - 1
CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel))
'If ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr) <> "127.0.0.1" Then
CBox.AddItem ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr)
'End If
' strIP = strIP & "IP 地址 : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr) & vbCrLf
' strIP = strIP & "子网掩码 : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwMask) & vbCrLf
' strIP = strIP & "广播地址 : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwBCastAddr) & vbCrLf
' strIP = strIP & "------------------------------------------------" & vbCrLf
Next
Exit Sub
END1:
MsgBox "ERROR"
End Sub Public Function IP3(IPs As String) As String '返回IP地址前三位
Dim s As String, C As String
Dim i As Integer, DonetC As Integer '记录小数点数目
For i = 1 To Len(IPs)
C = Mid(IPs, i, 1)
If DonetC = 3 Then Exit For
If C = "." Then DonetC = DonetC + 1
s = s & C
Next
IP3 = s
End FunctionPublic Function IP4(IPs As String) As String '返回IP地址第4位
Dim s As String, C As String
Dim i As Integer, DonetC As Integer '记录小数点数目
For i = 1 To Len(IPs)
C = Mid(IPs, i, 1)
If C = "." Then DonetC = DonetC + 1
If DonetC = 3 Then
s = s & C
End If
Next
IP4 = Mid(s, 2, Len(s))
End FunctionPublic Function IsIp(IPs As String) As Boolean '判断IP地址是合法
Dim s As String, C As String
Dim i As Integer, DonetC As Integer '记录小数点数目
IpIsLow = True '是合法IP地址 For i = 1 To Len(s)
C = Mid(IPs, i, 1)
If C = "." Then
DonetC = DonetC + 1
If Not IsNumeric(s) Then
IpIsLow = False
Exit Function
ElseIf CInt(s) < 0 Or CInt(s) > 255 Then
IpIsLow = False
Exit Function
End If
s = ""
Else
s = s & C
End If
Next
If DonetC <> 3 Then
IpIsLow = False
Exit Function
End If
End Function
您的答案很好,但只是对于拨号上网的主机有用,对于代理客户端或硬拨号共享上网是获取不到的其实这个问题可以请都下网域科技的技术人员。他们不懂就表示全中国没人会!