读写INI文件的API函数及读写配置文件函数SetCfg和GetCfg

mccad

2. '获取INI文件的整个Section段的值
   
3. Declare Function GetPrivateProfileSection Lib "kernel32" _
   
4.         Alias "GetPrivateProfileSectionA" _
   
5.         (ByVal lpAppName As String, _
   
6.         ByVal lpReturnedString As String, _
   
7.         ByVal nSize As Long, _
   
8.         ByVal lpFileName As String) As Long
   
9. 
   
10. '获取INI文件某个Section段的某个Key的值
    
11. Declare Function GetPrivateProfileString Lib "kernel32" _
    
12.         Alias "GetPrivateProfileStringA" _
    
13.         (ByVal lpApplicationName As String, _
    
14.         ByVal lpKeyName As Any, _
    
15.         ByVal lpDefault As String, _
    
16.         ByVal lpReturnedString As String, _
    
17.         ByVal nSize As Long, _
    
18.         ByVal lpFileName As String) As Long
    
19. 
    
20. '将一个格式化的Section段写入INI文件中
    
21. Declare Function WritePrivateProfileSection Lib "kernel32" _
    
22.         Alias "WritePrivateProfileSectionA" _
    
23.         (ByVal lpAppName As String, _
    
24.         ByVal lpString As Any, _
    
25.         ByVal lpFileName As String) As Long
    
26. 
    
27. '将一个字符串写入INI文件中的Section中的Key值
    
28. Declare Function WritePrivateProfileString Lib "kernel32" _
    
29.         Alias "WritePrivateProfileStringA" _
    
30.         (ByVal lpApplicationName As String, _
    
31.         ByVal lpKeyName As Any, _
    
32.         ByVal lpString As Any, _
    
33.         ByVal lpFileName As String) As Long
    
34. 
    
35. '以下是把API函数转化成易懂的函数供大家使用：
    
36. Public Function GetSection(IniFile As String, Section As String) As Variant
    
37.     Dim sSection As String * 32767
    
38.     Dim S As String
    
39.    
    
40.     GetPrivateProfileSection Section, sSection, Len(sSection), IniFile
    
41.     S = sSection
    
42.     S = Left(S, InStr(1, S, vbNullChar & vbNullChar) - 1)
    
43.     S = Trim(S)
    
44.     GetSection = Split(S, vbNullChar)
    
45. End Function
    
46. 
    
47. Public Function GetKey(IniFile As String, Section As String, Key As String, Default As String) As String
    
48.     Dim Value As String * 32767
    
49.     Dim S As String
    
50.     GetPrivateProfileString Section, Key, Default, Value, Len(Value), IniFile
    
51.     S = Value
    
52.     S = Left(S, InStr(1, S, vbNullChar) - 1)
    
53.     S = Trim(S)
    
54.     GetKey = S
    
55. End Function
    
56. 
    
57. Public Sub SetSection(IniFile As String, Section As String, Value As Variant)
    
58.     Dim i As Integer
    
59.     Dim S As String
    
60.     For i = LBound(Value) To UBound(Value)
    
61.         If i = 0 Then
    
62.             S = Value(i)
    
63.         Else
    
64.             S = S & vbNullChar & Value(i)
    
65.         End If
    
66.     Next i
    
67.     S = S & vbNullChar & vbNullChar
    
68.     S = Value
    
69.     WritePrivateProfileSection Section, S, IniFile
    
70. End Sub
    
71. 
    
72. Public Sub SetKey(IniFile As String, Section As String, Key As String, Value As String)
    
73.     WritePrivateProfileString Section, Key, Value, IniFile
    
74. End Sub
    
75. 
    

'获取INI文件的整个Section段的值<br /> Declare Function GetPrivateProfileSection Lib "kernel32" _<br />         Alias "GetPrivateProfileSectionA" _<br />         (ByVal lpAppName As String, _<br />         ByVal lpReturnedString As String, _<br />         ByVal nSize As Long, _<br />         ByVal lpFileName As String) As Long<br /> <br /> '获取INI文件某个Section段的某个Key的值<br /> Declare Function GetPrivateProfileString Lib "kernel32" _<br />         Alias "GetPrivateProfileStringA" _<br />         (ByVal lpApplicationName As String, _<br />         ByVal lpKeyName As Any, _<br />         ByVal lpDefault As String, _<br />         ByVal lpReturnedString As String, _<br />         ByVal nSize As Long, _<br />         ByVal lpFileName As String) As Long<br /> <br /> '将一个格式化的Section段写入INI文件中<br /> Declare Function WritePrivateProfileSection Lib "kernel32" _<br />         Alias "WritePrivateProfileSectionA" _<br />         (ByVal lpAppName As String, _<br />         ByVal lpString As Any, _<br />         ByVal lpFileName As String) As Long<br /> <br /> '将一个字符串写入INI文件中的Section中的Key值<br /> Declare Function WritePrivateProfileString Lib "kernel32" _<br />         Alias "WritePrivateProfileStringA" _<br />         (ByVal lpApplicationName As String, _<br />         ByVal lpKeyName As Any, _<br />         ByVal lpString As Any, _<br />         ByVal lpFileName As String) As Long<br /> <br /> '以下是把API函数转化成易懂的函数供大家使用：<br /> Public Function GetSection(IniFile As String, Section As String) As Variant<br />     Dim sSection As String * 32767<br />     Dim S As String<br />     <br />     GetPrivateProfileSection Section, sSection, Len(sSection), IniFile<br />     S = sSection<br />     S = Left(S, InStr(1, S, vbNullChar & vbNullChar) - 1)<br />     S = Trim(S)<br />     GetSection = Split(S, vbNullChar)<br /> End Function<br /> <br /> Public Function GetKey(IniFile As String, Section As String, Key As String, Default As String) As String<br />     Dim Value As String * 32767<br />     Dim S As String<br />     GetPrivateProfileString Section, Key, Default, Value, Len(Value), IniFile<br />     S = Value<br />     S = Left(S, InStr(1, S, vbNullChar) - 1)<br />     S = Trim(S)<br />     GetKey = S<br /> End Function<br /> <br /> Public Sub SetSection(IniFile As String, Section As String, Value As Variant)<br />     Dim i As Integer<br />     Dim S As String<br />     For i = LBound(Value) To UBound(Value)<br />         If i = 0 Then<br />             S = Value(i)<br />         Else<br />             S = S & vbNullChar & Value(i)<br />         End If<br />     Next i<br />     S = S & vbNullChar & vbNullChar<br />     S = Value<br />     WritePrivateProfileSection Section, S, IniFile<br /> End Sub<br /> <br /> Public Sub SetKey(IniFile As String, Section As String, Key As String, Value As String)<br />     WritePrivateProfileString Section, Key, Value, IniFile<br /> End Sub<br /> <br />

mccad

使用以上函数实现对系统配置文件acad2004.cfg的读取和修改,功能与LISP中的getcfg和setcfg完全相同

2. Sub gc()
   
3.     Debug.Print GetCfg("appdata/tyl/other")
   
4. End Sub
   
5. Sub sc()
   
6.     Debug.Print SetCfg("appdata/tyl/other", "明经通道 http://www.mjtd.com")
   
7. End Sub
   
8. 
   
9. Function GetCfg(cfgname As String) As String
   
10.     Dim strCfgFile As String
    
11.     strCfgFile = ThisDrawing.Application.Preferences.Files.ConfigFile
    
12.     Dim st As String
    
13.     Dim CfgSection As String
    
14.     Dim CfgKey As String
    
15.     Dim Cfgvar As Variant
    
16.     Cfgvar = Split(cfgname, "/")
    
17.     CfgKey = Cfgvar(UBound(Cfgvar))
    
18.     Dim i As Integer
    
19.     For i = 0 To UBound(Cfgvar) - 1
    
20.         CfgSection = CfgSection & "/" & Cfgvar(i)
    
21.     Next
    
22.     CfgSection = Right(CfgSection, Len(CfgSection) - 1)
    
23.     GetCfg = GetKey(strCfgFile, CfgSection, CfgKey, "")
    
24. End Function
    
25. 
    
26. Function SetCfg(cfgname As String, cfgval As String) As String
    
27.     Dim strCfgFile As String
    
28.     strCfgFile = ThisDrawing.Application.Preferences.Files.ConfigFile
    
29.     Dim st As String
    
30.     Dim CfgSection As String
    
31.     Dim CfgKey As String
    
32.     Dim Cfgvar As Variant
    
33.     Cfgvar = Split(cfgname, "/")
    
34.     CfgKey = Cfgvar(UBound(Cfgvar))
    
35.     Dim i As Integer
    
36.     For i = 0 To UBound(Cfgvar) - 1
    
37.         CfgSection = CfgSection & "/" & Cfgvar(i)
    
38.     Next
    
39.     CfgSection = Right(CfgSection, Len(CfgSection) - 1)
    
40.     On Error Resume Next
    
41.     SetKey strCfgFile, CfgSection, CfgKey, cfgval
    
42.     If Not Err Then SetCfg = cfgval
    
43. End Function
    

Sub gc()<br />     Debug.Print GetCfg("appdata/tyl/other")<br /> End Sub<br /> Sub sc()<br />     Debug.Print SetCfg("appdata/tyl/other", "明经通道 http://www.mjtd.com")<br /> End Sub<br /> <br /> Function GetCfg(cfgname As String) As String<br />     Dim strCfgFile As String<br />     strCfgFile = ThisDrawing.Application.Preferences.Files.ConfigFile<br />     Dim st As String<br />     Dim CfgSection As String<br />     Dim CfgKey As String<br />     Dim Cfgvar As Variant<br />     Cfgvar = Split(cfgname, "/")<br />     CfgKey = Cfgvar(UBound(Cfgvar))<br />     Dim i As Integer<br />     For i = 0 To UBound(Cfgvar) - 1<br />         CfgSection = CfgSection & "/" & Cfgvar(i)<br />     Next<br />     CfgSection = Right(CfgSection, Len(CfgSection) - 1)<br />     GetCfg = GetKey(strCfgFile, CfgSection, CfgKey, "")<br /> End Function<br /> <br /> Function SetCfg(cfgname As String, cfgval As String) As String<br />     Dim strCfgFile As String<br />     strCfgFile = ThisDrawing.Application.Preferences.Files.ConfigFile<br />     Dim st As String<br />     Dim CfgSection As String<br />     Dim CfgKey As String<br />     Dim Cfgvar As Variant<br />     Cfgvar = Split(cfgname, "/")<br />     CfgKey = Cfgvar(UBound(Cfgvar))<br />     Dim i As Integer<br />     For i = 0 To UBound(Cfgvar) - 1<br />         CfgSection = CfgSection & "/" & Cfgvar(i)<br />     Next<br />     CfgSection = Right(CfgSection, Len(CfgSection) - 1)<br />     On Error Resume Next<br />     SetKey strCfgFile, CfgSection, CfgKey, cfgval<br />     If Not Err Then SetCfg = cfgval<br /> End Function<br />

subtlation

今天才看到，用起来非常方便。和SaveSetting等命令差不多。
用setsection时还可以用数组直接建立若干个section。
打包， 谢谢明总。

zezh

怎么看不到附件？