source: branches/2.19.1/NewView/FileUtilsUnit.pas@ 265

Last change on this file since 265 was 97, checked in by RBRi, 18 years ago

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