1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
|
'encoding UTF-8 Do not remove or change this line!
'**************************************************************************
' DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
'
' Copyright 2000, 2010 Oracle and/or its affiliates.
'
' OpenOffice.org - a multi-platform office productivity suite
'
' This file is part of OpenOffice.org.
'
' OpenOffice.org is free software: you can redistribute it and/or modify
' it under the terms of the GNU Lesser General Public License version 3
' only, as published by the Free Software Foundation.
'
' OpenOffice.org is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU Lesser General Public License version 3 for more details
' (a copy is included in the LICENSE file that accompanied this code).
'
' You should have received a copy of the GNU Lesser General Public License
' version 3 along with OpenOffice.org. If not, see
' <http://www.openoffice.org/license.html>
' for a copy of the LGPLv3 License.
'
'/************************************************************************
'*
'* owner : thorsten.bosbach@sun.com
'*
'* short description : routines to handle ini-files ( read/write items )
'*
'*****************************************************************
'*
' #1 GetIniValue ' get a value of an entry
' #1 GetIniValue2 ' subroutine for GetIniValue
' #1 SetIniValue ' set a value of an entry
' #1 SetIniValue2 ' subroutine for SetIniValue
' #1 ChangeExt ' change the extension of an file
' #1 AnhaengenAnDatei ' add a string into a file
' #1 DateiSperren ' set the hidden flag for file
' #1 DateiFreigeben ' reset the hidden flag for file
'*
'\****************************************************************
function GetIniValue ( Datei$, Gruppe$, Variable$ ) as String
'/// wrapper for GetIniValue2 ///'
'///+ reads a value from an ini-file ///'
'///+ INPUT : name of ini-file; name of group (the one in braces []); the item (left of '=') ///'
'///+ OUTPUT: value (the right of the '=') ///'
if Dir(Datei$) = "" then
Warnlog "Error in GetIniValue(...):" + Datei$ + " not found"
exit function
end if
GetIniValue = GetIniValue2( Datei$, Gruppe$, Variable$ ) ' Arbeiten
end function
function SetIniValue( Datei$, Gruppe$, Variable$, Value$ ) as String
'/// wrapper for SetIniValue2 ///'
'///+ writes a value to an ini-file ///'
'///+ INPUT : name of ini-file; name of group (the one in braces []); the item (left of '='); value (the right of the '=') ///'
'///+ OUTPUT: - ///'
Dim FileNum as Integer
if Dir(Datei$) = "" then
WarnLog "Error in SetIniValue(...):" + Datei$ + " not found. File will be created now!"
FileNum = FreeFile
Open Datei$ For Output As #FileNum ' make empty file
Print #FileNum, ""
Close #FileNum
end if
SetIniValue = SetIniValue2( Datei$, Gruppe$, Variable$, Value$ )
end function
function GetIniValue2( Datei$, Gruppe$, Variable$ ) as String
'/// see the wrapper for it : GetIniValue ///'
Dim FileNum% : Dim GruppeOK% : Dim Pos% : Dim IniZeile$ : Dim IniZeile2$
FileNum% = FreeFile
GruppeOK%=FALSE
GetIniValue2 = ""
Open Datei$ For Input As #FileNum%
do until EOF(#FileNum%) = True
Line input #FileNum%, IniZeile$
IniZeile$ = TRIM(IniZeile$)
iniZeile2$ = UCASE( IniZeile$ ) ' compare case insensitive
if GruppeOK% = FALSE then ' still no group
if IniZeile2$= "[" + UCASE( Gruppe$ ) + "]" then 'Is it the wanted group?
GruppeOK% = TRUE
end if
else
If Left(IniZeile2$, 1) = "[" then 'sadly new group - goodby
Exit do
else
Pos% = Instr( IniZeile2$, "=" ) 'is the item valid?
if Pos%>0 then ' '=' not found
if Left( IniZeile2$ , Pos%-1 ) = UCASE( Variable$ ) then 'compare leftvalue
GetIniValue2 = Trim(Mid$( IniZeile$ , Pos%+ 1 )) 'return part right of '=' : with initial case
exit do
end if
end if
end if
end if
loop
Close #FileNum%
wait 1000
end function
sub SetIniValue2( Datei$, Gruppe$, Variable$, Value$ ) as String
'/// see the wrapper for it : SetIniValue ///'
Dim DateiBak$ : Dim D$ : Dim IniZeile$ : Dim IniZeile2$
Dim FileBak% : Dim GruppeOK% : Dim Gefunden% : Dim FileNum% : Dim Pos%
' rename
DateiBak$ = ChangeExt( Datei$, "BAK" )
GruppeOK% = FALSE
Gefunden% = FALSE
if Dir(DateiBak$)<>"" then
kill DateiBak$
end if
if Dir( Datei$ )<>"" then
D$ = CurDir
name Datei$ as DateiBak$
else
FileNum% = FreeFile
Open Datei$ For Output As #FileNum%
Print #FileNum%, "[" + Trim(Gruppe$) + "]"
Print #FileNum%, Variable$ + "=" + Trim(Value$)
Close #FileNum% ' finished here
Exit sub
endif
FileNum% = FreeFile
Open Datei$ For Output As #FileNum%
FileBak% = FreeFile
Open DateiBak$ For Input As #FileBak%
do until EOF(#FileBak%) = True
Line input #FileBak%, IniZeile$
IniZeile$ = TRIM(IniZeile$)
if IniZeile$ <> "" then
IniZeile2$ = UCASE( IniZeile$ )
if Left(IniZeile$, 1) = "[" then
if GruppeOK% = TRUE then 'groupchange
if Gefunden%=FALSE then
Print #FileNum%, Variable$ + "=" + Trim(Value$)
Gefunden% = TRUE
end if
GruppeOK% = FALSE
end if
Print #FileNum%, "" 'empty line
Print #FileNum%, IniZeile$
if IniZeile2$= "[" + UCASE( Gruppe$ ) + "]" then
GruppeOK% = TRUE
end if
else
if GruppeOK% = TRUE then ' found group
Pos% = Instr( IniZeile$, "=" )
if Left( IniZeile2$ , Pos%-1 ) = UCASE( Variable$ ) then
IniZeile$ = Left( IniZeile$ , Pos% ) +Trim( Value$ )' after the '='
Gefunden% = TRUE
end if
end if
Print #FileNum%, IniZeile$
end if
end if
loop
if Gefunden% = FALSE then
' set new group and value
if GruppeOK%=FALSE then
Print #FileNum%, ""
Print #FileNum%, "[" + Trim(Gruppe$) + "]"
end if
Print #FileNum%, Variable$ + "=" + Value$
end if
Close #FileNum%
Close #FileBak%
wait 1000
end sub
sub AnhaengenAnDatei ( Datei as String, Texte as String )
'/// append a string at the end of the file ///'
'///+ INPUT : filename; string///'
'///+ OUTPUT: - ///'
Dim FileNum%
FileNum% = FreeFile
Open Datei for Append as #FileNum%
Print #FileNum%, Texte
Close #FileNum%
end sub
function ChangeExt( Datei$, Ext$ )as String
'/// change the extension of a file ///'
'///+ INPUT : filename; extension ///'
'///+ OUTPUT: - ///'
Dim i%
i% = InStr( Right(Datei$, 4 ) , "." )
if Ext$<>"" then
if i%=0 then
ChangeExt = Datei$ +"."+Ext$
else
ChangeExt = Left( Datei$, Len(Datei$)-4+i% ) + Ext$
end if
elseif i%<>0 then
ChangeExt = Left( Datei$, Len(Datei$)-5+i% )
end if
end function
sub DateiSperren( Datei$ )
'/// set the hidden flag of a file; lock the file ///'
'///+ INPUT : filename ///'
'///+ OUTPUT: - ///'
Dim i%
if FileExists ( Datei$ ) <> TRUE then
Warnlog "File '" + Datei$ + "' doesn't exist; exiting now!"
exit sub
end if
i% = GetAttr( Datei$ )
do while (i% AND 2) = 2 ' is file already locked?
Wait( int( 400 * Rnd + 5 )
i% = GetAttr( Datei$ )
loop
SetAttr( Datei$ , i% OR 2 ) ' Lock
exit sub
end sub
sub DateiFreigeben( Datei$ )
'/// reset the hidden flag of a file; release the file ///'
'///+ INPUT : filename ///'
'///+ OUTPUT: - ///'
Dim i%
if FileExists ( Datei$ ) <> TRUE then
Warnlog "File '" + Datei$ + "' doesn't exist; exiting now!"
exit sub
end if
i% = GetAttr( Datei$ )
SetAttr( Datei$ , i% AND NOT 2 ) ' release
exit sub
end Sub
|
