This commit is contained in:
1 parent
19ee837986
commit
c2127c3f31
14 files changed
+3621
-5
No files matched your search
@@ -7,4 +7,9 @@
|
|||||||
<custom_options><option>-B</option><option>-CX-</option><option>-XX-</option><option>-k--no-undefined</option><option>-k--no-gc-sections</option></custom_options>
|
<custom_options><option>-B</option><option>-CX-</option><option>-XX-</option><option>-k--no-undefined</option><option>-k--no-gc-sections</option></custom_options>
|
||||||
<library_paths />
|
<library_paths />
|
||||||
</compiler_options>
|
</compiler_options>
|
||||||
|
<android>
|
||||||
|
<services>
|
||||||
|
<service name="diagnostic_report_export" />
|
||||||
|
</services>
|
||||||
|
</android>
|
||||||
</project>
|
</project>
|
||||||
+1
@@ -0,0 +1 @@
|
|||||||
|
services.add(new ServiceDiagnosticReportExport(this));
|
||||||
+100
@@ -0,0 +1,100 @@
|
|||||||
|
package io.castleengine;
|
||||||
|
|
||||||
|
import android.app.Activity;
|
||||||
|
import android.content.Intent;
|
||||||
|
import android.net.Uri;
|
||||||
|
import java.io.OutputStream;
|
||||||
|
import java.nio.charset.StandardCharsets;
|
||||||
|
|
||||||
|
public class ServiceDiagnosticReportExport extends ServiceAbstract
|
||||||
|
{
|
||||||
|
private static final int REQUEST_CREATE_DOCUMENT = 40127;
|
||||||
|
private static String pendingJson;
|
||||||
|
|
||||||
|
public ServiceDiagnosticReportExport(MainActivity activity)
|
||||||
|
{
|
||||||
|
super(activity);
|
||||||
|
}
|
||||||
|
|
||||||
|
@Override
|
||||||
|
public String getName()
|
||||||
|
{
|
||||||
|
return "diagnostic_report_export";
|
||||||
|
}
|
||||||
|
|
||||||
|
@Override
|
||||||
|
public boolean messageReceived(String[] parts)
|
||||||
|
{
|
||||||
|
if (parts.length != 2 || !parts[0].equals("diagnostic-report-export")) {
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
if (pendingJson != null) {
|
||||||
|
sendError("Export already pending");
|
||||||
|
return true;
|
||||||
|
}
|
||||||
|
|
||||||
|
pendingJson = parts[1];
|
||||||
|
try {
|
||||||
|
Intent intent = new Intent(Intent.ACTION_CREATE_DOCUMENT);
|
||||||
|
intent.addCategory(Intent.CATEGORY_OPENABLE);
|
||||||
|
intent.setType("application/json");
|
||||||
|
intent.putExtra(Intent.EXTRA_TITLE, "kam-mobile-diagnostics.json");
|
||||||
|
getActivity().startActivityForResult(intent, REQUEST_CREATE_DOCUMENT);
|
||||||
|
} catch (Exception error) {
|
||||||
|
finishError(error);
|
||||||
|
}
|
||||||
|
return true;
|
||||||
|
}
|
||||||
|
|
||||||
|
@Override
|
||||||
|
public void onActivityResult(int requestCode, int resultCode, Intent intent)
|
||||||
|
{
|
||||||
|
if (requestCode != REQUEST_CREATE_DOCUMENT) {
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
if (resultCode == Activity.RESULT_CANCELED) {
|
||||||
|
pendingJson = null;
|
||||||
|
messageSend(new String[] { "diagnostic-report-export-result", "cancel" });
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
if (resultCode != Activity.RESULT_OK || intent == null || intent.getData() == null || pendingJson == null) {
|
||||||
|
finishError("Invalid export result");
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
Uri uri = intent.getData();
|
||||||
|
String json = pendingJson;
|
||||||
|
try (OutputStream stream = getActivity().getContentResolver().openOutputStream(uri)) {
|
||||||
|
if (stream == null) {
|
||||||
|
throw new IllegalStateException("Document provider returned no output stream");
|
||||||
|
}
|
||||||
|
stream.write(json.getBytes(StandardCharsets.UTF_8));
|
||||||
|
stream.flush();
|
||||||
|
} catch (Exception error) {
|
||||||
|
finishError(error);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
pendingJson = null;
|
||||||
|
messageSend(new String[] { "diagnostic-report-export-result", "success" });
|
||||||
|
}
|
||||||
|
|
||||||
|
private void finishError(Exception error)
|
||||||
|
{
|
||||||
|
String message = error.getClass().getSimpleName();
|
||||||
|
if (error.getMessage() != null) {
|
||||||
|
message += ": " + error.getMessage();
|
||||||
|
}
|
||||||
|
finishError(message);
|
||||||
|
}
|
||||||
|
|
||||||
|
private void finishError(String message)
|
||||||
|
{
|
||||||
|
pendingJson = null;
|
||||||
|
sendError(message);
|
||||||
|
}
|
||||||
|
|
||||||
|
private void sendError(String message)
|
||||||
|
{
|
||||||
|
messageSend(new String[] { "diagnostic-report-export-result", "error", message });
|
||||||
|
}
|
||||||
|
}
|
||||||
@@ -0,0 +1,116 @@
|
|||||||
|
unit GameDiagnosticsExport;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
type
|
||||||
|
TDiagnosticExportOutcomeKind = (deokSuccess, deokCancel, deokError);
|
||||||
|
|
||||||
|
TDiagnosticExportOutcome = record
|
||||||
|
Kind: TDiagnosticExportOutcomeKind;
|
||||||
|
ErrorMessage: string;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TDiagnosticExportCallback = procedure(const AOutcome: TDiagnosticExportOutcome) of object;
|
||||||
|
|
||||||
|
procedure ExportDiagnosticReport(
|
||||||
|
const AJsonSnapshot: string;
|
||||||
|
const ACallback: TDiagnosticExportCallback
|
||||||
|
);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, CastleMessaging, CastleStringUtils, SysUtils;
|
||||||
|
|
||||||
|
const
|
||||||
|
ExportResultToken = 'diagnostic-report-export-result';
|
||||||
|
|
||||||
|
type
|
||||||
|
TDiagnosticExportListener = class
|
||||||
|
private
|
||||||
|
FPending: Boolean;
|
||||||
|
FCallback: TDiagnosticExportCallback;
|
||||||
|
procedure Complete(const AKind: TDiagnosticExportOutcomeKind;
|
||||||
|
const AErrorMessage: string);
|
||||||
|
function MessageReceived(const Received: TCastleStringList;
|
||||||
|
const ReceivedStream: TMemoryStream): Boolean;
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure Export(const AJsonSnapshot: string;
|
||||||
|
const ACallback: TDiagnosticExportCallback);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TDiagnosticExportListener.Create;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
Messaging.OnReceive.Add(@MessageReceived);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TDiagnosticExportListener.Destroy;
|
||||||
|
begin
|
||||||
|
Messaging.OnReceive.Remove(@MessageReceived);
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDiagnosticExportListener.Complete(const AKind: TDiagnosticExportOutcomeKind;
|
||||||
|
const AErrorMessage: string);
|
||||||
|
var
|
||||||
|
Outcome: TDiagnosticExportOutcome;
|
||||||
|
Callback: TDiagnosticExportCallback;
|
||||||
|
begin
|
||||||
|
Callback := FCallback;
|
||||||
|
FCallback := nil;
|
||||||
|
FPending := False;
|
||||||
|
Outcome.Kind := AKind;
|
||||||
|
Outcome.ErrorMessage := AErrorMessage;
|
||||||
|
if Assigned(Callback) then
|
||||||
|
Callback(Outcome);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDiagnosticExportListener.MessageReceived(
|
||||||
|
const Received: TCastleStringList;
|
||||||
|
const ReceivedStream: TMemoryStream): Boolean;
|
||||||
|
begin
|
||||||
|
Result := (Received.Count > 0) and (Received[0] = ExportResultToken);
|
||||||
|
if not Result or not FPending then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
if (Received.Count = 2) and (Received[1] = 'success') then
|
||||||
|
Complete(deokSuccess, '')
|
||||||
|
else
|
||||||
|
if (Received.Count = 2) and (Received[1] = 'cancel') then
|
||||||
|
Complete(deokCancel, '')
|
||||||
|
else
|
||||||
|
if (Received.Count = 3) and (Received[1] = 'error') then
|
||||||
|
Complete(deokError, Received[2])
|
||||||
|
else
|
||||||
|
Complete(deokError, 'Malformed export-service response');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDiagnosticExportListener.Export(const AJsonSnapshot: string;
|
||||||
|
const ACallback: TDiagnosticExportCallback);
|
||||||
|
begin
|
||||||
|
if FPending then
|
||||||
|
raise Exception.Create('Diagnostic report export is already pending');
|
||||||
|
FPending := True;
|
||||||
|
FCallback := ACallback;
|
||||||
|
Messaging.Send(['diagnostic-report-export', AJsonSnapshot]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
ExportListener: TDiagnosticExportListener;
|
||||||
|
|
||||||
|
procedure ExportDiagnosticReport(const AJsonSnapshot: string;
|
||||||
|
const ACallback: TDiagnosticExportCallback);
|
||||||
|
begin
|
||||||
|
ExportListener.Export(AJsonSnapshot, ACallback);
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
ExportListener := TDiagnosticExportListener.Create;
|
||||||
|
finalization
|
||||||
|
FreeAndNil(ExportListener);
|
||||||
|
end.
|
||||||
@@ -0,0 +1,265 @@
|
|||||||
|
unit GameDiagnosticsFileIO;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
procedure RunFileIODiagnostic;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, GameSelectedMap, GameDiagnosticsReport, KaMResourceInput,
|
||||||
|
KM_CommonClasses;
|
||||||
|
|
||||||
|
procedure InitializeResult(out AResult: TFileIODiagnosticResult);
|
||||||
|
var
|
||||||
|
Stage: TDiagnosticStageId;
|
||||||
|
begin
|
||||||
|
FillChar(AResult, SizeOf(AResult), 0);
|
||||||
|
AResult.Status := dsNotRun;
|
||||||
|
for Stage := Low(TDiagnosticStageId) to High(TDiagnosticStageId) do
|
||||||
|
AResult.Stages[Stage] := dsNotRun;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure FailStage(var AResult: TFileIODiagnosticResult;
|
||||||
|
const AStage: TDiagnosticStageId; const AMessage: string;
|
||||||
|
const AException: Exception = nil);
|
||||||
|
begin
|
||||||
|
AResult.Stages[AStage] := dsFail;
|
||||||
|
AResult.Status := dsFail;
|
||||||
|
AResult.FailureStage.HasValue := True;
|
||||||
|
AResult.FailureStage.Value := AStage;
|
||||||
|
AResult.Error.Present := True;
|
||||||
|
AResult.Error.MessageText.HasValue := True;
|
||||||
|
AResult.Error.MessageText.Value := AMessage;
|
||||||
|
if AException <> nil then
|
||||||
|
begin
|
||||||
|
AResult.Error.ClassName.HasValue := True;
|
||||||
|
AResult.Error.ClassName.Value := AException.ClassName;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure FailException(var AResult: TFileIODiagnosticResult;
|
||||||
|
const AStage: TDiagnosticStageId; const AException: Exception);
|
||||||
|
begin
|
||||||
|
FailStage(AResult, AStage, AException.Message, AException);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function RunResourceExists(const AMapUrl: string;
|
||||||
|
var AResult: TFileIODiagnosticResult): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := KaMResourceExists(AMapUrl);
|
||||||
|
if Result then
|
||||||
|
AResult.Stages[dsiResourceExists] := dsPass
|
||||||
|
else
|
||||||
|
FailStage(AResult, dsiResourceExists,
|
||||||
|
'Selected resource is not present');
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
begin
|
||||||
|
FailException(AResult, dsiResourceExists, E);
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function RunResourceOpen(const AMapUrl: string;
|
||||||
|
var AResult: TFileIODiagnosticResult): Boolean;
|
||||||
|
var
|
||||||
|
Source: TStream;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
Source := nil;
|
||||||
|
try
|
||||||
|
try
|
||||||
|
Source := KaMOpenResourceStream(AMapUrl);
|
||||||
|
if Source = nil then
|
||||||
|
begin
|
||||||
|
FailStage(AResult, dsiResourceOpen, 'Resource open returned no stream');
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
Source.Free;
|
||||||
|
Source := nil;
|
||||||
|
AResult.Stages[dsiResourceOpen] := dsPass;
|
||||||
|
Result := True;
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
FailException(AResult, dsiResourceOpen, E);
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
if Source <> nil then
|
||||||
|
try
|
||||||
|
Source.Free;
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
if AResult.Status <> dsFail then
|
||||||
|
FailException(AResult, dsiResourceOpen, E);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function RunCallerStreamLoad(const AMapUrl: string;
|
||||||
|
var AStream: TKMemoryStreamBinary; var AResult: TFileIODiagnosticResult): Boolean;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
try
|
||||||
|
AStream := TKMemoryStreamBinary.Create;
|
||||||
|
AStream.LoadFromFile(AMapUrl);
|
||||||
|
AResult.Stages[dsiCallerStreamLoad] := dsPass;
|
||||||
|
Result := True;
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
FailException(AResult, dsiCallerStreamLoad, E);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function RunStreamState(const AStream: TKMemoryStreamBinary;
|
||||||
|
var AResult: TFileIODiagnosticResult): Boolean;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
try
|
||||||
|
AResult.Stream.Size.Value := AStream.Size;
|
||||||
|
AResult.Stream.Size.HasValue := True;
|
||||||
|
AResult.Stream.PositionAfterLoad.Value := AStream.Position;
|
||||||
|
AResult.Stream.PositionAfterLoad.HasValue := True;
|
||||||
|
if AStream.Size <= 0 then
|
||||||
|
FailStage(AResult, dsiStreamState, 'Loaded stream is empty')
|
||||||
|
else if AStream.Position <> 0 then
|
||||||
|
FailStage(AResult, dsiStreamState, 'Loaded stream position is not zero')
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
AResult.Stages[dsiStreamState] := dsPass;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
FailException(AResult, dsiStreamState, E);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function RunSeekReadConsistency(const AStream: TKMemoryStreamBinary;
|
||||||
|
var AResult: TFileIODiagnosticResult): Boolean;
|
||||||
|
var
|
||||||
|
Requested, FirstCount, SecondCount, ExpectedPosition, RestoredPosition: LongInt;
|
||||||
|
FirstBytes, SecondBytes: array of Byte;
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
try
|
||||||
|
try
|
||||||
|
AResult.Stream.ReadOffset.Value := 0;
|
||||||
|
AResult.Stream.ReadOffset.HasValue := True;
|
||||||
|
Requested := 32;
|
||||||
|
if AStream.Size < Requested then Requested := LongInt(AStream.Size);
|
||||||
|
AResult.Stream.RequestedReadCount.Value := Requested;
|
||||||
|
AResult.Stream.RequestedReadCount.HasValue := True;
|
||||||
|
SetLength(FirstBytes, Requested);
|
||||||
|
SetLength(SecondBytes, Requested);
|
||||||
|
|
||||||
|
FirstCount := AStream.Read(FirstBytes[0], Requested);
|
||||||
|
AResult.Stream.FirstReadCount.Value := FirstCount;
|
||||||
|
AResult.Stream.FirstReadCount.HasValue := True;
|
||||||
|
AResult.Stream.PositionAfterFirstRead.Value := AStream.Position;
|
||||||
|
AResult.Stream.PositionAfterFirstRead.HasValue := True;
|
||||||
|
ExpectedPosition := FirstCount;
|
||||||
|
if (FirstCount <> Requested) or (AStream.Position <> ExpectedPosition) then
|
||||||
|
begin
|
||||||
|
FailStage(AResult, dsiSeekReadConsistency, 'First read did not advance as required');
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
AResult.Stream.SeekBackPosition.Value := AStream.Seek(0, soBeginning);
|
||||||
|
AResult.Stream.SeekBackPosition.HasValue := True;
|
||||||
|
if (AResult.Stream.SeekBackPosition.Value <> 0) or (AStream.Position <> 0) then
|
||||||
|
begin
|
||||||
|
FailStage(AResult, dsiSeekReadConsistency, 'Seek back did not return to zero');
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
SecondCount := AStream.Read(SecondBytes[0], Requested);
|
||||||
|
AResult.Stream.SecondReadCount.Value := SecondCount;
|
||||||
|
AResult.Stream.SecondReadCount.HasValue := True;
|
||||||
|
AResult.Stream.PositionAfterSecondRead.Value := AStream.Position;
|
||||||
|
AResult.Stream.PositionAfterSecondRead.HasValue := True;
|
||||||
|
ExpectedPosition := SecondCount;
|
||||||
|
if (SecondCount <> Requested) or (AStream.Position <> ExpectedPosition) then
|
||||||
|
begin
|
||||||
|
FailStage(AResult, dsiSeekReadConsistency, 'Second read did not advance as required');
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
AResult.Stream.RepeatEqual.Value := True;
|
||||||
|
AResult.Stream.RepeatEqual.HasValue := True;
|
||||||
|
for I := 0 to Requested - 1 do
|
||||||
|
if FirstBytes[I] <> SecondBytes[I] then
|
||||||
|
begin
|
||||||
|
AResult.Stream.RepeatEqual.Value := False;
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
if not AResult.Stream.RepeatEqual.Value then
|
||||||
|
begin
|
||||||
|
FailStage(AResult, dsiSeekReadConsistency, 'Repeated reads differ');
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
FailException(AResult, dsiSeekReadConsistency, E);
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
try
|
||||||
|
RestoredPosition := AStream.Seek(AResult.Stream.PositionAfterLoad.Value, soBeginning);
|
||||||
|
if ((RestoredPosition <> AResult.Stream.PositionAfterLoad.Value) or
|
||||||
|
(AStream.Position <> AResult.Stream.PositionAfterLoad.Value)) and
|
||||||
|
(AResult.Status <> dsFail) then
|
||||||
|
begin
|
||||||
|
FailStage(AResult, dsiSeekReadConsistency, 'Could not restore stream position');
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
if AResult.Status <> dsFail then
|
||||||
|
begin
|
||||||
|
FailException(AResult, dsiSeekReadConsistency, E);
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if AResult.Status <> dsFail then
|
||||||
|
begin
|
||||||
|
AResult.Stages[dsiSeekReadConsistency] := dsPass;
|
||||||
|
AResult.Status := dsPass;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RunFileIODiagnostic;
|
||||||
|
var
|
||||||
|
ResultData: TFileIODiagnosticResult;
|
||||||
|
MapUrl: string;
|
||||||
|
Stream: TKMemoryStreamBinary;
|
||||||
|
begin
|
||||||
|
InitializeResult(ResultData);
|
||||||
|
Stream := nil;
|
||||||
|
MapUrl := SelectedMapUrl;
|
||||||
|
try
|
||||||
|
if RunResourceExists(MapUrl, ResultData) and
|
||||||
|
RunResourceOpen(MapUrl, ResultData) and
|
||||||
|
RunCallerStreamLoad(MapUrl, Stream, ResultData) and
|
||||||
|
RunStreamState(Stream, ResultData) then
|
||||||
|
RunSeekReadConsistency(Stream, ResultData);
|
||||||
|
finally
|
||||||
|
try
|
||||||
|
Stream.Free;
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
if ResultData.Status <> dsFail then
|
||||||
|
FailException(ResultData, dsiSeekReadConsistency, E);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
ReplaceFileIODiagnosticResult(ResultData);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,247 @@
|
|||||||
|
unit GameDiagnosticsReport;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}{$codepage utf8}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
type
|
||||||
|
TDiagnosticStatus = (dsNotRun, dsPass, dsFail);
|
||||||
|
|
||||||
|
TDiagnosticStageId = (
|
||||||
|
dsiResourceExists,
|
||||||
|
dsiResourceOpen,
|
||||||
|
dsiCallerStreamLoad,
|
||||||
|
dsiStreamState,
|
||||||
|
dsiSeekReadConsistency
|
||||||
|
);
|
||||||
|
|
||||||
|
TOptionalString = record
|
||||||
|
HasValue: Boolean;
|
||||||
|
Value: string;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TOptionalInt64 = record
|
||||||
|
HasValue: Boolean;
|
||||||
|
Value: Int64;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TOptionalBoolean = record
|
||||||
|
HasValue: Boolean;
|
||||||
|
Value: Boolean;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TOptionalDiagnosticStageId = record
|
||||||
|
HasValue: Boolean;
|
||||||
|
Value: TDiagnosticStageId;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TDiagnosticError = record
|
||||||
|
Present: Boolean;
|
||||||
|
ClassName: TOptionalString;
|
||||||
|
MessageText: TOptionalString;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TFileIODiagnosticStreamResult = record
|
||||||
|
Size: TOptionalInt64;
|
||||||
|
PositionAfterLoad: TOptionalInt64;
|
||||||
|
ReadOffset: TOptionalInt64;
|
||||||
|
RequestedReadCount: TOptionalInt64;
|
||||||
|
FirstReadCount: TOptionalInt64;
|
||||||
|
PositionAfterFirstRead: TOptionalInt64;
|
||||||
|
SeekBackPosition: TOptionalInt64;
|
||||||
|
SecondReadCount: TOptionalInt64;
|
||||||
|
PositionAfterSecondRead: TOptionalInt64;
|
||||||
|
RepeatEqual: TOptionalBoolean;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TFileIODiagnosticResult = record
|
||||||
|
Status: TDiagnosticStatus;
|
||||||
|
FailureStage: TOptionalDiagnosticStageId;
|
||||||
|
Error: TDiagnosticError;
|
||||||
|
Stages: array[TDiagnosticStageId] of TDiagnosticStatus;
|
||||||
|
Stream: TFileIODiagnosticStreamResult;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TDiagnosticApplicationMetadata = record
|
||||||
|
Name: string;
|
||||||
|
PackageName: string;
|
||||||
|
Version: string;
|
||||||
|
VersionCode: Int64;
|
||||||
|
BuildId: TOptionalString;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TDiagnosticRuntimeMetadata = record
|
||||||
|
Platform: string;
|
||||||
|
OsVersion: TOptionalString;
|
||||||
|
DeviceModel: TOptionalString;
|
||||||
|
CpuArch: TOptionalString;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TDiagnosticSelectedMapMetadata = record
|
||||||
|
RelativePath: string;
|
||||||
|
Url: string;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TDiagnosticReportState = record
|
||||||
|
ApplicationInfo: TDiagnosticApplicationMetadata;
|
||||||
|
RuntimeInfo: TDiagnosticRuntimeMetadata;
|
||||||
|
SelectedMap: TDiagnosticSelectedMapMetadata;
|
||||||
|
OverallStatus: TDiagnosticStatus;
|
||||||
|
FileIO: TFileIODiagnosticResult;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CurrentDiagnosticReport: TDiagnosticReportState;
|
||||||
|
procedure ReplaceFileIODiagnosticResult(const AResult: TFileIODiagnosticResult);
|
||||||
|
function DiagnosticStatusToken(const AStatus: TDiagnosticStatus): string;
|
||||||
|
function DiagnosticStageIdToken(const AStage: TDiagnosticStageId): string;
|
||||||
|
function DiagnosticReportJsonSnapshot: string;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
fpjson, GameSelectedMap;
|
||||||
|
|
||||||
|
var
|
||||||
|
CurrentFileIO: TFileIODiagnosticResult;
|
||||||
|
|
||||||
|
function DiagnosticStatusToken(const AStatus: TDiagnosticStatus): string;
|
||||||
|
begin
|
||||||
|
case AStatus of
|
||||||
|
dsNotRun: Result := 'NOT_RUN';
|
||||||
|
dsPass: Result := 'PASS';
|
||||||
|
dsFail: Result := 'FAIL';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DiagnosticStageIdToken(const AStage: TDiagnosticStageId): string;
|
||||||
|
begin
|
||||||
|
case AStage of
|
||||||
|
dsiResourceExists: Result := 'resource_exists';
|
||||||
|
dsiResourceOpen: Result := 'resource_open';
|
||||||
|
dsiCallerStreamLoad: Result := 'caller_stream_load';
|
||||||
|
dsiStreamState: Result := 'stream_state';
|
||||||
|
dsiSeekReadConsistency: Result := 'seek_read_consistency';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CurrentDiagnosticReport: TDiagnosticReportState;
|
||||||
|
begin
|
||||||
|
Result.ApplicationInfo.Name := 'kam_mobile';
|
||||||
|
Result.ApplicationInfo.PackageName := 'org.kammobile.kamremake';
|
||||||
|
Result.ApplicationInfo.Version := '0.4.0';
|
||||||
|
Result.ApplicationInfo.VersionCode := 30;
|
||||||
|
Result.ApplicationInfo.BuildId.HasValue := False;
|
||||||
|
Result.RuntimeInfo.Platform := 'android';
|
||||||
|
Result.RuntimeInfo.OsVersion.HasValue := False;
|
||||||
|
Result.RuntimeInfo.DeviceModel.HasValue := False;
|
||||||
|
Result.RuntimeInfo.CpuArch.HasValue := False;
|
||||||
|
Result.SelectedMap.RelativePath := SelectedMapRelativePath;
|
||||||
|
Result.SelectedMap.Url := SelectedMapUrl;
|
||||||
|
Result.FileIO := CurrentFileIO;
|
||||||
|
Result.OverallStatus := Result.FileIO.Status;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ReplaceFileIODiagnosticResult(const AResult: TFileIODiagnosticResult);
|
||||||
|
begin
|
||||||
|
CurrentFileIO := AResult;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function OptionalStringJson(const AValue: TOptionalString): TJSONData;
|
||||||
|
begin
|
||||||
|
if AValue.HasValue then
|
||||||
|
Result := TJSONString.Create(AValue.Value)
|
||||||
|
else
|
||||||
|
Result := TJSONNull.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function OptionalInt64Json(const AValue: TOptionalInt64): TJSONData;
|
||||||
|
begin
|
||||||
|
if AValue.HasValue then
|
||||||
|
Result := TJSONIntegerNumber.Create(AValue.Value)
|
||||||
|
else
|
||||||
|
Result := TJSONNull.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function OptionalBooleanJson(const AValue: TOptionalBoolean): TJSONData;
|
||||||
|
begin
|
||||||
|
if AValue.HasValue then
|
||||||
|
Result := TJSONBoolean.Create(AValue.Value)
|
||||||
|
else
|
||||||
|
Result := TJSONNull.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DiagnosticReportJsonSnapshot: string;
|
||||||
|
var
|
||||||
|
State: TDiagnosticReportState;
|
||||||
|
Root, ObjectValue, Action, Stage, Stream: TJSONObject;
|
||||||
|
Actions, Stages: TJSONArray;
|
||||||
|
StageId: TDiagnosticStageId;
|
||||||
|
begin
|
||||||
|
State := CurrentDiagnosticReport;
|
||||||
|
Root := TJSONObject.Create;
|
||||||
|
try
|
||||||
|
Root.Add('schema', 'kam-mobile-diagnostics/1');
|
||||||
|
ObjectValue := TJSONObject.Create;
|
||||||
|
ObjectValue.Add('name', State.ApplicationInfo.Name);
|
||||||
|
ObjectValue.Add('package', State.ApplicationInfo.PackageName);
|
||||||
|
ObjectValue.Add('version', State.ApplicationInfo.Version);
|
||||||
|
ObjectValue.Add('version_code', State.ApplicationInfo.VersionCode);
|
||||||
|
ObjectValue.Add('build_id', OptionalStringJson(State.ApplicationInfo.BuildId));
|
||||||
|
Root.Add('application', ObjectValue);
|
||||||
|
ObjectValue := TJSONObject.Create;
|
||||||
|
ObjectValue.Add('platform', State.RuntimeInfo.Platform);
|
||||||
|
ObjectValue.Add('os_version', OptionalStringJson(State.RuntimeInfo.OsVersion));
|
||||||
|
ObjectValue.Add('device_model', OptionalStringJson(State.RuntimeInfo.DeviceModel));
|
||||||
|
ObjectValue.Add('cpu_arch', OptionalStringJson(State.RuntimeInfo.CpuArch));
|
||||||
|
Root.Add('runtime', ObjectValue);
|
||||||
|
ObjectValue := TJSONObject.Create;
|
||||||
|
ObjectValue.Add('relative_path', State.SelectedMap.RelativePath);
|
||||||
|
ObjectValue.Add('url', State.SelectedMap.Url);
|
||||||
|
Root.Add('selected_map', ObjectValue);
|
||||||
|
Root.Add('overall_status', DiagnosticStatusToken(State.OverallStatus));
|
||||||
|
Actions := TJSONArray.Create;
|
||||||
|
Action := TJSONObject.Create;
|
||||||
|
Action.Add('id', 'file_io');
|
||||||
|
Action.Add('status', DiagnosticStatusToken(State.FileIO.Status));
|
||||||
|
if State.FileIO.FailureStage.HasValue then
|
||||||
|
Action.Add('failure_stage', DiagnosticStageIdToken(State.FileIO.FailureStage.Value))
|
||||||
|
else
|
||||||
|
Action.Add('failure_stage', TJSONNull.Create);
|
||||||
|
if State.FileIO.Error.Present then
|
||||||
|
begin
|
||||||
|
ObjectValue := TJSONObject.Create;
|
||||||
|
ObjectValue.Add('class', OptionalStringJson(State.FileIO.Error.ClassName));
|
||||||
|
ObjectValue.Add('message', OptionalStringJson(State.FileIO.Error.MessageText));
|
||||||
|
Action.Add('error', ObjectValue);
|
||||||
|
end else
|
||||||
|
Action.Add('error', TJSONNull.Create);
|
||||||
|
Stages := TJSONArray.Create;
|
||||||
|
for StageId := Low(TDiagnosticStageId) to High(TDiagnosticStageId) do
|
||||||
|
begin
|
||||||
|
Stage := TJSONObject.Create;
|
||||||
|
Stage.Add('id', DiagnosticStageIdToken(StageId));
|
||||||
|
Stage.Add('status', DiagnosticStatusToken(State.FileIO.Stages[StageId]));
|
||||||
|
Stages.Add(Stage);
|
||||||
|
end;
|
||||||
|
Action.Add('stages', Stages);
|
||||||
|
Stream := TJSONObject.Create;
|
||||||
|
Stream.Add('size', OptionalInt64Json(State.FileIO.Stream.Size));
|
||||||
|
Stream.Add('position_after_load', OptionalInt64Json(State.FileIO.Stream.PositionAfterLoad));
|
||||||
|
Stream.Add('read_offset', OptionalInt64Json(State.FileIO.Stream.ReadOffset));
|
||||||
|
Stream.Add('requested_read_count', OptionalInt64Json(State.FileIO.Stream.RequestedReadCount));
|
||||||
|
Stream.Add('first_read_count', OptionalInt64Json(State.FileIO.Stream.FirstReadCount));
|
||||||
|
Stream.Add('position_after_first_read', OptionalInt64Json(State.FileIO.Stream.PositionAfterFirstRead));
|
||||||
|
Stream.Add('seek_back_position', OptionalInt64Json(State.FileIO.Stream.SeekBackPosition));
|
||||||
|
Stream.Add('second_read_count', OptionalInt64Json(State.FileIO.Stream.SecondReadCount));
|
||||||
|
Stream.Add('position_after_second_read', OptionalInt64Json(State.FileIO.Stream.PositionAfterSecondRead));
|
||||||
|
Stream.Add('repeat_equal', OptionalBooleanJson(State.FileIO.Stream.RepeatEqual));
|
||||||
|
Action.Add('stream', Stream);
|
||||||
|
Actions.Add(Action);
|
||||||
|
Root.Add('actions', Actions);
|
||||||
|
Result := Root.AsJSON;
|
||||||
|
finally
|
||||||
|
Root.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,182 @@
|
|||||||
|
unit GameDiagnosticsView;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}{$codepage utf8}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes,
|
||||||
|
CastleUIControls, CastleControls, GameDiagnosticsExport;
|
||||||
|
|
||||||
|
type
|
||||||
|
TDiagnosticsView = class(TCastleView)
|
||||||
|
private
|
||||||
|
FScroll: TCastleScrollView;
|
||||||
|
FContent: TCastleVerticalGroup;
|
||||||
|
FFileIOButton: TCastleButton;
|
||||||
|
FStatusLabel, FDetailsLabel, FExportFeedbackLabel: TCastleLabel;
|
||||||
|
FExportButton: TCastleButton;
|
||||||
|
FFileIOInProgress, FExportInProgress: Boolean;
|
||||||
|
procedure RefreshReport;
|
||||||
|
procedure UpdateWrapWidth;
|
||||||
|
procedure FileIOClick(Sender: TObject);
|
||||||
|
procedure ExportClick(Sender: TObject);
|
||||||
|
procedure ExportComplete(const AOutcome: TDiagnosticExportOutcome);
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
procedure Start; override;
|
||||||
|
procedure Resize; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, GameDiagnosticsFileIO, GameDiagnosticsReport;
|
||||||
|
|
||||||
|
const
|
||||||
|
LayoutMargin = 16;
|
||||||
|
UnavailableValue = '—';
|
||||||
|
|
||||||
|
function OptionalStringText(const AValue: TOptionalString): string;
|
||||||
|
begin
|
||||||
|
if AValue.HasValue then Result := AValue.Value else Result := UnavailableValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function OptionalInt64Text(const AValue: TOptionalInt64): string;
|
||||||
|
begin
|
||||||
|
if AValue.HasValue then Result := IntToStr(AValue.Value) else Result := UnavailableValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function OptionalBooleanText(const AValue: TOptionalBoolean): string;
|
||||||
|
begin
|
||||||
|
if AValue.HasValue then Result := BoolToStr(AValue.Value, True) else Result := UnavailableValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TDiagnosticsView.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
FScroll := TCastleScrollView.Create(Self);
|
||||||
|
FScroll.FullSize := True;
|
||||||
|
FScroll.EnableDragging := True;
|
||||||
|
Controls.InsertFront(FScroll);
|
||||||
|
|
||||||
|
FContent := TCastleVerticalGroup.Create(Self);
|
||||||
|
FContent.Padding := LayoutMargin;
|
||||||
|
FContent.Spacing := 8;
|
||||||
|
FScroll.ScrollArea.Controls.InsertFront(FContent);
|
||||||
|
|
||||||
|
FStatusLabel := TCastleLabel.Create(Self);
|
||||||
|
FDetailsLabel := TCastleLabel.Create(Self);
|
||||||
|
FExportFeedbackLabel := TCastleLabel.Create(Self);
|
||||||
|
FFileIOButton := TCastleButton.Create(Self);
|
||||||
|
FExportButton := TCastleButton.Create(Self);
|
||||||
|
|
||||||
|
FContent.Controls.InsertFront(FExportFeedbackLabel);
|
||||||
|
FExportButton.Caption := 'Export Report';
|
||||||
|
FExportButton.OnClick := @ExportClick;
|
||||||
|
FContent.Controls.InsertFront(FExportButton);
|
||||||
|
FContent.Controls.InsertFront(FDetailsLabel);
|
||||||
|
FContent.Controls.InsertFront(FStatusLabel);
|
||||||
|
FFileIOButton.Caption := 'Test File I/O';
|
||||||
|
FFileIOButton.OnClick := @FileIOClick;
|
||||||
|
FContent.Controls.InsertFront(FFileIOButton);
|
||||||
|
with TCastleLabel.Create(Self) do begin Caption := 'Tests / Diagnostics'; FContent.Controls.InsertFront(Self); end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDiagnosticsView.UpdateWrapWidth;
|
||||||
|
var
|
||||||
|
WrapWidth: Single;
|
||||||
|
begin
|
||||||
|
WrapWidth := Width - 2 * LayoutMargin;
|
||||||
|
if WrapWidth < 1 then WrapWidth := 1;
|
||||||
|
FDetailsLabel.MaxWidth := WrapWidth;
|
||||||
|
FExportFeedbackLabel.MaxWidth := WrapWidth;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDiagnosticsView.RefreshReport;
|
||||||
|
var
|
||||||
|
State: TDiagnosticReportState;
|
||||||
|
Stage: TDiagnosticStageId;
|
||||||
|
Details: string;
|
||||||
|
begin
|
||||||
|
State := CurrentDiagnosticReport;
|
||||||
|
FStatusLabel.Caption := 'File I/O: ' + DiagnosticStatusToken(State.FileIO.Status);
|
||||||
|
Details := 'selected map relative_path: ' + State.SelectedMap.RelativePath + LineEnding +
|
||||||
|
'selected map url: ' + State.SelectedMap.Url;
|
||||||
|
for Stage := Low(TDiagnosticStageId) to High(TDiagnosticStageId) do
|
||||||
|
Details := Details + LineEnding + DiagnosticStageIdToken(Stage) + ': ' +
|
||||||
|
DiagnosticStatusToken(State.FileIO.Stages[Stage]);
|
||||||
|
if State.FileIO.FailureStage.HasValue then
|
||||||
|
Details := Details + LineEnding + 'failure_stage: ' +
|
||||||
|
DiagnosticStageIdToken(State.FileIO.FailureStage.Value);
|
||||||
|
if State.FileIO.Error.Present then
|
||||||
|
begin
|
||||||
|
Details := Details + LineEnding + 'error class: ' + OptionalStringText(State.FileIO.Error.ClassName);
|
||||||
|
Details := Details + LineEnding + 'error message: ' + OptionalStringText(State.FileIO.Error.MessageText);
|
||||||
|
end;
|
||||||
|
with State.FileIO.Stream do
|
||||||
|
begin
|
||||||
|
if Size.HasValue then Details := Details + LineEnding + 'size: ' + OptionalInt64Text(Size);
|
||||||
|
if PositionAfterLoad.HasValue then Details := Details + LineEnding + 'position_after_load: ' + OptionalInt64Text(PositionAfterLoad);
|
||||||
|
if ReadOffset.HasValue then Details := Details + LineEnding + 'read_offset: ' + OptionalInt64Text(ReadOffset);
|
||||||
|
if RequestedReadCount.HasValue then Details := Details + LineEnding + 'requested_read_count: ' + OptionalInt64Text(RequestedReadCount);
|
||||||
|
if FirstReadCount.HasValue then Details := Details + LineEnding + 'first_read_count: ' + OptionalInt64Text(FirstReadCount);
|
||||||
|
if PositionAfterFirstRead.HasValue then Details := Details + LineEnding + 'position_after_first_read: ' + OptionalInt64Text(PositionAfterFirstRead);
|
||||||
|
if SeekBackPosition.HasValue then Details := Details + LineEnding + 'seek_back_position: ' + OptionalInt64Text(SeekBackPosition);
|
||||||
|
if SecondReadCount.HasValue then Details := Details + LineEnding + 'second_read_count: ' + OptionalInt64Text(SecondReadCount);
|
||||||
|
if PositionAfterSecondRead.HasValue then Details := Details + LineEnding + 'position_after_second_read: ' + OptionalInt64Text(PositionAfterSecondRead);
|
||||||
|
if RepeatEqual.HasValue then Details := Details + LineEnding + 'repeat_equal: ' + OptionalBooleanText(RepeatEqual);
|
||||||
|
end;
|
||||||
|
FDetailsLabel.Caption := Details;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDiagnosticsView.Start;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
RefreshReport;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDiagnosticsView.Resize;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
UpdateWrapWidth;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDiagnosticsView.FileIOClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if FFileIOInProgress then Exit;
|
||||||
|
FFileIOInProgress := True;
|
||||||
|
FFileIOButton.Enabled := False;
|
||||||
|
try
|
||||||
|
RunFileIODiagnostic;
|
||||||
|
RefreshReport;
|
||||||
|
finally
|
||||||
|
FFileIOButton.Enabled := True;
|
||||||
|
FFileIOInProgress := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDiagnosticsView.ExportClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if FExportInProgress then Exit;
|
||||||
|
FExportInProgress := True;
|
||||||
|
FExportButton.Enabled := False;
|
||||||
|
FExportFeedbackLabel.Caption := 'Exporting report…';
|
||||||
|
ExportDiagnosticReport(DiagnosticReportJsonSnapshot, @ExportComplete);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDiagnosticsView.ExportComplete(const AOutcome: TDiagnosticExportOutcome);
|
||||||
|
begin
|
||||||
|
FExportInProgress := False;
|
||||||
|
FExportButton.Enabled := True;
|
||||||
|
case AOutcome.Kind of
|
||||||
|
deokSuccess: FExportFeedbackLabel.Caption := 'Report exported.';
|
||||||
|
deokCancel: FExportFeedbackLabel.Caption := 'Export canceled.';
|
||||||
|
deokError: if AOutcome.ErrorMessage <> '' then
|
||||||
|
FExportFeedbackLabel.Caption := 'Export error: ' + AOutcome.ErrorMessage
|
||||||
|
else
|
||||||
|
FExportFeedbackLabel.Caption := 'Export error.';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -3,10 +3,14 @@ unit GameInitialize;
|
|||||||
{$ifndef ANDROID}{$fatal Android-only KaM Remake Mobile application; there is no desktop target}{$endif}
|
{$ifndef ANDROID}{$fatal Android-only KaM Remake Mobile application; there is no desktop target}{$endif}
|
||||||
interface
|
interface
|
||||||
implementation
|
implementation
|
||||||
uses CastleWindow;
|
uses CastleWindow, GameDiagnosticsView;
|
||||||
var Window: TCastleWindow;
|
var
|
||||||
|
Window: TCastleWindow;
|
||||||
|
DiagnosticsView: TDiagnosticsView;
|
||||||
procedure Initialize;
|
procedure Initialize;
|
||||||
begin
|
begin
|
||||||
|
DiagnosticsView := TDiagnosticsView.Create(Application);
|
||||||
|
Window.Container.View := DiagnosticsView;
|
||||||
end;
|
end;
|
||||||
initialization
|
initialization
|
||||||
Application.OnInitialize := @Initialize;
|
Application.OnInitialize := @Initialize;
|
||||||
|
|||||||
@@ -0,0 +1,22 @@
|
|||||||
|
unit GameSelectedMap;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}{$codepage utf8}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
const
|
||||||
|
SelectedMapRelativePath = 'Maps/CatchTheSnake/CatchTheSnake.map';
|
||||||
|
|
||||||
|
function SelectedMapUrl: string;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
CastleUriUtils;
|
||||||
|
|
||||||
|
function SelectedMapUrl: string;
|
||||||
|
begin
|
||||||
|
Result := 'castle-data:/game/' + UrlEncode(SelectedMapRelativePath);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,45 @@
|
|||||||
|
unit KaMResourceInput;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes;
|
||||||
|
|
||||||
|
function KaMResourceExists(const aReference: string): Boolean;
|
||||||
|
function KaMOpenResourceStream(const aReference: string): TStream;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
CastleUriUtils, CastleDownload;
|
||||||
|
|
||||||
|
function ResourceProtocol(const aReference: string): string;
|
||||||
|
begin
|
||||||
|
if aReference = '' then
|
||||||
|
raise EDownloadError.Create('KaMResourceInput: empty resource reference');
|
||||||
|
|
||||||
|
Result := UriProtocol(aReference);
|
||||||
|
if (Result <> '') and (Result <> 'file') and (Result <> 'castle-data') then
|
||||||
|
raise EDownloadError.Create('KaMResourceInput: unsupported resource protocol: ' + Result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function KaMResourceExists(const aReference: string): Boolean;
|
||||||
|
begin
|
||||||
|
ResourceProtocol(aReference);
|
||||||
|
case UriExists(aReference) of
|
||||||
|
ueFile: Result := True;
|
||||||
|
ueNotExists, ueDirectory: Result := False;
|
||||||
|
ueUnknown:
|
||||||
|
raise EDownloadError.Create('KaMResourceInput: resource existence is unknown: ' + aReference);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function KaMOpenResourceStream(const aReference: string): TStream;
|
||||||
|
begin
|
||||||
|
if ResourceProtocol(aReference) = '' then
|
||||||
|
Result := TFileStream.Create(aReference, fmOpenRead)
|
||||||
|
else
|
||||||
|
Result := Download(aReference, [soForceMemoryStream]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -1,6 +1,11 @@
|
|||||||
{
|
{
|
||||||
"schema": "kam-source-resolution/1",
|
"schema": "kam-source-resolution/1",
|
||||||
"adaptations": [],
|
"adaptations": [
|
||||||
"source_paths": [],
|
"src/utils/io/KM_FileIO.pas",
|
||||||
|
"src/common/KM_CommonClasses.pas"
|
||||||
|
],
|
||||||
|
"source_paths": [
|
||||||
|
"code/resource"
|
||||||
|
],
|
||||||
"library_paths": []
|
"library_paths": []
|
||||||
}
|
}
|
||||||
@@ -1,4 +1,6 @@
|
|||||||
{
|
{
|
||||||
"schema": "kam-runtime-resources/1",
|
"schema": "kam-runtime-resources/1",
|
||||||
"entries": []
|
"entries": [
|
||||||
|
{"kind": "file", "path": "Maps/CatchTheSnake/CatchTheSnake.map"}
|
||||||
|
]
|
||||||
}
|
}
|
||||||
File diff suppressed because it is too large.
Load diff
@@ -0,0 +1,713 @@
|
|||||||
|
unit KM_FileIO;
|
||||||
|
{$I KaM_Remake.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
{$IF DEFINED(FPC) AND NOT DEFINED(ANDROID)} lconvencoding, FileUtil, LazUTF8,
|
||||||
|
// windirs does not work under old lazarus (1.8.0) / FPC versions, which we use to make linux dedi server
|
||||||
|
LazFileUtils,{ windirs,} {$ENDIF}
|
||||||
|
{$IFDEF WDC} System.IOUtils, {$ENDIF}
|
||||||
|
{$IFDEF MSWindows} Windows, ShellAPI, {$ENDIF}
|
||||||
|
{$IF DEFINED(Unix) AND NOT DEFINED(ANDROID)} LCLType, {$ENDIF}
|
||||||
|
Classes, SysUtils
|
||||||
|
{$IFDEF WDC}, KM_WorkerThread{$ENDIF}
|
||||||
|
, KM_CommonTypes;
|
||||||
|
|
||||||
|
//Read text file into ANSI string (scripts, locale texts)
|
||||||
|
function ReadTextA(const afilename: UnicodeString): AnsiString;
|
||||||
|
|
||||||
|
//Read text file into unicode string (locale texts)
|
||||||
|
function ReadTextU(const afilename: UnicodeString; aEncoding: Word): UnicodeString;
|
||||||
|
|
||||||
|
procedure KMCreateEmptyFile(const aFilePath: UnicodeString);
|
||||||
|
|
||||||
|
//Copy a file (CopyFile is different between Delphi and Lazarus)
|
||||||
|
procedure KMCopyFile(const aSrc, aDest: UnicodeString); overload;
|
||||||
|
procedure KMCopyFile(const aSrc, aDest: UnicodeString; aOverwrite: Boolean); overload;
|
||||||
|
|
||||||
|
//{$IF DEFINED(WDC) OR (FPC_FULLVERSION >= 30200)}
|
||||||
|
{$IFDEF WDC}
|
||||||
|
procedure KMCopyFileAsync(const aSrc, aDest: UnicodeString; aOverwrite: Boolean; aWorkerThread: TKMWorkerThread);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure KMDeleteFileToBin(const aPath: UnicodeString);
|
||||||
|
procedure KMDeleteFile(aFilePath: string; aDeleteToBin: Boolean = False);
|
||||||
|
|
||||||
|
//Delete a folder (DeleteFolder is different between Delphi and Lazarus)
|
||||||
|
procedure KMDeleteFolderToBin(const aPath: UnicodeString);
|
||||||
|
procedure KMDeleteFolder(const aPath: UnicodeString); overload;
|
||||||
|
procedure KMDeleteFolder(const aPath: UnicodeString; aDeleteToBin: Boolean); overload;
|
||||||
|
procedure KMDeleteFolderContent(const aPath: UnicodeString; aDeleteToBin: Boolean = False);
|
||||||
|
|
||||||
|
|
||||||
|
//Rename a file (RenameFile is different between Delphi and Lazarus)
|
||||||
|
procedure KMRenamePath(const aSourcePath, aDestPath: UnicodeString);
|
||||||
|
|
||||||
|
//Move a folder and rename all the files inside it (MoveFolder is different between Delphi and Lazarus)
|
||||||
|
function KMMoveFolder(const aSourceFolder, aDestFolder: UnicodeString): Boolean;
|
||||||
|
|
||||||
|
//Rename all the files inside folder (MoveFolder is different between Delphi and Lazarus)
|
||||||
|
procedure KMRenameFilesInFolder(const aPathToFolder, aFromName, aToName: UnicodeString);
|
||||||
|
|
||||||
|
function KMFileSize(const aFilename: String): Int64;
|
||||||
|
|
||||||
|
function IsFilePath(const aPath: UnicodeString): Boolean;
|
||||||
|
|
||||||
|
procedure WriteText(const aText: string; aFilename: string; aEncoding: TEncoding);
|
||||||
|
procedure WriteTextUtf8(const aText, aFilename: string);
|
||||||
|
|
||||||
|
function IsDirectoryWriteable(const aDir: string): Boolean;
|
||||||
|
|
||||||
|
function CreateAndGetDocumentsSavePath: string;
|
||||||
|
|
||||||
|
procedure CheckFolderPermission(const aPath: string; var aRead, aWrite, aExec: Boolean);
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
StrUtils, KM_CommonUtils,
|
||||||
|
KM_Defaults;
|
||||||
|
|
||||||
|
|
||||||
|
function ReadTextA(const aFilename: UnicodeString): AnsiString;
|
||||||
|
var
|
||||||
|
MS: TMemoryStream;
|
||||||
|
Head: Cardinal;
|
||||||
|
begin
|
||||||
|
MS := TMemoryStream.Create;
|
||||||
|
try
|
||||||
|
// We can't rely on StringList because it applies default codepage encoding,
|
||||||
|
// which may differ between MP players.
|
||||||
|
// 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));
|
||||||
|
|
||||||
|
// Trim UTF8 BOM (don't know how to deal with others yet)
|
||||||
|
if Head and $FFFFFF = $BFBBEF 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);
|
||||||
|
finally
|
||||||
|
MS.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
//Load ANSI file with codepage we say into unicode string
|
||||||
|
function ReadTextU(const aFilename: UnicodeString; aEncoding: Word): UnicodeString;
|
||||||
|
var
|
||||||
|
{$IFDEF WDC}
|
||||||
|
SL: TStringList;
|
||||||
|
DefaultEncoding: TEncoding;
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF FPC}
|
||||||
|
MS: TMemoryStream;
|
||||||
|
Head: Cardinal;
|
||||||
|
HasBOM: Boolean;
|
||||||
|
TmpA: AnsiString;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
{$IFDEF WDC}
|
||||||
|
SL := TStringList.Create;
|
||||||
|
DefaultEncoding := TEncoding.GetEncoding(aEncoding);
|
||||||
|
try
|
||||||
|
//Load the text file with default ANSI encoding. If file has embedded BOM it will be used
|
||||||
|
SL.DefaultEncoding := DefaultEncoding;
|
||||||
|
SL.LoadFromFile(aFilename);
|
||||||
|
Result := SL.Text;
|
||||||
|
finally
|
||||||
|
SL.Free;
|
||||||
|
DefaultEncoding.Free;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF FPC}
|
||||||
|
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;
|
||||||
|
|
||||||
|
if HasBOM then
|
||||||
|
MS.Position := 3
|
||||||
|
else
|
||||||
|
MS.Position := 0;
|
||||||
|
|
||||||
|
SetLength(TmpA, MS.Size - MS.Position);
|
||||||
|
MS.Read(TmpA[1], MS.Size - MS.Position);
|
||||||
|
|
||||||
|
{$IFDEF ANDROID}
|
||||||
|
if not HasBOM then
|
||||||
|
raise Exception.Create('KM_FileIO: ReadTextU codepage conversion is unsupported on Android');
|
||||||
|
Result := UTF8Decode(TmpA);
|
||||||
|
{$ELSE}
|
||||||
|
//Non-UTF8 files must be converted from their native encoding
|
||||||
|
if not HasBOM then
|
||||||
|
TmpA := ConvertEncoding(TmpA, 'cp' + IntToStr(aEncoding), EncodingUTF8);
|
||||||
|
|
||||||
|
Result := UTF8ToUTF16(TmpA);
|
||||||
|
{$ENDIF}
|
||||||
|
finally
|
||||||
|
MS.Free;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure KMCopyFile(const aSrc, aDest: UnicodeString);
|
||||||
|
begin
|
||||||
|
{$IFDEF ANDROID}
|
||||||
|
raise Exception.Create('KM_FileIO: KMCopyFile is unsupported on Android');
|
||||||
|
{$ELSE}
|
||||||
|
{$IFDEF FPC}
|
||||||
|
CopyFile(pchar(aSrc), pchar(aDest), True);
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WDC}
|
||||||
|
TFile.Copy(aSrc, aDest);
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure KMCopyFile(const aSrc, aDest: UnicodeString; aOverwrite: Boolean);
|
||||||
|
begin
|
||||||
|
{$IFDEF ANDROID}
|
||||||
|
raise Exception.Create('KM_FileIO: KMCopyFile is unsupported on Android');
|
||||||
|
{$ELSE}
|
||||||
|
if aOverwrite and FileExists(aDest) then
|
||||||
|
DeleteFile(aDest);
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
CopyFile(pchar(aSrc), pchar(aDest), True);
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WDC}
|
||||||
|
TFile.Copy(aSrc, aDest);
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{$IFDEF WDC}
|
||||||
|
procedure KMCopyFileAsync(const aSrc, aDest: UnicodeString; aOverwrite: Boolean; aWorkerThread: TKMWorkerThread);
|
||||||
|
begin
|
||||||
|
{$IFDEF WDC}
|
||||||
|
aWorkerThread.QueueWork(procedure
|
||||||
|
begin
|
||||||
|
KMCopyFile(aSrc, aDest, aOverwrite);
|
||||||
|
end, 'KMCopyFile');
|
||||||
|
{$ELSE}
|
||||||
|
KMCopyFile(aSrc, aDest, aOverwrite);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
procedure KMDeleteFileToBin(const aPath: UnicodeString);
|
||||||
|
begin
|
||||||
|
{$IFDEF ANDROID}
|
||||||
|
raise Exception.Create('KM_FileIO: KMDeleteFileToBin is unsupported on Android');
|
||||||
|
{$ELSE}
|
||||||
|
KMDeleteFile(aPath, True);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
// Same as delete folder actually .. adjoin?
|
||||||
|
procedure KMDeleteFile(aFilePath: string; aDeleteToBin: Boolean = False);
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
var
|
||||||
|
ShOp: TSHFileOpStruct;
|
||||||
|
{$IFDEF FPC}
|
||||||
|
const
|
||||||
|
FOF_NO_UI = FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOERRORUI or FOF_NOCONFIRMMKDIR; // don't display any UI at all
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
//{$IFDEF FPC}
|
||||||
|
//ShOp.hWnd := 0;
|
||||||
|
//{$ELSE}
|
||||||
|
ShOp.Wnd := 0;
|
||||||
|
//{$ENDIF}
|
||||||
|
ShOp.wFunc := FO_DELETE;
|
||||||
|
ShOp.pFrom := PChar(aFilePath + #0);
|
||||||
|
ShOp.pTo := nil;
|
||||||
|
ShOp.fFlags := FOF_NO_UI or (FOF_ALLOWUNDO * Ord(aDeleteToBin));
|
||||||
|
SHFileOperation(ShOp);
|
||||||
|
{$ELSE}
|
||||||
|
{$IFDEF ANDROID}
|
||||||
|
if aDeleteToBin then
|
||||||
|
raise Exception.Create('KM_FileIO: KMDeleteFile recycle-bin mode is unsupported on Android');
|
||||||
|
{$ENDIF}
|
||||||
|
DeleteFile(aFilePath);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure KMDeleteFolderToBin(const aPath: UnicodeString);
|
||||||
|
begin
|
||||||
|
{$IFDEF ANDROID}
|
||||||
|
raise Exception.Create('KM_FileIO: KMDeleteFolderToBin is unsupported on Android');
|
||||||
|
{$ELSE}
|
||||||
|
KMDeleteFolder(aPath, True);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure KMDeleteFolder(const aPath: UnicodeString);
|
||||||
|
begin
|
||||||
|
{$IFDEF ANDROID}
|
||||||
|
raise Exception.Create('KM_FileIO: KMDeleteFolder is unsupported on Android');
|
||||||
|
{$ELSE}
|
||||||
|
KMDeleteFolder(aPath, False);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure KMDeleteFolder(const aPath: UnicodeString; aDeleteToBin: Boolean);
|
||||||
|
|
||||||
|
procedure DeleteDefault;
|
||||||
|
{$IFDEF WDC}
|
||||||
|
var
|
||||||
|
S: string;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
{$IF DEFINED(FPC) AND NOT DEFINED(ANDROID)}
|
||||||
|
DeleteDirectory(aPath, False);
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WDC}
|
||||||
|
|
||||||
|
//TDirectory.Delete will sometimes delay deletion due to Windows behaviour
|
||||||
|
//Suggested workarounds:
|
||||||
|
// - Empty the directory first (seems to work, commented out below)
|
||||||
|
// - Move the directory to a temporary name then delete it (sounds more robust)
|
||||||
|
//Discussions of workarounds:
|
||||||
|
//https://stackoverflow.com/questions/42809389/tdirectory-delete-seems-to-be-asynchronous
|
||||||
|
//https://github.com/dotnet/runtime/issues/27958
|
||||||
|
|
||||||
|
//Generate a temporary name based on time and random number
|
||||||
|
//S := TDirectory.GetParent(ExcludeTrailingPathDelimiter(aPath)) + PathDelim + IntToStr(Random(MaxInt)) + UIntToStr(TimeGet);
|
||||||
|
//TDirectory.Move(aPath, S);
|
||||||
|
//TDirectory.Delete(S, True);
|
||||||
|
|
||||||
|
// Rename folder approach could trigger antivirus sometimes (f.e. Kaspersky)
|
||||||
|
// so there could be many (almost) empty folders after antivirus block folders deletion
|
||||||
|
// "(folder deletion is potentionly dangeroues operation because of data corruption)"
|
||||||
|
for S in TDirectory.GetFiles(aPath) do
|
||||||
|
DeleteFile(S);
|
||||||
|
TDirectory.Delete(aPath, True);
|
||||||
|
//Assert(not DirectoryExists(aPath));
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
var
|
||||||
|
ShOp: TSHFileOpStruct;
|
||||||
|
{$IFDEF FPC}
|
||||||
|
const
|
||||||
|
FOF_NO_UI = FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOERRORUI or FOF_NOCONFIRMMKDIR; // don't display any UI at all
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFNDEF MSWINDOWS}
|
||||||
|
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
{$IFDEF ANDROID}
|
||||||
|
raise Exception.Create('KM_FileIO: KMDeleteFolder is unsupported on Android');
|
||||||
|
{$ELSE}
|
||||||
|
if DirectoryExists(aPath) then
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
if aDeleteToBin then
|
||||||
|
begin
|
||||||
|
//{$IFDEF FPC}
|
||||||
|
//ShOp.hWnd := 0;
|
||||||
|
//{$ELSE}
|
||||||
|
ShOp.Wnd := 0;
|
||||||
|
//{$ENDIF}
|
||||||
|
ShOp.wFunc := FO_DELETE;
|
||||||
|
ShOp.pFrom := PChar(aPath + #0);
|
||||||
|
ShOp.pTo := nil;
|
||||||
|
ShOp.fFlags := FOF_NO_UI or (FOF_ALLOWUNDO * Ord(aDeleteToBin));
|
||||||
|
SHFileOperation(ShOp);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
DeleteDefault;
|
||||||
|
{$ELSE}
|
||||||
|
DeleteDefault;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure KMDeleteFolderContent(const aPath: UnicodeString; aDeleteToBin: Boolean = False);
|
||||||
|
{$IFDEF WDC}
|
||||||
|
var
|
||||||
|
S: string;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
{$IFDEF ANDROID}
|
||||||
|
raise Exception.Create('KM_FileIO: KMDeleteFolderContent is unsupported on Android');
|
||||||
|
{$ELSE}
|
||||||
|
if DirectoryExists(aPath) then
|
||||||
|
begin
|
||||||
|
{$IFDEF FPC}
|
||||||
|
KMDeleteFolder(aPath, aDeleteToBin);
|
||||||
|
ForceDirectories(aPath); // We do not care too much about FPC now, recreating directory is ok
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WDC}
|
||||||
|
|
||||||
|
//TDirectory.Delete will sometimes delay deletion due to Windows behaviour
|
||||||
|
//Suggested workarounds:
|
||||||
|
// - Empty the directory first (seems to work, commented out below)
|
||||||
|
// - Move the directory to a temporary name then delete it (sounds more robust)
|
||||||
|
//Discussions of workarounds:
|
||||||
|
//https://stackoverflow.com/questions/42809389/tdirectory-delete-seems-to-be-asynchronous
|
||||||
|
//https://github.com/dotnet/runtime/issues/27958
|
||||||
|
|
||||||
|
//Generate a temporary name based on time and random number
|
||||||
|
//S := TDirectory.GetParent(ExcludeTrailingPathDelimiter(aPath)) + PathDelim + IntToStr(Random(MaxInt)) + UIntToStr(TimeGet);
|
||||||
|
//TDirectory.Move(aPath, S);
|
||||||
|
//TDirectory.Delete(S, True);
|
||||||
|
|
||||||
|
// Rename folder approach could trigger antivirus sometimes (f.e. Kaspersky)
|
||||||
|
// so there could be many (almost) empty folders after antivirus block folders deletion
|
||||||
|
// "(folder deletion is potentionly dangeroues operation because of data corruption)"
|
||||||
|
for S in TDirectory.GetFiles(aPath) do
|
||||||
|
KMDeleteFile(S, aDeleteToBin);
|
||||||
|
//Assert(not DirectoryExists(aPath));
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure KMRenameFolder(const aSourcePath, aDestPath: UnicodeString);
|
||||||
|
begin
|
||||||
|
{$IFDEF FPC} RenameFile(aSourcePath, aDestPath); {$ENDIF}
|
||||||
|
{$IFDEF WDC} TDirectory.Move(aSourcePath, aDestPath); {$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure KMRenamePath(const aSourcePath, aDestPath: UnicodeString);
|
||||||
|
var
|
||||||
|
ErrorStr: UnicodeString;
|
||||||
|
begin
|
||||||
|
if IsFilePath(aSourcePath) then
|
||||||
|
begin
|
||||||
|
if FileExists(aSourcePath) then
|
||||||
|
{$IFDEF FPC} RenameFile(aSourcePath, aDestPath); {$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);
|
||||||
|
|
||||||
|
//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;
|
||||||
|
|
||||||
|
|
||||||
|
//Rename all files inside folder by pattern _old_name_suffix to _new_name_suffix
|
||||||
|
//Pattern that we use for most of the files for our maps/saves
|
||||||
|
procedure KMRenameFilesInFolder(const aPathToFolder, aFromName, aToName: UnicodeString);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
RenamedFile: UnicodeString;
|
||||||
|
SearchRec: TSearchRec;
|
||||||
|
FilesToRename: TStringList;
|
||||||
|
begin
|
||||||
|
if (Trim(aFromName) = '')
|
||||||
|
or (Trim(aToName) = '')
|
||||||
|
or (aFromName = aToName) then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
FilesToRename := TStringList.Create;
|
||||||
|
try
|
||||||
|
//Find all files to rename in path
|
||||||
|
//Need to find them first, rename later, because we can possibly find files, that were already renamed, in case NewName = OldName + Smth
|
||||||
|
FindFirst(aPathToFolder + aFromName + '*', faAnyFile - faDirectory, SearchRec);
|
||||||
|
try
|
||||||
|
repeat
|
||||||
|
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..')
|
||||||
|
and (Length(SearchRec.Name) > Length(aFromName)) then
|
||||||
|
FilesToRename.Add(SearchRec.Name);
|
||||||
|
until (FindNext(SearchRec) <> 0);
|
||||||
|
finally
|
||||||
|
FindClose(SearchRec);
|
||||||
|
end;
|
||||||
|
|
||||||
|
//Move all previously finded files
|
||||||
|
for I := 0 to FilesToRename.Count - 1 do
|
||||||
|
begin
|
||||||
|
RenamedFile := aPathToFolder + aToName + RightStr(FilesToRename[I], Length(FilesToRename[I]) - Length(aFromName));
|
||||||
|
if not FileExists(RenamedFile) and (aPathToFolder + FilesToRename[I] <> RenamedFile) then
|
||||||
|
KMRenamePath(aPathToFolder + FilesToRename[I], RenamedFile);
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FilesToRename.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
//Move folder and rename all files inside by pattern _old_name_suffix to _new_name_suffix
|
||||||
|
//Pattern that we use for most of the files for our maps/saves
|
||||||
|
function KMMoveFolder(const aSourceFolder, aDestFolder: UnicodeString): Boolean;
|
||||||
|
var
|
||||||
|
SrcName, DestName: UnicodeString;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if (Trim(aSourceFolder) = '')
|
||||||
|
or (Trim(aDestFolder) = '')
|
||||||
|
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
|
||||||
|
KMRenamePath(aSourceFolder, aDestFolder);
|
||||||
|
|
||||||
|
SrcName := GetFileDirName(aSourceFolder);
|
||||||
|
DestName := GetFileDirName(aDestFolder);
|
||||||
|
//Rename all files there
|
||||||
|
KMRenameFilesInFolder(aDestFolder, SrcName, DestName);
|
||||||
|
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function KMFileSize(const aFilename: String): Int64;
|
||||||
|
{$IFDEF MSWindows}
|
||||||
|
var
|
||||||
|
info: TWin32FileAttributeData;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
Result := -1;
|
||||||
|
|
||||||
|
{$IFDEF MSWindows}
|
||||||
|
if not GetFileAttributesEx({$IFDEF FPC}PChar{$ELSE}PWideChar{$ENDIF}(aFileName), GetFileExInfoStandard, @info) then
|
||||||
|
EXIT;
|
||||||
|
|
||||||
|
Result := Int64(info.nFileSizeLow) or Int64(info.nFileSizeHigh shl 32);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function IsFilePath(const aPath: UnicodeString): Boolean;
|
||||||
|
begin
|
||||||
|
// For now we assume, that folder path always ends with PathDelim
|
||||||
|
Result := RightStr(aPath, 1) <> PathDelim;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
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}
|
||||||
|
sl := TStringList.Create;
|
||||||
|
try
|
||||||
|
sl.Text := aText;
|
||||||
|
sl.SaveToFile(aFilename, aEncoding);
|
||||||
|
finally
|
||||||
|
sl.Free;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
// Body taken from TStringList.SaveToFile
|
||||||
|
procedure WriteTextUtf8(const aText, aFilename: string);
|
||||||
|
var
|
||||||
|
Stream: TFileStream;
|
||||||
|
BOM, Buffer: TBytes;
|
||||||
|
begin
|
||||||
|
Stream := TFileStream.Create(aFileName, fmCreate);
|
||||||
|
try
|
||||||
|
BOM := TEncoding.UTF8.GetPreamble;
|
||||||
|
Stream.WriteBuffer(BOM, Length(BOM));
|
||||||
|
|
||||||
|
Buffer := TEncoding.UTF8.GetBytes(aText);
|
||||||
|
Stream.WriteBuffer(Buffer, Length(Buffer));
|
||||||
|
finally
|
||||||
|
Stream.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function IsDirectoryWriteable(const aDir: string): Boolean;
|
||||||
|
{$IFDEF WDC}
|
||||||
|
var
|
||||||
|
tmpFilename: string;
|
||||||
|
hnd: THandle;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
{$IFDEF ANDROID}
|
||||||
|
raise Exception.Create('KM_FileIO: IsDirectoryWriteable is unsupported on Android');
|
||||||
|
{$ELSE}
|
||||||
|
{$IFDEF WDC}
|
||||||
|
tmpFilename := IncludeTrailingPathDelimiter(aDir) + 'chk.tmp';
|
||||||
|
|
||||||
|
hnd := CreateFile(PChar(tmpFilename), GENERIC_READ or GENERIC_WRITE, 0, nil,
|
||||||
|
CREATE_NEW, FILE_ATTRIBUTE_TEMPORARY or FILE_FLAG_DELETE_ON_CLOSE, 0);
|
||||||
|
|
||||||
|
Result := hnd <> INVALID_HANDLE_VALUE;
|
||||||
|
|
||||||
|
if Result then
|
||||||
|
CloseHandle(hnd);
|
||||||
|
{$ELSE}
|
||||||
|
Result := True; //todo -cPractical: add Read/Write permissions on lazarus / fpc
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
// Creates directory, if missing
|
||||||
|
// If its not possible, or there are no read / write permissions on the directory,
|
||||||
|
// then use execution directory (ExeDir)
|
||||||
|
function CreateAndGetDocumentsSavePath: string;
|
||||||
|
begin
|
||||||
|
{$IFDEF ANDROID}
|
||||||
|
raise Exception.Create('KM_FileIO: CreateAndGetDocumentsSavePath is unsupported on Android');
|
||||||
|
{$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)
|
||||||
|
if FEAT_SETTINGS_IN_MYDOC then
|
||||||
|
begin
|
||||||
|
{$IFDEF WDC}
|
||||||
|
Result := TPath.GetDocumentsPath + PathDelim + 'My Games' + PathDelim + GAME_TITLE + PathDelim;
|
||||||
|
{$ELSE}
|
||||||
|
// GetWindowsSpecialDir does not work under old lazarus (1.8.0) / FPC versions, which we use to make linux dedi server
|
||||||
|
//Result := GetWindowsSpecialDir(CSIDL_PERSONAL) + PathDelim + 'My Games' + PathDelim + GAME_TITLE + PathDelim
|
||||||
|
Result := GetUserDir + 'My Games' + PathDelim + GAME_TITLE + PathDelim;
|
||||||
|
{$ENDIF}
|
||||||
|
ForceDirectories(Result);
|
||||||
|
if not IsDirectoryWriteable(Result) then
|
||||||
|
Result := ExtractFilePath(ParamStr(0));
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Result := ExtractFilePath(ParamStr(0));
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{$IFDEF WDC}
|
||||||
|
const
|
||||||
|
FILE_READ_DATA = $0001;
|
||||||
|
FILE_WRITE_DATA = $0002;
|
||||||
|
FILE_APPEND_DATA = $0004;
|
||||||
|
FILE_READ_EA = $0008;
|
||||||
|
FILE_WRITE_EA = $0010;
|
||||||
|
FILE_EXECUTE = $0020;
|
||||||
|
FILE_READ_ATTRIBUTES = $0080;
|
||||||
|
FILE_WRITE_ATTRIBUTES = $0100;
|
||||||
|
FILE_GENERIC_READ = (STANDARD_RIGHTS_READ or FILE_READ_DATA or
|
||||||
|
FILE_READ_ATTRIBUTES or FILE_READ_EA or SYNCHRONIZE);
|
||||||
|
FILE_GENERIC_WRITE = (STANDARD_RIGHTS_WRITE or FILE_WRITE_DATA or
|
||||||
|
FILE_WRITE_ATTRIBUTES or FILE_WRITE_EA or FILE_APPEND_DATA or SYNCHRONIZE);
|
||||||
|
FILE_GENERIC_EXECUTE = (STANDARD_RIGHTS_EXECUTE or FILE_READ_ATTRIBUTES or
|
||||||
|
FILE_EXECUTE or SYNCHRONIZE);
|
||||||
|
FILE_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $1FF;
|
||||||
|
|
||||||
|
|
||||||
|
// example from https://stackoverflow.com/questions/6908152/how-to-get-permission-level-of-a-folder
|
||||||
|
function CheckFileAccess(const aFileName: string; const aCheckedAccess: Cardinal): Cardinal;
|
||||||
|
var
|
||||||
|
Token: THandle;
|
||||||
|
Status: LongBool;
|
||||||
|
Access: Cardinal;
|
||||||
|
SecDescSize: Cardinal;
|
||||||
|
PrivSetSize: Cardinal;
|
||||||
|
PrivSet: PRIVILEGE_SET;
|
||||||
|
Mapping: GENERIC_MAPPING;
|
||||||
|
SecDesc: PSECURITY_DESCRIPTOR;
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
GetFileSecurity(PChar(aFileName), OWNER_SECURITY_INFORMATION or GROUP_SECURITY_INFORMATION or DACL_SECURITY_INFORMATION, nil, 0, SecDescSize);
|
||||||
|
SecDesc := GetMemory(SecDescSize);
|
||||||
|
|
||||||
|
if GetFileSecurity(PChar(aFileName), OWNER_SECURITY_INFORMATION or GROUP_SECURITY_INFORMATION or DACL_SECURITY_INFORMATION, SecDesc, SecDescSize, SecDescSize) then
|
||||||
|
begin
|
||||||
|
ImpersonateSelf(SecurityImpersonation);
|
||||||
|
OpenThreadToken(GetCurrentThread, TOKEN_QUERY, False, Token);
|
||||||
|
if Token <> 0 then
|
||||||
|
begin
|
||||||
|
Mapping.GenericRead := FILE_GENERIC_READ;
|
||||||
|
Mapping.GenericWrite := FILE_GENERIC_WRITE;
|
||||||
|
Mapping.GenericExecute := FILE_GENERIC_EXECUTE;
|
||||||
|
Mapping.GenericAll := FILE_ALL_ACCESS;
|
||||||
|
|
||||||
|
MapGenericMask(Access, Mapping);
|
||||||
|
PrivSetSize := SizeOf(PrivSet);
|
||||||
|
AccessCheck(SecDesc, Token, aCheckedAccess, Mapping, PrivSet, PrivSetSize, Access, Status);
|
||||||
|
CloseHandle(Token);
|
||||||
|
if Status then
|
||||||
|
Result := Access;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
FreeMem(SecDesc, SecDescSize);
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
// Check game execution dir generic permissions
|
||||||
|
procedure CheckFolderPermission(const aPath: string; var aRead, aWrite, aExec: Boolean);
|
||||||
|
begin
|
||||||
|
{$IFDEF ANDROID}
|
||||||
|
raise Exception.Create('KM_FileIO: CheckFolderPermission is unsupported on Android');
|
||||||
|
{$ELSE}
|
||||||
|
{$IFDEF WDC}
|
||||||
|
aRead := (CheckFileAccess(aPath, FILE_GENERIC_READ) = FILE_GENERIC_READ);
|
||||||
|
aWrite := (CheckFileAccess(aPath, FILE_GENERIC_WRITE) = FILE_GENERIC_WRITE);
|
||||||
|
aExec := (CheckFileAccess(aPath, FILE_GENERIC_EXECUTE) = FILE_GENERIC_EXECUTE);
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF FPC}
|
||||||
|
// No folder permissions check for FPC yet
|
||||||
|
aRead := True;
|
||||||
|
aWrite := True;
|
||||||
|
aExec := True;
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure KMCreateEmptyFile(const aFilePath: UnicodeString);
|
||||||
|
var
|
||||||
|
ft: TextFile;
|
||||||
|
begin
|
||||||
|
if FileExists(aFilePath) then Exit;
|
||||||
|
|
||||||
|
AssignFile(ft, aFilePath);
|
||||||
|
Rewrite(ft);
|
||||||
|
CloseFile(ft);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
Reference in new issue
Block a user