lazarus/components/lazutils/lazutf8classes.pas
bart b759d82dab TFileStreamUTF8.Create: fix error when mode = fmCreate or fmSomeShareMode.
Respect mode parameter when creating a file.

git-svn-id: trunk@41331 -
2013-05-20 16:47:52 +00:00

146 lines
3.3 KiB
ObjectPascal

unit lazutf8classes;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, 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);
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;
constructor TFileStreamUTF8.Create(const AFileName: utf8string; Mode: Word);
begin
Create(AFileName,Mode,438);
end;
constructor TFileStreamUTF8.Create(const AFileName: utf8string; 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
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.