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
271、如何知道资源回收站中有几个已删除的文件，占了多少空间？
网际网路的发展日益蓬勃的今天，很多人都喜欢到网路上下载文件、试用、删除文件！一直循环。
您是否随时注意您的资源回收站，是否有太多尚未清除的文件？这些您删除的文件并未真正删除，它们都还堆在资源回收站中，也都还是占住了您的硬盘空间！
当您打开资源回收站时，在状态列中，您总是可以看到现在有多少个物件在其中，占了多少空间。这些资讯您不用进入资源回收站，也可以在 VB 中利用 SHQueryRecycleBin API 计算出来！
在声明 SHQueryRecycleBin API 之前，由于它使用了一个 SHQUERYRBINFO Structure，所以您必须先声明 SHQUERYRBINFO，而 SHQUERYRBINFO Structure 中又使用到了上一个主题问题218：如何求出磁盘大小及剩余空间大小 (含大于 2GB 的正确算法)中提到的 ULARGE_INTEGER Structure，所以您也必须声明 ULARGE_INTEGER Structure，声明如下：
Type ULARGE_INTEGER
LowPart As Long
HighPart As Long
End Type
Type SHQUERYRBINFO
cbSize As Long
i64Size As ULARGE_INTEGER
i64NumItems As ULARGE_INTEGER
End Type
Declare Function SHQueryRecycleBin Lib "shell32.dll" Alias "SHQueryRecycleBinA" (ByVal pszRootPath As String, pSHQueryRBInfo As SHQUERYRBINFO) As Long
参数说明如下：
pszRootPath：资源回收站路径(不一定是根目录)，如果使用空字串，则表示要查询所有资源回收站的资讯。
pSHQueryRBInfo：返回资源回收桶中目前有多少物件，占了多少 Bytes。
范例如下：找出 C 磁盘中的资源回收站中目前有多少物件，占了多少 Bytes。
Private Sub Command1_Click()
Dim rbinfo As SHQUERYRBINFO ' 资源回收站的资讯
Dim retval As Long ' 返回值
' 初始化 rbinfo 的大小
rbinfo.cbSize = Len(rbinfo)
' 查询资源回收站的内容
retval = SHQueryRecycleBin("C:\", rbinfo) ' the path doesn't have to be the root path
' 显示资源回收站中目前有多少物件
If (rbinfo.i64NumItems.LowPart And &H80000000) = &H80000000 Or rbinfo.i64NumItems.HighPart > 0 Then
Label1 = "资源回收站中有超过 2,147,483,647 个物件"
Else
Label1 = "资源回收站中包含 "; rbinfo.i64NumItems.LowPart; " 个物件"
End If
' 显示资源回收站中的物件，占了多少 Bytes。
If (rbinfo.i64Size.LowPart And &H80000000) = &H80000000 Or rbinfo.i64Size.HighPart > 0 Then
Label2 = "资源回收站中包含超过 2,147,483,647 个字节"
Else
Label2 = "资源回收站中包含 "; rbinfo.i64Size.LowPart; " 个字节"
End If
End Sub
注意：以上的功能有以下 OS 本身及 IE 版本的限制
Windows 95 必须安装 IE 4.0 以后的版本，且必须使用整合界面才行！
Windows NT 4.0 必须安装 IE 4.0 以后的版本，且必须使用整合界面才行！
Windows 98 及 Windows 2000 均已支持！
Windows CE 则根本不支持！
272、如何清空资源回收站？
在问题：如何知道资源回收站中有几个已删除的文件，占了多少空间？中，我们使用了 SHQueryRecycleBin API 查出了资源回收站中目前有多少物件，占了多少 Bytes。那我们要如何在 VB 中来清除资源回收站中的垃圾文件呢？
在进入主题之前，必须先告诉大家，在您清空资源回收站时，系统会自动更改资源回收站的图示变成空桶图示，所以，进行中若有错误发生，您还必须还原资源回收站的图示！
清空资源回收站，我们使用 API SHEmptyRecycleBin Function
还原资源回收站的图示，则是使用 API SHUpdateRecycleBinIcon Function
在声明区中加入以下声明：
Public Const SHERB_NOCONFIRMATION = &H1
Public Const SHERB_NOPROGRESSUI = &H2
Public Const SHERB_NOSOUND = &H4
Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" (ByVal hwnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
Declare Function SHUpdateRecycleBinIcon Lib "shell32.dll" () As Long
参数说明如下：
hwnd：某一个 Window 的 Handle
pszRootPath：资源回收站路径(不一定是根目录)，如果使用空字串，则表示要清空所有资源回收站。
dwFlags：0 或是使用以下之常数：
SHERB_NOCONFIRMATION：表示不显示确认视窗
SHERB_NOPROGRESSUI：表示不显示清空资源回收站的动画视窗 (经测试98原本已不会出现动画)
SHERB_NOSOUND：表示清空资源回收站之后不出现声音
范例如下：清空所有资源回收站中(不显示清空资源回收站的动画视窗)：
Private Sub Command2_Click()
Dim retval As Long ' return value
' 清空所有资源回收站, 不确认
retval = SHEmptyRecycleBin(Form1.hwnd, "", SHERB_NOCONFIRMATION)
' 若有错误讯息出现，则回复资源回收站的图示
' 其实这一点不是很需要
If retval <> 0 Then ' error
retval = SHUpdateRecycleBinIcon()
End If
End Sub
注意：以上的功能有以下 OS 本身及 IE 版本的限制
Windows 95 必须安装 IE 4.0 以后的版本，且必须使用整合界面才行！
Windows NT 4.0 必须安装 IE 4.0 以后的版本，且必须使用整合界面才行！
Windows 98 及 Windows 2000 均已支持！
Windows CE 则根本不支持！
273、如何处理在 Access 数据库中的 Null 值？
Access 的字符串字段可以包含 NULL 值。在读这些字段到 VB 的 String 变量时，会出现运行时间的错误。最好的解决方法是使用 & 操作符将该字段与空串连接：
sString = "" & RS(0)
274、如何在 MIDForm 中控制 KeyPress 事件？
MDIForm 中是没有 KeyPress 事件的， 而在 MDIForm 中加入的 Picture 有， 那么只要在 MDIForm 中动手脚：
Private Sub MDIForm_Activate()
Picture1.SetFocus
End Sub
Private Sub MDIForm_Click()
Picture1.SetFocus
End Sub
Private Sub Picture1_KeyPress(KeyAscii As Integer)
Debug.Print "In KeyPress"
End Sub
275、如何进行位操作？
以下运算符可以直接进行位操作：
And Eqv Imp Not Or Xor
如： 3 or 2 值为 2
276、如何把符串中的一子串替换为另一子串
'替换一行中第一个字符串
Function sReplace(SearchLine As String, SearchFor As String, ReplaceWith As String)
Dim vSearchLine As String, found As Integer
found = InStr(SearchLine, SearchFor): vSearchLine = SearchLine
If found <> 0 Then
vSearchLine = ""
If found > 1 Then vSearchLine = Left(SearchLine, found - 1)
vSearchLine = vSearchLine + ReplaceWith
If found + Len(SearchFor) - 1 < Len(SearchLine) Then _
vSearchLine = vSearchLine + Right$(SearchLine, Len(SearchLine) - found - Len(SearchFor) + 1)
End If
sReplace = vSearchLine
End Function
277、如何把数字转换成汉字大写金额？
'调用方法Text2 = ChMoney(Val(Text1))
' 名称： CCh
' 得到一位数字 N1 的汉字大写
' 0 返回 ""
Private Function CCh(N1) As String
Select Case N1
Case 0
CCh = "零"
Case 1
CCh = "壹"
Case 2
CCh = "贰"
Case 3
CCh = "叁"
Case 4
CCh = "肆"
Case 5
CCh = "伍"
Case 6
CCh = "陆"
Case 7
CCh = "柒"
Case 8
CCh = "捌"
Case 9
CCh = "玖"
End Select
End Function
'名称： ChMoney
'得到数字 N1 的汉字大写
'最大为 千万位
'O 返回 ""
Public Function ChMoney(N1) As String
Dim tMoney As String
Dim lMoney As String
Dim tn '小数位置
Dim s1 As String '临时STRING 小数部分
Dim s2 As String '1000 以内
Dim s3 As String '10000
If N1 = 0 Then
ChMoney = " "
Exit Function
End If
If N1 < 0 Then
ChMoney = "负" + ChMoney(Abs(N1))
Exit Function
End If
tMoney = Trim(Str(N1))
tn = InStr(tMoney, ".") '小数位置
s1 = ""
If tn <> 0 Then
ST1 = Right(tMoney, Len(tMoney) - tn)
If ST1 <> "" Then
t1 = Left(ST1, 1)
ST1 = Right(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s1 = s1 + CCh(Val(t1)) + "角"
End If
If ST1 <> "" Then
t1 = Left(ST1, 1)
s1 = s1 + CCh(Val(t1)) + "分"
End If
End If
ST1 = Left(tMoney, tn - 1)
Else
ST1 = tMoney
End If
s2 = ""
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
s2 = CCh(Val(t1)) + s2
End If
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s2 = CCh(Val(t1)) + "拾" + s2
Else
If Left(s2, 1) <> "零" Then s2 = "零" + s2
End If
End If
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s2 = CCh(Val(t1)) + "佰" + s2
Else
If Left(s2, 1) <> "零" Then s2 = "零" + s2
End If
End If
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s2 = CCh(Val(t1)) + "仟" + s2
Else
If Left(s2, 1) <> "零" Then s2 = "零" + s2
End If
End If
s3 = ""
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
s3 = CCh(Val(t1)) + s3
End If
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s3 = CCh(Val(t1)) + "拾" + s3
Else
If Left(s3, 1) <> "零" Then s3 = "零" + s3
End If
End If
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s3 = CCh(Val(t1)) + "佰" + s3
Else
If Left(s3, 1) <> "零" Then s3 = "零" + s3
End If
End If
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s3 = CCh(Val(t1)) + "仟" + s3
End If
End If
If Right(s2, 1) = "零" Then s2 = Left(s2, Len(s2) - 1)
If Len(s3) > 0 Then
If Right(s3, 1) = "零" Then s3 = Left(s3, Len(s3) - 1)
s3 = s3 & "万"
End If
ChMoney = IIf(s3 & s2 = "", s1, s3 & s2 & "元" & s1)
End Function
278、如何查找替代字符串？
'不知该怎么组织
'1****************************************************************************
Function sReplace(SearchLine As String, SearchFor As String, ReplaceWith As String)
Dim vSearchLine As String, found As Integer
found = InStr(SearchLine, SearchFor)
vSearchLine = SearchLine
If found < 0 Then vSearchLine = ""
If found > 1 Then vSearchLine = Left(SearchLine, found - 1)
vSearchLine = vSearchLine + ReplaceWith
If found + Len(SearchFor) - 1 < Len(SearchLine) Then
vSearchLine = vSearchLine + Right$(SearchLine, Len(SearchLine) - found - Len(SearchFor) + 1)
End If
sReplace = vSearchLine
End Function
'2****************************************************************************
Function sReplace(SearchLine As String, SearchFor As String, ReplaceWith As String)
Dim vSearchLine As String, found As Integer
found = InStr(SearchLine, SearchFor)
vSearchLine = SearchLine
If found < 0 Then vSearchLine = ""
If found > 1 Then
vSearchLine = Left(SearchLine, found - 1)
vSearchLine = vSearchLine + ReplaceWith
If found + Len(SearchFor) - 1 < Len(SearchLine) Then vSearchLine = vSearchLine + Right$(SearchLine, Len(SearchLine) - found - Len(SearchFor) + 1)
End If
sReplace = vSearchLine
sReplace = vSearchLine
279、如何从HTM文件中提取文本？
Public Function StripText(Path As String, FileName As String, ExpandName As String) As String
Dim f, ff, is_tag, write2file, i
Dim strTemp As String
Dim t As String
On Error Resume Next
f = FreeFile
Open Path & FileName & "." & ExpandName For Input As #f ' Open the HTML file in read mode
strTemp = GetTempFile("txt"): StripText = strTemp
ff = FreeFile
Open strTemp For Output As #ff
Do While Not EOF(f)
Line Input #f, t
write2file = ""
For i = 1 To Len(t)
Select Case Mid(t, i, 1)
Case "<"
is_tag = True
Case ">"
is_tag = False
Case Else
If Not is_tag Then write2file = write2file & Mid(t, i, 1)
End Select
Next
Print #ff, write2file
Loop
Close ff
Close f
Close f
280、如何从全路径名中分离出路径？
Function ExtractPath(sFileName) As String
'*******************************************************************
' PURPOSE: This returns just a path name from a full/partial path.
' INPUTS: sFileName - String Data to remove file from.
' OUTPUTS: N/A
' RETURNS: This function returns all the characters from left to the last
' first \. Does NOT check validity of the filename/Path....
'*******************************************************************
Dim nIdx As Integer
For nIdx = Len(sFileName) To 1 Step -1
If Mid$(sFileName, nIdx, 1) = "\" Then
ExtractPath = Mid$(sFileName, 1, nIdx)
Exit Function
End If
Next nIdx
ExtractPath = sFileName
End Function
281、如何从全路径名中提取文件的扩展名？
Option Explicit
Public Function GetExtension(Filename As String)
Dim i, j, PthPos, ExtPos As Integer
For i = Len(Filename) To 1 Step -1 ' Go from the Length of the filename, to the first character by 1.
If Mid(Filename, i, 1) = "." Then ' If the current position is '.' then...
ExtPos = i ' ...Change the ExtPos to the number.
For j = Len(Filename) To 1 Step -1 ' Do the Same...
If Mid(Filename, j, 1) = "\" Then ' ...but for '\'.
PthPos = j ' Change the PthPos to the number.
Exit For ' Since we found it, don't search any more.
End If
Next j
Exit For ' Since we found it, don't search any more.
End If
Next i
If PthPos > ExtPos Then
Exit Function ' No extension.
Else
If ExtPos = 0 Then Exit Function ' If there is not extension, then exit sub.
GetExtension = Mid(Filename, ExtPos + 1, Len(Filename) - ExtPos) 'Messagebox the Extension
End If
End Function
'使用：
'FileExt = GetExtension("c:\windows\vb\vb.exe")
评论