lazarus/components/lazutils/lazutf8classes.pas
bart bf3f2431f6 LazUtils: fix LazFileUtils.FileIsText when filename has unicode characters outside currrent codepage on Windows.
Needs refactoring of LazUtf8Classes (use LazFileUtils instead of FileUtil).
Next step in moving UTF89 file routines to LazFileUil.

git-svn-id: trunk@41209 -
2013-05-15 16:52:42 +00:00

162 lines
3.7 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);
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.