266、让您的音乐 CD
动起来(多部光驱)！
267、如何求出磁盘大小及剩余空间大小
(含大于 2GB 的正确算法)
268、如何显示磁盘中所有的目录？
269、如何取得长文件名？
270、如何建立快捷方式？
266、让您的音乐 CD 动起来(多部光驱)！
以前，硬件还没有很便宜的时候，一般人的机器上 (指 Client 端)
最多只会装一部光驱，很少有使用者在同一台机器上装二台或二台以上的光驱，但是，现在连烧录机及 DVD
都很便宜了，所以在机器上装二台光驱已经是稀松平常的事了。
而我们用 VB
来开发应用程序时，若需要用到光驱，以前都是使用预设的光驱，没有什么困扰，但是现在，如果应用程序还是这样写的话，可能就会有点问题会发生了！因为
User 使用的不一定是预设的光驱！
我们在【问题: 让您的音乐 CD 动起来！】中曾经介绍过如何拨放
CD，但是当时并不考虑二台以上光驱的状况，当时的程序码如下：
Private Declare Function
mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand
As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long,
ByVal hwndCallback As Long) As Long
Dim lRet As Long
lRet =
mciSendString("open cdaudio alias cd", 0&, 0,
0)
而今天如果有二台以上的光驱时，假设机器上的 E:\ 及 F:\ 都是光驱，而我们要用的是 F:\
的话，只要将原来的程序稍为修改就可以了！如下：
lRet = mciSendString("open F:\ type cdaudio
alias cd2", 0&, 0, 0) '使用 cd2
只是为了和上面区别而已！
至于您要如何知道有那些磁盘代号是属于光驱的话，您可以参考 (依 VB 版本而定)：
问题:
如何判断目前电脑中所有磁盘之型态？
问题:
如何侦测光驱中是否有光碟存在？
或者看看以下的这个适用多部光驱的媒体拨放程序范例，这个范例的作者对于多媒体相当有研究，且有他自己的网站，网站名称及位址是：
267、如何求出磁盘大小及剩余空间大小 (含大于 2GB 的正确算法)
在问题：如何求出磁盘大小及剩余空间大小
我们使用了 GetDiskFreeSpace
API 来求出磁盘大小及剩余空间大小，
在问题：如何求出磁盘大小及剩余空间大小 (更简单的 VB6 新功能)
我们使用了
FileSystemObject 来求出磁盘大小及剩余空间大小，
如果网友自己曾经实际测试过这二个主题的程序码，而您的硬盘又大于
2GB 时，或许您会发现，只要大于 2GB 的部份都无法正确的显示！为什么会这样呢？这是因为目前 VB 只支持到 32 位的 Integer
资料型态，所以最大值就是 2GB！
要解决这个问题，您必须改用另一个 API GetDiskFreeSpaceEx，不过，在这个
API 中，有使用了一个新的 ULARGE_INTEGER Structure，所以在声明 GetDiskFreeSpaceEx API
之前，您也必须要先声明 ULARGE_INTEGER Type：
Type ULARGE_INTEGER
LowPart As
Long
HighPart As Long
End Type
Declare Function
GetDiskFreeSpaceEx Lib "kernel32.dll" Alias "GetDiskFreeSpaceExA"
_
(ByVal lpDirectoryName As String, _
'目录名称或磁盘代码
lpFreeBytesAvailableToCaller As ULARGE_INTEGER, _ '剩余可用空间大小
(Bytes)
lpTotalNumberOfBytes As ULARGE_INTEGER, _ '磁盘总空间大小
(Bytes)
lpTotalNumberOfFreeBytes As ULARGE_INTEGER) As Long '剩余总空间大小
(Bytes)
ULARGE_INTEGER Structure 是一个 VB 预设中尚未支持的 64 位的
Integer，它的范围是从 &H0 到 &HFFFFFFFFFFFFFFFF (也就是 2 的 64 次方)，它可用于所有尚未支持
64 位的 Integer 的程序语言中。它将 64 位的值切割成二个 32 位的部份，也就是 LowPart 及 HighPart。如果那一天
VB 开始支持 64 位的 Integer 资料型态，ULARGE_INTEGER Structure
就用不到了，否则，您一定要记得声明！
在模组中声明了上面的 Type ULARGE_INTEGER 及
GetDiskFreeSpaceEx API 之后，我们来看看以下的范例程序：
Private Sub
Command1_Click()
Dim userbytes As ULARGE_INTEGER ' 目前 User
可用磁盘空间
Dim totalbytes As ULARGE_INTEGER ' 磁盘总空间
Dim freebytes As
ULARGE_INTEGER ' 磁盘剩余总空间
Dim retval As Long ' GetDiskFreeSpaceEx
的返回值
If Text1.Text = "" Then Text1.Text = "C"
retval =
GetDiskFreeSpaceEx(Text1.Text & ":\", userbytes, totalbytes,
freebytes)
'
If userbytes.LowPart < 0 Then
User 可用磁盘空间 =
Format((userbytes.HighPart * (16 ^ 8)) + (userbytes.LowPart + (16 ^ 8)),
"#,###")
Else
User 可用磁盘空间 = Format((userbytes.HighPart * (16 ^ 8)) +
userbytes.LowPart, "#,###")
End If
'
If totalbytes.LowPart < 0
Then
磁盘总空间 = Format((totalbytes.HighPart * (16 ^ 8)) +
(totalbytes.LowPart + (16 ^ 8)), "#,###")
Else
磁盘总空间 =
Format((totalbytes.HighPart * (16 ^ 8)) + totalbytes.LowPart,
"#,###")
End If
'
If freebytes.LowPart < 0 Then
磁盘剩余总空间 =
Format((freebytes.HighPart * (16 ^ 8)) + (freebytes.LowPart + (16 ^ 8)),
"#,###")
Else
磁盘剩余总空间 = Format((freebytes.HighPart * (16 ^ 8)) +
freebytes.LowPart, "#,###")
End If
'
Text1.SelStart =
0
Text1.SelLength = Len(Text1)
End Sub
注意：以上的功能有以下 OS
本身的限制
Windows 95 必须在 OSR2 或以后的版本才行！
Windows NT 必须在 4.0 以后的版本才行！
268、如何显示磁盘中所有的目录？
以下的代码把盘中所有的目录都显示在 Listbox 中。需要一个 DriveListBox 和一个 DirListBox。如果
DirListBox 隐藏的话，处理可以快一些。
Dim iLevel As Integer, iMaxSize As
Integer
Dim i As Integer, j As Integer
ReDim iDirCount(22) As
Integer
'最大 22 级目录
ReDim sdirs(22, 1) As String
'drive1 是
DriveListBox 控件
'dir1 是 DirListBox 控件
iLevel =
1
iDirCount(iLevel) = 1
iMaxSize = 1
sdirs(iLevel,
iDirCount(iLevel)) = Left$(drive1.Drive, 2) & "\"
Do
iLevel =
iLevel + 1
iDirCount(iLevel) = 0
For j = 1 To iDirCount(iLevel -
1)
dir1.Path = sdirs(iLevel - 1, j)
dir1.Refresh
If iMaxSize <
(iDirCount(iLevel) + dir1.ListCount) Then
ReDim Preserve sdirs(22,
iMaxSize + dir1.ListCount + 1) As String
iMaxSize = dir1.ListCount +
iDirCount(iLevel) + 1
End If
For i = 0 To dir1.ListCount -
1
iDirCount(iLevel) = iDirCount(iLevel) + 1 '子目录记数
sdirs(iLevel,
iDirCount(iLevel)) = dir1.List(i)
Next i
Next j
'所有名称放到 List1
中
list1.Clear
If iDirCount(iLevel) = 0 Then
'如果无自目录
For i = 1
To iLevel
For j = 1 To iDirCount(i)
list1.AddItem sdirs(i,
j)
Next j
Next i
Exit Do
End If
Loop
269、如何取得长文件名？
Public Function GetLongFilename (ByVal sShortName As String) As
String
Dim sLongName As String
Dim sTemp As String
Dim
iSlashPos As Integer
'Add \ to short name to prevent Instr from
failing
sShortName = sShortName & "\"
'Start from 4 to
ignore the "[Drive Letter]:\" characters
iSlashPos = InStr(4,
sShortName, "\")
'Pull out each string between \ character for
conversion
While iSlashPos
sTemp = Dir(Left$(sShortName, iSlashPos -
1), vbNormal + vbHidden + vbSystem + vbDirectory)
If sTemp = ""
Then
'Error 52 - Bad File Name or Number
GetLongFilename =
""
Exit Function
End If
sLongName = sLongName & "\" &
sTemp
iSlashPos = InStr(iSlashPos + 1, sShortName,
"\")
Wend
'Prefix with the drive letter
GetLongFilename =
Left$(sShortName, 2) & sLongName
End Function
270、如何建立快捷方式？
Private Declare Function fCreateShellLink Lib "vb5stkit.DLL" (ByVal
lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal
lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As
Long
Private Sub MakeShortCuts()
Dim lReturn As Long
Dim
MyPath As String
Dim MyName As String
MyPath = App.Path
MyName =
App.EXEName
'增加到桌面
lReturn = fCreateShellLink("..\..\Desktop",
"Shortcut to Net Timer", MyPath & "\" & MyName,
"")
'增加到启动组
lReturn = fCreateShellLink("\启动", "Shortcut to Net
Timer", MyPath & "\" & MyName, "")
End
Sub |