diff --git a/.gitattributes b/.gitattributes index ba089917ec..45cafcf6f5 100644 --- a/.gitattributes +++ b/.gitattributes @@ -5638,6 +5638,7 @@ lcl/lazconfigstorage.pas svneol=native#text/pascal lcl/lazhelphtml.pas svneol=native#text/pascal lcl/lazhelpintf.pas svneol=native#text/pascal lcl/lazlinkedlist.pas svneol=native#text/pascal +lcl/lazutf8classes.pas svneol=native#text/pascal lcl/lcl_calc_images.lrs svneol=native#text/pascal lcl/lcl_dbgrid_images.lrs svneol=native#text/pascal lcl/lcl_dbnav_images.lrs svneol=native#text/pascal diff --git a/lcl/alllclunits.pp b/lcl/alllclunits.pp index 3f0567a69d..478d2d49cd 100644 --- a/lcl/alllclunits.pp +++ b/lcl/alllclunits.pp @@ -25,7 +25,7 @@ uses WSExtCtrls, WSExtDlgs, WSFactory, WSForms, WSGrids, WSImgList, WSLCLClasses, WSMenus, WSPairSplitter, WSProc, WSReferences, WSSpin, WSStdCtrls, WSToolwin, ActnList, Arrow, AsyncProcess, AvgLvlTree, ButtonPanel, Buttons, - Calendar, RegisterLCL, ValEdit, LazarusPackageIntf; + Calendar, RegisterLCL, ValEdit, lazutf8classes, LazarusPackageIntf; implementation diff --git a/lcl/fileutil.pas b/lcl/fileutil.pas index da1c17c7ad..f23829cd85 100644 --- a/lcl/fileutil.pas +++ b/lcl/fileutil.pas @@ -213,6 +213,9 @@ function SetCurrentDirUTF8(const NewDir: String): Boolean; function CreateDirUTF8(const NewDir: String): Boolean; function RemoveDirUTF8(const Dir: String): Boolean; function ForceDirectoriesUTF8(const Dir: string): Boolean; +function FileOpenUTF8(Const FileName : utf8string; Mode : Integer) : THandle; +function FileCreateUTF8(Const FileName : utf8String) : THandle; overload; +function FileCreateUTF8(Const FileName : utf8String; Rights: Cardinal) : THandle; overload; // environment function ParamStrUTF8(Param: Integer): string; diff --git a/lcl/include/unixfileutil.inc b/lcl/include/unixfileutil.inc index 8bc18144c3..945e03d139 100644 --- a/lcl/include/unixfileutil.inc +++ b/lcl/include/unixfileutil.inc @@ -377,6 +377,21 @@ begin Result:=SysUtils.DirectoryExists(UTF8ToSys(Directory)); end; +function FileOpenUTF8(Const FileName : utf8string; Mode : Integer) : THandle; +begin + Result := SysUtils.FileOpen(FileName, Mode); +end; + +function FileCreateUTF8(Const FileName : utf8string) : THandle; +begin + Result := SysUtils.FileCreate(FileName); +end; + +function FileCreateUTF8(Const FileName : utf8String; Rights: Cardinal) : THandle; +begin + Result := SysUtils.FileCreate(FileName, Rights); +end; + procedure InitFileUtils; begin end; diff --git a/lcl/include/winfileutil.inc b/lcl/include/winfileutil.inc index faa5e87d0c..20bd6ad647 100644 --- a/lcl/include/winfileutil.inc +++ b/lcl/include/winfileutil.inc @@ -588,6 +588,37 @@ begin Result:=False; end; +function FileOpenUTF8(Const FileName : utf8string; Mode : Integer) : THandle; +const + AccessMode: array[0..2] of Cardinal = ( + GENERIC_READ, + GENERIC_WRITE, + GENERIC_READ or GENERIC_WRITE); + ShareMode: array[0..4] of Integer = ( + 0, + 0, + FILE_SHARE_READ, + FILE_SHARE_WRITE, + FILE_SHARE_READ or FILE_SHARE_WRITE); +begin + Result := CreateFileW(PWideChar(UTF8Decode(FileName)), dword(AccessMode[Mode and 3]), + dword(ShareMode[(Mode and $F0) shr 4]), nil, OPEN_EXISTING, + FILE_ATTRIBUTE_NORMAL, 0); + //if fail api return feInvalidHandle (INVALIDE_HANDLE=feInvalidHandle=-1) +end; + +function FileCreateUTF8(Const FileName : utf8string) : THandle; +begin + Result := CreateFileW(PWideChar(UTF8Decode(FileName)), GENERIC_READ or GENERIC_WRITE, + 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); +end; + +function FileCreateUTF8(Const FileName : utf8String; Rights: Cardinal) : THandle; +begin + Result := CreateFileW(PWideChar(UTF8Decode(FileName)), GENERIC_READ or GENERIC_WRITE, + 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); +end; + procedure InitFileUtils; begin {$ifndef WinCE} diff --git a/lcl/lazutf8classes.pas b/lcl/lazutf8classes.pas new file mode 100644 index 0000000000..374058c397 --- /dev/null +++ b/lcl/lazutf8classes.pas @@ -0,0 +1,108 @@ +unit lazutf8classes; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fileutil; + +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; + procedure LoadFromFile(const FileName: string); override; + procedure SaveToFile(const FileName: string); override; + public + end; + +implementation + +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 + Result := CompareText(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. + diff --git a/lcl/lclbase.lpk b/lcl/lclbase.lpk index 6bffa1aa8c..2c59532e86 100644 --- a/lcl/lclbase.lpk +++ b/lcl/lclbase.lpk @@ -10,8 +10,14 @@ - 'win' then UnitPath := 'nonwin32';"/> + + + + + + @@ -31,7 +37,7 @@ - + @@ -1215,6 +1221,10 @@ + + + +