读写INI文件的API函数及读写配置文件函数SetCfg和GetCfg
本帖最后由 作者 于 2003-11-13 19:22:34 编辑'获取INI文件的整个Section段的值
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
'获取INI文件某个Section段的某个Key的值
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
'将一个格式化的Section段写入INI文件中
Declare Function WritePrivateProfileSection Lib "kernel32" _
Alias "WritePrivateProfileSectionA" _
(ByVal lpAppName As String, _
ByVal lpString As Any, _
ByVal lpFileName As String) As Long
'将一个字符串写入INI文件中的Section中的Key值
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
'以下是把API函数转化成易懂的函数供大家使用：
Public Function GetSection(IniFile As String, Section As String) As Variant
Dim sSection As String * 32767
Dim S As String
GetPrivateProfileSection Section, sSection, Len(sSection), IniFile
S = sSection
S = Left(S, InStr(1, S, vbNullChar & vbNullChar) - 1)
S = Trim(S)
GetSection = Split(S, vbNullChar)
End Function
Public Function GetKey(IniFile As String, Section As String, Key As String, Default As String) As String
Dim Value As String * 32767
Dim S As String
GetPrivateProfileString Section, Key, Default, Value, Len(Value), IniFile
S = Value
S = Left(S, InStr(1, S, vbNullChar) - 1)
S = Trim(S)
GetKey = S
End Function
Public Sub SetSection(IniFile As String, Section As String, Value As Variant)
Dim i As Integer
Dim S As String
For i = LBound(Value) To UBound(Value)
If i = 0 Then
S = Value(i)
Else
S = S & vbNullChar & Value(i)
End If
Next i
S = S & vbNullChar & vbNullChar
S = Value
WritePrivateProfileSection Section, S, IniFile
End Sub
Public Sub SetKey(IniFile As String, Section As String, Key As String, Value As String)
WritePrivateProfileString Section, Key, Value, IniFile
End Sub
使用以上函数实现对系统配置文件acad2004.cfg的读取和修改,功能与LISP中的getcfg和setcfg完全相同
Sub gc()
Debug.Print GetCfg("appdata/tyl/other")
End Sub
Sub sc()
Debug.Print SetCfg("appdata/tyl/other", "明经通道 http://www.mjtd.com")
End Sub
Function GetCfg(cfgname As String) As String
Dim strCfgFile As String
strCfgFile = ThisDrawing.Application.Preferences.Files.ConfigFile
Dim st As String
Dim CfgSection As String
Dim CfgKey As String
Dim Cfgvar As Variant
Cfgvar = Split(cfgname, "/")
CfgKey = Cfgvar(UBound(Cfgvar))
Dim i As Integer
For i = 0 To UBound(Cfgvar) - 1
CfgSection = CfgSection & "/" & Cfgvar(i)
Next
CfgSection = Right(CfgSection, Len(CfgSection) - 1)
GetCfg = GetKey(strCfgFile, CfgSection, CfgKey, "")
End Function
Function SetCfg(cfgname As String, cfgval As String) As String
Dim strCfgFile As String
strCfgFile = ThisDrawing.Application.Preferences.Files.ConfigFile
Dim st As String
Dim CfgSection As String
Dim CfgKey As String
Dim Cfgvar As Variant
Cfgvar = Split(cfgname, "/")
CfgKey = Cfgvar(UBound(Cfgvar))
Dim i As Integer
For i = 0 To UBound(Cfgvar) - 1
CfgSection = CfgSection & "/" & Cfgvar(i)
Next
CfgSection = Right(CfgSection, Len(CfgSection) - 1)
On Error Resume Next
SetKey strCfgFile, CfgSection, CfgKey, cfgval
If Not Err Then SetCfg = cfgval
End Function
今天才看到，用起来非常方便。和SaveSetting等命令差不多。
用setsection时还可以用数组直接建立若干个section。
打包， 谢谢明总。 怎么看不到附件？
页:
[1]