|
|
楼主 |
发表于 2005-6-1 00:19
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
|
范例一
*****************************************************************************
Dim CharCnt As Long
Dim lpString As String
Dim tmpstr As String
Dim NullPos As Long
Form1.Caption = "这是一个test"
lpString = String(255, 0) '设定初值
CharCnt = GetWindowText(Me.hwnd, lpString, 256) 'CharCnt = 12
tmpstr = Left(lpString, CharCnt) '如此做会有一些问题
Debug.Print Len(tmpstr) '得12
Label1.Caption = Left(lpString, CharCnt)
Debug.Print Len(Label1.Caption) '得8
*****************************************************************************
以范例一的例子来看，设定lpString= String(255,0)的目的，是设定255个字元的空间
给lpString(加上最後的null一共256)，CharCnt的值是12，明眼者可看到len("这是一个
test") 会是8，但CharCnt是12， 所以直接使用Left()函数来取得子字串会有问题，这
是UniCode与ANSI String间的关系，所以了，当您看到有些书的范例用这种方法取子字
串，是不太完善的，所以改用范例二的方式，比较正确。
范例二
*****************************************************************************
Form1.Caption = "这是一个test"
lpString = String(255, 0) '设定初值
CharCnt = GetWindowText(Me.hwnd, lpString, 256) 'CharCnt = 12
NullPos = InStr(1, lpString, Chr(0), vbBinaryCompare)
tmpstr = Left(lpString, NullPos - 1)
lable1.Caption = tmpstr
*****************************************************************************
四、 Null 值的传递
我们再回到求ProductId的问题，我们已知使用RegOpenKeyEx()来取得subkey的Han dle
值，紧接着便是用RegQueryValueEx()来取值。
-----------------------------------------------------------------------------
LONG RegQueryValueEx(
HKEY hKey, // handle of key to query
LPTSTR lpszValueName, // address of name of value to query
LPDWORD lpdwReserved, // reserved
LPDWORD lpdwType, // address of buffer for value type
LPBYTE lpbData, // address of data buffer
LPDWORD lpcbData // address of data buffer size
);
VB的宣告(由API检视员中Copy下来者)
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
lpType As Long, _
lpData As Any, _
lpcbData As Long) As Long
-----------------------------------------------------------------------------
仔细看一下第三个叁数，WIN API中是LPDWORD可是VB中麽会是用ByVal的方式传递呢？原
因在於 lpReserved一定要传Null进去，VB在呼叫时便在 这叁数的位置上填0(见范例三)。
为何传Null就得这做？我们可以这麽想，我们 在程式中下指令，告诉VB要以 ByVal 的
方式传0出去，而WIN API里，它可不管VB是ByVal或ByRef，API 认定我们传进来的就是
它需要的，所以了，第三个叁数在API中认定我们传进的是一个Address，而VB 传0进去，
那代表API若去取得它的内容，便会取得Address 0 的内容，或许Window的 Null值便是
指向Address 0呢！另一个作法比较直接，将VB宣告的第三个叁数宣告由 ByVal
lpReserved As Long改成 ByVal lpReserved as String而使用时固定传 vbNullString
进去也可以。这里在一个观念，那就是VB对Win API的宣告，纯粹是给VB 自己看的，在
API中定义了一个指标的叁数，Api检视员会将之宣告成ByRef的方式(字串除外)，但我们
可随需要而更动它，一个原始应为ByRef的叁数宣告，我们可以将之改为 ByVal的方式，
只要我们能取得叁数的位址，而将这型态为Long的位址以ByVal传出去， Win API 端根
本不知道VB端是用什麽方式传，反正只要我们传了一Long值进去，Win API 就会以这个
Long值当作是Address来运作。
问题还没有解决，RegQueryValueEx()的第四个叁数lpType若为REG_SZ(= 1)那代表
lpData是Null Terminate的String，若为REG_DWORD ( = 4)那代表lpData是Long值，正
是因为没有办法事先知道lpData的真正型态，所以VB就使用 ASAny的型态，它要VB放弃
型态的检查，传什麽值进去都可以，但是在这里有一些问题，如果lpType是REG_DWORD
那麽lpData以ByRef的方式没有问题，但是如果lpType 是REG_SZ，STRING是要以ByVal
的方式来宣告，所以会有冲突，而解决的方式就是改写API检视员Copy进来的宣告。
-----------------------------------------------------------------------------
Declare Function RegQueryLong Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
lpType As Long, _
lpData As Long, _
lpcbData As Long) As Long
Declare Function RegQueryString Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
lpType As Long, _
Byval lpData As String, _
lpcbData As Long) As Long
-----------------------------------------------------------------------------
使用两个宣告来解决这个问题，依不同的lpType呼叫不同的函式，即lpType=
REG_ DWORD时，呼叫RegQueryLong, lpType = REG_SZ时则为RegQueryString这也可以让
我们了解为何VB API的宣告为什麽要有Alias的存在。
范例三
*****************************************************************************
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) _
As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA"
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegQueryString Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Const REG_EXPAND_SZ = 2
Const HKEY_CLASSES_ROOT = &H80000000
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Const KEY_QUERY_VALUE = &H1
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const SYNCHRONIZE = &H100000
Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And (Not SYNCHRONIZE))
Dim key5 As String, ValueName as String, strBuff as String, ResultStr as String
Dim leng1 As Long, resul As Long, hkey As Long
Dim tp As Long, i As Long
key5 = " SOFTWARE\Microsoft\Windows\CurrentVerson "
resul = RegOpenKeyEx(HKEY_CLASSES_ROOT, key5, 0, KEY_READ, hkey)
'hkey便是subkey (key5)的KeyHandle，先取得它才能存取Subkey内的ValueName
ValueName= "ProDuctId "
tp = REG_SZ
strBuff = String(255, 0)
leng1 = Len(strBuff) + 1
resul = RegQueryString(hkey, ValueName, 0, tp, strBuff, leng1)
'注意，第三个叁数传0，leng1传回copy 到strBuff的字元个数(anci)
leng1 = InStr(1, strBuff, Chr(0), vbBinaryCompare) '重新算个数(UniCode)
ResultStr = Left(StrBuff,leng1-1) '这便是ProductId的值
*****************************************************************************
在这里有另外一件事要特别说明，范例三程式中有一行leng1=Len(strBuffer)+1，这行
可省不得，很奇怪吧，为什麽明明是一个传回值，却一定要设定给它一个strBuff 的大
小呢？这是因为许多WIN API 不会聪明到找strBuff的Null Char在哪里，所以需要程式
传进去，而後它再依这个栏位传回填入strBuff 的数目。
五、Array叁数的传递
我们知道Win API 的阵列传递是传阵列的起始位址，所以了，在VB中唯一要注意的是起
始位置的写法。以另一个取得Window目录所在路径的API为
例： -----------------------------------------------------------------------------
UINT GetWindowsDirectory(
LPTSTR lpBuffer, // address of buffer for Windows directory
UINT uSize // size of directory buffer
); // 若成功，则传回目录的字元数
VB的宣告(API检视员)
Declare Function GetWindowsDirectory Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) _
As Long
我们将之更改为
Declare Function GetWindowsDirectory Lib "kernel32" Alias _
"GetWindowsDirectoryA" ( lpBuffer As Byte, ByVal nSize As Long) As Long
-----------------------------------------------------------------------------
范例四
*****************************************************************************
Dim n as Long
Dim Buff() as Byte
Dim StrA as String
Buff = space(256)
n=GetWindowsDirectory(Buff(0), 256)
Buff = Leftb(Buff, n)
StrA = StrConv(Buff, vbUniCode) 'StrA便是Windows所在目录
*****************************************************************************
在范例四中，GetWindowsDirectory()传入的第一个叁数Buff(0)便是这阵列的起始 Byte
，因VB 宣告成lpBuffer As Byte，故传过去的是ByRef Buff(0)的位址，当然了，你也
可以呼叫成n=GetWindowsDirectory(Buff(1), 256)，只是传回值是填在Buff(1) to
Buff(n)，而Buff(0)则仍为起始的Space Character(32)，因为该API传回值是字元个数
，再加上存於Buff中的是Byte Array故，使用Leftb()去除多出的byte，再用 StrConv将
Byte Array转成Unicode的字串。比照范例二的作法，我们也可以将Byte Array 改成以
String的方式来做，二者可做一比较，谁比较好或比较顺畅，那见人见智，不过可以肯
定的是，如果传的值是Binary的值，那麽使用Byte Array来做才对，因用 String来传的
话，会经过转换成UniCode的步骤，这中间会发生什麽事，没人知道。
六、CallBack Function的作法
VB的使用者通常对於这个名词有着多多少少的疑惑，或称之为"哭爸"Function，而 VB5
使用手册使用Window Procedure来说明，除非对Window 系统有一些了解，否则可能令人
更不知所云；我使用另一个例子来说明，那便是KeyBoard Hook。什麽是KeyBoard Hook
呢，简言之便是按键盘时，便会自动执行某一段Function的功能，就好比Dos时代的拦
截中断向量一般。让我们先看一下设定Hook的宣告吧。
-----------------------------------------------------------------------------
HHOOK SetWindowsHookEx(
int idHook, // type of hook to install
HOOKPROC hkprc, // address of hook procedure
HINSTANCE hMod, // handle of application instance
DWORD dwThreadID // identity of thread to install hook for
);
Declare Function SetWindowsHookEx Lib "user32" Alias SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
-----------------------------------------------------------------------------
Hook有很多种，如KeyBoard Hook, Mouse Hook, JournalRecord Hook等，所以第一个
叁数指明了要哪一种Hook，第二个叁数便是Hook Procedure所在，也就是方才所说 "自
动执行某一段Function的功能"中的那一个Function，这个Function的名称可以随意给定
，但有一定的叁数传递规则，例如：
hnexthookproc = SetWindowsHookEx(WH_KEYBOARD, _
AddressOf MyKBHFunc, App.Hinstance, 0)
如此设定则每当按任一个键时，程式自动会去执行 MyKBHFunc。这个Hook Function 是
由我们所定义，但是它是由Window自动去呼叫，而不是由我们的程式呼叫，这类的
Function就叫CallBack Function。
以上面的例子来说，这个CallBack Function定义如下：
-----------------------------------------------------------------------------
Public Function MyKBHFunc(ByVal iCode As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
MyKBHFunc = 0
If iCode < 0 Then
MyKBHFunc = CallNextHookEx(hnexthookproc, iCode, wParam, lParam)
Exit Function
End If
'侦测 有没有按到PrintScreen键
If wParam = vbKeySnapshot Then
MyKBHFunc = 1
Debug.Print "haha"
End If
End Function
-----------------------------------------------------------------------------
这个KeyBoard Hook Function的目的主要是想拦截有没有按到Print Screen这个键，这
个键不会在Form的KeyDown, KeyPress, KeyUp Event中作用，所以只好透过KeyBoa rd
Hook去拦截。而CallBack Function放的位置有规定，一个是要与呼叫SetWindowsHo
okEx() 的地方在同样的一个Project，另外，它只能存在於.BAS档，不能放在其他地方。
KeyBoard Hook的程式於范五。
范例五
*****************************************************************************
'以下程式於Hook.bas
Declare Function SetWindowsHookEx Lib "user32" Alias _
"SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _
ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public hnexthookproc As Long
Public Const HC_ACTION = 0
Public Const WH_KEYBOARD = 2
Public Sub UnHookKBD()
If hnexthookproc <> 0 Then
UnhookWindowsHookEx hnexthookproc
hnexthookproc = 0
End If
End Sub
Public Function EnableKBDHook()
If hnexthookproc <> 0 Then
Exit Function
End If
hnexthookproc = SetWindowsHookEx(WH_KEYBOARD, AddressOf _
MyKBHFunc, App.Hinstance, 0)
If hnexthookproc <> 0 Then
EnableKBDHook = hnexthookproc
End If
End Function
Public Function MyKBHFunc(ByVal iCode As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
'这三个叁数是固定的，不能动，而MyKBHFunc这个名称只要和
'SetWindowsHookex()中 AddressOf後的名称一样便可，不一定叫什麽
MyKBHFunc = 0
If iCode < 0 Then
MyKBHFunc = CallNextHookEx(hnexthookproc, iCode, wParam, lParam)
Exit Function
End If
If wParam = vbKeySnapshot Then '侦测 有没有按到PrintScreen键
MyKBHFunc = 1
Debug.Print "haha"
End If
End Function
'以下程式於Form
Private Sub Form_Load()
Call EnableKBDHook
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call UnHookKBD
End Sub
***************************************************************************** |
|
楼主: welcpa
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-5-16 21:43
