mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-22 11:19:26 +02:00
LazUtils: Remove incorrect code dealing with strings on Windows, use SysUtils code instead. Issue #35512, patch from Serge Anvarov.
git-svn-id: trunk@61165 -
This commit is contained in:
juha
parent
5328b9a852
commit
3470923dd4
@ -18,114 +18,34 @@ end;
|
||||
|
||||
// ******** 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 @@ begin
|
||||
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 @@ begin
|
||||
{$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 @@ begin
|
||||
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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user