|
|
|
|
| VB问题全功略（38） |
|
［上一页］（38）［下一页］ |
186、谁终结了我的程序？
187、完全模拟【开始】中的【关机】功能
188、如何将桌面上所有的视窗最小化？
189、如何动态新增、移除
ODBC DSN？
190、如何从全路径文件名中分别抓出路径及文件名？
186、谁终结了我的程序？
您开发的应用程序或许写得非常完整，您也很满意，但有时候却莫名其妙地出现了一点问题，在不该结束程序的时候，它被强迫结束了！可能使用者是按下了
Ctrl + Alt + Del，使用 Microsoft Windows
工作管理员关闭应用程序，或者强迫关机了！然而您的程序却没有考虑到这一点。
在正常情况下要结束一个表单，会经过三个事件 (当您使用
End 结束程序时是例外！)，顺序如下：
1、Private Sub Form_QueryUnload(Cancel As Integer,
UnloadMode As Integer)
2、Private Sub Form_Unload(Cancel As
Integer)
3、Private Sub Form_Unload(Cancel As
Integer)
在这三个事件中都允许您设定 Cancel=True
来避免表单被结束，但是它们是不分青红皂白的，唯一能让您分辨表单为什么被结束的，就是在 Form_QueryUnload 中的 UnloadMode
参数！
unloadmode 参数返回下列的值：
常数 值 描述
vbFormControlMenu
0 使用者从表单上的控制功能表中选取「关闭」指令。
vbFormCode 1 Unload
陈述式被程序代码呼叫。
vbAppWindows 2 目前 Microsoft Windows
作业环境任务结束。
vbAppTaskManager 3 Microsoft Windows
工作管理员正在关闭应用程序。
vbFormMDIForm 4 因为 MDI 表单正在关闭的缘故，MDI
子表单正在关闭。
vbFormOwner 5 表单因其拥有人关闭而关闭。
所以下次您就可以在
Form_QueryUnload 中利用 UnloadMode 参数来判断程序是否 要做什么特别处理！
187、完全模拟【开始】中的【关机】功能
在【问题：如何从您的应程序中结束 Windows
重开机？】我们曾经提到过，如何由程序中强迫关机、重开机，但是在这个主题中，我们要告诉您的，是如何模拟按下了【开始】中的【关机】选项，屏幕变成灰灰一片，并且在屏幕中央出现【关闭
Windows】问话框！
在声明区中加入以下声明：
Declare Function SHShutDownDialog
Lib "shell32" Alias "#60" (ByVal lType As Long) As Long
Public Const
EWX_LOGOFF = 0
Public Const EWX_SHUTDOWN = 1
Public Const EWX_REBOOT
= 2
Public Const EWX_FORCE = 4
Public Const EWX_POWEROFF =
8
要 Show 出【关闭 Windows】问话框时用法如下：
SHShutDownDialog
EWX_SHUTDOWN
188、如何将桌面上所有的视窗最小化？
有很多好用的桌面工具软件都有提供这个功能，将桌面上所有的视窗最小化，也会提供将它们复原的功能，当然，要提供这种功能的软件，执行后都是将程序缩到桌面右下角的工具列中，使用
Menu
来操控，否则，将桌面上所有的视窗最小化，也包括它自己的程序本身的视窗的！
'请在视窗声明区中加入以下声明及模组：
Private
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal
lpClassName As String, ByVal lpWindowName As String) As Long
Private
Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd
As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
As Long
Private Const WM_COMMAND As Long = &H111
Private
Const MIN_ALL As Long = 419
Private Const MIN_ALL_UNDO As Long =
416
Public Sub MinimizeAll()
Dim lngHwnd As Long
lngHwnd =
FindWindow("Shell_TrayWnd", vbNullString)
Call PostMessage(lngHwnd,
WM_COMMAND, MIN_ALL, 0&)
End Sub
Public Sub
RestoreAll()
Dim lngHwnd As Long
lngHwnd =
FindWindow("Shell_TrayWnd", vbNullString)
Call PostMessage(lngHwnd,
WM_COMMAND, MIN_ALL_UNDO, 0&)
End
Sub
'而实际使用之范例如下：
Private Sub Command1_Click()
MinimizeAll
'将桌面上所有的视窗最小化
End Sub
Private Sub Command2_Click()
RestoreAll
'将最小化的视窗还原
End Sub
189、如何动态新增、移除 ODBC
DSN？
一般我们建立 Client 端 DSN
都是在使用者的机器上进入【控制台】【ODBC 资料来源管理员】去建立，但是如果我们开发的 APP
使用者很多时，这就有点累人了，所以我们可以将这个动作放在程序中！
新增 DSN 的方法有二种：
1、使用 DBEngine
物件的 RegisterDatabase 方法
2、呼叫 SQLConfigDataSource
API
不管使用以上任何一种方法新增 DSN，一共会写入二个地方，一个是注册表，一个是 ODBC.INI。
而删除
DSN 的方法同上面的第二种方法，呼叫 SQLConfigDataSource API。
以下之模组以 Oracle73 Ver
2.5 为例，在 Form 的声明区中加入以下声明及模组：
Private Const ODBC_ADD_DSN = 1 ' Add
data source
Private Const ODBC_CONFIG_DSN = 2 ' Configure (edit) data
source
Private Const ODBC_REMOVE_DSN = 3 ' Remove data
source
Private Const vbAPINull As Long = 0& ' NULL
Pointer
Private Declare Function SQLConfigDataSource Lib
"ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Long, ByVal
lpszDriver As String, ByVal lpszAttributes As String) As
Long
Public Sub CreateDSN(sDSN As String)
Dim nRet As
Long
Dim sDriver As String
Dim sAttributes As String
sDriver =
"Oracle73 Ver 2.5"
sAttributes = "Server=Oracle8" &
Chr$(0)
sAttributes = sAttributes & "DESCRIPTION=" & sDSN &
Chr$(0)
'sAttributes = sAttributes & "DSN=" & sDSN &
Chr$(0)
sAttributes = sAttributes & "DATABASE=DBFinance" &
Chr$(0)
sAttributes = sAttributes & "Userid=Scott" &
Chr$(0)
'sAttributes = sAttributes & "PWD=myPassword" &
Chr$(0)
DBEngine.RegisterDatabase sDSN, sDriver, True, sAttributes
'注一
'nRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_DSN, sDriver,
sAttributes) '注二
End Sub
Public Sub DeleteDSN(sDSN As
String)
Dim nRet As Long
Dim sDriver As String
Dim sAttributes As
String
sDriver = "Oracle73 Ver 2.5"
sAttributes = sAttributes &
"DSN=" & sDSN & Chr$(0)
nRet = SQLConfigDataSource(vbAPINull,
ODBC_REMOVE_DSN, sDriver, sAttributes)
End Sub
'假设要产生的 DSN 为
Test，实际使用范例如下：
Private Sub Command1_Click()
CreateDSN
"Test"
End Sub
Private Sub Command2_Click()
DeleteDSN
"Test"
End Sub
'而写到系统的资料如下：
1、ODBC.INI
[ODBC 32
bit Data Sources]
Test=Oracle73 Ver 2.5 (32
bit)
[Test]
Driver32=C:\ORAWIN95\ODBC250\sqo32_73.dll
2、注册表
机码：HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\ODBC
Data Sources
名称：Test 资料：Oracle73 Ver
2.5
机码：HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Test
名称：Description
资料：Test
名称：Driver 资料：C:\ORAWIN95\ODBC250\sqo32_73.dll
名称：Server
资料：Oracle8
名称：UserId 资料：Scott
※注一及注二可任选一种，只要将不使用的方法 Mark
起来即可！
※若您想使用其他之资料库，只要将以上模组稍作修改即可！
190、如何从全路径文件名中分别抓出路径及文件名？
这是一个很简单很常碰到的问题，只要有用到文件的程序常常都会需要处理这样的问题！既然很简单为什么还要提出这样的问题呢？没错，是很简单，但是我的着眼点是：它太常出现了，值得做成模组！
要解决这个问题，第一个要了解的就是全路径文件名称的构成要素：磁盘代号、目录名称、文件名称，而这三个组成要素之间，都是使用反斜线符号
(即 "\")
分开！
所以，要从全路径文件名中分别抓出路径及文件名，第一件事就是要找到从右边倒数的第一个反斜线符号！
不多说，直接来看看模组及实例：
'模组：抓出路径
Function
ExtractDirName(PathName As String) As String
Dim X As Integer
For X
= Len(PathName) To 1 Step -1
If Mid$(PathName, X, 1) = "\" Then Exit
For
Next
ExtractDirName = Left$(PathName, X - 1)
End
Function
'模组：抓出文件名
Function ExtractFileName(PathName As String)
As String
Dim X As Integer
For X = Len(PathName) To 1 Step -1
If
Mid$(PathName, X, 1) = "\" Then Exit For
Next
ExtractFileName =
Right$(PathName, Len(PathName) - X)
End
Function
'使用实例：
Private Sub Command1_Click()
Dim PathName As
String
PathName = "C:\倪匡小说原稿\未整理小说\黄金故事.txt"
Text1.Text =
ExtractFileName(PathName) ' 黄金故事.txt
Text2.Text =
ExtractDirName(PathName) ' C:\倪匡小说原稿\未整理小说
End
Sub |
|