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

　　´作用：去掉字符串中的首尾空格、所有无效字符

　　´测试用例

　　´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

　　´获得指定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