登录  
 加关注
查看详情
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

面包会有的

... ...

 
 
 

日志

 
 

VB使用大全 - 18  

2007-09-08 14:42:19|  分类: 默认分类 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

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

  评论这张
 
阅读(679)| 评论(0)

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2018