Visual Basic編程疑難問(wèn)題解（一）
2003-02-03 yesky
［前言：］在這個(gè)專(zhuān)題中我收集了一些在Visual Basic編程中的常見(jiàn)問(wèn)題，這些問(wèn)題均來(lái)自論壇，本專(zhuān)題以解決實(shí)際問(wèn)題主要目的。
問(wèn)：VB中如何使用C++類(lèi)？
答：把vc的類(lèi)編譯成dll文件，這樣的話(huà)就可以使用，最好是作為組件com來(lái)使用。
VB調用DLL的方法和調用Windows API的方法是一樣的，一般在VB的書(shū)中有介紹。對于上面一個(gè)例子，先要聲明VC函數：
Declare Function sample Lib "mydll.dll" (ByVal nLen As Integer, buffer As Integer) As Integer
這里mydll.dll是你的dll的名字。你可能已經(jīng)注意到了兩個(gè)參數的聲明有所不同，第一個(gè)參數加上了ByVal。規則是這樣的：如果在VC中某個(gè)參數聲明為指針和數組，就不加ByVal，否則都要加上ByVal。在VB中調用這個(gè)函數采用這樣的語(yǔ)法：
sample 10, a(0)
這里的a()數組是用來(lái)存放數據的，10為數組長(cháng)度，這里的第二個(gè)參數不能是a()，而必須是要傳遞的數據中的第一個(gè)。這是VB編程的關(guān)鍵。
下面在說(shuō)幾個(gè)可能遇到的問(wèn)題。一個(gè)問(wèn)題是VB可能報告找不到dll，你可以把dll放到system目錄下，并確保VB的Declare語(yǔ)句正確。另一個(gè)問(wèn)題是VB報告找不到需要的函數，這通常是因為在VC中*.def文件沒(méi)設置。第三種情況是VB告訴不能進(jìn)行轉換，這可能是在VC中沒(méi)有加上__stdcall關(guān)鍵字，也可能是VB和VC的參數類(lèi)型不一致，注意在VC中int是4個(gè)字節(相當于VB的Long)，而VB的Integer只有2個(gè)字節。必須保證VB和VC的參數個(gè)數相同，所占字節數也一致。最后一個(gè)要注意的問(wèn)題是VC中絕對不能出現數組越界的情況，否則會(huì )導致VB程序崩潰。
問(wèn)：怎樣用編程方式在窗體上創(chuàng )建一個(gè)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
問(wèn)：如何把一個(gè)已編譯的EXE程序打包到VB中再編譯呢？
答：你需要先編寫(xiě)一個(gè)程序B，并將其編譯為EXE。如果你希望今后允許程序A定制程序B的某個(gè)文本框，可以先將該文本框的Caption屬性設置為“Change Me!Change Me!”之類(lèi)首先定義好的字符串。然后程序A以二進(jìn)制方式打開(kāi)程序B，然后在其中查找“Change Me!Change Me!”字符串，并將其改變?yōu)槌绦駻中設置的文字。但這種方法有幾個(gè)缺點(diǎn)：
1、字符串長(cháng)度有限；
2、對于VB來(lái)說(shuō)，編譯后有的中文字符串編譯后格式有些辦法，不好處理。
也可以采用另一種辦法。程序A將設置信息保存在程序B文件的尾部。用程序B以二進(jìn)制方式打開(kāi)其自己的EXE文件，利用Seek命令移動(dòng)到指定位置讀出設置信息。如：
Dim s As String * 100
On Error GoTo ErrHandler
Open App.Path + "\" + App.EXEName + ".EXE" For Binary As #1
Seek 1, 20480 ‘ 這里是EXE文件的長(cháng)度
Get 1, , s
Label1.Caption = s
Close #1
Exit Sub
問(wèn)：如何確定EXE文件的長(cháng)度的具體數值呢？
答：先編譯程序B，看看程序B的EXE文件的長(cháng)度，例如17234。然后將上面的20480改為17234，再編譯一次程序B。
問(wèn)：關(guān)于程序熱鍵公用問(wèn)題？
如果兩個(gè)程序都用到了相同的熱鍵 比如說(shuō)ctrl+enter 當這2個(gè)程序同時(shí)運行起來(lái)的時(shí)候，怎么才能讓只有一個(gè)程序接受熱鍵，換句話(huà)說(shuō)就是誰(shuí)在前臺（前面 激活狀態(tài)）誰(shuí)就使用這個(gè)熱鍵，誰(shuí)在后臺 或者最小化等非激活狀態(tài) 那么就不使用這個(gè)熱鍵！ 怎么能做到呢？
答：代碼如下：
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
問(wèn)：在用二進(jìn)制binary,寫(xiě)入一個(gè)字串時(shí)(比如"你好")后，如何用get讀出來(lái)？
答：在VB讀和寫(xiě)有專(zhuān)用的語(yǔ)法，或者直接使用FSO，如：
open 文件所在路徑 for output as #1
write #1,"你好"
close (1)
‘這是寫(xiě)文件操作
讀的話(huà)類(lèi)同，用line input讀出來(lái)就可以了。
問(wèn)：怎樣讓Listbox中的滾動(dòng)條的顏色與Listbox的背景顏色一致？
答：其實(shí)要看每個(gè)控件是否可以設置顏色，一般檢查一下控件的backcorlor和forecolor屬性就可以了，有的話(huà)，自己設置吧。
問(wèn)：怎么讓form時(shí)刻處于最上方，formName.show不能做到這一點(diǎn)?
答：代碼如下：
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
問(wèn)：定義在類(lèi)中的Procedure和Function有什么區別？ 他們是不是都可以單獨存在?
答：procedure是聲明一個(gè)過(guò)程,沒(méi)有返回值.
function是聲明一個(gè)函數,有返回值的.
問(wèn)：VB中在textbox中查找單個(gè)的字符或字符串有什么好方法? 如:
在textbox中查找: 如textbox.text="12345678"查找"78"或"8" 代碼怎么寫(xiě)?
答：用instr函數
例:
dim i as integer
text1.text="12345678"
i=instr(text1.text,"78"
i 的值就是在textBox中找到的字符串"78"的第一次出現的位置.
問(wè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
問(wèn)：如何用vb實(shí)現真正的多線(xiàn)程而不是多進(jìn)程？
答：1.最好把代碼放在A(yíng)ctive Dll里，編譯時(shí)使用p代碼方式,至少要裝vbsp3以上
2.線(xiàn)程函數里不能有VB的內置函數，比如left,trim等
3.創(chuàng )建線(xiàn)程CreateThread的參數不要使用ByVal &0,使用變量
主程序退出時(shí)要使用TerminateProcess(GetCurrentProcess, ByVal 0&)強行結束當前進(jìn)程，否則有可能出錯，這是兩個(gè)API函數，請查相關(guān)資料
問(wèn)：局域網(wǎng)點(diǎn)對點(diǎn)傳輸，如何數據加密？怎樣實(shí)現？
答：在text1中輸入你要加密的數據（16進(jìn)制）
將它和4E進(jìn)行異或
再按就把數據還原了
Private Sub Command1_Click()
tmp = Hex(Val("&H" & Text1.Text) Xor Val("&H" & "4E"))
Text1.Text = tmp
End Sub
問(wèn)：如何實(shí)現鼠標取詞？
‘所要用到的函數、常量、類(lèi)型
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()
‘
‘ 代碼就是這么簡(jiǎn)單，你好好研究一下吧。
‘
‘
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
根據代碼加入相應控件，timer1的interval的屬性為100再加入把當前窗口置頂就是一個(gè)完美的簡(jiǎn)單的取詞工具了！
問(wèn)：VB調DLL時(shí)，如何傳Structure？
答：在DLL里定義時(shí)應該用指針作參數，在VB里面，只要把結構變量定義成 Long 類(lèi)型就可以了，調用的時(shí)候傳入地址，就是在調用的時(shí)候，在參數前面加 ByVal。
問(wèn)：如何可以在VB中實(shí)現對整個(gè)系統鼠標和鍵盤(pán)的屏蔽
答：我們常見(jiàn)一些導覽系統或教學(xué)系統，會(huì )自動(dòng)移動(dòng)Mouse與Keyin字，而那個(gè)時(shí)候，我們不管Keyin或動(dòng)Mouse都沒(méi)有效，直到完成了導覽系統的某個(gè)動(dòng)作後才讓使用者可以移動(dòng)Mouse與做Keyin的動(dòng)作；想做到這個(gè)，要借重JournalPlayBack Hook。
JournalPlayBack Hook，它和JournalRecord Hook合稱(chēng)Journal Hook，它們作用范圍是整個(gè)System，也就是掛上這個(gè)Hook後，影響的層面不單是這個(gè)Process，而是有的Process，而這兩Hook又不用寫(xiě)在Dll之中，所以很好用。
首先我們要知道由鍵盤(pán)和Mouse輸入等的硬體訊息，會(huì )存到一個(gè)System Queue而後OS會(huì )該System Queue看有沒(méi)有訊息在其中，若有則擷取出來(lái)，看目前Active的Window是誰(shuí)將訊息Post給它。而掛上JournalRecord Hook時(shí)，當有訊息被擷取出來(lái)時(shí)，會(huì )先執行他們所設定的Hook Function(在vb中，一定要放在.BAS檔之中)。這可以做什麼事呢？
例如我們可以Check整個(gè)系統是否有按了鍵盤(pán)或有沒(méi)有移動(dòng)Mouse(一般來(lái)說(shuō)，KeyUp,KeyDown, MouseMove等Event只有Form在A(yíng)ctive 時(shí)才收得到，掛上JournalRecord hook後，執行Hook的thread便能收到所有這些訊息)。再如，它既然能收到Keyboard、Mouse的訊息，那便可以將收到的訊息記錄起來(lái)(記錄於Memory或Disk都可以)，之後再依方才的順序重新將訊息放送出來(lái)，可重新執行方才的動(dòng)作(這不就是巨集的作法嗎)，或許它叫JournalRecord便是這個(gè)原因。再來(lái)便是播放記錄訊息的問(wèn)題了，如果一面播放，一面有其他訊息插隊(如移動(dòng)Mouse)，那就不對了，所以JournalPlayBack這個(gè)Hook它會(huì )讓Mouse、Keyboard都失效，當OS 要求讀System Queue時(shí)，便會(huì )啟動(dòng)這個(gè)Hook，就在此時(shí)，我們可以把方才記錄起來(lái)的訊息丟出一個(gè)出來(lái)，OS再要求讀System Queue時(shí)，再丟下一個(gè)訊息，如此達重播的效果(所以才叫JournalPlayBack)，正因它會(huì )讓鍵盤(pán)、Mouse失效，拿它來(lái)做導覽、教學(xué)系統的自動(dòng)Move Mouse或文字顯示是最適合的了。
Mouse的自動(dòng)導引系統制作方式，可叁考如何自動(dòng)移動(dò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中，需求:一個(gè)Command1, 一個(gè)text1
Private Sub Command1_Click()
Dim str5 As String, len5 As Long, i As Long
Call EnableHook
str5 = "這是一個(gè)測試JournalPlayBackHook的程式"
len5 = Len(str5)
For i = 1 To len5
Text1.Text = Mid(str5, 1, i)
Text1.Refresh
Sleep (200)
Next
Call FreeHook
End Sub
問(wèn)：如何把picture控件中圖形數據寫(xiě)成“流”？
答：可以使用adodb.stream對象。
上傳圖片或顯示SWF的時(shí)候都希望得到它的高度和寬度，基本原理使用Adodb.Stream讀二進(jìn)制文件然后進(jìn)行解析，然后返回一數組：
第一個(gè)元素為類(lèi)型(BMP JPG PNG GIF SWF)
第二個(gè)元素為寬度{width}
第三個(gè)元素為高度{height}
第四個(gè)元素為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
