VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - 改进VB的驱动器列表框
发表评论(0)作者:, 平台:, 阅读:8888, 日期:2000-03-17
改进VB的驱动器列表框


信 阳 师 范 学 院 计 算 机 系

董 建 军


V B 是 一 个 高 效 快 捷 的 WINDOWS 应 用 程 序 开 发 工 具, 倍 受 人 们 青 睐。 然 而, V B 也 有 其 局 限 性, 部 分 控 件 不 够 完 善, 许 多 事 件 和 属 性 没 有 提 供, 又 加 上 V B 自 身 的 封 闭 性( 不 允 许 自 我 创 建 对 象), 使 得 我 们 很 难 开 发 出 具 有 一 定 特 色 的 程 序, 如 V B 的 驱 动 器 列 表 框 便 是 一 例。

在 要 求 不 高 的 情 况 下, V B 的 驱 动 器 列 表 框 能 很 好 的 胜 任 其 工 作。 在 使 用 它 时 候, 一 般 在 其 CHANGE 事 件 中 加 入 以 下 代 码, 用 以 改 变 当 前 路 径, 从 而 带 动 目 录 列 表 框: DIR.PATH= DRIVE1.DRIVE

其 中 DIR1、DRIVE1 分 别 是 驱 动 器 列 表 框 和 目 录 列 表 框 的 名 字(NAME 属 性, 以 下 同)。 这 样, 在 运 行 时 只 要 从 驱 动 器 列 表 框 中 任 选 一 项( A:、 B:、 C:、...), 目 录 列 表 框 中 的 内 容 便 会 跟 着 变 动。

然 而, 事 情 远 不 象 它 显 示 的 那 么 简 单, 在 程 序 运 行 时 可 能 会 出 现 以 下 情 况:


⑴、 如 果 驱 动 器 中 没 有 磁 盘 便 会 产 生 运 行 时 错 误, 从 而 导 致 整 个 程 序 运 行 终 止, 这 是 我 们 所 不 想 见 到 的。 这 时 有 必 要 在 CHANGE 事 件 中 加 入 出 错 处 理:

SUB DRIVE1.CHANGE ()

DIM BACK%

ON ERROR GOTO ERRHANDL

DIR1.PATH=DRIVE1.DRIVE

EXIT SUB

ERRHANDL:

BEEP

'显示惊叹号图标和 RETRY ,CANCLE按钮

BACK=BMSGBOX (ERROR(ERR),5 OR 48,"错误")

IF BACK=4 THEN '按下 RETRY按钮

RESUME

ELSE

RESUME NEXT

ENDIF

EXIT SUB

END SUB

在 这 种 情 况 下, 当 错 的 时 候, 往 驱 动 器 中 插 入 磁 盘 并 按 下 REYRY 按 钮, 程 序 得 以 正 确 运 行; 若 按 下 CANCEL 按 钮 就 会 出 现 以 下 问 题:


目 录 列 表 框 的 当 前 内 容 没 有 发 生 改 变, 而 驱 动 器 列 表 框 的 内 容 则 为 刚 才 选 中 的 驱 动 器, 也 即 驱 动 器 列 表 框 和 目 录 列 表 框 的 内 容 没 有 指 向 同 一 磁 盘, 这 当 然 是 我 们 所 不 能 容 忍 的。 原 因 在 于 这 个 出 错 处 理 过 程 是 加 在 CHANGE 事 件 中 的, 而 CHANGE 事 件 是 在 当 前 驱 动 器 发 生 变 化 以 后 才 产 生 的。 如 果 驱 动 器 列 表 框 有 CLICK 事 件 的 话, 那 么 问 题 便 迎 刃 而 解 了。

⑵、 若 更 换 软 驱 中 的 磁 盘, 再 次 选 中 当 前 驱 动 器 进 行 目 录 列 表 时, 则 驱 动器 列 表 框 和 目 录 列 表 框 中 的 内 容 不 会 有 变 动, 仍 为 上 一 张 盘 的 内 容, 和 我 们 的 意 愿 很 不 相 符。 原 因 和 上 面 的 情 况 基 本 类 似, 这 是 因 为 对 驱 动 器 列 表 框 来 说, 当 前 驱 动 器 并 没 有 发 生 变 化, 也 就 不 会 引 发CHANGE 事 件, 相 应 的 其 他 事 件 也 就 不 会 触 发。

⑶、 只 提 供 硬 盘 的 卷 标, 软 盘 即 使 有 也 不 显 示。

这 些 问 题 的 出 现 一 方 面 和 驱 动 器 列 表 框 提 供 的 事 件 过 少 有 关; 另 一 方 面 则 说 明 驱 动 器 列 表 框 本 身 不 够 完 善( 应 能 自 动 识 别 一 些 可 能 发 生 的 错 误)。 再 者, 驱 动 器 列 表 框 本 身 并 不 和 驱 动 器 直 接 相 关, 驱 动 器 的 驱 动 是 由 目 录 列 表 框 来 完 成 的, 驱 动 器 列 表 框 只 是 为 改 变 当 前 路 径 提 供 了 一 个 手 段。 由 于 验 证 很 简 单, 在 这 里 就 不 再 赘 述 了。

为 了 解 决 以 上 问 题, 经 过 分 析 和 实 践, 笔 者 找 到 了 一 个 完 美 的 解 决 方 案。

由 于 V B 的“ 封 闭 性”, 故 不 能 直 接 对 驱 动 器 列 表 框 进 行 改 动, 用 C + + 重 写 驱 动 器 列 表 框 对 广 大 用 户 来 说 也 不 太 可 能, 况 且 在 发 布 程 序 时 还 要 带 上 一 个 小 尾 巴 ─ ─ XXX.VBX。 故 我 们 采 用 组 合 框 来 代 替 驱 动 器 列 表 框 的 方 法。

组 合 框 所 提 供 的 事 件 非 常 丰 富( 有 十 几 种 之 多), 在 这 里 我 们 只 用 到 以 下 两 个:Click 和 Dropdown。Click 事 件 在 用 箭 头 键 或 用 鼠 标 单 击 组 合 框 中 一 条 目 时 发 生; Dropdown 事 件 则 在 列 表 部 分 准 备 下 放 时 发 生。 对 于 本 文 所 附 程 序 来 说,Click 事 件 过 程 主 要 用 来 改 变 当 前 驱 动 器、 驱 动 目 录 列 表 框 和 获 取 并 处 理 当 前 磁 盘 的 卷 标;Dropdown 事 件 过 程 用 来 记 录 当 前 驱 动 器 的 列 表 下 标, 以 备 出 错 时 还 原 原 来 选 项, 具 体 过 程 见 所 例 程。

由 于 V B 没 有 获 取 驱 动 器 数 目 的 函 数 和 方 法, 为 获 取 当 前 环 境 下 的 驱 动 器 数 目 和 当 前 驱 动 器, 我 们 可 以 采 用 以 下 两 种 方 法: ⑴、 在 当 前 窗 体 中 多 加 一 个 驱 动 器 列 表 框( 设 置 其VISIBLE 属 性 为FALSE), 这 样 一 来, 便 可 在 FORM_LOAD 事 件 过 程 中 将 驱 动 器 列 表 框 中 的 内 容 加 到 组 合 框 中。

⑵、 调 用 WINDOWS 所 提 供 的 API 函 数 GetDriveType ()。

该 函 数 的 功 能 为 返 回 指 定 驱 动 器 的 类 型, 如, 软 盘、 硬 盘 等, 但 我 们 也 可 以 根 据 其 返 回 值 来 确 定 所 测 试 的 磁 盘 是 否 存 在。

该 函 数 的 原 型 为:

Declare Function GetDriveType Lib "kernel"

(ByVal nDrive as integer) as integer

其 中 nDrive 为 欲 测 的 驱 动 程 序 代 号, 0 代 表 A 磁 盘, 1 代 表 B 磁 盘, 2 代 表 C 磁 盘, 依 次 类 推。 返 回 值 的 意 义 是: 如 果 返 回 0 则 代 表 所 检 测 的 驱 动 器 不 存 在, 2 代 表 所 测 试 的 驱 动 器 为 软 驱, 3 代 表 所 测 试 的 驱 动 器 为 硬 盘, 4 则 代 表 所 测 试 的 驱 动 器 为 CD-ROM 或 为 网 络 驱 动 器。 我 们 可 根 据 是 否 返 回 0 来 决 定 所 指 定 的 磁 盘 是 否 存 在。 在 检 测 过 程 中 如 果 检 测 到 硬 盘 则 读 取 硬 盘 的 卷 标。 根 据 这 一 原 理, 只 要 我 们 从 A 驱 遍 历 到 Z 驱, 便 可 检 测 到 当 前 机 器 上 的 所 有 磁 盘 驱 动 器。 在 程 序 中 调 用 以 下 过 程, 便 可 方 便 的 实 现 这 一 功 能:


' 函 数 GetDriveType 须 在 全 局 模 块 中 加 以 声 明


Sub Chkdrive ()

On Error Resume Next

Dim i%, back%, drv$, dpath$

For i = 0 To 26 '从A驱到Z驱

back = getdrivetype(i) '检测指定的驱动器

If back < > 0 Then '不为0 则检测到

drv$ = Chr$(i + 65) & ":" '指定的驱动器符

If back = 3 Then '检测到硬盘

dpath$ = drv$ & "\*.*"

'返回硬盘卷标并进行格式处理

combo1.AddItem drv$ & "

[ " & Left(Dir(dpath$, 8), 3) & "... ]"

Else

combo1.AddItem drv$ & " [ None ]"

End If

Else

Exit For '不存在则退出FOR循环

End If

Next i

'以下返回当前驱动器

drv$=Left$(Curdir$,1)

For i= 0 to combo1.listcount-1

if instr(1,combo1.list(i),drv$,1) then

combo1.ListIndex = i

End If

End For

End Sub

在 这 里 我 们 将 采 用 第 一 种 方 法。


为 了 加 以 说 明, 笔 者 编 了 一 个 小 程 序 ─ ─ 文 件 管 理 器, 将 所 附 程 序 进 行 修 改 加 入 到 你 自 己 的 程 序 中, 你 的“ 驱 动 器 列 表 框” 便 无 懈 可 击 了。


以 下 程 序 在 V B FOR WINDOWS VER 3.0 下 调 试 通 过。


'在设计阶段设置组合框的 Style属性为 2

'驱动器列表框的 Visible属性为 False

Option Explicit

Dim index% '设置为全局变量


Sub Combo1_Click ()

Dim erh%, label$, tmp$

On Error GoTo errorh

ChDrive Left$(combo1.Text,

InStr(combo1.Text, ":")) '改变当前驱动器

label = Dir("\*.*", 8) '获取当前磁盘卷标

'显示格式处理

If Len(label) = 0 Then

tmp$ = combo1.List(combo1.ListIndex)

combo1.List(combo1.ListIndex) =

Left$(Left$(tmp$, 2) + " [None] ", 12) + "盘"

Else

tmp$ = combo1.List(combo1.ListIndex)

combo1.List(combo1.ListIndex) =

Left$(tmp$, 3) & "[" & Left$(label, 3) & "...] " + " 盘"

End If

Dir1.Path = CurDir$ '获取当前目录

Dir1.Refresh : FILE1.Refresh '更新目录列表框和文件列表框

'此两句非常关键,不可缺省

'否则目录列表框不会变动

Exit Sub

'出错处理

errorh:

'显示惊叹号图标和 RETRY ,CANCLE按钮

erh = MsgBox(" " + Error(Err), 48 Or 5, "错误")

If erh = 2 Then '按下CANCLE按钮

combo1.ListIndex = index

Resume Next

Else

Resume

End If

Exit Sub

End Sub


Sub Combo1_DropDown ()

index = combo1.ListIndex ' 记录当前选项下标

End Sub


Sub Command1_Click ()

Dim tmp$

tmp$ = FILE1.FileName

Caption = fp(tmp$)

End Sub


'设计时让驱动器列表框隐含

Sub dir1_change ()

FILE1.Path = Dir1.Path

ChDir Dir1.Path

End Sub


Sub Drive1_Change ()

combo1.ListIndex = drive1.ListIndex

End Sub


Sub File1_Click ()

Dim tmp$

tmp$ = FILE1.FileName

label3 = Format(FileLen(fp$(tmp$)), "##,###,###")

End Sub


Sub File1_DblClick ()

Command1_Click

End Sub


'将驱动器更表框中的内容加入到组合框中

Sub Form_Load ()

Dim i%, tmp$

For i = 0 To drive1.ListCount - 1

If Len(drive1.List(i)) = 2 Then t

mp$ = Left$(drive1.List(i) + " [None] ", 12) + "盘"

End If

If InStr(drive1.List(i), "]") Then

If InStr(drive1.List(i), "]") > 7 Then

tmp$ = Left$(drive1.List(i), 7) + "...] " + "盘"

Else

tmp$ = Left$(drive1.List(i) + " ", 12) + "盘"

End If

End If

combo1.AddItem tmp

Next

combo1.ListIndex = drive1.ListIndex '设置当前驱动器

End Sub


Sub Form_Unload (Cancel As Integer)

End

End Sub


Function fp$ (file$)

If Right$(filebox.Dir1.Path, 1) = "\" Then

fp$ = filebox.Dir1.Path + file$

Else

fp$ = filebox.Dir1.Path + "\" + file$

End If

End Function


Sub Text1_KeyPress (keyascii As Integer)

If keyascii = 13 Then FILE1.Pattern = text1.Text

End Sub