获取电脑名及IP
'用法: '1、把电脑名赋给一个变量:MyComputerName=GetDNName '2、把IP赋给一个变量:MyComputerIP=GetDNIP Public Const WSADESCRIPTION_LEN = 256 Public Const WSASYS_STATUS_LEN = 128 Public Type HOSTENT h_name As Long h_aliases As Long h_addrtype As Integer h_length As Integer h_addr_list As Long End Type Public Type WSADATA wVersion As Long wHighVersion As Long szDescription(0 To WSADESCRIPTION_LEN) As Byte szSystemStatus(0 To WSASYS_STATUS_LEN) As Byte iMaxSockets As Long iMaxUdpDg As Long lpVendorInfo As Long End Type Public Declare Function WSAStartup Lib "WSOCK32.DLL" _ (ByVal wVersionRequested As Long, _ lpWSAData As WSADATA) As Long Public Declare Function WSACleanup Lib "WSOCK32.DLL" _ () As Integer Public Declare Function WSAIsBlocking Lib "WSOCK32.DLL" _ () As Boolean Public Declare Function WSACancelBlockingCall Lib "WSOCK32.DLL" _ () As Integer Public Declare Function GetHostName Lib "WSOCK32.DLL" _ Alias "gethostname" (ByVal name As _ String, ByVal namelen As Integer) As Integer Public Declare Function gethostbyname Lib "WSOCK32.DLL" _ (ByVal name As String) As Long Public Const wVersionRequired = &H101; Public Const wMajorVersion = wVersionRequired \ &H100; And &HFF;& Public Const wMinorVersion = wVersionRequired And &HFF;&
Public Const ERROR_SUCCESS = 0 Declare Sub MoveMemory Lib "kernel32" _ Alias "RtlMoveMemory" _ (pDest As Any, _ ByVal pSource As Any, _ ByVal dwLength As Long) Dim LoByte As Byte Dim HiByte As Byte Dim WSData As WSADATA Public Sub SocketClose() Dim iReturn As Integer If WSAIsBlocking Then WSACancelBlockingCall End If iReturn = WSACleanup() If iReturn <> ERROR_SUCCESS Then MsgBox "Windows Sockets " & CStr(LoByte) & "." & _ CStr(HiByte) & " can not be closed" End If End Sub Public Function SocketStartup() As Integer Dim iReturn As Integer iReturn = WSAStartup(wVersionRequired, WSData) If iReturn <> ERROR_SUCCESS Then MsgBox "Windows Socket can not be started.", vbCritical + vbOKOnly SocketStartup = iReturn Exit Function End If HiByte = (WSData.wVersion And &HFF00;&) \ (&H100;) LoByte = WSData.wVersion And &HFF;& If LoByte < wMajorVersion Or _ (LoByte = wMajorVersion And _ HiByte < wMinorVersion) Then MsgBox "Sockets version " & CStr(LoByte) & "." & CStr(HiByte) _ & " is not supported.", vbCritical + vbOKOnly SocketStartup = -1 Exit Function End If SocketStartup = iReturn End Function Public Function ResolveHostName() As String Dim HostName As String Dim dwLength As Integer dwLength = 256 ' 建立HostName字符串buffer HostName = String(dwLength, Chr(0)) ' 传回本地主机的名称(host name) GetHostName HostName, Len(HostName) ResolveHostName = Left(HostName, (Len(HostName) - 1)) End Function Public Function ResolveIP() As String Dim HostName As String Dim dwLength As Integer Dim RemoteHost As Long Dim lHostEnt As HOSTENT Dim InAddress As Long Dim IPv4(0 To 3) As Byte dwLength = 256 ' 建立HostName字符串buffer HostName = String(dwLength, Chr(0)) ' 传回本地主机的名称(host name) GetHostName HostName, Len(HostName) RemoteHost = gethostbyname(Trim(HostName)) If RemoteHost = 0 Then ResolveIP = "127.0.0.1" Exit Function Else MoveMemory lHostEnt, RemoteHost, LenB(lHostEnt) If lHostEnt.h_addr_list <> 0 Then MoveMemory InAddress, lHostEnt.h_addr_list, lHostEnt.h_length i = 0 Do While InAddress <> 0 MoveMemory IPv4(i), InAddress, lHostEnt.h_length lHostEnt.h_addr_list = lHostEnt.h_addr_list + _ lHostEnt.h_length MoveMemory InAddress, lHostEnt.h_addr_list, _ lHostEnt.h_length i = i + 1 Loop ' 传回IPV4类型的主机IP address ResolveIP = IPv4(0) & "." & IPv4(1) & "." & IPv4(2) & "." & IPv4(3) Else ResolveIP = "127.0.0.1" End If End If End Function Public Function GetDNName() Dim StartupStatus As Integer StartupStatus = SocketStartup() If (StartupStatus <> ERROR_SUCCESS) Then MsgBox "Windows Sockets " & CStr(LoByte) & "." & CStr(HiByte) & " is not available." Else GetDNName = ResolveHostName
SocketClose End If End Function Public Function GetDNIp() Dim StartupStatus As Integer
StartupStatus = SocketStartup() If (StartupStatus <> ERROR_SUCCESS) Then MsgBox "Windows Sockets " & CStr(LoByte) & "." & CStr(HiByte) & " is not available." Else GetDNIp = ResolveIP SocketClose End If End Function
--------------------------------------------------------------------------------
相关文章
剖析 Declare 语句 2004-1-28 15:08:06
了解句柄 2004-1-28 15:03:43
什么是 API? 2004-1-28 15:01:53
对注册表操作技巧-将程序在开机时运行 2003-11-18 9:24:59
officeXP下使用文件对话框的另外一种方法 2003-11-17 8:47:04
真正实现在windows2000下关机的源代码 2003-11-14 8:32:00
获取Windows用户登录名 2003-11-7 8:42:45
获取网卡物理地址 2003-11-7 8:40:48
隐藏Access主窗口之二 2003-11-7 8:34:20
如何让窗体总在最前面? 2003-11-7 8:25:19
如何关闭计算机? 2003-11-7 8:24:43
如何建立简单的超级连接?(ShellExecute) 2003-11-6 20:39:18
如何让窗体的标题条闪烁以引起用户注意? 2003-11-6 20:38:43
怎样找到鼠标指针的XY坐标? 2003-11-6 20:37:33
在程序中如何打开和关闭光驱门? 2003-11-6 20:20:00
怎样使Ctrl-Alt-Delete无效? 2003-11-6 20:19:25
如何移动没有标题栏的窗口? 2003-11-6 20:17:30
延时函数 2003-11-6 20:16:53
让控件自适应屏幕分辨率 2003-10-18 9:58:33
键盘常用代码一览表 2003-10-17 19:54:02
重新定位链接表二步走 2003-10-17 19:00:07
ADO连接数据库字符串大全 2003-10-17 18:40:47
如何确定当前屏幕分辨率 2003-10-14 8:41:00
获取windows安装路径 2003-10-14 8:39:08
将 Microsoft Access 用作 Automation 服务器 2003-10-14 8:37:19
优化Microsoft Access提高速度 2003-10-6 10:31:55
|