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
|
{
**********************************************************************
This file is part of LazUtils.
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
**********************************************************************
}
unit LazUTF8Classes;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LazUTF8;
type
{ TFileStreamUTF8 }
TFileStreamUTF8 = class(TFileStream)
private
FFileName: string;
public
constructor Create(const AFileName: string; Mode: Word);
constructor Create(const AFileName: string; Mode: Word; Rights: Cardinal);
property FileName: string Read FFilename;
end;
{ TStringListUTF8 }
TStringListUTF8 = class(TStringList)
protected
function DoCompareText(const s1,s2 : string) : PtrInt; override;
public
procedure LoadFromFile(const FileName: string); override;
procedure SaveToFile(const FileName: string); override;
end;
{ TMemoryStreamUTF8 }
TMemoryStreamUTF8 = class(TMemoryStream)
public
procedure LoadFromFile(const FileName: string);
procedure SaveToFile(const FileName: string);
end;
procedure LoadStringsFromFileUTF8(List: TStrings; const FileName: string);
procedure SaveStringsToFileUTF8(List: TStrings; const FileName: string);
function CompareStringListItemsUTF8LowerCase(List: TStringList; Index1, Index2: Integer): Integer;
implementation
uses
LazFileUtils; //avoid circular reference with LazFileUtils
procedure LoadStringsFromFileUTF8(List: TStrings; const FileName: string);
var
uList: TStringListUTF8;
begin
if List is TStringListUTF8 then
begin
List.LoadFromFile(FileName);
exit;
end;
uList:=TStringListUTF8.Create;
try
uList.LoadFromFile(FileName);
List.Assign(uList);
finally
uList.Free;
end;
end;
procedure SaveStringsToFileUTF8(List: TStrings; const FileName: string);
var
uList: TStringListUTF8;
begin
if List is TStringListUTF8 then
begin
List.SaveToFile(FileName);
exit;
end;
uList:=TStringListUTF8.Create;
try
uList.Assign(List);
uList.SaveToFile(FileName);
finally
uList.Free;
end;
end;
function CompareStringListItemsUTF8LowerCase(List: TStringList; Index1,
Index2: Integer): Integer;
begin
Result:=CompareStr(UTF8LowerCase(List[Index1]),UTF8LowerCase(List[Index2]));
end;
{ TMemoryStreamUTF8 }
procedure TMemoryStreamUTF8.LoadFromFile(const FileName: string);
var
S: TFileStreamUTF8;
begin
S:=TFileStreamUTF8.Create (FileName,fmOpenRead or fmShareDenyWrite);
Try
LoadFromStream(S);
finally
S.free;
end;
end;
procedure TMemoryStreamUTF8.SaveToFile(const FileName: string);
var
S: TFileStreamUTF8;
begin
S:=TFileStreamUTF8.Create (FileName,fmCreate);
Try
SaveToStream(S);
finally
S.free;
end;
end;
constructor TFileStreamUTF8.Create(const AFileName: string; Mode: Word);
begin
Create(AFileName,Mode,438);
{ Rights 438 is the default in the FCL TFileStream
Under Unix:
438 = &666 = owner/group/others can read/write
Note: the real rights are "Rights and not umask"
Under Windows Rights is not used.
}
end;
constructor TFileStreamUTF8.Create(const AFileName: string; Mode: Word; Rights: Cardinal);
var
lHandle: THandle;
begin
FFileName:=AFileName;
if (Mode and fmCreate) > 0 then
lHandle:=FileCreateUTF8(AFileName,Mode,Rights)
else
lHandle:=FileOpenUTF8(AFileName,Mode);
if (THandle(lHandle)=feInvalidHandle) then
begin
if Mode=fmcreate then
raise EFCreateError.createfmt({SFCreateError}'Unable to create file "%s"',[AFileName])
else
raise EFOpenError.Createfmt({SFOpenError}'Unable to open file "%s"',[AFilename]);
end
else
THandleStream(Self).Create(lHandle);
end;
function TStringListUTF8.DoCompareText(const s1, s2: string): PtrInt;
begin
if CaseSensitive then
Result:= UTF8CompareStr(s1,s2)
else
Result:= UTF8CompareText(s1,s2);
end;
procedure TStringListUTF8.LoadFromFile(const FileName: string);
var
TheStream: TFileStreamUTF8;
begin
TheStream:= TFileStreamUTF8.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(TheStream);
finally
TheStream.Free;
end;
end;
procedure TStringListUTF8.SaveToFile(const FileName: string);
var
TheStream: TFileStreamUTF8;
begin
TheStream:=TFileStreamUTF8.Create(FileName,fmCreate);
try
SaveToStream(TheStream);
finally
TheStream.Free;
end;
end;
end.
|
