王二庆的妻子是谁:Visual Basic编程疑难问题解1

Visual Basic编程疑难问题解（一）
2003-02-03    yesky


［前言：］在这个专题中我收集了一些在Visual Basic编程中的常见问题，这些问题均来自论坛，本专题以解决实际问题主要目的。
问：VB中如何使用C++类？
答：把vc的类编译成dll文件，这样的话就可以使用，最好是作为组件com来使用。
VB调用DLL的方法和调用Windows API的方法是一样的，一般在VB的书中有介绍。对于上面一个例子，先要声明VC函数：
Declare Function sample Lib "mydll.dll" (ByVal nLen As Integer, buffer As Integer) As Integer
这里mydll.dll是你的dll的名字。你可能已经注意到了两个参数的声明有所不同，第一个参数加上了ByVal。规则是这样的：如果在VC中某个参数声明为指针和数组，就不加ByVal，否则都要加上ByVal。在VB中调用这个函数采用这样的语法：
sample 10, a(0)
这里的a()数组是用来存放数据的，10为数组长度，这里的第二个参数不能是a()，而必须是要传递的数据中的第一个。这是VB编程的关键。
下面在说几个可能遇到的问题。一个问题是VB可能报告找不到dll，你可以把dll放到system目录下，并确保VB的Declare语句正确。另一个问题是VB报告找不到需要的函数，这通常是因为在VC中*.def文件没设置。第三种情况是VB告诉不能进行转换，这可能是在VC中没有加上__stdcall关键字，也可能是VB和VC的参数类型不一致，注意在VC中int是4个字节(相当于VB的Long)，而VB的Integer只有2个字节。必须保证VB和VC的参数个数相同，所占字节数也一致。最后一个要注意的问题是VC中绝对不能出现数组越界的情况，否则会导致VB程序崩溃。
问：怎样用编程方式在窗体上创建一个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属性设置为“Change Me!Change Me!”之类首先定义好的字符串。然后程序A以二进制方式打开程序B，然后在其中查找“Change Me!Change Me!”字符串，并将其改变为程序A中设置的文字。但这种方法有几个缺点：
1、字符串长度有限；
2、对于VB来说，编译后有的中文字符串编译后格式有些办法，不好处理。
也可以采用另一种办法。程序A将设置信息保存在程序B文件的尾部。用程序B以二进制方式打开其自己的EXE文件，利用Seek命令移动到指定位置读出设置信息。如：
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文件的长度的具体数值呢？
答：先编译程序B，看看程序B的EXE文件的长度，例如17234。然后将上面的20480改为17234，再编译一次程序B。
问：关于程序热键公用问题？
如果两个程序都用到了相同的热键 比如说ctrl+enter 当这2个程序同时运行起来的时候，怎么才能让只有一个程序接受热键，换句话说就是谁在前台（前面 激活状态）谁就使用这个热键，谁在后台 或者最小化等非激活状态 那么就不使用这个热键！ 怎么能做到呢？
答：代码如下：
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的背景颜色一致？
答：其实要看每个控件是否可以设置颜色，一般检查一下控件的backcorlor和forecolor属性就可以了，有的话，自己设置吧。
问：怎么让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有什么区别？ 他们是不是都可以单独存在?
答：procedure是声明一个过程,没有返回值.
function是声明一个函数,有返回值的.
问：VB中在textbox中查找单个的字符或字符串有什么好方法? 如:
在textbox中查找: 如textbox.text="12345678"查找"78"或"8" 代码怎么写?
答：用instr函数
例:
dim i as integer
text1.text="12345678"
i=instr(text1.text,"78"
i 的值就是在textBox中找到的字符串"78"的第一次出现的位置.
问： 怎样判断程序是否在运行，如果运行怎样关闭他呢？
答：先用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实现真正的多线程而不是多进程？
答：1.最好把代码放在Active Dll里，编译时使用p代码方式,至少要装vbsp3以上
2.线程函数里不能有VB的内置函数，比如left,trim等
3.创建线程CreateThread的参数不要使用ByVal &0,使用变量
主程序退出时要使用TerminateProcess(GetCurrentProcess, ByVal 0&)强行结束当前进程，否则有可能出错，这是两个API函数，请查相关资料
问：局域网点对点传输，如何数据加密？怎样实现？
答：在text1中输入你要加密的数据（16进制）
将它和4E进行异或
再按就把数据还原了
Private Sub Command1_Click()
tmp = Hex(Val("&H" & Text1.Text) Xor Val("&H" & "4E"))
Text1.Text = tmp
End Sub
问：如何实现鼠标取词？
‘所要用到的函数、常量、类型
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
根据代码加入相应控件，timer1的interval的属性为100再加入把当前窗口置顶就是一个完美的简单的取词工具了！
问：VB调DLL时，如何传Structure？
答：在DLL里定义时应该用指针作参数，在VB里面，只要把结构变量定义成 Long 类型就可以了，调用的时候传入地址，就是在调用的时候，在参数前面加 ByVal。
问：如何可以在VB中实现对整个系统鼠标和键盘的屏蔽
答：我们常见一些导览系统或教学系统，会自动移动Mouse与Keyin字，而那个时候，我们不管Keyin或动Mouse都没有效，直到完成了导览系统的某个动作後才让使用者可以移动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时，当有讯息被撷取出来时，会先执行他们所设定的Hook Function(在vb中，一定要放在.BAS档之中)。这可以做什麽事呢？
例如我们可以Check整个系统是否有按了键盘或有没有移动Mouse(一般来说，KeyUp,KeyDown, MouseMove等Event只有Form在Active 时才收得到，挂上JournalRecord hook後，执行Hook的thread便能收到所有这些讯息)。再如，它既然能收到Keyboard、Mouse的讯息，那便可以将收到的讯息记录起来(记录於Memory或Disk都可以)，之後再依方才的顺序重新将讯息放送出来，可重新执行方才的动作(这不就是巨集的作法吗)，或许它叫JournalRecord便是这个原因。再来便是播放记录讯息的问题了，如果一面播放，一面有其他讯息插队(如移动Mouse)，那就不对了，所以JournalPlayBack这个Hook它会让Mouse、Keyboard都失效，当OS 要求读System Queue时，便会启动这个Hook，就在此时，我们可以把方才记录起来的讯息丢出一个出来，OS再要求读System Queue时，再丢下一个讯息，如此达重播的效果(所以才叫JournalPlayBack)，正因它会让键盘、Mouse失效，拿它来做导览、教学系统的自动Move Mouse或文字显示是最适合的了。
Mouse的自动导引系统制作方式，可叁考如何自动移动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控件中图形数据写成“流”？
答：可以使用adodb.stream对象。
上传图片或显示SWF的时候都希望得到它的高度和宽度，基本原理使用Adodb.Stream读二进制文件然后进行解析，然后返回一数组：
第一个元素为类型(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