VBFunctionBas/Config.bas

Attribute VB_Name = "Config"
'#######################################用户控件说明#########################################

'名称:配置文件模块

'功能:读取写入INI配置文件

'最后更新日期:2014年5月7日

'创建人:蒋天蓓

'单位:上海市定海水电工程安装有限公司

''====================================控件使用说明=======================================

'用法: 首先 定义iniFileName="文件名" 不需要 加ini后缀
'这就是说，你可以赋值给iniFileName就可以写入记录，而且你可以随时写入不同的ini文件(不管这个文件是否已存在），通过修改这个公用变量。

'清除键：DelInikey (部名,键名)
'清除部：DelIniSec (键名)
'写入数：SetIniN (部名,键名, 写入值)
'读取数：GetIniN (部名,键名, 默认值)
'写入字符：SetIniS (部名,键名, 写入值)
'读取字符：GetIniS (部名,键名, 默认值)

'#######################################模块说明#########################################

Option Explicit
''================================INI文件函数=========================================
Public iniFileName As String
Public DirMode As Boolean
Public DirPath As String
Public ALLDirPath As String
Public ReSetDirPath As Boolean
Private FileDir As String
Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Private 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
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

'========================================INI配置文件模块=====================================================

'****************************************获取Ini字符串值(Function)******************************************
Public Function GetIniS(ByVal SectionName As String, ByVal KeyWord As String, Optional ByVal DefString As String) As String
    Dim ResultString As String * 144, Temp As Integer
    Dim S As String, i As Integer
    Temp% = GetPrivateProfileString(SectionName, KeyWord, "", ResultString, 144, AppProFileName(iniFileName))
    '检索关键词的值
    If Temp% > 0 Then    '关键词的值不为空
        '        s = Mid$(ResultString, 1, Temp%)
        For i = 1 To 144
            If Asc(Mid$(ResultString, i, 1)) = 0 Then
                Exit For
            Else
                S = S & Mid$(ResultString, i, 1)
            End If
        Next
    Else
        If DefString <> vbNullString Then
            Temp% = WritePrivateProfileString(SectionName, KeyWord, DefString, AppProFileName(iniFileName))
            '将缺省值写入INI文件
            S = DefString
        Else
            S = ""
        End If
    End If
    GetIniS = S
End Function

'**************************************获取Ini数值(Function)***************************************************
Public Function GetIniN(ByVal SectionName As String, ByVal KeyWord As String, ByVal DefValue As Long) As Integer
    Dim D As Long, S As String
    D = DefValue
    GetIniN = GetPrivateProfileInt(SectionName, KeyWord, DefValue, AppProFileName(iniFileName))
    If D <> DefValue Then
        S = "" & D
        D = WritePrivateProfileString(SectionName, KeyWord, S, AppProFileName(iniFileName))
    End If
End Function

'***************************************写入字符串值(Sub)**************************************************
Public Sub SetIniS(ByVal SectionName As String, ByVal KeyWord As String, ByVal ValStr As String)
    Dim res%
    res% = WritePrivateProfileString(SectionName, KeyWord, ValStr, AppProFileName(iniFileName))
End Sub

'****************************************写入数值(Sub)******************************************************
Public Sub SetIniN(ByVal SectionName As String, ByVal KeyWord As String, ByVal ValInt As Long)
    Dim res%, S$
    S$ = Str$(ValInt)
    res% = WritePrivateProfileString(SectionName, KeyWord, S$, AppProFileName(iniFileName))
End Sub

'***************************************清除KeyWord"键"(Sub)*************************************************
Public Sub DelIniKey(ByVal SectionName As String, ByVal KeyWord As String)
    Dim retval As Integer
    retval = WritePrivateProfileString(SectionName, KeyWord, 0&, AppProFileName(iniFileName))
End Sub

'**************************************清除 Section"段"(Sub)***********************************************
Public Sub DelIniSec(ByVal SectionName As String)    '清除section
    Dim retval As Integer
    retval = WritePrivateProfileString(SectionName, 0&, "", AppProFileName(iniFileName))
End Sub

'*************************************定义Ini文件名(Function)***************************************************
'定义ini文件名
Public Function AppProFileName(iniFileName)
    If InStr(1, iniFileName, ":") <> 0 Then
        AppProFileName = iniFileName
    Else
        If Right(App.Path, 1) <> "\" Then AppProFileName = App.Path & "\"
        ALLDirPath = AppProFileName
        If DirMode Then
            AppProFileName = AppProFileName & DirPath & "\"
            ALLDirPath = AppProFileName
            If ReSetDirPath Then
                FileDir = Dir(ALLDirPath & "\*")
                While FileDir <> ""
                    Kill ALLDirPath & "\" & FileDir
                    FileDir = Dir(ALLDirPath & "\*")
                Wend
                ReSetDirPath = False
            End If
            If Dir(AppProFileName, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly) = "" Then
                MkDir AppProFileName
            End If
        End If
        AppProFileName = AppProFileName & iniFileName & ".ini"
    End If
End Function
'========================================INI配置文件模块=====================================================