IT博客-cyberfan's blog-文章分类-vb

用VB创建MS Office的COM加载项

cyberfan — Fri, 12 Aug 2005 06:45:00 GMT

通过此演练，可以用 VB 创建 COM 加载项。COM 加载项可以在不给用户增加复杂性的情况下扩展应用程序的功能。究其实质，COM 加载项是一个动态链接库 (DLL)，需要进行注册才能供 Microsoft? Office XP 应用程序加载和使用。虽然可以将加载项编写成可执行文件 (.exe)，但 DLL 通常会比.exe 文件提供更好的性能。

　　此演练将使用 VB 创建并运行一个自定义工具栏 COM 加载项。本主题中的任务假定您熟悉 Office 应用程序、VB 工程，以及调试和运行代码。

　　引言

　　创建 COM 加载项时可以使用任何支持 COM 的语言，如 VBA、Visual Basic 和 Microsoft Visual C++。用 Office Developer 创建的加载项将自动打包成 DLL，并由宿主应用程序注册后进行加载。可以创建一个加载项但能用于多个应用程序中。有关详细信息。请参阅为多个应用程序创建 COM 加载项。

　　此演练将完成一系列步骤，从而用 VB 创建一个 COM 加载项。创建 COM 加载项的基本步骤包括：

　　1.配置外接程序设计器。

　　2.在外接程序设计器中编写代码。

　　3.将命令条控件集成到加载项中。

　　4.对 COM 加载项进行调试和测试。

　　5.为 COM 加载项生成 DLL。

　　6.解决 COM 加载项的开发问题。

配置外接程序设计器

　　用外接程序设计器创建的工程为开发加载项提供工作区域。使用外接程序设计器可以创建用于 VBA 或任何 Office 应用程序的 COM 加载项。工程中的每个外接程序设计器都表示一个单独的、只能在一种 Office 应用程序中运行的加载项。创建的 DLL 可包含多个加载项，它们使用相同的窗体、模块和类模块，但面向的却是不同的应用程序。此演练使用 Excel 作为宿主 Office 应用程序。

　　如果希望加载项可供多个应用程序使用，就必须为每个宿主应用程序各自添加一个外接程序设计器。可以通过模块共享代码；但在每个工程中，必须引用每个宿主应用程序所特定的对象模型。

　　配置外接程序设计器

　　1.打开 VB

　　2.在“文件”菜单中，选择“新建工程”，然后选择“外接程序”。

　　3.把窗体移除,双击设计器中的Connect。

　　3.在“外接程序显示名称”文本框中键入名称 Greeting Toolbar，在“外接程序描述”文本框中键入说明 Toolbar add-in that launches a Hello World message in Excel。

　　4.从“应用程序”列表中选择 Microsoft Excel。

　　5.从“应用程序版本”列表中选择 Microsoft Excel 10.0。

　　6.从“初始化加载行为”列表中选择 "Startup"。有关各种不同类型初始加载行为的详细信息，请参阅指定加载行为。

　　此主题相关图片如下：

　　7.在“工程”菜单中，选择“引用”，确保让工程引用下列类型库。（该引用列表是此演练所必需的。对于您的加载项，要确保选择每个可以使用加载项的 Office 应用程序所需的类型库。）

●Visual Basic for Applications
●OLE Automation
●Microsoft Add-in Designer
●Microsoft Office 10.0 Object Library
●Microsoft Excel 10.0 Object Library

　　8.在“文件”菜单中选择“保存 Connect”。

　　9.在“工程另存为”对话框中，输入名称 Greetings.Dsr，选择要将其保存到的文件夹，然后单击“保存”。

在外接程序设计器中编写代码

　　在创建工程并为外接程序设计器赋值后，可以添加代码将加载项与宿主应用程序连接起来。此演练将向您展示将加载项与宿主应用程序连接起来所需的典型过程和事件。IDTExtensibility2 接口提供连接这二者所需的 COM 对象和事件。然后，加载项可以使用宿主应用程序所展示的对象模型与宿主应用程序接合。可以在对象浏览器中查看特定应用程序的对象模型。

　　外接程序设计器中的代码可处理加载项与宿主应用程序的集成。例如，加载或卸载加载项时运行的代码驻留在“外接程序设计器”的模块中。如果加载项中包含窗体，则外接程序设计器还可以包含用于显示窗体的代码。

　　声明变量和设置过程存根

　　1.在“工程资源管理器”窗口中，选择 Connect，然后打开“视图”菜单，单击“代码”。清除原来有的代码。

　　2.在“通用声明”部分，引用可扩展性接口。

Implements IDTExtensibility2

　　3.添加用于在加载项和宿主之间提供通讯的模块级变量。只要加载了 COM 加载项，赋值为 As Excel.Application 的变量就一直存在，因此，所有过程都可以确定加载项当前正在哪个应用程序中运行。因为 WithEvents 关键字指派给 cbbButton 变量，所以菜单项的 Click 事件过程将在用户单击新菜单项时触发。

'Global object references
Public appHostApp As Excel.Application
Private WithEvents cbbButton As Office.CommandBarButton

　　4.在“代码”窗口中，从“对象”列表中选择 IDTExtensibility2，从“事件”列表中选择 OnConnection。这将创建 OnConnection 事件过程存根。
注意您必须使由 IDTExtensibility2 界面提供的每个事件中都包括事件过程存根。如果您删除了任何事件过程，工程就无法编译。

　　5.为下列每个事件添加事件过程存根：

●OnDisconnection
●OnStartupComplete
●OnBeginShutdown
●OnAddinsUpdate

　　现在就可以为您的加载项添加功能了。

将命令条控件集成到加载项中

　　如果您的 COM 加载项有一个用户界面，就可以添加用于显示命令条的代码，以方便用户运行您的加载项。此演练将显示如何在宿主应用程序中包含用于创建新命令条控件（工具栏按钮或菜单项）的代码。加载您的加载项时，会同时加载控件，用户可以通过单击按钮或菜单项打开并使用加载项。

　　创建命令条控件

　　1.查找 OnConnection 事件过程。在 Private Sub 和 End Sub 行之间，添加代码以创建新的命令条控件并将其指派给支持事件的 CommandBarButton 对象变量。整个过程将显示如下：

Private Sub IDTExtensibility2_OnConnection(ByVal _
Application As Object, ByVal ConnectMode As _
AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst _
As Object, custom() As Variant)

' 存储启动引用
Set appHostApp = Application

' 添加命令条
Set cbbButton = CreateBar()
End Sub

　　如果您熟悉使用 Visual Basic 创建加载项，就可能注意到，在 VBA 中创建加载项时，不用设置命令条按钮 OnAction 属性的值。这是因为事件自动为您挂起。

　　2.查找 OnDisconnection 事件过程。在 Private Sub 和 End Sub 行之间，添加代码以便在卸载加载项时删除命令条控件。整个过程将显示如下：

Private Sub IDTExtensibility2_OnDisconnection(ByVal _
RemoveMode As AddInDesignerObjects.ext_DisconnectMode, _
custom() As Variant)

RemoveToolbar
' 移除要关闭的引用
Set appHostApp = Nothing
Set cbbButton = Nothing
End Sub

　　3.通常，只要在代码中存储函数，就会在 OnConnection 过程中添加您调用的函数对应的代码。该函数将创建命令条，设置命令按钮的属性，并提供错误信息的处理。

Public Function CreateBar() As Office.CommandBarButton
' 指定命令条
Dim cbcMyBar As Office.CommandBar
Dim btnMyButton As Office.CommandBarButton

On Error GoTo CreateBar_Err

Set cbcMyBar = appHostApp.CommandBars.Add(Name:="GreetingBar")

' 指定命令条按钮
Set btnMyButton = cbcMyBar.Controls.Add(Type:=msoControlButton, _
Parameter:="Greetings")
With btnMyButton
.Style = msoButtonCaption
.BeginGroup = True
.Caption = "&Greetings"
.TooltipText = "Display Hello World Message"
.Width = "24"
End With

' 显示并返回命令条
cbcMyBar.Visible = True
Set CreateBar = btnMyButton
Exit Function

CreateBar_Err:
MsgBox Err.Number & vbCrLf & Err.Description
End Function

　　4.在 OnDisconnection 过程中添加您调用的函数对应的代码。该函数在加载宏被卸载时会删除命令条。

Private Function RemoveToolbar()
　appHostApp.CommandBars("GreetingBar").Delete
End Function

　　5.为 CommandBarButton 对象添加一个单击事件过程。该过程将在单击新的命令条按钮时被调用。下面的代码将显示一条消息以表明单击事件正在进行：

Private Sub cbbButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
　MsgBox ("Hello World!")
End Sub

　　6.保存您的工程。

　　现在，COM 加载项完成。其余的步骤就是调试和测试代码以确保它运行顺利，然后将加载项放入 DLL 文件中，该文件可以在其他装有 Office XP 的计算机上进行分发和使用。

对加载项进行调试和测试

　　当您在 VB 中开发 COM 加载项时，可以通过将工程置于运行模式而调试加载项。如果工程处于运行模式，就可以从 Office 应用程序中加载 COM 加载项并使用它，通过使用任何 VB 调试工具而对它进行测试和调试。

　　使用 VB 调试和测试 COM 加载项

　　1.将任何所需的断点、Stop 语句或监视放在代码中。(可先不做这步)

　　2.在“工程”菜单上,单击“属性”，在“调试”对话框中，选择“等待要创建的部件”，单击“确定”

　　3.在“运行”菜单上，单击“全编译执行”。这将对工程进行编译（当出现任何编译错误时将提出警告），然后将工程置于运行模式。

　　4.检查“[运行]”是否出现在VB的标题栏中。

　　注意必须发布加载项，宿主应用程序才能使用它。

　　4.启动一个新的 Excel 实例。因为将加载项的加载行为设为 "Startup"，所以只要启动应用程序，加载项就会加载，OnConnection 事件就会发生，于是出现 Greetings 按钮。现在，您可以使用为调试代码而添加的断点和 Stop 语句了。

　　如果单击 Greetings 按钮，则只要在 VB 中运行工程，Hello World 消息就会出现在编辑器之前（不在 Excel 之前）。在将工程生成为 DLL 文件后，该消息就会出现在 Excel 之前。

　　5.当完成调试和测试后，打开“运行”菜单，单击“终止工程”。这会清除临时文件和注册表项，并将工程置于正确的状态以生成 DLL 文件。

　　为 COM 加载项生成 DLL

　　编写并调试代码后，可以使您的加载项成为一个 DLL 以将其部署到其他装有 Office XP 的计算机上。

　　在 VB 中将 COM 加载项打包为 DLL

　　1.从“文件”菜单上，选择“生成 myAddin.DLL”。

　　2.在“生成工程”对话框中保存文件名 Greetings，并选择要用于保存工程的位置。

　　3.单击“确定”。 (此时，加载项可在本机正式使用）

　　这一步骤将创建 COM 加载项，添加适当的注册表项，并使COM 加载项可用于 Office 宿主中。创建加载项 DLL 时，VB 使用给外接程序设计器提供的信息，将 DLL 注册为 COM 加载项。VB 向注册表中写入加载项的名称、说明和初始加载行为设置。加载项的宿主应用程序读取这些注册表项并加载相应的加载项。

　　常见加载项开发问题疑难解答

　　当在开发环境中工作并在应用程序之间进行切换时，可能会遇到某些错误信息或意外行为。下面是一些常见问题及其解决方案。

　　出现编译错误或语句结束在编辑器中无效

　　要确保为工程引用了适当的对象库。

　　运行工程并打开新的宿主应用程序实例时没有任何反应
　
　　●要确保字“已发布的”出现在所运行的加载项的标题栏中。如果不如此，就必须运行工程。

　　●单击每个打开的应用程序窗口。您的对象可能正在运行，但只有在您单击所打开的应用程序的第一个实例时，它才是可见的。

　　●要确保正确地指定并设置模块级变量。

　　●在宿主应用程序中，要确保在“COM 加载项”对话框中选中了您的加载项。可以通过向工具栏中添加 COM 加载项命令而对宿主应用程序进行自定义。此命令将打开“COM 加载项”对话框。

　　将 COM 加载项对话框添加到工具栏中

　　1.打开EXCEL“工具”菜单，单击“自定义”，选择“命令”选项卡。在“类别”下，选择“工具”。沿“命令”列表向下滚动，以查找“COM 加载项”。将“COM 加载项”拖动到工具栏中，以创建新的按钮，然后关闭“自定义”对话框。

　　2.在该工具栏上，单击刚添加的“COM 加载项”按钮。

　　3.在“COM 加载项”对话框中，确认选中您的加载项旁边的复选框。若要卸载加载项，请清除该复选框。

　　对象出现在宿主应用程序中但没有响应

　　可能是有多个对象实例在运行。用于检测和移除已有的具有该名称的代码可能没在运行。检查并调试您的 OnDisconnection 代码。

cyberfan 2005-08-12 14:45 发表评论

用VB设计MSN信息群发软件

cyberfan — Fri, 12 Aug 2005 06:44:00 GMT

MSN是目前网络上广泛使用的一个即时信息交流工具(IM)，笔者就常用它与同事或朋友联系，但是在使用过程中发现缺乏一个群发信息的功能，于是笔者寻思着自己编写一个MSN信息群发的软件，在查阅了一番资料之后，终于写出来了。下面大家和我一起动手来自己做一个MSN的信息群发工具。

　　第一步：新建一个工程。启动VB，选择“文件”菜单的“新建”子菜单新建一个VB工程，系统回自动添加一个窗体,并且取名叫Form1。

　　第二步：添加MSN接口的引用。点击VB的IDE环境的菜单中的工程菜单，在弹出的下拉菜单中选择“引用（N）...”子菜单。在弹出的“引用”窗体中的“可用的引用”下拉列表中找到“Messenger API Type Library” 项，将起前面的钩打上，然后关闭“引用”窗口。参见图1

图1

　　第三步：设置窗体，添加控件。首先在vb的工程管理器中双击Form1，打开窗体设计环境。选中窗体，将它的Caption值改为“MSN消息群发”。然后在窗体上添加控件，并且设置其初始属性。要添加的控件的信息见下表：

名称类型 Caption属性的值
Label1 Label 群发对象:
Combo1 ComboBox
Check1 CheckBox 只发送在线的
Label2 Label 消息内容:
Text1 TextBox

Command1 CommandButton 发送[&O]
Command2 CommandButton 退出[&X]

　　添加完控件后调整其位置，最后形成图2的效果：

第四步：编写代码。

Dim m_MSG As New MessengerAPI.Messenger 'MSN的Com对象
Dim m_Groups As MessengerAPI.IMessengerGroups 'MSN中的分组
Dim m_Group As MessengerAPI.IMessengerGroup 'MSN中组的内容
Dim m_Contracts As MessengerAPI.IMessengerContacts 'MSN中的所有的好友的信息
Dim m_Contract As MessengerAPI.IMessengerContact 'MSN中每个好友对象的内容

Private Sub Command1_Click()

　Dim i As Integer
　'检测需要发送的信息是否合法
　If Trim(Text1.Text) = "" Then
　　MsgBox "发送的信息不能为空!", vbInformation, "提示"
　　Text1.SetFocus
　　Exit Sub
　End If
　'判断消息的发送对象是全部好友还是某个组的成员

　If Combo1.ListIndex = 0 Then
　　Set m_Contracts = m_MSG.MyContacts
　Else
　　Set m_Groups = m_MSG.MyGroups
　　Set m_Group = m_Groups.Item(Combo1.ListIndex - 1)
　　Set m_Contracts = m_Group.Contacts
　End If

'遍历要发送的对象,发送信息

　For i = 0 To m_Contracts.Count - 1
　　Set m_Contract = m_Contracts.Item(i)
　　If Check1.Value = 1 Then
　　　If m_Contract.Status = 2 Then
　　　　m_MSG.InstantMessage m_Contract '打开要发送的好友窗体
　　　　DoEvents
　　　　SendKeys Text1.Text '写入信息
　　　　DoEvents
　　　　SendKeys "{enter}" '发送出信息
　　　　DoEvents
　　　　SendKeys "%{F4}" '关闭好友窗口
　　　End If
　　Else
　　　m_MSG.InstantMessage m_Contract
　　　DoEvents
　　　SendKeys Text1.Text
　　　DoEvents
　　　SendKeys "{enter}"
　　　DoEvents
　　　SendKeys "%{F4}"
　　End If
　Next i
　'成功发送完毕信息
　If MsgBox("发送完毕!是否清空消息?", vbInformation + vbYesNo, "提示") = vbYes Then
　　Text1.Text = ""
　　Text1.SetFocus
　Else
　　Text1.SetFocus
　End If
End Sub

Private Sub Command2_Click()
　Unload Me
End

End Sub

'初始化控件

Private Sub Form_Load()
　Dim i As Integer
　'初始化发送对象的下拉框
　Set m_Groups = m_MSG.MyGroups
　With Combo1
　　.AddItem "全部的组"
　　For i = 0 To m_Groups.Count - 1
　　　Set m_Group = m_Groups.Item(i)
　　　.AddItem m_Group.Name
　　Next i
　　.ListIndex = 0
　End With
End Sub

'释放变量

Private Sub Form_Unload(Cancel As Integer)
　Set m_MSG = Nothing
　Set m_Groups = Nothing
　Set m_Group = Nothing
　Set m_Contracts = Nothing
　Set m_Contract = Nothing
End Sub

　　第五步：编译运行。选择“文件”菜单的生成“工程1.exe”菜单项，一个属于你的MSN信息群发软件就完成了。运行这个exe界面如下：

cyberfan 2005-08-12 14:44 发表评论

用VB定制口令登录控件

cyberfan — Fri, 12 Aug 2005 06:44:00 GMT

大家知道，为防止非授权人随意运行软件，可以在该软件中设置密码而达到保护软件不被随意运行的目的。如果直接在软件中设置密码，至少存在两点不足：1、密码容易被PCTOOLS之类的工具软件窥视到；2、给普通用户修改密码带来困难。为此，笔者用VB5.0制作口令登录ACTIVEＸ控件 PASSWORD.OCX，该控件将口令加密后以文件的形式保存，工具软件无法看到密码，而用户修改口令却很方便。笔者认为虽然自编的口令登录控件在加密算法方面比较简单，但因其不象专业加密软件那样广泛应用，不至于引起众多的解密者挖空心思对其解密，反而更安全。当你用兼容ACTIVEＸ控件的语言编写应用软件时，只需将PASSWORD.OCX控件加入你的软件之中，就可使应用软件具有口令登录的功能。
该控件将口令加密后以文件的形式储存在WINDOWS目录下。加密方法为:产生随机数与每个口令字符的ASCII码异或,再乘以该随机数后储存.并将随机数和口令长度加密后保存。该控件的具体制作过程如下：
1、设计控件外观。运行VB，选择新建ACTIVEＸ控件,制作如图1所示的登录窗体，把工程名称改为PASSWORD。

2、设置控件属性、方法。在VB菜单的外接程序里找到ACTIVEＸ控件向导，按照向导提示逐步完成。具体过程为：在选定界面成员窗体步骤中选中ＴＩＭＥＲ事件，在创建自定义界面成员步骤中定义ＯＰＥＮＰＡＳＷＤ方法及ＧＥＴＬＯＧＯＮＩＮＦＯ属性（获取登录成功与否的信息）、ＧＥＴＣＯＵＮＴＦＴ属性（获取输入口令次数的信息）和ＰＲＥＳＳ事件。在设置映射步骤中将TIMER事件映射到控件TIMER1，成员TIMER之中。在设置属性步骤中，将GETCOUNTFT及GETLOGONINFO属性数据类型设置为BOOLEAN，缺省值为0　。至此，ACTIVEＸ控件向导设置完成。
3、在控件中添加模块MODULE1,并在代码中加入如下申明：
DECLARE FUNCTION GETWINDOWSDIRECTORY LIB "KERNEL32" ALIAS "GETWINDOWSDIRECTORYA" _
(BYVAL LPBUFFER AS STRING, BYVAL NSIZE AS LONG) AS LONG '获取WINDOWS目录
4、编写控件代码，完成口令登录、口令修改功能，其代码如程序1所示。
5、编译PASSWORD.OCX控件。
口令登录控件编译完成之后，可以把它加入工具箱中，供应用程序使用。当我们把应用软件提供给用户时，可以通过安装程序把初始口令装在WINDOWS目录下，安装程序的创建可参考有关书籍。
为了演示该控件，先将初始口令为123的口令文件TST.DAT拷贝到WINDOWS目录下，在VB中建立标准的EXE工程，将PASSWORD.OCX 控件添加到工具箱中，制作如图2所示的窗体，编写如程序2所示代码，编译后运行，输入123便进入登录成功的FORM2窗体中,如果输入三次口令均不对则程序终止。在实际应用中FORM2窗体就应该是我们应用软件在口令登录成功后下一步需要作的内容。

本控件程序在WINDOWS ME、WINDOWS98,VB5.0环境下，调试运行通过。
TST.DAT的内容为："DON'T MODIFY THESE DATA"，191165，438555，126258860，126292595，126281350，3733101，3699366， 3665631，3631896，3598161，3564426，3530691，3496956，

程序1 （口令控件代码）
DIM PSW AS STRING
DIM PASOK AS BOOLEAN
DIM PASNEW AS STRING
DIM PASFIRST AS STRING
DIM PASNUM AS BOOLEAN
DIM LENG AS LONG
DIM PASOLD AS STRING
DIM FLAG AS STRING
DIM FIRST AS INTEGER
DIM LP AS LONG
DIM LPP AS LONG
DIM GETINFO AS BOOLEAN
DIM GETCOUNT AS BOOLEAN
DIM WINDIR AS STRING
DIM WINDIRLEN AS LONG
DIM WINDIRS AS STRING
PUBLIC EVENT PRESS()
'EVENT DECLARATIONS:
EVENT TIMER() 'MAPPINGINFO=TIMER1,TIMER1,-1,TIMER
PRIVATE SUB COMMAND1_CLICK() '如果口令正确就登录
STATIC LOOPNUM AS INTEGER
LOOPNUM = LOOPNUM + 1
IF LOOPNUM > 2 THEN GETCOUNT = FALSE '判断输入口令次数是否超过3次
PSW = "NO"
PASOLD = TEXT1.TEXT

CALL OPENPASWD

IF LENG <> LEN(TEXT1.TEXT) THEN PSW = "NO" '判断输入口令是否与原口令长度相等
IF STRCOMP(PSW, "NO") = 0 THEN
LABEL2.CAPTION = "口令错,请重新输入!"
TEXT1.TEXT = ""
TEXT1.SETFOCUS
ELSE:
GETINFO = TRUE '口令正确

END IF
RAISEEVENT PRESS
END SUB
PUBLIC SUB OPENPASWD() '打开口令文件
T = 0
ON ERROR RESUME NEXT ' 将错误处理的方式改为"继续下一行"。
OPEN WINDIRS & "\TST.DAT" FOR INPUT AS #1 '读取口令密文
IF ERR.NUMBER <> 0 THEN
P = MSGBOX("口令已被破坏无法运行", 16, "退出应用软件")
ERR.CLEAR
GETCOUNT = FALSE
END IF
INPUT #1, INFO, NUM, LENG
NUM = NUM / 17
LENG = (LENG / NUM) / 13 '解密口令长度及口令
DO WHILE T <= LENG - 1
T = T + 1
INPUT #1, CHR1
LP = CHR1 / NUM
LPP = LP XOR NUM
PASS = CHR(LPP)
IF STRCOMP(PASS, RIGHT(LEFT(PASOLD, T), 1)) <> 0 THEN
PSW = "NO"
ELSE: PSW = "YES"
END IF
LOOP
CLOSE
END SUB

PRIVATE SUB COMMAND2_CLICK() '如果输入正确的原口令就更改口令
INFO = "DON'T MODIFY THESE DATA"
IF PSW = "YES" THEN
PASNUM = TRUE
PASNEW = TEXT2.TEXT
IF STRCOMP(PASFIRST, PASNEW) = 0 THEN PASOK = TRUE

IF PASOK = TRUE THEN
T = 0
OPEN WINDIRS & "\TST.DAT" FOR OUTPUT AS #1 '将口令文件创建在WINDOWS目录下
SAV = PASNEW
RANDOMIZE
NUM = INT(10000 * RND(20)) + 1 + INT(RND(60) * 10000) '随机数
KK = LEN(SAV)
WRITE #1, INFO, NUM * 17, KK * NUM * 13, '将随机数及变换后的口令长度写入文件
DO WHILE T <= KK - 1 '加密口令
T = T + 1
CHRQ = LEFT(SAV, T)
CHR1 = RIGHT(CHRQ, 1)
LP = ASC(CHR1) XOR NUM
LPP = LP * NUM
WRITE #1, LPP,
LOOP
IF KK < 10 THEN '如果口令长度少于10个字符,继续写入字符,防止解密者猜测口令长度
LL = 10 - KK
DO WHILE LL >= 0
WRITE #1, NUM * KK * (LL + 100) + 123456,
LL = LL - 1
LOOP
END IF
CLOSE

LABEL2.FORECOLOR = QBCOLOR(3)
LABEL2.CAPTION = "口令更改成功!"
TIMER1.ENABLED = TRUE
END IF

IF PASNUM = TRUE AND PASOK = FALSE THEN '允许有三次确认新口令的机会
LABEL2.FORECOLOR = QBCOLOR(13)
LABEL2.CAPTION = "请再输入一次新口令!"
FIRST = FIRST + 1
IF FIRST = 1 THEN PASFIRST = PASNEW
IF FIRST > 3 THEN GETCOUNT = FALSE
TEXT2.TEXT = ""
TEXT2.SETFOCUS
END IF

ELSE:
STATIC LOOPNUM AS INTEGER '有三次机会输入原口令
LOOPNUM = LOOPNUM + 1
IF LOOPNUM > 2 THEN GETCOUNT = FALSE
PASOLD = TEXT2.TEXT
CALL OPENPASWD
IF LENG <> LEN(PASOLD) THEN PSW = "NO"
IF STRCOMP(PSW, "NO") = 0 THEN
LABEL2.FORECOLOR = QBCOLOR(12)
LABEL2.CAPTION = "口令错,请重新输入!"
TEXT2.TEXT = ""
TEXT2.SETFOCUS
END IF

IF STRCOMP(PSW, "YES") = 0 THEN
LABEL2.FORECOLOR = QBCOLOR(4)
LABEL2.CAPTION = "请输入新口令!"
TEXT2.TEXT = ""
TEXT2.SETFOCUS
PASNUM = TRUE
END IF
END IF
RAISEEVENT PRESS
END SUB

PRIVATE SUB OPTION1_CLICK() '更改口令
TEXT2.SETFOCUS
LABEL2.CAPTION = "请输入原口令!"
RAISEEVENT PRESS
END SUB

PRIVATE SUB TIMER1_TIMER() '延时2秒关闭登录窗口
GETCOUNT = FALSE
RAISEEVENT TIMER
END SUB
PUBLIC PROPERTY GET GETLOGONINFO() AS BOOLEAN
GETLOGONINFO = GETINFO
END PROPERTY

PRIVATE SUB USERCONTROL_INITIALIZE()
WINDIR = STRING(255, 0)
WINDIRLEN = GETWINDOWSDIRECTORY(WINDIR, 255)
WINDIRS = LEFT(WINDIR, WINDIRLEN)
PSW = "NO"
TIMER1.INTERVAL = 2000
LOOPNUM = 0
TIMER1.ENABLED = FALSE
PASNUM = FALSE
PASOK = FALSE
FIRST = 0
GETINFO = FALSE
GETCOUNT = TRUE
END SUB

PUBLIC PROPERTY GET GETCOUNTFT() AS BOOLEAN
GETCOUNTFT = GETCOUNT
END PROPERTY

程序2：（演示程序）
PRIVATE SUB USERCONTROL11_PRESS()
IF USERCONTROL11.GETLOGONINFO = TRUE THEN
UNLOAD FORM1
FORM2.SHOW
END IF
IF USERCONTROL11.GETCOUNTFT = FALSE THEN
UNLOAD FORM1
END IF
END SUB

PRIVATE SUB USERCONTROL11_TIMER()
IF USERCONTROL11.GETCOUNTFT = FALSE THEN

UNLOAD FORM1
END IF
END SUB

cyberfan 2005-08-12 14:44 发表评论

用VB 6.0编写电脑抽奖程序

cyberfan — Fri, 12 Aug 2005 06:43:00 GMT

近年来在娱乐节目之中常常见到利用电脑来抽奖，笔者对其发生了兴趣遂自己动手用VB编了一个小程序来实现电脑抽奖的小功能，其原理如下：

　　主要利用VB中的Rnd函数，来实现随机查找和打乱排序的功能，从而实现随机抽奖的目的。Rnd函数的语法结构是Rnd[(number)]，可选的 number参数是 single或任何有效的数值表达式。Rnd函数返回小于1但大于或等于0的值。number 的值决定了 Rnd 生成随机数的方式。为了生成某个范围内的随机整数，可使用以下公式：

Int((upperbound － lowerbound ＋ 1) × Rnd ＋ lowerbound)

　　这里，upperbound 是随机数范围的上限，而 lowerbound 则是随机数范围的下限。

　　另外，程序中还使用了INI文件，Windows INI文件,可解释为Windows初始化文件。它是一种专门用来保存应用程序初始化信息和运行环境信息的文本文件。ini文件是一种文本文件,它可以通过Notepad等文本编辑器进行编辑。ini文件具有特定的格式。一个INI文件是由若干个段(section)组成的,每个段中包含若干关键字 (key)及相应的值(value)。创建应用程序自己的INI文件,通过INI文件保存应用程序的一些运行环境信息,然后在程序中读取INI文件中的设置信息并据以处理。一旦程序的运行环境需要变更,则可以通过直接修改INI文件，或在程序中提供专门的界面间接地修改INI文件来保证程序的可用性。

　　源程序及注释如下：

　　'窗体源程序

Option Explicit
　　Dim m_strNameArray() As MyName
　　Dim m_bIsStart As Boolean
　　Dim m_nNameIndex As Integer
　　Dim MAX_INDEX As Integer
　　Dim m_nSelectNum As Integer
　　 '被选定数
　　Dim nScrollStep As Integer
　　Dim nScrollWidth As Integer
　　Dim bScrollState As Boolean
　　Dim nEnableSecond As Integer
　　Dim m_strTitle As String
　　Dim m_strAppTitle As String
　　Dim m_strScrollTitleLeft As String
　　Dim m_strScrollTitleRight As String

Private Sub Command_Start_Stop_Click()
　　If m_bIsStart = True Then
　　　'按停止钮
　　　m_bIsStart = False
　　　Command_Start_Stop.Caption =
　　　“开始"
　　　Label_FlashName.Visible = True
　　　Timer_FlashName.Enabled = True
　　　Timer_ScrollName.Enabled = False
　　　Label_FlashName =
　　　　m_strNameArray（m_nNameIndex).strName ＋ “中奖了！"
　　　m_strNameArray(m_nNameIndex).bIsSelect = True
　　　m_nSelectNum = m_nSelectNum ＋ 1
　　　Dim Temp As MyName
　　　Temp =m_strNameArray(MAX_INDEX)
　　　m_str Name Array(MAX－INDEX) = m_strNameArray(m_nNameIndex)
　　　m_strNameArray(m_nNameIndex) =Temp
　　　MAX_INDEX = MAX_INDEX － 1
　　　If MAX_INDEX = 0 Then
　　　　MsgBox “非常感谢您使用本软件"
　　　End If
　　Else '按开始钮
　　　m_bIsStart = True
　　　Command_Start_Stop.Caption = “停止"
　　　Command_Start_Stop.Enabled = False
　　　Timer_ScrollName.Enabled = True
　　　Timer_FlashName.Enabled = False
　　　Label_FlashName.Caption = “"
　　End If
End Sub

Private Sub Form_Load()
　　Form_Bouns.ScaleMode = 3
　　m_nNameIndex = 0
　　m_bIsStart = False
　　Timer_ScrollName.Enabled = True
　　Timer_ScrollTitle.Enabled = True
　　Label_FlashName.Visible = False
　　Label_ScrollName.Caption = “"
　　nEnableSecond = 0
　　'定义起始秒数
　　ReDimNameArray
　　'获得文本中的名字和打乱名字顺序
　　nScrollStep = 5 '设定滚动字的步长
　　nScrollWidth = Label_Congruation.Left
　　'设定title的移动宽度
　　bScrollState = False
　　'设定缺省的开始滚动方向为向左
　　m_nSelectNum = 0
　　'初始化被选定数为0
　　Init
　　'初始化本程序的界面
End Sub

Private Sub Timer_FlashName_Timer() '闪动中奖者姓名
　　If Label_FlashName.Visible = True Then
　　　Label_FlashName.Visible = False
　　Else
　　　Label_FlashName.Visible = True
　　End If
End Sub

Private Sub Timer_ScrollName_Timer() '滚动出现名字
　　If m_bIsStart = True Then
　　　If m_nNameIndex >= MAX_INDEX Then
　　　　m_nNameIndex = 0
　　　End If
　　　m_nNameIndex =m_nNameIndex ＋ 1
　　　If m_strNameArray(m_nNameIndex).bIsSelect = True Then
　　　　If m_nNameIndex < MAX－INDEX Then
　　　　　m_nNameIndex =
　　　　　m_nNameIndex ＋ 1
　　　　Else
　　　　　m_nNameIndex = 0
　　　　End If
　　　End If
　　　Label_ScrollName.Caption = m_str
　　　NameArray(m_nNameIndex).strName
　　　'End If
　　End If
End Sub
　　
Private Sub Timer_ScrollTitle_Timer() '滚动“恭喜发财"字样
　　If bScrollState = False Then '向左滚
　　　nScrollStep = 10
　　　Label_Congruation.Caption = m_strScrollTitleLeft
　　　If nScrollWidth > 0 Then
　　　　nScrollWidth =
　　　　nScrollWidth － nScrollStep
　　　Else
　　　　bScrollState = True
　　　End If
　　Else '向右滚
　　　nScrollStep = －10
　　　Label_Congruation.Caption =
　　　m_strScrollTitleRight
　　　If nScrollWidth < Form_Bouns.ScaleWidth －
　　　　　　　Label_Congruation.Width Then
　　　　nScrollWidth =
　　　　nScrollWidth － nScrollStep
　　　Else
　　　　bScrollState = False
　　　End If
　　End If
　　Label_Congruation.Left = nScrollWidth
　　'以下为8秒钟内使“停止"按钮有效
　　If nEnableSecond <= 49 Then
　　　If m_bIsStart = True Then
　　　　nEnableSecond =nEnableSecond ＋ 1
　　　End If
　　Else
　　　If m_bIsStart = True Then
　　　　Command_Start_Stop.Enabled = True
　　　　nEnableSecond = 0
　　　End If
　　End If
End Sub

　　'动态定义数组

Private Sub ReDimNameArray()
　　Dim nMaxIndex As Integer
　　Dim strMaxIndex As String
　　Dim nIndex As Integer
　　Dim bIsBegin As Boolean
　　bIsBegin = False
　　nIndex = 0
　　Open App.Path ＋ “\name.txt" For Input As ＃1 '读文件
　　Do Until EOF(1)
　　　If bIsBegin = False Then
　　　　Line Input ＃1, strMaxIndex
　　　　nMaxIndex = Val(strMaxIndex)
　　　　MAX_INDEX = nMaxIndex － 1
　　　　ReDim m_strNameArray(0 To nMaxIndex － 1)
　　　　bIsBegin = True
　　　Else
　　　　Line Input ＃1, m_strNameArray(nIndex).strName
　　　　m_strNameArray(nIndex).bIsSelect = False
　　　　nIndex = nIndex ＋ 1
　　　End If
　　Loop
　　'以下为打乱人员顺序10次
　　Dim i As Integer
　　Dim j As Integer
　　Dim Temp As String
　　Dim nRandomNum As Integer
　　For j = 0 To 10
　　　For i = 0 To nMaxIndex － 1
　　　　nRandomNum = ((nMaxIndex － 1) × Rnd) '利用Rnd函数
　　　　Temp = m_strNameArray(i).strName
　　　m_strNameArray(i).strName = m_strNameArray(nRandomNum).strName
　　　　m_strNameArray(nRandomNum).strName = Temp
　　　Next i
　　Next j
　　End Sub
　　
Private Sub Init() '读取INI文件
　　Dim X As Long
　　Dim lpFileName
　　Dim Temp As String × 50
　　lpFileName = App.Path ＋ “\Sortition.ini"
　　X = GetPrivateProfileString(“SYSTEM",“AppTitle",“抽奖程序", Temp, Len(Temp), lpFileName)
　　m_strAppTitle = Trim(Temp)
　　Temp =“"
　　X = GetPrivateProfileString(“SYSTEM", "Title", "欢迎使用抽奖程序", Temp, Len(Temp), lpFileName)
　　m_strTitle = Trim(Temp)
　　Temp = “"
　　X = GetPrivateProfileString(“SYSTEM",“ScrollTitleRight", “恭喜发财!!!", Temp, Len(Temp), lpFileName)
　　m_strScrollTitleRight = Trim(Temp)
　　X = GetPrivateProfileString(“SYSTEM",“ScrollTitleLeft", “龙年大发!!!", Temp, Len(Temp), lpFileName)
　　m_strScrollTitleLeft = Trim(Temp)
　　Form_Bouns.Caption = m_strAppTitle
　　Label_CompanyTitle.Caption = m_strTitle
　　End Sub

　　模块源程序：

　　'用于读取ini文件的API函数
　　Declare Function GetPrivateProfileString Lib “kernel32" Alias “GetPrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
　　Public Type MyName
　　　strName As String
　　　bIsSelect As Boolean
　　End Type

　　由于程序利用的windows ini文件保存一些标题信息，因而可以方便的修改使用环境,及标题内容。

　　见ini文件内容：

　[SYSTEM]
　　　;应用程序的form名称
　　　AppTitle=“风云电脑抽奖Test"
　　　;窗口的内的标题(限9个字)
　　　Title=“大抽奖"
　　　;右滚动的文字(仅能为如下格式:XXXX!!!)
　　　　ScrollTitleRight=“恭喜发财!!!"
　　　;左滚动的文字(仅能为如下格式:XXXX!!!)
　　　ScrollTitleLeft=“祝您好运!!!"

　　如此一个小小的电脑抽奖程序便完成了。

　　以上程序在VB6.0 Windows98环境下编译通过

cyberfan 2005-08-12 14:43 发表评论

用VB实现COM+组件配置

cyberfan — Fri, 12 Aug 2005 06:43:00 GMT

在Windwos2000的管理工具里有一个“组件服务”工具，可以实现对COM+组件的应用的安装、启动、删除和对组件的安装、删除。这在安装一个有 COM+组件的应用系统时时非常有用的，我们可以通过程序控制一个组件添加删除，可以通过程序实现这个过程的自动化，而不必人工停止应用再安装组件！
现在我们来讨论怎样用VB程序实现这个工具的这些功能。
一、COMAdmin接口简介
COMAdmin接口是实现这些功能的关键对象，它有有三个基本接口,分别是IcomAdminCatalog,IcatalogCollection, IcatalogObject,调用这三个接口的相关属性方法可以实现对COM组件的添加、删除、应用的添加、删除、启动、关闭等功能。
1、IcomadminCatalog接口介绍
IcomAdminCatalog接口代表COM+ Catalog本身。
方法：GetCollection可以取得COM+ Catalog中包含的集合。
2、IcatalogCollection接口介绍
IcatalogCollection接口可以枚举内容、读取、增加、删除集合项目。
方法：Populate让集合填入内容；
方法：PopulateBykey同Populate,但让集合从akeys指定项读取数值；
方法：remove删除一个对象，参数是对象在集合中的索引；
方法：SaveChanges保存对属性的改变，无参数，返回保存的改变次数。
3、IcatalogObject接口介绍
属性：Name:包含目录对象的只读属性；
属性：Key:包含目录对象的唯一项的只读属性，这个属性用于需要对象项的方法，如PopulateByKeys ；
属性：Valid:表示对象是否有效的只读属性；
属性：Value包含对象所支持的任何命名属性值的读/写属性，每个目录对象支持的一组命名属性。
二、程序设计思路
建立对应用和组件的控制函数，在应用列表框中列表出本机上的应用名，在属性列表框显示所选择应用中包含的组件，通过工具条按钮事件实现对所选择的应用或组件的添加、删除、启动、关闭的功能。
要实现这些功能，我们计划有如下几个函数：
1． Createocatalog 创建取得应用集合的COMAdminCatalogCollection 对象；
2． Addapp 创建应用函数；
3． Deleteapp 删除应用函数；
4． Startobject 启动一个应用函数；
5． Stopobject 停止应用函数；
6． Addcomponent 在一个应用中添加一个组件；
7． Deletecomponent 在一个应用中删除一个组件；
8． Displayobjects 在应用列表框中显示应用名；
9． Disaplaycomponent 在应用组件列表框中显示所选则的应用中的组件名。
三、VB程序的实现
1、主界面的设计

(图一)

如图一，将应用名列表放在左边的列表框lbobject内，选择一个应用，则在右边列出这个应用中的COM组件名。当我们选择一个应用或组件时，可以选择工具条上相关的操作对应用或COM+组件进行控制。
2、程序实现步骤
首先在定义变量如下
Option Explicit
Public ocatalog As COMAdminCatalog
Public ocatcol As COMAdminCatalogCollection
Public ocatobj As COMAdminCatalogObject
然后我们定义一个函数实现取得COM+应用的集合.
Private Function createocatalog() As Boolean
createocatalog = False
'创建catalog对象
Set ocatalog = New COMAdminCatalog
'得到应用连接
Set ocatcol = ocatalog.GetCollection("Applications")
createocatalog = True
End Function
接下来我们在Form的启动事件里写上如下代码：
Private Sub Form_Load()
If App.PrevInstance Then
Unload Me
MsgBox "程序已经运行！"
Exit Sub
End If
form1.Show
If createocatalog() Then
StatusBar1.Panels(2) = "连接COMADMIN成功"
displayobjects ocatcol
Else
StatusBar1.Panels(2) = "连接COMADMIN失败!"
MsgBox "连接失败，请确认系统是否安装的组件服务！"
End If
End Sub
到这里我们实现了对组件应用对象的连接，接下来就是对这些对象的操作。我们先定义这样一些函数：
Public Function addapp(Optional name As String = "NewAppliation", Optional activation As Integer = 1, Optional Identity As String = "Interactive User") As String
'添加一个应用
On Error GoTo errd
Set ocatobj = ocatcol.Add '添加一个新应用
ocatobj.Value("Name") = name '设置这个应用的属性
ocatobj.Value("Activation") = activation
ocatobj.Value("Identity") = Identity
ocatcol.SaveChanges '保存关于ocatcol对象的改变
addapp = "OK"
Exit Function
errd:
addapp = Err.Description '如果出错返回错误信息
End Function
（addapp函数实现添加一个组件应用,参数name是要为这个新应用确定一个名字，我们可以默认是NewApplication,Activation和Indentity分别是配置这个应用的相关属性）
Public Function deleteapp(name As String) As String '参数name是应用的PROGID
If name <> "" Then
Dim oo As Object
Dim i As Integer
i = 0
On Error GoTo errd
ocatcol.Populate '首次取得目录集合时，缺省为空，需要调用Populate来填入内容
For Each oo In ocatcol
If oo.name = name Then
ocatcol.Remove i '删除索引号为i的组件应用
ocatcol.SaveChanges '保存
End If
i = i + 1
Next
End If
deleteapp = "ok"
Exit Function
errd:
addapp = Err.Description
End Function
（函数deleteapp实现删除名字为name的一个组件应用。）
Public Function startobject(name As String) As String '参数name是应用的PROGID
Dim oo As Object
On error goto errd
ocatcol.Populate
For Each oo In ocatcol
If oo.name = name Then
ocatalog.StartApplication oo.Key '启动一个应用
End If
Next
startobject = "OK"
Exit function
errd: '错误处理
startobject = Err.Description
End Function
（函数startobject实现启动名字为name的一个组件应用。）
Public Function stopobject(name As String) As String
Dim oo As Object
On error goto errd
ocatcol.Populate
For Each oo In ocatcol
If oo.name = name Then
ocatalog.ShutdownApplication oo.Key '停止这个应用
End If
Next
Stopobject = "OK"
Exit funcition
Errd:
Stopobject = Err.Description.
End Function
（Stopobject函数实现停止一个应用）
到这里我们已经实现了对应用的控制，下面我们来实现对组件的控制。
Public Function addcomponent(name As String, filename As String) As String
Dim oo As Object
On error goto errd
For Each oo In ocatcol
If oo.name = name Then
ocatalog.InstallComponent name, filename, "", "" '在这里实现安装组件到一个应用
End If
addcomponent = "OK"
exit function
Next
Errd:
addcomponent = err. Description
End Function
（addcomponent实现在一个应用里安装一个新的组件，参数name是应用名(PROGID),filename是组件文件(即.DLL文件)的完整路径）
Public Function deletecomponent(name As String, componentname As String) As String
Dim oo As Object
Dim okey As Variant
Dim components As Object
Dim i As Integer
On error goto errd
ocatcol.Populate
For Each oo In ocatcol
If oo.name = name Then
okey = oo.Key
End If
Next
Set components = ocatcol.GetCollection("Components", okey)
components.Populate
If components.Count > 0 Then
i = 0
For Each oo In components
If oo.name = componentname Then
components.Remove i
components.SaveChanges
End If
i = i + 1
Next
Deletecomponent = "OK"
Exit function
Else
Deletecomponent = "当前选择应用中没有组件！"
End If
Errd:
Deletecomponent = err. Description
End Function
（Deletecomponent实现在一个应用里删除一个组件，参数name是应用名(PROGID), componentname是组件名(即组件的PROGID)）
到这里，我们已经可以调用这些函数实现对组件的控制了，下面我们就来看看怎么样调用这些函数实现对组件的完全控制。
首先我们还需要添加两个过程：
Public Sub displayobjects(CurrentConnection As COMAdminCatalogCollection)
Dim oo As Object
CurrentConnection.Populate
With lbobject
.Clear
For Each oo In CurrentConnection
.AddItem oo.name '我们将取得的对象集合的的应用名添加到对象列表框中去
Next
End With
End Sub
（displayobjects过程实现将传入的集合显示在应用列表框中去）
Public Function disaplaycomponent(name As String, CurrentConnection As _
COMAdminCatalogCollection) 'name是应用名，CurrentConnection是已经取得应用对象的集合
Dim oo As Object
Dim okey As Variant
Dim components As Object
CurrentConnection.Populate
For Each oo In CurrentConnection
If oo.name = name Then
okey = oo.Key '取得CurrentConnection集合中名为name的应用的CLSID
End If
Next
Set components = CurrentConnection.GetCollection("Components", okey)
components.Populate
With lbcomponent
.Clear
For Each oo In components
.AddItem oo.name '将组件名添加进组件列表框中
Next
End With
End Function
（displayobjects过程实现将传入的应用的组件显示在组件列表框中）
好，有了这些函数过程，我们就能调用他们实现对应用、组件的显示和控制了。
下面的代码是调用这些函数的例子。
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case Is = 1 '刷新列表
displayobjects ocatcol
StatusBar1.Panels(1) = "刷新列表:"
StatusBar1.Panels(2) = "刷新列表成功！"
Case Is = 2 '添加应用
form2.Show vbModal, Me
StatusBar1.Panels(1) = "添加应用："
StatusBar1.Panels(2) = "添加应用成功！"
Case Is = 3 '删除应用
If lbobject.Text <> "" Then
deleteapp lbobject.Text
displayobjects ocatcol
StatusBar1.Panels(1) = "删除应用："
StatusBar1.Panels(2) = "删除应用成功！"
Else
MsgBox "请选择一个应用！"
End If
Case Is = 4 '启动当前应用
If lbobject.Text <> "" Then
StatusBar1.Panels(1) = "启动当前应用："
StatusBar1.Panels(2) = "正在启动当前应用．．．"
startobject lbobject.Text
StatusBar1.Panels(2) = "启动当前应用成功！"
Else
MsgBox "请选择一个应用！"
End If
Case Is = 5 '停止应用
If lbobject.Text <> "" Then
StatusBar1.Panels(1) = "停止当前应用："
StatusBar1.Panels(2) = "正在关闭当前应用．．．"
stopobject lbobject.Text
StatusBar1.Panels(2) = "正在关闭当前应用成功！"
Else
MsgBox "请选择一个应用！"
End If
Case Is = 6 '安装组件
If lbobject.Text <> "" Then
On Error GoTo errhandler
CommonDialog1.Filter = "组件文件 (*.dll) | *.dll"
CommonDialog1.ShowOpen
Dim filename As String
filename = Trim$(CommonDialog1.filename)
StatusBar1.Panels(1) = "安装组件："
StatusBar1.Panels(2) = "正在将组件安装进当前应用．．．"
addcomponent lbobject.Text, filename
StatusBar1.Panels(2) = "组件安装成功！"
disaplaycomponent lbobject.Text, ocatcol
Exit Sub
Else
MsgBox "请选择一个应用，再安装组件！"
End If
errhandler:
'按了cancel按钮
Exit Sub
Case Is = 7 '删除组件
If lbobject.Text = "" Then
MsgBox "请选择一个应用！"
Exit Sub
End If
If lbcomponent.Text = "" Then
MsgBox "请选择一个组件！"
Exit Sub
End If
deletecomponent lbobject.Text, lbcomponent.Text
StatusBar1.Panels(1) = "删除组件："
StatusBar1.Panels(2) = "删除组件成功！"
disaplaycomponent lbobject.Text, ocatcol
Case Is = 8 '关于程序
MsgBox "这个程序是COM组件的控制的程序,VB6.0开发，在win2000下调试通过！欢迎指教！"
End Select
End Sub
到这里程序完成。同样，ComAdmin的调用方法可以运用到ASP,VC等程序中去。
程序在Windows2000系统下调试通过。有关ComAdmin的详细信息请参看http: //msdn.microsoft.com/library/default.asp?URL=/library/psdk/cossdk/icomadmincatalog_61wu.htm

cyberfan 2005-08-12 14:43 发表评论

用VB6编写强力的windows隐藏引擎

cyberfan — Fri, 12 Aug 2005 06:42:00 GMT

编程爱好者一定经常见到能够隐藏桌面项目和状态栏等的软件，其中最著名的就是Hide-It。其实我们能够编写一个功能更加强大的即时超级隐藏引擎，它不仅可以隐藏桌面项目、开始按钮、状态栏、时钟栏，而且可以隐藏任何软件的按钮、菜单、工具栏、文本框、状态栏等等，只要是能够看见的独立部分——当然也可以轻松的将它们恢复出来。操作更是方便到了点击“开始隐藏”按钮，然后将鼠标放到需要隐藏的项目上，按下F12键即可——点哪就隐藏哪——这也是我称之为 “隐藏引擎”的原因。

　　一、编程原理

　　（1）WINDOWS API函数ShowWindow可以实现对程序界面（包括WINDOWS9X和其他应用软件）以及子项目的显示控制，通过调用相关消息常数SW_HIDE = 0（隐藏）和SW_SHOW = 5（显示）就可以执行对指定界面项目的隐藏和重新显示出来。它所需要的另外一个参数是被隐藏项目的句柄；

　　（2）GetCursorPos函数能够返回当前鼠标所在位置的屏幕坐标，而函数WindowFromPointXY恰好能够根据屏幕坐标返回该位置的窗体项目句柄——这正是我们所需要的！

　　（3）为了方便操作，我们需要为它注册一个系统级工作（激活）热键，我选择了F12；SetWindowLong、GetWindowLong、 CallWindowProc、RegisterHotKey、UnregisterHotKey是五个必须的热键注册、反注册函数；使用它们一定要小心谨慎，否则可能会导致开发平台的暂时崩溃，你不得不看到“该程序执行了非法操作，即将被关闭”的警示窗口，而且你的工作成果会立即化为乌有；但是如果你按照本文的编写方法，保你“一路平安”；

　　（4）为了方便“记忆力”不好的朋友，我们需要一个列表框来显示已经被隐藏的项目的句柄，以便能够适当、必要的提醒。
　　二、编程实践

　　（1）启动vb6，建立一个标准exe工程，添加一个窗体CHINAHIDE，添加四个command控件hideOK对应“开始隐藏”、 unhide对应“恢复一个”、uNhideall对应“全部恢复”；添加listbox控件list1（用来纪录句柄）；两个标签控件用来显示有关提示信息。调整上述控件到适当位置和合适大小，双击窗体，写入以下代码：

Dim LasthWnd As Integer '被隐藏项目句柄

Private Sub Form_Load()
　'程序启动时注册功能热键F12
　preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
　SetWindowLong Me.hwnd, GWL_WNDPROC, AddressOf Wndproc
　uVirtKey = vbKeyF12
　RegisterHotKey Me.hwnd, 1, Modifiers, uVirtKey
End Sub

Private Sub uNhideall_Click()
　'恢复所有被隐藏项目
　For res = 0 To List1.ListCount - 1
　　LasthWnd = List1.List(res)
　　ShowWindow LasthWnd, SW_SHOW
　Next res
　List1.Clear
　'清空句柄列表框
End Sub

Public Sub hideOK_Click()
　'当"开始隐藏"按钮被点击时，将窗口最小化
　Me.WindowState = 1
End Sub

Private Sub UNHIDE_Click()
　'恢复一个选定的被隐藏项目
　If List1.ListIndex < 0 Then
　　MsgBox "请首先选择一个被恢复的隐藏项目！", vbExclamation
　　Exit Sub
　End If'验证句柄列表栏目是否已经被选中
　hideINDEX = List1.ListIndex
　LasthWnd = List1.List(hideINDEX)
　X = ShowWindow(LasthWnd, SW_SHOW)
　'恢复选定的被隐藏项目
　List1.RemoveItem (hideINDEX)
　'移除该项目有关信息
End Sub

Private Sub Form_Unload(Cancel As Integer)
　'当程序被关闭时，取消已经注册的热键
　SetWindowLong Me.hwnd, GWL_WNDPROC, preWinProc
　UnregisterHotKey Me.hwnd, uVirtKey
　'取消系统级热键,释放资源
　End'终止程序运行
End Sub
　'主窗体代码结束

　　（2）添加一个标准模块，命名为MOULDLE1，写入以下代码：

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'在窗口结构中为指定的窗口设置信息

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
'从指定窗口的结构中取得信息

Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'运行指定的进程

Public Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal ID As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
'向系统注册一个指定的热键

Public Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal ID As Long) As Long
'取消热键并释放占用的资源
'上述五个API函数是注册系统级热键所必需的，具体实现过程如后文所示

Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
'本函数是实现隐藏的核心，参数HWND既是需要隐藏项目的句柄
'nCmdShow参数可以决定使隐藏还是显示

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'本函数得到当前鼠标所在位置的屏幕坐标

Public Declare Function WindowFromPointXY Lib "user32" Alias "WindowFromPoint" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
'本函数根据屏幕坐标返回被隐藏项目的句柄

Public Type POINTAPI
　X As Long
　Y As Long
End Type'鼠标坐标类型定义

Public Const SW_HIDE = 0'隐藏常数
Public Const SW_SHOW = 5'显示常数

Public Const WM_HOTKEY = &H312
　'热键标志常数,用来判断当键盘按键被按下时是否命中了我们设定的热键
Public Const GWL_WNDPROC = (-4)

Public preWinProc As Long, MyhWnd As Long,uVirtKey As Long
　'定义系统的热键,原中断标示,被隐藏的项目句柄
　'请紧记下面的热键拦截函数,它将对你将来编写WINDOWS32高级控制程序大有帮助!
Public Function Wndproc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'热键拦截过程
　If Msg = WM_HOTKEY Then'如果拦截到热键标志常数
　　If wParam = 1 Then
　　　'如果是我们的定义的热键F12...
　　　'为了节省篇幅，我对热键拦截处理不是非常严密...
　　　hideDONE
　　　'执行隐藏鼠标所指项目
　　End If
　　End If
　　'如果不是热键,或者不是我们设置的热键,交还控制权给
　　'系统,继续监测热键
　　Wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function

Public Sub hideDONE()'最关键的项目隐藏过程
Public Sub hideDONE()
Dim pt32 As POINTAPI
GetCursorPos pt32 ''得到鼠标屏幕坐标
MyhWnd = WindowFromPointXY(pt32.X, pt32.Y)
''得到所在位置窗体项目句柄
If MyhWnd = Chinahide.hwnd Then Exit Sub
'拒绝隐藏程序自身
Chinahide.List1.AddItem (MyhWnd)
''添加相关信息
ShowWindow MyhWnd, SW_HIDE
'执行隐藏功能
End Sub
‘模块结束
　
　　本文代码不仅将向编程爱好者展示“隐藏引擎”的魅力，也将让您立刻成为一个后台控制和系统级热键的编程高手。它适用于windows95/98/nt4/me/2000，vb5/6开发平台。

　　看到这里，你一定会想到能够将它应用到哪里了吧(譬如加个密码就可以保护你的桌面！)——心动不如行动，DO IT BY YOUSELF!

cyberfan 2005-08-12 14:42 发表评论

用VB为软件增加注册功能

cyberfan — Fri, 12 Aug 2005 06:42:00 GMT

在尊重软件著作权的时代，电子注册版软件的应用也越来越广。它的出现使用户对程序中未受限制的功能有了一定了解，起到了推广和传播作用，同时也很好地保护了制作人的切身利益。那么，我们如何制作一个电子注册版软件呢？

　　经过摸索，笔者利用VB也简单地制作了一个电子注册版软件。

　　设计原理
　　利用API中的“GetVolumeInformation”函数提取使用者机器的硬盘序列号为特征码，注册时提交此码，经过软件著作权人加以运算，给出注册码，最后软件使用人输入注册码完成整个注册过程（为使说明简单，本例中以特征码减101做为注册码）。

　　新建一模块文件
　　新建一模块文件，并将如下声明的语句和常量添加到Module1.Bas模块中：

　　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

　　Global GetVal As Long

　　编程时需注意的是要将声明语句写在同一行中。

　　窗体设置
　　在Form1上添加2个文本框，Name属性分别设置为Text1、Text2；再添加1个按钮，Name属性设置为Command1。

　　添加代码
　　将如下程序代码添加到Form1的Form1_Load事件中：

　　Private Sub Form_Load()

　　Dim TempStr1 As String * 256

　　Dim TempStr2 As String * 256

　　Dim TempLon1 As Long

　　Dim TempLon2 As Long

　　………

　　‘读取是否注册的信息，如何控制这里不再说明

　　………

　　Call GetVolumeInformation("C:", TempStr1, 256, GetVal, TempLon1, TempLon2, TempStr2, 256)

　　Text1.Text = GetVal ‘提取本机C盘的序列号至文本框一

　　End Sub

　　将如下程序代码添加到Command1的Command1_Click事件中：

　　Private Sub Command1_Click()

　　If Text2 〈〉 CStr(GetVal) Then

　　MsgBox "注册码不正确，请认真检查输入是否正确。"

　　Else

　　MsgBox "你已经成功注册，请重新启动本软件。"

　　………

　　（将正确注册的信息写入，使软件功能以后不受限制。具体方法依个人爱好进行设置。）

　　………

　　End If

　　End Sub

　　至此，我们可以运行一下程序。你会发现我们已经简单地实现了利用硬盘序列号制作电子注册版软件的功能。

cyberfan 2005-08-12 14:42 发表评论

用VB6.0实现数字签名

cyberfan — Fri, 12 Aug 2005 06:41:00 GMT

如果你在网络上传递一份数据，但却存在着种种不安全的因素，使你对数据能否原封不动地到达目的地而心存疑惑，这时，你就可以给数据加上数字签名，使对方可以通过验证签名来检查你所传过去的数据是否已被他人修改。

　　数据签名原理

　　----使用公共密钥加密算法对信息进行加密是非常耗时的，因此加密人员想出了一种办法来快速地生成一个代表你的消息的简短的、独特的消息摘要，这个摘要可以被加密并作为你的数字签名。

　　----通常，产生消息摘要的快速加密算法被称为单向杂凑函数。一种单向杂凑函数不使用密钥，它只是一个简单的公式，把任何长度的一个消息转化为一个叫做消息摘要的简单的字符串。当使用一个16位的杂凑函数时，杂凑函数处理的文本将产生一个16位的输出。例如，一个消息可能产生一个像 CBBV235ndsAG3D67 的字符串。每一个消息产生一个随机的消息摘要，用你的私有密钥对摘要进行加密就生成了一个数字签名。

　　----举一个例子:

　　----假设发送者A对他的消息计算一个消息摘要，然后用他的私有密钥对消息摘要进行加密，并把数字签名和原文一起发送给B。

　　----当B使用A的公开密钥解密数字签名，他就得到了A计算的消息摘要的一个备份。因为他能够用A的公开密钥对数字签名进行解密，他知道是A 产生的，这样就验证了发送者的身份。B然后使用相同的杂凑函数（在先前就协商好的）来计算A发送来的明文的消息摘要。如果他计算出来的摘要和A发送给他的摘要是相同的，这样他就可以确认数字签名是正确的，这不仅意味着是A发送的消息，而且消息在发送的过程中没有发生改变。一个相同的消息摘要意味着消息没有被改变，这种方法的一个问题是消息本身是作为明文的形式发送的，因此没有达到保密的要求。但编程人员可以采用一种使用秘密密钥的对称加密算法来加密消息的明文部分。

　　----编程人员利用Windows的CAPI接口，就可以实现数据的加密、解密和数字签名。

　　----数据签名的流程如下图所示：

　　程序原理

　　----数据签名主要使用以下两个函数：

　　＃include
　　BOOL WINAPI CryptSignHash(
　　HCRYPTHASH hHash, // in
　　DWORD dwKeySpec, // in
　　LPCTSTR sDescription,//in
　　DWORD dwFlags, // in
　　BYTE ＊pbSignature, // out
　　DWORD ＊pdwSigLen // in/out
　　);
　　
　　＃include
　　BOOL WINAPI CryptVerifySignature(
　　BYTE ＊pbSignature, // in
　　DWORD dwSigLen, // in
　　HCRYPTKEY hPubKey, // in
　　LPCTSTR sDescription, // in
　　DWORD dwFlags // in
　　);

　　----由于这两个函数是C语言的定义，其中的pbSignature变量是用户数据（二进制类型）的缓冲区的指针，而在VB中是没有指针这个定义的，因此，笔者通过利用VB的BYTE数组实现了C语言的指针。

　　----以上两个函数在VB中的定义如下：

Private Declare Function CryptSignHashA Lib “advapi32.dll" (ByVal hHash As Long, _
ByVal dwKeySpec As Long, ByVal sDescription As String, ByVal dwFlags As Long, _
　　ByRef pbSignature As Byte, pdwSigLen As Long) As Long

Private Declare Function CryptVerifySignatureA Lib “advapi32.dll" (ByVal hHash As Long, _
ByRef pbSignature As Byte, ByVal dwSigLen As Long, ByVal hPubKey As Long, _
　　ByVal sDescription As String, ByVal dwFlags As Long) As Long

cyberfan 2005-08-12 14:41 发表评论

使用Visual Basic修改宏来打印当前页

cyberfan — Fri, 12 Aug 2005 06:40:00 GMT

经常需要打印文档的朋友可能都遇到过这样的情况，明明只要打印文档的当前页，一不小心按下了工具栏中的［打印］按钮，结果把文档中的所有页面都打印出来了。如果从“文件”菜单中选择“打印”，再选“当前页”，非常麻烦是不是？那么有没有方便一点的办法呢？

　　依次执行菜单［工具］→［宏］→［录制新宏］，出现“录制宏”窗口。先为宏取一个名字，就叫做“PrintCurrentPage”好了；接着点击［键盘］按钮，为宏指定一个快捷键，即在随后出现的新窗口中，按下一组快捷键后点击［指定］(注意，一定要按下“指定”，否则快捷键将不生效)。此处我定义的是［Alt+Z］，好处是不会与别的快捷键相冲突。点击［关闭］后，就开始进入录制宏的程序了，不过我们并非真正需要录制宏，所以就执行［工具］→ ［宏］→［停止录制］中止当前程序。

　　接下来才是核心任务，依次点击［工具］→［宏］→［宏］，选择宏“PrintCurrentPage”，点“编辑”后进入Microsoft Visual Basic编辑界面，在此对该宏进行修改。将“Sub PrintCurrentPage()”和“End Sub”之间的所有内容全部删除，并增加这么一行：

　　Application.PrintOut FileName:="", Range:=wdPrintCurrentPage

　　其后保存退出即可，至此大功告成！

　　以后，再遇到打印文档当前页的任务，二话不说，按下快捷键［Alt+Z］准没错。

cyberfan 2005-08-12 14:40 发表评论

如何实现VB与EXCEL的无缝连接

cyberfan — Fri, 12 Aug 2005 06:39:00 GMT

VB是常用的应用软件开发工具之一，由于VB的报表功能有限，而且一但报表格式发生变化，就得相应修改程序，给应用软件的维护工作带来极大的不便。因此有很多程序员现在已经充分利用EXECL的强大报表功来实现报表功能。但由于VB与EXCEL由于分别属于不同的应用系统，如何把它们有机地结合在一起，是一个值得我们研究的课题。

　　一、 VB读写EXCEL表：

　　VB本身提自动化功能可以读写EXCEL表，其方法如下：

　　1、在工程中引用Microsoft Excel类型库：

　　从"工程"菜单中选择"引用"栏；选择Microsoft Excel 9.0 Object Library（EXCEL2000），然后选择"确定"。表示在工程中要引用EXCEL类型库。

　　2、在通用对象的声明过程中定义EXCEL对象：

Dim xlApp As Excel.Application
Dim xlBook As Excel.WorkBook
Dim xlSheet As Excel.Worksheet

　　3、在程序中操作EXCEL表常用命令：

Set xlApp = CreateObject("Excel.Application") '创建EXCEL对象
Set xlBook = xlApp.Workbooks.Open("文件名") '打开已经存在的EXCEL工件簿文件
xlApp.Visible = True '设置EXCEL对象可见（或不可见）
Set xlSheet = xlBook.Worksheets("表名") '设置活动工作表
xlSheet.Cells(row, col) =值 '给单元格（row,col）赋值
xlSheet.PrintOut '打印工作表
xlBook.Close (True) '关闭工作簿
xlApp.Quit '结束EXCEL对象
Set xlApp = Nothing '释放xlApp对象
xlBook.RunAutoMacros (xlAutoOpen) '运行EXCEL启动宏
xlBook.RunAutoMacros (xlAutoClose) '运行EXCEL关闭宏

　　4、在运用以上VB命令操作EXCEL表时，除非设置EXCEL对象不可见，否则VB程序可继续执行其它操作，也能够关闭EXCEL，同时也可对 EXCEL进行操作。但在EXCEL操作过程中关闭EXCEL对象时，VB程序无法知道，如果此时使用EXCEL对象，则VB程序会产生自动化错误。形成 VB程序无法完全控制EXCEL的状况，使得VB与EXCEL脱节。

　　二、 EXCEL的宏功能：

　　EXCEL提供一个Visual Basic编辑器，打开Visual Basic编辑器，其中有一工程属性窗口，点击右键菜单的"插入模块"，则增加一个"模块1"，在此模块中可以运用Visual Basic语言编写函数和过程并称之为宏。其中，EXCEL有两个自动宏：一个是启动宏（Sub Auto_Open()），另一个是关闭宏（Sub Auto_Close()）。它们的特性是：当用EXCEL打含有启动宏的工簿时，就会自动运行启动宏，同理，当关闭含有关闭宏的工作簿时就会自动运行关闭宏。但是通过VB的自动化功能来调用EXCEL工作表时，启动宏和关闭宏不会自动运行，而需要在VB中通过命令 xlBook.RunAutoMacros (xlAutoOpen)和xlBook.RunAutoMacros (xlAutoClose) 来运行启动宏和关闭宏。

　　三、 VB与EXCEL的相互勾通：

　　充分利用EXCEL的启动宏和关闭宏，可以实现VB与EXCEL的相互勾通，其方法如下：

　　在EXCEL的启动宏中加入一段程序，其功能是在磁盘中写入一个标志文件，同时在关闭宏中加入一段删除此标志文件的程序。VB程序在执行时通过判断此标志文件存在与否来判断EXCEL是否打开，如果此标志文件存在，表明EXCEL对象正在运行，应该禁止其它程序的运行。如果此标志文件不存在，表明 EXCEL对象已被用户关闭，此时如果要使用EXCEL对象运行，必须重新创建EXCEL对象。

　　四、举例：

　　1、在VB中，建立一个FORM，在其上放置两个命令按钮，将Ｃommand1的Caption属性改为EXCEL，Command2的Caption属性改为End。然后在其中输入如下程序：

Dim xlApp As Excel.Application '定义EXCEL类
Dim xlBook As Excel.Workbook '定义工件簿类
Dim xlsheet As Excel.Worksheet '定义工作表类
Private Sub Command1_Click() '打开EXCEL过程
　If Dir("D:\temp\excel.bz") = "" Then '判断EXCEL是否打开
　　Set xlApp = CreateObject("Excel.Application") '创建EXCEL应用类
　　xlApp.Visible = True '设置EXCEL可见
　　Set xlBook = xlApp.Workbooks.Open("D:\temp\bb.xls") '打开EXCEL工作簿
　　Set xlsheet = xlBook.Worksheets(1) '打开EXCEL工作表
　　xlsheet.Activate '激活工作表
　　xlsheet.Cells(1, 1) = "abc" '给单元格1行驶列赋值
　　xlBook.RunAutoMacros (xlAutoOpen) 运行EXCEL中的启动宏
　Else
　　MsgBox ("EXCEL已打开")
　End If
End Sub

Private Sub Command2_Click()
　If Dir("D:\temp\excel.bz") <> "" Then '由VB关闭EXCEL
　　xlBook.RunAutoMacros (xlAutoClose) '执行EXCEL关闭宏
　　xlBook.Close (True) '关闭EXCEL工作簿　
　　xlApp.Quit '关闭EXCEL
　End If
　Set xlApp = Nothing '释放EXCEL对象
　End
End Sub

　　2、在Ｄ盘根目录上建立一个名为Temp的子目录，在Temp目录下建立一个名为"bb.xls"的EXCEL文件。

　　3、在"bb.xls"中打开Visual Basic编辑器，在工程窗口中点鼠标键选择插入模块，在模块中输入入下程序存盘：

Sub auto_open()
　Open "d:\temp\excel.bz" For Output As #1 '写标志文件
　Close #1
End Sub
Sub auto_close()
　Kill "d:\temp\excel.bz" '删除标志文件
End Sub

　　4、运行VB程序，点击EXCEL按钮可以打开EXCEL系统，打开EXCEL系统后，VB程序和EXCEL分别属两个不同的应用系统，均可同时进行操作，由于系统加了判断，因此在VB程序中重复点击EXCEL按钮时会提示EXCEL已打开。如果在EXCEL中关闭EXCEL后再点EXCEL按钮，则会重新打开EXCEL。而无论EXCEL打开与否，通过VB程序均可关闭EXCEL。这样就实现了VB与EXCEL的无缝连接。

cyberfan 2005-08-12 14:39 发表评论

实战Visual Basic条形码编程

cyberfan — Fri, 12 Aug 2005 06:39:00 GMT

一、条形码的读取

　　用过键盘口式的扫条码工具的朋友就知道，它就如同在鍵盘上按下数字鍵一样，基本不需任何编程和处理。但如果你使用的是其它接口的话，可能你就要为该设备编写通讯代码了。以下有一段简单的25针串口的条码读取器通讯代码。

Option Explicit
Dim sData As String
Private Sub Form_Load()
With MSComm1
.CommPort = 3 '设为COM3，试运行的系统而定，你可提供一个Combox让用户选择。
.PortOpen = True　'打开通讯端口
End With
End Sub

Private Sub MSComm1_OnComm()

Dim EndPos As Integer
Select Case MSComm1.CommEvent
Case comEvReceive '当有数据传送过来时
sData = sData & Trim(MSComm1.Input)
'检索回车,通常读卡机每组数据結尾都返回一个回车作为结束符
EndPos = InStr(1, sData, Chr(13))
If EndPos = 0 Then '如果未结束就继续努力
Else '读完一组。
lblBarCode.Caption = sData '显示一组条形码
With lstBarCode
.AddItem Mid(sData, 1, EndPos - 1) '添加一组条形码到列表
End With
sData = "" '清空
End If
End Select
End Sub

Private Sub cmdEnd_Click()
MSComm1.PortOpen = False '关闭端口
End
End Sub

　　二、条形码的生成

　　看完以上关于条码读取的代码是否觉得很容易呢？对，在VB上编程本来就不难。以下关于条形码生成的代码也是很容易理解，只需使用一个OFFICE的附带的BarCode控件就可以轻松打印出11种不同标准的条形码，足以满足我们的要求。想起我书架上的一本书中的一篇用Turbo C编写条形码打印程序文章，长篇大论，那时不知看了n天，打了n小时字结果也不尽人意，现在真是幸福多了:)。废话说完，得回归正题。且看条形码生成的代码及有关说明。

　　源代码主要由两个窗体（frmMain主窗体和frmOption条码设置窗体）和两个模块组成(modGetScreen.bas、SysDLG32.bas)。考虑到篇幅，这里只列出部分较为关键的代码。
新建一个标准工程，添加一个名为(Microsoft Access BarCode Control9)的条形码部件，并添加一个条码控件到窗口，并将窗口改名为frmMain，如图所示。由于控件比较多，这里不便细说，详细内容请看源代码。
模块modGetScreen.bas代码如下：

Option Explicit

'声明BitBlt、GetDesktopWindow、GetWindowDC、ReleaseDC这几个API函数略

Public RegUser As Boolean

Sub GetObjImage1(Obj As Object, OwnerForm As PictureBox, Picture1 As PictureBox)
'hDC
Dim hWndDesk As Long
Dim hDCDesk As Long
'区域表达变量
Dim x As Long
Dim y As Long
Dim w As Long
Dim h As Long

x = Obj.Left Screen.TwipsPerPixelX
y = Obj.Top Screen.TwipsPerPixelY
w = Obj.Width Screen.TwipsPerPixelX
h = Obj.Height Screen.TwipsPerPixelY
hDCDesk = OwnerForm.hdc
'取出图像
Call BitBlt(Picture1.hdc, 0, 0, w, h, hDCDesk, x, y, vbSrcCopy)
Call ReleaseDC(hWndDesk, hDCDesk)

End Sub

　主窗体frmMain.frm部分代码如下：

Private Sub cmdPrint_Click()
'生成条形码图像
Dim r As Long, i As Integer, t As String,cfile As String '临时变量
t = BarCode
For i = 0 To Val(Times) - 1

BarCode1.Value = BarCode + i
DoEvents
Picture1.Refresh

GetObjImage1 BarCode1, Conel, Picture1

If RegUser = False Then '如果未注册添加MASK标记
Picture1.PaintPicture Picture2.Picture, 300, 300
End If

If Dir(SavePath, vbDirectory) = "" Then MkDir SavePath

SavePath = SavePath & IIf(Right(SavePath, 1) <> "", "", "")

cfile = SavePath & BarCode1.Value & ".bmp"

SavePicture Picture1.Image, cfile '将条形码保存为图像文件以便打印
Next
BarCode = t

End Sub

　　条形码设置窗体frmOption.frm代码如下：

Option Explicit
'条形码设置模块

Private Sub cboBig_Click()
BarCode1.Style = cboBig.ListIndex '改变标准
End Sub

Private Sub cboDirection_Click()
BarCode1.Direction = cboDirection.ListIndex '改变方向
End Sub

Private Sub cboLine_Click()
BarCode1.LineWeight = cboLine.ListIndex '改变线宽
End Sub

Private Sub cboSmall_Click()
BarCode1.SubStyle = cboSmall.ListIndex '改变样式
End Sub

Private Sub Check1_Click()
BarCode1.ShowData = Check1.Value '是否显示数据
End Sub

Private Sub cmdChange_Click()
'设置长、宽大小
BarWidth = BarCode1.Height
BarHeight = BarCode1.Width
cmdRefresh_Click
End Sub

Private Sub cmdOK_Click()
'传送条形码设定到主界面
With frmMain.BarCode1
.LineWeight = BarCode1.LineWeight
.Style = BarCode1.Style
.SubStyle = BarCode1.SubStyle
.Direction = BarCode1.Direction
.Width = BarCode1.Width
.Height = BarCode1.Height
.ShowData = BarCode1.ShowData
Me.Hide
End With
With frmMain
.Picture1.Width = .BarCode1.Width
.Picture1.Height = .BarCode1.Height
.Conel.Width = .BarCode1.Width
.Conel.Height = .BarCode1.Height
End With
End Sub

Private Sub cmdRefresh_Click()
BarCode1.Width = BarWidth
BarCode1.Height = BarHeight
End Sub

Private Sub Form_Load()
LoadBarInfo
BarWidth = BarCode1.Width
BarHeight = BarCode1.Height
End Sub

Sub LoadBarInfo() '初始化选项
LoadBigClass cboBig
LoadSmallClass cboSmall
LoadLineSize cboLine
LoadDirection cboDirection
End Sub
Sub LoadBigClass(cbo As ComboBox) '条码标准
With cbo
.AddItem "UPC-A"
.AddItem "UPC-E"
.AddItem "EAN-13"
.AddItem "EAN-8"
.AddItem "Case Code"
.AddItem "Codabar (NW-T)"
.AddItem "Code-39"
.AddItem "Code-128"
.AddItem "U.S. Postnet"
.AddItem "U.S. Postal FIM"
.AddItem "JP Post"
.ListIndex = 2
End With
End Sub
Sub LoadSmallClass(cbo As ComboBox) '条码样式
With cbo
.AddItem "Standard"
.AddItem "2-Digit Supplement"
.AddItem "5-Digit Supplement"
.AddItem "POS Case Code"
.ListIndex = 0
End With
End Sub

cyberfan 2005-08-12 14:39 发表评论

Visual Basic模块和过程设计

cyberfan — Fri, 12 Aug 2005 06:38:00 GMT

Visual Basic（下简称VB）的模块和过程是指应用程序代码的框架，而建立这样的框架我们必须进行慎密的考虑。目前已经有许多成熟的方法可以用来创建更好的模块和过程，开发工程时，应该使用这些方法。

　　一、创建具有很强内聚力的模块

　　过程的重要性往往比模块的重要性更容易理解，过程是指执行一个统一函数的一段代码。但是对于许多开发人员来说，模块的作用比较难于弄清。模块常常被错误地视为是一个仅仅用于存放过程的容器。有些开发人员甚至把这种思路作了进一步的发挥，将他们的所有过程放入单个模块之中。人们之所以不能正确地认识模块的功能，原因之一是模块的实现实际上并不影响程序的执行。当一个工程被编译时，如果所有过程都放在单个模块中或者放在几十个模块中，这没有任何关系。虽然模块的数量对代码的执行并无太大的影响，但是当创建便于调试和维护的代码时，模块的数量有时会带来很大的影响。

　　模块应该用来将相关的过程组织在一起。在大多数应用程序中，按照某种共性来组织过程是相当容易的。当模块包含一组紧密关联的过程时，该模块可以说具有强大的内聚力。当模块包含许多互不相关的过程时，该模块便具有较弱的内聚力。应该努力创建内聚力比较强的模块。一个非常大的VB工程可能只包含十几个模块，但是这些模块的组织结构应该非常完善。创建模块时，应该知道"模块化"这个术语的含义是什么。模块的基本目的是创建相当独立的程序单元。从根本上来讲，模块可以添加给另一个工程，并且可以通过直接调用它的公用过程来使用它。这种通用模块并不依赖于全局数据或其他模块中的过程。

　　二、创建松散连接和高度专用的过程

　　VB能够非常容易地创建过程，但是这种简易性掩盖了创建完美过程需要高度技巧和科学性的问题。VB对过程所作的限制很少，它并不限制放入过程的语句数目，也不限制一个过程能够执行多少个任务。虽然VB并不强制实施这些限制，但是在这些方面我们应该做一些自我控制，这样才能创建更好的过程。

　　1、使所有过程都执行专门的任务
首先要记住，每个过程都应该执行一项特定的任务，它应该出色地完成这项任务。应该避免创建执行许多不同任务的过程。这常常需要具有一定的远见，因为究竟哪些成分构成一个任务，这并不总是十分明显。创建专用过程有许多好处。首先，调试将变得更加容易。创建专用过程的更重要的好处是可以按计划或者不按计划来修改代码。

　　2、尽量使过程成为自成一体的独立过程

　　除了尽量使过程成为专用过程外（这是合乎道理的），还应该尽量使之成为独立的过程。当一个过程依赖于对其他过程的调用时，称为与其他过程紧密连接的过程。紧密连接的过程会使调试和修改变得比较困难，因为它牵涉到更多的因素。当创建的过程依赖于较少的其他过程或者不需要调用其他过程时，那么它就是松散连接的过程。松散连接的过程优于紧密连接的过程，但是我们不可能使每个过程都成为独立的过程。尽管如此，我们应该尽量减少过程之间的连接关系。

三、模块和过程设计的原则

　　1、为过程和模块赋予表义性强的名字

　　为了使代码更加容易理解，最容易的方法之一是为我们的过程赋予表义性强的名字。函数名DoIt、GetIt和PrintIt的可读性很难与 CalculateSalesTax、RetrieveUserID和PrintSpreadSheet相比。给过程正确地命名，可使程序工程的调试和维护工作大大改观。我们要认真对待过程命名的工作，不要为了减少键入操作量而降低过程的可理解度。给过程命名时应该大小写字母混合使用，定义过程名时不要使用缩写。这些都是初学者必须要牢记的。下面是一些例子：

　　不正确：

Private Function InvoicePost()As Boolean
Private Function PrintIt()As Boolean
Public Sub SaveItem()
Public Sub DeleteRecord()

　　正确：

Private Function PostInvoice()As Boolean
Private Function PrintSpreadsheet()As Boolean
Public Sub SavePicture()
Public Sub DeleteContact()

　　2、为每个过程赋予明确定义的作用域

　　作用域是指工程中的变量或过程的可视性。过程可以定义为拥有模块级作用域、全局作用域或友元作用域。当一个过程用Private关键字来说明时，便拥有模块级作用域，并且它只能用同一模块中的过程来调用。如果用关键字Public来说明一个过程，那么这个过程将拥有全局作用域，并且可以用工程中的任何模块来调用。此外，公用类模块的公用过程可用于外部程序。用Friend关键字说明的（公用类模块中的）过程将使该过程成为工程中的所有模块的公用过程，但是它不能使该过程成为外部程序的公用过程。创建过程时，始终都应显式地定义它的作用域。虽然不使用Public Private或Friend将无法定义一个过程，但是我们应该避免这样进行操作。

　　在许多情况下，我们不用Public、Private或Friend说明的过程实际上将作为模块级（专用）过程来使用。但是，如果不专门说明为专用过程，它们就会无意中创建为公用过程。通过为每个过程赋予一个明确定义的作用域，可以减少代码阅读者需要投入的工作量。另外，应该确保我们为过程赋予最有意义的作用域。如果一个过程只被同一模块中的另一个过程调用，那么请将它创建成专用过程。如果该过程是从多个模块中的多个过程中调用，请将该过程说明为公用过程。每个过程的定义都应该以Public、Private或Friend开头。如果现有的过程不带有这些关键字中的一个，那么我们就必须遍历工程，以便确定每个过程的作用域，并相应地修改其说明。

　　不正确：

Sub CalculatePOTotals( )
　…
End Sub

　　正确：

Public Sub CalculatePOTotals( )
　…
End Sub

　　3、用参数在过程之间传递数据

　　虽然模块级变量的问题不像全局变量那么多，但是我们也应该尽量避免使用模块级变量。一般来说，变量的作用域越小越好。为了减少模块级变量和全局变量，方法之一是将数据作为参数在不同过程之间传递，而不是让过程共享全局变量或模块级变量。

　　例如为每个参数指定数据类型。这个问题应该给予充分的重视。创建带有参数的过程时，请务必将每个参数明确说明为一个特定的数据类型。当我们省略参数说明中的As部分时，该参数将作为Variant（变码）来创建。如果我们想创建Variant参数，请使用As Variant进行显式创建。

　　不正确：

Private Sub CreateStockRecord(ItemID, Repair, Quantity)

　　正确：

Private Sub CreateStockRecord(strItemID As String, blnRepair _
As Boolean, sngQuantity As Single)

　　4、使用统一和直观明了的方式来调用过程

　　VB提供了许多快捷操作方式，可供在编写代码时使用。一般来说，这些快捷方式不影响代码的运行性能，但是它们往往牺牲了代码的可读性，以便在进行软件开发时省去一些击键操作。应该尽量使代码做到直观明了。有的时候，也就是当调用过程的时候，可以采用快捷方式，然而我们不应该这样去做。

　　我们可以用许多不同的方法来调用一个过程。当调用Sub过程时，可以使用单词Call，也可以省去这个单词。例如，下面这两个语句均调用相同的Sub过程：

CallShowError("clsApplication","ShowRep",Err.Number,Err.Description)
ShowError"clsApplication","ShowRep",Err.Number,Err.Description

　　虽然可以省略单词Call，这样我们就不必键入两个括号来启动代码，但是我们应该避免使用这种方法。关键字Call专门用来指明该语句是调用一个Sub过程，而不是调用Function过程，因此它使代码更容易阅读。
VB允许我们以完全相同的方法来调用Sub过程和Function过程。请看下面这个函数：

Public Function DisplayContact(lngContactNumber As Long) As Boolean
…
End Function

　　我们可以使用下面的任何一个语句来调用该函数：

Call ShowRep(lngRepNumber)
ShowRep lngRepNumber
blnResult=ShowRep(lngRepNumber)

　　为了使代码尽可能直观明了，必须将调用Sub过程与调用Function过程区分开来。调用Sub过程时，始终都应使用关键字Call；调用Function过程时，始终都应检索Function调用的值，即使我们并不使用这个值，也应这么做。

cyberfan 2005-08-12 14:38 发表评论

VB5.0应用程序的启动与退出设计

cyberfan — Fri, 12 Aug 2005 06:37:00 GMT

在缺省情况下，应用程序中的第一个窗体被指定为启动窗体。应用程序开始运行时，此窗体就被显示出来(因而最先执行的代码是该窗体Form_Initialize事件中的代码)。如果想在应用程序启动时显示别的窗体，就得改变启动窗体，其方法如下：
1从“工程”菜单中，选劝工程属性”。
2选劝通用”。
3在“启动对象”下拉列表中，选取要作为新启动窗体的窗体。
4选劝确定”。

没有启动窗体时的启动

有时候需要在应用程序启动时不加载任何窗体。例如想先运行装入数据文件的代码，然后再根据数据文件的内容决定显示几个不同窗体中的哪一个。为此，可在标准模块中创建一个名为Main的子过程，并将其设为启动对象。
SubMain()
DimintStatusAsInteger
′调用一个函数过程来检验用户状态
intStatus=GetUserStatus
′根据状态显示某个启动窗体
IfintStatus=1Then
frmMainShow
Else
frmPasswordShow
EndIf
注意：这个过程必须是一个子过程，且不能在窗体模块内。

结束应用程序

当所有窗体都已关闭并且没有代码正在执行时，事件驱动的应用程序就停止运行。如果最后一个可见窗体关闭时仍有隐藏窗体存在，那么，应用程序表现为已经结束了(因为没有可见的窗体)，可实际上却仍在继续运行，直至所有隐藏窗体都关闭为止。之所以出现这种情况，是因为对已卸载窗体的属性或控件的任何访问，都将导致隐含地、不予显示地加载那个窗体。
为了避免出现这类问题，最好的办法是确保所有的窗体都已卸载，可以使用Forms集合和Unload语句。例如在主窗体上可以用一个名为cmdQuit的命令按钮来退出程序，如果应用程序只有一个窗体，则Click事件过程可简单为：PrivateSubcmdQuit_Click() UnloadMeEndSub如果应用程序使用多窗体，通常把代码放入主窗体的Unload事件过程可以卸载这些窗体。可以使用Forms集合确保找到并关闭所有窗体。
PrivateSubForm_Unload
DimiasInteger
′在窗体集合中循环并卸载每个窗体
Fori=0toFormsCount－1
UnloadForms(i)
Next
EndS

cyberfan 2005-08-12 14:37 发表评论

Visual Basic通用报表设计小结

cyberfan — Fri, 12 Aug 2005 06:37:00 GMT

大家都知道，在VB平台下制作报表大致有两种选择：使用VB自带的Data Report控件和借助第三方软件。其中第三方软件比较著名的就是MS Excel和Seagate公司的CrystalReporter，以下就这三个方案进行详细的讨论。

　　1. Data Report控件

　　1．1 Data Report控件使用方法

　　由于是VB自带的控件，所以使用相对比较方便。使用方法是：首先在"工程"菜单下面选择"添加Data report"选项，这样Data Report控件就选入到了应用程序。

　　使用Data report的情况大多数采用数据绑定的模式，也就是将此控件与数据库的数据表绑定起来以便可以不用编写代码就轻松完成报表的设计。要使用数据绑定就必须要指定数据源，这里的数据源不是数据控件而是数据环境（Data Environment）,选择"工程"菜单下面选择"添加Data Environment"选项就可以将数据环境添加进应用程序中。数据环境有两个重要的属性：Connection 和Command属性，前者是连接指定的数据库，后者连接指定的数据表，一旦这两者都设置成功之后，就可以把数据环境作为数据源了。只需要把Data report的DataSource属性设置为前面的数据环境对象以及把DataMember设置为数据环境对象的Command对象即可。

　　1．2 Data Report控件界面元素

　　完成了Data report控件的数据绑定工作之后就可以直接控制报表的制作与显示了。这里首先熟悉一下Data report控件的显示界面：

　　Data report控件一共有5个区组成，分别是报表头、页面头、细节区、页面注脚和报表注脚。报表头和报表注脚是用分别用于整个报表的最上部和最下部，它们将出现于整个报表的每一页，可以放置一些报表名称，时间之类的固定文本；页面头和页面注脚只能出现在当前页的最上部和最下部，也就是说它只能出现在当前页中，不出现在其他页面中，可以放置随页面变化的一些量比如页码等；而细节区就是用来进行实际显示的区域，它是我们最为关心的区域，通过在此区域内放置显示控件可以控制报表的实际显示输出。这里介绍一下放置文本框控件的使用方法，其实在绑定情况下只需要设置其DataMember和Datafield即可，前者用来指定数据表，可以设置为前面数据环境对象的Command对象，后者是指定数据段，即绑定的数据库的指定字段。这样不需要编写任何代码就可以实现报表的显示工作。

　　1．3 Data Report控件的打印功能

　　对于报表的打印可以直接使用Data report自带的打印功能，即可以实现简易的报表打印。不过为了实现比较复杂的打印功能，也可以通过程序控制的方法来进行。这里只是给出一个实现思路：首先需要制作一个按钮控件来显示"打印设置"的窗口，通过这个窗口用户可以设置打印的相关的参数，然后在实现打印的子模块中使用VB内嵌的printer 对象来实现真实的打印，该对象能够对打印的当前位置进行定位，而且对打印的字体等参数进行控制，所以结合"打印设置"窗口可以实现类似于word里面的打印功能。

上一页 1 2 3 下一页

　　2．MS Excel

　　说起报表设计应用程序，无意微软的Excel是一支独秀，MS Excel就是用来进行表格和报表设计用的应用程序，它具有优秀的方格控制和宏代码定制功能。所以如果在设计自己的应用程序的时候能够结合到Excel的话，那么你的应用程序就应该是相当的完善了，因为无论是编辑还是打印功能，Excel都提供了很完美的解决方案，所以你的应用程序所要做的事情就是实现程序和Excel通讯即可。

　　事实上，可以使用VBscript可以将VB与Excel两者连接起来。以下就简要介绍在VB下开发基于Excel的编程思路。

　　在VB中处理Excel的对象大致分为五个：Application对象、WorkBook对象、WorkSheet对象、Range对象以及Cell对象。它们的功能分别如下：

　　Application---------用来指代整个应用程序。

　　WorkBook----------表示工作簿对象

　　WorkSheet---------表示工作表对象，注意，一个工作簿可以包含多个工作表，它们就类似于多文档中的框架窗口和里面的单个视图一样。

　　Range-------------表示工作表中的某个区域范围对象，特殊情况下也可以只代表一个Cell。

　　Cell---------------表示特定工作表的一个单元格对象。这个对象的使用频率是最高的。

　　清楚了以上的五个对象的应用范围，那么使用它们就很简单了，不过在使用这些对象之前，首先需要对它们进行声明。方法是在"工程"的"引用"对话框之下选择"Microsoft Excel9.0 Object Library"，这样就将整个Excel对象库就引入到程序中来了。

　　下面举一个示例，其实现的功能是打开一个工作簿。

Function OpenBook(strFilePath As String) As Boolean
' This procedure checks to see if the workbook
' specified in the strFilePath argument is open.
' If it is open, the workbook is activated. If it is
' not open, the procedure opens it.
Dim wkbCurrent As Excel.Workbook
Dim strBookName As String

On Error GoTo OpenBook_Err
' Determine the name portion of the strFilePath argument.
strBookName = NameFromPath(strFilePath)
If Len(strBookName) = 0 Then Exit Function
If Workbooks.Count > 0 Then
For Each wkbCurrent In Workbooks
If UCase$(wkbCurrent.Name) = UCase$(strBookName) Then
wkbCurrent.Activate
Exit Function
End If
Next wkbCurrent
End If
Workbooks.Open strBookName
OpenBook = True
OpenBook_End:
Exit Function
OpenBook_Err:
OpenBook = False
Resume OpenBook_End
End Function

　3．Crystal Reporter（水晶报表）

　　做为一个优秀的报表软件，水晶报表是实际应用中最多的方案。在这一节里主要介绍一下水晶报表的定制和显示，打印功能的实现。

　　首先要区分Crystal Reports插件程序和Crystal Reports控件。前者主要用来创建报表模板，后者主要是用来在程序中显示和打印报表，这两者的分工决定了它们程序中的功能的不同。

　　其中Crystal Reports的插件程序可以从Seagate公司的官方网站上下载最新的测试版本。

　　3．1 Crystal Reports插件程序的使用

　　选择"外接程序"菜单的"报表设计器"选项，则VB将执行Crystal Reports Pro插件应用程序。在Crystal Reports Pro里选择"新建报表"图标，可以选择8标准模板和一个自定义的模板来开始报表工程。

　　整个水晶报表的使用跟第一节的Data Report的使用很类似。首先需要给报表选择数据源，（即数据库），然后就可以在报表中添加、删除、修改字段以及为记录分组，可以利用水晶报表创建很多具有自定义风格的报表。由于本身Crystal Reports插件程序就是一个功能强大的报表设计软件，这里就不能一一的讲解了，有兴趣可以参考程序自带的帮助文档。

　　3．2 Crystal Reports控件的背景知识

　　Crystal Reports Pro还提供一个报表生成模块，该模块可以连接到并访问VB应用程序，VB程序员不需花费大量时间写自己的代码就可再应用程序中添加复杂的报表生成及输出功能。

　　Crystal Reports引擎是一个动态链接库，它可以使应用程序访问并具有同Crystal Reports 一样强大的报表输出功能。应用程序是通过Crystal Reports ActiveX控件来访问引擎。再编译时应用程序同报表引擎链接，以给应用程序添加了生成报表的功能。

　　当程序使用Crystal Reports ActiveX控件时，可以通过再设计时设置Crystal对象属性或者再运行时改变对象属性，来建立应用程序和Crystal Reports之间的连接。通过Crystal控件的属性可以指定：

　　响应应用程序某个事件的输出报表的名字。

　　报表的目标位置（预览窗口、磁盘文件或者电子邮件等）。

　　想要打印的份数（如果报表提交给打印机的话）。

　　输出文件的信息。

　　预览窗口的大小及位置信息（如果报表在预览窗口中显示时）。

　　选择公式信息（如果在报表中限制记录的话）。

　　排序信息。

　　其他相关的属性。

　　这里要注意一点的是，Crystal控件必须在由Crystal Reports Pro创建的报表中使用，而试图在VB应用程序里引用之前，必须首先创建报表。

　　3．3 Crystal Reports控件的使用

　　了解了Crystal Reports控件的功能，那么就可以使用它了。首先通过"工程"的"部件"选项里面选择"Crystal Reports Control"，那么VB的工具箱里面就添加了Crystal Reports控件了。

　　注意，对于Crystal Reports控件的最重要的属性就是ReportFileName了，把它设置为前面已经在Crystal Reports Pro里定制好的报表模板的文件路径。那么只需要调用控件的PrintReport方法就可以将报表显示出来了。

　　相对于Data Report控件来说，Crystal Reports控件的功能更加的完善，报表预览，打印，编辑修改等功能都很完善，所以在实际的报表应用设计方案中，使用Crystal Reports的相对较多。然而Crystal Reports控件也有它的局限性，即它不能在运行时创建自定义的窗口。可以使用控件的数据绑定属性来创建数据绑定报表，但是报表本身的格式都是由 Crystal Reports控件内部进行处理的。一般说来，Crystal Reports控件不提供在程序中对报表字段级的访问。这一缺陷可以通过设计出足够多的报表来弥补。

　　4.其他方法

　　除了通过上述的三种方法来实现报表设计以外，当然也可以直接利用Win32 API来进行直接进行设计，这种方式是最为灵活也是最为繁琐的方式，因为所有的编辑、修改、打印等功能都是由程序控制，所以一般情况下不会使用这样的方式来处理，这里就不介绍了。

　　5．小结

　　报表设计是程序员经常要遇到的问题，本文主要介绍目前主流的报表设计方案，由于所涉及到的知识点比较多，限于篇幅，在这里只是作了简要的介绍，希望可以起到抛砖引玉的作用。

cyberfan 2005-08-12 14:37 发表评论

VB的子类处理应用两例

cyberfan — Fri, 12 Aug 2005 06:36:00 GMT

子类处理，熟悉API函数的VB爱好者们一定不会感到陌生，它又称为“子类化”或“子类派生”，是一种功能强大的技术。在应用它之前，我们需要先对之原理进行简单的了解：在WINDOWS中，每一个窗口都有一个默认的窗口函数，它的作用是对发送到窗口的消息进行处理。在VB中，这个默认的窗口函数不是直接公开的，它提供了对VB中的事件进行处理的代码，当接受到一条WINDOWS消息时，这个窗口函数就会响应并产生一个VB事件，换言之，这个窗口函数隐藏了消息处理的细节，用一个VB事件来响应一条WINDOWS消息。然而，VB没有提供对所有WINDOWS消息的支持，许多WINDOWS消息都不会生成一个VB事件，但这不能说是VB的缺点，恰是VB的优点，放弃对那些程序员并不常用的消息的支持，在功能强大和性能稳定之间做了很好的平衡。而且，幸运的是，尽管这个幕后主宰是默认的，但它不是唯一的，我们完全可以用自己定制的一个窗口函数替代它，并保留指向默认窗口函数的指针，当一个消息到达窗口时，自制的窗口函数会拦截它并进行识别处理，对不能识别或不需进行特别处理的消息，就通过指向默认窗口函数的指针传递给默认的窗口函数进行处理，这样便扩充了默认窗口函数的功能。这种用定制的窗口函数代替默认的窗口函数，拦截并处理到达窗口的消息的技术，我们就称之为“子类处理”，定制的函数我们称之为“回调函数”。子类处理的方法主要有三种：忽略消息并传递给默认的窗口函数；截获消息，执行特定操作后，传递给默认的窗口函数或传递给默认的窗口函数处理后，对返回值进行控制；截获消息，执行特定操作并禁止默认的窗口函数对之进行处理。我们将通过下面两个实例对之进行简要说明。

一、实现无标题栏窗口的拖动

　　大家都知道，按住窗口的标题栏可以拖动窗口。可如果窗口没有标题栏，怎样拖动它呢?那就按在窗口的客户区上吧，只要让窗口觉得是按在了标题栏上就可以了。

　　首先需要在一个模块文件Modulel内输入以下代码，(我们自制的回调函数必须在模块文件中声明，不可将其放到类模块中，也不能附加到窗体中)：

　　下面声明的是子类处理中最重要的三个函数。

　　SetWindowLong函数使用GWL_WNDPROC索引将默认的窗口函数替换成我们自制的回调函数，回调函数的地址由AddressOf操作符得到。SetWindowsLong函数返回值为默认的窗口函数的地址。

　　Declare Function SetWindowLong Lib“user32"Alias“SetWindowLingA"(ByValhwnd As Long,ByVal nIndex As Long,By Val dwNewLong As Long)As Long
　　DefWindowProc函数调用默认的窗口函数对消息进行处理，并返回消息处理的指定返回值。

　　Declare Function DefWindowProc Lib“user32"Alias “DefWindowProcA"(ByValhwnd As Long,ByVal wMsg As Long,ByVal wParam As Interger,ByVal lParam As Long)As Long
　　CallWindowProc函数传递消息到指定的窗口函数(窗口函数地址由lpPrevWndFunc参数给定)，并返回消息处理的指定返回值。
　　Public Declare Function CallWindowProc Lib“user32"Alias“CallWindowProcA"(ByVal lpPrevWndFunc As Long,ByVal hwnd As Long,ByVal Msg As Long,ByVal wParam As Long,ByVal lParam As Long)As Long
　　Public proroc As Long
　　Public Const WM_NCHITTEST=＆H84
　　Public Const HTCAPTION=2
　　Public Const HTCLIENT=1
　　Public Const GWL_WNDPROC=(－4)

　　回调函数WindowProc结构如下，共有四个参数，第一个参数是窗口句柄，第二个参数是消息编号，第三、四个参数是32位整数，它们根据不同的消息而不同。

　　本例中，当鼠标在窗口内进行了一个按下或松开的操作时，WINDOWS会向窗口发出一条WM_NCHITTEST消息(该消息用于判断窗口的非客户区域的什么部分包含了鼠标指针)，回调函数在收到WM_NCHITTEST消息后，首先调用窗口的默认函数进行处理，然后判断返回值，如果是 HTCLIENT(表示鼠标指针在客户区内)，就改变它，使之返回HTCAPTION(表示鼠标指针在标题栏内)，这样，当我们在窗口的客户区内按住鼠标移动时，窗口就会傻呼呼地以为按在了标题框内，当然就跟着我们的鼠标动了。

　　Function WindowProc(ByVal hwnd As Long, ByVal msg As Long,ByVal wParam As Long,ByVal lParam As Long)As Long
　　Dim rv As Long
　　If msg=WM_NCHITTEST Then
　　rv=DefWindowProc(hwnd,msg,wParam,lParam)
　　If rv=HTCLIENT Then
　　WindowProc=HTCAPTION
　　Else
　　WindowProc=rv
　　End If
　　将其他的消息传递给默认的窗口函数进行处理。
　　Else
　　WindowProc=CallWindowProc(proroc,hwnd,msg,wParam,lParam)
　　End If
　　在Forml内输入如下代码：
　　Private Sub Form_load()
　　proroc=SetWindowLong(hwnd,GWL_WNDPROC,AddressOf WindowProc)
　　End Sub
　　一定要记得在窗口卸载之前恢复默认的窗口函数，否则……您试一试就知道了。
　　Private Sub Form_Unload(Cancel As Integer)
　　Dim rv As Long
　　rv=SetWindowLong(hwnd,GWL_WNDPROC,proroc)End Sub
二、规模文本框的关联菜单

　　大家都知道,文本框控件有自己的关联菜单(上有剪切、复制、全选之类的命令)，这无疑为我们在编程时提供了便利。可是，有利必有弊，当我们需要给文本框提供一些定制命令，并把它们加到一个自定义的关联菜单中时，默认的关联菜单给我们带来了不便(在文本框内单击右键时，会先后弹出两个关联菜单)。如何防止默认的关联菜单弹出呢?

　　程序如下：

　　需要在一个模块文件Modulel内输入以下代码：

　　首先加入SetWindowLong函数和CallWindowProc函数的声明
　　Declare Function GetMenu Lib“user32"(ByVal hwnd As Long)As Long
　　Declare Function GetSubMenu Lib“user32"(Byual hMenu As Long,ByVal nPOS As Long)As Long
　　Declare Function TrackPopupMenuBynum Lib“user32"Alias“TrackPopupMenu"(ByVal hMenu As Long,ByVal wFlags As Long,ByVal x As Long,ByVal y As Long,ByVal nReserved As Long,ByVal hwnd As Long,ByVal lprc As Long)As Long
　　Public Const WM_CONTEXTMENU=＆H7B
　　Public Const GWL_WNDPROC=(－4)
　　Public Const TPM_LEFTALIGN=＆H0＆
　　Public Const TPM_LEFTBUTTON=＊H0＆
　　Public proroc As Long
　　Public hMenu As Long
　　Public pMenu As Long

　　当我们在一个窗口内单击右键时(确切地说应是按下的右键抬起时)，会向窗口发出一条WM_CONTEXTMENU的消息，其LParam参数为鼠标指针的屏幕座标(低字为X座标，高字为Y座标)，其WParam参数为鼠标指针的窗口句柄，如果该窗口有默认的关联菜单，则其弹出。在文本框内单击右键时，我们必须先拦截这条消息，然后在鼠标指针所在位置弹出自制的关联菜单。
　　Function WindowProc(ByVal hwnd As Long,ByVal msg As Long,ByVal wParam As Long,ByVal lParam As Long)As Long
　　Dim xl As Long
　　Dim yl As Long
　　If msg=WM_CONTEXTMENU Then
　　xl=lParam Mod＆H10000
　　y1=lParam/＆H10000
　　TrackPopupMenuBynum pmenu,TPM_LEFTALIGN Or TPM_LEFTBUTTON,xl,yl,0,hwnd,0
　　Else
　　WindowProc=CallWindowProc(proroc,hwnd,msg,wParam,lParam)
　　End If
　　End Function
　　在Forml内输入如下代码：Private Sub Form_Load()
　　本例假定把菜单栏在顶级菜单的第1个条目作为关联菜单。
　　hMenu=GetMenu(Me.hwnd)
　　pmenu=GetSubMenu(hMenu,0)
　　proroc=SetWindowLong(Textl.hwnd,GWL_WNDPROC,AddressOf WindowProc)
　　End Sub
　　Private Sub Form_Unload(Cancel As Integer)
　　Dim rv As Long
　　rv=SetWindowLong(Textl.hwnd,GWL_WNDPROC,proroc)
　　End Sub

　　利用SetWindowLong函数和AddressOf操作符进行子类处理必须注意：

　　1、不可以在程序中设置断点对代码进行调试(这就是说你在回调函数中的一点小语法错误都会导致应用程序崩溃，所以在执行程序前一定要谨慎再谨慎)，可使用debug.print语句获得消息处理的信息。千万不要按VB工具栏上的停止按钮，它甚至会使VB.EXE崩溃。

　　2、只能对进程内的窗口进行子类处理，对进程外的窗口，可以使用一些厂商提供的子类处理控件(如Desaware公司的SpyWorks软件包中的 dwsbc32d.ocx控件)。此外，对于线程窗口，不能使用SetWindowLong函数，应使用SetWindowHookEx函数进行子类处理。

　　上述如有不对之处，欢迎各位批评指正。

　　以上程序在中文WIN95，VB5.0下调试通过。

cyberfan 2005-08-12 14:36 发表评论

VB6.0调用Excel制作任意表格

cyberfan — Fri, 12 Aug 2005 06:36:00 GMT

在VB中制作报表一般来讲有三种方法：
1、直接使用VB6.0中自带的Data Report 来做，这种方法有很大的局限性，对于比较规则的报表，但对于比较复杂的报表，比如说一张报表，上部分是人员的工资，下部分是人员的各日的考勤，使用这种方法就无能为力。
2、使用直接的打印方法，即Printer.print ，这种方法直接向打印机打印，就象过去使用Foxpro似的，需要进行打印机定位，并且在Windows下，不同的字符数字所占的宽度也不相同，所以这种方法使用起来非常麻烦。
3、使用微软的Excel。本文重点讨论用Excel来制作报表所涉及的问题。我们用Excel做报表时，不仅是将所要的内容填到Excel的工作表中，而且还需要填写公式、定义合适的格式（格线、字体、对齐）等。
Excel的每张工作表是由若干行、若干列构成的，行列的交叉形成的小格称作单元格。我们正好可以用这些现成的单元格来做我们的报表的相应的格。为了程序简单，可以将报表的模板做好，如表头，相应的行高、列宽、字体、对齐调整好（事实上，这些也可以通过程序来实现，只是麻烦点。），然后利用VB程序来操纵 Excel。
这里我们以SQL SERVER 7.0为后台数据。首先定义好需要的变量，在VB6.0的菜单“工程\引用”中确保 Microsoft Excel 8.0 Object Library（在Excel2000中，此处为Excel 9.0）复选框选中。
再向Excel工作表中填入数据：
Dim VBExcel As Excel.Application
Dim xlbook As Excel.Workbook 定义Excel工作簿对象
Dim xlsheet As Excel.Worksheet 定义Excel工作表对象
Dim rssalary As New ADODB.Recordset 定义记录集
rssalary.Open SQLStrsalary, CNstring, adOpenStatic, adLockReadOnly
rssalary 为已计算好的工资数据记录集。
SQLStrsalary 是SQL语句（如SELECT * FROM SALARY）。
Cnstring 是连接字符串（如Provider=SQLOLEDB.1;Integrated
Security=SSPI;Persist Security Info=False;
Initial Catalog=DBname;Data Source=servername）。
Set VBExcel = CreateObject("excel.application")
VBExcel.Visible = True
根据操作人员是否需要见到Excel此处可设为TRUE 或FALSE
Set xlbook = VBExcel.Workbooks.Open(ExcelFile)
ExcelFile为事先设计好的Excel模板文件（包括路径）
Set xlsheet = xlbook.Worksheets("salary")
Salary 为Excel模板工作表的名字
xlsheet.Activate
下面是向单元格中填写数据（以一个简单的工资打印为例）：
xh = 1
Row = 6 从第6行开始是工资数据，1-5 行为工资单表头
SumRow = Row SumRow用来存放合计的起始行
Do While Not rssalary.EOF
Col = 1
xlsheet.Cells(Row, Col).Value = xh
Col = Col + 1
xlsheet.Cells(Row, Col).Value = rssalary("name")
Col = Col + 1
xlsheet.Cells(Row, Col).Value = Str(rssalary("jngz").Value)
Col = Col + 1
xlsheet.Cells(Row, Col).Value = Str(rssalary("jbdx").Value)
Col = Col + 1
xlsheet.Cells(Row, Col).Value = Str(rssalary("gwgz").Value)
Col = Col + 1
xlsheet.Cells(Row, Col).Value = Str(rssalary("zygz").Value)
Col = Col + 1
xlsheet.Cells(Row, Col).Value = Str(rssalary("jfgz").Value)
Col = Col + 1
xlsheet.Cells(Row, Col).Value = Str(rssalary("yfgz").Value)
xh = xh + 1
Row = Row + 1
rssalary.MoveNext
Loop
以上可将各人的工资项打印出来，下面是合计（仅以一列的合计为例，填写公式）：
Col = 1
xlsheet.Cells(Row, Col).Value = ""
Col = Col + 1
xlsheet.Cells(Row, Col).Value = "合计"
Col = Col + 1
HeJi = "=SUM(c" + Trim(Str(SumRow)) + ":c" + Trim(Str(Row - 1)) + ")"
xlsheet.Cells(Row, Col).Value = HeJi
填入公式，HeJi是一个字符串变量。
如果用到的汇总是求平均、记数等，可用相应的Excel函数来替代上面的SUM，如COUNT、AVERAGE等。
因为Excel中所见到的格线，其实并不是实际存在的线，只是为了分割各个单元格；而如果在Exce的选项中设置上有网格线的话，那么每一个格的四周都有线，并不一定能符合实际的需要。因此，如果只是某些地方需要画线，可用以下方法为某个单元格加上边框：
xlsheet.Cells(Row, Col).Borders(xlTop).Weight = xlThin
其中Borders 的参数可为：xlTop，xlBottom，xlRight，xlLeft 代表位置。
它的Weight 的值可为：xlThin，xlMedium,xlThick.... 代表线粗。
在Excel 中，如果某个单元格的宽度小于其中内容的长度，其中的内容将显示一串“＃”，真正的内容就看不到了，我们可用以下的方法来解决：
　 xlsheet.Cells(Row, Col).ShrinkToFit = true
这样Excel可以自动将单元格中内容的字体缩小来适合所在的单元格的宽度。也可以将模板中所有可能用到的单元格格式的对齐方式中的“缩小字体填充”项选中，然后将不需要缩小字体填充的单元格设为：
　　 xlsheet.Cells(Row, Col).ShrinkToFit =false
由于Excel中对于对齐方式(即靠左、右,上、下等)有它自己默认的方式，如数字自动在单元格中靠右，文字自动靠左。如果需要中单元格的内容在某个单元格中的对齐方式可以这样来做：
水平对齐：xlsheet.Cells(Row, Col).HorizontalAlignment = xlCenter
其中xlCenter处可为xlLeft、xlRight。
垂直对齐：xlsheet.Cells(Row, Col). VerticalAlignment = xlCenter
其中xlCenter处可为xlTop、xlBottom。
如果需要用到单元格的内容在多个单元格中居中（跨列居中），可以这样来实现(下例可实现第一行的A到H列居中)：
Dim Total As Range
RangeCells = "a" + RTrim(LTrim(Str(1))) + ":" + “h” + RTrim(LTrim(Str(1)))
Set Total = Range(RangeCells)
Total.Select
Total.HorizontalAlignment = xlHAlignCenterAcrossSelection
然后在这几个单元格中的最前一个单元填入实际内容。
xlsheet.Cells(1, 1).Value = “实际内容”
有时我们可能会用到改变字体及尺寸，可以通过以下方法实现：
Sheet1.Cells(Row,Col).Font.Name = "隶书"
Sheet1.Cells(Row,Col).Font.Size = 20
在单元格中输入数字性的文本，如05182381104，写到Excel的单元格中时，Excel会自动将其视为数字，从而变为5182381104。要解决这个问题，可这样做：
xlsheet.Cells(Row, Col).Value="'"+"05182381104"
上句中的两个双引号中间是一个单引号。
另外，如果一张Excel工作表的长度超过了所设定的打印机的纸张的长度，Excel将自动分页，第二页就会没有表头。在出现这种情况下，如果表头是模板中固定好的，可在模板中设置好，方法是在Excel的菜单“文件\页面设置”中来设置。如果表头是在程序中形成的，可用下面的方法：
xlsheet.PageSetup.PrintTitleRows = rows("1:6").Address
这里“1:6”是根据表头所在的行来自行设定的。
xlsheet.PageSetup.PrintTitleColumns = Columns("A:p").Address
这里“A:P”是根据表头所在的列来设定的。
通过上面这些方法来制做我们平常所见的报表，应该是不会有太大的问题。其实，我们在Excel软件中所能做到的，在VB中都可以通过调用来实现。
注：文中所述，均在调用Excel 97和Excel 2000中通

cyberfan 2005-08-12 14:36 发表评论

VB设计能自动存盘的记事本

cyberfan — Fri, 12 Aug 2005 06:35:00 GMT

我们平时使用的Word、Excel等应用软件都有自动存盘功能，这样可以在出现意外情况时把数据的丢失减到最小程度，可是简陋的记事本就没有这么幸运了，但我们平时又离不开它。这可怎么办?没关系，让我们用VB来对它进行完善，让记事本也来个自动保存。

　　一、设计思路

　　在VB中有一个SendKeys方法，可以模拟键盘发送指令给应用程序只要设定一定的时间间隔，然后按时给记事本发送保存文件的命令就可以达到自动保存的目的了。

　　二、程序设计

　　新建一工程在窗体上添加一个时钟控件，并将属性INTERVAL的值设置为1000（即1秒），再添加一个Label控件、一个TEXT控件 text1和UpDown控件“updown1”，并设置“Updown1”的“autobuddy”属性为“true”； “buddyproperty”属性为“Text”；“increment”属性为“1”；“max”属性为“20”；“min”属性为“1”。最后再添加一个按钮控件command1并设置caption属性为“开始”。下面就可以双击窗体添加如下代码了：

Private Declare Function FindWindow Lib ″user32″ Alias ″FindWindowA″ ByVal lpClassName As String ByVal lpWindowName As String　 As Long
Dim i As Integer
Private Sub Command1_Click　
Me.WindowState = 1
Timer1.Enabled = True
End Sub
Private Sub Form_Load　
Form1.Caption = ″记事本自动保存″
Text1.Text = ″″
Text1.Text = 1
Shell ″notepad.exe″ vbNormalFocus '打开记事本，并使之成为当前窗口
Timer1.Enabled = True '激活时钟控件
Form1.WindowState = 0
End Sub
Private Sub Timer1_Timer　
If FindWindow″Notepad″ vbNullString　 Then
Dim b As Integer
b = UpDown1.Value
i = i + 1
If i Mod b  60 = 0 Then '设置自动存盘的时间间隔为分钟，可以根据需要进行更改。
SendKeys ″%FS　″ True '调用文件菜单的保存命令，显示文件保存对话框
End If
Else
Unload Me
End If
End Sub

　　使用方法：代码输入完毕，将该程序编译成EXE文件，用“发送到/桌面快捷方式”命令为该文件在桌面上创建一个快捷方式图标。当要使用记事本时，只要双击这个快捷方式图标就可以自动打开记事本及这个程序了。设置一下自动保存的时间间隔，比如2分钟，点击“开始”按钮开始工作。当第一次保存时，会显示文件保存窗口，让你填写文件名和选择路径，以后将每隔2分钟自动保存一次。当你关闭记事本时该程序也会随之自动退出。本程序在VB6.0企业版和Win98 SE下调试通过。

cyberfan 2005-08-12 14:35 发表评论

关于Visual Basic 6.0类开发

cyberfan — Fri, 12 Aug 2005 06:34:00 GMT

对程序员和编程爱好者来说，VB中类的技术是学习中的一个难点，在大型软件的开发过程中，模块（Moudle)、控件（Active ocx)、链接库（Active dll)和类（Class moudle)构成了系统化、高效化的软件工程，而类的技术是控件和链接库技术的基础，因此掌握类的理论和编程方法是非常有意义的。

（一）类的基本定义和应用概述；

　　类是包含了方法、属性、数据成员的高级代码模块，它既在模块的范畴之内，又是一个没有图形界面的Active ocx，程序员可以象使用控件一样使用它，但却不能看到它，值得注意的是，类是不能继承的。
类能够使我们高效的完成对某一个或者某几个特定的对象的复杂操作，对象的动作就是类的方法，对象的属性就是类的属性过程。相对而言，如果编程的对象是一组事物，那么，我们采用标准模块的方式是非常合适的，在下列两种情况下，应该使用类进行代码处理：

　　（1）创建大量性质相近的对象；

　　（2）提高代码的封装性。

　　类的创建非常简单，在进行代码编写的时候，在“工程”菜单中选择“添加类模块”项目，就可以添加一个空白的类。

　　类文件一般以.cls作为扩展名保存。

　　（二）类的方法的实现；

　　类的方法类似于动态链接库的接口函数，它能够接受其他窗体代码的指定类型参数，并且传递到类中。一般来说类的方法是能够指定是否有返回值的。它在类中通常是一个public过程。请看下面的代码示例，它使一个密码框拒绝非字母的输入：

　　（1）类cls的代码；

　　 Option Explicit'变量检查

　　　Private WithEvents mytxt As TextBox

　　　 '本类中的方法接受和控制一个text密码框

　　　Dim isNUM As Boolean

　　　'类的模块级变量

　　　Public Sub Attach(itTEXT As TextBox)

　　　'接受外部变量到mytxt中

　　　Set mytxt = itTEXT

　　 End Sub

　　 Private Sub mytxt_KeyUp(KeyCode As Integer, Shift As Integer)

　　　　isNUM = (KeyCode >= 65) And (KeyCode <= 90)

　　　　'测试密码框的键盘输入是否是英文字母

　　　　If isNUM = False Then

　　　　　Beep

　　　　　mytxt.Text = ""

　　　　　'如果输入不是英文字母则响铃并且清空密码框内容

　　　　　MsgBox "非法字符输入！"

　　　　End If

　　　　Debug.Print mytxt.Text

　　　　'调试输出密码框内容

　　　　End Sub

　　　 '类的代码结束

　　（2）类的引用；

　　已经编写完成的类可以经过两种格式进行引用，第一种方式：Private（public或者dim) myCLS（指定的类名） As New cls（编写完成的类名）；第二种方式较多用于程序编写风格较“老”的程序员：首先在窗体代码中进行模块级声明――Dim myCLS As cls,然后在具体代码过程中进行具体定义―― Set mycls = New cls。这两种方式的效率和代码的简洁性方面可能会有所差别，但在笔者的编程实践中，并没有什么特别的感觉，不过我较多使用第一种方式，因为它书写起来更加方便。另外，在代码结束的时候，使用 Set myCLS = Nothing来取消类的资源占用是一种非常好的编程习惯。

　　在窗体form1中(窗体有一个密码框控件text1，passworldchar="*")添加以下代码：

　　Option Explicit

　　　Private myCLS As New cls

　　　'引用cls

　　　Private Sub Form_Load()

　　　myCLS.Attach Text1

　　　'启动类

　　End Sub

　　'在代码结束时记得释放资源

　　Private Sub Form_Unload(Cancel As Integer)

　　　Set myCLS = Nothing

　　End

　End Sub

　　本文代码展示了类的方法的代码编写过程和调用方式(尽管它和类的事件非常相似)，它的效果是，如果密码框中被输入了非字母，则系统振铃，并删除密码框中的原来的数据――在一定程度上保护密码。
类的方法可以不需要任何参数，这一点类似一个public的函数或者过程，它也是类中使用最广泛的。在下一篇文章中我将讨论，如何使用类的属性、事件和方法进行综合编程。
--------------------------------------------------------------------------------

　　在Visual Basic 6.0类的技术与应用（上）（以下简称上文）中，我们讨论了类的理论、类的创建和类的方法的编程实践，实际上，类之所以能够在软件工程中广泛应用，最主要的一点是它可以非常方便的封装许多编程需要的属性，这不仅使程序员在一定程度上克服控件（ocx）和链接库（dll）设计和调试中的复杂性，而且能够提高程序代码的简洁和高效性――本文将讨论完整的类的编程，包括方法、属性和基本事件。

　　（一）类的属性的特征和定义；

　　类似于标准控件的属性，类的属性允许用户在指定的数据范围内进行赋值，这些值被类内的各个代码部分所共享。属性的获得和传递需要经过 Property Let和Property Get语句进行编程，当然，我们首先需要在类中进行全局或者模块级的相应变量定义。

　　（二）事件的属性和基本定义；

　　和窗体的事件类似，类也有两个基本的事件，Class_Initialize（类加载时触发）和Class_Terminate（类卸载时触发），这两个事件都是private的。实际上，我们完全可以忽略这两个事件――只要你记得完善类的方法和属性。

　　类同样可以定义自己的事件，它和方法的程序编写格式类似，只不过需要WithEvents关键字进行参数声明,而且事件不能有任何命名参数或者可选参数，它也没有返回值。

　　实际上，结构良好的方法和属性完全可以替代结构复杂的类的事件。

　　（三）类的方法、事件和属性的编程实例；

　　本程序的设计目的是，通过类控制窗体中文本框的内容的全部大写、小写和逆向排序转化。

　　为了方便代码的书写和调用，我在类中引用了枚举的编程方法。

　　以下代码在类Class1：

　　Option Explicit

　　　Private WithEvents myTXT As TextBox

　　　'方法的参数接口

　　　Public Enum sTYLE

　　　　Lcaseit'小写属性

　　　　Lbigit'大写属性

　　　　Nlogoit'逆向排序属性

　　　End Enum

　　'自定义枚举，用来实现属性的自动赋值

　　Private mvarBiaozhi As sTYLE

　　'实现枚举常量的连接

　　Public Function dONE() As String'

　　'DONE方法用来根据指定的枚举属性，对

　　'窗体文本框进行相应的字符转化操作

　　'并且返回转化后的字符串

　　If mvarBiaozhi = Nlogoit Then

　　　dONE = StrReverse(myTXT)

　　　'逆向排序

　　ElseIf mvarBiaozhi = Lcaseit Then

　　　dONE = LCase(myTXT)

　　　'强制小写转化

　　Else

　　　dONE = UCase(myTXT)

　　　'强制大写转化

　　End If

　　End Function

　　'DONE方法结束

　　Public Property Let Biaozhi(ByVal vData As sTYLE)

　　　'获得属性的被赋的值

　　　mvarBiaozhi = vData

　　End Property

　　Public Property Get Biaozhi() As sTYLE

　　　'传递属性值到类中

　　　Set Biaozhi = mvarBiaozhi

　　End Property

　　Public Sub Attach(itTEXT As TextBox)

　　　'连接类的方法

　　　Set myTXT = itTEXT

　　End Sub

　　Private Sub Class_Initialize()

　　　'本事件在类倍加载时激活

　　　MsgBox "你好！本程序向您展示使用类的方法、属性、事件进行编程的技术！"

　　End Sub

　　Private Sub Class_Terminate()

　　　'本事件在类被卸载时激活

　　　MsgBox "你好！记得在Class_Terminate中填写对象撤销后的代码！"

　　End Sub

　　'类的代码全部结束

　　（四）窗体代码的引用编程；

　　在窗体FORM1中添加文本控件TEXT1、下拉列表控件COMBO1、命令按钮COMMAND1（CAPTION="开始转化"），调整三个控件到适当位置。

　　Dim myT As New Class1

　　'类的引用

　　Private Sub Form_Load()

　　　Combo1.Clear

　　　Combo1.AddItem "字符串大写转化"

　　　Combo1.AddItem "字符串小写转化"

　　　Combo1.AddItem "字符串逆向排序"

　　　Combo1.ListIndex = 0

　　　'在列表框中添加属性选项

　　End Sub

　　Private Sub Command1_Click()

　　　'当命令按钮按下时激活类

　　　myT.Attach Text1

　　　'方法参数联接

　　　Select Case Combo1.ListIndex

　　　　Case 0

　　　　　　myT.Biaozhi = Lbigit

　　　　Case 1

　　　　　　myT.Biaozhi = Lcaseit

　　　　Case 2

　　　　　　myT.Biaozhi = Nlogoit

　　　End Select

　　　'根据列表框的选择，给类的Biaozhi属性赋值

　　　'注意，在编程环境中，上述属性值自动添加

　　　Text1.Text = myT.dONE

　　　'返回排序结束后的字符串

　　End Sub

　　Private Sub Form_Unload(Cancel As Integer)

　　　Set myT = Nothing

　　End

　　'良好的编程习惯

　　End Sub

怎么样，我们的代码看起来如此的简洁，这种感觉就象是在使用一个控件，不仅可以随心所欲的调用，而且方便的使用了vb的自动提示功能。

　　（五）关于类的编程技术的总结；

　　严格的说，类是vb编程中的一个相当有用的技术，同样也是学习和掌握中的难点，类在大型软件工程中应用是非常广泛和卓有成效的，但是，在小型软件开发中，为了提高软件的效率和代码的清晰度，应该避免使用较多的类模块，控件和联接库，取代以标准模块。

　　本文所示例的代码比较简单，却覆盖了关于模块编程技术的方方面面，希望初学者能够有所借鉴，也希望程序员能够共同探讨。我们应该相信，无论多么复杂的高楼大厦都是由普普通通的方砖堆砌而成的，同样，无论所么复杂的软件工程都是由基本的程序语句所构成的，编程爱好者、程序员和分析员的区别只是在于，用同样的程序语句构建的程序的不同而

cyberfan 2005-08-12 14:34 发表评论

VB中使用Form设计打印报表

cyberfan — Fri, 12 Aug 2005 06:34:00 GMT

VB 中的打印一直是件比较头痛的事情。通常大家会采用两种方法实现打印功能，即使用 Printer 对象和别人制作的打印控件。

如果使用 Printer 对象需要自己去计算和控制打印位置，而在 VB中使用 Twip 作为长度单位的计算量是非常大的。想想，一毫米就有 56.7 Twip，一页 A4 纸的宽度是 210 毫米，就有 56.7 × 210 = 11907 Twip，如此大的计算量，非把头算晕不可。

如果使用控件，则有两个问题，一是网上的控件虽多，但往往没有详细的说明文档，使用的时候需要摸着石头过河；二是网上的通用控件有时候不能满足我们写打印程序的一些特殊要求，如不能设计比较复杂的表格等。

使用 VB 编程的程序员都习惯把控件往窗体上拖，这也是 VB 易用之所在。于是我们就有一种想法：如果设计打印报表也能这么做该多好？这种想法真的不错，而且也的确能够实现，因为 VB 的 Form 对象提供了 PrintForm 方法。PrintForm 方法会使用默认打印机打印当前 Form 中的可视内容，所以我们只需要设计一个合适的 Form，就可以非常容易地打印出理想的效果。

下面，我就以打印个人简历为例，说说如何使用 Form 实现打印以及需要注意些什么问题。

新建一个 Standard EXE 工程，将工程名改为 MyPrintForm，默认的 Form1 改名为 PrintForm。然后按下表修改其属性：

BorderStyle
0 - None
Width
10433

BackColor
&H00FFFFFF&
Height
14742

Font
宋体, 小五

其中，PrintForm 的大小是按 16 开纸的大小设置的。

然后，使用 Label、Shape 和 Line 控件在 PrintForm 中绘制出个人简历表格。

个人简历绘制完成后直接就可以打印，随便在窗体中放一个按钮 Command1，在其 Click 事件中写两行代码即可：

Me.Command1.Visible = False

Me.PrintForm

然而，使用这种方法用于打印实在有些不正规。而且，那么大一个 PrintForm 显示在屏幕上，既不能滚动也不能改变位置，实在有些难受——现在是该使用 MDIForm 的时候了。添加一个新的 MDIForm，命名为 MDIFormMain；将 PrintForm 的 MDIChild 属性改为 True；这时候运行程序，是不是非常漂亮的预览效果？如果运行的时候 PrintForm 没有显示出来，请设置 MDIFormMain 的 AutoShowChldren 属性为 True。

现在我们只需要为 MDIFormMain 添加菜单或者按钮以便选择打印。添加菜单的方法相对比较简单，所以就添加一个菜单吧：名称 MenuPrint，标题为“打印(&P)”。不过菜单的代码当然不会还是 Me.PrintForm 了，应该改为

Me.ActiveForm.PrintForm

至此，简单的打印功能已经完成了。但是对于个人简历表格，你是宁愿填好了再打印还是打印好了再填呢？用惯了计算机打印的人恐怕都不太喜欢动笔，所以，如果能直接在 PrintForm 上填写内容，再将填好的表格打印出来就更好了。

要办到这一点并不难，只需要在每个需要填写内容的地方放上一个 TextBox 按控件即可，当然，这个控件要设置一下：

Appearance
0 - Flat
BorderSytle
0 - None

然后记得清空它们的 Text 属性，放适当的调整位置和大小。

再打印一次试试，结果并不如想象的那么好：TextBox 中的文本不是按矢量图打印的，而是按位图打印的，所以字体看起来非常不光滑。唯一的解决办法就是在放置 TextBox 的地方，放置一个同样大小同样位置 Label 控件，并使之置于 TextBox 之下。然后修改打印菜单的 Click 事件：

With Me.ActiveForm

Label1.Caption = TextBox1.Text

TextBox1.Visible = False

……

.PrintForm.

End With

从代码可以看出来，就是把每个 TextBox 的 Text 值赋予对应的 Label 的 Caption 属性。然后再把这些 TextBox 隐藏掉。看看，这次打印出来是不是非常令人满意了！

cyberfan 2005-08-12 14:34 发表评论

基于VB的分布式监控系统通信设计

cyberfan — Fri, 12 Aug 2005 06:33:00 GMT

摘要：本文介绍了利用VB的多种通信手段实现分布式监控系统的多种通信功能，对每一种通信手段给出其原理和应用实例。

　　关键词： VB 通信串行口控件 DDE API

　　1．概论

　　分布式监控系统已在工业领域得到广泛应用，许多企业对于中小规模的设备，如中小型热电厂和水电站，出于硬件软件投资利润率和性能价格比的考虑，常常是自行开发或参与开发本企业的监控系统。而许多企业在成套引进大型DCS系统后，也常因实际情况而需要自行开发或改进其监控系统。

　　分布式监控系统以微机为基础，用数据通信将微机连在一起实现数据共享，从而对工业过程进行集中监视管理和分散控制。因此，分布式监控系统中通信的设计与实现是至关重要的环节。Visual Basic开发语言具有简洁明了、编程效率高、开发周期短的特点，利用VB中的多种通信手段，可实现分布式监控系统的多种通信功能。

　　2．与下位机的通信

　　分布式监控系统的数据采集站可直接与现场带有标准RS-232C接口的智能仪表、PLC和单片机等链接，并可通过扩展控制卡形成一个数据采集子网，以高速准确地获取数据。VB的MSCOMM通信控件具有完善的串口数据发送和接受功能，利用它可以屏蔽对硬件的操作，简易快捷地进行串行通信编程。

　　本文的实例为上位机与OMRON 200HG系列PLC的1:N链接通信。带有RS-485接口通信板的PLC直接挂在RS-485总线上，上位机通过RS-232C /RS-485转换器与总线相连，这样即构成数据采集子网，甚至可以是一个独立的小型分布式监控系统。其它仪器仪表设备，只要是标准串口都可以类似方式直接或间接与上位机链接。
关于VB的MSCOMM控件可参考相关资料。本例通信程序摘要如下：

　　（1）初始化程序

Mscomm1.Commport=2 ' 选择COM2
Mscomm1.Settings="9600,N,8,2" ' 设置通信参数
Mscomm1.Inputlen=0 ' 读入接收缓冲区全部字符
Mscomm1.OutbufferSize=256 ' 设置发送缓冲区大小
Mscomm1.InbufferSize=512 ' 设置接收缓冲区大小
Mscomm1.PortOpen=True '打开COM2

　　（2）发送命令程序

　　比如读取节点号03的PLC中IR000到IR009的内容，并放到tag1字符串变量中，此时有：

Dim Command, node, begin, number as string
Dim Answerlen as integer
node="03" '节点号
Command="RR" '命令为读IR区
begin="0000" '从IR000开始
number=10 '读取长度
Answerlen=51 '计算接收字符串长度

　　进行命令发送和接收应答处理：

Dim FCS, I as integer
Dim s ,f as string
s="@"+node+Commad+begin+number
FCS=0
For i=1 to Len(s)
FCS=FCS xor Asc(Mid$(s,i,1) ) '帧校验码FCS
Next i
f=Hex$(FCS)
If Len(f)=1 Then f="0"+f
Commfrm.MSComm1.Output=s + f + "*" + CHR$(13) '命令帧发送
Do
Dummy=DoEvents()
Loop Untill Commfrm.MSComm1.InbufferCount >= Answerlen '等待应答帧
Do tag1= Commfrm.MSComm1.Input
Loop Untill Commfrm.MSComm1.InbufferCount=0 '读完应答帧

　　上述程序具有相当的通用性，对于其它设备不同的只是各自的数据帧格式，因而只需做相应少量修改即可。

3．节点自身的“通信”

　　节点自身的"通信"是一种形象的说法，严格说来应是VB应用程序利用DDE技术与本节点其它Windows应用程序进行数据交换。DDE （Dynamic Data Exchange）即动态数据交换，它是Windows支持的三种内部通信机制之一，是应用程序间通过共享内存进行进程间通信的一种形式。应用程序间进行数据交换称为"会话"（Conversation），申请会话端叫客户（Client），响应申请端叫服务器（Server）。一旦客户与服务器间建立起 DDE所需的数据链路就可自动进行数据交换。

　　在监控系统开发中，工控组态软件以其功能强大、使用方便等特点得到广泛应用，但在处理复杂数据时其计算功能受到一定限制，而VB可以较好地弥补这一不足，并且还能承担数据采集、报表打印等功能。这就需要在VB应用程序与组态软件应用程序间进行动态数据交换。

　　VB中只有TextBox、PictureBox、Label和Form可以与其它应用程序进行动态数据交换，控件用于DDE的属性项有 LinkTopic（连接主题）、LinkItem（连接项）、LinkMode（连接模式）和LinkTimeout（连接等待时间）。

　　这里以本实验室的小型分布式监控实验系统为例，介绍一个VB应用程序与组态王5.0应用程序间实现DDE的实例。

　　3.1 VB作为Server，组态王作为Client

　　当有些参数需要从VB应用程序传输到组态王应用程序，如VB从PLC采集水位值参数至程序Ser.vbp的Text1，再将数据动态传递给组态王的I/O变量SW，这时VB作为Server，组态王作为Client。
VB程序Ser.vbp 中属性设置如下（Form1为Text1所在窗体）：

Form1.LinkTopic = "water" 数据交换的话题
Form1.LinkMode = 1 作为服务器

　　组态王的设置如下：

　　新建一个名为vbdde的DDE设备，服务程序名Ser，话题名water，数据交换方式为标准WINDOWS项目交换。新建一个名为SW的I/O变量，连接设备设为vbdde，项目名设为Text1。

　　3.2 组态王作为Server，VB作为Client

　　当有些参数需要从组态王传输到VB，如为了提高变频器电压以提升泵速，可在组态王应用程序中改变I/O变量BS值并动态传递给VB的Text2，VB接收到数据后经处理再传递给PLC相应继电器区。这时组态王作为Server，VB作为Client。

　　组态王设置如下：

　　新建一个名为BS的I/O变量，连接设备设为已建立的vbdde设备，项目名设为bengsu。

　　VB程序Ser.vbp中设置如下：

Text2.LinkTopic = "view|tagname"
Text2.LinkItem = "bengsu"
Text2.LinkMode = 1

　　TextBox控件有无连接、自动式连接、被动式连接和通知式连接四种连接模式，可依据实际情况灵活运用。

4. 网络通信

　　VB6.0与旧版本相比较，最明显的特点是增加了强大的网络功能，将其用于分布式监控系统中可以轻松地实现远程通信。VB的WINSOCK控件有效屏蔽了对WINDOWS套接字的低层操作，可方便地建立起网络中任意两个具有唯一IP地址节点间的连接，并通过UDP或TCP协议进行数据交换，可用于创建 Client/Server应用程序。

　　本文举分布式监控系统中节点间通信的实例，其中节点A（IP地址202.114.102.134）作为服务器负责某一区域的数据采集与处理，程序内有一名为TCPServer的Winsock控件；节点B（IP地址202.114.102.135）是同级或上一级的某一节点，作为客户机，其程序内有一名为TCPClient的Winsock控件。

　　节点A服务器核心程序如下：

　　（1）初始化程序

tcpserver(0).RemoteHostIP = 202.114.102.135
tcpserver(0).LocalPort = 1001 'tcpserver(0)专用于侦听
tcpserver(0).Listen

　　（2）发送数据程序

tcpserver(Index).SendData Text1.Text

　　（3）处理客户机连接请求程序

Private Sub TCPServer_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Load tcpserver(Index)
tcpserver(Index).Accept requestID
End Sub

　　（4）客户机数据到达处理程序

Private Sub TCPServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim RD As String
tcpserver(Index).GetData RD, vbString
txtRD.text=RD
tcpserver(Index).SendData RD
End Sub

　　（5）关闭连接程序

Private Sub TCPServer_Close(Index As Integer)
tcpserver(Index).Close
Unload tcpserver(Index)
End Sub

　　以上程序着重说明Winsock控件的主要属性、方法和事件，如要实现多进程（多个客户程序同时运行），可应用创建控件数组来代表已连接的控件实例的方法处理。

　　节点B客户机核心程序如下：

Private ConnectFlag As Boolean '设置判断是否连接标志

　　(1)初始化程序

TCPClient.RemoteHost IP= 202.114.102.134 '远程计算机IP地址
TCPClient.RemotePort = 1001 '远程计算机端口
ConnectFlag = False

　　（2）申请连接程序

If Not ConnectFlag Then
TCPClient.Close
TCPClient.Connect
Do
DoEvents
Loop Until TCPClient.State = sckConnected
ConnectFlag = True
End Sub

　　（3）数据到达处理程序

Private Sub TCPClient_DataArrival(ByVal bytesTotal As Long)
Dim RD As String
TCPClient.GetData RD, vbString
txtRD.text = RD
End Sub

　　（4）发送数据程序

TCPClient.SendData txtSD.Text

　　（5）关闭连接程序

Private Sub TCPClient_Close()
TCPClient.Close
Do
DoEvents
Loop Until TCPClient.State = sckClosed
ConnectFlag = False
End Sub

5. 远程通信

　　当监控系统的一些重要信息，如严重事故，需要及时通知有关部门即实现远程通信时，可以利用网络中某一连接至Internet的带有MODEM的节点，通过MODEM自动拨打电话，将信息及时地送达有关部门。

　　应用VB的MSCOMM控件可实现这一功能，基本方法与下位机通信类似。这里介绍调用API函数直接写I/O端口，使用设备控制块DCB的方法拨打电话并挂起MODEM。

　　首先利用VB的API Viewer浏览器在module1模块中声明对以下函数、数据类型和常量的引用:

CreateFile 函数
CloseHandle 函数
BuildCommDCB 函数
SetCommState 函数

　　DCB数据类型

GENERIC_READ常量
GENERIC_WRITE 常量
OPEN_EXISTING 常量

　　（1） MODEM设置子程序

Public Function ModemSetup( ) As Boolean
Dim lResult As Long
Dim lCommHandle As Long
Dim DCB_Comm As DCB
Dim tDCBConfig As String
ModemSetup = True
'指定lCommHandle为通信源对象的句柄
lCommHandle = CreateFile(COM2，GENERIC_READ Or GENERIC_WRITE, _
0&, 0&, OPEN_EXISTING, 0&, 0&)
'构造DCB对象的初始化字符串
tDCBConfig = "baud=9600" & "parity=NONE" & "data=8" & "stops=1"
'用初始化字符串指定DCB对象的规范
lResult = BuildCommDCB(tDCBConfig, DCB_Comm)
'根据指定DCB对象的规范来设定通信设备
lResult = SetCommState(lCommHandle, DCB_Comm)
lResult = CloseHandle(lCommHandle)
End Function

　　（2）发送数据子程序

Public Function ModemSD(tComm As String, tModemSend As String) As Boolean
Dim nModem As Integer
ModemSS = True
nModem = FreeFile
Open tComm For Output As nModem
Print #nModem, tModemSend
Close #nModem
End Function

　　（3）主程序

ModemSetup
ModemSS(COM2, "ATDT" &"02767802169"& vbCr)
ModemSS(COM2, "ATDT" & txt1.Text & vbCr)
ModemSS(COM2, "ATH" & vbCr)

　　本例重在说明基本原理，没有加入错误捕获陷阱及通信异常处理。

　　6. 结束语

　　本文介绍了应用VB开发分布式监控系统的各种通信功能的基本原理和实例。通过以上实例可以看出，用VB开发通信程序简洁明了，编程效率高，可维护性好，尤其适用于自行开发中小型分布式监控系统。

cyberfan 2005-08-12 14:33 发表评论

基于VB的通用折行打印程序

cyberfan — Fri, 12 Aug 2005 06:32:00 GMT

---- 几乎所有数据库应用软件，都需要打印单证和报表。常见的方法是利用VB的Crystal Reports(水晶报表)方式，通过TextBox等数据绑定控件，调用Print方法直接输出。虽然Crystal Report这一个功能强大、样式丰富且无编程方式的报表编制程序能适应大部分单证、报表打印的需要，但是Crystal Reports引擎是一个动态链接库，需许多文件支持和调用更多系统资源，大大增加系统负担。

---- 另一种解决办法是通过Printer对象的Print方法，直接打印字符串。这虽然减少了系统资源的开销，但它不能直接用于打印复杂的单证和报表。本文通过两个实例，阐述一个通用折行打印程序的编程和在单证及报表的应用。

---- 二．编程实现及实例

---- 为便于阐述的方便，我们先建立一个Access数据库Standards.mdb，其内SN表由以下几个字段组成：

---- 标准号（文本，17）

---- 标准名称（文本，255）

---- 英文名称（文本，255）

---- 实施日期（日期，8）

---- 修定日期（日期，8）

---- 发布日期（日期，8）

---- 代替标准（文本，50）

---- 通用折行打印程序编制操作如下：

---- 1.在VB5.0编程环境中，新建一个工程Project1；

---- 2. 在Project1中添加Moduel，在Moduel模块中定义一个记录最大折行数的公用变量Rowlab和Function函数（以下程序都经过实际运行测试，可以原样复制使用）；

Public rowlab As Integer　　　
'定义一个公用变量
Function prnt11(X As Integer, Y As
Integer,Font As Single, Txt As String, Val As Integer)
Dim str As String, str1 As String,
str2 As String ,i As Integer
Printer.CurrentX = X
Printer.CurrentY = Y
Printer.FontBold = False
Printer.FontSize = font
str = txt
str2 = str
i = 0
rowlab = 0
If Len(Trim(str)) = 0 Then
　　 rowlab = 1　 '待打印字符串为空的标志
Else
　Do While Len(str) > 0
　　 Printer.CurrentX = X
　　 Printer.CurrentY = Y + rowlab * 240
　　 rowlab = rowlab + 1
　　 If Len(str) >= val Then
　　　　str1 = Mid(str, 1, val)
　　　　Printer.Print str1
　　　　i = i + 1
　　　　str = Mid(str2, i * val + 1)
　　 Else
　　　 Printer.Print str
　　　 Exit Do
　　 End If
　 Loop
End If
End Function

---- 3．在Project1中新建一个窗体Form1，窗体上添加一个Data控件Data1，一个MSFlexGrid控件MSFGrid1，7个TextBox和两个命令按钮CmdPrnt1、CmdPrnt2。设置Data控件的属性：

.. DatabaseName="Standards.mdb"
..RecordSourse="SN"
　 MSFGrid1属性：
　　　 .DataSource="Data1"
　 Text1属性：
　　　 .DataSource="Data1"
　　　 .DataField="标准号"
　 Text2~Text7类同。

---- CmdPrnt1、CmdPrnt2分别为打印单条记录和多条记录的按钮。

---- 实例1：文字串定位折行打印在口岸联检部门中应用非常广泛。下述例子是用CmdPrnt1的Click事件代码实现了对文字串定位折行打印：

Private Sub CmdPrnt1_Click()
Dim str As String, str1 As String ,txt As String
Dim strx As Integer, stry As Integer,i As Integer
strx = 200
stry = 0
txt = Space(20) + "中国出入境检验检疫标准目录检索STEMS 2000"
Printer.FontName = "黑体"
dd = prnt11(strx, stry, 10, txt, 50)
stry = stry + rowlab * 240
Printer.Line (0, stry)-(9000, stry)
Printer.FontName = "宋体"
txt = "标准号：" + Space(2) + Trim(Text1) + Space(3) +
"发布日期：" + Trim(Text4) + Space(3) + "实施日期："
+ Trim(Text6) + Space(3) + "修定日期：" + Trim(Text5) '+ Chr(13)
stry = stry + 240
dd = prnt11(strx, stry, 10, txt, 70)
stry = stry + rowlab * 240
txt = "代替标准："
dd = prnt11(strx, stry, 10, txt, 10)
dd = prnt11(strx + 1000, stry, 10, Trim(Text7), 60)
stry = stry + rowlab * 240
txt = "标准名称："
dd = prnt11(strx, stry, 10, txt, 10)
dd = prnt11(strx + 1000, stry, 10, Trim(Text4), 38)
stry = stry + rowlab * 240
txt = "英文名称："
dd = prnt11(strx, stry, 10, txt, 10)
dd = prnt11(strx + 1000, stry, 10, Text5, 72)
Printer.EndDoc
End Sub

---- 注： Prnt11函数原形：prnt11(X As Integer, Y As Integer, Font As Single, Txt As String, Val As Integer)，其各参数含义如下：

---- X、Y为待打印字符串左上角起始座标；

---- Font为字体大小；

---- Txt为待打印字符串；

---- Val为字符串打印折行长度。

---- 实例2：直接打印表格式窗体显示的多记录多字段，往往因某些字段的字节太多而造成纸张宽度不足。以下CmdPrnt2的Click事件中的代码，实现了对上述MSFGrid1表格记录的打印：

Private Sub CmdPrnt2_Click()
Dim fnt As Single
Dim pp As Integer
Dim stry As Integer, strx As Integer
Dim stry1 As Integer,
strx1 As Integer, linw As Integer
Dim page1 As Integer, p As Integer,
gridrow As Integer, ii As Integer
p = 0
ii = 1　'ii记录MSFGRID1表格同一记录内字段最大打印行
pp = 0 '开始页码
ss$ = "中国出入境检验检疫标准目录检索STEMS 2000" ' 表头
Static a(4) As Integer
kan = 0
a(2) = 1680
a(3) = 2800
a(4) = 5300
page1 = 46 '定义每页行数
　strx = 200
　strx1 = 200
　stry = 1400
　stry1 = 1400
　linw = 240 '定义行宽
　fnt = 10 '定义字体大小
　For i = 2 To 4
　　　kan = kan + a(i)
　Next
　gridrow = Datdatact1.Recordset.RecordCount
　If gridrow = 0 Then
　　 MsgBox "无满足条件记录打印！"
　　 Exit Sub
End If
　Printer.FontName = "黑体"
　dd = prnt11(3300, 700, fnt, ss$, 26) '打印标题
　dd = prnt11(500, stry - 250, fnt, "标准号", 26)
　dd = prnt11(2690, stry - 250, fnt, "标准名称", 26)
　dd = prnt11(6690, stry - 250, fnt, "英文名称", 26)
　Printer.Line (strx - 20, stry - 30)-(10460, stry - 30)
　Printer.FontName = "宋体"
　For j = 1 To gridrow　'打印gridrow条记录
　　　 MSFGrid1.Row = j
　　　 strx = strx1
　　　 For i = 2 To 4 '假设只打印2-3 列
　　　　 MSFGrid1.Col = i
　　　　 dd = prnt11(strx, stry, fnt,
MSFGrid1.Text, IIf(i = 3, 13, 55))
　　　　 If ii < rowlab Then
'ii记录同一记录内字段最大打印行
　　　　　 ii = rowlab
　　　　 End If
　　　　 strx = strx + a(i)
　　　 Next
　　　 p = p + ii
　　　 rowlab = ii
　　　 ii = 1 '重新初始化
　　　 If p > page1 Then
　　　　　 p = 0
　　　　　 strx = strx1
　　　　　 For n = 2 To 4
　　　　　　 strx = strx + a(n)
　　　　　 Next
　　　　　 pp = pp + 1
　　　　　 stry = stry + rowlab * linw
　　　　　 foot$ = "第" + CStr(pp) + "页"
　　　　　 dd = prnt11(strx / 2, stry + 3 * linw, 10, foot$, 26)
　　　　　 stry = stry1
　　　　　 Printer.NewPage
　　　　　 Printer.FontName = "黑体"
　　　　　 dd = prnt11(3300, 700, fnt, ss$, 26)
　　　　　 dd = prnt11(500, stry - 250, fnt, "标准号", 26)
　　　　　 dd = prnt11(2690, stry - 250, fnt, "标准名称", 26)
　　　　　 dd = prnt11(6690, stry - 250, fnt, "英文名称", 26)
　　　　　 Printer.Line (-20, stry - 30)-(10460, stry - 30)
　　　　　 '打印起始线
　　　　　 Printer.FontName = "宋体"
　　　　　 strx = strx1
　　　　 Else
　　　　　 stry = stry + rowlab * linw
　　　　 End If
　　　Next
　　　If p < page1 Then
　　　　　For p = 0 To page1 + 1
　　　　　　 strx = strx1
　　　　　Next
　　　End If
　　　strx = strx1
　　　For n = 2 To 4
　　　　　strx = strx + a(n)
　　　Next
　　　pp = pp + 1
　　　foot$ = "第" + CStr(pp) + "页"
　　　dd = prnt11(strx / 2, stry + 3 * linw, 10, foot$, 26)
　　　Printer.EndDoc
　End Sub

---- 以上程序在简体中文Windows98、VB5.0环境中调试通过。

cyberfan 2005-08-12 14:32 发表评论

建立一个非窗体的VB程序

cyberfan — Fri, 12 Aug 2005 06:31:00 GMT

在某些情况下，你一定需要在没有用户界面的环境中运行并完成任务的程序。这种程序的类型可以被其他程序或者批文件调用以执行如文件操作的任务。或者，这种程序可能是一个没有窗体的命令行。这一篇文章将讲述如何在VB中建立这样的程序。

你可能认为VB程序总是与窗体有关的，其实决非全然。是的，一个VB程序在缺省的情况下是一个窗体，但在需要的时候你也可以去掉它。而且，建立一个非窗体的VB程序只需要一个步骤，以下是整个过程的全部。

1. 建立一个新的标准EXE VB程序。

2. 在工程中添加一个代码模块。

3. 选择工程的缺省窗体，并使用Project|Remove Form1命令来删除窗体。

4. 在程序的代码模块中添加一个名为Main的程序。(这也就是当程序运行的起点)

一个非窗体的模块在需要的时候可以包含其他Sub和Function程序。模块也可以使用类模块，使用API调用，以及可以使用任何一个普通VB程序的所有功能。

一个非窗体VB程序还可以使用可视化的屏幕成分，比如MsgBox和InputBox，但是最好的方法是避免这些调用，因为这很有可能造成建立一个非窗体程序的失败。

进入一个非窗体的程序
将信息传递到一个非窗体程序的最常用的方法是使用命令行变量。在程序中，Command$函数返回一个字符串，这一字符串包含当程序启动时可以被传递的任何命令行变量。这些变量位于程序名称之后，如下显示：

C:\>ProgramName argument1 argument2

变量是用户在一个命令提示符下键入，包括一个批文件命令，或者是一个快捷键的属性。

一个范例

在这一个非窗体程序的范例中，被传递的是作为一个命令行参数的一个文本文件的名称。程序读入文件，并使用两个空白字符取代每一个Tab字符，然后将文件传到磁盘。

程序代码中缺乏一个普通程序需要的错误检测和其他安全特性。为了编译程序，你必须在References对话框中(选择 Project | References)选择微软脚本运行时间。

将程序编译成为EXE程序之后，你就可以从命令行中运行，如下所示：

C:\TabsToSpaces myfile.txt

使用VB来建立一个非窗体命令行程序的特性很吸收人，你一定会发觉这一特性非常有用。当你的程序需要访问stdin和stdout流的时候，使用这一功能程序就会变得更加灵活，这也就是我们下一章节要讲述到的主题。

Sub Main()

Dim fs As New Scripting.FileSystemObject
Dim f As TextStream
Dim filename As String
Dim strin As String
Dim strout As String
Dim ch As String
Dim idx As Long

filename = Command$
Set f = fs.OpenTextFile(filename)
strin = f.ReadAll
f.Close

For idx = 1 To Len(strin)
ch = Mid(strin, idx, 1)
If ch = Chr(9) Then
strout = strout & " "
Else
strout = strout & ch
End If
Next idx

Set f = fs.CreateTextFile(filename, True)
f.Write (strout)
f.Close

End Sub

cyberfan 2005-08-12 14:31 发表评论

基于VB6.0射击游戏的实现

cyberfan — Fri, 12 Aug 2005 06:30:00 GMT

随着计算机技术的进步，计算机游戏也越来越普及，很多喜爱程序开发的读者朋友都向往游戏编程，但往往又觉得游戏编程序很复杂，高深莫测。诚然，象"帝国时代"、"反恐精英"这样的大型游戏需要写很复杂的程序来实现一些令人"头昏"的算法，需要熟悉DirectX开发知识。但是，对于一般的开发人员，完全可以利用所学的知识开发一些小的游戏，达到自娱自乐的目的。

　　本文介绍如何在Visual Basic6.0环境下开发射击小游戏，通过实现该小游戏可以帮助一些Visual Basic初学者加深对Visual Basic编程知识的理解，同时它也可以开拓初、中级开发爱好者的编程思路。该射击小游戏程序编译运行后的界面效果如图一所示：

图一、射击游戏界面图

　　在射击游戏中，安排了两个角色，相互之间可以开枪进行对射，同时为了丰富游戏的功能，游戏的场景中添加定时移动的仙人掌，为射击的双方角色提供保护功能。当其中一个角色中弹后，游戏终止，同时游戏人物角色的图标变更，表示角色死亡。为了实现上述的游戏，最初要作的是设计程序界面，按照游戏的需求，首先生成一个VB应用程序，在Form1上添加一个开始按钮btnStart，一个名为picDesert的Picture控件，该控件用来做为游戏的场景和其它控件的容器，在该控件上添加六个Image控件，分别用来显示游戏的角色、两个移动的仙人掌、分别向右、向左呼啸射击的子弹以及标志角色死亡的图标，它们的图象分别如下：

游戏角色　仙人掌呼啸的子弹角色击中标志

　　为了使程序中的仙人掌、游戏角色和射击时发射的子弹可以移动，需要向项目中添加定时器tmrMouseCnt和Timer1，在这两个定时响应函数中完成不同对象的移动功能。在游戏运行后，为了使用户可以通过键盘和鼠标来操作游戏的角色，实现射击的功能，需要添加鼠标消息和键盘消息处理函数。例如，对于角色1来说，可以通过上下键来移动，空格键来射击，对于角色2来说，鼠标左右键控制移动，双击实现射击。在射击过程中，要处理两个细节，一个细节是子弹与仙人掌及角色的区域重叠问题，当子弹与仙人掌重叠时让子弹隐藏起来，与角色重叠时表示击中目标，游戏结束。这里需要判断何时两个区域有重叠，解决这个问题的方法是使用API函数IntersectRect，用它来判断两个区域是否有重叠。另一个细节是子弹射击过程中需要添加"呼啸"的声音和击中目标时添加人物惨叫的声音，来达到逼真的效果，为了实现这个功能，需要向程序中添加语音文件（程序中的语音文件分别为：BANG.WAV和OH！！.WAV），然后通过API函数sndPlaySound来实现。另外，在对象移动的过程中，需要注意移动到边缘位置的情况处理。

　程序的具体实现代码如下：

' SHOOTOUT.BAS
Option Explicit
' Data type required by the IntersectRect function
Type tRect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
' Windows API rectangle functions
Declare Function IntersectRect Lib "user32" (lpDestRect As tRect, lpSrc1Rect As tRect, lpSrc2Rect As tRect) As Long
' Functions and constants used to play sounds.
Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
' Constant used with sndPlaySound function
Global Const SND_ASYNC = &H1
'----------------------------------------------------------
' SHOOTOUT.FRM
Option Explicit
' KeyCodes for keyboard action.
Const KEY_SPACE = &H20
Const KEY_UP = &H26
Const KEY_DOWN = &H28
' Number of Twips to move player on each key or mouse event.
Const PlayerIncrement = 45
' Constants for mouse action.
Const NO_BUTTON = 0
Const LBUTTON = 1
Const RBUTTON = 2
' Boolean that indicates if mouse button has been pressed down.
Dim MouseButtonDown As Integer
' Number of bullets either player can have in use at one time.
Const NUM_BULLETS = 6
' Booleans indicating if player 0 or player 1 have just fired.
Dim GunFired(0 To 1) As Integer

' Start the game by enabling the main timer and hiding the start button.
Private Sub btnStart_Click()
Timer1.Enabled = True
btnStart.Visible = False
End Sub

' Check if the two Images intersect, using the IntersectRect API call.
Private Function Collided(imgA As Image, imgB As Image) As Integer
Dim A As tRect
Dim B As tRect
Dim ResultRect As tRect
' Copy information into tRect structure
A.Left = imgA.Left
A.Top = imgA.Top
B.Left = imgB.Left
B.Top = imgB.Top
' Calculate the right and bottoms of rectangles needed by the API call.
A.Right = A.Left + imgA.Width - 1
A.Bottom = A.Top + imgA.Height - 1
B.Right = B.Left + imgB.Width - 1
B.Bottom = B.Top + imgB.Height - 1
' IntersectRect will only return 0 (false) if the
' two rectangles do NOT intersect.
Collided = IntersectRect(ResultRect, A, B)
End Function

' Double-clicking the mouse fires Player 1's gun.
Private Sub Form_DblClick()
Dim rc As Integer
If Not Timer1.Enabled Then Exit Sub
GunFired(1) = True
rc = sndPlaySound(App.Path & "\BANG.WAV", SND_ASYNC)
End Sub

' This event handles Player 0's game action via the keyboard.
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim rc As Integer
Static InKeyDown As Integer
If Not Timer1.Enabled Then Exit Sub
If InKeyDown Then Exit Sub
InKeyDown = True
DoEvents
Select Case KeyCode
Case KEY_UP
imgPlayer(0).Top = imgPlayer(0).Top - PlayerIncrement
If imgPlayer(0).Top < 0 Then imgPlayer(0).Top = 0
Case KEY_SPACE
GunFired(0) = True
rc = sndPlaySound(App.Path & "\BANG.WAV", SND_ASYNC)
Case KEY_DOWN
imgPlayer(0).Top = imgPlayer(0).Top + PlayerIncrement
If imgPlayer(0).Top > (picDesert.ScaleHeight -
imgPlayer(0).Height) Then
imgPlayer(0).Top = picDesert.ScaleHeight -
imgPlayer(0).Height
End If
End Select
InKeyDown = False
End Sub

Private Sub Form_Load()
Dim i As Integer
Timer1.Interval = 22
Timer1.Enabled = False
MouseButtonDown = NO_BUTTON
For i = 1 To NUM_BULLETS - 1
Load imgLBullet(i)
Load imgRBullet(i)
Next
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseButtonDown = Button
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseButtonDown = NO_BUTTON
End Sub

' The main game timer.
Private Sub Timer1_Timer()
Const CactusIncrement = 30
Const BulletIncrement = 300
Const NumCacti = 2

Dim i As Integer
Dim rc As Integer
' Move the roving cacti.
For i = 0 To NumCacti - 1
imgCactus(i).Top = imgCactus(i).Top - CactusIncrement
If imgCactus(i).Top < -imgCactus(i).Height Then
imgCactus(i).Top = picDesert.Height
End If
Next
' Did player 0 fire a bullet?
If GunFired(0) Then
GunFired(0) = False
' Find a spare (invisible) bullet.
For i = 0 To NUM_BULLETS - 1
If Not imgLBullet(i).Visible Then
imgLBullet(i).Top = imgPlayer(0).Top
imgLBullet(i).Left = imgPlayer(0).Left +
(imgPlayer(0).Width / 2)
imgLBullet(i).Visible = True
Exit For
End If
Next
End If
' Did player 1 fire a bullet?
If GunFired(1) Then
GunFired(1) = False
' Find a spare (invisible) bullet.
For i = 0 To NUM_BULLETS - 1
If Not imgRBullet(i).Visible Then
imgRBullet(i).Top = imgPlayer(1).Top
imgRBullet(i).Left = imgPlayer(1).Left -
(imgPlayer(1).Width / 2)
imgRBullet(i).Visible = True
Exit For
End If
Next
End If
' Move Visible Bullets
For i = 0 To NUM_BULLETS - 1
' Move player 0's bullets.
If imgLBullet(i).Visible Then
imgLBullet(i).Left = imgLBullet(i).Left + BulletIncrement
If Collided(imgLBullet(i), imgCactus(0)) Then
imgLBullet(i).Visible = False
ElseIf Collided(imgLBullet(i), imgCactus(1)) Then
imgLBullet(i).Visible = False
ElseIf imgLBullet(i).Left > picDesert.ScaleWidth Then
imgLBullet(i).Visible = False
ElseIf Collided(imgLBullet(i), imgPlayer(1)) Then
imgLBullet(i).Visible = False
imgPlayer(1).Picture = imgRIP.Picture
Timer1.Enabled = False
rc = sndPlaySound(App.Path & "\OH!!.WAV", SND_ASYNC)
End If
End If
' Move player 1's bullets.
If imgRBullet(i).Visible Then
imgRBullet(i).Left = imgRBullet(i).Left - BulletIncrement
If Collided(imgRBullet(i), imgCactus(0)) Then
imgRBullet(i).Visible = False
ElseIf Collided(imgRBullet(i), imgCactus(1)) Then
imgRBullet(i).Visible = False
ElseIf imgRBullet(i).Left < -imgRBullet(i).Width Then
imgRBullet(i).Visible = False
ElseIf Collided(imgRBullet(i), imgPlayer(0)) Then
imgRBullet(i).Visible = False
imgPlayer(0).Picture = imgRIP.Picture
Timer1.Enabled = False
rc = sndPlaySound(App.Path & "\OH!!.WAV", SND_ASYNC)
End If
End If
Next
End Sub

' Handle Player 1's movement (up and down).
Private Sub tmrMouseCntl_Timer()
If Not Timer1.Enabled Then Exit Sub
Select Case MouseButtonDown
Case RBUTTON
imgPlayer(1).Top = imgPlayer(1).Top - PlayerIncrement
If imgPlayer(1).Top < 0 Then imgPlayer(1).Top = 0
Case LBUTTON
imgPlayer(1).Top = imgPlayer(1).Top + PlayerIncrement
If imgPlayer(1).Top > (picDesert.ScaleHeight -
imgPlayer(1).Height) Then
imgPlayer(1).Top = picDesert.ScaleHeight -
imgPlayer(1).Height
End If
End Select
End Sub

　　文章的上述内容对射击游戏中的各个实现功能进行了详细的介绍，读者朋友可以根据文章中的程序代码自己动手实验一下。本程序在Windows2000、Visual Basic6.0环境下编译通过，运行正常。

cyberfan 2005-08-12 14:30 发表评论

用ADO与大型数据库的无“数据源”连接

cyberfan — Fri, 12 Aug 2005 04:48:00 GMT

目前，绝大多数的数据库参考书都介绍了ODBC的手工配置方法，或者介绍了如何在代码中进行ODBC配置。但这两种方法都有一定的局限性: 不是当程序最终完成并分发到用户手中后，还需要为用户配置ODBC，显得既麻烦又不符合专业软件的要求；就是得编写复杂的更改操作系统注册表文件的程序，十分烦琐。本文从ADO（ActiveX Data Objects）入手，介绍无需配置数据源的几种常用大型数据库连接方法。

本文所述的无“数据源”连接，意义不是不需要数据源，否则连接无从谈起，而是不需要配置注册数据源所进行的连接。ODBC（Open DataBase Connectivity，开放式数据库连接）是用于连接不同数据源的标准编程语言接口。许多文章中介绍，在实现ODBC 时，必须首先配置ODBC环境，进行数据源的注册，然后才能在对数据库编程时，对数据源进行连接、访问和操作，并提供了用PB或VB等语言工具实现数据源注册的具体方法。这些方法不但复杂烦琐，而且由于参数内容不一，配置时令人感觉无所适从，不宜把握。

走近ADO

ADO是微软提供的数据库访问技术。它被设计用来同新的数据访问层OLE DB Provider一起协同工作，以提供通用数据访问（Universal Data Access）能力。OLE DB是一个底层的数据访问接口，用它可以访问各种数据源，包括传统的关系型数据库、电子邮件系统及自定义的商业对象等。

ADO提供了一个熟悉的、高层的对OLE DB的Automation封装接口。对那些熟悉RDO的程序员来说，可以把OLE DB 看作ODBC驱动程序，如同RDO对象是ODBC驱动程序接口一样，ADO对象是OLE DB的接口。同样，像不同的数据库系统需要它们自己的 ODBC驱动程序一样，不同的数据源也要求它们自己的OLE DB提供者（OLE DB provider）。目前，虽然 OLE DB提供者比较少，但微软正积极推广该技术，并计划用OLE DB取代ODBC。

微软公司已宣布今后不会对VB SQL/DBLib进行升级，而且ODBC API函数一级的编程方式也不为人们所喜爱，所以， RDO今后将被以ActiveX技术为基础的ADO所替代。ADO是基于OLE DB之上的技术，它通过内部的属性和方法提供统一的数据库访问接口。

1．ADO组件

● Microsoft ActiveX Data Objects (ADO) ：使客户端应用程序能通过OLE DB提供者访问和操作数据库服务器中的数据。

● ActiveX Data Objects Extensions for DDL and Security(ADOX) ：将ADO扩展为包括创建、修改和删除的模式对象，如表格和过程，以及包括用于维护用户和组以及管理对象权限的安全对象。

● ActiveX Data Objects (Multidimensional) (ADO MD): 将ADO扩展为包括指定到多维数据的对象，并允许浏览多维模式、查询立方和检索结果。

2．ADO优点

● ADO具有高度的灵活性，它可以使用相同的编程模式连接到不同的数据提供者，而不管给定提供者的特定特性。

● 较低的内存占用率。

● 具有远程数据服务(RDS)功能，通过RDS可以在一次往返过程中将数据从服务器移动到客户端应用程序或Web页，并在客户端对数据进行处理后将更新结果返回服务器。

● 同传统的数据对象层次（DAO和RDO）不同，ADO可以独立创建。可以只创建一个“Connection”对象，然后由多个独立的“Recordset”对象来使用它。

● ODBC本身是以SQL Server、Oracle等关系数据库作为访问对象，而OLE DB则不仅限于此，它还可以对电子邮件、文本文件、复合文件、数据表等各种各样的数据通过统一的接口进行存取。

OLE DB Provider for ODBC是ADO的默认提供者，默认值是MSDASQL，如果省略连接字符串的Provider=参数，ADO将试图建立与该提供者的连接。

ADO的连接方式主要可分为OLE DB Privder方式与OLE DB Provider for ODBC方式。前者很明显是微软公司极力推荐的方式，对于ADO或RDS程序员来说，理想的环境是每个数据源都具有一个 OLE DB接口，这比ODBC方式要快且所需资源更少。

ODBC Provider允许ADO连接到任何ODBC数据源。ODBC驱动程序对于当今使用的各种主要DBMS都有效，包括 SQL Server、Access、FoxPro，以及诸如Oracle等非微软数据库产品。提供者将不受线程控制，允许使用 Unicode，并将支持事务。

连接对象属性

ConnectionString是Connection对象的属性名称，为可读写String类型，提供数据提供者或服务提供者打开到数据源的连接所需要的特定信息，包括Provider、Driver、Server、Database、DSN、UID、PWD或者Provider、 Data Source、User、Password、Initial Catalog等。

1．Provider

字符串表达式，指定OLE DB数据或服务提供者的名称，可以缺省。

一般有三种提供者：数据提供者、服务提供者和服务组件。数据提供者拥有自己的数据并将数据以表的格式显示给应用程序。服务提供者将服务封装，使ADO应用程序中的功能得以扩大。服务提供者也可以进一步定义为服务组件，服务组件必须连同其他服务提供者或组件一起工作。

２．Driver

字符串表达式，表示ODBC驱动程序的名称，并不是ODBC驱动程序动态链接库（DLL）的文件名。

有些驱动程序是微软公司的产品，在安装操作系统时就已经安装好了; 而有些数据库产品的驱动程序由开发数据库产品的软件公司随数据库产品一起提供，需要在安装数据库时选择安装后，才可以使用。如：Sybase数据库驱动程序等。

3．Server(SRVR)

字符串表达式，数据库服务名称。

4．Database(DB)

字符串表达式，指定服务器上的数据库名称。即使DSN定义已经指定了数据库，也可以在DSN之外指定Database参数以便连接到不同的数据库。

5．DSN(Data Source)

字符串表达式，在此为空，无须指定连接的ODBC数据源的名称。

6．UID(User ID)

字符串表达式，为ODBC数据源指定用户标识(用户账号名)，指定用户必须有足够的权限。

7．PWD(Password)

字符串表达式，为ODBC数据源指定用户口令，必须有足够的权限。

8．Persist Security Info

布尔类型，为True时，表明采用集成安全机制；若为False，则表明不采用集成安全机制。

无DSN（非DSN）连接

除了ADO所定义的参数外，提供者不支持任何特定连接参数，它将把任何非ADO连接参数传递给ODBC驱动程序管理器。下面介绍几种常见数据库的处理方法。

1. Visual Foxpro

[PROVIDER=MSDASQL.1]; ’或者为MSDASQL

DRIVER={Driver Name};

SourceDB=Path;

SourceType=DBF

例如：

cnna.ConnectionString = “PROVIDER=MSDASQL; ”

+ “DRIVER={Microsoft Visual Foxpro Driver};”

+ “SourceDB=D:\data\;”

+ “SourceType=DBF”

2．SQL Server

[PROVIDER=MSDASQL;]

DRIVER={Driver Name};

SERVER=server;

DATABASE=database;

UID=user;

PWD=password

例如：

cnnb.ConnectionString = “PROVIDER=

MSDASQL;”

+ “DRIVER={SQL Server};”

+ “SERVER=servera;”

+ “DATABASE=pubs;”

+ “UID=sa;”

+ “PWD=yyuui”

3. Sybase数据库

[PROVIDER=MSDASQL;]

DRIVER={Driver Name};

SRVR=server; ’必须是SRVR，不能是SERVER

DB=database; ’可以是DB，也可以是DATABASE

DSN=; ’可以省略

UID=user;

PWD=passwod;

PERSIST SECURITY INFO=False

例如：

cnnc.ConnectionString=

“PROVIDER=MSDASQL;”

+ “DRIVER={Sybase System 11};”

+ “SRVR=serveru; ”

+ “DSN=;”

+ “DB=dataa;”

+ “UID=sa;”

+ “PWD=dqwe;”

+ “PERSIST SECURITY INFO=False”

4. Oracle数据库

[PROVIDER=MSDASQL;]

DRIVER={Driver Name};

SERVER=server;

databasename=database;

databasefile=path;

DSN=;

UID=user;

PWD=password;

例如：

cnnd.ConnectionString =

“PROVIDER=MSDASQL; ”

+ “DRIVER={Microsoft ODBC for Oracle};”

+ “SERVER=Webserver;”

+ “DSN=;”

+ “databasename=dataall;”

+ “databasefile=d:\data\;”

+ “UID=dba;”

+ “PWD=killer”

应用实例

下面以Sybase 11.9.2为例，编制一个简单的工作人员管理程序，介绍ADO的具体实现方法和步骤。数据库名称为Workerdb，只包括一个表（Worker），其结构如下：

字段名称　　　　宽度　　　　　　　注释

code nchar(4) 代号

name char(8) 姓名

…… …… ……

首先安装ADO，在VB的“工程”/“引用”对话框中选择“ActiveX Data Object 2. 5 Library”(ADODB)。其中“ADO Recordset 2. 5 Library”是一个客户端的版本(ADOR)，因为不需要Connection对象来建立与远程数据源的联系，所以ADOR对于客户端的数据访问来说已经足够了。下面是部分主要代码：

1. 处理代码

’在工程菜单中引用Microsoft ActiveX Data Object 2. 5 Library

’声明ADO连接对象为工程级全局变量

Public cndbase As New ADODB.Connection

……

’自定义连接数据库函数

Public Function ConnectDbase(StrConnect As String) As Boolean

On Error GoTo ErrHandle

cndbase.ConnectionString = StrConnect

cndbase.Open

cndbase.CursorLocation = adUseClient

ConnectDbase = True

Exit Function

ErrHandle:

ConnectDbase = False

End Function

Private Sub Form_Load()

……

输入 VarServer ’服务名称

VarDbase ’数据库名称

VarUser ’用户名称

VarPassword ’用户口令

……

’连接数据库,采取无DSN连接方法

StrConnect = “Provider=MSDASQL;”

+“Driver={” & VarDriver &“};”

+“SRVR=” & VarServer & “;”

+“DB=” & VarDbase & “;”

+“DSN=;”

+“UID=” & VarUser & “;”

+“PWD=” & VarPassword & “;”

+ “Persist Security Info=False” ’不采用集成安全机制

if ConnectDbase(StrConnect) Then

Exit Sub

else

myexit = MsgBox(“数据库连接失败！请检查连接设置信息。”, vbOKOnly, “错误提示:”)

Unload me

endif

ErrHand:

myexit = MsgBox(“错误程序:” & Err. Source & Chr(10) & “错误代码:” & Err. Number & Chr(10) & “错误信息:” & Err.Description, VbAbortRetryIgnore, “错误提示:”)

If myexit = 3 Then

Err.Clear

Unload Me

Else

If myexit = 4 Then

Err.Clear

Resume

Else

Err.Clear

Resume Next

End If

End If

End Sub

Private Sub Form_Unload()

……

cndbase.Close

Set cndbase = Nothing

End Sub

2. 建表

codbase.CommandText=“{call CREATABLE (?) }”

codbase.CommandType = adCmdText

codbase.Name = “CREATABLE”

’设定OutPut的参数

Set param = codbase.CreateParameter(“flag”, adInteger, adParamOutput)

codbase. Parameters. Append param

Set codbase. ActiveConnection = cndbase

codbase. Execute

If codbase. Parameters(0) = 0 Then

myexit = MsgBox(“建表成功!”, vbOKOnly, “程序提示:”)

Else

myexit = MsgBox(“建表失败!”, vbOKOnly, “错误提示:”)

Endif

……

3. 修改

rsdbase. Open“worker”，cndbase，adOpenDynamic，adLockPessimistic，adCmdTable

rsdbase. MoveFirst

cndbase. BeginTrans

’在记录集中进行循环更改

Do Until rsdbase.EOF

’增加20元职务代码为1的人员的工资

If rsdbase! duty = 1 Then

rsdbase! salary = rsdbase! salary + 20

End If

rsdbase. MoveNext

Loop

rsdbase.UpdateBatch

……

4. 统计

StrSQL = “Select avg(salary)， sum(salary) from worker”

rsdbase. CursorLocation = adUseClient

rsdbase. Open StrSQL，cndbase

salaryavg = rsdbase(0) ’平均工资

salarysum = rsdbase(1) ’工资总和

……

rsdbase .Close

5. 存储过程creatable. sql

CREATE PROCEDURE dbo.creatable(@return_value integer output)

AS

Begin

Create table Workerdb..Worker

( code nchar(4) not null ,

name char(8) not null ,

year nchar(4) ,

month nchar(2) ,

day nchar(2) ,

salary numeric(18,2) ,

duty nchar(1) )

If @@error != 0

begin

select @return_value = 1

　　End

　Else

Begin

select @return_value = 0

End

return

End

cyberfan 2005-08-12 12:48 发表评论

在VB中使用文字朗读引擎（TTS）技术

cyberfan — Fri, 12 Aug 2005 04:48:00 GMT

现今市面上流行的一些英语学习软件，在广告词上经常说自己使用了国际顶尖的全程语音TTS技术，能进行整段英文的流利朗读，并能自由调节朗读的速度与频率等。那么，这个神奇的TTS究竟是什么东西呢？

　　其实，TTS是微软出品的一套文字朗读引擎（Text-To-Speech Engine)，这些英语软件就是调用它来进行英文朗读的。我们在英语学习软件的编程开发中也可使用TTS技术，下面笔者将利用Visual Basic 5.0来揭开TTS神秘的面纱。

　　一、安装TTS引擎
　　TTS引擎所需的Microsoft Text-to-Speech Engine与Microsoft Speech API软件都可到微软的站点去下载，也可以在“金山词霸2000”或“金山词霸.net”的安装光盘上找到（文件名为MSTTS.EXE与 SPCHAPI.EXE)。安装了TTS引擎后，在Windows所在目录下会生成一个SPEECH目录，其中有一个Vtxtauto.tlb文件，在编程时我们需要调用它。

　　二、在VB中引入Vtxtauto.tlb文件
　　进入VB 5.0，执行选单命令“文件/新建工程/标准EXE”并确定，然后执行选单“工程”中的“引用”，单击“浏览”按钮到Windows目录下的SPEECH 子目录，打开Vtxtauto.tlb文件，将“VoiceText 1.0 Type Library”添加到引用列表中，选中它并单击确定。将库Vtxtauto引入VB后，我们可以通过选单“视图”中的“对象浏览器”来了解它所封装的类，以及各类成员函数的属性的意义、使用格式等信息。一些主要的方法与属性意义,笔者在下面的源程序中将给出注释，在这里就不详细列出，请参见附图1。

　　三、设置控件及属性
　　在FORM1上添加三个Label控件、一个TextBox控件、一个HScrollBar控件和六个CommandButton控件。窗体及各控件的主要属性设置如下：

　　FORM1：Caption=“英文朗读”

　　LABEL1：Caption=“请输入英文文档”

　　LABEL2：Caption=“朗读速度”

　　LABEL3：Caption=“ ”

　　（LABEL3标签用来显示朗读速度值）

　　TEXT1：Text=“Please input english text”；ToolTiptext=“请输入或粘贴英文文档”； MultiLine=True；ScrollBars=3-Both

　　HSCROLL1:名称=SpeedChange；Min=90；Max=300（Min与Max属性值分别用来限定可调节的语速的最小与最大值）

　　COMMAND1：名称=read；Caption=“朗读”

　　COMMAND2：名称=pause；Caption=“暂停”

　　COMMAND3：名称=stop；Caption=“停止”

　　COMMAND4：名称=prev；Caption=“上一句”

　　COMMAND5：名称=next；Caption=“下一句”

　　COMMAND6：名称=quit；Caption=“退出”

　　四、编写代码
　　下面我们就可以一步步地编写代码，具体代码如下：

　　'在窗体装载时调用Register方法注册，括号内的两个参数是字符串

　　Private Sub Form_Load()

　　Call VTxtAuto.VTxtAuto.Register(Space(8), Space(8))

　　'因为语速的默认值为170，故水平滚动条的初值也设为170

　　SpeedChange.Value = 170

　　End Sub

　　'设置朗读速度调节代码,当水平滚动条的值Value发生变化时将其赋给控制语速的Speed属性

　　Private Sub SpeedChange_Change()

　　VTxtAuto.VTxtAuto.Speed=SpeedChange.Value

　　Label3.Caption = SpeedChange.Value

　　End Sub

　　'设置“朗读”按钮代码

　　Private Sub read_Click()

　　'如果朗读出错，则转到出错处理标记模块ErrorHandler

　　On Error GoTo ErrorHandler

　　'调用方法Speak进行朗读，第一个参数是要朗读的文本，第二个参数是设置朗读风格

　　Call VTxtAuto.VTxtAuto.speak(Trim(Text1.Text), vtxtsp_VERYHIGH + vtxtst_READING)

　　Exit Sub

　　ErrorHandler:

　　MsgBox "只能朗读英文文档，不能朗读汉字字符！", , "出错信息"

　　End Sub

　　'设置“暂停”按钮代码

　　Private Sub pause_Click()

　　If VTxtAuto.VTxtAuto.IsSpeaking Then

　　'如果属性IsSpeaking为真，则表示正在朗读，调用AudioPause方法暂停朗读

　　Call VTxtAuto.VTxtAuto.AudioPause

　　pause.Caption = "恢复"

　　Else

　　'如果已经处于暂停状态则调用AudioResume方法恢复朗读

　　Call VTxtAuto.VTxtAuto.AudioResume

　　pause.Caption = "暂停"

　　End If

　　End Sub

　　'设置“停止”按钮代码，调用StopSpeaking方法停止当前朗读

　　Private Sub stop_Click()

　　Call VTxtAuto.VTxtAuto.StopSpeaking

　　End Sub

　　'设置“上一句”按钮代码，调用AudioRewind方法往后跳过一句

　　Private Sub prev_Click()

　　 Call VTxtAuto.VTxtAuto.AudioRewind

　　End Sub

　　'设置“下一句”按钮代码，调用AudioFastForward方法向前跳过一句

　　Private Sub next_Click()

　　 Call VTxtAuto.VTxtAuto.AudioFastForward

　　End Sub

　　'设置“退出”按钮代码

　　Private Sub quit_Click()

　　 Unload Me

　　End Sub

　　本程序在中文Windows 95/98、VB 5.0环境下运行通过。运行时在文本编辑框中输入或粘贴英文文档，然后单击“朗读”按钮就可播放读音，运行界面如图2。

　　五、程序改进思路
　　本文对在VB编程中使用TTS技术只是起个抛砖引玉的作用，熟悉VB编程的电脑爱好者来可以对本程序作一些改进，例如增加对声卡和TTS引擎是否安装的检测、增加从文本文件或数据库中读取文档的功能、增加让用户选择朗读的优先级和发声音量调节等功能。这些功能实现起来较为复杂，感兴趣的读者可进行深入研究。

cyberfan 2005-08-12 12:48 发表评论