VB几个有用的函数

注释: ———————— ( 1 ) ————————————
注释:获得指定 ini 文件中某个节下面的所有键值 TrueZq,, 需要下面的 API 声明
注释: Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
注释:返回一个字符串数组
注释:调用举例:
注释: Dim arrClass() As String
注释: arrClass = GetInfoSection("class", "d:\type.ini")

Public Function GetInfoSection(strSection As String, strIniFile As String) As String()
Dim strReturn As String * 32767
Dim strTmp As String
Dim nStart As Integer, nEnd As Integer, i As Integer
Dim sArray() As String

Call GetPrivateProfileSection(strSection, strReturn, Len(strReturn), strIniFile)

strTmp = strReturn
i = 1
Do While strTmp <> ""
nStart = nEnd + 1
nEnd = InStr(nStart, strReturn, vbNullChar)
strTmp = Mid$(strReturn, nStart, nEnd - nStart)
If Len(strTmp) > 0 Then
ReDim Preserve sArray(1 To i)
sArray(i) = strTmp
i = i + 1
End If

Loop
GetInfoSection = sArray
End Function

注释: ———————— ( 2 ) ————————————
注释:作用:去掉字符串中的首尾空格、所有无效字符
注释:测试用例
注释: Dim strRes As String
注释: Dim strSour As String
注释:
注释: strSour = " " & vbNullChar & vbNullChar & " ab cd" & vbNullChar
注释: strRes = zqTrim(strSour)
注释: MsgBox " 长度 =" & Len(strSour) & " 值 =111" & strRes & "222"
Public Function zqTrim(ByVal strSour As String) As String
Dim strTmp As String
Dim nLen As Integer
Dim i As Integer, j As Integer
Dim strNow As String, strValid() As String, strNew As String
注释: strNow 当前字符
注释: strValid 有效字符
注释: strNew 最后生成的新字符

strTmp = Trim$(strSour)
nLen = Len(strTmp)
If nLen < 1 Then
zqTrim = ""
Exit Function
End If
j = 0
For i = 1 To nLen
strNow = Mid(strTmp, i, 1) 注释:每次读取一个字符
注释: MsgBox Asc(strNow)
If strNow <> vbNullChar And Asc(strNow) <> 9 Then 注释:如果有效,则存入有效数组
ReDim Preserve strValid(j)
strValid(j) = strNow
j = j + 1
End If

Next i

strNew = Join(strValid, "") 注释:将所有有效字符连接起来
zqTrim = Trim$(strNew) 注释:去掉字符串中的首尾空格
End Function

注释: ———————— ( 3 ) ————————————
注释:检查文件是否存在 , 存在返回 TRUE, 否则返回 FALSE
Public Function CheckFileExist(strFile As String) As Boolean

If Dir(strFile, vbDirectory) <> "" Then
CheckFileExist = True
Else
CheckFileExist = False
End If
End Function

注释: ———————— ( 4 ) ————————————
注释:获得指定 ini 文件中某个节下面某个子键的键值 , 需要下面的 API 声明
注释: Public Declare Function GetPrivateProfileString Lib "kernel32" Alias _
注释: "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
注释: ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString _
注释: As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
注释:返回一个字符串
注释:调用举例:
注释: Dim strRun As String
注释: strRun = GetiniValue("Windows","Run", "C:\Windows\Win.ini")

Public Function GetiniValue(ByVal lpKeyName As String, ByVal strName As String, ByVal strIniFile As String) As String
Dim strTmp As String * 255

Call GetPrivateProfileString(lpKeyName, strName, "", _
strTmp, Len(strTmp), strIniFile)
GetiniValue = Left$(strTmp, InStr(strTmp, vbNullChar) - 1)

End Function

注释: ———————— ( 5 ) ————————————
注释:获得 Windows 目录 , 需要下面的 API 声明
注释: Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
注释:返回一个字符串,如 “C:\Windows” 、 “C:\Winnt”
注释:调用举例:
注释: Dim strWindir As String
注释: strWindir = GetWinDir()
Private Function GetWinDir()
Dim windir As String * 100
Call GetWindowsDirectory(windir, 100)
GetWinDir = Left$(windir, InStr(windir, vbNullChar) - 1)

End Function

注释: ———————— ( 6 ) ————————————
注释:获得 Windows 系统目录 , 需要下面的 API 声明
注释: Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
注释:返回一个字符串,如 “C:\Windows\System” 、 “C:\Winnt\System32”
注释:调用举例:
注释: Dim strSysDir As String
注释: strSysDir = GetSystemDir()
Private Function GetSystemDir()
Dim strSysDir As String * 100
Call GetSystemDirectory(strSysDir, 100)
GetSystemDir = Left$(strSysDir, InStr(strSysDir, vbNullChar) - 1)

End Function

Published At
Categories with Web编程
Tagged with
comments powered by Disqus