最近写了个小东西,就是利用API类似PING的把得到的数值放到ACCESS中,可是程序运行中,XP点关机居然没效果,下面是声明的API,里面有些热键之类的
Option ExplicitDeclare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long
Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long'Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Declare Function SetWindowPos& Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Option ExplicitDeclare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long
Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long'Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Declare Function SetWindowPos& Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
解决方案 »
- FreeCommunication 版本 3.6 已经出来了!
- 如何用vb实现,杀死task manager中的进程?
- 圣诞快乐!!!大家谁遇到winsock的以下问题!!不简单呀!给60分!!
- 如何结束調用Shell后﹐產生的 Winoldap ?
- 出来SLEEP外还有能够延时的方法吗?谢谢
- ***讨论,如何在一句SQL语句中操作SQL数据库的一张表和ACCESS数据库中的一张表。说者有分!!!
- 兄弟们,帮帮忙.来着有分!关于硬盘坏簇
- 请问那里有关DCS的详细资料或原代码?
- Listview 请各位高手看一看
- 编译应用程序的问题?
- 错误指向adodc.recordset.movenext提示"无法更新;当前被锁定"
- asp关于sqlserver2000的数据库操作 回滚事务
Public Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As Long
Public Declare Function IcmpSendEcho Lib "icmp.dll" (ByVal IcmpHandle As Long, ByVal DestinationAddress As Long, ByVal RequestData As String, ByVal RequestSize As Integer, ByVal RequestOptions As Long, ReplyBuffer As ICMP_ECHO_REPLY, ByVal ReplySize As Long, ByVal Timeout As Long) As Long
Public Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Public Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
Public Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Public Declare Function gethostname Lib "WSOCK32.DLL" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Public Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal szHost As String) As Long
Public Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)这是PING方面的
Option ExplicitPublic Const IP_STATUS_BASE = 11000
Public Const IP_SUCCESS = 0
Public Const IP_BUF_TOO_SMALL = (11000 + 1)
Public Const IP_DEST_NET_UNREACHABLE = (11000 + 2)
Public Const IP_DEST_HOST_UNREACHABLE = (11000 + 3)
Public Const IP_DEST_PROT_UNREACHABLE = (11000 + 4)
Public Const IP_DEST_PORT_UNREACHABLE = (11000 + 5)
Public Const IP_NO_RESOURCES = (11000 + 6)
Public Const IP_BAD_OPTION = (11000 + 7)
Public Const IP_HW_ERROR = (11000 + 8)
Public Const IP_PACKET_TOO_BIG = (11000 + 9)
Public Const IP_REQ_TIMED_OUT = (11000 + 10)
Public Const IP_BAD_REQ = (11000 + 11)
Public Const IP_BAD_ROUTE = (11000 + 12)
Public Const IP_TTL_EXPIRED_TRANSIT = (11000 + 13)
Public Const IP_TTL_EXPIRED_REASSEM = (11000 + 14)
Public Const IP_PARAM_PROBLEM = (11000 + 15)
Public Const IP_SOURCE_QUENCH = (11000 + 16)
Public Const IP_OPTION_TOO_BIG = (11000 + 17)
Public Const IP_BAD_DESTINATION = (11000 + 18)
Public Const IP_ADDR_DELETED = (11000 + 19)
Public Const IP_SPEC_MTU_CHANGE = (11000 + 20)
Public Const IP_MTU_CHANGE = (11000 + 21)
Public Const IP_UNLOAD = (11000 + 22)
Public Const IP_ADDR_ADDED = (11000 + 23)
Public Const IP_GENERAL_FAILURE = (11000 + 50)
Public Const MAX_IP_STATUS = 11000 + 50
Public Const IP_PENDING = (11000 + 255)
Public Const PING_TIMEOUT = 200
Public Const WS_VERSION_REQD = &H101
Public Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Public Const MIN_SOCKETS_REQD = 1
Public Const SOCKET_ERROR = -1Public Const MAX_WSADescription = 256
Public Const MAX_WSASYSStatus = 128Public Type ICMP_OPTIONS
Ttl As Byte
Tos As Byte
Flags As Byte
OptionsSize As Byte
OptionsData As Long
End TypeDim ICMPOPT As ICMP_OPTIONSPublic Type ICMP_ECHO_REPLY
Address As Long
status As Long
RoundTripTime As Long
DataSize As Integer
Reserved As Integer
DataPointer As Long
Options As ICMP_OPTIONS
Data As String * 250
End TypePublic Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLen As Integer
hAddrList As Long
End TypePublic Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Integer
wMaxUDPDG As Integer
dwVendorInfo As Long
End TypePublic Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
Public Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As Long
Public Declare Function IcmpSendEcho Lib "icmp.dll" (ByVal IcmpHandle As Long, ByVal DestinationAddress As Long, ByVal RequestData As String, ByVal RequestSize As Integer, ByVal RequestOptions As Long, ReplyBuffer As ICMP_ECHO_REPLY, ByVal ReplySize As Long, ByVal Timeout As Long) As Long
Public Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Public Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
Public Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Public Declare Function gethostname Lib "WSOCK32.DLL" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Public Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal szHost As String) As Long
Public Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)Public Function GetStatusCode(status As Long) As String
Dim Msg As String Select Case status
Case IP_SUCCESS: Msg = sysset.yesValuse '"ip success"
Case IP_BUF_TOO_SMALL: Msg = "ip buf too_small"
Case IP_DEST_NET_UNREACHABLE: Msg = "ip dest net unreachable"
Case IP_DEST_HOST_UNREACHABLE: Msg = "ip dest host unreachable"
Case IP_DEST_PROT_UNREACHABLE: Msg = "ip dest prot unreachable"
Case IP_DEST_PORT_UNREACHABLE: Msg = "ip dest port unreachable"
Case IP_NO_RESOURCES: Msg = "ip no resources"
Case IP_BAD_OPTION: Msg = "ip bad option"
Case IP_HW_ERROR: Msg = "ip hw_error"
Case IP_PACKET_TOO_BIG: Msg = "ip packet too_big"
Case IP_REQ_TIMED_OUT: Msg = sysset.noValuse '"ip req timed out"
Case IP_BAD_REQ: Msg = "ip bad req"
Case IP_BAD_ROUTE: Msg = "ip bad route"
Case IP_TTL_EXPIRED_TRANSIT: Msg = "ip ttl expired transit"
Case IP_TTL_EXPIRED_REASSEM: Msg = "ip ttl expired reassem"
Case IP_PARAM_PROBLEM: Msg = "ip param_problem"
Case IP_SOURCE_QUENCH: Msg = "ip source quench"
Case IP_OPTION_TOO_BIG: Msg = "ip option too_big"
Case IP_BAD_DESTINATION: Msg = "错误的IP地址" '"ip bad destination"
Case IP_ADDR_DELETED: Msg = "ip addr deleted"
Case IP_SPEC_MTU_CHANGE: Msg = "ip spec mtu change"
Case IP_MTU_CHANGE: Msg = "ip mtu_change"
Case IP_UNLOAD: Msg = "ip unload"
Case IP_ADDR_ADDED: Msg = "ip addr added"
Case IP_GENERAL_FAILURE: Msg = "ip general failure"
Case IP_PENDING: Msg = "ip pending"
Case PING_TIMEOUT: Msg = "ping timeout"
Case Else: Msg = "unknown msg returned"
End Select
' GetStatusCode = CStr(status) & " [ " & msg & " ]"
GetStatusCode = Msg
End FunctionPublic Function HiByte(ByVal wParam As Integer)
HiByte = wParam \ &H100 And &HFF&
End FunctionPublic Function LoByte(ByVal wParam As Integer)
LoByte = wParam And &HFF&
End Function
Public Function Ping(szAddress As String, ECHO As ICMP_ECHO_REPLY) As Long
Dim hPort As Long
Dim dwAddress As Long
Dim sDataToSend As String
Dim iOpt As Long
sDataToSend = "My Request"
dwAddress = AddressStringToLong(szAddress)
Call SocketsInitialize
hPort = IcmpCreateFile()
If IcmpSendEcho(hPort, _
dwAddress, _
sDataToSend, _
Len(sDataToSend), _
0, _
ECHO, _
Len(ECHO), _
PING_TIMEOUT) Then
'Ping如果成功
'.Status返回0
'.RoundTripTime是Ping完成的时间,单位为Ms
'.Data是返回的数据
'.Address是接受响应的Ip地址
'.DataSize是接受数据.Data的大小
Ping = ECHO.RoundTripTime
Else: Ping = ECHO.status * -1
End If
Call IcmpCloseHandle(hPort)
Call SocketsCleanup
End Function
Function AddressStringToLong(ByVal tmp As String) As Long
'IP地址16进制转换
Dim i As Integer
Dim parts(1 To 4) As String
i = 0
While InStr(tmp, ".") > 0
i = i + 1
parts(i) = Mid(tmp, 1, InStr(tmp, ".") - 1)
tmp = Mid(tmp, InStr(tmp, ".") + 1)
Wend
i = i + 1
parts(i) = tmp
If i <> 4 Then
AddressStringToLong = 0
Exit Function
End If
AddressStringToLong = Val("&H" & Right("00" & Hex(parts(4)), 2) & _
Right("00" & Hex(parts(3)), 2) & _
Right("00" & Hex(parts(2)), 2) & _
Right("00" & Hex(parts(1)), 2))
End FunctionPublic Function SocketsCleanup() As Boolean Dim x As Long
x = WSACleanup()
If x <> 0 Then
MsgBox "Windows Sockets error " & Trim$(str$(x)) & _
" occurred in Cleanup.", vbExclamation
SocketsCleanup = False
Else
SocketsCleanup = True
End If
End FunctionPublic Function SocketsInitialize() As Boolean Dim WSAD As WSADATA
Dim x As Integer
Dim szLoByte As String, szHiByte As String, szBuf As String
x = WSAStartup(WS_VERSION_REQD, WSAD)
If x <> 0 Then
MsgBox "Windows Sockets for 32 bit Windows " & _
"environments is not successfully responding."
SocketsInitialize = False
Exit Function
End If
If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or _
(LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And _
HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
szHiByte = Trim$(str$(HiByte(WSAD.wVersion)))
szLoByte = Trim$(str$(LoByte(WSAD.wVersion)))
szBuf = "Windows Sockets Version " & szLoByte & "." & szHiByte
szBuf = szBuf & " is not supported by Windows " & _
"Sockets for 32 bit Windows environments."
MsgBox szBuf, vbExclamation
SocketsInitialize = False
Exit Function
End If
If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
szBuf = "This application requires a minimum of " & _
Trim$(str$(MIN_SOCKETS_REQD)) & " supported sockets."
MsgBox szBuf, vbExclamation
SocketsInitialize = False
Exit Function
End If
SocketsInitialize = True
End Function
你取消热键部分看看,如果不行再取消拦截窗口消息函数看看,总能发现问题
如果是拦截窗口消息的,那可能是没有处理windows关机消息:这个网上有很多参考
关机消息的拦截 在关机或Logff前信息的拦截 如果我们关机或Logoff时,我们的程序有时会因而无法按正常程序结束,一般我们会在Form的Unload中一段程序结束时要做什么事,但是,如果使用者直接用开始功能菜单的关机,会使UnLoad的部份没有做到,我们现在就想办法来拦截关机(或Logoff)时的信息。 一般来说,关机或Logff后,Windows会传依序送出WM_QUERYENDSESSION的信息给每个Process,如果中间有一个Process不能顺利结束(例如:Word修改后未存档,而出现是否存档,但我们按取消),这时该信息执行的结果会传回False(0),这时Windows也就不再继续送WM_QUERYENDSESSION给下一个Proccess。反之,如果所有的Process都可以顺利结束(也就是每个送出的WM_QUERYENDSESSION都传回True),那才代表以以顺利结束。 不管WM_QUERYENDSESSION最后的结果是可以顺利结束或不能顺利结束,Windows会再送一个WM_ENDSESSION的信息给所有的Process,而wParam的内容便是指出是否可以顺利结束(True菜单可以,False菜单不行,在vb中则CheckwParam = 0 菜单False ,0菜单True),说到这里大概就知道该如何做啦,程序如下:
’以下在Form
Private Sub Form_Load()
Dim ret As Long ’记录原来的Window Procedure的位址
preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
’设定form的window Procedure到wndproc
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf wndproc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim ret As Long
Dim fno As Long ’取消Message的截取,而使之又只送往原来的Window Procedure
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc) ’这里只是要看看用关机的方式结束程序时,会不会执行到这里
fno = FreeFile
Open "c:\tt2" For Append As fno
Print #fno, "ccc" + vbCrLf
Close #fno
End Sub
’以下在.Bas
Option Explicit
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public Const WM_ENDSESSION = &H16
Public Const WM_QUERYENDSESSION = &H11
Public preWinProc As Long
Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_QUERYENDSESSION Then
Debug.Print "QryEnd", wParam, lParam
Else
If Msg = WM_ENDSESSION Then
If wParam 0 Then ’代表将顺利关机或LogOff,这时便得做正常结束程序的操作
Dim fno As Long
Open "c:\ttt" For Output As #1
Print #1, "hahcccc5"
Close #1
End If
End If
End If ’将之送往原来的Window Procedure
wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function
只是不知你是如何调用 的?是不是循环或用timer控件,连续调用引起的