Commit 3470923d authored by Juha Manninen's avatar Juha Manninen
Browse files

LazUtils: Remove incorrect code dealing with strings on Windows, use SysUtils...

LazUtils: Remove incorrect code dealing with strings on Windows, use SysUtils code instead. Issue #35512, patch from Serge Anvarov.

git-svn-id: trunk@61165 -
parent 5328b9a8
......@@ -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;
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
R: TSearchRec;
begin
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);
begin
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;
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment