中天英语学习-动画学语法

软件简介：
学英语的最终目标,就是要能读、写、听、讲句子。想到就会讲,听到就会答--表示你会这个语言。
中天英语学习-动画学语法软件运用形象生动地动画卡通进行教学，适合于各个层次的人进行学习。软件内置100多个动画课程和文字教程，内容详尽，是您掌握英语语法的好帮手。

下载：中天英语学习-动画学语法

中天在线网络电视1.5

软件简介:
中天在线网络电视1.5继承了以前版本使用的在线播放的基础上，增加了PPL.PPS.UUSee.迅雷看看播放。设计成绿化版，绿化就可以使用。
使用说明：
1.打开P2P网视观看时请稍等片刻观看。
2.网络电视播放收到网络公司和带宽的的影响，请选择可以观看的频道。
3.P2P网视再使用过程会在硬盘留下文件，观看久了会越来越多，请定时用绿化卸载里面的清理文件功能清理。


下载：中天在线网络电视1.5

关于 .NET 程序如飞信不能使用问题

开电脑，运行飞信，竟然不能使用，网上搜索下，发现没有好的解决办法，有的建议重装系统，在介飞信发现说是.NET 程序，试者下载Microsoft .NET Framework 2.0版修复安装，重启电脑后问题解决。
Microsoft .NET Framework 2.0版下载地址：http://dl.pconline.com.cn/html_2/1/82/id=10637&pn=0.html

悠迅全能录音机V1.4中天绿化版

软件简介:
悠迅全能录音机是一款运行于个人计算机上的功能强大的录音、播放软件。使用它，您可将计算机内部或外部声音（如来麦克风、mono mix、stereo mix、spdif、CD唱机、线路输入、电话线或各影音播放软件正在播放的声音）永久保存到硬盘上。
主要功能如下:
1、几乎可保存为目前已知的声音格式。
2、可选择输入设备。
3、支持多声卡。
4、可以制作多种声音效果，如回声、放大声音、周相移动、均衡器。
5、可直观地看到声音的频率。
6、较之其它国内外录音软件，本软件界面更友好，操作更方便。

下载：http://www.qupan.com/79932/170543.html

手机铃声剪辑王 V6.0 精简版

软件介绍; 手机铃声剪辑王 V6.0 精简版是一款免安装、绿色、小巧，自做手机铃声软件。能够任意剪辑文件长短并支持所听即所得，保留最精华部分作为自己手机铃声的超强软件。
注册信息;
用户名：中天在线
注册码：93913146



下载：http://www.qupan.com/79932/170534.html

Windows优化大师 8.0.8.815 单文件版

软件简介：
本次新版较以往版本做了较大改动，更注重用户体验，操作较以往版本更简单，真正实现一键优化的目标！另外优化大师联手优化网，全力打造一个ＩＴ服务平台！相信大家在下载使用最新版优化大师后，会有许多新的感受！

下载：http://www.qupan.com/79932/170525.html

几款VB美化代码

窗体半透明效果
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1

Private Sub Command1_Click()
Dim rtn As Long
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, 0, 200, LWA_ALPHA
End Sub
二。窗体靠边自动隐藏
Option Explicit

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
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 Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
X As Long
Y As Long
End Type

Private Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40


Private Sub Form_Load()
'窗体放在最前面
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
End Sub

Private Sub Timer1_Timer()
Dim p As POINTAPI
Dim f As RECT
GetCursorPos p '得到MOUSE位置
GetWindowRect Me.hwnd, f '得到窗体的位置
If Me.WindowState <> 1 Then
If p.X > f.Left And p.X < f.Right And p.Y > f.Top And p.Y < f.Bottom Then
'MOUSE 在窗体上
If Me.Top < 0 Then
Me.Top = -10
Me.Show
ElseIf Me.Left < 0 Then
Me.Left = -10
Me.Show
ElseIf Me.Left + Me.Width >= Screen.Width Then
Me.Left = Screen.Width - Me.Width + 10
Me.Show
End If

Else
If f.Top <= 4 Then
Me.Top = 40 - Me.Height
ElseIf f.Left <= 4 Then
Me.Left = 40 - Me.Width
ElseIf Me.Left + Me.Width >= Screen.Width - 4 Then
Me.Left = Screen.Width - 40
End If
End If
End If

End Sub

VB编程的8个优良习惯

1、"&"替换"+"
2、变量命名大小写，语句错落有秩，源代码维护方面
3、请养成以下的“对象命名约定”良好习惯
4、在简单的选择条件情况下,使用IIf()函数
5、尽量使用Debug.Print进行调试
6、在重复对某一对象的属性进行修改时，尽量使用With....End With
7、MsgBox中尽量使用消息图标，这样程序比较有规范
8、在可能的情况下使用枚举
1、"&"替换"+"
在很多人的编程语言中，用“+”来连接字符串，这样容易导致歧义。良好的习惯是用“&”来连接字符串.

不正确:
Dim sMessage As String
sMessage = "1" + "2"

正确:
Dim sMessage As String
sMessage = "1" & "2"

注意："&"的后面有个空格

2、变量命名大小写，语句错落有秩，源代码维护方面

下面大家比较一下以下两段代码:

读懂难度很大的代码：

Dim SNAME As String
Dim NTURN As Integer

If NTURN = 0 Then
If SNAME = "vbeden" Then
Do While NTURN < 4
NTURN = NTURN + 1
Loop
End If
End If

容易读懂的代码：

Dim sName As String
Dim nTurn As Integer

If nTurn = 0 Then
If sName = "vbeden" Then
Do While nTurn < 4
nTurn = nTurn + 1
Loop
End If
End If
3、请养成以下的“对象命名约定”良好习惯

推荐使用的控件前缀

控件类型 前缀 例子
3D Panel pnl pnlGroup
ADO Data ado adoBiblio
Animated button ani aniMailBox
Check box chk chkReadOnly
Combo box, drop-down list box cbo cboEnglish
Command button cmd cmdExit
Common dialog dlg dlgFileOpen
Communications com comFax
Control （当特定类型未知时，在过程中所使用的） ctr ctrCurrent
Data dat datBiblio
Data-bound combo box dbcbo dbcboLanguage
Data-bound grid dbgrd dbgrdQueryResult
Data-bound list box dblst dblstJobType
Data combo dbc dbcAuthor
Data grid dgd dgdTitles
Data list dbl dblPublisher
Data repeater drp drpLocation
Date picker dtp dtpPublished
Directory list box dir dirSource
Drive list box drv drvTarget
File list box fil filSource
Flat scroll bar fsb fsbMove
Form frm frmEntry
Frame fra fraLanguage
Gauge gau gauStatus
Graph gra graRevenue
Grid grd grdPrices
Hierarchical flexgrid flex flexOrders
Horizontal scroll bar hsb hsbVolume
Image img imgIcon
Image combo imgcbo imgcboProduct
ImageList ils ilsAllIcons
Label lbl lblHelpMessage
Lightweight check box lwchk lwchkArchive
Lightweight combo box lwcbo lwcboGerman
Lightweight command button lwcmd lwcmdRemove
Lightweight frame lwfra lwfraSaveOptions
Lightweight horizontal scroll bar lwhsb lwhsbVolume
Lightweight list box lwlst lwlstCostCenters
Lightweight option button lwopt lwoptIncomeLevel
Lightweight text box lwtxt lwoptStreet
Lightweight vertical scroll bar lwvsb lwvsbYear
Line lin linVertical
List box lst lstPolicyCodes
ListView lvw lvwHeadings
MAPI message mpm mpmSentMessage
MAPI session mps mpsSession
MCI mci mciVideo
Menu mnu mnuFileOpen
Month view mvw mvwPeriod
MS Chart ch chSalesbyRegion
MS Flex grid msg msgClients
MS Tab mst mstFirst
OLE container ole oleWorksheet
Option button opt optGender
Picture box pic picVGA
Picture clip clp clpToolbar
ProgressBar prg prgLoadFile
Remote Data rd rdTitles
RichTextBox rtf rtfReport
Shape shp shpCircle
Slider sld sldScale
Spin spn spnPages
StatusBar sta staDateTime
SysInfo sys sysMonitor
TabStrip tab tabOptions
Text box txt txtLastName
Timer tmr tmrAlarm
Toolbar tlb tlbActions
TreeView tre treOrganization
UpDown upd updDirection
Vertical scroll bar vsb vsbRate

--------------------------------------------------------------------------------
推荐使用的数据访问对象 (DAO) 的前缀
用下列前缀来指示数据访问对象
数据库对象 前缀 例子
Container con conReports
Database db dbAccounts
DBEngine dbe dbeJet
Document doc docSalesReport
Field fld fldAddress
Group grp grpFinance
Index ix idxAge
Parameter prm prmJobCode
QueryDef qry qrySalesByRegion
Recordset rec recForecast
Relation rel relEmployeeDept
TableDef tbd tbdCustomers
User usr usrNew
Workspace wsp wspMine
应用程序频繁使用许多菜单控件，对于这些控件具备一组唯一的命名约定很实用。除了最前面 "mnu" 标记以外，菜单控件的前缀应该被扩展：对每一级嵌套增加一个附加前缀，将最终的菜单的标题放在名称字符串的最后。下表列出了一些例子。

推荐使用的菜单前缀
菜单标题序列 菜单处理器名称
File Open mnuFileOpen
File Send Email mnuFileSendEmail
File Send Fax mnuFileSendFax
Format Character mnuFormatCharacter
Help Contents mnuHelpContents

当使用这种命名约定时，一个特定的菜单组的所有成员一个接一个地列在 Visual Basic 的“属性”窗口中。而且，菜单控件的名字清楚地表示出它们所属的菜单项。

为其它控件选择前缀

对于上面没有列出的控件，应该用唯一的由两个或三个字符组成的前缀使它们标准化，以保持一致性。只有当需要澄清时，才使用多于三个字符的前缀。

常量和变量命名约定
除了对象之外，常量和变量也需要良好格式的命名约定。本节列出了 Visual Basic 支持的常量和变量的推荐约定。并且讨论标识数据类型和范围的问题。

变量应该总是被定义在尽可能小的范围内。全局 (Public) 变量可以导致极其复杂的状态机构，并且使一个应用程序的逻辑非常难于理解。全局变量也使代码的重用和维护更加困难。

Visual Basic 中的变量可以有下列范围

范围 声明位置 可见位置
过程级 过程，子过程或函数过程中的 ‘Private’ 在声明它的过程中
模块级 窗体或代码模块（.frm、.bas ）的声明部分中的 ‘Private’ 窗体或代码模块中的每一个过程
全局 代码模块（.bas）的声明部分中的 ‘Public’ 应用程序中的每一处

在 Visual Basic 的应用程序中，只有当没有其它方便途径在窗体之间共享数据时才使用全局变量。当必须使用全局变量时，在一个单一模块中声明它们，并按功能分组。给这个模块取一个有意义的名称，以指明它的作用，如 Public.bas。

较好的编码习惯是尽可能写模块化的代码。例如，如果应用程序显示一个对话框，就把要完成这一对话任务所需要的所有控件和代码放在单一的窗体中。这有助于将应用程序的代码组织在有用的组件中，并减小它运行时的开销。

除了全局变量（应该是不被传递的），过程和函数应该仅对传递给它们的对象操作。在过程中使用的全局变量应该在过程起始处的声明部分中标识出来。此外，应该用 ByVal 将参数传递给 Sub 过程及 function 过程，除非明显地需要改变已传递的参数值。

随着工程大小的增长，划分变量范围的工作也迅速增加。在类型前缀的前面放置单字母范围前缀标明了这种增长，但变量名的长度并没有增加很多。

变量范围前缀

范围 前缀 例子
全局 g gstrUserName
模块级 m mblnCalcInProgress
本地到过程 无 dblVelocity

如果一个变量在标准模块或窗体模块中被声明为 Public，那么该变量具有全局范围。如果一个变量在标准模块或窗体模块中被分别声明为 Private，那么该变量有模块级范围。

注意： 一致性是卓有成效地使用这种技术的关键；Visual Basic 中的语法检查器不会捕捉以 "p." 开头的模块级变量。

常量
常量名的主体是大小写混合的，每个单词的首字母大写。尽管标准 Visual Basic 常量不包含数据类型和范围信息，但是象 i、s、g 和 m 这样的前缀对于理解一个常量的值和范围还是很有用的。对于常量名，应遵循与变量相同的规则。例如：

mintUserListMax '对用户列表的最大限制
'(整数值，本地到模块)
gstrNewLine '新行字符
'(字符串，应用程序全局使用)

变量
声明所有的变量将会节省编程时间，因为键入操作引起的错误减少了（例如，究竟是 aUserNameTmp，还是 sUserNameTmp，还是 sUserNameTemp）。在“选项”对话框的“编辑器”标签中，复选“要求变量声明”选项。Option Explicit 语句要求在 Visual Basic 程序中声明所有的变量。

应该给变量加前缀来指明它们的数据类型。而且前缀可以被扩展，用来指明变量范围，特别是对大型程序。

用下列前缀来指明一个变量的数据类型。

变量数据类型

数据类型 前缀 例子
String （字符串类型） str strFName
Integer （短整数类型） int intQuantity
Long （长整数类型） lng lngDistance
Single (单精度浮点数类型) sng sngAverage
Double （双精度浮点数类型） dbl dblTolerance
Boolean （布尔类型） bln blnFound
Byte （字节类型） byt bytRasterData
Date （日期类型） dte dteNow
Currency （货币计算与定点计算类型） cur curRevenue
Object （对象类型） obj objCurrent
Variant （变体类型） vnt vntCheckSum

描述变量和过程名

变量或过程名的主体应该使用大小写混合形式，并且应该足够长以描述它的作用。而且，函数名应该以一个动词起首，如 InitNameArray 或 CloseDialog。

对于频繁使用的或长的项，推荐使用标准缩略语以使名称的长度合理化。一般来说，超过 32 个字符的变量名在 VGA 显示器上读起来就困难了。

当使用缩略语时，要确保它们在整个应用程序中的一致性。在一个工程中，如果一会儿使用 Cnt， 一会儿使用 Count，将导致不必要的混淆。

用户定义的类型
在一项有许多用户定义类型的大工程中，常常有必要给每种类型一个它自己的三个字符的前缀。如果这些前缀是以 "u" 开始的，那么当用一个用户定义类型来工作时，快速识别这些类型是很容易的。例如，ucli 可以被用来作为一个用户定义的客户类型变量的前缀。

[返回索引]

4、在简单的选择条件情况下,使用IIf()函数

罗索的代码：
If nNum = 0 Then
sName = "sancy"
Else
sName = "Xu"
End If

简单的代码：
sName=IIf(nNum=0,"sancy","Xu")

5、尽量使用Debug.Print进行调试

在很多初学者的调试中,用MsgBox来跟踪变量值.其实用Debug.Print不仅可以达到同样的功效,而且在程序最后编译过程中,会被忽略.而MsgBox必须手动注释或删除.

通常：
MsgBox nName

应该：
Debug.Print nName

6、在重复对某一对象的属性进行修改时，尽量使用With....End With

通常：
Form1.Height = 5000
Form1.Width = 6000
Form1.Caption = "This is MyLabel"

应该：
With Form1
.Height = 5000
.Width = 6000
.Caption = "This is MyLabel"
End With
这种结构程序执行效率比较高，特别在循环语句里。

7、MsgBox中尽量使用消息图标，这样程序比较有规范

一般来说

vbInformation 用来提示确认或成功操作的消息

vbExclamation 用来提示警告的消息

vbCritical 用来提示危机情况的消息

vbQuestion 用来提示询问的消息

[返回索引]

8、在可能的情况下使用枚举

枚举的格式为
[Public | Private] Enum name
membername [= constantexpression]
membername [= constantexpression]
....
End Enum

Enum 语句包含下面部分：

部分 描述
Public 可选的。表示该 Enum 类型在整个工程中都是可见的。Enum 类型的缺省情况是 Public。
Private 可选的。表示该 Enum 类型只在所声明的模块中是可见的。
name 必需的。该 Enum 类型的名称。name 必须是一个合法的 Visual Basic 标识符，在定义该 Enum 类型的变量或参数时用该名称来指定类型。
membername 必需的。用于指定该 Enum 类型的组成元素名称的合法 Visual Basic 标识符。
constantexpression 可选的。元素的值（为 Long 类型）。可以是别的 Enum 类型。如果没有指定 constantexpression，则所赋给的值或者是 0（如果该元素是第一个 membername），或者比其直接前驱的值大 1。

说明
所谓枚举变量，就是指用 Enum 类型定义的变量。变量和参数都可以定义为 Enum 类型。Enum 类型中的元素被初始化为 Enum 语句中指定的常数值。所赋给的值可以包括正数和负数，且在运行时不能改变。例如：

Enum SecurityLevel IllegalEntry = -1 SecurityLevel1 = 0 SecurityLevel2 = 1 End Enum

Enum 语句只能在模块级别中出现。定义 Enum 类型后，就可以用它来定义变量，参数或返回该类型的过程。不能用模块名来限定 Enum 类型。类模块中的 Public Enum 类型并不是该类的成员；只不过它们也被写入到类型库中。在标准模块中定义的 Enum 类型则不写到类型库中。具有相同名字的 Public Enum 类型不能既在标准模块中定义，又在类模块中定义，因为它们共享相同的命名空间。若不同的类型库中有两个 Enum 类型的名字相同，但成员不同，则对这种类型的变量的引用，将取决于哪一个类型库具有更高的引用优先级。

不能在 With 块中使用 Enum 类型作为目标。

Enum 语句示例
下面的示例演示用 Enum 语句定义一个命名常数的集合。在本例中是一些可以选择的颜色常数用于设计数据库的数据输入窗体。

Public Enum InterfaceColors
icMistyRose = &HE1E4FF&
icSlateGray = &H908070&
icDodgerBlue = &HFF901E&
icDeepSkyBlue = &HFFBF00&
icSpringGreen = &H7FFF00&
icForestGreen = &H228B22&
icGoldenrod = &H20A5DA&
icFirebrick = &H2222B2&
End Enum

在VB中的MsgBox中怎么换行

" + vbCrLf + "

给VB程序添加背景音乐

在新世纪看到一个给VB添加背景音乐的教程，感到好麻烦啊
其实很简单

添加一个WMP控件就可以解决了

以下是代码咯

Private Sub Form_Load()
wmp1.URL = "19.mid"
End Sub

把程序和音乐文件放在一起，就可以了，而且那个WMP播放器可以选择隐藏，这样根本看不到。也能达到那个效果

比起那个教程里的简单多

那个要添加资源文件 还要些那么多的代码

VB获取系统目录

Dim FileSystem0bject
Dim SystemDir
Dim SystemDir2

Set FileSystem0bject = CreateObject("Scripting.FileSystemObject")

Set SystemDir0 = FileSystem0bject.getspecialfolder(0) '获取WINDOWS目录

Set SystemDir1 = FileSystem0bject.getspecialfolder(1) '获取WINDOWS/SYSTEM32目录

Set SystemDir2 = FileSystem0bject.getspecialfolder(2) '当前用户TEMP目录

用VB编写一个加密软件

编写一个加密软件，要求将源文件按字节逐位倒排序加密法加密。
字节逐位倒排序加密法是以比特为单位的换位加密方法，用VB实现的具体算法是：
(1) 以二进制模式打开源文件；
(2) 从源文件第I位读取一个字节，假设为字母“A”，得到“A”的ASCII值为65；
(3) 将65转换成八位二进制串为“01000001”；
(4) 将“01000001”按字节逐位倒排序得另一个八位二进制串“10000010”；
(5) 将“10000010”转换成十进制再写回源文件第I位置，完成一个字节的加密；
(6) 重复(2)、(3)、(4)和(5)，直到所有字节加密结束。
为了使程序模块化，我们用函数过程ByteToBin完成将字节型数据转换成二进制串（其实质就是将十进制数转换成八位二进制串）；用函数过程BinToByte将二进制串转换成字节型数据（实质是将八位二进制串转换成十进制数）：用函数过程Reverse将八位二进制串逐位倒排序。具体程序如下：
Function ByteToBin(m As Byte) As String ' 将字节型数据转换成八位二进制字符串
Dim c$
c$ = ""
Do While m <> 0
r = m Mod 2
m = m \ 2
c$ = r & c$
Loop
c$ = Right("00000000" & c$, 8)
ByteToBin = c$
End Function
Function Reverse(m As String) As String ' 将八位二进制字符串颠倒顺序
Dim i%, x$
x = ""
For i = 1 To 8
x = Mid(m, i, 1) & x
Next i
Reverse = x
End Function
Function BinToByte(m As String) As Byte ' 将八位二进制串转换成十进制
Dim x As String * 1, y%, z%
z = 0
For i = 1 To 8
x = Mid(m, i, 1)
y = x * 2 ^ (8 - i)
z = z + y
Next i
BinToByte = z
End Function
Private Sub Command1_Click()
Dim x As Byte, i%, fname$
fname = InputBox("请输入要加密的文件名！注意加上路径名：")
If Dir(fname) = "" Then
MsgBox "文件不存在！"
Exit Sub
End If
Open fname For Binary As #1 ' 以二进制访问模式打开待加密文件
For i = 1 To LOF(1) ' LOF函数是求文件长度的内部函数
Get #1, i, x ' 取出第i个字节
x = BinToByte(Reverse(ByteToBin(x))) ' 这里调用了三个自定义函数
Put #1, i, x ' 将加密后的这个字节写回到文件原位置
Next i
Close
MsgBox "任务完成！"
End Sub
本例可以完成对任意文件的加密与解密，对同一文件作第一次处理为加密，第二次处理为解密。要调试本程序，可用记事本在C盘根目录下任意建立一个文本文件（假设为文件名为aaa.txt），其中的内容任意（可以包括字母、汉字、数字、回车符、换行符等）。运行本程序后，在输入文件名的对话框中输入文件名（如：“C:\aaa.txt”）后回车，即可完成对文件的加密。文件加密后，可以在记事本中打开该文件查看加密效果。如果想解密，可再次运行该程序并输入相同文件名。
摘自西北大学出版社出版、李书琴等主编的《VB60程序设计教程》

VB弹网页代码

rivate Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

load事件（打开软件时弹出）和 unload事件（关闭软件时弹出）
ShellExecute 0&, vbNullString, "http://www.baidu.com", vbNullString, vbNullString, vbNormalFocus

Private Sub Form_Load()
WebBrowser1.Navigate ("http://www.baidu.com")
End Sub

Private Sub Form_Resize()
WebBrowser1.Height = Form2.Height
WebBrowser1.Width = Form2.Width
End Sub

VB读取注册表获得CPU信息!

Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Const REG_SZ = 1
Const REG_DWORD = 4
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002

Private Sub Command1_Click()
Dim cpupl As String * 100
Dim ret As Long, hKey&
ret = RegOpenKey(HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System\CentralProcessor\0", hKey)
RegQueryValueEx hKey, "ProcessorNameString", 0, REG_SZ, ByVal cpupl, Len(cpupl)
'cpuinfo = Left(cpupl, InStr(cpupl, Chr(0)) - 1)
MsgBox cpupl
End Sub

VB写远程用到的IP列表显示

Option Explicit
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

Public Function ipwhere(ipAddress As String)
'Dim ipbegin, ipend, ipData1, ipData2, DataSeek, ipFlag
Dim ip
ip = Split(ipAddress, ".")
Dim ipNum '当前要查询的ip
ipNum = ip(0) * 16777216 + ip(1) * 65536 + ip(2) * 256 + ip(3)
'Debug.Print ipNum
Dim ipfile
ipfile = App.Path & "\QQwry.dat"

''''''''''''''''''''''''vb的文件读取方式
Dim fn As Integer
fn = FreeFile
Open ipfile For Binary Access Read As #fn
Dim ipbegin, ipend
'Dim ipbegin As Long
'Dim ipend As Long
'Get #fn, , ipbegin '读文件头4个字节 第一个起始IP的绝对偏移
'Get #fn, , ipend '再读文件头4个字节 最后一个起始IP的绝对偏移
Dim ipbeginArray(1 To 4) As Byte
Dim ipendArray(1 To 4) As Byte
Get #fn, , ipbeginArray()
Get #fn, , ipendArray()
ipbegin = unPack(ipbeginArray)
ipend = unPack(ipendArray)

Dim ipAllNum
'每组ip段占7个字节 计算有多少组ip段
ipAllNum = (ipend - ipbegin) / 7 + 1
Dim BeginNum, EndNum
BeginNum = 0
EndNum = ipAllNum
Dim Middle
Dim ipData1
Dim ipData1Array(1 To 4) As Byte
Dim ip1Num
Bgn:
Middle = CLng((EndNum + BeginNum) / 2)
Get #fn, ipbegin + 7 * Middle + 1, ipData1Array()
ipData1 = unPack(ipData1Array)
'Debug.Print Loc(fn)
ip1Num = ipData1
If ip1Num > ipNum Then
EndNum = Middle
GoTo Bgn
End If
Dim DataSeek
Dim DataSeekArray(1 To 3) As Byte
'Debug.Print Loc(fn)
Get #fn, , DataSeekArray()
DataSeek = unPack(DataSeekArray)
Dim ipData2, ip2Num
Dim ipData2Array(1 To 4) As Byte
Get #fn, DataSeek + 1, ipData2Array()
ipData2 = unPack(ipData2Array)
ip2Num = ipData2
If ip2Num < ipNum Then
If Middle = BeginNum Then GoTo nd
BeginNum = Middle
GoTo Bgn
End If
Dim ipFlag As Byte
'Debug.Print Loc(fn)
Get #fn, , ipFlag
'Debug.Print Loc(fn)
Dim ipAddr2 As String
Dim ipAddr1 As String
If ipFlag = 1 Then
Dim ipSeek
Dim ipSeekArray(1 To 3) As Byte
Get #fn, , ipSeekArray()
ipSeek = unPack(ipSeekArray)
Get #fn, ipSeek + 1, ipFlag
End If
If ipFlag = 2 Then
Dim AddrSeek
Dim AddrSeekArray(1 To 3) As Byte
Dim AddrSeek2
Dim AddrSeek2Array(1 To 3) As Byte
Get #fn, , AddrSeekArray()
Get #fn, , ipFlag
'MsgBox Loc(fn)
If ipFlag = 2 Then
Get #fn, , AddrSeek2Array()
AddrSeek2 = unPack(AddrSeek2Array)
Seek #fn, AddrSeek2 + 1
Else
Seek #fn, Loc(fn) '- 1
' MsgBox Loc(fn)
End If
Dim temp1(1024) As Byte '1k 字节空间
Dim curr1 As Integer
curr1 = 0
Do
Get #fn, , temp1(curr1)
' MsgBox temp1(curr1)
curr1 = curr1 + 1
Loop Until temp1(curr1 - 1) = 0
ipAddr2 = StrConv(temp1, vbUnicode)
'MsgBox Len(ipAddr2)
'ipaddr2
AddrSeek = unPack(AddrSeekArray)
Seek #fn, AddrSeek + 1
curr1 = 0
Do
Get #fn, , temp1(curr1)
curr1 = curr1 + 1
Loop Until temp1(curr1 - 1) = 0
ipAddr1 = StrConv(temp1, vbUnicode)
'ipaddr1
Else
Seek #fn, Loc(fn) '-1
Dim temp2(1024) As Byte '1k 字节空间
Dim curr2 As Integer
' Debug.Print Loc(fn)
curr2 = 0
Do
Get #fn, , temp2(curr2)
'MsgBox temp2(curr2)
curr2 = curr2 + 1
Loop Until temp2(curr2 - 1) = 0
ipAddr1 = StrConv(temp2, vbUnicode)
'ipaddr1
Get #fn, , ipFlag
If ipFlag = 2 Then
Get #fn, , AddrSeek2Array()
AddrSeek2 = unPack(AddrSeek2Array)
Seek #fn, AddrSeek2 + 1
Else
Seek #fn, Loc(fn) '- 1
End If
' Debug.Print Loc(fn)
curr2 = 0
Do
Get #fn, , temp2(curr2)
curr2 = curr2 + 1
Loop Until temp2(curr2 - 1) = 0
ipAddr2 = StrConv(temp2, vbUnicode)
'ipaddr2
End If
nd:

Close #fn
''''''''''''''''''''''''vb的文件读取方式
Call lstrcat(ipAddr1, ipAddr2)
ipwhere = ipAddr1
'ipwhere = ipAddr1 & " " & ipAddr2
'ipwhere = ipAddr2

End Function

Public Function unPack(MyArray() As Byte)
Dim n As Integer
Dim m As Integer
Dim num
m = 0
For n = LBound(MyArray) To UBound(MyArray)
num = MyArray(n) * 256 ^ m + num
m = m + 1
Next n
unPack = num
End Function

VB极时停代事件代码

Public Starting As Boolean
Private Declare Function GetInputState Lib "user32" () As Long

Sub Command1_Click()
Dim i As Long
Starting = Not Starting
Command1.Caption = IIf(Starting, "停止", "开始")
Do
If GetInputState Then DoEvents
For i = i To i + 1000
If Starting = False Then Exit Do
Next
Me.Caption = i
Loop
End Sub

Private Sub Form_Unload(Cancel As Integer)
Starting = False

End Sub

计算程序从打开到结束的时间

记个代码,自己以后用用的着,计算程序从打开到结束的时间,也可以监视某个程序是否执行完成!
Private Declare Function GetInputState Lib "user32" () As Long
Private Const INFINITE = -1&
Private Const SYNCHRONIZE = &H100000
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
'获取时间差需要API
Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Sub Form_Click()
'Shell "explorer http://www.dyjmgm.com/110/vote.asp", vbNormalFocus
MsgBox "所调用程序已经结束,该程序一共运行了:" & DoEvents & mWait(Shell("Notepad", vbNormalFocus)) & "毫秒" ' Shell 函数返回值为 Process Id ,这里运行了记事本,当关闭记事本以后,就会弹出对话框
End Sub

'自定义等待函数,传入SHELL返回值就可以了,返回值为经过的时间
Public Function mWait(ByVal mPid As Long) As Long
Dim mTime As Long
mTime = GetTickCount
Dim pHnd As Long ' Process Handle
pHnd = OpenProcess(SYNCHRONIZE, 0, mPid) ' 取得 Process Handle
If pHnd <> 0 Then
Call WaitForSingleObject(pHnd, INFINITE) ' 无限等待，直到程序结束
If GetInputState Then DoEvents
Call CloseHandle(pHnd) '释放句柄资源
End If
mWait = GetTickCount - mTime
End Function

VB webrowes iframe开发过程

Option Explicit
' Find the selected document.
Public Function getSelectedDocument(ByVal DocO As HTMLDocument) As HTMLDocument
Static depth As Long

Dim i As Integer
Dim sub_doc As HTMLDocument
Dim hw2 As HTMLWindow2
Dim doc2 As HTMLDocument

' Avoid infinite loops for some deeply nested pages
If depth < 6 Then depth = depth + 1 Else Exit Function

If DocO.selection.Type = "Text" Then
' Debug.Print "Found selection in " & DocO.parentWindow.Name
Set getSelectedDocument = DocO
ElseIf DocO.frames.length <> 0 Then
For i = 0 To DocO.frames.length - 1
Set hw2 = DocO.frames(i)
' Debug.Print Space$(depth * 2) & hw2.Name
Set doc2 = hw2.Document
Set sub_doc = getSelectedDocument(doc2)
If Not sub_doc Is Nothing Then
depth = depth - 1
Set getSelectedDocument = sub_doc
Exit Function
End If
Next i
Else
Set getSelectedDocument = Nothing
End If
depth = depth - 1
End Function
Private Sub cmdGo_Click()
WebBrowser1.Navigate txtURL.Text
End Sub

' Grab text from the WebBrowser control.
Private Sub Command1_Click()
txtResult(1).Text = WebBrowser1.Document.body.innerText
txtResult(2).Text = WebBrowser1.Document.body.outerText
txtResult(3).Text = WebBrowser1.Document.body.innerHTML
txtResult(4).Text = WebBrowser1.Document.body.outerHTML
txtResult(5).Text = WebBrowser1.Document.activeElement.innerText
txtResult(6).Text = WebBrowser1.Document.activeElement.outerText
txtResult(7).Text = WebBrowser1.Document.activeElement.innerHTML
txtResult(8).Text = WebBrowser1.Document.activeElement.outerHTML

Dim doc As HTMLDocument
Set doc = getSelectedDocument(WebBrowser1.Document)
If doc Is Nothing Then
txtResult(9).Text = vbNullString
Else
With doc
If .selection.Type = "Text" Then
txtResult(9).Text = .selection.createRange().htmlText
Else
' Return the whole document if there was no selection
txtResult(9).Text = .documentElement.outerHTML
End If
End With
End If
End Sub

Private Sub Form_Load()
WebBrowser1.Navigate "http://www.vb-helper.com/index_categories.html"
End Sub

Private Sub Form_Resize()
Dim i As Integer
Dim wid As Single
Dim hgt As Single

TabStrip1.Width = ScaleWidth
hgt = ScaleHeight - TabStrip1.Top
If hgt < 120 Then hgt = 120

VB拷备代码

Option Explicit

Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Private Const FO_COPY = &H2
Private Const FOF_ALLOWUNDO = &H40
Public Sub SHCopyFile(ByVal from_file As String, ByVal to_file As String)
Dim sh_op As SHFILEOPSTRUCT

With sh_op
.hWnd = 0
.wFunc = FO_COPY
.pFrom = from_file & vbNullChar & vbNullChar
.pTo = to_file & vbNullChar & vbNullChar
.fFlags = FOF_ALLOWUNDO
End With

SHFileOperation sh_op
End Sub

Private Sub cmdCopy_Click()
SHCopyFile txtFrom.Text, txtTo.Text
End Sub

Private Sub Form_Load()
Dim file_path As String

file_path = App.Path
If Right$(file_path, 1) <> "\" Then file_path = file_path & "\"

txtFrom.Text = file_path & "TestFrom.txt"
txtTo.Text = file_path & "TestTo.txt"
End Sub

系统类ID

控制面板::::{21EC2020-3AEA-1069-A2DD-08002B30309D}
我的电脑::{20D04FE0-3AEA-1069-A2D8-08002B30309D}
我的文档::{450D8FBA-AD25-11D0-98A8-0800361B1103}
回收站::{645FF040-5081-101B-9F08-00AA002F954E}
我的电脑{20D04FE0-3AEA-1069-A2D8-08002B30309D}
网上邻居{208D2C60-3AEA-1069-A2D7-08002B30309D}
Internet Explorer{871C5380-42A0-1069-A2EA-08002B30309D}
拨号网络/网络连接{992CFFA0-F557-101A-88EC-00DD010CCC48}
网络（和拨号）连接{7007ACC7-3202-11D1-AAD2-00805FC1270E}（WIN2000/XP）
打印机/打印机和传真{2227A280-3AEA-1069-A2DE-08002B30309D}
计划任务{D6277990-4C6A-11CF-8D87-00AA0060F5BF}
查找计算机 ::{208D2C60-3AEA-1069-A2D7-08002B30309D}
管理工具f::{20D04FE0-3AEA-1069-A2D8-08002B30309D}/::{21EC2020-3AEA-1069-A2DD-08002B30309D}/::{D20EA4E1-3957-11d2-A40B-0C5020524153}