Complete BigTask

code/KM_FileIO_Mobile.pas

@@ -0,0 +1,255 @@
+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.