2008年8月18日星期一

vb技巧8

从全路径名中提取文件名
Function StripPath(T$) As String
Dim x%, ct%
StripPath$ = T$
x% = InStr(T$, "\")
Do While x%
ct% = x%
x% = InStr(ct% + 1, T$, "\")
Loop
If ct% > 0 Then StripPath$ = Mid$(T$, ct% + 1)
End Function
例子:
File = StripPath("c:\windows\hello.txt")
返回
把文件置入到Text或RichText中
dim sFile as string
'Set sFile equal to your filename
dim i as long

i = freefile()

open sFile for input as #i
txtMain.text = input$(i,LOF(i))
close #1
返回

目录所占的字节数
该函数返回目录使用的字节数:

Function DirUsedBytes(ByVal dirName As String) As Long
Dim FileName As String
Dim FileSize As Currency
If Right$(dirName, 1) <> "\" Then
dirName = dirName & "\"
Endif
FileSize = 0
FileName = Dir$(dirName & "*.*")
Do While FileName <> ""
FileSize = FileSize + _
FileLen(dirName & FileName)
FileName = Dir$
Loop
DirUsedBytes = FileSize
使用:
MsgBox DirUsedBytes("C:\Windows")
返回

打开 Win95 的创建快捷方式窗口
以下的代码演示了如何利用 Win95 的 Wizard 在指定的目录中建立快捷方式。

Dim X As Integer
X = Shell("C:\WINDOWS\rundll32.exe AppWiz.Cpl,NewLinkHere " & App.Path & "\", 1)
返回

显示盘中所有的目录
以下的代码把盘中所有的目录都显示在DriveListBox 和一个Listbox 中。需要一个 如果 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
返回

取得长文件名
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

没有评论: