VB与API

VB 与 Windows API 讲座(四)

VB 无解问题与 API 的解决方案

---

　王国荣

上一期介绍 Windows 的讯息系统， 对有些读者来说可能比较艰涩(或者说比较无趣)，这是笔者想极力避免却又无法避免的事情， 毕竟讯息的观念在 Windows API 的程式设计中是不可或缺的，以本期所提出的 15 则问题， 就有 2 则的解决方案与讯息有关系。除了讯息的应用之外，由於本期预定刊载於 Run!PC 2 月号， 属於新春期间， 笔者想来点轻松而又实用的东西，所以特别挑选读者问过而 VB 无法解决的问题， 以 Windows API 来加以解决，除了第 4 则与第 15 则之外， 这些解决方案大抵上没有太艰涩的技术， 您只要跟着笔者所介绍的方法，就可以将它们应用於您的 VB 程式中。

问题1：我只是想将档案丢到「资源回收筒」， 而不是从硬碟中删除。

问题2：如何复制整个目录(包含子目录及其所有档案)？

问题3：如何快速改变档案的所在目录？

问题4：如何让 TextBox 在按下滑鼠右钮时不显示快显功能表？

问题5：如何读取 Windows 的所在目录？

问题6：如何将程式建立成「启动」资料夹的捷径？

问题7：如何启动 Windows 预设的执行档开启某一文件？

问题8：如何在启动某一个程式之後， 等待此一程式结束执行後才继续执行。

问题9：在多行的 TextBox 中， 如何计算行数？

问题10：如何判断某一个 Drive 是否为光碟机？

问题11：如何读取档案的建立时间及存取时间？

问题12：如何以程式控制多行 TextBox 的卷动？

问题13：如何像一般的绘图软体一样填满某一区域的颜色？

问题14：如何读取磁碟的空间及可用空间？

问题15：将表单缩小时， 希望它的图示显示在工作列的右下角。

阅读本文以前：

---

在 Windows API 的呼叫过程中， 我们必须事先宣告所呼叫的 API 函数及其相关常数、自订型别，但这些宣告式通常是又臭又长， 有碍阅读， 所以笔者把它们集中放在最後的附录，当然， 为了方便您引用， 这些宣告式亦收录於笔者的网站， 请自行下载。此外，本文讨论的所有问题也都附有范例程式， 一样包含在下载的档案中。

　

问题1：我只是想将档案丢到「资源回收筒」，而不是从硬碟中删除。

---

　

这个绝对不能呼叫 VB 所提供的 Kill 叙述， Kill 叙述只会将档案从磁碟中删除，若要将档案丢到资源回收筒， 必须呼叫 SHFileOperation API 函数， 假设我们想将 c:/test.txt 丢到资源回收筒， 则呼叫的叙述如下：

　

Dim SHFileOp As SHFILEOPSTRUCT

　

SHFileOp.wFunc = FO_DELETE

SHFileOp.pFrom = "c:/test.txt" + Chr(0)

SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION

Call SHFileOperation(SHFileOp)

　

在以上叙述中有几件值得注意的事情：

　

1. FOF_ALLOWUNDO 表示被删除的档案将来可以还原， 此一设定值是绝对必要的。
2. FOF_NOCONFIRMATION 表示不显示交谈窗询问使用者「是否将档案丢到资源回收筒」，若要询问使用者， 则应取消此一设定值。
3. 请注意 "c:/test.txt" 之後必须加上 Chr(0)。

　

利用以上方法也可以一次删除多个档案， 此时只要将多个档案名称串在一起，并且以 Chr(0) 分隔即可， 假设我们想删除 c:/test1.txt、c:/test2.txt、及 c:/test3.txt 等叁个档案， 则程式如下：

　

Dim SHFileOp As SHFILEOPSTRUCT
Dim Files As String

Files = "c:/test1.txt" + Chr(0) + "c:/test2.txt" + Chr(0) + "c:/test3.txt" + Chr(0)

SHFileOp.wFunc = FO_DELETE

SHFileOp.pFrom = Files

SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION

Call SHFileOperation(SHFileOp)

　

问题2：如何复制整个目录(包含子目录及其所有档案)？

---

　

如果使用 VB 所提供的功能， 必须使用的叙述及函数大致上有 Dir、Mkdir、及 FileCopy 等几个， 而所需撰写的程式也不算简单， 在此就不做介绍， 若呼叫 SHFileOperation API， 则只需短短的几行， 假设我们想将 c:/temp 目录的所有档案(包含其子目录)复制到 c:/temp2 目录底下， 则程式如下：

　

Dim SHFileOp As SHFILEOPSTRUCT

　

SHFileOp.wFunc = FO_COPY

SHFileOp.pFrom = "c:/temp/*.*"

SHFileOp.pTo = "c:/temp2/*.*"

SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR

Call SHFileOperation(SHFileOp)

　

在以上叙述中请注意一件事情：FOF_NOCONFIRMMKDIR 表示不显示交谈窗询问使用者「是否建立目录」，如果取消此一设定值， 而当 SHFileOp.pTo 所指定的目录不存在时， 则 Windows 会询问使用者是否建立目录。(SHFileOp.pTo = "c:/temp2/*.*" 写成 SHFileOp.pTo = "c:/temp2 亦可)

　

问题3：如何快速改变档案的所在目录？

---

　

当我们想改变某一个档案的所在目录， 若使用 VB 所提供的功能， 必须先执行 FileCopy 将档案复制到另一个目录， 然後才将原档案删除， 例如：

　

FileCopy Path1 & FileName, Path2 & FileName

Kill Path1 & FileName

　

此一方法对於比较大的档案(假设是 100MB)， 十分浪费时间， 若使用 SHFileOperation API 函数， 则可以不必复制档案， 而直接将档案移至另一个目录， 方法如下：(假设将 c:/test4.txt 移至 c:/temp 目录)

　

Dim SHFileOp As SHFILEOPSTRUCT

　

SHFileOp.wFunc = FO_MOVE

SHFileOp.pFrom = "c:/test4.txt" + Chr(0)

SHFileOp.pTo = "c:/temp"

SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION

Call SHFileOperation(SHFileOp)

　

在以上叙述中有几件值得注意的事情：

　

1. SHFileOp.pTo 所指定的参数必须是一个已存在的目录。
2. 档案可以移到另一个磁碟机， 但它的作用相当於复制档案， 再把原档案删除，唯有在同一磁碟中移动才具有快速移动的效果。
3. 如果想一次移动多个档案， 请参阅本文「问题 1」的说明。

　

问题4：如何让 TextBox 在按下滑鼠右钮时不显示快显功能表？

---

　

当我们在 TextBox 上面按下滑鼠右钮时， TextBox 总是会显示含有「复原、剪下、复制、贴上…」的快显功能表，如何叫 TextBox 不要这麽做呢？

　

这个问题有点难， 必须利用我们上一期介绍的「视窗程序的插队游戏」。为了不让 TextBox 显示预设的快显功能表， 我们必须利用插队的视窗程序将 WM_RBUTTONDOWN(表示 Right Button Down)讯息吃掉， 在制作的细节上， 则包含以下几点：

　

1. 设定插队的视窗程序：假设 TextBox 的名称为 Text1， 而我们所撰写的视窗程序名称为 WndProc， 则如下：

　

Dim ret As Long

prevWndProc = GetWindowLong(Text1.hWnd, GWL_WNDPROC)

ret = SetWindowLong(Text1.hWnd, GWL_WNDPROC, AddressOf WndProc)

　

2. 视窗程序的撰写：

　

Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

If Msg = WM_RBUTTONDOWN Then

' 吃掉这个讯息

Else

WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)

End If

End Function

　

当以上视窗程序收到 WM_RBUTTONDOWN 讯息时， 不再呼叫 CallWindowProc，所以 TextBox 便不会收到「按下滑鼠右钮」的讯息， 也就不会显示预设的快显功能表。

　

3. 取消插队行为：

　

' prevWndProc 是插队时所储存下来的前一个视窗程序的位址

ret = SetWindowLong(Text1.hWnd, GWL_WNDPROC, prevWndProc)

　

使用以上解决方案请特别注意， 由於我们的程式把 WM_RBUTTONDOWN 讯息吃掉了，因此当使用者按下滑鼠「右钮」时， TextBox 也不会发生 MouseDown 事件， 这将使得 Text1_MouseDown 事件程序中的程式只有在使用者按下滑鼠「左钮」时才会被执行，此时的解决方案是在 WndProc 视窗程序收到 WM_RBUTTONDOWN 讯息时呼叫 Text1_MouseDown 事件程序， 如下：

　

Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

If Msg = WM_RBUTTONDOWN Then

Call Text1_MouseDown( 参数… )

Else

WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)

End If

End Function

　

问题5：如何读取 Windows 的所在目录？

---

虽然 Windows 安装的预设目录是 "c:/Windows"，但由於使用者可以自由设定 Windows 安装的目录， 所以不能假设 "c:/Windows" 是 Windows 的所在目录， 要读取 Windows 的所在目录， 需利用 GetWindowsDirectory API 函数， 以下是呼叫的例子：

　

Dim S As String * 80, Length As Long

Dim WinPath As String

　

Length = GetWindowsDirectory(S, Len(S))

WinPath = Left(S, Length)

　

则执行之後 WinPath 将等於 Windows 的所在目录。

　

问题6：如何将程式建立成「启动」资料夹的捷径？

---

　

想要建立捷径， 使用 Windows API 比较麻烦， 因此笔者想藉助一个附属於 VB 的 DLL 档案 — vb5stkit.dll(如果是 VB 4.0 32-bit 版， 则为 stkit432.dll)，在安装有 VB 的机器里面， 此一档案会出现在 Windows 的 System 目录底下，此外， 在 VB 的 setupkit/kitfil32 目录底下也有这一个档案。在 vb5stkit.dll 里面有一个叫做 fCreateShellLink 的函数， 可用来建立「捷径」(ShortCut)，此一函数含有 4 个参数， 意义如下：

　

1. folder：资料夹， 此一参数虽然称为资料夹，但与磁碟的资料夹(目录)略有出入， 它的根目录("/")表示「开始」工具列底下的「程式集」资料夹，而 ".." 表示「开始」工具列， "../.." 表示 Windows 的所在目录。

2. ShortCutName：捷径名称。

3. ExePath：程式或档案的完整路径。

4. Params：参数叁 ExePath 的程式参数。

　

假设我们想把 "c:/Windows/Notepad.exe" 执行档设定成「启动」资料夹名称为 "记事本" 的捷径， 则呼叫的方式如下：

　

ret = fCreateShellLink("/启动", "记事本", "c:/Windows/Notepad.exe", "")

　

在以上程式中参数一 folder 最值得注意， 由於「启动」资料夹是「程式集」的子资料夹，所以将此一参数写成 "/启动"， 再举个例子， 假设我们想把同样的捷径建立在「桌面」上，则此一参数应设定为 "../../Desktop"(NT 中文版则为 "../../桌面")，因为 "../.." 代表 Windows 的所在目录， 而所谓「桌面」其实就是 Windows 底下的 Desktop(桌面)子资料夹， 所以将此一参数写成 "../../Desktop"("../../桌面")。

　

除了 4 个参数之外， fCreateShellLink 的传回值表示「是否成功地建立了捷径」，如果等於 1， 表示成功， 等於 0， 表示失败。

　

在 VB5 里面使用 fCreateShellLink， 必须撰写的 API 宣告式如下：

　

Declare Function fCreateShellLink Lib "vb5stkit.DLL" (ByVal folder As String, ByVal ShortCutName As String, ByVal ExePath As String, ByVal Params As String) As Long

　

但如果您使用的是 VB4 32-bit 版， 则必须将以上的 vb5stkit.dll 改成 stkit432.dll。最後请注意， vb5stkit.dll(stkit432.dll) 不是 Windows 所提供 API 函数， 呼叫之前， 必须将此一档案复制到 Windows、Windows 的 System 目录、或应用程式所在目录， 但如果您使用 VB 的「安装精灵」安装应用程式，则「安装精灵」会自动复制此一档案到 Windows 的 System 目录。

　

为了让您进一步体验 fCreateShellLink 函数的使用， 笔者特别准备了如图-1的表单(放置於范例程式的 Form3)：

　

图-1 笔者所撰写的 fCreateShellLink 试验程式

　

您可以利用此一表单设定不同的参数(参数与表单上各栏位的对应如图-1之标示)，然後检测建立捷径的情况， 检测时， 笔者必须说明的是， 呼叫建立 fCreateShellLink 之後， 再按下「开始」工具列时， 被建立的捷径不一定会马上出现在其中， 这是因为「开始」工具列未即时更新的缘故，但您可以利用档案总管功能表的「检视/重新整理」让「开始」工具列立即更新。

　

附带说明：中文 Windows 的「启动」资料夹名称是 "启动"， 但英文 Windows 却是 "StartUp"， 而不同语言的 Windows 可能又所不同，「桌面」的情况亦然， 因此如果您要在「启动」资料夹中或「桌面」上建立捷径，必须考虑不同语言的问题。

　

问题7：如何启动 Windows 预设的执行档开启某一文件？

---

　

举例来说， .txt 的文件希望用「记事本」开启、.doc 的文件用 Word 开启、.bmp 的文件用「小画家」开启…， 就好像利用「档案总管」开启文件一样。

　

当我们想在 VB 程式中执行某一个程式时， 最简单的方法是呼叫 Shell 叙述，例如「Shell "Notepadc:/test.txt"」， 但 Shell 叙述必须指定好执行档，所以并不适用於此一问题。想要像档案总管一样开启文件， 需呼叫 ShellExecute API 函数， 先举个简单的例子， 假设想开启 c:/Windows 目录的 general.txt 文件， 则方法如下：

　

Call ShellExecute(Me.hwnd, "open", "c:/Windows/general.txt", "", "", SW_SHOW)

　

以上叙述笔者省略了参数四及参数五， 其中参数四表示传递给执行档的参数，但由於此一 ShellExcute 叙述已经是用来开启文件， 所以此一参数通常设定为 ""， 参数五则表示工作目录， 若设定为 ""， 则以文件的所在目录为工作目录。此外，参数六表示文件开启後显示的方式， SW_SHOW 表示正常大小， 若设定成 SW_SHOWMINIMIZED，则以最小化的视窗来显示， 若设定成 SW_SHOWMAXIMIZED， 则以最大化的视窗来显示。

　

问题8：如何在启动某一个程式之後， 等待此一程式结束执行後才继续执行。

---

　

当我们呼叫 Shell 时， 会传回一个数值， 此一数值称为 Process Id， 利用此一 Process Id， 我们可以呼叫 OpenProcess API 取得 Process Handle， 然後再利用 Process Handle 呼叫 WaitForSingleObject， 即可等待被 Shell 执行的程式执行完毕後，才继续向下执行。程式如下：(以执行 Notepad 程式为例)

　

Dim pId As Long ' 宣告 Process Id 变数

Dim pHndn As Long ' 宣告 Process Handle 变数

pId = Shell("Notepad", vbNormalFocus) ' Shell 传回 Process Id

pHnd = OpenProcess(SYNCHRONIZE, 0, pId) ' 取得 Process Handle

If pHnd <> 0 Then

Call WaitForSingleObject(pHnd, INFINITE) ' 无限等待，直到程式结束

Call CloseHandle(pHnd)

End If

　

至於程式的工作原理， 由於故事很长， 原谅笔者暂时不做进一步的解说。使用此一方法时，请特别注意， 在等待的时候， 原来的程式是完全不能操作的， 因此笔者建议在呼叫 WaitForSingleObject 之前， 先将原程式的视窗隐藏起来， 直到等待结束时(也就是 WaitForSingleObject 之後)， 才重新显示视窗。

　

问题9：在多行的 TextBox 中， 如何计算行数？

---

　

这个问题如果不使用 Windows API， 使用 VB， 则方法如下：

　

Dim S As String, N As Integer, pos As Integer

S = Text1.Text

pos = InStr(S, vbCr + vbLf) ' vbCr + vbLf 为 TextBox 的断行字元

While pos > 0

N = N + 1

S = Mid(S, pos + 2)

pos = InStr(S, vbCr + vbLf)

Wend

N = N + 1

' N 即等於 Text1 的行数

　

但以上程式遇到 TextBox 行数很多时， 执行效能会比较差一点， 因此可以考虑使用以下的 API 方法：

　

Dim N As Long

N = SendMessage(Text1.hwnd, EM_GETLINECOUNT, 0, ByVal 0&)

' N 即等於 Text1 的行数

　

问题10：如何判断某一个 Drive 是否为光碟机？

---

　

须呼叫 Windows API 的 GetDriveType 函数， 假设我们想判断 "D:" 碟是否为光碟机， 则方法如下：

　

DriveType = GetDriveType ( "D:/")

If DriveType = DRIVE_CDROM Then ' 表示光碟机

　

请注意 GetDriveType 的参数不可以写成 "D" 或 "D:"，必须写成 "D:/"。GetDriveType 除了可以用判断光碟机之外， 以下是各种传回值的意义：

　

传回值意义0无从判断1根目录不存在DRIVE_REMOVABLE(= 2)可移式磁碟， 例如软碟DRIVE_FIXED(= 3)硬碟DRIVE_REMOTE(= 4)远端(网路)储存装置DRIVE_CDROM(= 5)光碟机DRIVE_RAMDISK(= 6)RAM Disk

　

如果我们想列举出所有磁碟机的类型， 则可先在表单上布置一个 DriveListBox(假设它的名称是 Drive1) 控制元件， 然後再利用以下程式列举：

　

Dim dTypeStr(0 To 6) As String, dType As Long

　

dTypeStr(0) = "无从判断" : dTypeStr(1) = "根目录不存在"

dTypeStr(2) = "软碟" : dTypeStr(3) = "硬碟"

dTypeStr(4) = "远端(网路)储存装置"

dTypeStr(5) = "光碟机" : dTypeStr(6) = "RAM Disk"

For I = 0 To Drive1.ListCount - 1

Drv = Left(Drive1.List(I), 2) & "/"

dType = GetDriveType(Drv)

Debug.Print Drv & " is " & dTypeStr(dType)

Next

　

问题11：如何读取档案的建立时间及存取时间？

---

　

如果我们利用 VB 所提供的 FileDateTime 来读取档案的时间， 则所得到的是档案最後一次被修改的时间，但是当我们利用档案总管来检视某一个档案时， 除了档案「修改时间」之外， 却还可以看到档案的「建立时间」与「存取时间」，如图-2。

　

图-2 档案总管所显示的档案内容除了「修改时间」之外，还有「建立时间」与「存取时间」。

　

想要进一步读取档案的相关资讯， 必须先呼叫 API 函数的 OpenFile 取得档案的 Handle， 然後再利用 Handle 呼叫 GetFileInformationByHandle 读取档案的相关资讯，而在读取的档案相关资讯中便含有档案建立、修改、及存取时间， 程式执行过程如下：(假设想读取的档案是 "c:/autoexec.bat")

　

Dim FileHandle As Long

Dim FileInfo As BY_HANDLE_FILE_INFORMATION

Dim lpReOpenBuff As OFSTRUCT, ft As SYSTEMTIME

Dim tZone As TIME_ZONE_INFORMATION

　

Dim dtCreate As Date ' 建立时间

Dim dtAccess As Date ' 存取日期

Dim dtWrite As Date ' 修改时间

Dim bias As Long

　

' 先取得 autoexec.bat 的 File Handle

FileHandle = OpenFile("c:/autoexec.bat", lpReOpenBuff, OF_READ)

' 利用 File Handle 读取档案资讯

Call GetFileInformationByHandle(FileHandle, FileInfo)

Call CloseHandle(FileHandle)

　

' 读取 Time Zone 资讯， 因为上一步骤的档案时间是「格林威治」时间

Call GetTimeZoneInformation(tZone)

bias = tZone.bias ' 时间差， 以「分」为单位

　

Call FileTimeToSystemTime(FileInfo.ftCreationTime, ft) ' 转换时间资料结构

dtCreate = DateSerial(ft.wYear, ft.wMonth, ft.wDay) + TimeSerial(ft.wHour, ft.wMinute - bias, ft.wSecond)

Call FileTimeToSystemTime(FileInfo.ftLastAccessTime, ft)

dtAccess = DateSerial(ft.wYear, ft.wMonth, ft.wDay) + TimeSerial(ft.wHour, ft.wMinute - bias, ft.wSecond)

Call FileTimeToSystemTime(FileInfo.ftLastWriteTime, ft)

dtWrite = DateSerial(ft.wYear, ft.wMonth, ft.wDay) + TimeSerial(ft.wHour, ft.wMinute - bias, ft.wSecond)

　

执行以上程式所得到的 dtCreate、dtWrite、及 dtAccess 变数， 即分别为档案建立、修改、及存取时间。

　

问题12：如何以程式控制多行 TextBox 的卷动？

---

　

首先请回顾问题-9的程式， 在问题-9 的程式中， 我们利用 SendMessage 传送 EM_GETLINECOUNT 讯息给 TextBox， 而 TextBox 收到讯息时， 会判断讯息的编号，然後计算行数并且回传， 此一工作模式， 我们可以把传送给 TextBox 的讯息当成对 TextBox 所下的指令， 而对於控制 TextBox 的卷动来说， 所传送的讯息(下达的指令)是 EM_LINESCROLL， 程式则如下：

　

Dim N As Long
Call SendMessage(Text1.hwnd, EM_LINESCROLL, 0&, ByVal N ) ' 下卷N行

Call SendMessage(Text1.hwnd, EM_LINESCROLL, 0&, ByVal -N ) ' 上卷N行

Call SendMessage(Text1.hwnd, EM_LINESCROLL, N, ByVal 0&) ' 右卷N列

Call SendMessage(Text1.hwnd, EM_LINESCROLL, -N, ByVal 0&) ' 左卷N列

　

举例来说， 想要上卷 5 行右卷 3 列， 呼叫的叙述如下：

　

Call SendMessage(Text1.hwnd, EM_LINESCROLL, 3&, ByVal -5& )

　

问题13：如何像一般的绘图软体一样填满某一区域的颜色？

---

　

想要把某一区域填满成某一颜色， 可以呼叫 FloodFill API 函数， 此一函数含有以下四个参数：

　

1. hDC：handle of DC， 有关 DC(Device Context) 的意义请参阅上上期的解说，对 VB 的物件而言， Form 及 PictureBox 都具有名称为 hDC 的属性， 可据以呼叫 FloodFill 函数。
2. X, Y：座标位置， 但请注意， 单位是 pixel(像素)。
3. crColor：封闭区域的边框颜色。

　

让笔者举例来说明以上参数 2、3、4 的设定方法， 参考图-3， 假设我们想填满某一方形区域，则 (X, Y) 可以设定成区域内的任何一点， 而 crColor 则必须设定成边框的颜色，假设边框颜色是黑色， 则设定值等於 RGB(0,0,0)(等於 0)， 假设边框颜色是红色，则设定值等於 RGB(255,0,0)。

　

图-3 FloodFill 的参数意义

　

虽然 FloodFill 是填满区域的函数， 但单纯呼叫此一函数并不能填满区域，因为 Windows GDI 规定， 填满区域之前必须先设定 brush(图刷)物件给 DC 才可以，而 brush 物件的颜色就成为填满的颜色。为了建立 brush 物件， 并且设定给 DC，我们必须这麽做：

　

Dim hBrush As Long

hBrush = CreateSolidBrush(颜色设定值) ' 建立 brush 物件

Call SelectObject(hDC, hBrush) ' 将 brush 物件设定给 DC

' 接着再呼叫 FloodFill， 例如：

Call FloodFill(hDC, X, Y, RGB(0, 0, 0))

　

有关实际范例， 您可以参阅笔者所完成的 runpc49h.frm 表单， 如图-4， 使用此一表单时，只要选取颜色， 再以滑鼠选取欲填满颜色的区域， 即可看到 FloodFill 执行的结果，在此范例中， 请注意一件事情：笔者将表单的 ScaleMode 属性设定成 "3-像素"，因为 FloodFill 的 (X, Y) 参数是以像素为座标单位。

　

图-4 FloodFill 范例程式

　

问题14：如何读取磁碟的空间及可用空间？

---

　

读取磁碟的空间及可用空间需呼叫 GetDiskFreeSpace API 函数， 此一函数含有 5 个参数， 意义如下：

　

1. RootPathName：磁碟机根目录， 以 C: 为例， 必须写成 "C:/"，不可以写成 "C:" 或 "C"。
2. SectorsPerCluster：每一丛集的磁轨数。
3. BytesPerSector：每一磁轨的位元组数。
4. NumberOfFreeClusters：可用的丛集数。
5. TotalNumberOfClusters：总丛集数。

　

而计算磁碟空间(位元组数)的公式等於＝(每一磁轨的位元组数×每一丛集的磁轨数×丛集数)，所以求取磁碟空间与可用空间的程式如下：(以 C: 为例)

　

Dim Sectors As Long, Bytes As Long, Free As Long, Total As Long

Dim FreeKB As Long, TotalKB As Long

Call GetDiskFreeSpace("C:/", Sectors, Bytes, Free, Total)

FreeKB = Bytes * Sectors * Free / 1024 ' 可用空间, 以 KB 为单位

TotalKB = Bytes * Sectors * Total / 1024 ' 总空间, 以 KB 为单位

　

问题15：将表单缩小时， 希望它的图示显示在工作列的右下角。

---

　

最後来一题超难的， 但问此一问题的读者很多。

　

图-5 将程式缩到右下角， 可能吗？

　

基本上， 表单缩小後只有一个归宿—「开始」功能表右边的工作列， 要缩到右下角，别想。但为什麽有的程式可以缩到右下角呢？其实右下角的图示都不是表单或程式，对 Windows 来说， 它只是一个图示， 而想建立此一图示， 方法是呼叫 Shell_NotifyIconA API 函数， 如下：

　

Dim nid As NOTIFYICONDATA

Call Shell_NotifyIconA(NIM_ADD, nid)

　

呼叫 Shell_NotifyIconA 之前， 必须间填好 NOTIFYICONDATA 资料结构(如以上的 nid 变数)的内容， 而 NOTIFYICONDATA 各资料成员的意义如下：

　

1. cbSize：需填入 NOTIFYICONDATA 资料结构的长度。
2. hWnd：handle of window， 例如设定成 Form1.hWnd。
3. uID：使用者为图示所设定的 ID。
4. uFlags：用来设定以下叁个参数(uCallbackMessage、hIcon、szTip)是否有效，通常设定成 (NIF_MESSAGE + NIF_ICON + NIF_TIP) 表示全部有效。
5. uCallbackMessage：将来使用者在图示上按下滑鼠时， Windows 会以讯息通知视窗程序，而此一参数为讯息之编号。
6. hIcon：图示。
7. szTip：提示讯息。

　

以上共有 7 个资料成员， 看起来挺吓人的， 别担心， 这几个资料成员很容易设定，首先让笔者举个最简单的例子：

　

Dim nid As NOTIFYICONDATA

nid.cbSize = Len(nid) ' 取资料结构的长度设定给 cbSize

nid.hWnd = Me.hWnd ' 设定成表单的 hWnd

nid.uID = 9999 ' 取一个编号， 可自订

nid.uFlags = NIF_ICON ' NIF_ICON 表示设定图示

nid.hIcon = Me.hIcon ' 设定成表单的图示

Call Shell_NotifyIconA(NIM_ADD, nid)

　

结果执行之後， Me(目前表单) 的图示就会出现在工作列的右下角(以下简称工作列)，您可以直接参阅笔者所完成的范例， 以检视程式执行的结果。在以上的设定中 uID 必须取一个唯一的编号， 将来我们若要从工作列除去此一图示， Windows 会比对此一 uID 与 hWnd， 所以除去的方法如下：

　

Dim nid As NOTIFYICONDATA

nid.cbSize = Len(nid)

nid.hWnd = Me.hWnd

nid.uID = 9999

Call Shell_NotifyIconA(NIM_DELETE, nid)

　

笔者的习惯是将 nid 宣告成全域变数， 所以执行 Shell_NotifyIconA(NIM_ADD, nid) 之後， nid 资料结构会保存 uID 及 hWnd 的值， 所以接下来不必再设定 nid 的资料成员， 即可直接呼叫 Shell_NotifyIconA(NIM_DELETE, nid)， 笔者的范例程式就是这麽写的。

　

设定「提示讯息」

　

图-6 滑鼠移到图示上面会出现「提示讯息」

　

参考图-6， 当我们把滑鼠移到图示上面时， 有些图示还会显示「提示讯息」，这是怎麽办到的呢？直接来看程式：

　

nid.cbSize = Len(nid)

nid.hWnd = Me.hWnd

nid.uID = 9998

nid.uFlags = NIF_ICON + NIF_TIP ' 增加「提示讯息」的设定

nid.hIcon = Me.Icon

nid.szTip = "学 VB 找王国荣" + Chr(0)

Call Shell_NotifyIconA(NIM_ADD, nid)

　

首先 uFlags 资料成员要加上 NIF_TIP， 而 szTip 资料成员则设定成提示讯息，请注意此一提示讯息的最後应加上 Chr(0)， 否则提示讯息的最後会多出很多空白字元。

　

图示的修改

　

Shell_NotifyIconA 函数除了可用来建立及删除图示之外， 也可以修改图示，例如以下程式可以将 uID = 9998 图示的提示讯息由「学 VB 找王国荣」改成「学 Visual Basic 找王国荣」：

　

nid.hWnd = Me.hWnd

nid.uID = 9998

nid.uFlags = NIF_ICON + NIF_TIP

nid.szTip = "学 Visual Basic 找王国荣" + Chr(0)

Call Shell_NotifyIconA(NIM_MODIFY, nid)

　

接收 Windows 的讯息

　

想想， 我们在工作列里面建立图示有什麽用呢？首先， 假设我们将 Form1 的图示设定到工作列中，那麽接下来可以利用以下叙述让 Form1 不会显示在正规的工作列中：

　

Form1.Hide

　

因为右下角的工作列比较不占空间， 对於一些处理「背景」(background)工作的表单而言，这确实是个不错的表现方式， 以数据机、印表机…为例， 就采用此一表现方式，而有意思的是， 数据机(或印表机)状态改变时， 程式也会利用 Shell_NotifyIconA(NIM_MODIFY, nid) 改变图示， 让使用者感觉到程式有在执行。

　

以数据机或印表机为例， 当我们在图示上面按下滑鼠时， 它们都会开启视窗，这又是如何办到的呢？笔者稍早说过， 工作列的图示只是图示， 不是视窗， 因此无法接收「按下滑鼠」的讯息，而实际上， 当使用者在工作列的图示按下滑鼠时， 收到讯息的是 Windows 的 Shell 程式， 为了让 Shell 程式能够将按下滑鼠的讯息转送给我们的视窗， 在建立图示时，必须这麽做：

　

Dim nid As NOTIFYICONDATA

nid.cbSize = Len(nid)

nid.hWnd = Me.hWnd

nid.uID = 9997

nid.uFlags = NIF_ICON + NIF_TIP + NIF_MESSAGE

nid.hIcon = Me.hIcon

nid.szTip = "学 VB 找王国荣" + Chr(0)

nid.uCallbackMessage = 讯息编号

Call Shell_NotifyIconA(NIM_ADD, nid)

　

主要的变动有二：(1) uFlags 资料成员必须增加 NIF_MESSAGE (2) 把希望 Shell 传送过来的讯息编号设定给 uCallbackMessage 资料成员， 例如设定成 99999，则将来使用者在工作列的图示按下滑鼠时(包含单按及双按)， 视窗程序都会收到 99999 的讯息。

　

但故事还没结束， 收到 Shell 传来讯息的是「视窗程序」， 不是「事件程序」，所以想要处理 Shell 传来的讯息， 必须撰写视窗程序， 这下子又要应用到上一期所介绍的「Windows 的讯息系统」了。

　

接着让笔者来说明视窗程序如何处理 Shell 所传来的讯息， 就架构部分， 与上一期介绍的视窗程序完全相同，而 Msg、wParam、及 lParam 等几个参数的意义则如下：

　

1. Msg：将等於 nid.uCallbackMessage 资料成员的设定值。
2. wParam：将等於 nid.uID 资料成员的设定值。
3. lParam：将等於滑鼠的讯息， 其中最常使用的是 WM_LBUTTONDOWN(按下滑鼠左钮) 及 WM_LBUTTONDBLCLK(双按滑鼠左钮)。

　

因此视窗程序的架构大致如下：

　

Function WndProcForIcon(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

If Msg = 讯息编号 Then

If lParam = WM_LBUTTONDOWN Then

... 处理「按下滑鼠」讯息

ElseIf lParam = WM_LBUTTONDBLCLK Then

... 处理「双按滑鼠」讯息

End If

End If

WndProcForIcon = CallWindowProc(prevWndProcForIcon, hWnd, Msg, wParam, lParam)

End Function

　

此一运作模式并不困难， 唯一要特别注意的事情是「讯息编号」(也就是 nid.uCallbackMessage 资料成员与视窗程序的 Msg 参数)， 由於 Windows 已经定义了某些讯息(例如 WM_LBUTTONDOWN)，而这些讯息都具有特定意义， 因此我们选用的「讯息编号」绝对不可以与 Windows 已定义的讯息相冲突， 而要避免讯息的冲突， 程式可以使用编号在 WM_USER(=&H400=1024) 以後的讯息， 因为 WM_USER 以後的讯息编号属於 Windows 未定义的讯息。

　

此一问题特别困难， 建议您仔细阅读笔者所完成的范例， 如果不太能了解其中的意义，请翻开上一期的「Windows 的讯息系统」， 复习一下。

　

附录 — 呼叫本文 API 函数所需之宣告式

　

Option Explicit

' 问题 1、2、3 所需之宣告

Public Const FO_MOVE = &H1

Public Const FO_COPY = &H2

Public Const FO_DELETE = &H3

Public Const FOF_NOCONFIRMATION = &H10

Public Const FOF_NOCONFIRMMKDIR = &H200

Public Const FOF_ALLOWUNDO = &H40

Type SHFILEOPSTRUCT

hWnd As Long

wFunc As Long

pFrom As String

pTo As String

fFlags As Integer

fAborted As Boolean

hNameMaps As Long

sProgress As String

End Type

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

　

' 问题 4 所需之宣告

Public Const GWL_WNDPROC = (-4)

Public Const WM_RBUTTONDOWN = &H204

Public Const WM_RBUTTONUP = &H205

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

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public prevWndProc As Long

　

' 问题 5 所需之宣告

Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

　

' 问题 6 所需之宣告

Declare Function fCreateShellLink Lib "vb5stkit.DLL" (ByVal folder As String, ByVal ShortCutName As String, ByVal ExePath As String, ByVal Params As String) As Long

　

' 问题 7 所需之宣告

Public Const SW_SHOWMINIMIZED = 2

Public Const SW_SHOWMAXIMIZED = 3

Public Const SW_SHOW = 5

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

　

' 问题 8 所需之宣告

Public Const SYNCHRONIZE = &H100000

Public Const INFINITE = &HFFFFFFFF

Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

　

' 问题 9、12 所需之宣告

Public Const EM_GETLINECOUNT = &HBA

Public Const EM_LINESCROLL = &HB6

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

　

' 问题 10 所需之宣告

Public Const DRIVE_REMOVABLE = 2

Public Const DRIVE_FIXED = 3

Public Const DRIVE_REMOTE = 4

Public Const DRIVE_CDROM = 5

Public Const DRIVE_RAMDISK = 6

Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

　

' 问题 11 所需之宣告

Public Const OFS_MAXPATHNAME = 128

Public Const OF_READ = &H0

Type OFSTRUCT

cBytes As Byte

fFixedDisk As Byte

nErrCode As Integer

Reserved1 As Integer

Reserved2 As Integer

szPathName(OFS_MAXPATHNAME) As Byte

End Type

　

Type SYSTEMTIME

wYear As Integer

wMonth As Integer

wDayOfWeek As Integer

wDay As Integer

wHour As Integer

wMinute As Integer

wSecond As Integer

wMilliseconds As Integer

End Type

Type FileTime

dwLowDateTime As Long

dwHighDateTime As Long

End Type

　

Type BY_HANDLE_FILE_INFORMATION

dwFileAttributes As Long

ftCreationTime As FileTime

ftLastAccessTime As FileTime

ftLastWriteTime As FileTime

dwVolumeSerialNumber As Long

nFileSizeHigh As Long

nFileSizeLow As Long

nNumberOfLinks As Long

nFileIndexHigh As Long

nFileIndexLow As Long

End Type

Type TIME_ZONE_INFORMATION

bias As Long

StandardName(32) As Integer

StandardDate As SYSTEMTIME

StandardBias As Long

DaylightName(32) As Integer

DaylightDate As SYSTEMTIME

DaylightBias As Long

End Type

　

Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long

Declare Function GetFileInformationByHandle Lib "kernel32" (ByVal hFile As Long, lpFileInformation As BY_HANDLE_FILE_INFORMATION) As Long

' Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FileTime, lpSystemTime As SYSTEMTIME) As Long

　

' 问题 13 所需之宣告

Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Declare Function FloodFill Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long

　

' 问题 14 所需之宣告

Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long

　

' 问题 15 所需之宣告

Public Const NIM_ADD = 0

Public Const NIM_MODIFY = 1

Public Const NIM_DELETE = 2

Public Const NIF_MESSAGE = 1

Public Const NIF_ICON = 2

Public Const NIF_TIP = 4

Type NOTIFYICONDATA

cbSize As Long

hWnd As Long

uID As Long

uFlags As Long

uCallbackMessage As Long

hIcon As Long

szTip As String * 64

End Type

　

Public Const WM_LBUTTONDOWN = &H201

Public Const WM_LBUTTONDBLCLK = &H203

Public Const WM_USER = &H400

Public prevWndProcForIcon As Long

　

Declare Function Shell_NotifyIconA Lib "SHELL32" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Integer

　

　

' 问题 4 所需之视窗程序

Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

If Msg = WM_RBUTTONDOWN Then

' 吃掉这个讯息

Else

WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)

End If

End Function

　

' 问题 15 所需之视窗程序

Function WndProcForIcon(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

If Msg = WM_USER Then

If lParam = WM_LBUTTONDOWN Then

MsgBox "按下滑鼠", vbInformation + vbSystemModal

ElseIf lParam = WM_LBUTTONDBLCLK Then

MsgBox "双按滑鼠", vbInformation + vbSystemModal

End If

End If

WndProcForIcon = CallWindowProc(prevWndProcForIcon, hWnd, Msg, wParam, lParam)

End Function