http://www.symental.com/sfw/?f=IniExample
Attribute VB_Name = "Module1" 'Public Part '--------------------------------------------------------------------------- ' ReadKeyVal FileName,Section,Key ' ~~~~~~~~读取FileName文件中的段Section下的关键字Key的值KeyValue ' WriteKeyVal FileName,Key,KeyValue ' ~~~~~~~~写入值KeyValue到FileName文件中的段Section下的关键字Key '---------------------------------------------------------------------------- ' DeleteSection FileName,Section ' ~~~~~~~~删除FileName文件中的段Section ' DeleteKey FileName,Key ' ~~~~~~~~删除FileName文件中的段Section下的关键字Key ' DeleteKeyValue FileName,Key ' ~~~~~~~~删除FileName文件中的段Section下的关键字Key的KeyValue '---------------------------------------------------------------------------- ' TotalSections FileName ' ~~~~~~~~统计FileName文件中的段Section的总数 ' TotalKeys FileName ' ~~~~~~~~统计FileName文件中的关键字Key的总数 ' NumKeys FileName,Section ' ~~~~~~~~统计FileName文件中的段Section下的关键字Key的总数 '---------------------------------------------------------------------------- ' RenameSection FileName,NewSectionName ' ~~~~~~~~使用值NewSectionName替换FileName文件中的段Section ' RenameKey FileName,KeyName,NewKeyName ' ~~~~~~~~使用值NewKeyName替换FileName文件中的段Section下的关键字Key '---------------------------------------------------------------------------- ' GetKey FileName,KeyIndexNum,' ~~~~~~~~获得FileName文件中的段Section下的Key索引为KeyIndexNum的Key ' GetKey2 FileName,SectionIndexNum,KeyIndexNum ' ~~~~~~~~获得FileName文件中的段索引为Section下的Key索引为KeyIndexNum的Key ' GetSection FileName,SectionIndexNum ' ~~~~~~~~获得FileName文件中的段索引为Section下的Section '---------------------------------------------------------------------------- ' GetSectionIndex FileName,Section ' ~~~~~~~~获得FileName文件中的段Section的索引 ' GetKeyIndex FileName,Key ' ~~~~~~~~获得FileName文件中的段Section下的关键字Key的索引 ' GetKeyIndex2 FileName,Key ' ~~~~~~~~获得FileName文件中的段索引为Section下的关键字Key的索引 '---------------------------------------------------------------------------- ' KeyExist FileName,Key ' ~~~~~~~~检测是FileName文件中的段Section下的Key是否存在 ' KeyExist2 FileName,Key ' ~~~~~~~~检测是FileName文件中的段索引为Section下的Key是否存在 ' SectionExist FileName,Section ' ~~~~~~~~检测是FileName文件中的段Section是否存在 '---------------------------------------------------------------------------- 'Private Part '---------------------------------------------------------------------------- ' IsKey TextLine ' ~~~~~~~~检测是TextLine是否是Key行 ' IsSection TextLine ' ~~~~~~~~检测是TextLine是否是Section行 '---------------------------------------------------------------------------- '********************************************** 'ini AllOperation .bas ' '********************************************** '-------------------------------------------------'-------------------------------------------------' ' .ini file all operation bas '-------------------------------------------------'-------------------------------------------------' 'Format of .ini file '---------------------------------------------------- '[Section 1] 'Key 1=Key1Value '[Section 2] 'Key 1=Key1Value 'Key 2=Key2Value 'Key 3=Key3Value 'Key 4=Key4Value 'Key 5=Key5Value '[Section 3] 'Key 1=Key1Value 'Key 2=Key2Value 'Key 3=Key3Value '---------------------------------------------------- 'Function list '------------------------------------------------------------------------------------------------ ' Name Parameter ' ReadKeyVal FileName,Key ' WriteKeyVal FileName,KeyValue ' DeleteSection FileName,Section ' DeleteKey FileName,Key ' DeleteKeyValue FileName,Key ' TotalSections FileName ' TotalKeys FileName ' NumKeys FileName,Section ' RenameSection FileName,NewSectionName ' RenameKey FileName,NewKeyName ' GetKey FileName,' GetKey2 FileName,KeyIndexNum ' GetSection FileName,SectionIndexNum ' IsKey TextLine ' IsSection TextLine ' KeyExists FileName,Key ' KeyExists2 FileName,Key ' SectionExists FileName,Section ' GetSectionIndex FileName,Section ' GetKeyIndex FileName,Key ' GetKeyIndex2 FileName,Key '------------------------------------------------------------------------------------------------ Option Explicit 'APIs to access INI files and retrieve data 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 Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String,ByVal lpString As Any,ByVal lpFileName As String) As Long ' '------ Base part for operations ( use api access method ) ------ '------ Read or Write ------ Function ReadKeyVal(ByVal FileName As String,ByVal Section As String,ByVal Key As String) As String 'Returns info from an INI file Dim RetVal As String,Worked As Integer GetKeyVal = "" If Dir(FileName) = "" Then MsgBox FileName & " not found.",vbCritical,"File Not Found": Exit Function RetVal = String$(255,Chr(0))) Worked = GetPrivateProfileString(Section,"",RetVal,Len(RetVal),FileName) ReadKeyVal = IIf(Worked = 0,Left(RetVal,InStr(RetVal,Chr(0)) - 1)) End Function '------ Function WriteKeyVal(ByVal FileName As String,ByVal Key As String,ByVal KeyValue As String) As Long 'Add info to an INI file 'Function returns non 0 if successful and 0 if unsuccessful WriteKeyVal = 0 If Dir(FileName) = "" Then MsgBox FileName & " not found.","File Not Found": Exit Function WriteKeyVal = WritePrivateProfileString(Section,KeyValue,FileName) End Function '--------------------------- '------ Delete Section or Key or KeyValue ------ Function DeleteSection(ByVal FileName As String,ByVal Section As String) As Long 'Delete an entire section and all it's keys from a given INI file 'Function returns non 0 if successful and 0 if unsuccessful DeleteSection = 0 If Dir(FileName) = "" Then MsgBox FileName & " not found.","File Not Found": Exit Function If Not SectionExists(FileName,Section) Then MsgBox "Section," & Section & ",Not Found. ~(DeleteSection)" & vbCrLf & "Verify spelling and capitilization is correct. Case-sensative.",vbInformation,"Section Not Found.": Exit Function DeleteSection = WritePrivateProfileString(Section,vbNullString,FileName) End Function '------ Function DeleteKey(ByVal FileName As String,ByVal Key As String) As Long 'Delete a key from an INI file 'Function returns non 0 if successful and 0 if unsuccessful DeleteKey = 0 If Dir(FileName) = "" Then MsgBox FileName & " not found.",Not Found. ~(DeleteKey)" & vbCrLf & "Verify spelling and capitilization is correct. Case-sensative.","Section Not Found.": Exit Function If Not KeyExists(FileName,Key) Then MsgBox "Key," & Key & ","Key Not Found.": Exit Function DeleteKey = WritePrivateProfileString(Section,FileName) End Function '------ Function DeleteKeyValue(ByVal FileName As String,ByVal Key As String) As Integer 'Delete a key's value from an INI file 'Function returns no 0 if successful and 0 if unsuccessful DeleteKeyValue = 0 If Dir(FileName) = "" Then MsgBox FileName & " not found.",Not Found. ~(DeleteKeyValue)" & vbCrLf & "Verify spelling and capitilization is correct. Case-sensative.","Key Not Found.": Exit Function DeleteKeyValue = WritePrivateProfileString(Section,FileName) End Function '--------------------------------------------------------------------------------------------------------------------------- '------ Extend part for other operations ( Only use sequence file access method ) ------ '------ Total Sections or Keys ------ Public Function TotalSections(ByVal FileName As String) As Long 'Returns the total number of sections in a given INI file Dim Counter As Long Dim InputData As String Dim fNum As Byte If Dir(FileName) = "" Then MsgBox FileName & " not found.","File Not Found": Exit Function Counter = 0 fNum = FreeFile Open FileName For Input As #fNum Do While Not EOF(fNum) Line Input #fNum,InputData If IsSection(InputData) Then Counter = Counter + 1 Loop Close #fNum TotalSections = Counter End Function '------ Public Function TotalKeys(ByVal FileName As String) As Long 'Returns the total number of keys in a given INI file Dim Counter As Long Dim InputData As String Dim Looper As Integer Dim fNum As Byte If Dir(FileName) = "" Then MsgBox FileName & " not found.",InputData If IsKey(InputData) Then Counter = Counter + 1 Loop Close #fNum TotalKeys = Counter End Function '--------------------------------------------------------------------------------------------------------------------------- '------ NumKeys in Section ------ Public Function NumKeys(ByVal FileName As String,ByVal Section As String) As Long 'Returns the total number of keys in 1 given section. Dim Counter As Long Dim InputData As String Dim Looper As Integer Dim InZone As Boolean Dim fNum As Byte If Dir(FileName) = "" Then MsgBox FileName & " not found.",Not Found. ~(NumKeys)" & vbCrLf & "Verify spelling and capitilization is correct. Case-sensative.","Section Not Found.": Exit Function InZone = False Counter = 0 fNum = FreeFile Open FileName For Input As #fNum Do While Not EOF(fNum) Line Input #fNum,InputData If InZone Then If IsSection(InputData) Or EOF(fNum) Then If EOF(fNum) Then NumKeys = Counter + 1 Else NumKeys = Counter End If Exit Do Else If IsKey(InputData) Then Counter = Counter + 1 End If Else If InputData = "[" & Section & "]" Then InZone = True End If End If Loop Close #fNum End Function '--------------------------------------------------------------------------------------------------------------------------- '------ Rename Section or Key Public Function RenameSection(ByVal FileName As String,ByVal SectionName As String,ByVal NewSectionName As String) As Boolean 'Renames a section in a given INI file. 'Function returns true if successful and false if unsuccessful Dim TopKeys As String Dim BotKeys As String Dim Looper As Integer Dim InputData As String Dim InZone As Boolean Dim Key1 As String,Key2 As String Dim fNum1 As Byte,fNum2 As Byte RenameSection = False 'unsuccessful If Dir(FileName) = "" Then MsgBox FileName & " not found.",SectionName) Then MsgBox "Section," & SectionName & ",Not Found. ~(RenameSection)" & vbCrLf & "Verify spelling and capitilization is correct. Case-sensative.","Section Not Found.": RenameSection = 0: Exit Function If SectionExists(FileName,NewSectionName) Then MsgBox NewSectionName & " allready exists. ~(RenameSection)","Duplicate Section": RenameSection = 0: Exit Function InZone = False fNum1 = FreeFile Open FileName For Input As #fNum1 Do While Not EOF(fNum1) Line Input #fNum1,InputData If InZone Then If Not EOF(fNum1) Then 'If BotKeys = "" Then BotKeys = InputData Else BotKeys = BotKeys & vbCrLf & InputData BotKeys = IIf(BotKeys = "",InputData,BotKeys & vbCrLf & InputData) 'keep bot data Else 'file old eof then process Close #fNum1 Kill FileName 'Recreate ini file whicn is the section has renamed fNum2 = FreeFile Open FileName For Append As #fNum2 If TopKeys <> "" Then Print #fNum2,TopKeys 'Write top data Print #fNum2,"[" & NewSectionName & "]" & vbCrLf & BotKeys 'Write name and bot data Close #fNum2 RenameSection = True 'successful Exit Function End If Else If InputData = "[" & SectionName & "]" Then 'compare sectionname InZone = True 'sectionname correct flag = true Else 'If TopKeys = "" Then TopKeys = InputData Else TopKeys = TopKeys & vbCrLf & InputData TopKeys = IIf(TopKeys = "",TopKeys & vbCrLf & InputData) 'keep top data End If End If Loop Close #fNum1 End Function '------ Public Function RenameKey(ByVal FileName As String,ByVal KeyName As String,ByVal NewKeyName As String) As Boolean 'Renames a key in a given INI file 'Function returns 1 if successful and 0 if unsuccessful Dim KeyVal As String RenameKey = False 'err process If Dir(FileName) = "" Then MsgBox FileName & " not found.","File Not Found": RenameKey = 0: Exit Function If Not SectionExists(FileName,Not Found. ~(RenameKey)" & vbCrLf & "Verify spelling and capitilization is correct. Case-sensative.","Section Not Found.": RenameKey = 0: Exit Function If Not KeyExists(FileName,KeyName) Then MsgBox "Key," & KeyName & ","Key Not Found.": RenameKey = 0: Exit Function If KeyExists(FileName,NewKeyName) Then MsgBox NewKeyName & " allready exists in the section," & Section & ". ~(RenameKey)","Duplicate Key.": RenameKey = 0: Exit Function KeyVal = GetKeyVal(FileName,KeyName) If DeleteKey(FileName,KeyName) = 0 Then Exit Function If WriteKeyVal(FileName,NewKeyName,KeyVal) = 0 Then Exit Function RenameKey = True End Function '--------------------------------------------------------------------------------------------------------------------------- '------ Get Key or Section Public Function GetKey(ByVal FileName As String,ByVal KeyIndexNum As Integer) As String 'This function returns the name of a key which is identified by it's IndexNumber. 'The Section is identified as Text - GetKey2 identifies Section by it's IndexNumber 'IndexNumbers begin at 0 and increment up Dim Counter As Integer Dim InputData As String,KeyName As String Dim InZone As Boolean Dim Looper As Integer Dim fNum As Byte GetKey = "" If Dir(FileName) = "" Then MsgBox FileName & " not found.",Not Found. ~(GetKey)" & vbCrLf & "Verify spelling and capitilization is correct. Case-sensative.","Section Not Found.": Exit Function If NumKeys(FileName,Section) - 1 < KeyIndexNum Then MsgBox KeyIndexNum & ",not a valid Key Index Number. ~(GetKey)","Invalid Index Number.": Exit Function 'init Counter = -1 fNum = FreeFile Open FileName For Input As #fNum Do While Not EOF(fNum) Line Input #fNum,InputData If InZone Then If IsKey(InputData) Then 'the current data is the key Counter = Counter + 1 If Counter = KeyIndexNum Then 'find the correct keyindexnum For Looper = 1 To Len(InputData) If Mid(InputData,Looper,1) = "=" Then GetKey = KeyName 'return keyname Exit Do Else KeyName = KeyName & Mid(InputData,1) 'keep "=" left data End If Next Looper End If End If Else If InputData = "[" & Section & "]" Then InZone = True 'find the correct section End If Loop Close #fNum End Function '------ Public Function GetKey2(ByVal FileName As String,ByVal SectionIndexNum As Integer,ByVal KeyIndexNum As Integer) As String 'This function returns the name of a key which is identified by it's IndexNumber. 'The Section is identified by it's IndexNumber 'IndexNumbers begin at 0 and increment up Dim Counter As Integer Dim Counter2 As Integer Dim InputData As String,KeyName As String Dim InZone As Boolean Dim Looper As Integer Dim fNum As Byte GetKey2 = "" 'error process If Dir(FileName) = "" Then MsgBox FileName & " not found.","File Not Found": Exit Function If TotalSections(FileName) - 1 < SectionIndexNum Then MsgBox SectionIndexNum & ",not a valid Section Index Number. ~(GetKey2)","Invalid Index Number.": Exit Function If NumKeys(FileName,GetSection(FileName,SectionIndexNum)) - 1 < KeyIndexNum Then MsgBox KeyIndexNum & ",not a valid Key Index Number. ~(GetKey2)","Invalid Index Number.": Exit Function 'init Counter = -1 Counter2 = -1 fNum = FreeFile Open FileName For Input As #fNum Do While Not EOF(fNum) Line Input #fNum,InputData If InZone Then 'the secrtionindexnum is correct If IsKey(InputData) Then 'the inputdata is the key Counter = Counter + 1 If Counter = KeyIndexNum Then 'the index is the kenindexnum For Looper = 1 To Len(InputData) If Mid(InputData,1) = "=" Then GetKey2 = KeyName 'return keyname Exit Do Else KeyName = KeyName & Mid(InputData,1) 'keep "=" left data End If Next Looper End If End If Else If IsSection(InputData) Then 'current inputdata is the section Counter2 = Counter2 + 1 If Counter2 = SectionIndexNum Then InZone = True 'find the correct sectionindexnum End If End If Loop Close #fNum End Function '------ Public Function GetSection(ByVal FileName As String,ByVal SectionIndexNum As Integer) As String 'Returns a section name which is identified by it's indexnumber 'IndexNumbers begin at 0 and increment up Dim InputData As String Dim Counter As Integer Dim fNum As Byte GetSection = "" If Dir(FileName) = "" Then MsgBox FileName & " not found.",not a valid Section Index Number. ~(GetSection)","Invalid Index Number.": Exit Function Counter = -1 fNum = FreeFile Open FileName For Input As #fNum Do While Not EOF(fNum) Line Input #fNum,InputData If IsSection(InputData) Then 'the inputdata is section Counter = Counter + 1 'InputData = Right(InputData,Len(InputData) - 1) 'InputData = Left(InputData,Len(InputData) - 1) InputData = Mid(InputData,2,Len(InputData) - 2) If Counter = SectionIndexNum Then GetSection = InputData: Exit Do End If Loop Close #fNum End Function '--------------------------------------------------------------------------------------------------------------------------- '------ Is Key or Section------ Private Function IsKey(ByVal TextLine As String) As Boolean 'This function determines whether or not a line of text is a valid Key (ex. "This=key") 'This returns True or False Dim Looper As Integer IsKey = False If TextLine = "" Then Exit Function 'For Looper = 1 To Len(TextLine) ' If Mid(TextLine,1) = "=" Then IsKey = True: Exit For 'Next Looper If InStr(TextLine,"=") <> 0 Then IsKey = True End Function '------ Private Function IsSection(ByVal TextLine As String) As Boolean 'This function determines whether or not a line of text is a 'valid section (ex. "[section]") 'This return's True or False Dim FirstChar As String,LastChar As String IsSection = False If TextLine = "" Then Exit Function FirstChar = Mid(TextLine,1,1) LastChar = Mid(TextLine,Len(TextLine),1) If FirstChar = "[" And LastChar = "]" Then IsSection = True End Function '--------------------------------------------------------------------------------------------------------------------------- '------ Key or Section Exist ----- Public Function KeyExists(ByVal FileName As String,ByVal Key As String) As Boolean 'This function determines if a key exists in a given section 'The Section is identified as Text - KeyExists2 identifies Section by its IndexNumber 'This returns True or False Dim InZone As Boolean Dim InputData As String Dim Looper As Integer Dim fNum As Byte KeyExists = False If Dir(FileName) = "" Then MsgBox FileName & " not found.",Not Found. ~(KeyExists)" & vbCrLf & "Verify spelling and capitilization is correct. Case-sensative.","Section Not Found.": Exit Function fNum = FreeFile InZone = False Open FileName For Input As #fNum Do While Not EOF(fNum) Line Input #fNum,InputData 'find the correct section ? If InZone Then If IsKey(InputData) Then 'the inputdata is the key If Left(InputData,Len(Key)) = Key Then 'the inputdata is the key KeyExists = True 'return true Exit Do End If ElseIf IsSection(InputData) Then 'the inputdata is the section Exit Do End If Else If InputData = "[" & Section & "]" Then InZone = True 'find End If Loop Close #fNum End Function '------ Public Function KeyExists2(ByVal FileName As String,ByVal Key As String) As Boolean 'This function determines if a key exists in a given section 'The Section is identified by its IndexNumber 'IndexNumbers begin at 0 and increment up 'This returns True or False Dim InZone As Boolean Dim InputData As String Dim Looper As Integer Dim Counter As Integer Dim fNum As Byte KeyExists2 = False If Dir(FileName) = "" Then MsgBox FileName & " not found.",not a valid Section Index Number. ~(KeyExists2)","Invalid Index Number.": Exit Function fNum = FreeFile Counter = -1 Open FileName For Input As #fNum Do While Not EOF(fNum) Line Input #fNum,InputData If InZone Then If IsKey(InputData) Then If Left(InputData,Len(Key)) = Key Then KeyExists2 = True Exit Do End If ElseIf IsSection(InputData) Then Exit Do End If Else If IsSection(InputData) Then Counter = Counter + 1 If Counter = SectionIndexNum Then InZone = True End If End If Loop Close #fNum End Function '------ Public Function SectionExists(ByVal FileName As String,ByVal Section As String) 'This determines if a section exists in a given INI file 'This returns True or False Dim InputData As String Dim fNum As Byte SectionExists = False fNum = FreeFile If Dir(FileName) = "" Then MsgBox FileName & " not found.","File Not Found": Exit Function Open FileName For Input As #fNum Do While Not EOF(fNum) Line Input #fNum,InputData If "[" & Section & "]" = InputData Then SectionExists = True: Exit Do Loop Close #fNum End Function '--------------------------------------------------------------------------------------------------------------------------- '------ Get Section or Key index ------ Public Function GetSectionIndex(ByVal FileName As String,ByVal Section As String) As Integer 'This function is used to get the IndexNumber for a given Section Dim InputData As String Dim Counter As Integer Dim fNum As Byte GetSectionIndex = -1 If Dir(FileName) = "" Then MsgBox FileName & " not found.",Not Found. ~(GetSectionIndex)" & vbCrLf & "Verify spelling and capitilization is correct. Case-sensative.","Section Not Found.": Exit Function Counter = -1 fNum = FreeFile Open FileName For Input As #fNum Do While Not EOF(fNum) Line Input #fNum,InputData If IsSection(InputData) Then Counter = Counter + 1 If "[" & Section & "]" = InputData Then GetSectionIndex = Counter End If Loop Close #fNum End Function '------ Public Function GetKeyIndex(ByVal FileName As String,ByVal Key As String) As Integer 'This function returns the IndexNumber of a key in a given Section 'The Section is identified as Text - GetKeyIndex2,Section is 'identified by it's IndexNumber 'IndexNumbers start at 0 and increment up Dim InputData As String Dim InZone As Boolean Dim Counter As Integer Dim fNum As Byte GetKeyIndex = -1 If Dir(FileName) = "" Then MsgBox FileName & " not found.",Not Found. ~(GetKeyIndex)" & vbCrLf & "Verify spelling and capitilization is correct. Case-sensative.",Not Found. ~(GetKetIndex)" & vbCrLf & "Verify spelling and capitilization is correct. Case-sensative.","Key Not Found.": Exit Function Counter = -1 fNum = FreeFile Open FileName For Input As #fNum Do While Not EOF(fNum) Line Input #fNum,InputData If InZone Then If IsKey(InputData) Then Counter = Counter + 1 If Left(InputData,Len(Key)) = Key Then GetKeyIndex = Counter Exit Do End If ElseIf IsSection(InputData) Then Exit Do End If Else If "[" & Section & "]" = InputData Then InZone = True End If Loop Close #fNum End Function '------ Public Function GetKeyIndex2(ByVal FileName As String,ByVal Key As String) As Integer 'This function returns the IndexNumber of a key in a given Section 'The Section is identified by it's IndexNumber 'IndexNumbers start at 0 and increment up Dim InputData As String Dim Counter As Integer Dim Counter2 As Integer Dim InZone As Boolean Dim fNum As Byte GetKeyIndex2 = -1 If Dir(FileName) = "" Then MsgBox FileName & " not found.",not a valid Section Index Number. ~(GetKeyIndex2)","Invalid Index Number.": Exit Function If Not KeyExists(FileName,SectionIndexNum),Not Found. ~(GetKetIndex2)" & vbCrLf & "Verify spelling and capitilization is correct. Case-sensative.","Key Not Found.": Exit Function Counter = -1 Counter2 = -1 fNum = FreeFile Open FileName For Input As #fNum Do While Not EOF(fNum) Line Input #fNum,InputData If InZone Then If IsKey(InputData) Then Counter = Counter + 1 If Left(InputData,Len(Key)) = Key Then GetKeyIndex2 = Counter Exit Do End If ElseIf IsSection(InputData) Then Exit Do End If Else If IsSection(InputData) Then Counter2 = Counter2 + 1 If Counter2 = SectionIndexNum Then InZone = True End If End If Loop Close #fNum End Function '---------------------------------------------------------------------------------------------------------------------------
'**************************************************************************** 'ini文件读写示例 '**************************************************************************** Option Explicit Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String,ByVal lpFileName As String) As Long Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String,ByVal lpFileName As String) As Long Public iniFileName As String '配置文件的名称,一般在窗体load事件中初始化 '获取Ini的值,注意DefString表示如果不存在对应的KeyWord就设置此项为DefString,为空时不处理 Function GetIniS(ByVal SectionName As String,ByVal KeyWord As String,Optional ByVal DefString As String) As String Dim ResultString As String * 144,Temp% Dim s$,i% Temp% = GetPrivateProfileString(SectionName,KeyWord,ResultString,144,iniFileName) '检索关键词的值 If Temp% > 0 Then '关键词的值不为空 For i = 1 To 144 If Asc(Mid$(ResultString,i,1)) <> 0 Then s = s & Mid$(ResultString,1) End If Next Else Temp% = WritePrivateProfileString(SectionName,DefString,iniFileName) '将缺省值写入INI文件 s = DefString End If GetIniS = s End Function '写入字符串值,返回值如果是0表示操作失败 Public Function SetIniS(ByVal SectionName As String,ByVal ValStr As String) As Boolean SetIniS = WritePrivateProfileString(SectionName,ValStr,iniFileName) End Function '清除 Section"段" Public Function DelIniSec(ByVal SectionName As String) As Boolean DelIniSec = WritePrivateProfileString(SectionName,0&,iniFileName) End Function ''清除KeyWord"键" Public Function DelIniKey(ByVal SectionName As String,ByVal KeyWord As String) As Boolean DelIniKey = WritePrivateProfileString(SectionName,iniFileName) End Function '注意点: 'ini文件在有回车换行符会出错,经过测试,汉字要小于86字节, '英文要小于143字节才能返回列表框。 '使用范例: 'form_load时设置文件路径 'Private Sub Form_Load() ' iniFileName = App.Path & "/test.ini" 'End Sub ''写入 'Private Sub Command1_Click() ' MsgBox SetIniS(Text1.Text,Text2.Text,Now) 'End Sub ''获取 'Private Sub Command2_Click() ' MsgBox GetIniS(Text1.Text,"fff") 'End Sub ''删除 Section 'Private Sub Command3_Click() ' MsgBox DelIniSec(Text1.Text) 'End Sub ''删除 KeyWord 'Private Sub Command4_Click() ' MsgBox DelIniKey(Text1.Text,Text2.Text) 'End Sub
Attribute VB_Name = "IniKeyS" '**************************************************************************** '描 述:根据鼠标位置获取句柄类名 '编 程:sysdzw 收藏整理 '发布日期:2008/07/20 '博 客:http://hi.baidu.com/sysdzw 'Email :sysdzw@163.com 'QQ :171977759 '**************************************************************************** Option Explicit Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String,I% Temp% = GetPrivateProfileString(SectionName,iniFileName) '检索关键词的值 If Temp% > 0 Then '关键词的值不为空 For I = 1 To 144 If Asc(Mid$(ResultString,I,iniFileName) '将缺省值写入INI文件 s = DefString End If GetIniS = Trim(s) End Function '写入字符串值,返回值如果是0表示操作失败 Public Function SetIniS(ByVal SectionName As String,Text2.Text) 'End Sub