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