會員登錄 - 用戶注冊 - 網站地圖 Office中國(office-cn.net),專業(yè)Office論壇
當前位置:主頁 > 技巧 > Access技巧 > API > 正文

Access獲取電腦名及IP

時間:2005-08-16 11:36 來源:未知 作者:共享 閱讀:
'用法:
'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

(責任編輯:admin)

頂一下
(0)
0%
踩一下
(0)
0%
發(fā)表評論
請自覺遵守互聯網相關的政策法規(guī),嚴禁發(fā)布色情、暴力、反動的言論。
評價: