{ Double Commander ------------------------------------------------------------------------- This unit contains platform dependent functions dealing with operating system. Copyright (C) 2006-2014 Koblov Alexander (Alexx2000@mail.ru) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA } unit DCOSUtils; {$mode objfpc}{$H+} interface uses SysUtils, Classes, DynLibs, DCClassesUtf8, DCBasicTypes; type TFileMapRec = record FileHandle : System.THandle; FileSize : Int64; {$IFDEF MSWINDOWS} MappingHandle : System.THandle; {$ENDIF} MappedFile : Pointer; end; TCopyAttributesOption = (caoCopyAttributes, caoCopyTime, caoCopyOwnership, caoRemoveReadOnlyAttr); TCopyAttributesOptions = set of TCopyAttributesOption; const faInvalidAttributes: TFileAttrs = TFileAttrs(-1); CopyAttributesOptionCopyAll = [caoCopyAttributes, caoCopyTime, caoCopyOwnership]; {en Is file a directory @param(iAttr File attributes) @returns(@true if file is a directory, @false otherwise) } function FPS_ISDIR(iAttr: TFileAttrs) : Boolean; {en Is file a symbolic link @param(iAttr File attributes) @returns(@true if file is a symbolic link, @false otherwise) } function FPS_ISLNK(iAttr: TFileAttrs) : Boolean; {en Is file executable @param(sFileName File name) @returns(@true if file is executable, @false otherwise) } function FileIsExeLib(const sFileName : String) : Boolean; {en Copies a file attributes (attributes, date/time, owner & group, permissions). @param(sSrc String expression that specifies the name of the file to be copied) @param(sDst String expression that specifies the target file name) @param(bDropReadOnlyFlag Drop read only attribute if @true) @returns(The function returns @true if successful, @false otherwise) } function FileIsReadOnly(iAttr: TFileAttrs): Boolean; {en Returns path to a temporary name. It ensures that returned path doesn't exist, i.e., there is no filesystem entry by that name. If it could not create a unique temporary name then it returns empty string. @param(PathPrefix This parameter is added at the beginning of each path that is tried. The directories in this path are not created if they don't exist. If it is empty then the system temporary directory is used. For example: If PathPrefix is '/tmp/myfile' then files '/tmp/myfileXXXXXX' are tried. The path '/tmp' must already exist.) } function GetTempName(PathPrefix: String): String; (* File mapping/unmapping routines *) {en Create memory map of a file @param(sFileName Name of file to mapping) @param(FileMapRec TFileMapRec structure) @returns(The function returns @true if successful, @false otherwise) } function MapFile(const sFileName : UTF8String; out FileMapRec : TFileMapRec) : Boolean; {en Unmap previously mapped file @param(FileMapRec TFileMapRec structure) } procedure UnMapFile(var FileMapRec : TFileMapRec); {en Convert from console to UTF8 encoding. } function ConsoleToUTF8(const Str: AnsiString): UTF8String; { File handling functions} function mbFileOpen(const FileName: UTF8String; Mode: Word): System.THandle; function mbFileCreate(const FileName: UTF8String): System.THandle; overload; function mbFileCreate(const FileName: UTF8String; ShareMode: Longint): System.THandle; overload; function mbFileCreate(const FileName: UTF8String; ShareMode: Longint; Rights: Longint): System.THandle; overload; function mbFileAge(const FileName: UTF8String): DCBasicTypes.TFileTime; function mbFileSame(const FirstName, SecondName: UTF8String): Boolean; // On success returns True. function mbFileGetTime(const FileName: UTF8String; var ModificationTime: DCBasicTypes.TFileTime; var CreationTime : DCBasicTypes.TFileTime; var LastAccessTime : DCBasicTypes.TFileTime): Boolean; // On success returns True. function mbFileSetTime(const FileName: UTF8String; ModificationTime: DCBasicTypes.TFileTime; CreationTime : DCBasicTypes.TFileTime = 0; LastAccessTime : DCBasicTypes.TFileTime = 0): Boolean; {en Checks if a given file exists - it can be a real file or a link to a file, but it can be opened and read from. Even if the result is @false, we can't be sure a file by that name can be created, because there may still exist a directory or link by that name. } function mbFileExists(const FileName: UTF8String): Boolean; function mbFileAccess(const FileName: UTF8String; Mode: Word): Boolean; function mbFileGetAttr(const FileName: UTF8String): TFileAttrs; overload; function mbFileSetAttr(const FileName: UTF8String; Attr: TFileAttrs) : LongInt; function mbFileGetAttr(const FileName: UTF8String; out Attr: TSearchRec): Boolean; overload; {en If any operation in Options is performed and does not succeed it is included in the result set. If all performed operations succeed the function returns empty set. For example for Options=[caoCopyTime, caoCopyOwnership] setting ownership doesn't succeed then the function returns [caoCopyOwnership]. } function mbFileCopyAttr(const sSrc, sDst: UTF8String; Options: TCopyAttributesOptions): TCopyAttributesOptions; // Returns True on success. function mbFileSetReadOnly(const FileName: UTF8String; ReadOnly: Boolean): Boolean; function mbDeleteFile(const FileName: UTF8String): Boolean; function mbRenameFile(const OldName: UTF8String; NewName: UTF8String): Boolean; function mbFileSize(const FileName: UTF8String): Int64; function FileFlush(Handle: System.THandle): Boolean; { Directory handling functions} function mbGetCurrentDir: UTF8String; function mbSetCurrentDir(const NewDir: UTF8String): Boolean; {en Checks if a given directory exists - it may be a real directory or a link to directory. Even if the result is @false, we can't be sure a directory by that name can be created, because there may still exist a file or link by that name. } function mbDirectoryExists(const Directory : UTF8String) : Boolean; function mbCreateDir(const NewDir: UTF8String): Boolean; function mbRemoveDir(const Dir: UTF8String): Boolean; {en Checks if any file system entry exists at given path. It can be file, directory, link, etc. (links are not followed). } function mbFileSystemEntryExists(const Path: UTF8String): Boolean; function mbCompareFileNames(const FileName1, FileName2: UTF8String): Boolean; function mbSameFile(const FileName1, FileName2: String): Boolean; { Other functions } function mbGetEnvironmentString(Index : Integer) : UTF8String; function mbSysErrorMessage(ErrorCode: Integer): UTF8String; function mbLoadLibrary(const Name: UTF8String): TLibHandle; function SafeGetProcAddress(Lib: TLibHandle; const ProcName: AnsiString): Pointer; implementation uses {$IF DEFINED(MSWINDOWS)} Windows, JwaWinNetWk, DCDateTimeUtils, {$ENDIF} {$IF DEFINED(UNIX)} {$IF DEFINED(BSD)} {$DEFINE FPC_USE_LIBC} {$ENDIF} {$IF (NOT DEFINED(FPC_USE_LIBC)) OR (DEFINED(BSD) AND NOT DEFINED(DARWIN))} SysCall, {$ENDIF} BaseUnix, Unix, dl, {$ENDIF} DCStrUtils, LazUTF8; {$IFDEF UNIX} function SetModeReadOnly(mode: TMode; ReadOnly: Boolean): TMode; begin mode := mode and not (S_IWUSR or S_IWGRP or S_IWOTH); if ReadOnly = False then begin if (mode AND S_IRUSR) = S_IRUSR then mode := mode or S_IWUSR; if (mode AND S_IRGRP) = S_IRGRP then mode := mode or S_IWGRP; if (mode AND S_IROTH) = S_IROTH then mode := mode or S_IWOTH; end; Result := mode; end; {$ENDIF} {$IF DEFINED(MSWINDOWS)} const AccessModes: array[0..2] of DWORD = ( GENERIC_READ, GENERIC_WRITE, GENERIC_READ or GENERIC_WRITE); ShareModes: array[0..4] of DWORD = ( 0, 0, FILE_SHARE_READ, FILE_SHARE_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE); {$ELSEIF DEFINED(UNIX)} const AccessModes: array[0..2] of LongInt = ( O_RdOnly, O_WrOnly, O_RdWr); function fpLChown(path : pChar; owner : TUid; group : TGid): cInt; {$IFDEF FPC_USE_LIBC}cdecl; external 'c' name 'lchown';{$ENDIF} {$IFNDEF FPC_USE_LIBC} begin fpLChown:=do_syscall(syscall_nr_lchown,TSysParam(path),TSysParam(owner),TSysParam(group)); end; {$ENDIF} {$ENDIF} (*Is Directory*) function FPS_ISDIR(iAttr: TFileAttrs) : Boolean; inline; {$IFDEF MSWINDOWS} begin Result := (iAttr and FILE_ATTRIBUTE_DIRECTORY <> 0); end; {$ELSE} begin Result := BaseUnix.FPS_ISDIR(iAttr); end; {$ENDIF} (*Is Link*) function FPS_ISLNK(iAttr: TFileAttrs) : Boolean; inline; {$IFDEF MSWINDOWS} begin Result := (iAttr and FILE_ATTRIBUTE_REPARSE_POINT <> 0); end; {$ELSE} begin Result := BaseUnix.FPS_ISLNK(iAttr); end; {$ENDIF} function FileIsExeLib(const sFileName : String) : Boolean; var fsExeLib : TFileStreamEx; {$IFDEF MSWINDOWS} Sign : Word; {$ELSE} Sign : DWord; {$ENDIF} begin Result := False; if mbFileExists(sFileName) and (mbFileSize(sFileName) >= SizeOf(Sign)) then begin fsExeLib := TFileStreamEx.Create(sFileName, fmOpenRead or fmShareDenyNone); try {$IFDEF MSWINDOWS} Sign := fsExeLib.ReadWord; Result := (Sign = $5A4D); {$ELSE} Sign := fsExeLib.ReadDWord; Result := (Sign = $464C457F); {$ENDIF} finally fsExeLib.Free; end; end; end; function FileIsReadOnly(iAttr: TFileAttrs): Boolean; {$IFDEF MSWINDOWS} begin Result:= (iAttr and faReadOnly) <> 0; end; {$ELSE} begin Result:= (((iAttr AND S_IRUSR) = S_IRUSR) and ((iAttr AND S_IWUSR) <> S_IWUSR)); end; {$ENDIF} function mbFileCopyAttr(const sSrc, sDst: UTF8String; Options: TCopyAttributesOptions): TCopyAttributesOptions; {$IFDEF MSWINDOWS} var Attr : TFileAttrs; ModificationTime, CreationTime, LastAccessTime: DCBasicTypes.TFileTime; begin Result := []; if caoCopyAttributes in Options then begin Attr := mbFileGetAttr(sSrc); if Attr <> faInvalidAttributes then begin if (caoRemoveReadOnlyAttr in Options) and ((Attr and faReadOnly) <> 0) then Attr := (Attr and not faReadOnly); if mbFileSetAttr(sDst, Attr) <> 0 then Include(Result, caoCopyAttributes); end else Include(Result, caoCopyAttributes); end; if caoCopyTime in Options then begin if not (mbFileGetTime(sSrc, ModificationTime, CreationTime, LastAccessTime) and mbFileSetTime(sDst, ModificationTime, CreationTime, LastAccessTime)) then Include(Result, caoCopyTime); end; end; {$ELSE} // *nix var StatInfo : BaseUnix.Stat; utb : BaseUnix.TUTimBuf; mode : TMode; begin if fpLStat(PChar(UTF8ToSys(sSrc)), StatInfo) >= 0 then begin Result := []; if FPS_ISLNK(StatInfo.st_mode) then begin if caoCopyOwnership in Options then begin // Only group/owner can be set for links. if fpLChown(PChar(UTF8ToSys(sDst)), StatInfo.st_uid, StatInfo.st_gid) = -1 then begin Include(Result, caoCopyOwnership); end; end; end else begin if caoCopyTime in Options then begin utb.actime := time_t(StatInfo.st_atime); // last access time utb.modtime := time_t(StatInfo.st_mtime); // last modification time if fputime(PChar(UTF8ToSys(sDst)), @utb) <> 0 then Include(Result, caoCopyTime); end; if caoCopyOwnership in Options then begin if fpChown(PChar(UTF8ToSys(sDst)), StatInfo.st_uid, StatInfo.st_gid) = -1 then begin Include(Result, caoCopyOwnership); end; end; if caoCopyAttributes in Options then begin mode := StatInfo.st_mode; if caoRemoveReadOnlyAttr in Options then mode := SetModeReadOnly(mode, False); if fpChmod(PChar(UTF8ToSys(sDst)), mode) = -1 then begin Include(Result, caoCopyAttributes); end; end; end; end else Result := Options; end; {$ENDIF} function GetTempName(PathPrefix: String): String; const MaxTries = 100; var TryNumber: Integer = 0; begin if PathPrefix = '' then PathPrefix := GetTempDir; repeat Result := PathPrefix + IntToStr(System.Random(MaxInt)); // or use CreateGUID() Inc(TryNumber); if TryNumber = MaxTries then Exit(''); until not mbFileSystemEntryExists(Result); end; function MapFile(const sFileName : UTF8String; out FileMapRec : TFileMapRec) : Boolean; {$IFDEF MSWINDOWS} begin Result := False; with FileMapRec do begin MappedFile := nil; MappingHandle := 0; FileHandle := feInvalidHandle; FileSize := mbFileSize(sFileName); if FileSize = 0 then Exit; // Cannot map empty files FileHandle := mbFileOpen(sFileName, fmOpenRead); if FileHandle = feInvalidHandle then Exit; MappingHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil); if MappingHandle <> 0 then begin MappedFile := MapViewOfFile(MappingHandle, FILE_MAP_READ, 0, 0, 0); if not Assigned(MappedFile) then begin UnMapFile(FileMapRec); Exit; end; end else begin UnMapFile(FileMapRec); Exit; end; end; Result := True; end; {$ELSE} var StatInfo: BaseUnix.Stat; begin Result:= False; with FileMapRec do begin MappedFile := nil; FileHandle:= fpOpen(PChar(UTF8ToSys(sFileName)), O_RDONLY); if FileHandle = feInvalidHandle then Exit; if fpfstat(FileHandle, StatInfo) <> 0 then begin UnMapFile(FileMapRec); Exit; end; FileSize := StatInfo.st_size; if FileSize = 0 then // Cannot map empty files begin UnMapFile(FileMapRec); Exit; end; MappedFile:= fpmmap(nil,FileSize,PROT_READ, MAP_PRIVATE{SHARED},FileHandle,0 ); if MappedFile = MAP_FAILED then begin MappedFile := nil; UnMapFile(FileMapRec); Exit; end; end; Result := True; end; {$ENDIF} procedure UnMapFile(var FileMapRec : TFileMapRec); {$IFDEF MSWINDOWS} begin with FileMapRec do begin if Assigned(MappedFile) then begin UnmapViewOfFile(MappedFile); MappedFile := nil; end; if MappingHandle <> 0 then begin CloseHandle(MappingHandle); MappingHandle := 0; end; if FileHandle <> feInvalidHandle then begin FileClose(FileHandle); FileHandle := feInvalidHandle; end; end; end; {$ELSE} begin with FileMapRec do begin if FileHandle <> feInvalidHandle then begin fpClose(FileHandle); FileHandle := feInvalidHandle; end; if Assigned(MappedFile) then begin fpmunmap(MappedFile,FileSize); MappedFile := nil; end; end; end; {$ENDIF} function ConsoleToUTF8(const Str: AnsiString): UTF8String; {$IFDEF MSWINDOWS} var Dst: PChar; {$ENDIF} begin Result:= Str; {$IFDEF MSWINDOWS} Dst:= AllocMem((Length(Result) + 1) * SizeOf(Char)); if OEMToChar(PChar(Result), Dst) then Result:= SysToUTF8(Dst); FreeMem(Dst); {$ENDIF} end; function mbFileOpen(const FileName: UTF8String; Mode: Word): System.THandle; {$IFDEF MSWINDOWS} begin Result:= CreateFileW(PWideChar(UTF8Decode(FileName)), AccessModes[Mode and 3], ShareModes[(Mode and $F0) shr 4], nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); end; {$ELSE} begin Result:= fpOpen(UTF8ToSys(FileName), AccessModes[Mode and 3]); end; {$ENDIF} function mbFileCreate(const FileName: UTF8String): System.THandle; {$IFDEF MSWINDOWS} begin Result := mbFileCreate(FileName, fmShareDenyWrite, 0); end; {$ELSE} begin Result:= fpOpen(UTF8ToSys(FileName), O_Creat or O_RdWr or O_Trunc); end; {$ENDIF} function mbFileCreate(const FileName: UTF8String; ShareMode: Longint): System.THandle; {$IFDEF MSWINDOWS} begin Result:= mbFileCreate(FileName, ShareMode, 0); end; {$ELSE} begin {$IF (FPC_VERSION > 2) or ((FPC_VERSION = 2) and (FPC_RELEASE >= 5))} Result:= FileCreate(UTF8ToSys(FileName), ShareMode, 438); // 438 = 666 octal {$ELSE} Result:= FileCreate(UTF8ToSys(FileName), 438); // 438 = 666 octal {$ENDIF} end; {$ENDIF} function mbFileCreate(const FileName: UTF8String; ShareMode: Longint; Rights: Longint): System.THandle; {$IFDEF MSWINDOWS} begin Result:= CreateFileW(PWideChar(UTF8Decode(FileName)), GENERIC_READ or GENERIC_WRITE, ShareModes[(ShareMode and $F0) shr 4], nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); end; {$ELSE} begin {$IF (FPC_VERSION > 2) or ((FPC_VERSION = 2) and (FPC_RELEASE >= 5))} Result:= FileCreate(UTF8ToSys(FileName), ShareMode, Rights); {$ELSE} Result:= FileCreate(UTF8ToSys(FileName), Rights); {$ENDIF} end; {$ENDIF} function mbFileAge(const FileName: UTF8String): DCBasicTypes.TFileTime; {$IFDEF MSWINDOWS} var Handle: System.THandle; FindData: TWin32FindDataW; wFileName: WideString; begin wFileName:= UTF8Decode(FileName); Handle := FindFirstFileW(PWChar(wFileName), FindData); if Handle <> INVALID_HANDLE_VALUE then begin Windows.FindClose(Handle); if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then Exit(DCBasicTypes.TWinFileTime(FindData.ftLastWriteTime)); end; Result:= DCBasicTypes.TFileTime(-1); end; {$ELSE} var Info: BaseUnix.Stat; begin Result:= DCBasicTypes.TFileTime(-1); if fpStat(UTF8ToSys(FileName), Info) >= 0 then {$PUSH}{$R-} Result := Info.st_mtime; {$POP} end; {$ENDIF} function mbFileSame(const FirstName, SecondName: UTF8String): Boolean; {$IFDEF MSWINDOWS} var Handle: System.THandle; lpFirstFileInfo, lpSecondFileInfo: TByHandleFileInformation; begin // Read first file info Handle:= CreateFileW(PWideChar(UTF8Decode(FirstName)), FILE_READ_ATTRIBUTES, FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE, nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0); if Handle = INVALID_HANDLE_VALUE then Exit(False); Result:= GetFileInformationByHandle(Handle, lpFirstFileInfo); CloseHandle(Handle); if not Result then Exit; // Read second file info Handle:= CreateFileW(PWideChar(UTF8Decode(SecondName)), FILE_READ_ATTRIBUTES, FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE, nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0); if Handle = INVALID_HANDLE_VALUE then Exit(False); Result:= GetFileInformationByHandle(Handle, lpSecondFileInfo); CloseHandle(Handle); if not Result then Exit; // Compare file info Result:= CompareByte(lpFirstFileInfo, lpSecondFileInfo, SizeOf(TByHandleFileInformation)) = 0; end; {$ELSE} var FirstStat, SecondStat: BaseUnix.Stat; begin // Read first file info if fpStat(UTF8ToSys(FirstName), FirstStat) < 0 then Exit(False); // Read second file info if fpStat(UTF8ToSys(SecondName), SecondStat) < 0 then Exit(False); // Compare file info Result:= (FirstStat.st_dev = SecondStat.st_dev) and (FirstStat.st_ino = SecondStat.st_ino); end; {$ENDIF} function mbFileGetTime(const FileName: UTF8String; var ModificationTime: DCBasicTypes.TFileTime; var CreationTime : DCBasicTypes.TFileTime; var LastAccessTime : DCBasicTypes.TFileTime): Boolean; {$IFDEF MSWINDOWS} var Handle: System.THandle; wFileName: WideString; begin wFileName:= UTF8Decode(FileName); Handle := CreateFileW(PWChar(wFileName), FILE_READ_ATTRIBUTES, FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE, nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, // needed for opening directories 0); if Handle <> INVALID_HANDLE_VALUE then begin Result := Windows.GetFileTime(Handle, @CreationTime, @LastAccessTime, @ModificationTime); CloseHandle(Handle); end else Result := False; end; {$ELSE} var StatInfo : BaseUnix.Stat; begin Result := fpLStat(PChar(UTF8ToSys(FileName)), StatInfo) >= 0; if Result then begin LastAccessTime := StatInfo.st_atime; ModificationTime := StatInfo.st_mtime; CreationTime := StatInfo.st_ctime; end; end; {$ENDIF} function mbFileSetTime(const FileName: UTF8String; ModificationTime: DCBasicTypes.TFileTime; CreationTime : DCBasicTypes.TFileTime = 0; LastAccessTime : DCBasicTypes.TFileTime = 0): Boolean; {$IFDEF MSWINDOWS} var Handle: System.THandle; wFileName: WideString; PWinModificationTime: Windows.LPFILETIME = nil; PWinCreationTime: Windows.LPFILETIME = nil; PWinLastAccessTime: Windows.LPFILETIME = nil; begin wFileName:= UTF8Decode(FileName); Handle := CreateFileW(PWChar(wFileName), FILE_WRITE_ATTRIBUTES, FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE, nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, // needed for opening directories 0); if Handle <> INVALID_HANDLE_VALUE then begin if ModificationTime <> 0 then begin PWinModificationTime := @ModificationTime; end; if CreationTime <> 0 then begin PWinCreationTime := @CreationTime; end; if LastAccessTime <> 0 then begin PWinLastAccessTime := @LastAccessTime; end; Result := Windows.SetFileTime(Handle, PWinCreationTime, PWinLastAccessTime, PWinModificationTime); CloseHandle(Handle); end else Result := False; end; {$ELSE} var t: TUTimBuf; begin t.actime := time_t(LastAccessTime); t.modtime := time_t(ModificationTime); Result := (fputime(PChar(UTF8ToSys(FileName)), @t) <> -1); end; {$ENDIF} function mbFileExists(const FileName: UTF8String) : Boolean; {$IFDEF MSWINDOWS} var Attr: Dword; wFileName: WideString; begin wFileName:= UTF8Decode(FileName); Attr:= GetFileAttributesW(PWChar(wFileName)); if Attr <> DWORD(-1) then Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) = 0 else Result:=False; end; {$ELSE} var Info: BaseUnix.Stat; begin // Can use fpStat, because link to an existing filename can be opened as if it were a real file. if fpStat(UTF8ToSys(FileName), Info) >= 0 then Result:= fpS_ISREG(Info.st_mode) else Result:= False; end; {$ENDIF} function mbFileAccess(const FileName: UTF8String; Mode: Word): Boolean; {$IFDEF MSWINDOWS} const AccessMode: array[0..2] of DWORD = ( GENERIC_READ, GENERIC_WRITE, GENERIC_READ or GENERIC_WRITE); var hFile: System.THandle; wFileName: WideString; dwDesiredAccess: DWORD; dwShareMode: DWORD = 0; begin wFileName:= UTF8Decode(FileName); dwDesiredAccess := AccessMode[Mode and 3]; if Mode = fmOpenRead then // If checking Read mode no sharing mode given Mode := Mode or fmShareDenyNone; dwShareMode := ShareModes[(Mode and $F0) shr 4]; hFile:= CreateFileW(PWChar(wFileName), dwDesiredAccess, dwShareMode, nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0); Result := hFile <> INVALID_HANDLE_VALUE; if Result then FileClose(hFile); end; {$ELSE} const AccessMode: array[0..2] of LongInt = ( R_OK, W_OK, R_OK or W_OK); begin Result:= fpAccess(UTF8ToSys(FileName), AccessMode[Mode and 3]) = 0; end; {$ENDIF} {$IFOPT R+} {$DEFINE uOSUtilsRangeCheckOn} {$R-} {$ENDIF} function mbFileGetAttr(const FileName: UTF8String): TFileAttrs; {$IFDEF MSWINDOWS} var wFileName: WideString; begin wFileName:= UTF8Decode(FileName); Result := GetFileAttributesW(PWChar(wFileName)); end; {$ELSE} var Info: BaseUnix.Stat; begin if fpLStat(UTF8ToSys(FileName), @Info) >= 0 then Result:= Info.st_mode else Result:= faInvalidAttributes; end; {$ENDIF} function mbFileSetAttr(const FileName: UTF8String; Attr: TFileAttrs): LongInt; {$IFDEF MSWINDOWS} var wFileName: WideString; begin wFileName:= UTF8Decode(FileName); if SetFileAttributesW(PWChar(wFileName), Attr) then Result:= 0 else Result:= GetLastError; end; {$ELSE} begin Result:= fpchmod(PChar(UTF8ToSys(FileName)), Attr); end; {$ENDIF} function mbFileGetAttr(const FileName: UTF8String; out Attr: TSearchRec): Boolean; {$IFDEF MSWINDOWS} var FileInfo: Windows.TWin32FileAttributeData; begin Result:= GetFileAttributesExW(PWideChar(UTF8Decode(FileName)), GetFileExInfoStandard, @FileInfo); if Result then begin WinToDosTime(FileInfo.ftLastWriteTime, Attr.Time); Int64Rec(Attr.Size).Lo:= FileInfo.nFileSizeLow; Int64Rec(Attr.Size).Hi:= FileInfo.nFileSizeHigh; Attr.Attr:= FileInfo.dwFileAttributes; end; end; {$ELSE} var StatInfo: BaseUnix.Stat; begin Result:= fpLStat(PAnsiChar(UTF8ToSys(FileName)), StatInfo) >= 0; if Result then begin Attr.Time:= StatInfo.st_mtime; Attr.Size:= StatInfo.st_size; Attr.Attr:= StatInfo.st_mode; end; end; {$ENDIF} {$IFDEF uOSUtilsRangeCheckOn} {$R+} {$UNDEF uOSUtilsRangeCheckOn} {$ENDIF} function mbFileSetReadOnly(const FileName: UTF8String; ReadOnly: Boolean): Boolean; {$IFDEF MSWINDOWS} var iAttr: DWORD; wFileName: WideString; begin wFileName:= UTF8Decode(FileName); iAttr := GetFileAttributesW(PWChar(wFileName)); if iAttr = DWORD(-1) then Exit(False); if ReadOnly then iAttr:= iAttr or faReadOnly else iAttr:= iAttr and not faReadOnly; Result:= SetFileAttributesW(PWChar(wFileName), iAttr) = True; end; {$ELSE} var StatInfo: BaseUnix.Stat; mode: TMode; begin if fpStat(PChar(UTF8ToSys(FileName)), StatInfo) <> 0 then Exit(False); mode := SetModeReadOnly(StatInfo.st_mode, ReadOnly); Result:= fpchmod(PChar(UTF8ToSys(FileName)), mode) = 0; end; {$ENDIF} function mbDeleteFile(const FileName: UTF8String): Boolean; {$IFDEF MSWINDOWS} var wFileName: WideString; begin wFileName:= UTF8Decode(FileName); Result:= Windows.DeleteFileW(PWChar(wFileName)); end; {$ELSE} begin Result:= fpUnLink(UTF8ToSys(FileName)) = 0; end; {$ENDIF} function mbRenameFile(const OldName: UTF8String; NewName: UTF8String): Boolean; {$IFDEF MSWINDOWS} var wOldName, wNewName: WideString; begin wOldName:= UTF8Decode(OldName); wNewName:= UTF8Decode(NewName); Result:= MoveFileExW(PWChar(wOldName), PWChar(wNewName), MOVEFILE_REPLACE_EXISTING); end; {$ELSE} var tmpFileName: UTF8String; OldFileStat, NewFileStat: stat; begin if GetPathType(NewName) <> ptAbsolute then NewName := ExtractFilePath(OldName) + NewName; if OldName = NewName then Exit(True); if fpLstat(UTF8ToSys(OldName), OldFileStat) <> 0 then Exit(False); // Check if target file exists. if fpLstat(UTF8ToSys(NewName), NewFileStat) = 0 then begin // Check if source and target are the same files (same inode and same device). if (OldFileStat.st_ino = NewFileStat.st_ino) and (OldFileStat.st_dev = NewFileStat.st_dev) then begin // Check number of links. // If it is 1 then source and target names most probably differ only // by case on a case-insensitive filesystem. Direct rename() in such case // fails on Linux, so we use a temporary file name and rename in two stages. // If number of links is more than 1 then it's enough to simply unlink // the source file, since both files are technically identical. // (On Linux rename() returns success but doesn't do anything // if renaming a file to its hard link.) // We cannot use st_nlink for directories because it means "number of // subdirectories"; hard links to directories are not supported on Linux // or Windows anyway (on MacOSX they are). Therefore we always treat // directories as if they were a single link and rename them using temporary name. if (NewFileStat.st_nlink = 1) or BaseUnix.fpS_ISDIR(NewFileStat.st_mode) then begin tmpFileName := GetTempName(OldName); if FpRename(UTF8ToSys(OldName), UTF8ToSys(tmpFileName)) = 0 then begin if fpLstat(UTF8ToSys(NewName), NewFileStat) = 0 then begin // We have renamed the old file but the new file name still exists, // so this wasn't a single file on a case-insensitive filesystem // accessible by two names that differ by case. FpRename(UTF8ToSys(tmpFileName), UTF8ToSys(OldName)); // Restore old file. {$IFDEF DARWIN} // If it's a directory with multiple hard links then simply unlink the source. if BaseUnix.fpS_ISDIR(NewFileStat.st_mode) and (NewFileStat.st_nlink > 1) then Result := (fpUnLink(UTF8ToSys(OldName)) = 0) else {$ENDIF} Result := False; end else if FpRename(UTF8ToSys(tmpFileName), UTF8ToSys(NewName)) = 0 then begin Result := True; end else begin FpRename(UTF8ToSys(tmpFileName), UTF8ToSys(OldName)); // Restore old file. Result := False; end; end else Result := False; end else begin // Multiple links - simply unlink the source file. Result := (fpUnLink(UTF8ToSys(OldName)) = 0); end; Exit; end; end; Result := FpRename(UTF8ToSys(OldName), UTF8ToSys(NewName)) = 0; end; {$ENDIF} function mbFileSize(const FileName: UTF8String): Int64; {$IFDEF MSWINDOWS} var Handle: System.THandle; FindData: TWin32FindDataW; wFileName: WideString; begin Result:= 0; wFileName:= UTF8Decode(FileName); Handle := FindFirstFileW(PWideChar(wFileName), FindData); if Handle <> INVALID_HANDLE_VALUE then begin Windows.FindClose(Handle); if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then begin Int64Rec(Result).Lo:= FindData.nFileSizeLow; Int64Rec(Result).Hi:= FindData.nFileSizeHigh; end; end; end; {$ELSE} var Info: BaseUnix.Stat; begin Result:= 0; if fpStat(UTF8ToSys(FileName), Info) >= 0 then Result:= Info.st_size; end; {$ENDIF} function FileFlush(Handle: System.THandle): Boolean; {$IFDEF MSWINDOWS} begin Result:= FlushFileBuffers(Handle); end; {$ELSE} begin Result:= (fpfsync(Handle) = 0); end; {$ENDIF} function mbGetCurrentDir: UTF8String; {$IFDEF MSWINDOWS} var iSize: Integer; wsDir: WideString; begin Result:= ''; iSize:= GetCurrentDirectoryW(0, nil); if iSize > 0 then begin SetLength(wsDir, iSize); GetCurrentDirectoryW(iSize, PWideChar(wsDir)); wsDir:= PWideChar(wsDir); Result:= UTF8Encode(wsDir); end; end; {$ELSE} begin GetDir(0, Result); Result := SysToUTF8(Result); end; {$ENDIF} function mbSetCurrentDir(const NewDir: UTF8String): Boolean; {$IFDEF MSWINDOWS} var wsNewDir: WideString; NetResource: TNetResourceW; begin // Function WNetAddConnection2W works very slow // when the final character is a backslash ('\') wsNewDir:= UTF8Decode(ExcludeTrailingPathDelimiter(NewDir)); if Pos('\\', wsNewDir) = 1 then begin FillChar(NetResource, SizeOf(NetResource), #0); NetResource.dwType:= RESOURCETYPE_ANY; NetResource.lpRemoteName:= PWideChar(wsNewDir); WNetAddConnection2W(NetResource, nil, nil, CONNECT_INTERACTIVE); end; // MSDN says that the final character must be a backslash ('\'). wsNewDir:= wsNewDir + DirectorySeparator; Result:= SetCurrentDirectoryW(PWideChar(wsNewDir)); end; {$ELSE} begin Result:= fpChDir(PChar(UTF8ToSys(NewDir))) = 0; end; {$ENDIF} function mbDirectoryExists(const Directory: UTF8String) : Boolean; {$IFDEF MSWINDOWS} var Attr:Dword; wDirectory: WideString; begin wDirectory:= UTF8Decode(Directory); Attr:= GetFileAttributesW(PWChar(wDirectory)); if Attr <> DWORD(-1) then Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) > 0 else Result:= False; end; {$ELSE} var Info: BaseUnix.Stat; begin // We can use fpStat here instead of fpLstat, so that True is returned // when target is a directory or a link to an existing directory. // Note that same behaviour would be achieved by passing paths // that end with path delimiter to fpLstat. // Paths with links can be used the same way as if they were real directories. if fpStat(UTF8ToSys(Directory), Info) >= 0 then Result:= fpS_ISDIR(Info.st_mode) else Result:= False; end; {$ENDIF} function mbCreateDir(const NewDir: UTF8String): Boolean; {$IFDEF MSWINDOWS} var wNewDir: WideString; begin wNewDir:= UTF8Decode(NewDir); Result:= CreateDirectoryW(PWChar(wNewDir), nil); end; {$ELSE} begin Result:= fpMkDir(PChar(UTF8ToSys(NewDir)), $1FF) = 0; // $1FF = &0777 end; {$ENDIF} function mbRemoveDir(const Dir: UTF8String): Boolean; {$IFDEF MSWINDOWS} var wDir: WideString; begin wDir:= UTF8Decode(Dir); Result:= RemoveDirectoryW(PWChar(wDir)); end; {$ELSE} begin Result:= fpRmDir(PChar(UTF8ToSys(Dir))) = 0; end; {$ENDIF} function mbFileSystemEntryExists(const Path: UTF8String): Boolean; begin Result := mbFileGetAttr(Path) <> faInvalidAttributes; end; function mbCompareFileNames(const FileName1, FileName2: UTF8String): Boolean; inline; {$IF DEFINED(WINDOWS) OR DEFINED(DARWIN)} begin Result:= (WideCompareText(UTF8Decode(FileName1), UTF8Decode(FileName2)) = 0); end; {$ELSE} begin Result:= (WideCompareStr(UTF8Decode(FileName1), UTF8Decode(FileName2)) = 0); end; {$ENDIF} function mbSameFile(const FileName1, FileName2: String): Boolean; {$IF DEFINED(MSWINDOWS)} var FileHandle1, FileHandle2: System.THandle; FileInfo1, FileInfo2: BY_HANDLE_FILE_INFORMATION; begin Result := mbCompareFileNames(FileName1, FileName2); if not Result then begin FileHandle1 := CreateFileW(PWideChar(UTF8Decode(FileName1)), FILE_READ_ATTRIBUTES, FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE, nil, OPEN_EXISTING, 0, 0); if FileHandle1 <> INVALID_HANDLE_VALUE then begin FileHandle2 := CreateFileW(PWideChar(UTF8Decode(FileName2)), FILE_READ_ATTRIBUTES, FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE, nil, OPEN_EXISTING, 0, 0); if FileHandle2 <> INVALID_HANDLE_VALUE then begin if GetFileInformationByHandle(FileHandle1, FileInfo1) and GetFileInformationByHandle(FileHandle2, FileInfo2) then begin // Check if both files have the same index on the same volume. // This check is valid only while both files are open. Result := (FileInfo1.dwVolumeSerialNumber = FileInfo2.dwVolumeSerialNumber) and (FileInfo1.nFileIndexHigh = FileInfo2.nFileIndexHigh) and (FileInfo1.nFileIndexLow = FileInfo2.nFileIndexLow); end; CloseHandle(FileHandle2); end; CloseHandle(FileHandle1); end end; end; {$ELSEIF DEFINED(UNIX)} var File1Stat, File2Stat: stat; begin Result := mbCompareFileNames(FileName1, FileName2) or ( (fpLstat(UTF8ToSys(FileName1), File1Stat) = 0) and (fpLstat(UTF8ToSys(FileName2), File2Stat) = 0) and (File1Stat.st_ino = File2Stat.st_ino) and (File1Stat.st_dev = File2Stat.st_dev) ); end; {$ENDIF} function mbGetEnvironmentString(Index: Integer): UTF8String; {$IFDEF MSWINDOWS} var hp, p: PWideChar; begin Result:= ''; p:= GetEnvironmentStringsW; hp:= p; if (hp <> nil) then begin while (hp^ <> #0) and (Index > 1) do begin Dec(Index); hp:= hp + lstrlenW(hp) + 1; end; if (hp^ <> #0) then Result:= UTF8Encode(WideString(hp)); end; FreeEnvironmentStringsW(p); end; {$ELSE} begin Result:= SysToUTF8(GetEnvironmentString(Index)); end; {$ENDIF} function mbSysErrorMessage(ErrorCode: Integer): UTF8String; begin Result := {$IFDEF WINDOWS} UTF8Encode(SysErrorMessage(ErrorCode)); {$ELSE} SysToUTF8(SysErrorMessage(ErrorCode)); {$ENDIF} end; function mbLoadLibrary(const Name: UTF8String): TLibHandle; {$IFDEF MSWINDOWS} var wsName: WideString; begin wsName:= UTF8Decode(Name); Result:= LoadLibraryW(PWideChar(wsName)); end; {$ELSE} begin Result:= TLibHandle(dlopen(PChar(UTF8ToSys(Name)), RTLD_LAZY)); end; {$ENDIF} function SafeGetProcAddress(Lib: TLibHandle; const ProcName: AnsiString): Pointer; begin Result:= GetProcedureAddress(Lib, ProcName); if (Result = nil) then raise Exception.Create(ProcName); end; end.