作者: blsoft 时间: 2004-4-11 23:45
版主在吗？这个问题困扰我几天了，能否帮忙解决？多谢！！！！
在此附上我读取的代码
Public Function ReadLinkDB(str模块 As String)‘str模块对应的INI中[]中的标题
Dim i As Integer
Dim str As String
Dim strType As String
Dim strtp模块 As String
Dim strTitle As String
Dim stm As New ADODB.Stream
'判断文件是否存在
If Nz(Dir(Nz(str, "")), "") = "" Then
ReadLinkDB = ""
MsgBox "程序目录中的文件 LogoInfo.ini文件被删除！", vbOKOnly + vbExclamation, strMsg_Con
Exit Function
End If
Dim tpStr As String
stm.Position = 0
Do While (Not stm.EOS)
str = Trim(stm.ReadText(adReadLine))
If str = "[" & Trim(str模块) & "]" Then
strtp模块 = str
End If
If Not strtp模块 = "" Then
If Left(str, 1) = "[" And str <> strtp模块 Then '不是本模块的定义
Exit Do
Else
i = 1
Do While Not i = Len(str) + 1
tpStr = tpStr & Mid(str, i, 1)
If Mid(str, i, 1) = "=" Then
strType = Left(tpStr, Len(tpStr) - 1)
tpStr = ""
End If
i = i + 1
Loop
If strType = "title" Then
strTitle = tpStr
End If
tpStr = ""
End If
End If
Loop
If strTitle = "" Then
ReadLinkDB = "未知标题"
Else
ReadLinkDB = strTitle
End If
End Function
'文件名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 Function
Public 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 Function
Public 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 作者: zhuyiwen 时间: 2004-4-12 00:52
以上是VB中的代码，App.Path用CurrentProject.Path代替作者: zhuyiwen 时间: 2004-4-12 00:58
读写INI文件，通常都是通过API来完成的
定义：
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 WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
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 Sub Form_Load()
'Sample for reading a numbers directly on the INI file
'Write a number 55 on the sample.ini to be read
WritePrivateProfileString "Sample", "Sample", "55", App.Path & "\sample.ini"
'Then, read the stored number
'No need to convert the value returned
MsgBox GetPrivateProfileInt("Sample", "Sample", 0, App.Path & "\sample.ini")
End Sub
定义：
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
举例：
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
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
Private Sub Form_Load()
' We will create a new section in the INI-file
' It's output will be:
'
' [SectionName]
' Key=Value
'
' Note that used this ONLY if you are creating a new
' section on the INI file, unless you wanted to erase
' its existing keys.
Call WritePrivateProfileSection("SectionName", "Key=Value", App.Path & "\sample.ini")
Dim szBuf As String * 255
Call GetPrivateProfileSection("SectionName", szBuf, 255, App.Path & "\sample.ini")
MsgBox szBuf
End Sub
定义：
Declare Function GetPrivateProfileSectionNames Lib "kernel32.dll" Alias "GetPrivateProfileSectionNamesA" (ByVal lpszReturnBuffer As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
举例：
'Note : Need one listbox named List1
Private Declare Function GetPrivateProfileSectionNames Lib "kernel32.dll" Alias "GetPrivateProfileSectionNamesA" (ByVal lpszReturnBuffer As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Sub Form_Load()
Dim szBuf As String, Length As Integer
Dim SectionArr() As String, m As Integer
szBuf = String$(255, 0)
Length = GetPrivateProfileSectionNames(szBuf, 255, vbNullChar)
szBuf = Left$(szBuf, Length)
SectionArr = Split(szBuf, vbNullChar)
For m = 0 To UBound(SectionArr)
List1.AddItem SectionArr(m)
Next m
End Sub
定义：
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 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 Strin作者: blsoft 时间: 2004-4-12 02:14
已收藏，多谢多谢。
我这一阵子的思路都被stream这个对象给绕进去了，看来想问题要从多方面着手啊，真的多谢了。