From 06baad3db61a312add89264809c913ececfa499e Mon Sep 17 00:00:00 2001 From: admin_d Date: Fri, 18 Sep 2026 00:06:15 +0500 Subject: [PATCH] Complete BigTask --- code/KM_FileIO_Mobile.pas | 255 +++++++++++ config/extra-paths.json | 1 + .../kam_remake/src/res/KM_ResTexts.pas | 416 ++++++++++++++++++ .../kam_remake/src/utils/io/KM_FileIO.pas | 159 ++++--- 4 files changed, 779 insertions(+), 52 deletions(-) create mode 100644 code/KM_FileIO_Mobile.pas create mode 100644 port-source/kam_remake/src/res/KM_ResTexts.pas diff --git a/code/KM_FileIO_Mobile.pas b/code/KM_FileIO_Mobile.pas new file mode 100644 index 0000000..cd7c65b --- /dev/null +++ b/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. diff --git a/config/extra-paths.json b/config/extra-paths.json index 856d2b2..0c45706 100755 --- a/config/extra-paths.json +++ b/config/extra-paths.json @@ -9,6 +9,7 @@ "src/utils/KM_Utils.pas", "src/terrain/KM_TerrainUtils.pas", "src/res/KM_ResSprites.pas", + "src/res/KM_ResTexts.pas", "src/utils/io/KM_IoPNG.pas", "src/res/KM_ResUnits.pas", "src/res/KM_ResHouses.pas" diff --git a/port-source/kam_remake/src/res/KM_ResTexts.pas b/port-source/kam_remake/src/res/KM_ResTexts.pas new file mode 100644 index 0000000..4801af7 --- /dev/null +++ b/port-source/kam_remake/src/res/KM_ResTexts.pas @@ -0,0 +1,416 @@ +unit KM_ResTexts; +{$I KaM_Remake.inc} +interface +uses + Classes, SysUtils, StrUtils, KromUtils, + KM_CommonClasses, KM_FileIO, KM_ResLocales; + + +const + // Take text IDs from this include file that is managed by the Translation Manager + // NAME__## means that this const defines first element of some range that is ## long + {$I KM_TextIDs.inc} + + // Supposed for places where some text must be placed + // That string was used in all Synetic games for missing texts + NO_TEXT = '<<>>'; + + MISSION_NAME_LIBX_ID = 200; //Reserved Libx ID for Mission name in Campaigns + LIBX_NO_ID = -1; + +type + TKMTextLibraryCommon = class + private + procedure LoadLIBXFile(const FilePath: string; var aArray: TUnicodeStringArray; aFullScan: Boolean = True); + end; + + + TKMTextLibrarySingle = class(TKMTextLibraryCommon) + private + fTexts: TUnicodeStringArray; + function GetTexts(aIndex: Word): UnicodeString; + public + procedure LoadLocale(const aPathTemplate: string); // Initial locale for UI strings + property Texts[aIndex: Word]: UnicodeString read GetTexts; default; + function IsIndexValid(aIndex: Word): Boolean; + end; + + + TKMTextLibraryMulti = class(TKMTextLibraryCommon) + private const + HANDS_NAMES_OFFSET = 100; + private + fPref: array [0..2] of Integer; + + fTexts: array of TUnicodeStringArray; + fForceDefaultLocale: Boolean; //Force to use default Locale (Eng) + function GetTexts(aIndex: Word): UnicodeString; + function GetDefaultTexts(aIndex: Word): UnicodeString; + procedure InitLocaleIds; + function DoParseTextMarkup(const aText: UnicodeString; aTagSym: Char): UnicodeString; + public + constructor Create; + procedure LoadLocale(const aPathTemplate: string; aFullScan: Boolean = True); // All locales for Mission strings + procedure Clear; + function ParseTextMarkup(const aText: UnicodeString): UnicodeString; overload; + function ParseTextMarkup(const aText: UnicodeString; aParams: array of const): UnicodeString; overload; + function HasText(aIndex: Word): Boolean; + property Texts[aIndex: Word]: UnicodeString read GetTexts; default; + + function HasHandNameText(aIndex: Word): Boolean; + function GetHandNameText(aIndex: Word): UnicodeString; + + property DefaultTexts[aIndex: Word]: UnicodeString read GetDefaultTexts; + property ForceDefaultLocale: Boolean read fForceDefaultLocale write fForceDefaultLocale; + procedure Save(aStream: TKMemoryStream); + procedure Load(LoadStream: TKMemoryStream); + end; + + +var + // All games texts accessible from everywhere + gResTexts: TKMTextLibraryMulti; + +implementation +uses + Math; + +{ TKMTextLibraryCommon } +// LIBX files consist of lines. Each line has an index and a text. Lines without index are skipped +procedure TKMTextLibraryCommon.LoadLIBXFile(const FilePath: string; var aArray: TUnicodeStringArray; aFullScan: Boolean = True); + + function TextToArray(const aText: UnicodeString): TUnicodeStringArray; + var + P, start: PWideChar; + S: UnicodeString; + begin + SetLength(Result, 0); + P := Pointer(aText); + if P = nil then Exit; + + // This is a lot faster than using StrPos/AnsiStrPos when + // LineBreak is the default (#13#10) + while P^ <> #0 do + begin + start := P; + while not KromUtils.CharInSet(P^, [#0, #10, #13]) do Inc(P); + SetString(S, start, P - start); + + SetLength(Result, Length(Result) + 1); + Result[High(Result)] := S; + + if P^ = #13 then Inc(P); + if P^ = #10 then Inc(P); + end; + end; +var + tmp: TUnicodeStringArray; + langCode: AnsiString; + libTxt: UnicodeString; + I: Integer; + s: UnicodeString; + firstDelimiter: Integer; + id, topId, lineId: Integer; +begin + if not FileExists(FilePath) then Exit; + + // Load ANSI file with codepage we say into unicode string + langCode := AnsiString(Copy(FilePath, Length(FilePath) - 7, 3)); + libTxt := ReadTextU(FilePath, gResLocales.LocaleByCode(langCode).FontCodepage); + tmp := TextToArray(libTxt); + + topId := -1; + + for I := High(tmp) downto 0 do + begin + firstDelimiter := Pos(':', tmp[I]); + if firstDelimiter = 0 then Continue; + + if TryStrToInt(LeftStr(tmp[I], firstDelimiter - 1), lineId) then + begin + if not aFullScan then + begin + topId := lineId; + Break; + end; + topId := Max(lineId, topId); + end; + end; + + // No strings were found + if topId = -1 then Exit; + + Assert(topId <= 2048, 'Don''t allow too many strings for no reason'); + + // Don't shrink the array, we might be overloading base locale with a partial translation + if Length(aArray) < topId + 1 then + SetLength(aArray, topId + 1); + + for I := 0 to High(tmp) do + begin + s := tmp[I]; + + // Get string index and skip erroneous lines + firstDelimiter := Pos(':', s); + if firstDelimiter = 0 then Continue; + if not TryStrToInt(TrimLeft(LeftStr(s, firstDelimiter - 1)), id) then Continue; + + s := RightStr(s, Length(s) - firstDelimiter); + // Required characters that can't be stored in plain text + //todo -cComplicated: Remove them in favor of | for eol (and update libx files) + s := SysUtils.UnicodeStringReplace(s, '\n', EolW, [rfReplaceAll, rfIgnoreCase]); + s := SysUtils.UnicodeStringReplace(s, '\\', '\', [rfReplaceAll, rfIgnoreCase]); + aArray[id] := s; + end; +end; + + +function TKMTextLibrarySingle.GetTexts(aIndex: Word): UnicodeString; +begin + if aIndex < Length(fTexts) then + Result := fTexts[aIndex] + else + Result := '~~~String ' + IntToStr(aIndex) + ' out of range!~~~'; +end; + + +function TKMTextLibrarySingle.IsIndexValid(aIndex: Word): Boolean; +begin + Result := aIndex < Length(fTexts); +end; + + +// Text file template, e.g.: ExeDir\text.%s.libx +// We need locale separate to assemble Fallback and Default locales paths +procedure TKMTextLibrarySingle.LoadLocale(const aPathTemplate: string); +begin + // We load the English LIBX by default, then overwrite it with the selected language + // (this way missing strings are in English) + LoadLIBXFile(Format(aPathTemplate, [gResLocales.DefaultLocale]), fTexts); + + if gResLocales.FallbackLocale <> '' then + LoadLIBXFile(Format(aPathTemplate, [gResLocales.FallbackLocale]), fTexts); + + LoadLIBXFile(Format(aPathTemplate, [gResLocales.UserLocale]), fTexts); +end; + + +{ TKMTextLibraryMulti } +constructor TKMTextLibraryMulti.Create; +begin + inherited Create; + + InitLocaleIds; + fForceDefaultLocale := False; +end; + + +procedure TKMTextLibraryMulti.InitLocaleIds; +begin + // Using indexes is faster than always looking them up for every string requested + fPref[0] := gResLocales.IndexByCode(gResLocales.UserLocale); + fPref[1] := gResLocales.IndexByCode(gResLocales.FallbackLocale); + fPref[2] := gResLocales.IndexByCode(gResLocales.DefaultLocale); +end; + + +// Check if requested string is empty +function TKMTextLibraryMulti.HasText(aIndex: Word): Boolean; +begin + Result := ((fPref[0] <> -1) and (aIndex < Length(fTexts[fPref[0]])) and (fTexts[fPref[0], aIndex] <> '')) + or ((fPref[1] <> -1) and (aIndex < Length(fTexts[fPref[1]])) and (fTexts[fPref[1], aIndex] <> '')) + or ((fPref[2] <> -1) and (aIndex < Length(fTexts[fPref[2]])) and (fTexts[fPref[2], aIndex] <> '')); +end; + + +function TKMTextLibraryMulti.HasHandNameText(aIndex: Word): Boolean; +begin + Result := HasText(HANDS_NAMES_OFFSET + aIndex); +end; + + +function TKMTextLibraryMulti.GetHandNameText(aIndex: Word): UnicodeString; +begin + Result := GetTexts(HANDS_NAMES_OFFSET + aIndex); +end; + + +// Order of preference: Locale > Fallback > Default(Eng) +// Some locales may have no strings at all, just skip them +function TKMTextLibraryMulti.GetTexts(aIndex: Word): UnicodeString; +var + found: Boolean; +begin + found := False; + + if (fPref[0] <> -1) and (aIndex < Length(fTexts[fPref[0]])) and (fTexts[fPref[0], aIndex] <> '') then + begin + Result := fTexts[fPref[0], aIndex]; + found := True; + end + else + if (fPref[1] <> -1) and (aIndex < Length(fTexts[fPref[1]])) and (fTexts[fPref[1], aIndex] <> '') then + begin + Result := fTexts[fPref[1], aIndex]; + found := True; + end; + + if (not found or fForceDefaultLocale) then + begin + if (fPref[2] <> -1) and (aIndex < Length(fTexts[fPref[2]])) and (fTexts[fPref[2], aIndex] <> '') then + begin + Result := fTexts[fPref[2], aIndex]; + found := True; + end; + end; + if not found then + Result := '~~~String ' + IntToStr(aIndex) + ' out of range!~~~'; +end; + + +// Returns in text default locale +function TKMTextLibraryMulti.GetDefaultTexts(aIndex: Word): UnicodeString; +begin + if (fPref[2] <> -1) and (aIndex < Length(fTexts[fPref[2]])) and (fTexts[fPref[2], aIndex] <> '') then + Result := fTexts[fPref[2], aIndex] + else + Result := '~~~String ' + IntToStr(aIndex) + ' out of range!~~~'; +end; + + +procedure TKMTextLibraryMulti.Clear; +begin + SetLength(fTexts, 0); +end; + + +// Path template with %s +procedure TKMTextLibraryMulti.LoadLocale(const aPathTemplate: string; aFullScan: Boolean = True); +var + I: Integer; +begin + SetLength(fTexts, gResLocales.Count); + + for I := 0 to gResLocales.Count - 1 do + LoadLIBXFile(Format(aPathTemplate, [gResLocales[I].Code]), fTexts[I], aFullScan); +end; + + +// Dynamic Scripts should not have access to the actual strings (script variables should be identical for all MP players) +// Take the string and replace every occurence of <$tag> with corresponding text from LibX +// - aTagSym says which tags should be replaced ($ for missions, % for game texts) +function TKMTextLibraryMulti.DoParseTextMarkup(const aText: UnicodeString; aTagSym: Char): UnicodeString; +var + I, ID, last: Integer; +begin + Assert((aTagSym = '$') or (aTagSym = '%')); + + Result := ''; + I := 1; + while I <= Length(aText) do + begin + if (I + 3 <= Length(aText)) and (aText[I] = '<') and (aText[I+1] = aTagSym) then + begin + last := PosEx('>', aText, I); + ID := StrToIntDef(Copy(aText, I+2, last-(I+2)), -1); + if ID >= 0 then + begin + Result := Result + Texts[ID]; + I := last + 1; + Continue; + end; + end; + Result := Result + aText[I]; + Inc(I); + end; +end; + + +function TKMTextLibraryMulti.ParseTextMarkup(const aText: UnicodeString): UnicodeString; +begin + Assert(Self <> gResTexts, 'Only missions so far can do text parsing'); + + Result := DoParseTextMarkup(aText, '$'); + Result := gResTexts.DoParseTextMarkup(Result, '%'); +end; + + +function TKMTextLibraryMulti.ParseTextMarkup(const aText: UnicodeString; aParams: array of const): UnicodeString; +begin + Result := ParseTextMarkup(Format(ParseTextMarkup(aText), aParams)); +end; + + +procedure TKMTextLibraryMulti.Save(aStream: TKMemoryStream); + + function LocalesWithText: Integer; + var + I: Integer; + begin + Result := 0; + for I := 0 to gResLocales.Count - 1 do + if Length(fTexts[I]) > 0 then + Inc(Result); + end; + +var + I, K: Integer; + textCount: Integer; +begin + aStream.PlaceMarker('TextLibraryMulti'); + // Only save locales containing text (otherwise locale list must be synced in MP) + aStream.Write(LocalesWithText); + for I := 0 to gResLocales.Count - 1 do + if Length(fTexts[I]) > 0 then + begin + aStream.WriteA(gResLocales[I].Code); + + textCount := Length(fTexts[I]); + + aStream.Write(textCount); + for K := 0 to textCount - 1 do + aStream.WriteW(fTexts[I,K]); + end; +end; + + +procedure TKMTextLibraryMulti.Load(LoadStream: TKMemoryStream); +var + I, K: Integer; + locCount, textCount: Integer; + curLoc: AnsiString; + ID: Integer; + tmp: UnicodeString; +begin + // Try to match savegame locales with players locales, + // because some players might have non-native locales missing + // We might add locale selection to setup.exe + LoadStream.CheckMarker('TextLibraryMulti'); + SetLength(fTexts, gResLocales.Count); + + LoadStream.Read(locCount); + for I := 0 to locCount - 1 do + begin + LoadStream.ReadA(curLoc); + ID := gResLocales.IndexByCode(curLoc); + + LoadStream.Read(textCount); + + if ID <> -1 then + begin + SetLength(fTexts[ID], textCount); + for K := 0 to textCount - 1 do + LoadStream.ReadW(fTexts[ID,K]); + end + else + begin + for K := 0 to textCount - 1 do + LoadStream.ReadW(tmp); + end; + end; + + InitLocaleIds; +end; + + +end. diff --git a/port-source/kam_remake/src/utils/io/KM_FileIO.pas b/port-source/kam_remake/src/utils/io/KM_FileIO.pas index cfc66c4..f9c0382 100644 --- a/port-source/kam_remake/src/utils/io/KM_FileIO.pas +++ b/port-source/kam_remake/src/utils/io/KM_FileIO.pas @@ -65,13 +65,16 @@ uses implementation uses StrUtils, KM_CommonUtils, - KM_Defaults; + KM_Defaults + {$IFDEF ANDROID}, KM_FileIO_Mobile{$ENDIF}; function ReadTextA(const aFilename: UnicodeString): AnsiString; var MS: TMemoryStream; - Head: Cardinal; + BOM: array[0..2] of Byte; + HasBOM: Boolean; + Remaining: Int64; begin MS := TMemoryStream.Create; try @@ -80,18 +83,23 @@ begin // Instead we read plain ANSI text. If there's BOM - clip it MS.LoadFromFile(aFileName); - // Read 4 bytes but check just 3, cos reading 3 bytes is a hassle - MS.Read(Head, SizeOf(Cardinal)); + HasBOM := False; + if MS.Size >= 3 then + begin + MS.Position := 0; + MS.ReadBuffer(BOM, SizeOf(BOM)); + HasBOM := (BOM[0] = $EF) and (BOM[1] = $BB) and (BOM[2] = $BF); + end; - // Trim UTF8 BOM (don't know how to deal with others yet) - if Head and $FFFFFF = $BFBBEF then + if HasBOM then MS.Position := 3 else MS.Position := 0; - SetLength(Result, MS.Size - MS.Position); - if MS.Size - MS.Position > 0 then - MS.Read(Result[1], MS.Size - MS.Position); + Remaining := MS.Size - MS.Position; + SetLength(Result, Remaining); + if Remaining > 0 then + MS.ReadBuffer(Result[1], Remaining); finally MS.Free; end; @@ -107,9 +115,10 @@ var {$ENDIF} {$IFDEF FPC} MS: TMemoryStream; - Head: Cardinal; + BOM: array[0..2] of Byte; HasBOM: Boolean; - TmpA: AnsiString; + TmpA: RawByteString; + Remaining: Int64; {$ENDIF} begin {$IFDEF WDC} @@ -129,23 +138,29 @@ begin MS := TMemoryStream.Create; try MS.LoadFromFile(aFileName); - MS.Read(Head, 4); - - //Trim UTF8 BOM (don't know how to deal with others yet) - HasBOM := Head and $FFFFFF = $BFBBEF; + HasBOM := False; + if MS.Size >= 3 then + begin + MS.Position := 0; + MS.ReadBuffer(BOM, SizeOf(BOM)); + HasBOM := (BOM[0] = $EF) and (BOM[1] = $BB) and (BOM[2] = $BF); + end; if HasBOM then MS.Position := 3 else MS.Position := 0; - SetLength(TmpA, MS.Size - MS.Position); - MS.Read(TmpA[1], MS.Size - MS.Position); + Remaining := MS.Size - MS.Position; + SetLength(TmpA, Remaining); + if Remaining > 0 then + MS.ReadBuffer(TmpA[1], Remaining); {$IFDEF ANDROID} - if not HasBOM then - raise Exception.Create('KM_FileIO: ReadTextU codepage conversion is unsupported on Android'); - Result := UTF8Decode(TmpA); + if HasBOM then + Result := UTF8Decode(TmpA) + else + Result := KMFileIODecodeLegacy(TmpA, aEncoding); {$ELSE} //Non-UTF8 files must be converted from their native encoding if not HasBOM then @@ -163,7 +178,7 @@ end; procedure KMCopyFile(const aSrc, aDest: UnicodeString); begin {$IFDEF ANDROID} - raise Exception.Create('KM_FileIO: KMCopyFile is unsupported on Android'); + KMFileIOCopyFile(aSrc, aDest); {$ELSE} {$IFDEF FPC} CopyFile(pchar(aSrc), pchar(aDest), True); @@ -178,7 +193,9 @@ end; procedure KMCopyFile(const aSrc, aDest: UnicodeString; aOverwrite: Boolean); begin {$IFDEF ANDROID} - raise Exception.Create('KM_FileIO: KMCopyFile is unsupported on Android'); + if aOverwrite and FileExists(aDest) and not SysUtils.DeleteFile(aDest) then + raise Exception.CreateFmt('KM_FileIO: unable to delete destination file: %s', [aDest]); + KMFileIOCopyFile(aSrc, aDest); {$ELSE} if aOverwrite and FileExists(aDest) then DeleteFile(aDest); @@ -211,7 +228,7 @@ end; procedure KMDeleteFileToBin(const aPath: UnicodeString); begin {$IFDEF ANDROID} - raise Exception.Create('KM_FileIO: KMDeleteFileToBin is unsupported on Android'); + KMDeleteFile(aPath, True); {$ELSE} KMDeleteFile(aPath, True); {$ENDIF} @@ -242,10 +259,15 @@ begin SHFileOperation(ShOp); {$ELSE} {$IFDEF ANDROID} + if not FileExists(aFilePath) then + Exit; if aDeleteToBin then - raise Exception.Create('KM_FileIO: KMDeleteFile recycle-bin mode is unsupported on Android'); + KMFileIOMoveToTrash(aFilePath, False) + else if not SysUtils.DeleteFile(aFilePath) then + raise Exception.CreateFmt('KM_FileIO: unable to delete file: %s', [aFilePath]); + {$ELSE} + DeleteFile(aFilePath); {$ENDIF} - DeleteFile(aFilePath); {$ENDIF} end; @@ -253,7 +275,7 @@ end; procedure KMDeleteFolderToBin(const aPath: UnicodeString); begin {$IFDEF ANDROID} - raise Exception.Create('KM_FileIO: KMDeleteFolderToBin is unsupported on Android'); + KMDeleteFolder(aPath, True); {$ELSE} KMDeleteFolder(aPath, True); {$ENDIF} @@ -263,7 +285,7 @@ end; procedure KMDeleteFolder(const aPath: UnicodeString); begin {$IFDEF ANDROID} - raise Exception.Create('KM_FileIO: KMDeleteFolder is unsupported on Android'); + KMDeleteFolder(aPath, False); {$ELSE} KMDeleteFolder(aPath, False); {$ENDIF} @@ -320,11 +342,14 @@ const {$ENDIF} begin - {$IFDEF ANDROID} - raise Exception.Create('KM_FileIO: KMDeleteFolder is unsupported on Android'); - {$ELSE} if DirectoryExists(aPath) then begin + {$IFDEF ANDROID} + if aDeleteToBin then + KMFileIOMoveToTrash(aPath, True) + else + KMFileIORemoveDirectoryTree(aPath); + {$ELSE} {$IFDEF MSWINDOWS} if aDeleteToBin then begin @@ -344,8 +369,8 @@ begin {$ELSE} DeleteDefault; {$ENDIF} + {$ENDIF} end; - {$ENDIF} end; @@ -356,7 +381,12 @@ var {$ENDIF} begin {$IFDEF ANDROID} - raise Exception.Create('KM_FileIO: KMDeleteFolderContent is unsupported on Android'); + if DirectoryExists(aPath) then + begin + KMDeleteFolder(aPath, aDeleteToBin); + if not ForceDirectories(aPath) and not DirectoryExists(aPath) then + raise Exception.CreateFmt('KM_FileIO: unable to recreate folder: %s', [aPath]); + end; {$ELSE} if DirectoryExists(aPath) then begin @@ -393,7 +423,13 @@ end; procedure KMRenameFolder(const aSourcePath, aDestPath: UnicodeString); begin - {$IFDEF FPC} RenameFile(aSourcePath, aDestPath); {$ENDIF} + {$IFDEF FPC} + {$IFDEF ANDROID} + KMFileIORenameDirectory(aSourcePath, aDestPath); + {$ELSE} + RenameFile(aSourcePath, aDestPath); + {$ENDIF} + {$ENDIF} {$IFDEF WDC} TDirectory.Move(aSourcePath, aDestPath); {$ENDIF} end; @@ -405,15 +441,19 @@ begin if IsFilePath(aSourcePath) then begin if FileExists(aSourcePath) then - {$IFDEF FPC} RenameFile(aSourcePath, aDestPath); {$ENDIF} + {$IFDEF FPC} + {$IFDEF ANDROID} + if not SysUtils.RenameFile(aSourcePath, aDestPath) then + raise Exception.CreateFmt('KM_FileIO: unable to rename file from %s to %s', [aSourcePath, aDestPath]); + {$ELSE} + RenameFile(aSourcePath, aDestPath); + {$ENDIF} + {$ENDIF} {$IFDEF WDC} TFile.Move(aSourcePath, aDestPath); {$ENDIF} end else if DirectoryExists(aSourcePath) then begin - {$IFDEF ANDROID} - raise Exception.Create('KM_FileIO: KMRenamePath directory mode is unsupported on Android'); - {$ELSE} //Try to delete folder up to 3 times. Sometimes folder could not be deleted for some reason if not TryExecuteMethodProc(KMDeleteFolder, aDestPath, 'KMDeleteFolder', ErrorStr) then raise Exception.Create('Can''t delete folder ' + aDestPath + ': ' + ErrorStr); @@ -421,7 +461,6 @@ begin //Try to rename folder up to 3 times. Sometimes folder could not be renamed for some reason if not TryExecuteMethodProc(KMRenameFolder, aSourcePath, aDestPath, 'KMRenameFolder', ErrorStr) then raise Exception.Create(Format('Can''t rename folder from %s to %s: %s', [aSourcePath, aDestPath, ErrorStr])); - {$ENDIF} end; end; @@ -480,10 +519,6 @@ begin or (aSourceFolder = aDestFolder) or not DirectoryExists(aSourceFolder) then Exit; - {$IFDEF ANDROID} - raise Exception.Create('KM_FileIO: KMMoveFolder is unsupported on Android'); - {$ENDIF} - KMDeleteFolder(aDestFolder, False); //Move directory to dest first @@ -503,6 +538,10 @@ function KMFileSize(const aFilename: String): Int64; var info: TWin32FileAttributeData; {$ENDIF} +{$IFDEF ANDROID} +var + Stream: TFileStream; +{$ENDIF} begin Result := -1; @@ -512,6 +551,22 @@ begin Result := Int64(info.nFileSizeLow) or Int64(info.nFileSizeHigh shl 32); {$ENDIF} + + {$IFDEF ANDROID} + if not FileExists(aFilename) then + Exit; + + try + Stream := TFileStream.Create(aFilename, fmOpenRead or fmShareDenyNone); + try + Result := Stream.Size; + finally + Stream.Free; + end; + except + Result := -1; + end; + {$ENDIF} end; @@ -526,10 +581,7 @@ procedure WriteText(const aText: string; aFilename: string; aEncoding: TEncoding var sl: TStringList; begin -{$IFDEF ANDROID} - raise Exception.Create('KM_FileIO: WriteText is unsupported on Android'); -{$ELSE} -{$IFDEF WDC} +{$IF DEFINED(WDC) OR DEFINED(ANDROID)} sl := TStringList.Create; try sl.Text := aText; @@ -538,7 +590,6 @@ begin sl.Free; end; {$ENDIF} -{$ENDIF} end; @@ -551,10 +602,12 @@ begin Stream := TFileStream.Create(aFileName, fmCreate); try BOM := TEncoding.UTF8.GetPreamble; - Stream.WriteBuffer(BOM, Length(BOM)); + if Length(BOM) > 0 then + Stream.WriteBuffer(BOM[0], Length(BOM)); Buffer := TEncoding.UTF8.GetBytes(aText); - Stream.WriteBuffer(Buffer, Length(Buffer)); + if Length(Buffer) > 0 then + Stream.WriteBuffer(Buffer[0], Length(Buffer)); finally Stream.Free; end; @@ -569,7 +622,7 @@ var {$ENDIF} begin {$IFDEF ANDROID} - raise Exception.Create('KM_FileIO: IsDirectoryWriteable is unsupported on Android'); + Result := KMFileIOIsDirectoryWriteable(aDir); {$ELSE} {$IFDEF WDC} tmpFilename := IncludeTrailingPathDelimiter(aDir) + 'chk.tmp'; @@ -594,7 +647,9 @@ end; function CreateAndGetDocumentsSavePath: string; begin {$IFDEF ANDROID} - raise Exception.Create('KM_FileIO: CreateAndGetDocumentsSavePath is unsupported on Android'); + Result := KMFileIOApplicationSavePath; + if not IsDirectoryWriteable(Result) then + raise Exception.CreateFmt('KM_FileIO: application save path is not writeable: %s', [Result]); {$ELSE} // Returns C:\Users\Username\My Documents\My Games\GAME_TITLE\ // According to GDSE this is the most commonly used savegame location (https://gamedev.stackexchange.com/a/108243) @@ -681,7 +736,7 @@ end; procedure CheckFolderPermission(const aPath: string; var aRead, aWrite, aExec: Boolean); begin {$IFDEF ANDROID} - raise Exception.Create('KM_FileIO: CheckFolderPermission is unsupported on Android'); + KMFileIOCheckFolderPermission(aPath, aRead, aWrite, aExec); {$ELSE} {$IFDEF WDC} aRead := (CheckFileAccess(aPath, FILE_GENERIC_READ) = FILE_GENERIC_READ);