282、如何从全路径名中提取文件名(从前向后)？
Option Explicit
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")
283、如何翻转一个字符串？
翻转一个字符串
下面的函数利用递归原理获得字符串的翻转字符串
Function reversestring(revstr As String) As String
' revstr: 要翻转的字符串
' 返回值:翻转后的字符串
Dim doreverse As Long
reversestring = ""
For doreverse = Len(revstr) To 1 Step -1
reversestring = reversestring & Mid$(revstr, doreverse, 1)
Next
End Function
284、如何分离出路径和文件名？
Public Function GETPATH(ByVal PATHANDNAME As String, Optional filename As String) As String
'把带有含有文件和路径的字符串分为路径和文件两个字符串输出.GETPATH 返回路径,filename 返回文件名.
'get path and filename separated. no "\" at the end of path after.
'author NorthWest Donkey nwdonkey@371.net
For i = Len(PATHANDNAME) To 1 Step -1 '循环减1
slash = Mid(PATHANDNAME, i, 1) '截取单个字符(从后往前)
If slash = "\" Then Exit For '发现第一个“\”说明由此往后是文件名
Next i
If i <> 0 Then
filename = Mid(PATHANDNAME, i + 1, Len(PATHANDNAME) - i) '从第一个\后取出文件名
GETPATH = Left(PATHANDNAME, i - 1) '从第一个\往左取出路径
End If
End Function
'张建慧标注：
此函数只是简单的一个示例，并未进行路径有效性的判断，比如非法字符，路径是否完整，文件名是否完整有效等。
285、如何将长的目录名缩短？
Public Function path2long(ByVal LongPath As String, ByVal reduce2 As Integer) As String
'将长的目录名缩短
'如：由 "C:\Program Files\Vb5\我的最新程序库\temp" 变成 "...\Vb5\我的最新程序库\temp"
Dim i As Integer
Dim slash As String
If reduce2 < Len(LongPath) Then
path2long = Right(LongPath, reduce2 - 3) 'get rid of extensions
For i = 1 To Len(path2long)
slash = Mid(path2long, i, 1)
If slash = "\" Then Exit For
Next i
If i <> 0 Then
path2long = "..." & Right(path2long, Len(path2long) - i + 1)
End If
Else
path2long = LongPath
End If
End Function
286、如何检查目录名是否有效？
'Function: IsPathValid(DestPath$, ByVal DefaultDrive$) As Integer
'Description: Checks for a valid path
'Returns: True/False
Function IsPathValid(DestPath$, ByVal DefaultDrive$) As Integer
Dim Tmp$, Drive$, LegalChar$, BackPos As Integer, ForePos As Integer
Dim Temp$, I As Integer, PeriodPos As Integer, Length As Integer
'-------------------------------------------------------
'- Remove left and right spaces
'-------------------------------------------------------
DestPath$ = RTrim$(LTrim$(DestPath$))
'-------------------------------------------------------
'- Check vbDefault Drive Parameter
'-------------------------------------------------------
If Right$(DefaultDrive$, 1) <> ":" Or Len(DefaultDrive$) <> 2 Then
MsgBox "Bad vbDefault drive parameter specified in IsPathValid Function. You passed, """ + DefaultDrive$ + """. Must be one drive letter and "":"". For example, ""C:"", ""D:""...", 64, "Setup Kit Error"
GoTo parseErr
End If
'-------------------------------------------------------
'- Insert vbDefault drive if path begins with root backslash
'-------------------------------------------------------
If Left$(DestPath$, 1) = "\" Then
DestPath$ = DefaultDrive + DestPath$
End If
'-------------------------------------------------------
'- check for invalid characters
'-------------------------------------------------------
On Error Resume Next
Tmp$ = Dir$(DestPath$)
If Err <> 0 Then
GoTo parseErr
End If
'-------------------------------------------------------
'- Check for wildcard characters and spaces
'-------------------------------------------------------
If (InStr(DestPath$, "*") <> 0) Then GoTo parseErr
If (InStr(DestPath$, "?") <> 0) Then GoTo parseErr
If (InStr(DestPath$, " ") <> 0) Then GoTo parseErr
'-------------------------------------------------------
'- Make Sure colon is in second char position
'-------------------------------------------------------
If Mid$(DestPath$, 2, 1) <> Chr$(58) Then GoTo parseErr
'-------------------------------------------------------
'- Insert root backslash if needed
'-------------------------------------------------------
If Len(DestPath$) > 2 Then
If Right$(Left$(DestPath$, 3), 1) <> "\" Then
DestPath$ = Left$(DestPath$, 2) + "\" + Right$(DestPath$, Len(DestPath$) - 2)
End If
End If
'-------------------------------------------------------
'- Check drive to install on
'-------------------------------------------------------
Drive$ = Left$(DestPath$, 1)
ChDrive (Drive$) ' Try to change to the dest drive
If Err <> 0 Then GoTo parseErr
'-------------------------------------------------------
'- Add final \
'-------------------------------------------------------
If Right$(DestPath$, 1) <> "\" Then
DestPath$ = DestPath$ + "\"
End If
'-------------------------------------------------------
'- Root dir is a valid dir
'-------------------------------------------------------
If Len(DestPath$) = 3 Then
If Right$(DestPath$, 2) = ":\" Then
GoTo ParseOK
End If
End If
'-------------------------------------------------------
'- Check for repeated Slash
'-------------------------------------------------------
If InStr(DestPath$, "\\") <> 0 Then GoTo parseErr
'-------------------------------------------------------
'- Check for illegal directory names
'-------------------------------------------------------
LegalChar$ = "!#$%&'()-0123456789@ABCDEFGHIJKLMNOPQRSTUVWXYZ^_`{}~.?"
BackPos = 3
ForePos = InStr(4, DestPath$, "\")
Do
Temp$ = Mid$(DestPath$, BackPos + 1, ForePos - BackPos - 1)
'-------------------------------------------------------
'- Test for illegal characters
'-------------------------------------------------------
For I = 1 To Len(Temp$)
If InStr(LegalChar$, UCase$(Mid$(Temp$, I, 1))) = 0 Then GoTo parseErr
Next I
'-------------------------------------------------------
'- Check combinations of periods and lengths
'-------------------------------------------------------
PeriodPos = InStr(Temp$, ".")
Length = Len(Temp$)
If PeriodPos = 0 Then
If Length > 8 Then GoTo parseErr ' Base too long
Else
If PeriodPos > 9 Then GoTo parseErr ' Base too long
If Length > PeriodPos + 3 Then GoTo parseErr ' Extension too long
If InStr(PeriodPos + 1, Temp$, ".") <> 0 Then GoTo parseErr ' Two periods not allowed
End If
BackPos = ForePos
ForePos = InStr(BackPos + 1, DestPath$, "\")
Loop Until ForePos = 0
ParseOK:
IsPathValid = True
Exit Function
parseErr:
IsPathValid = False
End Function
287、如何将路径名和文件名拼装生成全路径名？
Function AddPathToFile(ByVal sPathIn As String, ByVal sFileNameIn As String) As String
'RETURNS: Path concatenated to File.
Dim sPath As String
Dim sFileName As String
'Remove any leading or trailing spaces
sPath = Trim$(sPathIn)
sFileName = Trim$(sFileNameIn)
If sPath = "" Then
AddPathToFile = sFileName
Else
If Right$(sPath, 1) = "\" Then
AddPathToFile = sPath & sFileName
Else
AddPathToFile = sPath & "\" & sFileName
End If
End If
End Function
288、如何将数字转换为大写中文？
这个读数程序可以支持无限长有限小数，希望大家一测：
Const strN = "零壹贰叁肆伍陆柒捌玖"
Const strG = "拾佰仟万亿"
Const intN = "0123456789"
Dim Zero_Count As Long '读零计数
'
Private Function GetN(ByVal N As Long) As String
GetN = Mid(strN, N + 1, 1)
End Function
Private Function GetG(ByVal G As Long) As String
Select Case G
Case 1
GetG = ""
Case 2, 6
GetG = Mid(strG, 1, 1)
Case 3, 7
GetG = Mid(strG, 2, 1)
Case 4, 8
GetG = Mid(strG, 3, 1)
Case 5
GetG = Mid(strG, 4, 1)
Case 9
GetG = Mid(strG, 5, 1)
End Select
End Function
Private Function ReadLongNumber(ByVal LongX As String) As String
Dim NumberX As String
Dim l As Long '长度
Dim m As Long '多余位数
Dim c As Long '循环次数
Dim i As Long, j As Long '标志
Dim CurN As String
NumberX = LongX
l = Len(NumberX)
Do Until l < 9
m = l Mod 8
If m = 0 Then m = 8
CurN = Left(NumberX, m)
If ReadIntNumber(CurN) <> "零" Then
ReadLongNumber = ReadLongNumber & ReadIntNumber(CurN) & "亿"
Else
ReadLongNumber = ReadLongNumber & "亿"
End If
NumberX = Right(NumberX, Len(NumberX) - m)
l = Len(NumberX)
Loop
ReadLongNumber = ReadLongNumber & ReadIntNumber(NumberX)
If Len(ReadLongNumber) > 2 And Right(ReadLongNumber, 1) = "零" Then '去尾 零
ReadLongNumber = Left(ReadLongNumber, Len(ReadLongNumber) - 1)
End If
If Mid(ReadLongNumber, 1, 2) = "壹拾" Then '掐头 壹拾
ReadLongNumber = Right(ReadLongNumber, Len(ReadLongNumber) - 1)
Mid(ReadLongNumber, 1, 1) = "拾"
End If
Zero_Count = 0
End Function
Private Function ReadIntNumber(ByVal NumberX As String) As String
Dim l As Long '长度
Dim m As Long '多余位数
Dim c As Long '循环次数
Dim i As Long, j As Long '标志
Dim CurN As String
If Val(NumberX) = 0 Then ReadIntNumber = GetN(0): Exit Function
l = Len(NumberX)
If l > 8 Then Exit Function
m = l Mod 9
CurN = Right(NumberX, m)
For i = Len(CurN) To 1 Step -1
If GetN(Int(Mid(CurN, i, 1))) = "零" And Zero_Count = 1 Then
If GetG(Len(CurN) - i + 1) = "万" Then
If (Not (Val(Left(CurN, Len(CurN) - 5)) = 0)) Then ReadIntNumber = GetG(Len(CurN) - i + 1) & ReadIntNumber
End If
Else
If GetN(Int(Mid(CurN, i, 1))) = "零" Then
ReadIntNumber = GetN(Int(Mid(CurN, i, 1))) & ReadIntNumber
If GetG(Len(CurN) - i + 1) = "万" Then
If (Not (Val(Left(CurN, Len(CurN) - 5)) = 0)) Then ReadIntNumber = GetG(Len(CurN) - i + 1) & ReadIntNumber
End If
Zero_Count = 1
Else
ReadIntNumber = GetG(Len(CurN) - i + 1) & ReadIntNumber
ReadIntNumber = GetN(Int(Mid(CurN, i, 1))) & ReadIntNumber
Zero_Count = 0
End If
End If
Next i
'Loop
If Len(ReadIntNumber) > 2 And Right(ReadIntNumber, 1) = "零" Then '去尾零
ReadIntNumber = Left(ReadIntNumber, Len(ReadIntNumber) - 1)
End If
If Mid(ReadIntNumber, 1, 2) = "壹拾" Then '掐头 壹拾
ReadIntNumber = Right(ReadIntNumber, Len(ReadIntNumber) - 1)
Mid(ReadIntNumber, 1, 1) = "拾"
End If
End Function
Public Function ReadNumber(ByVal NumberX As String) As String
Dim LongX As String
Dim PointX As String
Dim LongLong As Long
Dim bFS As Boolean '负数
If Not IsNumeric(NumberX) Then
ReadNumber = ""
Exit Function
End If
If CDbl(NumberX) < 0 Then
NumberX = -NumberX
bFS = True
End If
NumberX = CStr(Format(NumberX, "General Number"))
LongLong = InStr(1, NumberX, ".")
If LongLong <> 0 Then
ReadNumber = ReadLongNumber(Left(NumberX, LongLong - 1))
ReadNumber = ReadNumber & "点" & ReadSmallNumber(Right(NumberX, Len(NumberX) - LongLong))
Else
ReadNumber = ReadLongNumber(NumberX)
End If
If bFS = True Then
ReadNumber = "负" & ReadNumber
End If
End Function
Private Function ReadSmallNumber(SmallNumber As String) As String
Dim i As Long
For i = 1 To Len(SmallNumber)
ReadSmallNumber = ReadSmallNumber & GetN(Mid(SmallNumber, i, 1))
Next i
End Function
Private Function ReadSmallNumberToRMB(SmallNumber As String) As String
ReadSmallNumberToRMB = GetN(Mid(SmallNumber, 1, 1)) & "角" & GetN(Mid(SmallNumber, 2, 1)) & "分"
End Function
Public Function ReadNumberToRMB(ByVal NumberX As String) As String
Dim LongX As String
Dim PointX As String
Dim LongLong As Long
Dim bFS As Boolean '负数
If Not IsNumeric(NumberX) Then
ReadNumberToRMB = ""
Exit Function
End If
If CDbl(NumberX) < 0 Then
NumberX = -NumberX
bFS = True
End If
NumberX = CStr(Format(NumberX, "#.00"))
LongLong = InStr(1, NumberX, ".")
If Right(NumberX, Len(NumberX) - LongLong) <> "" Then
ReadNumberToRMB = ReadLongNumber(Left(NumberX, LongLong - 1))
ReadNumberToRMB = ReadNumberToRMB & "元" & ReadSmallNumberToRMB(Right(NumberX, Len(NumberX) - LongLong))
Else
ReadNumberToRMB = ReadLongNumber(NumberX)
End If
If bFS = True Then
ReadNumberToRMB = "负" & ReadNumberToRMB
End If
End Function
289、如何将一个文件转化为短名？
Option Explicit
'API calls for long filename support
Declare Function LoadLibraryEx32W Lib "Kernel" (ByVal lpszFile As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
Declare Function FreeLibrary32W Lib "Kernel" (ByVal hDllModule As Long) As Long
Declare Function GetProcAddress32W Lib "Kernel" (ByVal hInstance As Long, ByVal FunctionName As String) As Long
Declare Function FindFirstFileA Lib "Kernel" Alias "CallProc32W" (ByVal lpszFile As String, aFindFirst As WIN32_FIND_DATA, ByVal lpfnFunction As Long, ByVal fAddressConvert As Long, ByVal dwParams As Long) As Long
Declare Function GetShortPathNameA Lib "Kernel" Alias "CallProc32W" (ByVal lpszLongFile As String, ByVal lpszShortFile As String, ByVal lBuffer As Long, ByVal lpfnFunction As Long, ByVal fAddressConvert As Long, ByVal dwParams As Long) As Long
Declare Function lcreat Lib "Kernel" Alias "_lcreat" (ByVal lpPathName As String, ByVal iAttribute As Integer) As Integer
Private hInstKernel As Long
Private lpGetShortPathNameA As Long
Private lpFindFirstFileA As Long
'Define structures for api calls
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Const MAX_PATH = 260
Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Function GetShortFilename(Filename As String) As String
'=========================================================
'Returns the ShortFileName of a file if in a 32 bit system
'Else returns Filename. You MUST check the validity of the
'filename after this function. If this function fails, it
'will return the long filename it was passed.
'=========================================================
On Error GoTo GetShortFilename_Error
Dim sFF As WIN32_FIND_DATA
Dim a As Long
Dim szShortFilename As String * 256
Dim p As Integer
'Load Kernel32 DLL - if you are on a 16 bit system this is where it would fail
hInstKernel = LoadLibraryEx32W("Kernel32.dll", 0&, 0&)
'Addresses of the long filename functions
lpGetShortPathNameA = GetProcAddress32W(hInstKernel, "GetShortPathNameA")
'Get the short name for the directory
a = GetShortPathNameA(Filename, szShortFilename, 256&, lpGetShortPathNameA, 6&, 3&)
p = InStr(szShortFilename, Chr$(0))
Filename = LCase$(Left$(szShortFilename, p - 1))
GetShortFilename = Filename
'Release the Kernel if necessary
a = FreeLibrary32W(hInstKernel)
Exit Function
GetShortFilename_Error:
' must be no Win32 support, so just return the passed in filename
GetShortFilename = Filename
Exit Function
End Function
290、如何匹配RichTextBox框的查找下一个功能？
Private Sub FindNext()
Dim nPosition As Long
Dim strTemp As String
'如果文本中已有加亮的字符则将光标后移一位
If txtContext.SelLength > 0 Then txtContext.SelStart = txtContext.SelStart + 1
'将当前光标以前的字符串取出
strTemp = Left(txtContext.Text, txtContext.SelStart)
'最中英文混合字符串的长度(中文相当于两个英文)
nPosition = LenB(StrConv(strTemp, vbFromUnicode))
'下面一行的目的是为了从第一个字符开始搜索
If nPosition = 0 Then nPosition = -1
'后移一位以防搜索到自已
nPosition = txtContext.Find(FrmSearch.txtSearch.Text, nPosition + 1)
If nPosition = -1 Then 'nPosition=-1表示没有找到
If MsgBox(" 本次搜索没有找到匹配字符串, 从头开始吗? ", vbQuestion + vbYesNo, "") = vbYes Then
txtContext.SelStart = 0
FindNext
Exit Sub
End If
End If
End If
291、如何去掉文中多余的回车和空行？
'下面的函数可以去掉文中多余的回车和空行，可以对付非常规的字符(以0Ah作为回车，而不是0Dh,0Ah)
Private Function FormatStr(strReadyToFormat As String) As String
Dim strTemp() As String
Dim strReady As String
Dim nPos As Long
Dim i As Long
On Error Resume Next
Do
DoEvents
'有的文件以0Ah作为回车换行标志
nPos = InStr(1, strReadyToFormat, Chr(10), vbBinaryCompare)
'找到0AH后，表示准备另起一行，先将之前的字符0Dh取出(如果有的话)，0Dh表示回车
strReady = Left(strReadyToFormat, nPos - 1)
'如果前面有0DH，全部去掉
Do While Asc(Right(strReady, 1)) = 13
strReady = Left(strReady, Len(strReady) - 1)
If strReady = "" Then Exit Do
Loop
'检查是不是一个空行
If Trim(strReady) <> "" Then
'若是，则写入
i = i + 1
ReDim Preserve strTemp(i)
strTemp(i) = strReady
End If
'去掉头部的字符串
strReadyToFormat = Right(strReadyToFormat, Len(strReadyToFormat) - nPos)
Loop Until nPos = 0 '继续向下找
FormatStr = ""
For i = 1 To UBound(strTemp)
FormatStr = FormatStr + strTemp(i)
Next
End Function
End Function
292、如何在每一个中文后面加一个空格？
Dim TEXTlen As Integer
Dim i As Integer
Dim temp1 As String
Dim temp2 As String
Dim MyCreate As String
Dim j As Integer
Dim NextLine As String
Command1.Enabled = False
If List1.ListCount = 0 Then Exit Sub
Form1.MousePointer = 11
For j = 0 To List1.ListCount - 1
Label2.Caption = "共 " & Str(List1.ListCount) & "个文件，正在修改第 " & Str(j + 1) & " 个文件。"
'打开一个文件，input方式 #1
Open List1.List(j) For Input As #1
'打开一个文件，append文件 #2
Open (App.Path & "\temp.tmp") For Append As #2
Do Until EOF(1)
'从#1读取一行
Line Input #1, NextLine
MyCreate = ""
TEXTlen = Len(NextLine)
For i = 1 To TEXTlen
temp1 = Mid(NextLine, i, 1)
If Asc(temp1) < 0 Then
temp2 = Mid(NextLine, i + 1, 1)
If temp2 <> " " Then
temp1 = temp1 & " "
End If
End If
MyCreate = MyCreate + temp1
DoEvents
Next
Print #2, MyCreate
'向#2写文件
Loop
Close #1
Close #2
FileCopy App.Path & "\temp.tmp", List1.List(j)
Kill App.Path & "\temp.tmp"
Next '下一个文件
Form1.MousePointer = 1
MsgBox "文件已经成功修改！", vbOKOnly + vbInfoBackground, "恭喜！"
293、如何匹配TextBox框的查找下一个功能？
If KeyCode = vbKeyF3 Then 'F3查找下一个
'下面这个If块在查找下一个匹配字符时很有用
If txtContext.SelStart = 0 Then '光标位置在文本框最开头
If txtContext.SelLength > 0 Then
nPos = 2 '如果文本框中有被加亮的字符
Else
nPos = 1 ''如果文本框中没有被加亮的字符
End If
Else
If txtContext.SelLength > 0 Then
nPos = txtContext.SelStart + 2 '如果文本框中有被加亮的字符
Else
nPos = txtContext.SelStart + 1 '如果文本框中没有被加亮的字符
End If
End If
nPos = InStr(nPos, txtContext.Text, FrmSearch.txtSearch.Text, vbTextCompare)
If nPos = 0 Then Exit Sub 'nPos=0表示没有找到
'加亮找到的字符串
txtContext.SelStart = nPos - 1
txtContext.SelLength = Len(FrmSearch.txtSearch.Text)
294、如何寻找并加亮找到的字符？
If KeyCode = vbKeyF3 Then 'F3查找下一个
'下面这个If块在查找下一个匹配字符时很有用
If txtContext.SelStart = 0 Then '光标位置在文本框最开头
If txtContext.SelLength > 0 Then
nPos = 2 '如果文本框中有被加亮的字符
Else
nPos = 1 ''如果文本框中没有被加亮的字符
End If
Else
If txtContext.SelLength > 0 Then
nPos = txtContext.SelStart + 2 '如果文本框中有被加亮的字符
Else
nPos = txtContext.SelStart + 1 '如果文本框中没有被加亮的字符
End If
End If
nPos = InStr(nPos, txtContext.Text, FrmSearch.txtSearch.Text, vbTextCompare)
If nPos = 0 Then Exit Sub 'nPos=0表示没有找到
'加亮找到的字符串
txtContext.SelStart = nPos - 1
txtContext.SelLength = Len(FrmSearch.txtSearch.Text)
295、如何移去字符串末端的目录符号\？
Public Function RemoveBackslash(s As String) As String
Dim i As Integer
i = Len(s)
If i <> 0 Then
If Right$(s, 1) = "\" Then
RemoveBackslash = Left$(s, i - 1)
Else
RemoveBackslash = s
End If
Else
RemoveBackslash = ""
End If
End Function
举例：mystring=RemoveBackslash("c:\windows\") '张建慧标注
296、您知道 Mid$ 函量可以放在 '=' 的左方吗？
一般我们使用函量时，函量一定都在 '=' 的右方，再将函量计算的结果指定给 '=' 左方的变量或物件。但是，如果您从 Quick Basic 时代就开始使用 Basic 了，您一定知道 Mid$ 函量是可以放在 '=' 的左方的！
不过这个技巧，却有很多人不知道，以下举个例子：
Dim sName as string
sName = "Jack Smith, Jr."
Mid$(sName, 6, 5) = "Jones"
当程序执行完毕之后，sName 就等于 "Jack Jones, Jr." 了，这个方法不仅简单而且速度也快！
不过，很遗憾的，遇到上述情形时，我看到很多人都是这么写的：
Dim sName as string
sName = "Jack Smith, Jr."
sName = left$(sName, 6) & "Jones" & right$(sName, 4)
虽然也没有错啦，不过，我觉得还是前面的方法简单明快！
297、如何呼叫出文件的内容问话框（Standard File Properties Dialog）？
当您在资源管理器 (包含【我的电脑】【资源管理器】【网络邻居】..等可以列出文件名称的地方) 的任何一个文件上，按鼠标右键，在出现的下拉选单上选择【内容】，您就会看到和这个文件有关的一个问话框。
在这个文件内容问话框中，您可以看到以下资讯：
1、代表文件类型的图标及文件名。
2、文件类型。
3、文件位置。
4、文件大小。
5、MS-DOS名称。
6、建立日期。
7、修改日期。
8、存取日期。
9、文件属性。
如果您开发的应用程序类型类似资源管理器，需要列出文件，而您也想提供这样的功能，我们在 VB 中也可以做到，请在表单的声明区中加入以下声明及模组：
Private Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hWnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
Private Declare Function ShellExecuteEx Lib "shell32" (lpSEI As SHELLEXECUTEINFO) As Long
Private Const SEE_MASK_INVOKEIDLIST = &HC
Private Sub ShowFileProperties(ByVal aFile As String)
Dim sei As SHELLEXECUTEINFO
sei.hWnd = Me.hWnd
sei.lpVerb = "properties"
sei.lpFile = aFile
sei.fMask = SEE_MASK_INVOKEIDLIST
sei.cbSize = Len(sei)
ShellExecuteEx sei
End Sub
'在表单中加一个 CommandButton，我们以 msvbvm60.dll 为例，程序码如下：
Private Sub Command1_Click()
Call ShowFileProperties("c:\windows\system\msvbvm60.dll")
End Sub
评论