VB我不大熟，帮朋友写了个INI读写的类，当时运行中总出错，请大家帮忙检查～运行环境VS 2003Public Class InIControl
Public FileName As String
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal section As String, ByVal key As String, ByVal def As String, ByVal retVal As Byte(), ByVal size As Integer, ByVal filePath As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal section As String, ByVal key As String, ByVal val As String, ByVal filePath As String) As Boolean
Public Sub New(ByVal AFileName As String)
Dim fileinfo As New System.IO.FileInfo(AFileName)
If Not fileinfo.Exists Then
Throw New ApplicationException("IniIni文件不存在")
End If
FileName = fileinfo.FullName
End Sub
Public Sub DeleteKey(ByVal Section As String, ByVal Ident As String)
InIControl.WritePrivateProfileString(Section, Ident, Nothing, FileName)
End Sub
Public Sub EraseSection(ByVal Section As String)
If Not InIControl.WritePrivateProfileString(Section, Nothing, Nothing, FileName) Then
Throw New ApplicationException("无法清除Ini文件中的Section")
End If
End Sub
Public Function ReadBool(ByVal Section As String, ByVal Ident As String, ByVal [Default] As Boolean) As Boolean
Try
Return Convert.ToBoolean(Me.ReadString(Section, Ident, Convert.ToString([Default])))
Catch exception1 As Exception
Console.WriteLine(exception1.Message)
Return [Default]
End Try
End Function
Public Function ReadInteger(ByVal Section As String, ByVal Ident As String, ByVal [Default] As Integer) As Integer
Dim text1 As String = Me.ReadString(Section, Ident, Convert.ToString([Default]))
Try
Return Convert.ToInt32(text1)
Catch exception1 As Exception
Console.WriteLine(exception1.Message)
Return [Default]
End Try
End Function
Public Sub ReadSection(ByVal Section As String, ByVal Idents As System.Collections.Specialized.StringCollection)
Dim buffer1 As Byte() = New Byte(16384 - 1) {}
Dim num1 As Integer = InIControl.GetPrivateProfileString(Section, Nothing, Nothing, buffer1, buffer1.GetUpperBound(0), FileName)
Me.GetStringsFromBuffer(buffer1, num1, Idents)
End Sub
Public Sub ReadSections(ByVal SectionList As System.Collections.Specialized.StringCollection)
Dim buffer1 As Byte() = New Byte(65535 - 1) {}
Dim num1 As Integer = 0
num1 = InIControl.GetPrivateProfileString(Nothing, Nothing, Nothing, buffer1, buffer1.GetUpperBound(0), FileName)
Me.GetStringsFromBuffer(buffer1, num1, SectionList)
End Sub
Public Sub ReadSectionValues(ByVal Section As String, ByVal Values As System.Collections.Specialized.NameValueCollection)
Dim collection1 As New System.Collections.Specialized.StringCollection
Me.ReadSection(Section, collection1)
Values.Clear()
Dim text1 As String
For Each text1 In collection1
Values.Add(text1, Me.ReadString(Section, text1, ""))
Next
End Sub
Public Function ReadString(ByVal Section As String, ByVal Ident As String, ByVal [Default] As String) As String
Dim buffer1 As Byte() = New Byte(65535 - 1) {}
Dim num1 As Integer = InIControl.GetPrivateProfileString(Section, Ident, [Default], buffer1, buffer1.GetUpperBound(0), FileName)
Dim text1 As String = System.Text.Encoding.GetEncoding(0).GetString(buffer1)
Return text1.Substring(0, num1).Trim
End Function
Public Sub UpdateFile()
InIControl.WritePrivateProfileString(Nothing, Nothing, Nothing, FileName)
End Sub
Public Function ValueExists(ByVal Section As String, ByVal Ident As String) As Boolean
Dim collection1 As New System.Collections.Specialized.StringCollection
Me.ReadSection(Section, collection1)
Return (collection1.IndexOf(Ident) > -1)
End Function
Public Sub WriteBool(ByVal Section As String, ByVal Ident As String, ByVal Value As Boolean)
Me.WriteString(Section, Ident, Convert.ToString(Value))
End Sub
Public Sub WriteInteger(ByVal Section As String, ByVal Ident As String, ByVal Value As Integer)
Me.WriteString(Section, Ident, Value.ToString)
End Sub
Public Sub WriteString(ByVal Section As String, ByVal Ident As String, ByVal Value As String)
If Not InIControl.WritePrivateProfileString(Section, Ident, Value, FileName) Then
Throw New ApplicationException(ChrW(20889) & "Ini" & ChrW(25991) & ChrW(20214) & ChrW(20986) & ChrW(38169))
End If
End Sub
Private Sub GetStringsFromBuffer(ByVal Buffer As Byte(), ByVal bufLen As Integer, ByVal Strings As System.Collections.Specialized.StringCollection)
Strings.Clear()
If (bufLen <> 0) Then
Dim num1 As Integer = 0
Dim num2 As Integer = 0
Do While (num2 < bufLen)
If ((Buffer(num2) = 0) AndAlso ((num2 - num1) > 0)) Then
Dim text1 As String = System.Text.Encoding.GetEncoding(0).GetString(Buffer, num1, (num2 - num1))
Strings.Add(text1)
num1 = (num2 + 1)
End If
num2 += 1
Loop
End If
End Sub
End Class
Public FileName As String
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal section As String, ByVal key As String, ByVal def As String, ByVal retVal As Byte(), ByVal size As Integer, ByVal filePath As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal section As String, ByVal key As String, ByVal val As String, ByVal filePath As String) As Boolean
Public Sub New(ByVal AFileName As String)
Dim fileinfo As New System.IO.FileInfo(AFileName)
If Not fileinfo.Exists Then
Throw New ApplicationException("IniIni文件不存在")
End If
FileName = fileinfo.FullName
End Sub
Public Sub DeleteKey(ByVal Section As String, ByVal Ident As String)
InIControl.WritePrivateProfileString(Section, Ident, Nothing, FileName)
End Sub
Public Sub EraseSection(ByVal Section As String)
If Not InIControl.WritePrivateProfileString(Section, Nothing, Nothing, FileName) Then
Throw New ApplicationException("无法清除Ini文件中的Section")
End If
End Sub
Public Function ReadBool(ByVal Section As String, ByVal Ident As String, ByVal [Default] As Boolean) As Boolean
Try
Return Convert.ToBoolean(Me.ReadString(Section, Ident, Convert.ToString([Default])))
Catch exception1 As Exception
Console.WriteLine(exception1.Message)
Return [Default]
End Try
End Function
Public Function ReadInteger(ByVal Section As String, ByVal Ident As String, ByVal [Default] As Integer) As Integer
Dim text1 As String = Me.ReadString(Section, Ident, Convert.ToString([Default]))
Try
Return Convert.ToInt32(text1)
Catch exception1 As Exception
Console.WriteLine(exception1.Message)
Return [Default]
End Try
End Function
Public Sub ReadSection(ByVal Section As String, ByVal Idents As System.Collections.Specialized.StringCollection)
Dim buffer1 As Byte() = New Byte(16384 - 1) {}
Dim num1 As Integer = InIControl.GetPrivateProfileString(Section, Nothing, Nothing, buffer1, buffer1.GetUpperBound(0), FileName)
Me.GetStringsFromBuffer(buffer1, num1, Idents)
End Sub
Public Sub ReadSections(ByVal SectionList As System.Collections.Specialized.StringCollection)
Dim buffer1 As Byte() = New Byte(65535 - 1) {}
Dim num1 As Integer = 0
num1 = InIControl.GetPrivateProfileString(Nothing, Nothing, Nothing, buffer1, buffer1.GetUpperBound(0), FileName)
Me.GetStringsFromBuffer(buffer1, num1, SectionList)
End Sub
Public Sub ReadSectionValues(ByVal Section As String, ByVal Values As System.Collections.Specialized.NameValueCollection)
Dim collection1 As New System.Collections.Specialized.StringCollection
Me.ReadSection(Section, collection1)
Values.Clear()
Dim text1 As String
For Each text1 In collection1
Values.Add(text1, Me.ReadString(Section, text1, ""))
Next
End Sub
Public Function ReadString(ByVal Section As String, ByVal Ident As String, ByVal [Default] As String) As String
Dim buffer1 As Byte() = New Byte(65535 - 1) {}
Dim num1 As Integer = InIControl.GetPrivateProfileString(Section, Ident, [Default], buffer1, buffer1.GetUpperBound(0), FileName)
Dim text1 As String = System.Text.Encoding.GetEncoding(0).GetString(buffer1)
Return text1.Substring(0, num1).Trim
End Function
Public Sub UpdateFile()
InIControl.WritePrivateProfileString(Nothing, Nothing, Nothing, FileName)
End Sub
Public Function ValueExists(ByVal Section As String, ByVal Ident As String) As Boolean
Dim collection1 As New System.Collections.Specialized.StringCollection
Me.ReadSection(Section, collection1)
Return (collection1.IndexOf(Ident) > -1)
End Function
Public Sub WriteBool(ByVal Section As String, ByVal Ident As String, ByVal Value As Boolean)
Me.WriteString(Section, Ident, Convert.ToString(Value))
End Sub
Public Sub WriteInteger(ByVal Section As String, ByVal Ident As String, ByVal Value As Integer)
Me.WriteString(Section, Ident, Value.ToString)
End Sub
Public Sub WriteString(ByVal Section As String, ByVal Ident As String, ByVal Value As String)
If Not InIControl.WritePrivateProfileString(Section, Ident, Value, FileName) Then
Throw New ApplicationException(ChrW(20889) & "Ini" & ChrW(25991) & ChrW(20214) & ChrW(20986) & ChrW(38169))
End If
End Sub
Private Sub GetStringsFromBuffer(ByVal Buffer As Byte(), ByVal bufLen As Integer, ByVal Strings As System.Collections.Specialized.StringCollection)
Strings.Clear()
If (bufLen <> 0) Then
Dim num1 As Integer = 0
Dim num2 As Integer = 0
Do While (num2 < bufLen)
If ((Buffer(num2) = 0) AndAlso ((num2 - num1) > 0)) Then
Dim text1 As String = System.Text.Encoding.GetEncoding(0).GetString(Buffer, num1, (num2 - num1))
Strings.Add(text1)
num1 = (num2 + 1)
End If
num2 += 1
Loop
End If
End Sub
End Class
Inherits System.Windows.Forms.Form
#Region " Windows 窗体设计器生成的代码 "
Public Sub New()
MyBase.New()
'该调用是 Windows 窗体设计器所必需的。
InitializeComponent()
'在 InitializeComponent() 调用之后添加任何初始化
End Sub
'窗体重写 dispose 以清理组件列表。
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub
'Windows 窗体设计器所必需的
Private components As System.ComponentModel.IContainer
'注意: 以下过程是 Windows 窗体设计器所必需的
'可以使用 Windows 窗体设计器修改此过程。
'不要使用代码编辑器修改它。
Friend WithEvents ComboBox1 As System.Windows.Forms.ComboBox
Friend WithEvents ComboBox2 As System.Windows.Forms.ComboBox
Friend WithEvents ComboBox3 As System.Windows.Forms.ComboBox
Friend WithEvents ContextMenu1 As System.Windows.Forms.ContextMenu
Friend WithEvents MenuItem1 As System.Windows.Forms.MenuItem
Friend WithEvents MenuItem2 As System.Windows.Forms.MenuItem
Friend bComboBox1 As Boolean
Friend bComboBox2 As Boolean
Friend bComboBox3 As Boolean
Friend WithEvents Label1 As System.Windows.Forms.Label
Friend WithEvents Label2 As System.Windows.Forms.Label
Friend WithEvents Label3 As System.Windows.Forms.Label
Friend iniControl As iniControl
<System.Diagnostics.DebuggerStepThrough() > Private Sub InitializeComponent()
Me.ComboBox1 = New System.Windows.Forms.ComboBox
Me.ContextMenu1 = New System.Windows.Forms.ContextMenu
Me.MenuItem1 = New System.Windows.Forms.MenuItem
Me.MenuItem2 = New System.Windows.Forms.MenuItem
Me.ComboBox2 = New System.Windows.Forms.ComboBox
Me.ComboBox3 = New System.Windows.Forms.ComboBox
Me.Label1 = New System.Windows.Forms.Label
Me.Label2 = New System.Windows.Forms.Label
Me.Label3 = New System.Windows.Forms.Label
Me.SuspendLayout()
'
'ComboBox1
'
Me.ComboBox1.ContextMenu = Me.ContextMenu1
Me.ComboBox1.Items.AddRange(New Object() { "1 ", "2 ", "3 "})
Me.ComboBox1.Location = New System.Drawing.Point(8, 8)
Me.ComboBox1.Name = "ComboBox1 "
Me.ComboBox1.Size = New System.Drawing.Size(120, 20)
Me.ComboBox1.TabIndex = 0
'
'ContextMenu1
'
Me.ContextMenu1.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.MenuItem1, Me.MenuItem2})
'
'MenuItem1
'
Me.MenuItem1.Index = 0
Me.MenuItem1.Text = "添加 "
'
'MenuItem2
'
Me.MenuItem2.Index = 1
Me.MenuItem2.Text = "删除 "
'
'ComboBox2
'
Me.ComboBox2.ContextMenu = Me.ContextMenu1
Me.ComboBox2.Items.AddRange(New Object() { "4 ", "5 ", "6 "})
Me.ComboBox2.Location = New System.Drawing.Point(8, 40)
Me.ComboBox2.Name = "ComboBox2 "
Me.ComboBox2.Size = New System.Drawing.Size(121, 20)
Me.ComboBox2.TabIndex = 0
'
'ComboBox3
'
Me.ComboBox3.ContextMenu = Me.ContextMenu1
Me.ComboBox3.Items.AddRange(New Object() { "7 ", "8 ", "9 "})
Me.ComboBox3.Location = New System.Drawing.Point(8, 72)
Me.ComboBox3.Name = "ComboBox3 "
Me.ComboBox3.Size = New System.Drawing.Size(121, 20)
Me.ComboBox3.TabIndex = 0
'
'Label1
'
Me.Label1.Location = New System.Drawing.Point(176, 8)
Me.Label1.Name = "Label1 "
Me.Label1.Size = New System.Drawing.Size(104, 24)
Me.Label1.TabIndex = 1
Me.Label1.Text = "none "
'
'Label2
'
Me.Label2.Location = New System.Drawing.Point(176, 39)
Me.Label2.Name = "Label2 "
Me.Label2.TabIndex = 1
Me.Label2.Text = "none "
'
'Label3
'
Me.Label3.Location = New System.Drawing.Point(176, 71)
Me.Label3.Name = "Label3 "
Me.Label3.TabIndex = 1
Me.Label3.Text = "none "
'
'Form1
'
Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
Me.ClientSize = New System.Drawing.Size(352, 290)
Me.Controls.Add(Me.Label1)
Me.Controls.Add(Me.ComboBox1)
Me.Controls.Add(Me.ComboBox2)
Me.Controls.Add(Me.ComboBox3)
Me.Controls.Add(Me.Label2)
Me.Controls.Add(Me.Label3)
Me.Name = "Form1 "
Me.Text = "Form1 "
Me.ResumeLayout(False)
'
'inicontrol
'
Me.iniControl = New InIControl(Application.StartupPath & "\System.ini ")
End Sub
#End Region
bComboBox1 = True
Label1.Text = bComboBox1.ToString()
End Sub
Private Sub ComboBox1_MouseLeave(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBox1.MouseLeave
bComboBox1 = False
Label1.Text = bComboBox1.ToString()
End Sub
Private Sub ComboBox2_MouseEnter(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBox2.MouseEnter
bComboBox2 = True
Label2.Text = bComboBox2.ToString()
End Sub
Private Sub ComboBox2_MouseLeave(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBox2.MouseLeave
bComboBox2 = False
Label2.Text = bComboBox2.ToString()
End Sub
Private Sub ComboBox3_MouseEnter(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBox3.MouseEnter
bComboBox3 = True
Label3.Text = bComboBox3.ToString()
End Sub
Private Sub ComboBox3_MouseLeave(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBox3.MouseLeave
bComboBox3 = False
Label3.Text = bComboBox3.ToString()
End Sub
Private Sub MenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem1.Click
If bComboBox1 = True Then
If ComboBox1.Text < > " " Then
ComboBox1.Items.Add(ComboBox1.Text.ToString())
'bComboBox1 = False
End If
End If
If bComboBox2 = True Then
If ComboBox2.Text < > " " Then
ComboBox2.Items.Add(ComboBox2.Text.ToString())
'bComboBox2 = False
End If
End If
If bComboBox3 = True Then
If ComboBox3.Text < > " " Then
ComboBox3.Items.Add(ComboBox3.Text.ToString())
'bComboBox3 = False
End If
End If
End Sub
Private Sub MenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem2.Click
If bComboBox1 = True Then
ComboBox1.Items.Remove(ComboBox1.SelectedItem)
'bComboBox1 = False
End If
If bComboBox2 = True Then
ComboBox2.Items.Remove(ComboBox2.SelectedItem)
'bComboBox2 = False
End If
If bComboBox3 = True Then
ComboBox3.Items.Remove(ComboBox3.SelectedItem)
'bComboBox3 = False
End If
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
End Sub
Private Sub Form1_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
Dim i As Integer
Dim k As Integer = 0
'For i = 0 To ComboBox1.Items.Count - 1
Me.iniControl.WriteString( "ComboBox1 ", "Item0 ", ComboBox1.Items(0).ToString())
Me.iniControl.WriteString( "ComboBox1 ", "Item1 ", ComboBox1.Items(1).ToString())
Me.iniControl.WriteString( "ComboBox1 ", "Item2 ", ComboBox1.Items(2).ToString())
'k = k + 1
'Next
'Me.iniControl.WriteString( "ComboBox1 ", "Item1 ", ComboBox2.Items(0).ToString())
End Sub
End Class
If Not InIControl.WritePrivateProfileString(Section, Ident, Value, FileName) Then 这一句时 FileName 发生改变，FileName的结尾最后三个字母消失不见 不晓得为什么
请大家一定帮忙
Attribute VB_Name = "ini_old"
Option Explicit'/******************************************************\
'模块说明:
' INI文件读写for vb
'实现过程:
' 由于98下用api写入后不能立刻变换文件(缓冲问题)
' 所以仿照
' API WritePrivateProfileString
' API GetPrivateProfileString
' 采用VB+API试探API INI函数工作原理改写
' 编写了一个
'具体细节有下:
'1: 任何一行先经过trim处理
' 2：如果left(line,1)="["说明为一个section
' 然后往后查找"]"或者该行结束，表示找到一个section
' 3：如果ucase(trim(section))=ucase(trim(section input))
' 说明找到正确的section
' 4：接着往下找key，先找=号。左边为key，右边为value
' 5：如果ucase(trim(key))=ucase(trim(key input))
' 说明找到正确的section
' 6：如果ucase(trim(vale))的被"或者'包括。则取里面数据
' 7：如果在没找key之前发现文件结束，或者找到"["
' 说明里面不包含key
' -----
' 关于write操作
'8: 如果没找到section文件结束.则开始追加section , Key, Value
' 最后一行(只不包含回车符的一行,下同)经过trim操作后
' 如果为空.则用section , Key, value替换最后一行
' 否则 在最后一行下面追加section, Key, Value
' 9: 如果找到了section.
' 找到了key , 则替换该行
' 没找到key , 文件结束(找到最后一行), 或者找到新的section
' 则在该行(最后一行或新的section)前插入section,key,value
'发行:
' 版本 1#
' 日期 2004年3月22日
' 作者 胡俊杰
'\******************************************************/'//////////////////////////////////////////////////////////////////////////////////
'函数名: GetProfile
'函数功能: 读INI
'函数参数: strFileName 文件名, strSection 段, strName 名称
'返回值: key内容
'完成日期: 2004-3-22
'//////////////////////////////////////////////////////////////////////////////////
Public Function GetProfile(ByVal strFileName As String, ByVal strSection As String, _
ByVal strName As String) As String
On Error GoTo errHandle
Dim lngFileNumber As Long, pos As Long
Dim strTemp As String
'check file exist?
If Dir(strFileName) = "" Then Exit Function
lngFileNumber = 0
lngFileNumber = FreeFile()
Open strFileName For Input As #lngFileNumber
strSection = Trim(strSection)
strName = Trim(strName)
'try to found section
Do
If EOF(lngFileNumber) Then Close #lngFileNumber: Exit Function
Line Input #1, strTemp
strTemp = Trim(strTemp)
If Left(strTemp, 1) = "[" Then
For pos = 2 To Len(strTemp)
If Mid(strTemp, pos, 1) = "]" Then Exit For
Next pos
If UCase(Trim(Mid(strTemp, 2, pos - 2))) = UCase(strSection) Then Exit Do
End If
Loop
'try to found name
Do
If EOF(lngFileNumber) Then Close #lngFileNumber: Exit Function
Line Input #1, strTemp
strTemp = Trim(strTemp)
If Left(strTemp, 1) = "[" Then Close #lngFileNumber: Exit Function
pos = InStr(1, strTemp, "=", vbTextCompare)
If pos <> 0 Then
If UCase(Trim(Left(strTemp, pos - 1))) = UCase(strName) Then Exit Do
End If
Loop
'get value
GetProfile = Trim(Mid(strTemp, pos + 1))
If ((Left(GetProfile, 1) = "'" And Right(GetProfile, 1) = "'") Or _
(Left(GetProfile, 1) = """" And Right(GetProfile, 1) = """")) And Len(GetProfile) >= 2 Then
GetProfile = Mid(GetProfile, 2, Len(GetProfile) - 2)
End If
errHandle:
If lngFileNumber <> 0 Then Close #lngFileNumber
End Function'//////////////////////////////////////////////////////////////////////////////////
'函数名: SetProfile
'函数功能: 写INI
'函数参数: strFileName 文件名, strSection 段, strName 名称, strSave 内容
'返回值: 是否成功
'完成日期: 2004-3-22
'//////////////////////////////////////////////////////////////////////////////////
Public Function SetProfile(strFileName As String, strSection As String, _
strName As String, strSave As String) As Boolean
On Error GoTo errHandle
Dim lngFileNumber As Long, pos As Long
Dim strTemp As String, strFileBak() As String, i As Long, j As Long, mode As Long
lngFileNumber = 0: mode = 0
strSection = Trim(strSection)
strName = Trim(strName)
'check file exist or filelen = 0?
If Dir(strFileName) <> "" Then
If FileLen(strFileName) > 0 Then GoTo lbl_1
End If
lngFileNumber = FreeFile
Open strFileName For Output As #lngFileNumber
Print #lngFileNumber, "[" & strSection & "]"
Print #lngFileNumber, strName & " = " & """" & strSave & """"
Close #lngFileNumber
SetProfile = True
Exit Function
lbl_1:
'read file to buff
lngFileNumber = FreeFile
i = 0
Open strFileName For Input As #lngFileNumber
Do
If EOF(lngFileNumber) Then Exit Do
Line Input #lngFileNumber, strTemp
ReDim Preserve strFileBak(i)
strFileBak(i) = Trim(strTemp)
i = i + 1
Loop
Close #lngFileNumber
'try to found section
mode = 0
For i = 0 To UBound(strFileBak)
If Left(strFileBak(i), 1) = "[" Then
For pos = 2 To Len(strFileBak(i))
If Mid(strFileBak(i), pos, 1) = "]" Then Exit For
Next pos
If UCase(Trim(Mid(strFileBak(i), 2, pos - 2))) = UCase(strSection) Then Exit For
End If
Next i
If i > UBound(strFileBak) Then GoTo lbl_over
'try to found name
mode = 1
For i = i + 1 To UBound(strFileBak)
If Left(strFileBak(i), 1) = "[" Then GoTo lbl_over
pos = InStr(1, strFileBak(i), "=", vbTextCompare)
If pos <> 0 Then
If UCase(Trim(Left(strFileBak(i), pos - 1))) = UCase(strName) Then Exit For
End If
Next i
If i > UBound(strFileBak) Then GoTo lbl_over
'found name
mode = 2
'set values
lbl_over:
'mode 0 found nothing
'mode 1 found section
'mode 2 found name
lngFileNumber = FreeFile
Open strFileName For Output As #lngFileNumber
For j = 0 To i - 1
Print #lngFileNumber, strFileBak(j)
Next j
'------------
If mode = 0 Then 'print section
Print #lngFileNumber, "[" & strSection & "]"
End If
Print #lngFileNumber, strName & " = " & """" & strSave & """"
'------------
If i <= UBound(strFileBak) Then 'file not over
If mode <> 2 Then
Print #lngFileNumber, strFileBak(i)
End If
For j = i + 1 To UBound(strFileBak)
Print #lngFileNumber, strFileBak(j)
Next j
End If
SetProfile = TrueerrHandle:
If lngFileNumber <> 0 Then Close #lngFileNumber
End Function
If Not InIControl.WritePrivateProfileString(Section, Ident, Value, FileName) Then 这一句时 FileName 发生改变，FileName的结尾最后三个字母消失不见 不晓得为什么
请大家一定帮忙
---------------------------------------------------------------------------------
改为：
If Not InIControl.WritePrivateProfileString(Section, Ident, Value, FileName & vbNullChar) Then