参考http://www.csdn.net/expert/topic/1075/1075169.xml?temp=.7181513
里面有一个GetIP函数。
里面有一个GetIP函数。
解决方案 »
- 能否在当前屏幕全屏
- 急……在线等!关于Adodc5.Recordset.RecordCount的问题!
- 请教高手,数据库插入记录的问题!
- MEDIPLAYER控件实现左右声道功能
- 进销存数据库表如何设计?
- 关于用VB的Printer对象处理自定义纸张的问题 送500分以上
- 请教高手,vb中richtextbox中文字符读的问题!!!
- 对sql父子关系表的遍历问题。大家帮忙啊!!!!
- 不止哪位大侠,可以告诉我,汉字按声母排序的区位码区间?谢谢
- 怎么使使这数据库中的某个动态数据表(如动态库存)在三台电脑上同步?急!急!急!
- 哪里有局域网论坛(BBS)的免费源代码,200分送上。谢谢
- 请问*.dat这是什么文件.
例如象求计算机名
声明过程:
Public Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
调用方法:
Dl& = GetComputerName(ComputerName, ComputerLen)
Private Const WS_VERSION_REQD = &H101
Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1
Private Const SOCKET_ERROR = -1
Private Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128Private Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End TypePrivate 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 TypePrivate Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired&, lpWSAData As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal hostname$) As Long
Private 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 FunctionSub SocketsInitialize()
Dim WSAD As WSADATA
Dim iReturn As Integer
Dim sLowByte As String, sHighByte As String, sMsg As String
iReturn = WSAStartup(WS_VERSION_REQD, WSAD)
If iReturn <> 0 Then
MsgBox "Winsock.dll is not responding."
End
End If
If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
sHighByte = Trim$(Str$(hibyte(WSAD.wversion)))
sLowByte = Trim$(Str$(lobyte(WSAD.wversion)))
sMsg = "Windows Sockets version " & sLowByte & "." & sHighByte
sMsg = sMsg & " is not supported by winsock.dll "
MsgBox sMsg
End
End If
If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
sMsg = "This application requires a minimum of "
sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
MsgBox sMsg
End
End If
End SubSub SocketsCleanup()
Dim lReturn As Long
lReturn = WSACleanup()
If lReturn <> 0 Then
MsgBox "Socket error " & Trim$(Str$(lReturn)) & " occurred in Cleanup "
End
End If
End SubSub Form_Load()
SocketsInitialize
End SubPrivate Sub Form_Unload(Cancel As Integer)
SocketsCleanup
End SubPrivate Sub Command1_click()
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
hostent_addr = gethostbyname(Text1)
If hostent_addr = 0 Then
MsgBox "Can't resolve name."
Exit Sub
End If
RtlMoveMemory host, hostent_addr, LenB(host)
RtlMoveMemory hostip_addr, host.hAddrList, 4
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)
MsgBox ip_address
End Sub
如果你想得到上网时的IP,我到写了一段代码,或许对你帮助
http://www.dapha.net/new/ReadNews.asp?NewsID=158&BigClassName=Visual%20Basic&SmallClassName=其它类别&SpecialID=0
在WIN2000+VB6下通过
Public Function GetIPAddress() As String
Dim sHostName As String * 256
Dim lpHost As Long
Dim HOST As HOSTENT
Dim dwIPAddr As Long
Dim tmpIPAddr() As Byte
Dim i As Integer
Dim sIPAddr As String
If gethostname(sHostName, 256) <> 0 Then
GetIPAddress = ""
MsgBox " 取本机IP地址出错!", vbInformation + vbOKCancel, "严重错误"
Exit Function
End If
sHostName = Trim(sHostName)
lpHost = gethostbyname(sHostName)
If lpHost = 0 Then
GetIPAddress = ""
MsgBox "Windows Sockets are not responding. " & "Unable to successfully get Host Name."
Exit Function
End If
CopyMemoryIP HOST, lpHost, Len(HOST)
CopyMemoryIP dwIPAddr, HOST.hAddrList, 4
ReDim tmpIPAddr(1 To HOST.hLen)
CopyMemoryIP tmpIPAddr(1), dwIPAddr, HOST.hLen
For i = 1 To HOST.hLen
sIPAddr = sIPAddr & tmpIPAddr(i) & "."
Next
GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)
End Function