View Issue Details

IDProjectCategoryView StatusLast Update
0035512LazarusLazUtilspublic2019-10-08 14:50
ReporterSerge AnvarovAssigned ToJuha Manninen 
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionreopened 
PlatformWindowsOSOS Version
Product Version2.1 (SVN)Product Build 
Target VersionFixed in Version 
Summary0035512: winlazfileutils.inc patch
DescriptionAt first, I found that the internal functions WinToDosTime and DosToWinTime used by functions FindFirstUtf8 and FindNextUtf8, incorrect work in Windows CE. They did not return a value through the parameter at all.
When I decided to fix this to code from SysUtils where everything works correctly, I found that most of the code repeats the code from SysUtils. Apparently all this was written in those days when RTL and SysUtils did not support Unicode.
As a result, I changed those functions that repeated SysUtils/RTL code to a direct call, removing all unnecessary now auxiliary functions/variables.
The result is presented as a patch,
TagsNo tags attached.
Fixed in Revisionr61165, r61999
LazTarget-
Widgetset
Attached Files
  • winlazfileutils.diff (12,343 bytes)
    Index: components/lazutils/winlazfileutils.inc
    ===================================================================
    --- components/lazutils/winlazfileutils.inc	(revision 61133)
    +++ components/lazutils/winlazfileutils.inc	(working copy)
    @@ -18,114 +18,33 @@
     
     // ******** Start of WideString specific implementations ************
     
    -const
    -  ShareModes: array[0..4] of Integer = (
    -               0,
    -               0,
    -               FILE_SHARE_READ,
    -               FILE_SHARE_WRITE,
    -               FILE_SHARE_READ or FILE_SHARE_WRITE);
    -
    -  AccessModes: array[0..2] of Cardinal  = (
    -    GENERIC_READ,
    -    GENERIC_WRITE,
    -    GENERIC_READ or GENERIC_WRITE);
    -
    -function WinToDosTime(Var Wtime : TFileTime; var DTime:longint):longbool;
    -var
    -  lft : TFileTime;
    -begin
    -  WinToDosTime:=FileTimeToLocalFileTime(WTime,lft{%H-})
    -    {$ifndef WinCE}
    -    and FileTimeToDosDateTime(lft,Longrec(Dtime).Hi,LongRec(DTIME).lo)
    -    {$endif}
    -    ;
    -end;
    -
    -Function DosToWinTime(DosTime:longint; Var Wintime : TFileTime):longbool;
    -var
    - lft : TFileTime;
    -begin
    - DosToWinTime:=
    -   {$ifndef wince}
    -   DosDateTimeToFileTime(longrec(DosTime).hi,longrec(DosTime).lo,@lft) and
    -   {$endif}
    -   LocalFileTimeToFileTime(lft,Wintime);                                        ;
    -end;
    -
     function GetCurrentDirUtf8: String;
    -{$ifndef WinCE}
     var
    -  w   : WideString;
    -  res : Integer;
    -  {$endif}
    +  U: UnicodeString;
     begin
    -  {$ifdef WinCE}
    -  Result := '\';
    -  // Previously we sent an exception here, which is correct, but this causes
    -  // trouble with code which isnt tested for WinCE, so lets just send a dummy result instead
    -  // Exception.Create('[GetCurrentDirWide] The concept of the current directory doesn''t exist in Windows CE');
    -  {$else}
    -  res:=GetCurrentDirectoryW(0, nil);
    -  SetLength(w, res);
    -  res:=Windows.GetCurrentDirectoryW(res, @w[1]);
    -  SetLength(w, res);
    -  Result:=UTF8Encode(w);
    -  {$endif}
    +  System.GetDir(0, U);
    +  Result := UTF8Encode(U);
     end;
     
     procedure GetDirUtf8(DriveNr: Byte; var Dir: String);
    -{This procedure may not be threadsafe, because SetCurrentDirectory isn't}
    -{$ifndef WinCE}
     var
    -  w, D: WideString;
    -  SavedDir: WideString;
    -  res : Integer;
    -{$endif}
    +  U: UnicodeString;
     begin
    -  {$ifdef WinCE}
    -  Dir := '\';
    -  // Previously we sent an exception here, which is correct, but this causes
    -  // trouble with code which isnt tested for WinCE, so lets just send a dummy result instead
    -  // Exception.Create('[GetCurrentDirWide] The concept of the current directory doesn''t exist in Windows CE');
    -  {$else}
    -  //writeln('GetDirWide START');
    -  if not (DriveNr = 0) then
    -  begin
    -    res := GetCurrentDirectoryW(0, nil);
    -    SetLength(SavedDir, res);
    -    res:=Windows.GetCurrentDirectoryW(res, @SavedDir[1]);
    -    SetLength(SavedDir,res);
    -
    -    D := WideChar(64 + DriveNr) + ':';
    -    if not SetCurrentDirectoryW(@D[1]) then
    -    begin
    -      Dir := Char(64 + DriveNr) + ':\';
    -      SetCurrentDirectoryW(@SavedDir[1]);
    -      Exit;
    -    end;
    -  end;
    -  res := GetCurrentDirectoryW(0, nil);
    -  SetLength(w, res);
    -  res := GetCurrentDirectoryW(res, @w[1]);
    -  SetLength(w, res);
    -  Dir:=UTF8Encode(w);
    -  if not (DriveNr = 0) then SetCurrentDirectoryW(@SavedDir[1]);
    -  //writeln('GetDirWide END');
    -  {$endif}
    +  {$PUSH}
    +  {$IOCHECKS OFF}
    +  GetDir(DriveNr, U);
    +  if IOResult = 0 then
    +    Dir := UTF8Encode(U)
    +  else
    +    Dir := Chr(DriveNr + Ord('A') - 1) + ':\'
    +  {$POP}
     end;
     
    -
     function FileOpenUtf8(Const FileName : string; Mode : Integer) : THandle;
    -
     begin
    -  Result := CreateFileW(PWideChar(UTF8Decode(FileName)), dword(AccessModes[Mode and 3]),
    -                         dword(ShareModes[(Mode and $F0) shr 4]), nil, OPEN_EXISTING,
    -                         FILE_ATTRIBUTE_NORMAL, 0);
    -  //if fail api return feInvalidHandle (INVALIDE_HANDLE=feInvalidHandle=-1)
    +  Result := SysUtils.FileOpen(UTF8Decode(FileName), Mode);
     end;
     
    -
     function FileCreateUTF8(Const FileName : string) : THandle;
     begin
       Result := FileCreateUtf8(FileName, fmShareExclusive, 0);
    @@ -136,100 +55,65 @@
       Result := FileCreateUtf8(FileName, fmShareExclusive, Rights);
     end;
     
    -function FileCreateUtf8(Const FileName : string;  ShareMode: Integer; {%H-}Rights: Cardinal) : THandle;
    +function FileCreateUtf8(Const FileName : string;  ShareMode: Integer; Rights: Cardinal) : THandle;
     begin
    -  Result := CreateFileW(PWideChar(UTF8Decode(FileName)), GENERIC_READ or GENERIC_WRITE,
    -                       dword(ShareModes[(ShareMode and $F0) shr 4]), nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
    +  Result := SysUtils.FileCreate(UTF8Decode(FileName), ShareMode, Rights);
     end;
     
    -
     function FileGetAttrUtf8(const FileName: String): Longint;
     begin
    -  Result:=Integer(Windows.GetFileAttributesW(PWideChar(UTF8Decode(FileName))));
    +  Result := SysUtils.FileGetAttr(UTF8Decode(FileName));
     end;
     
     function FileSetAttrUtf8(const Filename: String; Attr: longint): Longint;
     begin
    -  if Windows.SetFileAttributesW(PWideChar(UTF8Decode(FileName)), Attr) then
    -    Result:=0
    -  else
    -    Result := Integer(Windows.GetLastError);
    +  Result := SysUtils.FileSetAttr(UTF8Decode(FileName), Attr);
     end;
     
     function FileAgeUtf8(const FileName: String): Longint;
    -var
    -  Hnd: THandle;
    -  FindData: TWin32FindDataW;
     begin
    -  Result := -1;
    -  Hnd := FindFirstFileW(PWideChar(UTF8ToUTF16(FileName)), FindData{%H-});
    -   if Hnd <> Windows.INVALID_HANDLE_VALUE then
    -    begin
    -      Windows.FindClose(Hnd);
    -      if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    -        If WinToDosTime(FindData.ftLastWriteTime,Result) then
    -          exit;
    -    end;
    +  Result := SysUtils.FileAge(UTF8ToUTF16(FileName));
     end;
     
     function FileSetDateUtf8(const FileName: String; Age: Longint): Longint;
     var
    - FT:TFileTime;
    - fh: HANDLE;
    +  UFileName: UnicodeString;
     begin
    -   try
    -     fh := CreateFileW(PWideChar(UTF8ToUTF16(FileName)),
    -                       FILE_WRITE_ATTRIBUTES,
    -                       0, nil, OPEN_EXISTING,
    -                       FILE_ATTRIBUTE_NORMAL, 0);
    -     if (fh <> feInvalidHandle) and (DosToWinTime(Age,FT{%H-}) and SetFileTime(fh, nil, nil, @FT)) then
    -       Result := 0
    -     else
    -       Result := GetLastError;
    -   finally
    -     if (fh <> feInvalidHandle) then FileClose(fh);
    -   end;
    +  UFileName := UTF8ToUTF16(FileName);
    +  Result := SysUtils.FileSetDate(UFileName, Age);
     end;
     
    -
     function FileSizeUtf8(const Filename: string): int64;
     var
    -  FindData: TWIN32FindDataW;
    -  FindHandle: THandle;
    -  Str: WideString;
    +  UFileName: UnicodeString;
    +  R: TUnicodeSearchRec;
     begin
    -  // Fix for the bug 14360:
    -  // Don't assign the widestring to TSearchRec.name because it is of type
    -  // string, which will generate a conversion to the system encoding
    -  Str := UTF8Decode(Filename);
    -  FindHandle := Windows.FindFirstFileW(PWideChar(Str), FindData{%H-});
    -  if FindHandle = Windows.Invalid_Handle_value then
    -  begin
    +  UFileName := UTF8Decode(Filename);
    +  if SysUtils.FindFirst(UFileName, faAnyFile, R) = 0 then
    +    Result := R.Size
    +  else
         Result := -1;
    -    exit;
    -  end;
    -  Result := (int64(FindData.nFileSizeHigh) shl 32) + FindData.nFileSizeLow;
    -  Windows.FindClose(FindHandle);
    +  SysUtils.FindClose(R);
     end;
     
     function CreateDirUtf8(const NewDir: String): Boolean;
     begin
    -  Result:=Windows.CreateDirectoryW(PWideChar(UTF8Decode(NewDir)), nil);
    +  Result := SysUtils.CreateDir(UTF8Decode(NewDir));
     end;
     
     function RemoveDirUtf8(const Dir: String): Boolean;
     begin
    -  Result:=Windows.RemoveDirectoryW(PWideChar(UTF8Decode(Dir)));
    +  Result := SysUtils.RemoveDir(UTF8Decode(Dir));
     end;
     
     function DeleteFileUtf8(const FileName: String): Boolean;
     begin
    -  Result:=Windows.DeleteFileW(PWideChar(UTF8Decode(FileName)));
    +  Result := SysUtils.DeleteFile(UTF8Decode(FileName));
     end;
     
     function RenameFileUtf8(const OldName, NewName: String): Boolean;
     begin
    -  Result:=MoveFileW(PWideChar(UTF8Decode(OldName)), PWideChar(UTF8Decode(NewName)));
    +  Result := SysUtils.RenameFile(UTF8Decode(OldName), UTF8Decode(NewName));
     end;
     
     function SetCurrentDirUtf8(const NewDir: String): Boolean;
    @@ -241,120 +125,14 @@
       {$endif}
     end;
     
    -{$IF DEFINED(WinCE) OR (FPC_FULLVERSION>=30000)}
    -  {$define FindData_W}
    -{$IFEND}
    -
    -function FindMatch(var f: TSearchRec) : Longint;
    -begin
    -  { Find file with correct attribute }
    -  While (F.FindData.dwFileAttributes and cardinal(F.ExcludeAttr))<>0 do
    -   begin
    -     if FindNextUTF8(F)<>0 then
    -      begin
    -        Result:=GetLastError;
    -        exit;
    -      end;
    -   end;
    -  { Convert some attributes back }
    -  WinToDosTime(F.FindData.ftLastWriteTime,F.Time);
    -  f.size:=F.FindData.NFileSizeLow+(qword(maxdword)+1)*F.FindData.NFileSizeHigh;
    -  f.attr:=F.FindData.dwFileAttributes;
    -  { The structures are different at this point
    -    in win32 it is the ansi structure with a utf-8 string
    -    in wince it is a wide structure }
    -  {$ifdef FindData_W}
    -  {$IFDEF ACP_RTL}
    -  f.Name:=String(UnicodeString(F.FindData.cFileName));
    -  {$ELSE}
    -  f.Name:=UTF8Encode(UnicodeString(F.FindData.cFileName));
    -  {$ENDIF}
    -  {$else}
    -  f.Name:=F.FindData.cFileName;
    -  {$endif}
    -  Result:=0;
    -end;
    -
    -{$IFNDEF FindData_W}
    -
    -{ This function does not really convert from wide to ansi, but from wide to
    -  a utf-8 encoded ansi version of the data structures in win32 and does
    -  nothing in wince
    -
    -  See FindMatch also }
    -procedure FindWideToAnsi(const wide: TWIN32FINDDATAW; var ansi: TWIN32FINDDATA);
    -var
    -  ws: WideString;
    -  an: AnsiString;
    -begin
    -  SetLength(ws, length(wide.cAlternateFileName));
    -  Move(wide.cAlternateFileName[0], ws[1], length(ws)*2);
    -  an := AnsiString(ws); // no need to utf8 for cAlternateFileName (it's always ansi encoded)
    -  Move(an[1], ansi.cAlternateFileName, sizeof(ansi.cAlternateFileName));
    -
    -  ws := PWideChar(@wide.cFileName[0]);
    -  an := UTF8Encode(ws);
    -  ansi.cFileName := an;
    -  if length(an)<length(ansi.cFileName) then ansi.cFileName[ length(an)]:=#0;
    -
    -  with ansi do
    -  begin
    -    dwFileAttributes := wide.dwFileAttributes;
    -    ftCreationTime := wide.ftCreationTime;
    -    ftLastAccessTime := wide.ftLastAccessTime;
    -    ftLastWriteTime := wide.ftLastWriteTime;
    -    nFileSizeHigh := wide.nFileSizeHigh;
    -    nFileSizeLow := wide.nFileSizeLow;
    -    dwReserved0 := wide.dwReserved0;
    -    dwReserved1 := wide.dwReserved1;
    -  end;
    -end;
    -{$ENDIF}
    -
     function FindFirstUtf8(const Path: string; Attr: Longint; out Rslt: TSearchRec): Longint;
    -var
    -  find: TWIN32FINDDATAW;
     begin
    -  Rslt.Name:=Path;
    -  Rslt.Attr:=attr;
    -  Rslt.ExcludeAttr:=(not Attr) and ($1e);
    -                 { $1e = faHidden or faSysFile or faVolumeID or faDirectory }
    -  { FindFirstFile is a Win32 Call }
    -  {$IFDEF ACP_RTL}
    -  Rslt.FindHandle:=Windows.FindFirstFileW(PWideChar(WideString(Path)),find{%H-});
    -  {$ELSE}
    -  Rslt.FindHandle:=Windows.FindFirstFileW(PWideChar(UTF8Decode(Path)),find{%H-});
    -  {$ENDIF}
    -  If Rslt.FindHandle=Windows.Invalid_Handle_value then
    -  begin
    -    Result:=GetLastError;
    -    Exit;
    -  end;
    -  { Find file with correct attribute }
    -  {$IFNDEF FindData_W}
    -  FindWideToAnsi(find, Rslt.FindData);
    -  {$ELSE}
    -  Rslt.FindData := find;
    -  {$IFEND}
    -  Result := FindMatch(Rslt);
    +  Result := SysUtils.FindFirst(Path, Attr, Rslt);
     end;
     
    -
     function FindNextUtf8(var Rslt: TSearchRec): Longint;
    -var
    -  wide: TWIN32FINDDATAW;
     begin
    -  if FindNextFileW(Rslt.FindHandle, wide{%H-}) then
    -  begin
    -    {$IFNDEF FindData_W}
    -    FindWideToAnsi(wide, Rslt.FindData);
    -    {$ELSE}
    -    Rslt.FindData := wide;
    -    {$ENDIF}
    -    Result := FindMatch(Rslt);
    -  end
    -  else
    -    Result := Integer(GetLastError);
    +  Result := SysUtils.FindNext(Rslt);
     end;
     
     {$IFDEF WINCE}
    @@ -635,28 +413,14 @@
       end;
     end;
     
    -
    -
     function FileExistsUTF8(const Filename: string): boolean;
    -var
    -  Attr: Longint;
     begin
    -  Attr := FileGetAttrUTF8(FileName);
    -  if Attr <> -1 then
    -    Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) = 0
    -  else
    -    Result:=False;
    +  Result := SysUtils.FileExists(UTF8Decode(Filename));
     end;
     
     function DirectoryExistsUTF8(const Directory: string): boolean;
    -var
    -  Attr: Longint;
     begin
    -  Attr := FileGetAttrUTF8(Directory);
    -  if Attr <> -1 then
    -    Result := (Attr and FILE_ATTRIBUTE_DIRECTORY) > 0
    -  else
    -    Result := False;
    +  Result := SysUtils.DirectoryExists(Directory);
     end;
     
     function FileIsExecutable(const AFilename: string): boolean;
    
    winlazfileutils.diff (12,343 bytes)
  • winlazfileutils.2.diff (12,536 bytes)
    Index: components/lazutils/winlazfileutils.inc
    ===================================================================
    --- components/lazutils/winlazfileutils.inc	(revision 61140)
    +++ components/lazutils/winlazfileutils.inc	(working copy)
    @@ -18,114 +18,34 @@
     
     // ******** Start of WideString specific implementations ************
     
    -const
    -  ShareModes: array[0..4] of Integer = (
    -               0,
    -               0,
    -               FILE_SHARE_READ,
    -               FILE_SHARE_WRITE,
    -               FILE_SHARE_READ or FILE_SHARE_WRITE);
    -
    -  AccessModes: array[0..2] of Cardinal  = (
    -    GENERIC_READ,
    -    GENERIC_WRITE,
    -    GENERIC_READ or GENERIC_WRITE);
    -
    -function WinToDosTime(Var Wtime : TFileTime; var DTime:longint):longbool;
    -var
    -  lft : TFileTime;
    -begin
    -  WinToDosTime:=FileTimeToLocalFileTime(WTime,lft{%H-})
    -    {$ifndef WinCE}
    -    and FileTimeToDosDateTime(lft,Longrec(Dtime).Hi,LongRec(DTIME).lo)
    -    {$endif}
    -    ;
    -end;
    -
    -Function DosToWinTime(DosTime:longint; Var Wintime : TFileTime):longbool;
    -var
    - lft : TFileTime;
    -begin
    - DosToWinTime:=
    -   {$ifndef wince}
    -   DosDateTimeToFileTime(longrec(DosTime).hi,longrec(DosTime).lo,@lft) and
    -   {$endif}
    -   LocalFileTimeToFileTime(lft,Wintime);                                        ;
    -end;
    -
     function GetCurrentDirUtf8: String;
    -{$ifndef WinCE}
     var
    -  w   : WideString;
    -  res : Integer;
    -  {$endif}
    +  U: UnicodeString;
     begin
    -  {$ifdef WinCE}
    -  Result := '\';
    -  // Previously we sent an exception here, which is correct, but this causes
    -  // trouble with code which isnt tested for WinCE, so lets just send a dummy result instead
    -  // Exception.Create('[GetCurrentDirWide] The concept of the current directory doesn''t exist in Windows CE');
    -  {$else}
    -  res:=GetCurrentDirectoryW(0, nil);
    -  SetLength(w, res);
    -  res:=Windows.GetCurrentDirectoryW(res, @w[1]);
    -  SetLength(w, res);
    -  Result:=UTF8Encode(w);
    -  {$endif}
    +  System.GetDir(0, U);
    +  // Need to do an explicit encode to utf8, if compiled with "-dDisableUtf8RTL"
    +  Result := UTF8Encode(U);
     end;
     
     procedure GetDirUtf8(DriveNr: Byte; var Dir: String);
    -{This procedure may not be threadsafe, because SetCurrentDirectory isn't}
    -{$ifndef WinCE}
     var
    -  w, D: WideString;
    -  SavedDir: WideString;
    -  res : Integer;
    -{$endif}
    +  U: UnicodeString;
     begin
    -  {$ifdef WinCE}
    -  Dir := '\';
    -  // Previously we sent an exception here, which is correct, but this causes
    -  // trouble with code which isnt tested for WinCE, so lets just send a dummy result instead
    -  // Exception.Create('[GetCurrentDirWide] The concept of the current directory doesn''t exist in Windows CE');
    -  {$else}
    -  //writeln('GetDirWide START');
    -  if not (DriveNr = 0) then
    -  begin
    -    res := GetCurrentDirectoryW(0, nil);
    -    SetLength(SavedDir, res);
    -    res:=Windows.GetCurrentDirectoryW(res, @SavedDir[1]);
    -    SetLength(SavedDir,res);
    -
    -    D := WideChar(64 + DriveNr) + ':';
    -    if not SetCurrentDirectoryW(@D[1]) then
    -    begin
    -      Dir := Char(64 + DriveNr) + ':\';
    -      SetCurrentDirectoryW(@SavedDir[1]);
    -      Exit;
    -    end;
    -  end;
    -  res := GetCurrentDirectoryW(0, nil);
    -  SetLength(w, res);
    -  res := GetCurrentDirectoryW(res, @w[1]);
    -  SetLength(w, res);
    -  Dir:=UTF8Encode(w);
    -  if not (DriveNr = 0) then SetCurrentDirectoryW(@SavedDir[1]);
    -  //writeln('GetDirWide END');
    -  {$endif}
    +  {$PUSH}
    +  {$IOCHECKS OFF}
    +  GetDir(DriveNr, U);
    +  if IOResult <> 0 then
    +    U := UnicodeString(Chr(DriveNr + Ord('A') - 1) + ':\');
    +  {$POP}
    +  // Need to do an explicit encode to utf8, if compiled with "-dDisableUtf8RTL"
    +  Dir := UTF8Encode(U);
     end;
     
    -
     function FileOpenUtf8(Const FileName : string; Mode : Integer) : THandle;
    -
     begin
    -  Result := CreateFileW(PWideChar(UTF8Decode(FileName)), dword(AccessModes[Mode and 3]),
    -                         dword(ShareModes[(Mode and $F0) shr 4]), nil, OPEN_EXISTING,
    -                         FILE_ATTRIBUTE_NORMAL, 0);
    -  //if fail api return feInvalidHandle (INVALIDE_HANDLE=feInvalidHandle=-1)
    +  Result := SysUtils.FileOpen(FileName, Mode);
     end;
     
    -
     function FileCreateUTF8(Const FileName : string) : THandle;
     begin
       Result := FileCreateUtf8(FileName, fmShareExclusive, 0);
    @@ -136,100 +56,62 @@
       Result := FileCreateUtf8(FileName, fmShareExclusive, Rights);
     end;
     
    -function FileCreateUtf8(Const FileName : string;  ShareMode: Integer; {%H-}Rights: Cardinal) : THandle;
    +function FileCreateUtf8(Const FileName : string;  ShareMode: Integer; Rights: Cardinal) : THandle;
     begin
    -  Result := CreateFileW(PWideChar(UTF8Decode(FileName)), GENERIC_READ or GENERIC_WRITE,
    -                       dword(ShareModes[(ShareMode and $F0) shr 4]), nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
    +  Result := SysUtils.FileCreate(FileName, ShareMode, Rights);
     end;
     
    -
     function FileGetAttrUtf8(const FileName: String): Longint;
     begin
    -  Result:=Integer(Windows.GetFileAttributesW(PWideChar(UTF8Decode(FileName))));
    +  Result := SysUtils.FileGetAttr(FileName);
     end;
     
     function FileSetAttrUtf8(const Filename: String; Attr: longint): Longint;
     begin
    -  if Windows.SetFileAttributesW(PWideChar(UTF8Decode(FileName)), Attr) then
    -    Result:=0
    -  else
    -    Result := Integer(Windows.GetLastError);
    +  Result := SysUtils.FileSetAttr(FileName, Attr);
     end;
     
     function FileAgeUtf8(const FileName: String): Longint;
    -var
    -  Hnd: THandle;
    -  FindData: TWin32FindDataW;
     begin
    -  Result := -1;
    -  Hnd := FindFirstFileW(PWideChar(UTF8ToUTF16(FileName)), FindData{%H-});
    -   if Hnd <> Windows.INVALID_HANDLE_VALUE then
    -    begin
    -      Windows.FindClose(Hnd);
    -      if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    -        If WinToDosTime(FindData.ftLastWriteTime,Result) then
    -          exit;
    -    end;
    +  Result := SysUtils.FileAge(FileName);
     end;
     
     function FileSetDateUtf8(const FileName: String; Age: Longint): Longint;
    -var
    - FT:TFileTime;
    - fh: HANDLE;
     begin
    -   try
    -     fh := CreateFileW(PWideChar(UTF8ToUTF16(FileName)),
    -                       FILE_WRITE_ATTRIBUTES,
    -                       0, nil, OPEN_EXISTING,
    -                       FILE_ATTRIBUTE_NORMAL, 0);
    -     if (fh <> feInvalidHandle) and (DosToWinTime(Age,FT{%H-}) and SetFileTime(fh, nil, nil, @FT)) then
    -       Result := 0
    -     else
    -       Result := GetLastError;
    -   finally
    -     if (fh <> feInvalidHandle) then FileClose(fh);
    -   end;
    +  Result := SysUtils.FileSetDate(FileName, Age);
     end;
     
    -
     function FileSizeUtf8(const Filename: string): int64;
     var
    -  FindData: TWIN32FindDataW;
    -  FindHandle: THandle;
    -  Str: WideString;
    +  R: TSearchRec;
     begin
    -  // Fix for the bug 14360:
    -  // Don't assign the widestring to TSearchRec.name because it is of type
    -  // string, which will generate a conversion to the system encoding
    -  Str := UTF8Decode(Filename);
    -  FindHandle := Windows.FindFirstFileW(PWideChar(Str), FindData{%H-});
    -  if FindHandle = Windows.Invalid_Handle_value then
    +  if SysUtils.FindFirst(FileName, faAnyFile, R) = 0 then
       begin
    +    Result := R.Size;
    +    SysUtils.FindClose(R);
    +  end
    +  else
         Result := -1;
    -    exit;
    -  end;
    -  Result := (int64(FindData.nFileSizeHigh) shl 32) + FindData.nFileSizeLow;
    -  Windows.FindClose(FindHandle);
     end;
     
     function CreateDirUtf8(const NewDir: String): Boolean;
     begin
    -  Result:=Windows.CreateDirectoryW(PWideChar(UTF8Decode(NewDir)), nil);
    +  Result := SysUtils.CreateDir(NewDir);
     end;
     
     function RemoveDirUtf8(const Dir: String): Boolean;
     begin
    -  Result:=Windows.RemoveDirectoryW(PWideChar(UTF8Decode(Dir)));
    +  Result := SysUtils.RemoveDir(Dir);
     end;
     
     function DeleteFileUtf8(const FileName: String): Boolean;
     begin
    -  Result:=Windows.DeleteFileW(PWideChar(UTF8Decode(FileName)));
    +  Result := SysUtils.DeleteFile(FileName);
     end;
     
     function RenameFileUtf8(const OldName, NewName: String): Boolean;
     begin
    -  Result:=MoveFileW(PWideChar(UTF8Decode(OldName)), PWideChar(UTF8Decode(NewName)));
    +  Result := SysUtils.RenameFile(OldName, NewName);
     end;
     
     function SetCurrentDirUtf8(const NewDir: String): Boolean;
    @@ -237,124 +119,18 @@
       {$ifdef WinCE}
       raise Exception.Create('[SetCurrentDirWide] The concept of the current directory doesn''t exist in Windows CE');
       {$else}
    -  Result:=Windows.SetCurrentDirectoryW(PWidechar(UTF8Decode(NewDir)));
    +  Result:=Windows.SetCurrentDirectoryW(PWidechar(UnicodeString(NewDir)));
       {$endif}
     end;
     
    -{$IF DEFINED(WinCE) OR (FPC_FULLVERSION>=30000)}
    -  {$define FindData_W}
    -{$IFEND}
    -
    -function FindMatch(var f: TSearchRec) : Longint;
    -begin
    -  { Find file with correct attribute }
    -  While (F.FindData.dwFileAttributes and cardinal(F.ExcludeAttr))<>0 do
    -   begin
    -     if FindNextUTF8(F)<>0 then
    -      begin
    -        Result:=GetLastError;
    -        exit;
    -      end;
    -   end;
    -  { Convert some attributes back }
    -  WinToDosTime(F.FindData.ftLastWriteTime,F.Time);
    -  f.size:=F.FindData.NFileSizeLow+(qword(maxdword)+1)*F.FindData.NFileSizeHigh;
    -  f.attr:=F.FindData.dwFileAttributes;
    -  { The structures are different at this point
    -    in win32 it is the ansi structure with a utf-8 string
    -    in wince it is a wide structure }
    -  {$ifdef FindData_W}
    -  {$IFDEF ACP_RTL}
    -  f.Name:=String(UnicodeString(F.FindData.cFileName));
    -  {$ELSE}
    -  f.Name:=UTF8Encode(UnicodeString(F.FindData.cFileName));
    -  {$ENDIF}
    -  {$else}
    -  f.Name:=F.FindData.cFileName;
    -  {$endif}
    -  Result:=0;
    -end;
    -
    -{$IFNDEF FindData_W}
    -
    -{ This function does not really convert from wide to ansi, but from wide to
    -  a utf-8 encoded ansi version of the data structures in win32 and does
    -  nothing in wince
    -
    -  See FindMatch also }
    -procedure FindWideToAnsi(const wide: TWIN32FINDDATAW; var ansi: TWIN32FINDDATA);
    -var
    -  ws: WideString;
    -  an: AnsiString;
    -begin
    -  SetLength(ws, length(wide.cAlternateFileName));
    -  Move(wide.cAlternateFileName[0], ws[1], length(ws)*2);
    -  an := AnsiString(ws); // no need to utf8 for cAlternateFileName (it's always ansi encoded)
    -  Move(an[1], ansi.cAlternateFileName, sizeof(ansi.cAlternateFileName));
    -
    -  ws := PWideChar(@wide.cFileName[0]);
    -  an := UTF8Encode(ws);
    -  ansi.cFileName := an;
    -  if length(an)<length(ansi.cFileName) then ansi.cFileName[ length(an)]:=#0;
    -
    -  with ansi do
    -  begin
    -    dwFileAttributes := wide.dwFileAttributes;
    -    ftCreationTime := wide.ftCreationTime;
    -    ftLastAccessTime := wide.ftLastAccessTime;
    -    ftLastWriteTime := wide.ftLastWriteTime;
    -    nFileSizeHigh := wide.nFileSizeHigh;
    -    nFileSizeLow := wide.nFileSizeLow;
    -    dwReserved0 := wide.dwReserved0;
    -    dwReserved1 := wide.dwReserved1;
    -  end;
    -end;
    -{$ENDIF}
    -
     function FindFirstUtf8(const Path: string; Attr: Longint; out Rslt: TSearchRec): Longint;
    -var
    -  find: TWIN32FINDDATAW;
     begin
    -  Rslt.Name:=Path;
    -  Rslt.Attr:=attr;
    -  Rslt.ExcludeAttr:=(not Attr) and ($1e);
    -                 { $1e = faHidden or faSysFile or faVolumeID or faDirectory }
    -  { FindFirstFile is a Win32 Call }
    -  {$IFDEF ACP_RTL}
    -  Rslt.FindHandle:=Windows.FindFirstFileW(PWideChar(WideString(Path)),find{%H-});
    -  {$ELSE}
    -  Rslt.FindHandle:=Windows.FindFirstFileW(PWideChar(UTF8Decode(Path)),find{%H-});
    -  {$ENDIF}
    -  If Rslt.FindHandle=Windows.Invalid_Handle_value then
    -  begin
    -    Result:=GetLastError;
    -    Exit;
    -  end;
    -  { Find file with correct attribute }
    -  {$IFNDEF FindData_W}
    -  FindWideToAnsi(find, Rslt.FindData);
    -  {$ELSE}
    -  Rslt.FindData := find;
    -  {$IFEND}
    -  Result := FindMatch(Rslt);
    +  Result := SysUtils.FindFirst(Path, Attr, Rslt);
     end;
     
    -
     function FindNextUtf8(var Rslt: TSearchRec): Longint;
    -var
    -  wide: TWIN32FINDDATAW;
     begin
    -  if FindNextFileW(Rslt.FindHandle, wide{%H-}) then
    -  begin
    -    {$IFNDEF FindData_W}
    -    FindWideToAnsi(wide, Rslt.FindData);
    -    {$ELSE}
    -    Rslt.FindData := wide;
    -    {$ENDIF}
    -    Result := FindMatch(Rslt);
    -  end
    -  else
    -    Result := Integer(GetLastError);
    +  Result := SysUtils.FindNext(Rslt);
     end;
     
     {$IFDEF WINCE}
    @@ -635,28 +411,14 @@
       end;
     end;
     
    -
    -
     function FileExistsUTF8(const Filename: string): boolean;
    -var
    -  Attr: Longint;
     begin
    -  Attr := FileGetAttrUTF8(FileName);
    -  if Attr <> -1 then
    -    Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) = 0
    -  else
    -    Result:=False;
    +  Result := SysUtils.FileExists(Filename);
     end;
     
     function DirectoryExistsUTF8(const Directory: string): boolean;
    -var
    -  Attr: Longint;
     begin
    -  Attr := FileGetAttrUTF8(Directory);
    -  if Attr <> -1 then
    -    Result := (Attr and FILE_ATTRIBUTE_DIRECTORY) > 0
    -  else
    -    Result := False;
    +  Result := SysUtils.DirectoryExists(Directory);
     end;
     
     function FileIsExecutable(const AFilename: string): boolean;
    
    winlazfileutils.2.diff (12,536 bytes)

Relationships

related to 0014360 closedFelipe Monteiro de Carvalho FileSize doesn't work in WinCE 
has duplicate 0029436 closedBart Broersma LazUtils FileXXXUtf8() functions: maybe conditionally rewrite to call WideString fpc functions 

Activities

Serge Anvarov

2019-05-04 19:34

reporter  

winlazfileutils.diff (12,343 bytes)
Index: components/lazutils/winlazfileutils.inc
===================================================================
--- components/lazutils/winlazfileutils.inc	(revision 61133)
+++ components/lazutils/winlazfileutils.inc	(working copy)
@@ -18,114 +18,33 @@
 
 // ******** Start of WideString specific implementations ************
 
-const
-  ShareModes: array[0..4] of Integer = (
-               0,
-               0,
-               FILE_SHARE_READ,
-               FILE_SHARE_WRITE,
-               FILE_SHARE_READ or FILE_SHARE_WRITE);
-
-  AccessModes: array[0..2] of Cardinal  = (
-    GENERIC_READ,
-    GENERIC_WRITE,
-    GENERIC_READ or GENERIC_WRITE);
-
-function WinToDosTime(Var Wtime : TFileTime; var DTime:longint):longbool;
-var
-  lft : TFileTime;
-begin
-  WinToDosTime:=FileTimeToLocalFileTime(WTime,lft{%H-})
-    {$ifndef WinCE}
-    and FileTimeToDosDateTime(lft,Longrec(Dtime).Hi,LongRec(DTIME).lo)
-    {$endif}
-    ;
-end;
-
-Function DosToWinTime(DosTime:longint; Var Wintime : TFileTime):longbool;
-var
- lft : TFileTime;
-begin
- DosToWinTime:=
-   {$ifndef wince}
-   DosDateTimeToFileTime(longrec(DosTime).hi,longrec(DosTime).lo,@lft) and
-   {$endif}
-   LocalFileTimeToFileTime(lft,Wintime);                                        ;
-end;
-
 function GetCurrentDirUtf8: String;
-{$ifndef WinCE}
 var
-  w   : WideString;
-  res : Integer;
-  {$endif}
+  U: UnicodeString;
 begin
-  {$ifdef WinCE}
-  Result := '\';
-  // Previously we sent an exception here, which is correct, but this causes
-  // trouble with code which isnt tested for WinCE, so lets just send a dummy result instead
-  // Exception.Create('[GetCurrentDirWide] The concept of the current directory doesn''t exist in Windows CE');
-  {$else}
-  res:=GetCurrentDirectoryW(0, nil);
-  SetLength(w, res);
-  res:=Windows.GetCurrentDirectoryW(res, @w[1]);
-  SetLength(w, res);
-  Result:=UTF8Encode(w);
-  {$endif}
+  System.GetDir(0, U);
+  Result := UTF8Encode(U);
 end;
 
 procedure GetDirUtf8(DriveNr: Byte; var Dir: String);
-{This procedure may not be threadsafe, because SetCurrentDirectory isn't}
-{$ifndef WinCE}
 var
-  w, D: WideString;
-  SavedDir: WideString;
-  res : Integer;
-{$endif}
+  U: UnicodeString;
 begin
-  {$ifdef WinCE}
-  Dir := '\';
-  // Previously we sent an exception here, which is correct, but this causes
-  // trouble with code which isnt tested for WinCE, so lets just send a dummy result instead
-  // Exception.Create('[GetCurrentDirWide] The concept of the current directory doesn''t exist in Windows CE');
-  {$else}
-  //writeln('GetDirWide START');
-  if not (DriveNr = 0) then
-  begin
-    res := GetCurrentDirectoryW(0, nil);
-    SetLength(SavedDir, res);
-    res:=Windows.GetCurrentDirectoryW(res, @SavedDir[1]);
-    SetLength(SavedDir,res);
-
-    D := WideChar(64 + DriveNr) + ':';
-    if not SetCurrentDirectoryW(@D[1]) then
-    begin
-      Dir := Char(64 + DriveNr) + ':\';
-      SetCurrentDirectoryW(@SavedDir[1]);
-      Exit;
-    end;
-  end;
-  res := GetCurrentDirectoryW(0, nil);
-  SetLength(w, res);
-  res := GetCurrentDirectoryW(res, @w[1]);
-  SetLength(w, res);
-  Dir:=UTF8Encode(w);
-  if not (DriveNr = 0) then SetCurrentDirectoryW(@SavedDir[1]);
-  //writeln('GetDirWide END');
-  {$endif}
+  {$PUSH}
+  {$IOCHECKS OFF}
+  GetDir(DriveNr, U);
+  if IOResult = 0 then
+    Dir := UTF8Encode(U)
+  else
+    Dir := Chr(DriveNr + Ord('A') - 1) + ':\'
+  {$POP}
 end;
 
-
 function FileOpenUtf8(Const FileName : string; Mode : Integer) : THandle;
-
 begin
-  Result := CreateFileW(PWideChar(UTF8Decode(FileName)), dword(AccessModes[Mode and 3]),
-                         dword(ShareModes[(Mode and $F0) shr 4]), nil, OPEN_EXISTING,
-                         FILE_ATTRIBUTE_NORMAL, 0);
-  //if fail api return feInvalidHandle (INVALIDE_HANDLE=feInvalidHandle=-1)
+  Result := SysUtils.FileOpen(UTF8Decode(FileName), Mode);
 end;
 
-
 function FileCreateUTF8(Const FileName : string) : THandle;
 begin
   Result := FileCreateUtf8(FileName, fmShareExclusive, 0);
@@ -136,100 +55,65 @@
   Result := FileCreateUtf8(FileName, fmShareExclusive, Rights);
 end;
 
-function FileCreateUtf8(Const FileName : string;  ShareMode: Integer; {%H-}Rights: Cardinal) : THandle;
+function FileCreateUtf8(Const FileName : string;  ShareMode: Integer; Rights: Cardinal) : THandle;
 begin
-  Result := CreateFileW(PWideChar(UTF8Decode(FileName)), GENERIC_READ or GENERIC_WRITE,
-                       dword(ShareModes[(ShareMode and $F0) shr 4]), nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
+  Result := SysUtils.FileCreate(UTF8Decode(FileName), ShareMode, Rights);
 end;
 
-
 function FileGetAttrUtf8(const FileName: String): Longint;
 begin
-  Result:=Integer(Windows.GetFileAttributesW(PWideChar(UTF8Decode(FileName))));
+  Result := SysUtils.FileGetAttr(UTF8Decode(FileName));
 end;
 
 function FileSetAttrUtf8(const Filename: String; Attr: longint): Longint;
 begin
-  if Windows.SetFileAttributesW(PWideChar(UTF8Decode(FileName)), Attr) then
-    Result:=0
-  else
-    Result := Integer(Windows.GetLastError);
+  Result := SysUtils.FileSetAttr(UTF8Decode(FileName), Attr);
 end;
 
 function FileAgeUtf8(const FileName: String): Longint;
-var
-  Hnd: THandle;
-  FindData: TWin32FindDataW;
 begin
-  Result := -1;
-  Hnd := FindFirstFileW(PWideChar(UTF8ToUTF16(FileName)), FindData{%H-});
-   if Hnd <> Windows.INVALID_HANDLE_VALUE then
-    begin
-      Windows.FindClose(Hnd);
-      if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
-        If WinToDosTime(FindData.ftLastWriteTime,Result) then
-          exit;
-    end;
+  Result := SysUtils.FileAge(UTF8ToUTF16(FileName));
 end;
 
 function FileSetDateUtf8(const FileName: String; Age: Longint): Longint;
 var
- FT:TFileTime;
- fh: HANDLE;
+  UFileName: UnicodeString;
 begin
-   try
-     fh := CreateFileW(PWideChar(UTF8ToUTF16(FileName)),
-                       FILE_WRITE_ATTRIBUTES,
-                       0, nil, OPEN_EXISTING,
-                       FILE_ATTRIBUTE_NORMAL, 0);
-     if (fh <> feInvalidHandle) and (DosToWinTime(Age,FT{%H-}) and SetFileTime(fh, nil, nil, @FT)) then
-       Result := 0
-     else
-       Result := GetLastError;
-   finally
-     if (fh <> feInvalidHandle) then FileClose(fh);
-   end;
+  UFileName := UTF8ToUTF16(FileName);
+  Result := SysUtils.FileSetDate(UFileName, Age);
 end;
 
-
 function FileSizeUtf8(const Filename: string): int64;
 var
-  FindData: TWIN32FindDataW;
-  FindHandle: THandle;
-  Str: WideString;
+  UFileName: UnicodeString;
+  R: TUnicodeSearchRec;
 begin
-  // Fix for the bug 14360:
-  // Don't assign the widestring to TSearchRec.name because it is of type
-  // string, which will generate a conversion to the system encoding
-  Str := UTF8Decode(Filename);
-  FindHandle := Windows.FindFirstFileW(PWideChar(Str), FindData{%H-});
-  if FindHandle = Windows.Invalid_Handle_value then
-  begin
+  UFileName := UTF8Decode(Filename);
+  if SysUtils.FindFirst(UFileName, faAnyFile, R) = 0 then
+    Result := R.Size
+  else
     Result := -1;
-    exit;
-  end;
-  Result := (int64(FindData.nFileSizeHigh) shl 32) + FindData.nFileSizeLow;
-  Windows.FindClose(FindHandle);
+  SysUtils.FindClose(R);
 end;
 
 function CreateDirUtf8(const NewDir: String): Boolean;
 begin
-  Result:=Windows.CreateDirectoryW(PWideChar(UTF8Decode(NewDir)), nil);
+  Result := SysUtils.CreateDir(UTF8Decode(NewDir));
 end;
 
 function RemoveDirUtf8(const Dir: String): Boolean;
 begin
-  Result:=Windows.RemoveDirectoryW(PWideChar(UTF8Decode(Dir)));
+  Result := SysUtils.RemoveDir(UTF8Decode(Dir));
 end;
 
 function DeleteFileUtf8(const FileName: String): Boolean;
 begin
-  Result:=Windows.DeleteFileW(PWideChar(UTF8Decode(FileName)));
+  Result := SysUtils.DeleteFile(UTF8Decode(FileName));
 end;
 
 function RenameFileUtf8(const OldName, NewName: String): Boolean;
 begin
-  Result:=MoveFileW(PWideChar(UTF8Decode(OldName)), PWideChar(UTF8Decode(NewName)));
+  Result := SysUtils.RenameFile(UTF8Decode(OldName), UTF8Decode(NewName));
 end;
 
 function SetCurrentDirUtf8(const NewDir: String): Boolean;
@@ -241,120 +125,14 @@
   {$endif}
 end;
 
-{$IF DEFINED(WinCE) OR (FPC_FULLVERSION>=30000)}
-  {$define FindData_W}
-{$IFEND}
-
-function FindMatch(var f: TSearchRec) : Longint;
-begin
-  { Find file with correct attribute }
-  While (F.FindData.dwFileAttributes and cardinal(F.ExcludeAttr))<>0 do
-   begin
-     if FindNextUTF8(F)<>0 then
-      begin
-        Result:=GetLastError;
-        exit;
-      end;
-   end;
-  { Convert some attributes back }
-  WinToDosTime(F.FindData.ftLastWriteTime,F.Time);
-  f.size:=F.FindData.NFileSizeLow+(qword(maxdword)+1)*F.FindData.NFileSizeHigh;
-  f.attr:=F.FindData.dwFileAttributes;
-  { The structures are different at this point
-    in win32 it is the ansi structure with a utf-8 string
-    in wince it is a wide structure }
-  {$ifdef FindData_W}
-  {$IFDEF ACP_RTL}
-  f.Name:=String(UnicodeString(F.FindData.cFileName));
-  {$ELSE}
-  f.Name:=UTF8Encode(UnicodeString(F.FindData.cFileName));
-  {$ENDIF}
-  {$else}
-  f.Name:=F.FindData.cFileName;
-  {$endif}
-  Result:=0;
-end;
-
-{$IFNDEF FindData_W}
-
-{ This function does not really convert from wide to ansi, but from wide to
-  a utf-8 encoded ansi version of the data structures in win32 and does
-  nothing in wince
-
-  See FindMatch also }
-procedure FindWideToAnsi(const wide: TWIN32FINDDATAW; var ansi: TWIN32FINDDATA);
-var
-  ws: WideString;
-  an: AnsiString;
-begin
-  SetLength(ws, length(wide.cAlternateFileName));
-  Move(wide.cAlternateFileName[0], ws[1], length(ws)*2);
-  an := AnsiString(ws); // no need to utf8 for cAlternateFileName (it's always ansi encoded)
-  Move(an[1], ansi.cAlternateFileName, sizeof(ansi.cAlternateFileName));
-
-  ws := PWideChar(@wide.cFileName[0]);
-  an := UTF8Encode(ws);
-  ansi.cFileName := an;
-  if length(an)<length(ansi.cFileName) then ansi.cFileName[ length(an)]:=#0;
-
-  with ansi do
-  begin
-    dwFileAttributes := wide.dwFileAttributes;
-    ftCreationTime := wide.ftCreationTime;
-    ftLastAccessTime := wide.ftLastAccessTime;
-    ftLastWriteTime := wide.ftLastWriteTime;
-    nFileSizeHigh := wide.nFileSizeHigh;
-    nFileSizeLow := wide.nFileSizeLow;
-    dwReserved0 := wide.dwReserved0;
-    dwReserved1 := wide.dwReserved1;
-  end;
-end;
-{$ENDIF}
-
 function FindFirstUtf8(const Path: string; Attr: Longint; out Rslt: TSearchRec): Longint;
-var
-  find: TWIN32FINDDATAW;
 begin
-  Rslt.Name:=Path;
-  Rslt.Attr:=attr;
-  Rslt.ExcludeAttr:=(not Attr) and ($1e);
-                 { $1e = faHidden or faSysFile or faVolumeID or faDirectory }
-  { FindFirstFile is a Win32 Call }
-  {$IFDEF ACP_RTL}
-  Rslt.FindHandle:=Windows.FindFirstFileW(PWideChar(WideString(Path)),find{%H-});
-  {$ELSE}
-  Rslt.FindHandle:=Windows.FindFirstFileW(PWideChar(UTF8Decode(Path)),find{%H-});
-  {$ENDIF}
-  If Rslt.FindHandle=Windows.Invalid_Handle_value then
-  begin
-    Result:=GetLastError;
-    Exit;
-  end;
-  { Find file with correct attribute }
-  {$IFNDEF FindData_W}
-  FindWideToAnsi(find, Rslt.FindData);
-  {$ELSE}
-  Rslt.FindData := find;
-  {$IFEND}
-  Result := FindMatch(Rslt);
+  Result := SysUtils.FindFirst(Path, Attr, Rslt);
 end;
 
-
 function FindNextUtf8(var Rslt: TSearchRec): Longint;
-var
-  wide: TWIN32FINDDATAW;
 begin
-  if FindNextFileW(Rslt.FindHandle, wide{%H-}) then
-  begin
-    {$IFNDEF FindData_W}
-    FindWideToAnsi(wide, Rslt.FindData);
-    {$ELSE}
-    Rslt.FindData := wide;
-    {$ENDIF}
-    Result := FindMatch(Rslt);
-  end
-  else
-    Result := Integer(GetLastError);
+  Result := SysUtils.FindNext(Rslt);
 end;
 
 {$IFDEF WINCE}
@@ -635,28 +413,14 @@
   end;
 end;
 
-
-
 function FileExistsUTF8(const Filename: string): boolean;
-var
-  Attr: Longint;
 begin
-  Attr := FileGetAttrUTF8(FileName);
-  if Attr <> -1 then
-    Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) = 0
-  else
-    Result:=False;
+  Result := SysUtils.FileExists(UTF8Decode(Filename));
 end;
 
 function DirectoryExistsUTF8(const Directory: string): boolean;
-var
-  Attr: Longint;
 begin
-  Attr := FileGetAttrUTF8(Directory);
-  if Attr <> -1 then
-    Result := (Attr and FILE_ATTRIBUTE_DIRECTORY) > 0
-  else
-    Result := False;
+  Result := SysUtils.DirectoryExists(Directory);
 end;
 
 function FileIsExecutable(const AFilename: string): boolean;
winlazfileutils.diff (12,343 bytes)

Juha Manninen

2019-05-04 21:06

developer   ~0116005

I don't think the UTF8Encode() and UTF8Decode() calls are needed. The encoding is now converted automatically as needed.
Can you please test without them.

Bart Broersma

2019-05-04 23:26

developer   ~0116014

Last edited: 2019-05-04 23:30

View 2 revisions

Leaving Utf8Encode out will trigger lots of warnings (implicit conversion of unicodestring to ansistring with potential dataloss).
Also, in LCL we seem to prefer Utf16ToUtf8/Utf8ToUtf16 instead of Utf8Encode/Utf8Decode?

OTOH if LCL is compiled with -dDisableUtf8RTL then the explicit cast is wrong (and has been for a long, long time).

Bart Broersma

2019-05-04 23:40

developer   ~0116017

B.t.w. do we still support fpc 2.6.4 (for people who refuse to use CP aware strings)?

Serge Anvarov

2019-05-05 18:30

reporter   ~0116024

@Juha is right about UTF8Decode. Since conversions to UnicodeString are always correct, whether UTF8 is encoding or not, I have removed all calls to Ut8Decode and Utf8ToUtf16 because RTL does an explicit conversion to UnicodeString.
Calls to Utf8Encode left with the comment that @Bart pointed.

winlazfileutils.2.diff (12,536 bytes)
Index: components/lazutils/winlazfileutils.inc
===================================================================
--- components/lazutils/winlazfileutils.inc	(revision 61140)
+++ components/lazutils/winlazfileutils.inc	(working copy)
@@ -18,114 +18,34 @@
 
 // ******** Start of WideString specific implementations ************
 
-const
-  ShareModes: array[0..4] of Integer = (
-               0,
-               0,
-               FILE_SHARE_READ,
-               FILE_SHARE_WRITE,
-               FILE_SHARE_READ or FILE_SHARE_WRITE);
-
-  AccessModes: array[0..2] of Cardinal  = (
-    GENERIC_READ,
-    GENERIC_WRITE,
-    GENERIC_READ or GENERIC_WRITE);
-
-function WinToDosTime(Var Wtime : TFileTime; var DTime:longint):longbool;
-var
-  lft : TFileTime;
-begin
-  WinToDosTime:=FileTimeToLocalFileTime(WTime,lft{%H-})
-    {$ifndef WinCE}
-    and FileTimeToDosDateTime(lft,Longrec(Dtime).Hi,LongRec(DTIME).lo)
-    {$endif}
-    ;
-end;
-
-Function DosToWinTime(DosTime:longint; Var Wintime : TFileTime):longbool;
-var
- lft : TFileTime;
-begin
- DosToWinTime:=
-   {$ifndef wince}
-   DosDateTimeToFileTime(longrec(DosTime).hi,longrec(DosTime).lo,@lft) and
-   {$endif}
-   LocalFileTimeToFileTime(lft,Wintime);                                        ;
-end;
-
 function GetCurrentDirUtf8: String;
-{$ifndef WinCE}
 var
-  w   : WideString;
-  res : Integer;
-  {$endif}
+  U: UnicodeString;
 begin
-  {$ifdef WinCE}
-  Result := '\';
-  // Previously we sent an exception here, which is correct, but this causes
-  // trouble with code which isnt tested for WinCE, so lets just send a dummy result instead
-  // Exception.Create('[GetCurrentDirWide] The concept of the current directory doesn''t exist in Windows CE');
-  {$else}
-  res:=GetCurrentDirectoryW(0, nil);
-  SetLength(w, res);
-  res:=Windows.GetCurrentDirectoryW(res, @w[1]);
-  SetLength(w, res);
-  Result:=UTF8Encode(w);
-  {$endif}
+  System.GetDir(0, U);
+  // Need to do an explicit encode to utf8, if compiled with "-dDisableUtf8RTL"
+  Result := UTF8Encode(U);
 end;
 
 procedure GetDirUtf8(DriveNr: Byte; var Dir: String);
-{This procedure may not be threadsafe, because SetCurrentDirectory isn't}
-{$ifndef WinCE}
 var
-  w, D: WideString;
-  SavedDir: WideString;
-  res : Integer;
-{$endif}
+  U: UnicodeString;
 begin
-  {$ifdef WinCE}
-  Dir := '\';
-  // Previously we sent an exception here, which is correct, but this causes
-  // trouble with code which isnt tested for WinCE, so lets just send a dummy result instead
-  // Exception.Create('[GetCurrentDirWide] The concept of the current directory doesn''t exist in Windows CE');
-  {$else}
-  //writeln('GetDirWide START');
-  if not (DriveNr = 0) then
-  begin
-    res := GetCurrentDirectoryW(0, nil);
-    SetLength(SavedDir, res);
-    res:=Windows.GetCurrentDirectoryW(res, @SavedDir[1]);
-    SetLength(SavedDir,res);
-
-    D := WideChar(64 + DriveNr) + ':';
-    if not SetCurrentDirectoryW(@D[1]) then
-    begin
-      Dir := Char(64 + DriveNr) + ':\';
-      SetCurrentDirectoryW(@SavedDir[1]);
-      Exit;
-    end;
-  end;
-  res := GetCurrentDirectoryW(0, nil);
-  SetLength(w, res);
-  res := GetCurrentDirectoryW(res, @w[1]);
-  SetLength(w, res);
-  Dir:=UTF8Encode(w);
-  if not (DriveNr = 0) then SetCurrentDirectoryW(@SavedDir[1]);
-  //writeln('GetDirWide END');
-  {$endif}
+  {$PUSH}
+  {$IOCHECKS OFF}
+  GetDir(DriveNr, U);
+  if IOResult <> 0 then
+    U := UnicodeString(Chr(DriveNr + Ord('A') - 1) + ':\');
+  {$POP}
+  // Need to do an explicit encode to utf8, if compiled with "-dDisableUtf8RTL"
+  Dir := UTF8Encode(U);
 end;
 
-
 function FileOpenUtf8(Const FileName : string; Mode : Integer) : THandle;
-
 begin
-  Result := CreateFileW(PWideChar(UTF8Decode(FileName)), dword(AccessModes[Mode and 3]),
-                         dword(ShareModes[(Mode and $F0) shr 4]), nil, OPEN_EXISTING,
-                         FILE_ATTRIBUTE_NORMAL, 0);
-  //if fail api return feInvalidHandle (INVALIDE_HANDLE=feInvalidHandle=-1)
+  Result := SysUtils.FileOpen(FileName, Mode);
 end;
 
-
 function FileCreateUTF8(Const FileName : string) : THandle;
 begin
   Result := FileCreateUtf8(FileName, fmShareExclusive, 0);
@@ -136,100 +56,62 @@
   Result := FileCreateUtf8(FileName, fmShareExclusive, Rights);
 end;
 
-function FileCreateUtf8(Const FileName : string;  ShareMode: Integer; {%H-}Rights: Cardinal) : THandle;
+function FileCreateUtf8(Const FileName : string;  ShareMode: Integer; Rights: Cardinal) : THandle;
 begin
-  Result := CreateFileW(PWideChar(UTF8Decode(FileName)), GENERIC_READ or GENERIC_WRITE,
-                       dword(ShareModes[(ShareMode and $F0) shr 4]), nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
+  Result := SysUtils.FileCreate(FileName, ShareMode, Rights);
 end;
 
-
 function FileGetAttrUtf8(const FileName: String): Longint;
 begin
-  Result:=Integer(Windows.GetFileAttributesW(PWideChar(UTF8Decode(FileName))));
+  Result := SysUtils.FileGetAttr(FileName);
 end;
 
 function FileSetAttrUtf8(const Filename: String; Attr: longint): Longint;
 begin
-  if Windows.SetFileAttributesW(PWideChar(UTF8Decode(FileName)), Attr) then
-    Result:=0
-  else
-    Result := Integer(Windows.GetLastError);
+  Result := SysUtils.FileSetAttr(FileName, Attr);
 end;
 
 function FileAgeUtf8(const FileName: String): Longint;
-var
-  Hnd: THandle;
-  FindData: TWin32FindDataW;
 begin
-  Result := -1;
-  Hnd := FindFirstFileW(PWideChar(UTF8ToUTF16(FileName)), FindData{%H-});
-   if Hnd <> Windows.INVALID_HANDLE_VALUE then
-    begin
-      Windows.FindClose(Hnd);
-      if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
-        If WinToDosTime(FindData.ftLastWriteTime,Result) then
-          exit;
-    end;
+  Result := SysUtils.FileAge(FileName);
 end;
 
 function FileSetDateUtf8(const FileName: String; Age: Longint): Longint;
-var
- FT:TFileTime;
- fh: HANDLE;
 begin
-   try
-     fh := CreateFileW(PWideChar(UTF8ToUTF16(FileName)),
-                       FILE_WRITE_ATTRIBUTES,
-                       0, nil, OPEN_EXISTING,
-                       FILE_ATTRIBUTE_NORMAL, 0);
-     if (fh <> feInvalidHandle) and (DosToWinTime(Age,FT{%H-}) and SetFileTime(fh, nil, nil, @FT)) then
-       Result := 0
-     else
-       Result := GetLastError;
-   finally
-     if (fh <> feInvalidHandle) then FileClose(fh);
-   end;
+  Result := SysUtils.FileSetDate(FileName, Age);
 end;
 
-
 function FileSizeUtf8(const Filename: string): int64;
 var
-  FindData: TWIN32FindDataW;
-  FindHandle: THandle;
-  Str: WideString;
+  R: TSearchRec;
 begin
-  // Fix for the bug 14360:
-  // Don't assign the widestring to TSearchRec.name because it is of type
-  // string, which will generate a conversion to the system encoding
-  Str := UTF8Decode(Filename);
-  FindHandle := Windows.FindFirstFileW(PWideChar(Str), FindData{%H-});
-  if FindHandle = Windows.Invalid_Handle_value then
+  if SysUtils.FindFirst(FileName, faAnyFile, R) = 0 then
   begin
+    Result := R.Size;
+    SysUtils.FindClose(R);
+  end
+  else
     Result := -1;
-    exit;
-  end;
-  Result := (int64(FindData.nFileSizeHigh) shl 32) + FindData.nFileSizeLow;
-  Windows.FindClose(FindHandle);
 end;
 
 function CreateDirUtf8(const NewDir: String): Boolean;
 begin
-  Result:=Windows.CreateDirectoryW(PWideChar(UTF8Decode(NewDir)), nil);
+  Result := SysUtils.CreateDir(NewDir);
 end;
 
 function RemoveDirUtf8(const Dir: String): Boolean;
 begin
-  Result:=Windows.RemoveDirectoryW(PWideChar(UTF8Decode(Dir)));
+  Result := SysUtils.RemoveDir(Dir);
 end;
 
 function DeleteFileUtf8(const FileName: String): Boolean;
 begin
-  Result:=Windows.DeleteFileW(PWideChar(UTF8Decode(FileName)));
+  Result := SysUtils.DeleteFile(FileName);
 end;
 
 function RenameFileUtf8(const OldName, NewName: String): Boolean;
 begin
-  Result:=MoveFileW(PWideChar(UTF8Decode(OldName)), PWideChar(UTF8Decode(NewName)));
+  Result := SysUtils.RenameFile(OldName, NewName);
 end;
 
 function SetCurrentDirUtf8(const NewDir: String): Boolean;
@@ -237,124 +119,18 @@
   {$ifdef WinCE}
   raise Exception.Create('[SetCurrentDirWide] The concept of the current directory doesn''t exist in Windows CE');
   {$else}
-  Result:=Windows.SetCurrentDirectoryW(PWidechar(UTF8Decode(NewDir)));
+  Result:=Windows.SetCurrentDirectoryW(PWidechar(UnicodeString(NewDir)));
   {$endif}
 end;
 
-{$IF DEFINED(WinCE) OR (FPC_FULLVERSION>=30000)}
-  {$define FindData_W}
-{$IFEND}
-
-function FindMatch(var f: TSearchRec) : Longint;
-begin
-  { Find file with correct attribute }
-  While (F.FindData.dwFileAttributes and cardinal(F.ExcludeAttr))<>0 do
-   begin
-     if FindNextUTF8(F)<>0 then
-      begin
-        Result:=GetLastError;
-        exit;
-      end;
-   end;
-  { Convert some attributes back }
-  WinToDosTime(F.FindData.ftLastWriteTime,F.Time);
-  f.size:=F.FindData.NFileSizeLow+(qword(maxdword)+1)*F.FindData.NFileSizeHigh;
-  f.attr:=F.FindData.dwFileAttributes;
-  { The structures are different at this point
-    in win32 it is the ansi structure with a utf-8 string
-    in wince it is a wide structure }
-  {$ifdef FindData_W}
-  {$IFDEF ACP_RTL}
-  f.Name:=String(UnicodeString(F.FindData.cFileName));
-  {$ELSE}
-  f.Name:=UTF8Encode(UnicodeString(F.FindData.cFileName));
-  {$ENDIF}
-  {$else}
-  f.Name:=F.FindData.cFileName;
-  {$endif}
-  Result:=0;
-end;
-
-{$IFNDEF FindData_W}
-
-{ This function does not really convert from wide to ansi, but from wide to
-  a utf-8 encoded ansi version of the data structures in win32 and does
-  nothing in wince
-
-  See FindMatch also }
-procedure FindWideToAnsi(const wide: TWIN32FINDDATAW; var ansi: TWIN32FINDDATA);
-var
-  ws: WideString;
-  an: AnsiString;
-begin
-  SetLength(ws, length(wide.cAlternateFileName));
-  Move(wide.cAlternateFileName[0], ws[1], length(ws)*2);
-  an := AnsiString(ws); // no need to utf8 for cAlternateFileName (it's always ansi encoded)
-  Move(an[1], ansi.cAlternateFileName, sizeof(ansi.cAlternateFileName));
-
-  ws := PWideChar(@wide.cFileName[0]);
-  an := UTF8Encode(ws);
-  ansi.cFileName := an;
-  if length(an)<length(ansi.cFileName) then ansi.cFileName[ length(an)]:=#0;
-
-  with ansi do
-  begin
-    dwFileAttributes := wide.dwFileAttributes;
-    ftCreationTime := wide.ftCreationTime;
-    ftLastAccessTime := wide.ftLastAccessTime;
-    ftLastWriteTime := wide.ftLastWriteTime;
-    nFileSizeHigh := wide.nFileSizeHigh;
-    nFileSizeLow := wide.nFileSizeLow;
-    dwReserved0 := wide.dwReserved0;
-    dwReserved1 := wide.dwReserved1;
-  end;
-end;
-{$ENDIF}
-
 function FindFirstUtf8(const Path: string; Attr: Longint; out Rslt: TSearchRec): Longint;
-var
-  find: TWIN32FINDDATAW;
 begin
-  Rslt.Name:=Path;
-  Rslt.Attr:=attr;
-  Rslt.ExcludeAttr:=(not Attr) and ($1e);
-                 { $1e = faHidden or faSysFile or faVolumeID or faDirectory }
-  { FindFirstFile is a Win32 Call }
-  {$IFDEF ACP_RTL}
-  Rslt.FindHandle:=Windows.FindFirstFileW(PWideChar(WideString(Path)),find{%H-});
-  {$ELSE}
-  Rslt.FindHandle:=Windows.FindFirstFileW(PWideChar(UTF8Decode(Path)),find{%H-});
-  {$ENDIF}
-  If Rslt.FindHandle=Windows.Invalid_Handle_value then
-  begin
-    Result:=GetLastError;
-    Exit;
-  end;
-  { Find file with correct attribute }
-  {$IFNDEF FindData_W}
-  FindWideToAnsi(find, Rslt.FindData);
-  {$ELSE}
-  Rslt.FindData := find;
-  {$IFEND}
-  Result := FindMatch(Rslt);
+  Result := SysUtils.FindFirst(Path, Attr, Rslt);
 end;
 
-
 function FindNextUtf8(var Rslt: TSearchRec): Longint;
-var
-  wide: TWIN32FINDDATAW;
 begin
-  if FindNextFileW(Rslt.FindHandle, wide{%H-}) then
-  begin
-    {$IFNDEF FindData_W}
-    FindWideToAnsi(wide, Rslt.FindData);
-    {$ELSE}
-    Rslt.FindData := wide;
-    {$ENDIF}
-    Result := FindMatch(Rslt);
-  end
-  else
-    Result := Integer(GetLastError);
+  Result := SysUtils.FindNext(Rslt);
 end;
 
 {$IFDEF WINCE}
@@ -635,28 +411,14 @@
   end;
 end;
 
-
-
 function FileExistsUTF8(const Filename: string): boolean;
-var
-  Attr: Longint;
 begin
-  Attr := FileGetAttrUTF8(FileName);
-  if Attr <> -1 then
-    Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) = 0
-  else
-    Result:=False;
+  Result := SysUtils.FileExists(Filename);
 end;
 
 function DirectoryExistsUTF8(const Directory: string): boolean;
-var
-  Attr: Longint;
 begin
-  Attr := FileGetAttrUTF8(Directory);
-  if Attr <> -1 then
-    Result := (Attr and FILE_ATTRIBUTE_DIRECTORY) > 0
-  else
-    Result := False;
+  Result := SysUtils.DirectoryExists(Directory);
 end;
 
 function FileIsExecutable(const AFilename: string): boolean;
winlazfileutils.2.diff (12,536 bytes)

Bart Broersma

2019-05-05 23:15

developer   ~0116032

Last edited: 2019-05-05 23:19

View 4 revisions

if DisableUtf8RTL is defined (this will define ACP_RTL in lazutils_defines.inc) then Utf8Encode should be omitted and UnicodeString should be cast to String and vice versa.

Here's an excerpt from FindFirstUtf8

  {$IFDEF ACP_RTL}
  Rslt.FindHandle:=Windows.FindFirstFileW(PWideChar(WideString(Path)),find{%H-});
  {$ELSE}
  Rslt.FindHandle:=Windows.FindFirstFileW(PWideChar(UTF8Decode(Path)),find{%H-});
  {$ENDIF}

Currently (with 3.04 at least) direct casting of String<->UniCodeString will also give correct results if UTF8_RTL is defined (DisableUtf8RTL is not defined), because then the strings codepage is CP_UTF8.
Simply assigning (without casting) UnicodeString to String will trigger numerous warnings though.

The real question is from which compiler version this works OK (3.0.0??).

As long as we support any compiler version where this is not 100% OK, we still need to have the ifdef's like in the code example above.
Once this is not the case anymore, all these constructs can go away and no more Utf8Encode/Utf8Decode or Utf16ToUtf8/Utf8ToUtf16 is needed.

Juha Manninen

2019-05-06 16:18

developer   ~0116048

My understanding is that we don't support FPC 2.6.4 with Lazarus trunk any more. I have not tested it for a long time and I doubt anybody else has.
The encoding aware came with FPC 3.0.0. It means we already support 3 latest FPC versions (3.0.0, 3.0.2, 3.0.4) which is more than the rule about 2 latest versions.
Serge's latest patch looks OK. I will apply it so it gets tested by others.

Bart Broersma

2019-05-06 20:17

developer   ~0116054

All Utf8Encode/Decode could be removed then and replaced with casting (Stringto Ansi) or assigning (string to unicode).

Bart Broersma

2019-05-08 11:39

developer   ~0116074

I think this is wrong:
// Need to do an explicit encode to utf8, if compiled with "-dDisableUtf8RTL"
   Result := UTF8Encode(U);

If compiled with -dDisableUtf8RTL then we are supposed to return the string in DefaultSystemEncoding, not encode the string as UTF8.

Also: did someone check for regression of Issue 0014360 after the changes to FileAgeUtf8?

Bart Broersma

2019-05-08 12:29

developer   ~0116076

> If compiled with -dDisableUtf8RTL then we are supposed to return the string in DefaultSystemEncoding, not encode the string as UTF8.
Never mind that comment. The function explicitely has the word UTF8 in it's name, so forcing UTF8 is the right thing to do there.

The second question stands however.
Unfortunately I can't test that myself (otherwise I would have donse so, of course).

Juha Manninen

2019-05-11 10:04

developer   ~0116125

> did someone check for regression of Issue 0014360 after the changes to FileAgeUtf8?

Bart, what makes you believe the changes caused regressions?

Juha Manninen

2019-10-06 10:21

developer   ~0118368

I improved it in r61999. Resolving.

Issue History

Date Modified Username Field Change
2019-05-04 19:34 Serge Anvarov New Issue
2019-05-04 19:34 Serge Anvarov File Added: winlazfileutils.diff
2019-05-04 21:06 Juha Manninen Note Added: 0116005
2019-05-04 23:26 Bart Broersma Note Added: 0116014
2019-05-04 23:27 Bart Broersma Relationship added related to 0029436
2019-05-04 23:30 Bart Broersma Note Edited: 0116014 View Revisions
2019-05-04 23:40 Bart Broersma Note Added: 0116017
2019-05-05 18:30 Serge Anvarov File Added: winlazfileutils.2.diff
2019-05-05 18:30 Serge Anvarov Note Added: 0116024
2019-05-05 23:15 Bart Broersma Note Added: 0116032
2019-05-05 23:15 Bart Broersma Note Edited: 0116032 View Revisions
2019-05-05 23:17 Bart Broersma Note Edited: 0116032 View Revisions
2019-05-05 23:19 Bart Broersma Note Edited: 0116032 View Revisions
2019-05-06 16:18 Juha Manninen Note Added: 0116048
2019-05-06 16:19 Juha Manninen Assigned To => Juha Manninen
2019-05-06 16:19 Juha Manninen Status new => assigned
2019-05-06 16:26 Juha Manninen Status assigned => resolved
2019-05-06 16:26 Juha Manninen Resolution open => fixed
2019-05-06 16:26 Juha Manninen Fixed in Revision => r61165
2019-05-06 16:26 Juha Manninen LazTarget => -
2019-05-06 20:17 Bart Broersma Note Added: 0116054
2019-05-06 20:18 Bart Broersma Relationship replaced has duplicate 0029436
2019-05-08 11:39 Bart Broersma Status resolved => assigned
2019-05-08 11:39 Bart Broersma Resolution fixed => reopened
2019-05-08 11:39 Bart Broersma Note Added: 0116074
2019-05-08 12:29 Bart Broersma Note Added: 0116076
2019-05-08 12:55 Juha Manninen Relationship added related to 0014360
2019-05-11 10:04 Juha Manninen Note Added: 0116125
2019-10-06 10:21 Juha Manninen Status assigned => resolved
2019-10-06 10:21 Juha Manninen Fixed in Revision r61165 => r61165, r61999
2019-10-06 10:21 Juha Manninen Note Added: 0118368