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
|
{
fpGUI - Free Pascal GUI Library
Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
for details about redistributing fpGUI.
This program 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.
Description:
Abstracted OS specific function to work in a cross-platfrom manner.
}
unit fpg_utils;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpg_base;
// *** Platform specific functions ***
function fpgToOSEncoding(aString: TfpgString): string;
function fpgFromOSEncoding(aString: string): TfpgString;
procedure fpgOpenURL(const aURL: TfpgString);
// *** Common functions for all platforms ***
function fpgAddTrailingValue(const ALine, AValue: TfpgString; ADuplicates: boolean = true): TfpgString;
// RTL wrapper filesystem functions with platform independant encoding
// These functions are common for all platforms and rely on fpgXXXPlatformEncoding
function fpgFindFirst(const Path: TfpgString; Attr: Longint; out Rslt: TSearchRec): Longint;
function fpgFindNext(var Rslt: TSearchRec): Longint;
function fpgGetCurrentDir: TfpgString;
function fpgSetCurrentDir(const NewDir: TfpgString): Boolean;
function fpgExpandFileName(const FileName: TfpgString): TfpgString;
function fpgFileExists(const FileName: TfpgString): Boolean;
function fpgAppendPathDelim(const Path: TfpgString): TfpgString;
function fpgHasSubDirs(const Dir: TfpgString; AShowHidden: Boolean): Boolean;
implementation
{ No USES clause is allowed here! Add it to the include file shown below. }
// Platform specific encoding handling functions
{$I fpg_utils_impl.inc}
function fpgAddTrailingValue(const ALine, AValue: TfpgString; ADuplicates: boolean = true): TfpgString;
begin
if ALine = '' then
begin
result := ALine;
Exit; //==>
end;
if ADuplicates then
begin
result := ALine + AValue;
Exit; //==>
end;
if (not SameText(Copy(ALine, Length(ALine) - Length(AValue) + 1, Length(AValue)), AValue)) then
result := ALine + AValue
else
result := ALine;
end;
function fpgFindFirst(const Path: TfpgString; Attr: Longint; out
Rslt: TSearchRec): Longint;
begin
Result := FindFirst(fpgToOSEncoding(Path), Attr, Rslt);
Rslt.Name := fpgFromOSEncoding(Rslt.Name);
end;
function fpgFindNext(var Rslt: TSearchRec): Longint;
begin
Result := FindNext(Rslt);
Rslt.Name := fpgFromOSEncoding(Rslt.Name);
end;
function fpgGetCurrentDir: TfpgString;
begin
Result := fpgFromOSEncoding(GetCurrentDir);
end;
function fpgSetCurrentDir(const NewDir: TfpgString): Boolean;
begin
Result := SetCurrentDir(fpgToOSEncoding(NewDir));
end;
function fpgExpandFileName(const FileName: TfpgString): TfpgString;
begin
Result := fpgFromOSEncoding(ExpandFileName(fpgToOSEncoding(FileName)));
end;
function fpgFileExists(const FileName: TfpgString): Boolean;
begin
Result := FileExists(fpgToOSEncoding(FileName));
end;
function fpgAppendPathDelim(const Path: TfpgString): TfpgString;
begin
if (Path <> '') and (Path[length(Path)] <> PathDelim) then
Result := Path + PathDelim
else
Result := Path;
end;
{function fpgHasSubDirs returns True if the directory passed has subdirectories}
function fpgHasSubDirs(const Dir: TfpgString; AShowHidden: Boolean): Boolean;
var
FileInfo: TSearchRec;
FCurrentDir: TfpgString;
begin
//Assume No
Result := False;
if Dir <> '' then
begin
FCurrentDir := fpgAppendPathDelim(Dir);
FCurrentDir := FCurrentDir + AllFilesMask;
try
if fpgFindFirst(FCurrentDir, faAnyFile or $00000080, FileInfo) = 0 then
repeat
if FileInfo.Name = '' then
Continue;
// check if special file
if ((FileInfo.Name = '.') or (FileInfo.Name = '..')) or
// unix dot directories (aka hidden directories)
((FileInfo.Name[1] in ['.']) and AShowHidden) or
// check Hidden attribute
(((faHidden and FileInfo.Attr) > 0) and AShowHidden) then
Continue;
Result := ((faDirectory and FileInfo.Attr) > 0);
//We found at least one non special dir, that's all we need.
if Result then
break;
until fpgFindNext(FileInfo) <> 0;
finally
FindClose(FileInfo);
end;
end;
end;
end.
|
