mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-02 19:23:40 +02:00
151 lines
3.4 KiB
ObjectPascal
151 lines
3.4 KiB
ObjectPascal
unit lazutf8classes;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, fileutil, lazutf8;
|
|
|
|
type
|
|
TFileStreamUTF8 = class(THandleStream)
|
|
private
|
|
FFileName: utf8string;
|
|
public
|
|
constructor Create(const AFileName: utf8string; Mode: Word);
|
|
constructor Create(const AFileName: utf8string; Mode: Word; Rights: Cardinal);
|
|
destructor Destroy; override;
|
|
property FileName: utf8string Read FFilename;
|
|
end;
|
|
|
|
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;
|
|
|
|
procedure LoadStringsFromFileUTF8(List: TStrings; const FileName: string);
|
|
procedure SaveStringsToFileUTF8(List: TStrings; const FileName: string);
|
|
|
|
implementation
|
|
|
|
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;
|
|
|
|
constructor TFileStreamUTF8.Create(const AFileName: utf8string; Mode: Word);
|
|
var
|
|
lHandle: THandle;
|
|
begin
|
|
FFileName:= AFileName;
|
|
if Mode = fmcreate then
|
|
lHandle:= FileCreateUTF8(AFileName)
|
|
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
|
|
inherited Create(lHandle);
|
|
end;
|
|
|
|
constructor TFileStreamUTF8.Create(const AFileName: utf8string; Mode: Word; Rights: Cardinal);
|
|
var
|
|
lHandle: THandle;
|
|
begin
|
|
FFileName:=AFileName;
|
|
if Mode=fmcreate then
|
|
lHandle:=FileCreateUTF8(AFileName,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
|
|
inherited Create(lHandle);
|
|
end;
|
|
|
|
destructor TFileStreamUTF8.Destroy;
|
|
begin
|
|
FileClose(Handle);
|
|
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.
|
|
|