小山:請問用那個API函數不行嗎?GetPrivateProfileString 

解决方案 »

  1.   

    我的全部代码如下:读写INI文件的四个函数'文件名SourceDB.ini文件
    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文件,固定节点setting,in_key为写入/读取的主键
    '仅仅针对是非值
    'Y:yes,N:no,E:error
    Public Function GetIniTF(ByVal In_Key As String) As Boolean
    On Error GoTo GetIniTFErr
    GetIniTF = True
    Dim GetStr As String
    GetStr = VBA.String(128, 0)
    GetPrivateProfileString "Setting", In_Key, "", GetStr, 256, App.Path & "\SourceDB.ini"
    GetStr = VBA.Replace(GetStr, VBA.Chr(0), "")
    If GetStr = "1" Then
       GetIniTF = True
       GetStr = ""
    Else
       GoTo GetIniTFErr
    End If
    Exit Function
    GetIniTFErr:
       Err.Clear
       GetIniTF = False
       GetStr = ""
    End FunctionPublic Function WriteIniTF(ByVal In_Key As String, ByVal In_Data As Boolean) As Boolean
    On Error GoTo WriteIniTFErr
    WriteIniTF = True
    If In_Data = True Then
     WritePrivateProfileString "Setting", In_Key, "1", App.Path & "\SourceDB.ini"
    Else
     WritePrivateProfileString "Setting", In_Key, "0", App.Path & "\SourceDB.ini"
    End If
    Exit Function
    WriteIniTFErr:
       Err.Clear
       WriteIniTF = False
    End Function
    '以下两个函数,读/写ini文件,不固定节点,in_key为写入/读取的主键
    '针对字符串值
    '空值表示出错
    Public Function GetIniStr(ByVal AppName As String, ByVal In_Key As String) As String
    On Error GoTo GetIniStrErr
    If VBA.Trim(In_Key) = "" Then
       GoTo GetIniStrErr
    End If
    Dim GetStr As String
    GetStr = VBA.String(128, 0)
     GetPrivateProfileString AppName, In_Key, "", GetStr, 256, App.Path & "\SourceDB.ini"
      GetStr = VBA.Replace(GetStr, VBA.Chr(0), "")
    If GetStr = "" Then
       GoTo GetIniStrErr
    Else
       GetIniStr = GetStr
       GetStr = ""
    End If
    Exit Function
    GetIniStrErr:
       Err.Clear
       GetIniStr = ""
       GetStr = ""
    End FunctionPublic Function WriteIniStr(ByVal AppName As String, ByVal In_Key As String, ByVal In_Data As String) As Boolean
    On Error GoTo WriteIniStrErr
    WriteIniStr = True
    If VBA.Trim(In_Data) = "" Or VBA.Trim(In_Key) = "" Or VBA.Trim(AppName) = "" Then
       GoTo WriteIniStrErr
    Else
     WritePrivateProfileString AppName, In_Key, In_Data, App.Path & "\SourceDB.ini"
    End If
    Exit Function
    WriteIniStrErr:
       Err.Clear
       WriteIniStr = False
    End Function
           以上代码来自: 源代码数据库(SourceDataBase)
               当前版本: 1.0.531
                   作者: Shawls
               个人主页: Http://Shawls.Yeah.Net
                 E-Mail: [email protected]
                     QQ: 9181729
      

  2.   

    我得代码:读写INI文件的四个函数'文件名SourceDB.ini文件
    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文件,固定节点setting,in_key为写入/读取的主键
    '仅仅针对是非值
    'Y:yes,N:no,E:error
    Public Function GetIniTF(ByVal In_Key As String) As Boolean
    On Error GoTo GetIniTFErr
    GetIniTF = True
    Dim GetStr As String
    GetStr = VBA.String(128, 0)
    GetPrivateProfileString "Setting", In_Key, "", GetStr, 256, App.Path & "\SourceDB.ini"
    GetStr = VBA.Replace(GetStr, VBA.Chr(0), "")
    If GetStr = "1" Then
       GetIniTF = True
       GetStr = ""
    Else
       GoTo GetIniTFErr
    End If
    Exit Function
    GetIniTFErr:
       Err.Clear
       GetIniTF = False
       GetStr = ""
    End FunctionPublic Function WriteIniTF(ByVal In_Key As String, ByVal In_Data As Boolean) As Boolean
    On Error GoTo WriteIniTFErr
    WriteIniTF = True
    If In_Data = True Then
     WritePrivateProfileString "Setting", In_Key, "1", App.Path & "\SourceDB.ini"
    Else
     WritePrivateProfileString "Setting", In_Key, "0", App.Path & "\SourceDB.ini"
    End If
    Exit Function
    WriteIniTFErr:
       Err.Clear
       WriteIniTF = False
    End Function
    '以下两个函数,读/写ini文件,不固定节点,in_key为写入/读取的主键
    '针对字符串值
    '空值表示出错
    Public Function GetIniStr(ByVal AppName As String, ByVal In_Key As String) As String
    On Error GoTo GetIniStrErr
    If VBA.Trim(In_Key) = "" Then
       GoTo GetIniStrErr
    End If
    Dim GetStr As String
    GetStr = VBA.String(128, 0)
     GetPrivateProfileString AppName, In_Key, "", GetStr, 256, App.Path & "\SourceDB.ini"
      GetStr = VBA.Replace(GetStr, VBA.Chr(0), "")
    If GetStr = "" Then
       GoTo GetIniStrErr
    Else
       GetIniStr = GetStr
       GetStr = ""
    End If
    Exit Function
    GetIniStrErr:
       Err.Clear
       GetIniStr = ""
       GetStr = ""
    End FunctionPublic Function WriteIniStr(ByVal AppName As String, ByVal In_Key As String, ByVal In_Data As String) As Boolean
    On Error GoTo WriteIniStrErr
    WriteIniStr = True
    If VBA.Trim(In_Data) = "" Or VBA.Trim(In_Key) = "" Or VBA.Trim(AppName) = "" Then
       GoTo WriteIniStrErr
    Else
     WritePrivateProfileString AppName, In_Key, In_Data, App.Path & "\SourceDB.ini"
    End If
    Exit Function
    WriteIniStrErr:
       Err.Clear
       WriteIniStr = False
    End Function
           以上代码来自: 源代码数据库(SourceDataBase)
               当前版本: 1.0.531
                   作者: Shawls
               个人主页: Http://Shawls.Yeah.Net
                 E-Mail: [email protected]
                     QQ: 9181729
      

  3.   


    我主要是想参考一下!
     可以mail给我么?[email protected]