This commit is contained in:
Pavel 2024-10-22 15:58:54 +03:00
parent a0634ca042
commit 17c32e8cc1
13 changed files with 441 additions and 64 deletions

View File

@ -1486,6 +1486,15 @@
<IsPartOfProject Value="True"/>
<UnitName Value="ps4_libSceVideoRecording"/>
</Unit>
<Unit>
<Filename Value="src\param_sfo_ipc.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="rtl\charstream.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="CharStream"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>

View File

@ -1,7 +1,7 @@
object frmCfgEditor: TfrmCfgEditor
Left = 473
Left = 422
Height = 319
Top = 205
Top = 234
Width = 400
Caption = 'Config Editor'
ClientHeight = 319
@ -543,7 +543,7 @@ object frmCfgEditor: TfrmCfgEditor
Anchors = [akLeft, akBottom]
BorderSpacing.Left = 10
BorderSpacing.Bottom = 10
Caption = 'ok'
Caption = 'OK'
TabOrder = 1
OnClick = BtnOkClick
end

View File

@ -1,14 +1,14 @@
object frmGameEditor: TfrmGameEditor
Left = 632
Left = 497
Height = 319
Top = 214
Top = 119
Width = 397
Caption = 'Game editor'
ClientHeight = 319
ClientWidth = 397
OnClose = FormClose
Position = poMainFormCenter
LCLVersion = '3.4.0.0'
LCLVersion = '3.6.0.0'
object EditPages: TPageControl
AnchorSideBottom.Control = BtnOk
Left = 0
@ -108,7 +108,7 @@ object frmGameEditor: TfrmGameEditor
Anchors = [akLeft, akBottom]
BorderSpacing.Left = 10
BorderSpacing.Bottom = 10
Caption = 'ok'
Caption = 'OK'
TabOrder = 1
OnClick = BtnOkClick
end

View File

@ -383,8 +383,9 @@ begin
tkAString:S:=S+'"'+StringToJSONString(value.AsString,False)+'"';
tkInteger:S:=S+IntToStr(value.AsInteger);
tkQWord :S:=S+IntToStr(value.AsUInt64);
tkBool:S:=S+BoolToStr(value.AsBoolean,'true','false');
tkBool :S:=S+BoolToStr(value.AsBoolean,'true','false');
else
Assert(False);
@ -633,8 +634,9 @@ begin
tkAString:Stream.WriteAnsiString(p.GetValue(Self).AsString);
tkInteger:Stream.WriteDWord(p.GetValue(Self).AsInteger);
tkQWord :Stream.WriteQWord(p.GetValue(Self).AsInteger);
tkBool:Stream.WriteByte(Byte(p.GetValue(Self).AsBoolean));
tkBool :Stream.WriteByte(Byte(p.GetValue(Self).AsBoolean));
tkClass:
begin
@ -673,13 +675,15 @@ begin
TypeKind:=p.PropertyType.TypeKind;
case TypeKind of
tkSString,
tkLString,
tkAString:p.SetValue(Self,Stream.ReadAnsiString);
tkInteger:p.SetValue(Self,Integer(Stream.ReadDWord));
tkQWord :p.SetValue(Self,QWord (Stream.ReadQWord));
tkBool:p.SetValue(Self,Boolean(Stream.ReadByte));
tkBool :p.SetValue(Self,Boolean(Stream.ReadByte));
tkClass:
begin
@ -727,6 +731,7 @@ begin
tkLString,
tkAString,
tkInteger,
tkQWord ,
tkBool :p.SetValue(dst,p.GetValue(Self));
tkClass:
@ -855,6 +860,7 @@ begin
tkLString,
tkAString,
tkInteger,
tkQWord ,
tkBool :Stream.WriteValue(p.Name,p.GetValue(Self));
tkClass:
@ -882,13 +888,101 @@ begin
end;
Procedure TAbstractArray.Serialize(Stream:TStream);
var
i,c:SizeInt;
V:TValue;
obj:TObject;
begin
Assert(false);
c:=GetArrayCount;
Stream.WriteQWord(c); //Size Header
if (c<>0) then
For i:=0 to c-1 do
begin
V:=GetArrayItem(i);
Stream.WriteDWord(DWORD(V.Kind)); //Type Header
case V.Kind of
tkSString,
tkLString,
tkAString:Stream.WriteAnsiString(V.AsString);
tkInteger:Stream.WriteDWord(V.AsInteger);
tkQWord :Stream.WriteQWord(V.AsUInt64);
tkBool :Stream.WriteByte(Byte(V.AsBoolean));
tkClass:
begin
//Use Class Header?
obj:=V.AsObject;
if (obj<>nil) then
if obj.InheritsFrom(TAbstractObject) then
begin
TAbstractObject(obj).Serialize(Stream);
end;
end;
else
Assert(false);
end;
end;
end;
Procedure TAbstractArray.Deserialize(Stream:TStream);
var
i,c:SizeInt;
Kind:TTypeKind;
V:TValue;
obj:TObject;
begin
Assert(false);
c:=Stream.ReadQWord; //Size Header
if (c<>0) then
For i:=0 to c-1 do
begin
V:=Default(TValue);
Kind:=TTypeKind(Stream.ReadDWord); //Type Header
case Kind of
tkSString,
tkLString,
tkAString:V:=Stream.ReadAnsiString;
tkInteger:V:=Integer(Stream.ReadDWord);
tkQWord :V:=QWord (Stream.ReadQWord);
tkBool :V:=Boolean(Stream.ReadByte);
tkClass:
begin
//Use Class Header?
V:=AddObject;
obj:=V.AsObject;
if (obj<>nil) then
if obj.InheritsFrom(TAbstractObject) then
begin
TAbstractObject(obj).Deserialize(Stream);
end;
end;
else
Assert(false);
end;
//save
AddValue(V);
end;
end;
Procedure TAbstractArray.CopyTo(dst:TAbstractObject);
@ -916,6 +1010,7 @@ begin
tkLString,
tkAString,
tkInteger,
tkQWord ,
tkBool :Stream.WriteValue('',V);
tkClass:

View File

@ -8,11 +8,13 @@ uses
windows,
Classes,
SysUtils,
CharStream,
Dialogs,
kern_thr,
md_sleep,
md_pipe,
host_ipc,
host_ipc_interface,
md_host_ipc,
game_info;
@ -262,25 +264,6 @@ begin
end;
type
TPCharStream=class(TCustomMemoryStream)
public
constructor Create(P:PChar;len:SizeUint); virtual; overload;
procedure SetNew(P:PChar;len:SizeUint);
end;
constructor TPCharStream.Create(P:PChar;len:SizeUint);
begin
inherited Create;
SetPointer(P,len);
end;
procedure TPCharStream.SetNew(P:PChar;len:SizeUint);
begin
SetPosition(0);
SetPointer(P,len);
end;
procedure fork_process(data:Pointer;size:QWORD); SysV_ABI_CDecl;
var
td:p_kthread;
@ -314,7 +297,9 @@ begin
kipc:=THostIpcPipeKERN.Create;
kipc.set_pipe(pipefd);
p_host_ipc:=kipc;
p_host_ipc :=kipc;
p_host_handler:=THostIpcHandler.Create;
p_host_ipc .FHandler:=p_host_handler;
td:=nil;
r:=kthread_add(@prepare,GameStartupInfo,@td,0,'[main]');
@ -407,7 +392,9 @@ begin
g_ipc:=s_mgui_ipc;
p_host_ipc:=s_kern_ipc;
p_host_ipc :=s_kern_ipc;
p_host_handler:=THostIpcHandler.Create;
p_host_ipc .FHandler:=p_host_handler;
Ftd:=nil;
r:=kthread_add(@prepare,GameStartupInfo,@Ftd,0,'[main]');

View File

@ -147,10 +147,11 @@ type
FGameMainForm:TGameMainForm;
function OnKevent (mlen:DWORD;buf:Pointer):Ptruint; //KEV_EVENT
function OnMainWindows(mlen:DWORD;buf:Pointer):Ptruint; //MAIN_WINDOWS
function OnCaptionFPS (mlen:DWORD;buf:Pointer):Ptruint; //CAPTION_FPS
function OnError (mlen:DWORD;buf:Pointer):Ptruint; //ERROR
function OnKevent (mlen:DWORD;buf:Pointer):Ptruint; //KEV_EVENT
function OnMainWindows (mlen:DWORD;buf:Pointer):Ptruint; //MAIN_WINDOWS
function OnCaptionFPS (mlen:DWORD;buf:Pointer):Ptruint; //CAPTION_FPS
function OnError (mlen:DWORD;buf:Pointer):Ptruint; //ERROR
function OnParamSfoInit(mlen:DWORD;buf:Pointer):Ptruint; //PARAM_SFO_INIT
function get_caption_format:RawByteString;
function OpenMainWindows():THandle;
@ -177,6 +178,8 @@ var
implementation
uses
param_sfo_gui,
game_find,
windows,
@ -396,6 +399,51 @@ begin
end;
end;
function TfrmMain.OnParamSfoInit(mlen:DWORD;buf:Pointer):Ptruint; //PARAM_SFO_INIT
var
ParamSfo:TParamSfoFile;
mem:TMemoryStream;
V:RawByteString;
begin
Result:=Ptruint(-1);
if (FGameItem=nil) then Exit;
V:=FGameItem.MountList.app0;
ParamSfo:=LoadParamSfoFile(ExcludeTrailingPathDelimiter(V)+
DirectorySeparator+
'sce_sys'+
DirectorySeparator+
'param.sfo');
if (ParamSfo=nil) then
begin
V:='"{$GAME}/sce_sys/param.sfo" not found, continue?';
if (MessageDlgEx(V,mtError,[mbOK,mbAbort],Self)=mrOK) then
begin
Exit(0);
end else
begin
Exit(Ptruint(-1));
end;
end;
if (FGameProcess<>nil) then
if (FGameProcess.g_ipc<>nil) then
begin
mem:=TMemoryStream.Create;
ParamSfo.Serialize(mem);
FreeAndNil(ParamSfo);
FGameProcess.g_ipc.SendSync(HashIpcStr('PARAM_SFO_LOAD'),mem.Size,mem.Memory);
end;
FreeAndNil(ParamSfo);
Result:=0;
end;
//ShowMessage(GetEnumName(TypeInfo(mtype),ord(mtype)));
var
@ -675,10 +723,11 @@ var
begin
IpcHandler:=THostIpcHandler.Create;
IpcHandler.AddCallback('KEV_EVENT' ,@OnKevent );
IpcHandler.AddCallback('MAIN_WINDOWS',@OnMainWindows);
IpcHandler.AddCallback('CAPTION_FPS' ,@OnCaptionFPS );
IpcHandler.AddCallback('ERROR' ,@OnError );
IpcHandler.AddCallback('KEV_EVENT' ,@OnKevent );
IpcHandler.AddCallback('MAIN_WINDOWS' ,@OnMainWindows );
IpcHandler.AddCallback('CAPTION_FPS' ,@OnCaptionFPS );
IpcHandler.AddCallback('ERROR' ,@OnError );
IpcHandler.AddCallback('PARAM_SFO_INIT',@OnParamSfoInit);
ReadConfigFile;

View File

@ -5,7 +5,9 @@ unit param_sfo_gui;
interface
uses
sysutils;
sysutils,
rtti,
game_info;
const
//sfo_value_format
@ -38,17 +40,33 @@ type
//
TParamSfoValue=packed object
format:ptruint;
name,value:RawByteString;
Function GetString:RawByteString;
Function GetUInt :DWORD;
TParamSfoValue=class(TAbstractObject)
private
Fformat:ptruint;
Fname :RawByteString;
Fvalue :RawByteString;
published
property format:ptruint read Fformat write Fformat;
property name :RawByteString read Fname write Fname;
property value :RawByteString read Fvalue write Fvalue;
public
Function GetString:RawByteString;
Function GetUInt :DWORD;
end;
TParamSfoFile=class
TParamSfoFile=class(TAbstractArray)
params:array of TParamSfoValue;
Function GetString(const name:RawByteString):RawByteString;
Function GetUInt (const name:RawByteString):DWORD;
//
Destructor Destroy; override;
//
Function GetString(const name:RawByteString):RawByteString;
Function GetUInt (const name:RawByteString):DWORD;
//
Function GetArrayCount:SizeInt; override;
Function GetArrayItem(i:SizeInt):TValue; override;
Function AddObject:TAbstractObject; override;
Function AddArray :TAbstractArray; override;
procedure AddValue(Value:TValue); override;
end;
function LoadParamSfoFile(const path:RawByteString):TParamSfoFile;
@ -159,6 +177,7 @@ begin
SetLength(value,size);
Move(PChar(value_table+entry_table[i].value_offset)^,PChar(value)^,size);
Result.params[i]:=TParamSfoValue.Create;
Result.params[i].format:=entry_table[i].format;
Result.params[i].name :=name;
Result.params[i].value :=value;
@ -213,6 +232,19 @@ begin
end;
end;
Destructor TParamSfoFile.Destroy;
var
i:Integer;
begin
if (Length(params)=0) then Exit;
For i:=0 to High(params) do
begin
FreeAndNil(params[i]);
end;
SetLength(params,0);
inherited;
end;
Function TParamSfoFile.GetString(const name:RawByteString):RawByteString;
var
i:Integer;
@ -247,6 +279,38 @@ begin
end;
end;
//////
Function TParamSfoFile.GetArrayCount:SizeInt;
begin
Result:=Length(params);
end;
Function TParamSfoFile.GetArrayItem(i:SizeInt):TValue;
begin
if (i>=Length(params)) then
begin
Result:=TValue.Empty;
end else
begin
Result:=params[i];
end;
end;
Function TParamSfoFile.AddObject:TAbstractObject;
begin
Result:=TParamSfoValue.Create;
end;
Function TParamSfoFile.AddArray:TAbstractArray;
begin
Result:=nil;
end;
procedure TParamSfoFile.AddValue(Value:TValue);
begin
Insert(Value.AsObject,params,Length(params));
end;
end.

32
rtl/charstream.pas Normal file
View File

@ -0,0 +1,32 @@
unit CharStream;
{$mode ObjFPC}{$H+}
interface
uses
Classes;
type
TPCharStream=class(TCustomMemoryStream)
public
constructor Create(P:PChar;len:SizeUint); virtual; overload;
procedure SetNew(P:PChar;len:SizeUint);
end;
implementation
constructor TPCharStream.Create(P:PChar;len:SizeUint);
begin
inherited Create;
SetPointer(P,len);
end;
procedure TPCharStream.SetNew(P:PChar;len:SizeUint);
begin
SetPosition(0);
SetPointer(P,len);
end;
end.

96
src/param_sfo_ipc.pas Normal file
View File

@ -0,0 +1,96 @@
unit param_sfo_ipc;
{$mode ObjFPC}{$H+}
interface
procedure init_param_sfo;
function ParamSfoGetString(const name:RawByteString):RawByteString;
function ParamSfoGetUInt (const name:RawByteString):DWORD;
implementation
uses
SysUtils,
CharStream,
atomic,
sys_bootparam,
host_ipc_interface,
param_sfo_gui,
kern_rwlock;
var
param_sfo_lock :Pointer=nil;
param_sfo_lazy_init:Integer=0;
param_sfo_file :TParamSfoFile=nil;
type
TParamSfoLoaderIpc=object
function OnLoad(mlen:DWORD;buf:Pointer):Ptruint;
end;
function TParamSfoLoaderIpc.OnLoad(mlen:DWORD;buf:Pointer):Ptruint;
var
mem:TPCharStream;
begin
Result:=0;
Writeln('PARAM_SFO_LOAD');
mem:=TPCharStream.Create(buf,mlen);
param_sfo_file:=TParamSfoFile.Create;
param_sfo_file.Deserialize(mem);
mem.Free;
end;
procedure init_param_sfo;
var
Loader:TParamSfoLoaderIpc;
err:Integer;
begin
if( param_sfo_lazy_init=2) then Exit;
if CAS(param_sfo_lazy_init,0,1) then
begin
rw_wlock(param_sfo_lock);
p_host_handler.AddCallback('PARAM_SFO_LOAD',@Loader.OnLoad);
err:=p_host_ipc.SendSync(HashIpcStr('PARAM_SFO_INIT'),0,nil);
if (err<>0) then
begin
Assert(false,'PARAM_SFO_INIT error='+IntToStr(err));
end;
param_sfo_lazy_init:=2;
rw_wunlock(param_sfo_lock);
end else
begin
//sunc
rw_wlock (param_sfo_lock);
rw_wunlock(param_sfo_lock);
end;
end;
function ParamSfoGetString(const name:RawByteString):RawByteString;
begin
init_param_sfo;
rw_rlock(param_sfo_lock);
Result:=param_sfo_file.GetString(name);
rw_runlock(param_sfo_lock);
end;
function ParamSfoGetUInt(const name:RawByteString):DWORD;
begin
init_param_sfo;
rw_rlock(param_sfo_lock);
Result:=param_sfo_file.GetUInt(name);
rw_runlock(param_sfo_lock);
end;
end.

View File

@ -10,6 +10,9 @@ uses
implementation
uses
param_sfo_ipc;
{
uses
sys_path,
@ -85,6 +88,8 @@ function ps4_sceAppContentInitialize(initParam:PSceAppContentInitParam;bootParam
begin
Writeln('sceAppContentInitialize');
param_sfo_ipc.init_param_sfo;
Result:=0;
end;
@ -94,12 +99,10 @@ begin
if (value=nil) then Exit(SCE_APP_CONTENT_ERROR_PARAMETER);
Case SCE_APP_CONTENT_APPPARAM_ID_SKU_FLAG of
SCE_APP_CONTENT_APPPARAM_ID_SKU_FLAG :value^:=SCE_APP_CONTENT_APPPARAM_SKU_FLAG_FULL;
{
SCE_APP_CONTENT_APPPARAM_ID_USER_DEFINED_PARAM_1:value^:=ParamSfoGetInt('USER_DEFINED_PARAM_1');
SCE_APP_CONTENT_APPPARAM_ID_USER_DEFINED_PARAM_2:value^:=ParamSfoGetInt('USER_DEFINED_PARAM_2');
SCE_APP_CONTENT_APPPARAM_ID_USER_DEFINED_PARAM_3:value^:=ParamSfoGetInt('USER_DEFINED_PARAM_3');
SCE_APP_CONTENT_APPPARAM_ID_USER_DEFINED_PARAM_4:value^:=ParamSfoGetInt('USER_DEFINED_PARAM_4');
}
SCE_APP_CONTENT_APPPARAM_ID_USER_DEFINED_PARAM_1:value^:=ParamSfoGetUInt('USER_DEFINED_PARAM_1');
SCE_APP_CONTENT_APPPARAM_ID_USER_DEFINED_PARAM_2:value^:=ParamSfoGetUInt('USER_DEFINED_PARAM_2');
SCE_APP_CONTENT_APPPARAM_ID_USER_DEFINED_PARAM_3:value^:=ParamSfoGetUInt('USER_DEFINED_PARAM_3');
SCE_APP_CONTENT_APPPARAM_ID_USER_DEFINED_PARAM_4:value^:=ParamSfoGetUInt('USER_DEFINED_PARAM_4');
else
Result:=SCE_APP_CONTENT_ERROR_PARAMETER;
end;
@ -135,6 +138,7 @@ begin
Result:=FormatTmpPath(PChar(mountPoint));
_sig_unlock;
}
Result:=-1;
end;
function ps4_sceAppContentTemporaryDataMount(mountPoint:pSceAppContentMountPoint):Integer;
@ -144,6 +148,7 @@ begin
Result:=FetchTmpMount(PChar(mountPoint),SCE_APP_CONTENT_TEMPORARY_DATA_OPTION_FORMAT);
_sig_unlock;
}
Result:=-1;
end;
function ps4_sceAppContentTemporaryDataMount2(option:DWORD;mountPoint:pSceAppContentMountPoint):Integer;
@ -153,6 +158,7 @@ begin
Result:=FetchTmpMount(PChar(mountPoint),option);
_sig_unlock;
}
Result:=-1;
end;
function ps4_sceAppContentTemporaryDataUnmount(mountPoint:pSceAppContentMountPoint):Integer;
@ -162,6 +168,7 @@ begin
Result:=UnMountTmpPath(PChar(mountPoint));
_sig_unlock;
}
Result:=-1;
end;
function ps4_sceAppContentTemporaryDataGetAvailableSpaceKb(mountPoint:pSceAppContentMountPoint;availableSpaceKb:PQWORD):Integer;
@ -171,6 +178,7 @@ begin
Result:=GetTmpPathAvailableSpaceKb(PChar(mountPoint),availableSpaceKb);
_sig_unlock;
}
Result:=-1;
end;
function ps4_sceAppContentDownloadDataGetAvailableSpaceKb(mountPoint:pSceAppContentMountPoint;availableSpaceKb:PQWORD):Integer;
@ -180,6 +188,7 @@ begin
Result:=GetDownloadAvailableSpaceKb(PChar(mountPoint),availableSpaceKb);
_sig_unlock;
}
Result:=-1;
end;
function ps4_sceAppContentGetEntitlementKey(serviceLabel:SceNpServiceLabel;

View File

@ -52,8 +52,9 @@ type
procedure Pack(mtype,mlen,mtid:DWORD;buf:Pointer);
function Recv:PQNode;
procedure Flush;
procedure RecvSync(node:PQNode);
function RecvKevent(mlen:DWORD;buf:Pointer):Ptruint;
procedure RecvResultNode (node:PQNode);
procedure RecvResultDirect(mlen,mtid:DWORD;buf:Pointer);
function RecvKevent (mlen:DWORD;buf:Pointer):Ptruint;
procedure UpdateKevent();
procedure WakeupKevent(); virtual;
public
@ -165,7 +166,7 @@ begin
end;
end;
procedure THostIpcConnect.RecvSync(node:PQNode);
procedure THostIpcConnect.RecvResultNode(node:PQNode);
var
value:Ptruint;
mlen:DWORD;
@ -183,6 +184,22 @@ begin
TriggerNodeSync(node^.header.mtid,value);
end;
procedure THostIpcConnect.RecvResultDirect(mlen,mtid:DWORD;buf:Pointer);
var
value:Ptruint;
begin
value:=0;
if (mlen>SizeOf(Ptruint)) then
begin
mlen:=SizeOf(Ptruint);
end;
Move(buf^,value,mlen);
TriggerNodeSync(mtid,value);
end;
procedure kq_wakeup(data:Pointer); SysV_ABI_CDecl;
begin
THostIpcConnect(data).WakeupKevent();
@ -249,7 +266,7 @@ begin
if (node^.header.mtype=iRESULT) then
begin
RecvSync(node);
RecvResultNode(node);
end else
begin
OnMsg:=GetCallback(node^.header.mtype);
@ -441,7 +458,14 @@ procedure THostIpcSimpleKERN.Send(mtype,mlen,mtid:DWORD;buf:Pointer);
begin
if (FDest<>nil) then
begin
FDest.Pack(mtype,mlen,mtid,buf);
if (mtype=iRESULT) then
begin
//Trigger Direct on Simple mode!
FDest.RecvResultDirect(mlen,mtid,buf);
end else
begin
FDest.Pack(mtype,mlen,mtid,buf);
end;
//
if Assigned(Classes.WakeMainThread) then
begin

View File

@ -44,6 +44,7 @@ type
THostIpcPipeMGUI=class(THostIpcPipe)
Ftd_handle:TThreadID;
procedure Recv_pipe; override;
Function Push(Node:Pointer):Boolean; override;
procedure thread_new; override;
procedure thread_free; override;
end;
@ -131,8 +132,6 @@ begin
if ((events and (BEV_EVENT_ERROR or BEV_EVENT_EOF))<>0) then
begin
Exit;
end;
@ -214,6 +213,18 @@ begin
end;
end;
Function THostIpcPipeMGUI.Push(Node:Pointer):Boolean;
begin
if (PQNode(Node)^.header.mtype=iRESULT) then
begin
//Trigger Direct on GUI side!
RecvResultNode(Node);
end else
begin
Result:=inherited;
end;
end;
procedure THostIpcPipeMGUI.thread_new;
begin
if (Ftd_handle=0) then

View File

@ -8,7 +8,7 @@ uses
host_ipc_interface;
const
CPUID_BASE_MODE=$710f13; //$710f31
CPUID_BASE_MODE=$710f13; // $710f31
CPUID_NEO_MODE =$740f00;
var
@ -26,6 +26,7 @@ var
p_print_gpu_hint :Boolean=False;
p_host_ipc :THostIpcInterface=nil;
p_host_handler :THostIpcHandler =nil;
function p_host_ipc_td:Pointer;