Visual Basic編程疑難問題解（一）
2003-02-03 yesky
［前言：］在這個專題中我收集了一些在Visual Basic編程中的常見問題，這些問題均來自論壇，本專題以解決實際問題主要目的。
問：VB中如何使用C++類？
答：把vc的類編譯成dll文件，這樣的話就可以使用，最好是作為組件com來使用。
VB調(diào)用DLL的方法和調(diào)用Windows API的方法是一樣的，一般在VB的書中有介紹。對于上面一個例子，先要聲明VC函數(shù)：
Declare Function sample Lib "mydll.dll" (ByVal nLen As Integer, buffer As Integer) As Integer
這里mydll.dll是你的dll的名字。你可能已經(jīng)注意到了兩個參數(shù)的聲明有所不同，第一個參數(shù)加上了ByVal。規(guī)則是這樣的：如果在VC中某個參數(shù)聲明為指針和數(shù)組，就不加ByVal，否則都要加上ByVal。在VB中調(diào)用這個函數(shù)采用這樣的語法：
sample 10, a(0)
這里的a()數(shù)組是用來存放數(shù)據(jù)的，10為數(shù)組長度，這里的第二個參數(shù)不能是a()，而必須是要傳遞的數(shù)據(jù)中的第一個。這是VB編程的關(guān)鍵。
下面在說幾個可能遇到的問題。一個問題是VB可能報告找不到dll，你可以把dll放到system目錄下，并確保VB的Declare語句正確。另一個問題是VB報告找不到需要的函數(shù)，這通常是因為在VC中*.def文件沒設(shè)置。第三種情況是VB告訴不能進行轉(zhuǎn)換，這可能是在VC中沒有加上__stdcall關(guān)鍵字，也可能是VB和VC的參數(shù)類型不一致，注意在VC中int是4個字節(jié)(相當(dāng)于VB的Long)，而VB的Integer只有2個字節(jié)。必須保證VB和VC的參數(shù)個數(shù)相同，所占字節(jié)數(shù)也一致。最后一個要注意的問題是VC中絕對不能出現(xiàn)數(shù)組越界的情況，否則會導(dǎo)致VB程序崩潰。
問：怎樣用編程方式在窗體上創(chuàng)建一個label或textbox？
答：代碼如下：
‘聲明
Private WithEvents NewButton As ComandButton
‘1,添加
Set NewButton=Controls.Add("VB.CommandButton","cmdNew",Me)
NewButton.Move 0,0,Width,Height
NewButton.Visible=True
‘2，刪除
Controls.Remove NewButton
Set NewButton=Nothing
問：如何把一個已編譯的EXE程序打包到VB中再編譯呢？
答：你需要先編寫一個程序B，并將其編譯為EXE。如果你希望今后允許程序A定制程序B的某個文本框，可以先將該文本框的Caption屬性設(shè)置為“Change Me!Change Me!”之類首先定義好的字符串。然后程序A以二進制方式打開程序B，然后在其中查找“Change Me!Change Me!”字符串，并將其改變?yōu)槌绦駻中設(shè)置的文字。但這種方法有幾個缺點：
1、字符串長度有限；
2、對于VB來說，編譯后有的中文字符串編譯后格式有些辦法，不好處理。
也可以采用另一種辦法。程序A將設(shè)置信息保存在程序B文件的尾部。用程序B以二進制方式打開其自己的EXE文件，利用Seek命令移動到指定位置讀出設(shè)置信息。如：
Dim s As String * 100
On Error GoTo ErrHandler
Open App.Path + "\" + App.EXEName + ".EXE" For Binary As #1
Seek 1, 20480 ‘ 這里是EXE文件的長度
Get 1, , s
Label1.Caption = s
Close #1
Exit Sub
問：如何確定EXE文件的長度的具體數(shù)值呢？
答：先編譯程序B，看看程序B的EXE文件的長度，例如17234。然后將上面的20480改為17234，再編譯一次程序B。
問：關(guān)于程序熱鍵公用問題？
如果兩個程序都用到了相同的熱鍵 比如說ctrl+enter 當(dāng)這2個程序同時運行起來的時候，怎么才能讓只有一個程序接受熱鍵，換句話說就是誰在前臺（前面 激活狀態(tài)）誰就使用這個熱鍵，誰在后臺 或者最小化等非激活狀態(tài) 那么就不使用這個熱鍵！ 怎么能做到呢？
答：代碼如下：
Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 2 Then
If KeyCode = vbKeyReturn Then
Text1.Text = Text2.Text
Text2.Text = ""
End If
End If
End Sub
問：在用二進制binary,寫入一個字串時(比如"你好")后，如何用get讀出來？
答：在VB讀和寫有專用的語法，或者直接使用FSO，如：
open 文件所在路徑 for output as #1
write #1,"你好"
close (1)
‘這是寫文件操作
讀的話類同，用line input讀出來就可以了。
問：怎樣讓Listbox中的滾動條的顏色與Listbox的背景顏色一致？
答：其實要看每個控件是否可以設(shè)置顏色，一般檢查一下控件的backcorlor和forecolor屬性就可以了，有的話，自己設(shè)置吧。
問：怎么讓form時刻處于最上方，formName.show不能做到這一點?
答：代碼如下：
Private 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) As Long
Private Const HWND_TOPMOST = -1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Sub Form_Load()
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, Me.Width, Me.Height, SWP_NOMOVE Or SWP_NOSIZE
End Sub
問：定義在類中的Procedure和Function有什么區(qū)別？ 他們是不是都可以單獨存在?
答：procedure是聲明一個過程,沒有返回值.
function是聲明一個函數(shù),有返回值的.
問：VB中在textbox中查找單個的字符或字符串有什么好方法? 如:
在textbox中查找: 如textbox.text="12345678"查找"78"或"8" 代碼怎么寫?
答：用instr函數(shù)
例:
dim i as integer
text1.text="12345678"
i=instr(text1.text,"78"
i 的值就是在textBox中找到的字符串"78"的第一次出現(xiàn)的位置.
問： 怎樣判斷程序是否在運行，如果運行怎樣關(guān)閉他呢？
答：先用findwindow得到你要查的窗口的hwnd，然后用sendmessge yourform.hwnd,wm_close,0
private button1_click()
dim tmp as long
tmp=findwindow(vbnullstring,"程序的窗口名VB中FORM的NAME屬性值")
if tmp > 0 then
sendmessage tmp,wm_close,0
else
msgbox "Sorry!Don‘t find formname"
end if
end sub
問：如何用vb實現(xiàn)真正的多線程而不是多進程？
答：1.最好把代碼放在Active Dll里，編譯時使用p代碼方式,至少要裝vbsp3以上
2.線程函數(shù)里不能有VB的內(nèi)置函數(shù)，比如left,trim等
3.創(chuàng)建線程CreateThread的參數(shù)不要使用ByVal &0,使用變量
主程序退出時要使用TerminateProcess(GetCurrentProcess, ByVal 0&)強行結(jié)束當(dāng)前進程，否則有可能出錯，這是兩個API函數(shù)，請查相關(guān)資料
問：局域網(wǎng)點對點傳輸，如何數(shù)據(jù)加密？怎樣實現(xiàn)？
答：在text1中輸入你要加密的數(shù)據(jù)（16進制）
將它和4E進行異或
再按就把數(shù)據(jù)還原了
Private Sub Command1_Click()
tmp = Hex(Val("&H" & Text1.Text) Xor Val("&H" & "4E"))
Text1.Text = tmp
End Sub
問：如何實現(xiàn)鼠標(biāo)取詞？
‘所要用到的函數(shù)、常量、類型
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Const WM_GETTEXT = &HD
Private Const WM_SETTEXT = &HC
Private Type POINTAPI
x As Long
y As Long
End Type
Private Sub Form_Load()
End Sub
Private Sub Timer1_Timer()
‘
‘ 代碼就是這么簡單，你好好研究一下吧。
‘
‘
Dim Shu As POINTAPI
Dim Str As String * 300
GetCursorPos Shu
SendMessage WindowFromPoint(Shu.x, Shu.y), WM_GETTEXT, 299, ByVal Str
Label1.Caption = Str
End Sub
根據(jù)代碼加入相應(yīng)控件，timer1的interval的屬性為100再加入把當(dāng)前窗口置頂就是一個完美的簡單的取詞工具了！
問：VB調(diào)DLL時，如何傳Structure？
答：在DLL里定義時應(yīng)該用指針作參數(shù)，在VB里面，只要把結(jié)構(gòu)變量定義成 Long 類型就可以了，調(diào)用的時候傳入地址，就是在調(diào)用的時候，在參數(shù)前面加 ByVal。
問：如何可以在VB中實現(xiàn)對整個系統(tǒng)鼠標(biāo)和鍵盤的屏蔽
答：我們常見一些導(dǎo)覽系統(tǒng)或教學(xué)系統(tǒng)，會自動移動Mouse與Keyin字，而那個時候，我們不管Keyin或動Mouse都沒有效，直到完成了導(dǎo)覽系統(tǒng)的某個動作後才讓使用者可以移動Mouse與做Keyin的動作；想做到這個，要借重JournalPlayBack Hook。
JournalPlayBack Hook，它和JournalRecord Hook合稱Journal Hook，它們作用范圍是整個System，也就是掛上這個Hook後，影響的層面不單是這個Process，而是有的Process，而這兩Hook又不用寫在Dll之中，所以很好用。
首先我們要知道由鍵盤和Mouse輸入等的硬體訊息，會存到一個System Queue而後OS會該System Queue看有沒有訊息在其中，若有則擷取出來，看目前Active的Window是誰將訊息Post給它。而掛上JournalRecord Hook時，當(dāng)有訊息被擷取出來時，會先執(zhí)行他們所設(shè)定的Hook Function(在vb中，一定要放在.BAS檔之中)。這可以做什麼事呢？
例如我們可以Check整個系統(tǒng)是否有按了鍵盤或有沒有移動Mouse(一般來說，KeyUp,KeyDown, MouseMove等Event只有Form在Active 時才收得到，掛上JournalRecord hook後，執(zhí)行Hook的thread便能收到所有這些訊息)。再如，它既然能收到Keyboard、Mouse的訊息，那便可以將收到的訊息記錄起來(記錄於Memory或Disk都可以)，之後再依方才的順序重新將訊息放送出來，可重新執(zhí)行方才的動作(這不就是巨集的作法嗎)，或許它叫JournalRecord便是這個原因。再來便是播放記錄訊息的問題了，如果一面播放，一面有其他訊息插隊(如移動Mouse)，那就不對了，所以JournalPlayBack這個Hook它會讓Mouse、Keyboard都失效，當(dāng)OS 要求讀System Queue時，便會啟動這個Hook，就在此時，我們可以把方才記錄起來的訊息丟出一個出來，OS再要求讀System Queue時，再丟下一個訊息，如此達重播的效果(所以才叫JournalPlayBack)，正因它會讓鍵盤、Mouse失效，拿它來做導(dǎo)覽、教學(xué)系統(tǒng)的自動Move Mouse或文字顯示是最適合的了。
Mouse的自動導(dǎo)引系統(tǒng)制作方式，可叁考如何自動移動Mouse
‘以下在.Bas中
Declare Sub Sleep Lib "KERNEL32" (ByVal dwMilliseconds As Long)
Const WM_MOUSELAST = &H209
Const WM_MOUSEFIRST = &H200
Public Const WM_KEYLAST = &H108
Public Const WM_KEYFIRST = &H100
Public Const WH_JOURNALRECORD = 0
Public Const WH_JOURNALPLAYBACK = 1
Type EVENTMSG
message As Long
paramL As Long
paramH As Long
time As Long
hwnd As Long
End Type
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 hNxtHook As Long ‘ handle of Hook Procedure
Public msg As EVENTMSG
Sub EnableHook()
hNxtHook = SetWindowsHookEx(WH_JOURNALPLAYBACK, AddressOf HookProc, App.hInstance, 0)
End Sub
Sub FreeHook()
Dim ret As Long
ret = UnhookWindowsHookEx(hNxtHook)
End Sub
Function HookProc(ByVal code As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
HookProc = CallNextHookEx(hNxtHook, code, wParam, lParam)
End Function
‘以下在Form中，需求:一個Command1, 一個text1
Private Sub Command1_Click()
Dim str5 As String, len5 As Long, i As Long
Call EnableHook
str5 = "這是一個測試JournalPlayBackHook的程式"
len5 = Len(str5)
For i = 1 To len5
Text1.Text = Mid(str5, 1, i)
Text1.Refresh
Sleep (200)
Next
Call FreeHook
End Sub
問：如何把picture控件中圖形數(shù)據(jù)寫成“流”？
答：可以使用adodb.stream對象。
上傳圖片或顯示SWF的時候都希望得到它的高度和寬度，基本原理使用Adodb.Stream讀二進制文件然后進行解析，然后返回一數(shù)組：
第一個元素為類型(BMP JPG PNG GIF SWF)
第二個元素為寬度{width}
第三個元素為高度{height}
第四個元素為width={width},height={height}式字符串
Class qswhImg
dim aso
Private Sub Class_Initialize
set aso=CreateObject("Adodb.Stream")
aso.Mode=3
aso.Type=1
aso.Open
End Sub
Private Sub Class_Terminate
set aso=nothing
End Sub
Private Function Bin2Str(Bin)
Dim I, Str
For I=1 to LenB(Bin)
clow=MidB(Bin,I,1)
if ASCB(clow)<128 then
Str = Str & Chr(ASCB(clow))
else
I=I+1
if I <= LenB(Bin) then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow))
end if
Next
Bin2Str = Str
End Function
Private Function Num2Str(num,base,lens)
‘qiushuiwuhen (2002-8-12)
dim ret
ret = ""
while(num>=base)
ret = (num mod base) & ret
num = (num - num mod base)/base
wend
Num2Str = right(string(lens,"0") & num & ret,lens)
End Function
Private Function Str2Num(str,base)
‘qiushuiwuhen (2002-8-12)
dim ret
ret = 0
for i=1 to len(str)
ret = ret *base + cint(mid(str,i,1))
next
Str2Num=ret
End Function
Private Function BinVal(bin)
‘qiushuiwuhen (2002-8-12)
dim ret
ret = 0
for i = lenb(bin) to 1 step -1
ret = ret *256 + ascb(midb(bin,i,1))
next
BinVal=ret
End Function
Private Function BinVal2(bin)
‘qiushuiwuhen (2002-8-12)
dim ret
ret = 0
for i = 1 to lenb(bin)
ret = ret *256 + ascb(midb(bin,i,1))
next
BinVal2=ret
End Function
Function getImageSize(filespec)
‘qiushuiwuhen (2002-9-3)
dim ret(3)
aso.LoadFromFile(filespec)
bFlag=aso.read(3)
select case hex(binVal(bFlag))
case "4E5089":
aso.read(15)
ret(0)="PNG"
ret(1)=BinVal2(aso.read(2))
aso.read(2)
ret(2)=BinVal2(aso.read(2))
case "464947":
aso.read(3)
ret(0)="GIF"
ret(1)=BinVal(aso.read(2))
ret(2)=BinVal(aso.read(2))
case "535746":
aso.read(5)
binData=aso.Read(1)
sConv=Num2Str(ascb(binData),2 ,8)
nBits=Str2Num(left(sConv,5),2)
sConv=mid(sConv,6)
while(len(sConv)
使用范例（讀某目錄下所有圖片的寬度）：
set qswh=new qswhImg
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(server.mappath("."))
Set fc = f.Files
For Each f1 in fc
ext=fso.GetExtensionName(f1.path)
select case ext
case "gif","bmp","jpg","png":
arr=qswh.getImageSize(f1.path)
response.write "
" & arr(0) & " " & arr(3) & ":" & f1.name & " width:" & arr(1) & " height:" & arr(2)
case "swf"
arr=qswh.getimagesize(f1.path)
response.write "
" & arr(0) & " " & arr(3) & ":" & f1.name & " width:" & arr(1) & " height:" & arr(2)
end select
Next
Set fc=nothing
Set f=nothing
Set fso=nothing
Set qswh=nothing
