Complete BigTask
Sync changed files to Google Drive / sync (push) Successful in 29s

This commit is contained in:
admin_d committed 2026-09-18 00:06:15 +05:00
1 parent 1a5b20ca9f
commit 06baad3db6
4 files changed
+779 -52

No files matched your search

+255
View File
@@ -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.
+1
View File
@@ -9,6 +9,7 @@
"src/utils/KM_Utils.pas", "src/utils/KM_Utils.pas",
"src/terrain/KM_TerrainUtils.pas", "src/terrain/KM_TerrainUtils.pas",
"src/res/KM_ResSprites.pas", "src/res/KM_ResSprites.pas",
"src/res/KM_ResTexts.pas",
"src/utils/io/KM_IoPNG.pas", "src/utils/io/KM_IoPNG.pas",
"src/res/KM_ResUnits.pas", "src/res/KM_ResUnits.pas",
"src/res/KM_ResHouses.pas" "src/res/KM_ResHouses.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 = '<<<LEER>>>';
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.
+107 -52
View File
@@ -65,13 +65,16 @@ uses
implementation implementation
uses uses
StrUtils, KM_CommonUtils, StrUtils, KM_CommonUtils,
KM_Defaults; KM_Defaults
{$IFDEF ANDROID}, KM_FileIO_Mobile{$ENDIF};
function ReadTextA(const aFilename: UnicodeString): AnsiString; function ReadTextA(const aFilename: UnicodeString): AnsiString;
var var
MS: TMemoryStream; MS: TMemoryStream;
Head: Cardinal; BOM: array[0..2] of Byte;
HasBOM: Boolean;
Remaining: Int64;
begin begin
MS := TMemoryStream.Create; MS := TMemoryStream.Create;
try try
@@ -80,18 +83,23 @@ begin
// Instead we read plain ANSI text. If there's BOM - clip it // Instead we read plain ANSI text. If there's BOM - clip it
MS.LoadFromFile(aFileName); MS.LoadFromFile(aFileName);
// Read 4 bytes but check just 3, cos reading 3 bytes is a hassle HasBOM := False;
MS.Read(Head, SizeOf(Cardinal)); 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 HasBOM then
if Head and $FFFFFF = $BFBBEF then
MS.Position := 3 MS.Position := 3
else else
MS.Position := 0; MS.Position := 0;
SetLength(Result, MS.Size - MS.Position); Remaining := MS.Size - MS.Position;
if MS.Size - MS.Position > 0 then SetLength(Result, Remaining);
MS.Read(Result[1], MS.Size - MS.Position); if Remaining > 0 then
MS.ReadBuffer(Result[1], Remaining);
finally finally
MS.Free; MS.Free;
end; end;
@@ -107,9 +115,10 @@ var
{$ENDIF} {$ENDIF}
{$IFDEF FPC} {$IFDEF FPC}
MS: TMemoryStream; MS: TMemoryStream;
Head: Cardinal; BOM: array[0..2] of Byte;
HasBOM: Boolean; HasBOM: Boolean;
TmpA: AnsiString; TmpA: RawByteString;
Remaining: Int64;
{$ENDIF} {$ENDIF}
begin begin
{$IFDEF WDC} {$IFDEF WDC}
@@ -129,23 +138,29 @@ begin
MS := TMemoryStream.Create; MS := TMemoryStream.Create;
try try
MS.LoadFromFile(aFileName); MS.LoadFromFile(aFileName);
MS.Read(Head, 4); HasBOM := False;
if MS.Size >= 3 then
//Trim UTF8 BOM (don't know how to deal with others yet) begin
HasBOM := Head and $FFFFFF = $BFBBEF; MS.Position := 0;
MS.ReadBuffer(BOM, SizeOf(BOM));
HasBOM := (BOM[0] = $EF) and (BOM[1] = $BB) and (BOM[2] = $BF);
end;
if HasBOM then if HasBOM then
MS.Position := 3 MS.Position := 3
else else
MS.Position := 0; MS.Position := 0;
SetLength(TmpA, MS.Size - MS.Position); Remaining := MS.Size - MS.Position;
MS.Read(TmpA[1], MS.Size - MS.Position); SetLength(TmpA, Remaining);
if Remaining > 0 then
MS.ReadBuffer(TmpA[1], Remaining);
{$IFDEF ANDROID} {$IFDEF ANDROID}
if not HasBOM then if HasBOM then
raise Exception.Create('KM_FileIO: ReadTextU codepage conversion is unsupported on Android'); Result := UTF8Decode(TmpA)
Result := UTF8Decode(TmpA); else
Result := KMFileIODecodeLegacy(TmpA, aEncoding);
{$ELSE} {$ELSE}
//Non-UTF8 files must be converted from their native encoding //Non-UTF8 files must be converted from their native encoding
if not HasBOM then if not HasBOM then
@@ -163,7 +178,7 @@ end;
procedure KMCopyFile(const aSrc, aDest: UnicodeString); procedure KMCopyFile(const aSrc, aDest: UnicodeString);
begin begin
{$IFDEF ANDROID} {$IFDEF ANDROID}
raise Exception.Create('KM_FileIO: KMCopyFile is unsupported on Android'); KMFileIOCopyFile(aSrc, aDest);
{$ELSE} {$ELSE}
{$IFDEF FPC} {$IFDEF FPC}
CopyFile(pchar(aSrc), pchar(aDest), True); CopyFile(pchar(aSrc), pchar(aDest), True);
@@ -178,7 +193,9 @@ end;
procedure KMCopyFile(const aSrc, aDest: UnicodeString; aOverwrite: Boolean); procedure KMCopyFile(const aSrc, aDest: UnicodeString; aOverwrite: Boolean);
begin begin
{$IFDEF ANDROID} {$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} {$ELSE}
if aOverwrite and FileExists(aDest) then if aOverwrite and FileExists(aDest) then
DeleteFile(aDest); DeleteFile(aDest);
@@ -211,7 +228,7 @@ end;
procedure KMDeleteFileToBin(const aPath: UnicodeString); procedure KMDeleteFileToBin(const aPath: UnicodeString);
begin begin
{$IFDEF ANDROID} {$IFDEF ANDROID}
raise Exception.Create('KM_FileIO: KMDeleteFileToBin is unsupported on Android'); KMDeleteFile(aPath, True);
{$ELSE} {$ELSE}
KMDeleteFile(aPath, True); KMDeleteFile(aPath, True);
{$ENDIF} {$ENDIF}
@@ -242,10 +259,15 @@ begin
SHFileOperation(ShOp); SHFileOperation(ShOp);
{$ELSE} {$ELSE}
{$IFDEF ANDROID} {$IFDEF ANDROID}
if not FileExists(aFilePath) then
Exit;
if aDeleteToBin then 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} {$ENDIF}
DeleteFile(aFilePath);
{$ENDIF} {$ENDIF}
end; end;
@@ -253,7 +275,7 @@ end;
procedure KMDeleteFolderToBin(const aPath: UnicodeString); procedure KMDeleteFolderToBin(const aPath: UnicodeString);
begin begin
{$IFDEF ANDROID} {$IFDEF ANDROID}
raise Exception.Create('KM_FileIO: KMDeleteFolderToBin is unsupported on Android'); KMDeleteFolder(aPath, True);
{$ELSE} {$ELSE}
KMDeleteFolder(aPath, True); KMDeleteFolder(aPath, True);
{$ENDIF} {$ENDIF}
@@ -263,7 +285,7 @@ end;
procedure KMDeleteFolder(const aPath: UnicodeString); procedure KMDeleteFolder(const aPath: UnicodeString);
begin begin
{$IFDEF ANDROID} {$IFDEF ANDROID}
raise Exception.Create('KM_FileIO: KMDeleteFolder is unsupported on Android'); KMDeleteFolder(aPath, False);
{$ELSE} {$ELSE}
KMDeleteFolder(aPath, False); KMDeleteFolder(aPath, False);
{$ENDIF} {$ENDIF}
@@ -320,11 +342,14 @@ const
{$ENDIF} {$ENDIF}
begin begin
{$IFDEF ANDROID}
raise Exception.Create('KM_FileIO: KMDeleteFolder is unsupported on Android');
{$ELSE}
if DirectoryExists(aPath) then if DirectoryExists(aPath) then
begin begin
{$IFDEF ANDROID}
if aDeleteToBin then
KMFileIOMoveToTrash(aPath, True)
else
KMFileIORemoveDirectoryTree(aPath);
{$ELSE}
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
if aDeleteToBin then if aDeleteToBin then
begin begin
@@ -344,8 +369,8 @@ begin
{$ELSE} {$ELSE}
DeleteDefault; DeleteDefault;
{$ENDIF} {$ENDIF}
{$ENDIF}
end; end;
{$ENDIF}
end; end;
@@ -356,7 +381,12 @@ var
{$ENDIF} {$ENDIF}
begin begin
{$IFDEF ANDROID} {$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} {$ELSE}
if DirectoryExists(aPath) then if DirectoryExists(aPath) then
begin begin
@@ -393,7 +423,13 @@ end;
procedure KMRenameFolder(const aSourcePath, aDestPath: UnicodeString); procedure KMRenameFolder(const aSourcePath, aDestPath: UnicodeString);
begin 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} {$IFDEF WDC} TDirectory.Move(aSourcePath, aDestPath); {$ENDIF}
end; end;
@@ -405,15 +441,19 @@ begin
if IsFilePath(aSourcePath) then if IsFilePath(aSourcePath) then
begin begin
if FileExists(aSourcePath) then 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} {$IFDEF WDC} TFile.Move(aSourcePath, aDestPath); {$ENDIF}
end end
else else
if DirectoryExists(aSourcePath) then if DirectoryExists(aSourcePath) then
begin 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 //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 if not TryExecuteMethodProc(KMDeleteFolder, aDestPath, 'KMDeleteFolder', ErrorStr) then
raise Exception.Create('Can''t delete folder ' + aDestPath + ': ' + ErrorStr); 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 //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 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])); raise Exception.Create(Format('Can''t rename folder from %s to %s: %s', [aSourcePath, aDestPath, ErrorStr]));
{$ENDIF}
end; end;
end; end;
@@ -480,10 +519,6 @@ begin
or (aSourceFolder = aDestFolder) or (aSourceFolder = aDestFolder)
or not DirectoryExists(aSourceFolder) then Exit; or not DirectoryExists(aSourceFolder) then Exit;
{$IFDEF ANDROID}
raise Exception.Create('KM_FileIO: KMMoveFolder is unsupported on Android');
{$ENDIF}
KMDeleteFolder(aDestFolder, False); KMDeleteFolder(aDestFolder, False);
//Move directory to dest first //Move directory to dest first
@@ -503,6 +538,10 @@ function KMFileSize(const aFilename: String): Int64;
var var
info: TWin32FileAttributeData; info: TWin32FileAttributeData;
{$ENDIF} {$ENDIF}
{$IFDEF ANDROID}
var
Stream: TFileStream;
{$ENDIF}
begin begin
Result := -1; Result := -1;
@@ -512,6 +551,22 @@ begin
Result := Int64(info.nFileSizeLow) or Int64(info.nFileSizeHigh shl 32); Result := Int64(info.nFileSizeLow) or Int64(info.nFileSizeHigh shl 32);
{$ENDIF} {$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; end;
@@ -526,10 +581,7 @@ procedure WriteText(const aText: string; aFilename: string; aEncoding: TEncoding
var var
sl: TStringList; sl: TStringList;
begin begin
{$IFDEF ANDROID} {$IF DEFINED(WDC) OR DEFINED(ANDROID)}
raise Exception.Create('KM_FileIO: WriteText is unsupported on Android');
{$ELSE}
{$IFDEF WDC}
sl := TStringList.Create; sl := TStringList.Create;
try try
sl.Text := aText; sl.Text := aText;
@@ -538,7 +590,6 @@ begin
sl.Free; sl.Free;
end; end;
{$ENDIF} {$ENDIF}
{$ENDIF}
end; end;
@@ -551,10 +602,12 @@ begin
Stream := TFileStream.Create(aFileName, fmCreate); Stream := TFileStream.Create(aFileName, fmCreate);
try try
BOM := TEncoding.UTF8.GetPreamble; 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); Buffer := TEncoding.UTF8.GetBytes(aText);
Stream.WriteBuffer(Buffer, Length(Buffer)); if Length(Buffer) > 0 then
Stream.WriteBuffer(Buffer[0], Length(Buffer));
finally finally
Stream.Free; Stream.Free;
end; end;
@@ -569,7 +622,7 @@ var
{$ENDIF} {$ENDIF}
begin begin
{$IFDEF ANDROID} {$IFDEF ANDROID}
raise Exception.Create('KM_FileIO: IsDirectoryWriteable is unsupported on Android'); Result := KMFileIOIsDirectoryWriteable(aDir);
{$ELSE} {$ELSE}
{$IFDEF WDC} {$IFDEF WDC}
tmpFilename := IncludeTrailingPathDelimiter(aDir) + 'chk.tmp'; tmpFilename := IncludeTrailingPathDelimiter(aDir) + 'chk.tmp';
@@ -594,7 +647,9 @@ end;
function CreateAndGetDocumentsSavePath: string; function CreateAndGetDocumentsSavePath: string;
begin begin
{$IFDEF ANDROID} {$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} {$ELSE}
// Returns C:\Users\Username\My Documents\My Games\GAME_TITLE\ // 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) // 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); procedure CheckFolderPermission(const aPath: string; var aRead, aWrite, aExec: Boolean);
begin begin
{$IFDEF ANDROID} {$IFDEF ANDROID}
raise Exception.Create('KM_FileIO: CheckFolderPermission is unsupported on Android'); KMFileIOCheckFolderPermission(aPath, aRead, aWrite, aExec);
{$ELSE} {$ELSE}
{$IFDEF WDC} {$IFDEF WDC}
aRead := (CheckFileAccess(aPath, FILE_GENERIC_READ) = FILE_GENERIC_READ); aRead := (CheckFileAccess(aPath, FILE_GENERIC_READ) = FILE_GENERIC_READ);