Access獲取電腦名及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
(責任編輯:admin)
- ·API函數詳細解釋
- ·Access從剪切版里復制和粘貼數據
- ·Access利用api實現打開/關閉光驅
- ·應用程序開機自動啟動(注冊表操作技巧
- ·Access VBA 判斷網絡是否連通的多種辦
- ·什么是ADP,了解ADP的優(yōu)缺點
- ·優(yōu)秀產品大全--通用票據打印軟件(新)
- ·[技巧分享]多條Shell語句執(zhí)行導致判斷
- ·在access中可以調用API函數GetFileInfo
- ·Access API集中營--增加臨時使用的字體
- ·API ShellExecute 功能說明及應用示例
- ·在VB中使用API函數(什么是API? )
- ·API實現完美的圖片出現效果(轉)
- ·API 設置調整系統當前時間
- ·如何檢測以及設置鍵盤狀態(tài)
- ·不關閉當前數據庫COPY當前數據庫