• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号

VB下的TIniFile类(模拟Delphi)

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

因为一个需求,写了这样一个类..写的我很胸闷.好多东西都没有现成的...记得一定要SetFileName,不然没法用..而且可能报异常,实在不想写异常处理了..
我实在没找到构造函数在哪里....
我只尝试了WriteString,ReadString,ReadSections这几个函数,其他的都没测试.
调用代码如下:

1 Dim sectionlist() As String
2 IniFile.SetFileName (".\Test.ini")
3 IniFile.ReadSections sectionlist
4 Dim i As Long
5 Combo1.Clear
6 For i = 0 To UBound(sectionlist)
7 Combo1.AddItem (sectionlist(i))
8 Next

  以下是类代码.

  1 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
2 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
3
4 Private FFileName As String
5
6 Public Sub SetFileName(ByVal FileName As String)
7 FFileName = FileName
8 End Sub
9
10 Public Sub WriteString(ByVal Section, Ident, Value As String)
11 Dim WriteKey As Long
12 WriteKey = WritePrivateProfileString(Section, CStr(Ident), CStr(Value), FFileName)
13 End Sub
14
15 Public Sub WriteInteger(ByVal Section, Ident As String, Value As Long)
16 WriteString Section, Ident, CStr(Value)
17 End Sub
18
19 Public Sub WriteDate(ByVal Section, Ident As String, Value As Date)
20 WriteString Section, Ident, DateValue(Value)
21 End Sub
22
23 Public Sub WriteDateTime(ByVal Section, Ident As String, Value As Date)
24 WriteString Section, Ident, CStr(Value)
25 End Sub
26
27 Public Sub WriteFloat(ByVal Section, Ident As String, Value As Double)
28 WriteString Section, Ident, CStr(Value)
29 End Sub
30
31 Public Sub WriteTime(ByVal Section, Ident As String, Value As Date)
32 WriteString Section, Ident, TimeValue(Value)
33 End Sub
34
35 Public Sub WriteBool(ByVal Section, Ident As String, Value As Boolean)
36 If Value Then
37 WriteString Section, Ident, "1"
38 Else
39 WriteString Section, Ident, "0"
40 End If
41 End Sub
42
43 Public Sub ReadSectionValues(ByVal Section As String, ByRef Strings() As String)
44 Dim KeyList() As String
45 ReadSection Section, KeyList
46 Dim i As Long
47 For i = 0 To UBound(KeyList)
48 ReDim Preserve Strings(i)
49 Strings(i) = ReadString(Section, KeyList(i), "")
50 Next
51 End Sub
52
53 Public Sub EreSection(ByVal Section As String)
54 Dim WriteKey As Long
55 WriteKey = WritePrivateProfileString(Section, vbNullString, vbNullString, FFileName)
56 End Sub
57
58 Public Sub DeleteKey(ByVal Section, Ident As String)
59 Dim WriteKey As Long
60 WriteKey = WritePrivateProfileString(Section, Ident, vbNullString, FFileName)
61 End Sub
62
63 Public Sub UpdateFile()
64 Dim WriteKey As Long
65 WriteKey = WritePrivateProfileString(vbNullString, vbNullString, vbNullString, FFileName)
66 End Sub
67
68 Public Function SectionExists(ByVal Section As String) As Boolean
69 Dim Strings() As String
70 ReadSection Section, Strings
71 SectionExists = UBound(Strings) >= 0
72 End Function
73
74 Public Function ReadString(ByVal Section As String, ByVal Ident As String, ByVal Default As String) As String
75 Dim Buffer As String
76 Dim Length As Long
77 Buffer = String$(2048, Chr(0))
78 Length = GetPrivateProfileString(Section, CStr(Ident), Default, Buffer, Len(Buffer), FFileName)
79 ReadString = Buffer
80 End Function
81
82
83 Public Function ReadInteger(ByVal Section, Ident As String, Default As Long) As Long
84 Dim DataStr As String
85 ReadInteger = Default
86 DataStr = ReadString(Section, Ident, "")
87 If DataStr <> "" Then
88 If IsNumeric(DataStr) And (Int(DataStr) = DataStr) Then
89 ReadInteger = CInt(DataStr)
90 End If
91 End If
92 End Function
93
94 Public Function ReadBool(ByVal Section, Ident As String, Default As Boolean) As Boolean
95 ReadBool = ReadInteger(Section, Ident, Asc(Default)) <> 0
96 End Function
97
98 Public Function ReadDate(ByVal Section, Ident As String, Default As Date) As Date
99 Dim DataStr As String
100 DataStr = ReadString(Section, Ident, "")
101 If DataStr <> "" Then
102 If IsDate(DataStr) Then
103 ReadDate = DateValue(CDate(DataStr))
104 End If
105 End If
106 End Function
107
108 Public Function ReadDateTime(ByVal Section, Ident As String, Default As Date) As Date
109 Dim DataStr As String
110 DataStr = ReadString(Section, Ident, "")
111 If DataStr <> "" Then
112 If IsDate(DataStr) Then
113 ReadDateTime = CDate(DataStr)
114 End If
115 End If
116 End Function
117
118 Public Function ReadFloat(ByVal Section, Ident As String, Default As Double) As Double
119 Dim DataStr As String
120 ReadFloat = Default
121 DataStr = ReadString(Section, Ident, "")
122 If DataStr <> "" Then
123 If IsNumeric(DataStr) Then
124 ReadFloat = CSng(DataStr)
125 End If
126 End If
127 End Function
128
129 Public Function ReadTime(ByVal Section, Ident As String, Default As Date) As Date
130 Dim DataStr As String
131 DataStr = ReadString(Section, Ident, "")
132 If DataStr <> "" Then
133 If IsDate(DataStr) Then
134 ReadTime = TimeValue(CDate(DataStr))
135 End If
136 End If
137 End Function
138
139 Public Sub ReadSection(ByVal Section As String, ByRef Strings() As String)
140 Dim Buffer As String
141 Dim NowLen As Long
142 Dim Index As Long
143 Index = 0
144 ReDim Strings(Index)
145 Buffer = String$(16384, Chr(0))
146 If GetPrivateProfileString(Section, CStr(vbNullString), vbNullString, Buffer, Len(Buffer), FFileName) <> 0 Then
147 NowLen = InStr(Buffer, Chr(0)) - 1
148 Do While NowLen > 0
149 ReDim Preserve Strings(Index)
150 Strings(Index) = Left(Buffer, NowLen + 1)
151 Buffer = Right(Buffer, Len(Buffer) - NowLen - 1)
152 NowLen = InStr(Buffer, Chr(0)) - 1
153 Index = Index + 1
154 Loop
155 End If
156 End Sub
157
158 Public Sub ReadSections(ByRef Strings() As String)
159 Dim Buffer As String
160 Dim NowLen As Long
161 Dim Index As Long
162 Index = 0
163 ReDim Strings(Index)
164 Buffer = String$(16384, Chr(0))
165 If GetPrivateProfileString(vbNullString, CStr(vbNullString), vbNullString, Buffer, Len(Buffer), FFileName) <> 0 Then
166 NowLen = InStr

鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
Matlab基础刻意练习笔记(1)发布时间:2022-07-18
下一篇:
Matlab:回归分析(2)发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap