unit KM_FileIO_Mobile; {$I KaM_Remake.inc} interface function KMFileIODecodeLegacy(const aBytes: RawByteString; aCodePage: Word): UnicodeString; procedure KMFileIOCopyFile(const aSource, aDest: UnicodeString); procedure KMFileIORemoveDirectoryTree(const aPath: UnicodeString); procedure KMFileIOMoveToTrash(const aSourcePath: UnicodeString; aIsDirectory: Boolean); procedure KMFileIORenameDirectory(const aSourcePath, aDestPath: UnicodeString); function KMFileIOApplicationSavePath: string; function KMFileIOIsDirectoryWriteable(const aDir: string): Boolean; procedure KMFileIOCheckFolderPermission(const aPath: string; out aRead, aWrite, aExec: Boolean); implementation uses SysUtils, BaseUnix, SyncObjs, CastleFilesUtils, CastleUriUtils, charset, cpall, cp932, cp936, cp949, cp950; var TrashCriticalSection: TCriticalSection; function FileSystemPathToUtf8(const aPath: UnicodeString): RawByteString; begin Result := RawByteString(UTF8Encode(aPath)); end; function ResolveApplicationDirectory(const aRelativePath: string): string; var Url, RawPath: string; begin Url := CastleFilesUtils.ApplicationConfig(aRelativePath); RawPath := CastleUriUtils.UriToFilenameSafe(Url); if RawPath = '' then raise Exception.CreateFmt('Unable to resolve application storage location: %s', [Url]); Result := IncludeTrailingPathDelimiter(RawPath); if not DirectoryExists(Result) and not ForceDirectories(Result) and not DirectoryExists(Result) then raise Exception.CreateFmt('Unable to create application storage directory: %s', [Result]); end; function KMFileIOApplicationSavePath: string; begin Result := ResolveApplicationDirectory(''); end; procedure KMFileIOCopyFile(const aSource, aDest: UnicodeString); begin CastleFilesUtils.CheckCopyFile(aSource, aDest); end; procedure KMFileIORemoveDirectoryTree(const aPath: UnicodeString); begin CastleFilesUtils.RemoveNonEmptyDir(aPath, False); end; procedure KMFileIORenameDirectory(const aSourcePath, aDestPath: UnicodeString); var RawSource, RawDest: RawByteString; Err: Integer; begin RawSource := FileSystemPathToUtf8(aSourcePath); RawDest := FileSystemPathToUtf8(aDestPath); if fpRename(RawSource, RawDest) = 0 then Exit; Err := fpgeterrno; if Err <> ESysEXDEV then raise Exception.CreateFmt('KM_FileIO: unable to rename directory from %s to %s (errno %d: %s)', [aSourcePath, aDestPath, Err, SysErrorMessage(Err)]); try CastleFilesUtils.CopyDirectory(aSourcePath, aDestPath); except if DirectoryExists(aDestPath) then try CastleFilesUtils.RemoveNonEmptyDir(aDestPath, True); except end; raise; end; CastleFilesUtils.RemoveNonEmptyDir(aSourcePath, False); end; procedure KMFileIOMoveToTrash(const aSourcePath: UnicodeString; aIsDirectory: Boolean); var TrashRoot: string; NormalizedSource, BaseName, Extension, Destination: UnicodeString; Counter, Err: Integer; RawSource, RawDest: RawByteString; begin TrashCriticalSection.Acquire; try TrashRoot := ResolveApplicationDirectory('Trash/'); NormalizedSource := ExcludeTrailingPathDelimiter(aSourcePath); BaseName := ExtractFileName(NormalizedSource); if BaseName = '' then raise Exception.CreateFmt('KM_FileIO: invalid trash source path: %s', [aSourcePath]); Destination := UnicodeString(TrashRoot) + BaseName; if FileExists(Destination) or DirectoryExists(Destination) then begin Counter := 1; if not aIsDirectory then Extension := ExtractFileExt(BaseName); repeat if aIsDirectory then Destination := UnicodeString(TrashRoot) + BaseName + '.trash-' + IntToStr(Counter) else Destination := UnicodeString(TrashRoot) + Copy(BaseName, 1, Length(BaseName) - Length(Extension)) + '.trash-' + IntToStr(Counter) + Extension; Inc(Counter); until not FileExists(Destination) and not DirectoryExists(Destination); end; RawSource := FileSystemPathToUtf8(aSourcePath); RawDest := FileSystemPathToUtf8(Destination); if fpRename(RawSource, RawDest) = 0 then Exit; Err := fpgeterrno; if Err <> ESysEXDEV then raise Exception.CreateFmt('KM_FileIO: unable to move %s to %s (errno %d: %s)', [aSourcePath, Destination, Err, SysErrorMessage(Err)]); if aIsDirectory then begin try CastleFilesUtils.CopyDirectory(aSourcePath, Destination); except if DirectoryExists(Destination) then try CastleFilesUtils.RemoveNonEmptyDir(Destination, True); except end; raise; end; CastleFilesUtils.RemoveNonEmptyDir(aSourcePath, False); end else begin try CastleFilesUtils.CheckCopyFile(aSourcePath, Destination); except if FileExists(Destination) then try SysUtils.DeleteFile(Destination); except end; raise; end; if not SysUtils.DeleteFile(aSourcePath) then raise Exception.CreateFmt('KM_FileIO: unable to delete moved source file: %s', [aSourcePath]); end; finally TrashCriticalSection.Release; end; end; procedure KMFileIOCheckFolderPermission(const aPath: string; out aRead, aWrite, aExec: Boolean); var RawPath: RawByteString; begin RawPath := FileSystemPathToUtf8(UnicodeString(aPath)); aRead := fpAccess(RawPath, R_OK) = 0; aWrite := fpAccess(RawPath, W_OK) = 0; aExec := fpAccess(RawPath, X_OK) = 0; end; function KMFileIOIsDirectoryWriteable(const aDir: string): Boolean; var BaseToken, Candidate: string; RawCandidate: RawByteString; Attempt, Handle, Err: Integer; Value: Byte; Created, IsOpen, WriteOk, CloseOk: Boolean; begin Result := False; if (aDir = '') or not DirectoryExists(aDir) then Exit; Created := False; IsOpen := False; try try BaseToken := '.kam-write-check-' + IntToHex(GetTickCount64, 1); Attempt := 0; repeat Candidate := IncludeTrailingPathDelimiter(aDir) + BaseToken + '-' + IntToStr(Attempt); RawCandidate := FileSystemPathToUtf8(UnicodeString(Candidate)); Handle := fpOpen(RawCandidate, O_WRONLY or O_CREAT or O_EXCL, S_IRUSR or S_IWUSR); if Handle >= 0 then Break; Err := fpgeterrno; if Err <> ESysEEXIST then Exit; Inc(Attempt); until False; Created := True; IsOpen := True; Value := 0; WriteOk := fpWrite(Handle, Value, 1) = 1; CloseOk := fpClose(Handle) = 0; if CloseOk then IsOpen := False; Result := WriteOk and CloseOk; finally try if IsOpen then fpClose(Handle); finally if Created and FileExists(Candidate) and not DeleteFile(Candidate) then Result := False; end; end; except Result := False; end; end; function KMFileIODecodeLegacy(const aBytes: RawByteString; aCodePage: Word): UnicodeString; var Map: PUnicodeMap; Required, Converted: LongInt; begin Map := getmap(aCodePage); if Map = nil then raise EConvertError.CreateFmt('Unsupported codepage: %d', [aCodePage]); if aBytes = '' then Exit(''); Required := getunicode(PAnsiChar(aBytes), Length(aBytes), Map, nil); if Required < 0 then raise EConvertError.CreateFmt('Conversion failed for codepage: %d', [aCodePage]); if Required = 0 then Exit(''); SetLength(Result, Required); Converted := getunicode(PAnsiChar(aBytes), Length(aBytes), Map, @Result[1]); if Converted < 0 then raise EConvertError.CreateFmt('Conversion failed for codepage: %d', [aCodePage]); if Converted < Required then SetLength(Result, Converted); end; initialization TrashCriticalSection := TCriticalSection.Create; finalization TrashCriticalSection.Free; end.