source: trunk/Library/FileUtilsUnit.pas@ 388

Last change on this file since 388 was 388, checked in by RBRi, 9 years ago

move some libs to library folder
  • Property svn:eol-style set to native
File size: 14.6 KB
RevLine 
[82]1Unit FileUtilsUnit;
2
3// NewView - a new OS/2 Help Viewer
4// Copyright 2006/2007 Ronald Brill (rbri at rbri dot de)
5// This software is released under the GNU Public License - see readme.txt
6
7// Helper functions for file handling
8
9Interface
10
11uses
12 Classes,
13 ACLUtility;
14
15
16const
17 DirectorySeparator = '\';
18 PATH_SEPARATOR = ';';
19
20 // TODO
21 HelpPathEnvironmentVar = 'HELP';
22 BookshelfEnvironmentVar = 'BOOKSHELF';
23 LanguageEnvironmentVar = 'LANG';
24 DEFAULT_LANGUAGE = 'EN_US';
25 HELP_FILE_EXTENSION = '.hlp';
[289]26 INF_FILE_EXTENSION = '.inf';
[82]27
28
29 // Adds a slash to the end of dir if not present
30 // if aDir is empty this returns '\'
31 Function AddDirectorySeparator(aDirectory : String) : String;
32
33 // Adds a slash to the end of dir if not present
34 // if aDir is empty this returns ''
35 Function AddDirectorySeparatorIfNotEmpty(aDirectory: String) : String;
36
37 // Removes a directory seperator from the end of aDirectory
38 // (if present)
39 Function RemoveRightDirectorySeparator(aDirectory : String) : String;
40
41 // Expands the path given, relative to aBaseDirectory
42 // Handles leading \ for root dir,
43 // .. for parent, . (ignored),
44 // drive spec at start,
45 // ignores repeated \ e.g. \\
46 Function ExpandPath(aBaseDirectory : String; aPath : String): String;
47
48 Function GetLogFilesDir: String;
49
50 Function SearchPath(const aPathEnvVar: String; const aFilename: String; var aResultFilename: String) : boolean;
51
52 Function SearchHelpPaths(const aFilename: String; var aResultFilename: String; const anIncludeAppDir: boolean) : boolean;
53
54 // Find the help file for the current app based on LANG
55 Function FindDefaultLanguageHelpFile(const anApplicationName: String; const aLanguage : String) : String;
56
57 // Breaks up specified Env var path
[97]58 // this always clears the list at the beginning
[82]59 Procedure GetDirsInPath(const aPathEnvVar: String; var aList: TStrings);
60
61 // searches for all files in aDirectory matching aFilter and add
62 // them to aList
63 // it is possible to define different filter if you separate them by semicolon
[97]64 Procedure ListFilesInDirectory( const aDirectory : String;
65 const aFilter : String;
66 const aWithDirectoryFlag : boolean;
67 var aList : TStrings);
[82]68
69 // searches for all directories in aDirectory and add them to aList
70 Procedure ListSubDirectories(const aDirectory: String; var aList: TStrings);
71
72 Procedure ListFilesInDirectoryRecursiveWithTermination(const aDirectory : String;
73 const aFilter : String;
[97]74 const aWithDirectoryFlag : boolean;
[82]75 var aList : TStrings;
76 const aTerminateCheck : TTerminateCheck;
77 const aUseTerminateCheck : boolean);
78
79 Function ParentDir(const aDirectory : String) : String;
80
81 Function DirectoryExists(const aDirectory : String) : boolean;
82
83Implementation
84
85uses
86 Dos,
87 BseDos,
88 Os2Def,
89 SysUtils,
90 StringUtilsUnit;
91
92 Function AddDirectorySeparator(aDirectory : String) : String;
93 begin
94 if aDirectory = '' then
95 begin
96 Result:= DirectorySeparator;
97 exit;
98 end;
99
100 if aDirectory[length(aDirectory)] <> DirectorySeparator then
101 begin
102 Result := aDirectory + DirectorySeparator;
103 exit;
104 end;
105
106 Result := aDirectory;
107 end;
108
109
110 Function AddDirectorySeparatorIfNotEmpty(aDirectory: String): String;
111 begin
112 if aDirectory = '' then
113 begin
114 Result := '';
115 exit;
116 end;
117 Result := AddDirectorySeparator(aDirectory);
118 end;
119
120
121 Function RemoveRightDirectorySeparator(aDirectory : String) : String;
122 begin
123 Result := StrTrimRightChars(aDirectory, [DirectorySeparator]);
124 end;
125
126
127 Function ExpandPath(aBaseDirectory : String; aPath : String): String;
128 var
129 tmpDirectory: String;
130 tmpDirectories : TStringList;
131 i : integer;
132 begin
133 Result:= aBaseDirectory;
134
135 if aPath = '' then
136 begin
137 Result := StrTrimRightChars(Result, [DirectorySeparator]);
138 exit;
139 end;
140
141 aPath := trim(aPath);
142 if Length(aPath) > 1 then
143 begin
144 // check for drive spec
145 if aPath[2] = ':' then
146 begin
147 Result := AddDirectorySeparator(aPath);
148 if Length(aPath) > 3 then
149 begin
150 Result := StrTrimRightChars(Result, [DirectorySeparator]);
151 end;
152 exit;
153 end
154 end;
155
156 if Length(aPath) > 0 then
157 begin
158 // check for root dir spec
159 if aPath[1] = DirectorySeparator then
160 begin
161 // take just the drive from the basedir
162 if aBaseDirectory[2] = ':' then
163 begin
164 Result := StrLeft(aBaseDirectory, 2);
165 end
166 else
167 begin
168 Result := DirectorySeparator;
169 end;
170 aPath := StrTrimLeftChars(aPath, [DirectorySeparator]);
171 end;
172 end;
173
174 tmpDirectories := TStringList.Create;
175 StrExtractStringsIgnoreEmpty(tmpDirectories, aPath, [DirectorySeparator], #0);
176 for i := 0 to tmpDirectories.count-1 do
177 begin
178 tmpDirectory := tmpDirectories[i];
179 if tmpDirectory = '..' then
180 begin
181 if NOT ((Length(Result) = 2) AND (Result[2] = ':')) then
182 begin
183 Result := ParentDir(Result);
184 end;
185 end
186 else if tmpDirectory = '.' then
187 begin
188 ; // nothing to do
189 end
190 else
191 begin
192 Result := AddDirectorySeparator(Result) + tmpDirectory;
193 end;
194
195 // strip any extra leading slashes
196 aPath := StrTrimLeftChars(aPath, [DirectorySeparator]);
197 end;
198 tmpDirectories.Destroy;
199
200 if Length(Result) = 2 then
201 begin
202 if Result[2] = ':' then
203 begin
204 // just a drive spec X:, so add a slash
205 Result := Result + DirectorySeparator;
206 end;
207 end;
208 end;
209
210 Function GetLogFilesDir: String;
211 begin
212 // ecomstation 1.1 compat
213 Result := GetEnv('LOGFILES');
214 if Result <> '' then
215 begin
216 Result := AddDirectorySeparator(Result);
217 exit;
218 end;
219 // TODO
220 Result := AddDirectorySeparator(GetApplicationDir);
221 end;
222
223
224 Function SearchPath(const aPathEnvVar: String;
225 const aFilename: String;
226 var aResultFilename: String) : boolean;
227 var
228 tmpSzEnvVar : CString;
229 tmpSzFilename : CString;
230 tmpSzFilenameFound : CString;
231 tmpRC: APIRET;
232 begin
233 Result := false;
234 aResultFilename := '';
235
236 tmpSzEnvVar := aPathEnvVar;
237 tmpSzFilename := aFilename;
238 tmpRC := DosSearchPath( SEARCH_IGNORENETERRS
239 + SEARCH_ENVIRONMENT
240 + SEARCH_CUR_DIRECTORY,
241 tmpSzEnvVar,
242 tmpSzFilename,
243 tmpSzFilenameFound,
244 sizeof(tmpSzFilenameFound));
245 if tmpRC = 0 then
246 begin
247 Result := true;
248 aResultFilename := tmpSzFilenameFound;
249 end;
250 end;
251
252
253 Function SearchHelpPaths(const aFilename: String;
254 var aResultFilename: String;
255 const anIncludeAppDir: boolean) : boolean;
256 begin
257 Result := SearchPath(HelpPathEnvironmentVar, aFileName, aResultFilename);
258 if not Result then
259 begin
260 Result := SearchPath(BookshelfEnvironmentVar, aFileName, aResultFilename);
261 end;
262
263 if (not Result) and anIncludeAppDir then
264 begin
265 aResultFilename := AddDirectorySeparator(GetApplicationDir) + aFilename;
266 Result := FileExists(aResultFilename);
267 if not Result then
268 begin
269 aResultFilename := '';
270 end;
271 end;
272 end;
273
274
275 Function FindDefaultLanguageHelpFile(const anApplicationName: String; const aLanguage : String) : String;
276 var
277 tmpLanguage : String;
278 tmpLanguageParts : TStringList;
279 tmpMajorLanguage : String;
280 tmpMinorLanguage : String;
281 begin
282 Result := '';
283
284 tmpLanguage := aLanguage;
285 if aLanguage = '' then
286 begin
287 tmpLanguage := DEFAULT_LANGUAGE;
288 end;
289
290 tmpLanguageParts := TStringList.Create;
291 StrExtractStrings(tmpLanguageParts, tmpLanguage, ['_'], #0);
292
293 tmpMajorLanguage := '';
294 if tmpLanguageParts.count > 0 then
295 begin
296 tmpMajorLanguage := tmpLanguageParts[0];
297 end;
298
299 tmpMinorLanguage := '';
300 if tmpLanguageParts.count > 1 then
301 begin
302 tmpMinorLanguage := tmpMinorLanguage[1];
303 end;
304
305 tmpLanguageParts.Destroy;
306
307 // note there might be some other stuff on the end of LANG
308 // such as ES_ES_EURO...
309 if tmpMinorLanguage <> '' then
310 begin
311 if SearchHelpPaths( anApplicationName
312 + '_' + tmpMajorLanguage
313 + '_' + tmpMinorLanguage
314 + HELP_FILE_EXTENSION,
315 Result,
316 true ) then
317 begin
318 // found a specifc language
319 exit;
320 end;
321 end;
322
323 // try generic language?
324 if SearchHelpPaths( anApplicationName
325 + '_' + tmpMajorLanguage
326 + HELP_FILE_EXTENSION,
327 Result,
328 true ) then
329 begin
330 exit;
331 end;
332
333 // nothing specific, search for default
334 SearchHelpPaths(anApplicationName + HELP_FILE_EXTENSION, Result, true);
335 end;
336
337
338 Procedure GetDirsInPath(const aPathEnvVar: String; var aList: TStrings);
339 var
340 tmpRC : APIRET;
341 tmpPszPathEnvVar : PChar;
342 tmpSzEnvVar : CString;
343 begin
344 // do this in any case also if there is an error
345 // to garantie a defined behavior
346 aList.Clear;
347
348 tmpSzEnvVar := aPathEnvVar;
349 tmpRC := DosScanEnv(tmpSzEnvVar, tmpPszPathEnvVar);
350
351 if tmpRC <> 0 then
352 begin
353 exit;
354 end;
355
356 StrExtractStringsIgnoreEmpty(aList, StrPas(tmpPszPathEnvVar), [PATH_SEPARATOR], #0);
357 end;
358
359
[97]360 Procedure ListFilesInDirectory( const aDirectory: String;
361 const aFilter: String;
362 const aWithDirectoryFlag: boolean;
363 var aList: TStrings);
[82]364 var
365 tmpRC : APIRET;
366 tmpSearchResults: TSearchRec;
367 tmpMask: String;
368 tmpFilterParts : TStringList;
[97]369 tmpDirectory : String;
[82]370 i : integer;
371 begin
372 tmpFilterParts := TStringList.Create;
373 StrExtractStrings(tmpFilterParts, aFilter, [PATH_SEPARATOR], #0);
374
375 for i:=0 to tmpFilterParts.count-1 do
376 begin
377 tmpMask := tmpFilterParts[i];
[97]378 tmpDirectory := AddDirectorySeparator(aDirectory);
379 tmpRC := FindFirst(tmpDirectory + tmpMask, faAnyFile, tmpSearchResults);
[82]380
381 while tmpRC = 0 do
382 begin
383 if tmpSearchResults.Attr And faDirectory = 0 then
384 begin
[97]385 if (aWithDirectoryFlag) then
386 begin
387 aList.Add(tmpDirectory + tmpSearchResults.Name);
388 end
389 else
390 begin
391 aList.Add(tmpSearchResults.Name);
392 end;
[82]393 end;
394
395 tmpRC := FindNext(tmpSearchResults);
396 end;
397
398 FindClose(tmpSearchResults);
399 end;
400 tmpFilterParts.Destroy;
401 end;
402
403
404 Procedure ListSubDirectories(const aDirectory: String; var aList: TStrings);
405 var
406 tmpRC : APIRET;
407 tmpSearchResults: TSearchRec;
408 tmpName : String;
409 begin
410
411 tmpRC := FindFirst(AddDirectorySeparator(aDirectory) + '*', faDirectory or faMustDirectory, tmpSearchResults);
412 if (tmpRC <> 0) then
413 begin
414 exit;
415 end;
416
417 while tmpRC = 0 do
418 begin
419 tmpName := tmpSearchResults.Name;
420 if (tmpName <> '.') AND (tmpName <> '..') then
421 begin
422 aList.Add(AddDirectorySeparatorIfNotEmpty(aDirectory) + tmpSearchResults.Name );
423 end;
424 tmpRC := FindNext(tmpSearchResults);
425 end;
426 FindClose(tmpSearchResults);
427 end;
428
429
430 Procedure ListFilesInDirectoryRecursiveWithTermination(const aDirectory : String;
431 const aFilter : String;
[97]432 const aWithDirectoryFlag : boolean;
[82]433 var aList : TStrings;
434 const aTerminateCheck : TTerminateCheck;
435 const aUseTerminateCheck : boolean);
436 var
437 i : integer;
438 tmpSubDirectories : TStringList;
439 tmpSubDirectory : String;
440 begin
441 // at first add all files from the directory itself
[97]442 ListFilesInDirectory(aDirectory, aFilter, aWithDirectoryFlag, aList);
[82]443
444 // now determine all subdirectories
445 tmpSubDirectories := TStringList.Create;
446 ListSubDirectories(aDirectory, tmpSubDirectories);
447
448 for i := 0 to tmpSubDirectories.Count - 1 do
449 begin
450 // if Assigned( TerminateCheck ) then - doesn't work in sibyl
451 if aUseTerminateCheck then
452 if aTerminateCheck then
453 break;
454
455 tmpSubDirectory := tmpSubDirectories[i];
456
[97]457 ListFilesInDirectoryRecursiveWithTermination(tmpSubDirectory, aFilter, aWithDirectoryFlag, aList, aTerminateCheck, aUseTerminateCheck);
[82]458 end;
459 tmpSubDirectories.Destroy;
460 end;
461
462
463 Function ParentDir(const aDirectory : String) : String;
464 var
465 tmpPos: integer;
466 begin
467 tmpPos := Length(aDirectory);
468
469 // ends with slash
470 while (aDirectory[tmpPos] = DirectorySeparator) AND (tmpPos > 0) do
471 begin
472 dec(tmpPos);
473 end;
474
475 // find slash
476 while (aDirectory[tmpPos] <> DirectorySeparator) AND (tmpPos > 0) do
477 begin
478 dec(tmpPos);
479 end;
480
481 result:= StrLeft(aDirectory, tmpPos-1);
482 end;
483
484
485 Function DirectoryExists(const aDirectory : String) : boolean;
486 Var
487 tmpRC : APIRET;
488 tmpSearchResults : TSearchRec;
489 tmpDriveMap : ULONG;
490 tmpActualDrive : ULONG;
491 tmpDrive : Char;
492 tmpDriveNum : integer;
493 tmpDriveBit : longword;
494 tmpDirectory : String;
495 Begin
496 Result := false;
497 tmpDirectory := RemoveRightDirectorySeparator(aDirectory);
498 if tmpDirectory = '' then
499 begin
500 Result:= true;
501 exit;
502 end;
503
504 if Length(tmpDirectory) = 2 then
505 begin
506 if tmpDirectory[2] = ':' then
507 begin
508 // a drive only has been specified
509 tmpDrive:= UpCase(tmpDirectory[1] );
510 if (tmpDrive < 'A') or (tmpDrive > 'Z') then
511 begin
512 // invalid drive; return false;
513 exit;
514 end;
515
516 DosQueryCurrentDisk(tmpActualDrive, tmpDriveMap);
517 tmpDriveNum := Ord(tmpDrive) - Ord('A') + 1; // A -> 1, B -> 2...
518 tmpDriveBit := 1 shl (tmpDriveNum-1); // 2^DriveNum
519
520 Result := tmpDriveMap and (tmpDriveBit) > 0;
521 exit;
522 end;
523 end;
524
525 tmpRC := FindFirst(tmpDirectory, faDirectory or faMustDirectory, tmpSearchResults);
526 if tmpRC = 0 then
527 begin
528 Result:= true;
529 FindClose(tmpSearchResults);
530 end;
531 end;
532
533
534Initialization
535End.
Note: See TracBrowser for help on using the repository browser.