unit Engine;

interface

uses
  Windows, Rtti, TypInfo, System.SysUtils, vcl.dialogs;

const
  dll = 'php7ts.dll';

type
  TPtr = Pointer;

  PPHPOptions = ^TPHPOptions;

  TPHPOptions = object
    SessionInit, SessionInit2, SizeZval: Integer;

    IS_UNDEF, IS_NULL, IS_FALSE, IS_TRUE, IS_LONG, IS_DOUBLE, IS_STRING, IS_ARRAY, IS_OBJECT, IS_RESOURCE, IS_REFERENCE, IS_CONSTANT_AST, IS_INDIRECT, IS_PTR, IS_ALIAS_PTR, IS_ERROR, IS_BOOL, IS_CALLABLE,
      IS_ITERABLE, IS_VOID, IS_NUMBER: UInt8;

    // Array\Class\...
    PDeclare, PUpdate, PUpdateStatic, PAssoc, PIndex, PNext, PConst, PConstClass, PProperty: UInt8;
    P: function(Operation: Integer; ptr: TPtr; TypeSet: Integer): Integer cdecl varargs;

    // Для print\echo и так далее .ub_write := function(...): Size_t; cdecl;
    ub_write: function(const Str: PAnsiChar; Len: Size_t): Size_t; cdecl;

    NewPzval: function(size: Size_t = 1): TPtr; cdecl;
    FreePzval: procedure(zv: TPtr); cdecl;

    // Извлекаем из zval* ифнормацию
    Zval_Type: function(zval: TPtr; &type: Integer): TPtr; cdecl; // convert zval* to zval* type
    Z_TYPE_P: function(zval: TPtr): Integer; cdecl; // return IS_NULL\IS_LONG\IS_STRING\...
    Z_STRVAL_P: function(zval: TPtr): PAnsiChar; cdecl; // Используйте функцию ZStr
    Z_LVAL_P: function(z: Pointer): NativeInt; cdecl;
    Z_DVAL_P: function(z: Pointer): Double; cdecl;
    ZVAL_DEREF: procedure(z: Pointer); cdecl;

    // Str : Строка с кодом.
    // Retval_ptr: Можно получить return кода.
    // String_name : Имя виртуального скрипт.
    // Handle_exceptions : Разрешить вывод ошибок.
    EvalCode: procedure(Str: UTF8String; Retval_ptr: TPtr; String_name: UTF8String; Handle_exceptions: Integer); cdecl;

    // Аналог  ini_set без возврата старого значения
    IniSet: procedure(const name, Value: UTF8String); cdecl;

    // Старый добрый print_r
    printR: function(Expr: TPtr; Indent: Integer): PAnsiChar; cdecl;

    // Регистрируем переменную глобально
    RegGlobal: procedure(&var: UTF8String; Val: TPtr); cdecl;

    // Регистрируем класс
    RegPHPClass: function(const Str: UTF8String): TPtr; cdecl; // return zend_class_entry *

    Zend_new_array: function(NSize: Cardinal = 12): TPtr; cdecl; // return zend_array *
    array_init_size: function(NSize: Cardinal = 12): TPtr; cdecl;
    array_count: function(zval: TPtr): uint32; cdecl;
    array_dup: function(zval: TPtr): TPtr; cdecl;
    array_destroy: procedure(zval: TPtr); cdecl;

    ArrayDelStr: function(zval: TPtr; const Key: UTF8String): NativeInt; cdecl;
    ArrayDelStr2: function(zval: TPtr; const Key: UTF8String; Len: NativeInt): NativeInt; cdecl;
    ArrayDelIndex: function(zval: TPtr; Key: NativeInt): NativeInt; cdecl;

    ArrayFindStr: function(zval: TPtr; const Key: UTF8String): TPtr; cdecl;
    ArrayGetIntStr: function(zval: TPtr; const Key: UTF8String): NativeInt; cdecl;
    ArrayGetDoubleStr: function(zval: TPtr; const Key: UTF8String): Double; cdecl;
    ArrayGetStringStr: function(zval: TPtr; const Key: UTF8String): PAnsiChar; cdecl;

    ArrayFindStr2: function(zval: TPtr; const Key: UTF8String; Len: NativeInt): TPtr; cdecl;
    ArrayGetIntStr2: function(zval: TPtr; const Key: UTF8String; Len: NativeInt): NativeInt; cdecl;
    ArrayGetDoubleStr2: function(zval: TPtr; const Key: UTF8String; Len: NativeInt): Double; cdecl;
    ArrayGetStringStr2: function(zval: TPtr; const Key: UTF8String; Len: NativeInt): PAnsiChar; cdecl;

    ArrayFindIndex: function(zval: TPtr; Key: NativeInt): TPtr; cdecl;
    ArrayGetIntIndex: function(zval: TPtr; Key: NativeInt): NativeInt; cdecl;
    ArrayGetDoubleIndex: function(zval: TPtr; Key: NativeInt): Double; cdecl;
    ArrayGetStringIndex: function(zval: TPtr; Key: NativeInt): PAnsiChar; cdecl;

    array_set_zval_key: function(ht, Arg, Value: TPtr): Integer; cdecl;

    // Вместо, использовать FreePHP. Так как надо освободить библиотеку PHP
    &destructor: procedure(); cdecl;

    // Возвратим всем понятный строковой тип
    function ZStr(zval: TPtr): STRING;
  end;

  {
    var arr := array_init_size();
    P(PAssoc, arr, IS_LONG, UTF8String('Key1'), 1 * 10);
    P(PAssoc, arr, IS_LONG, UTF8String('Key2'), 2 * 10);
    P(PAssoc, arr, IS_STRING, UTF8String('Key3'), UTF8String('Hello Key3'));

    P(PIndex, arr, IS_LONG, 0, 4 * 10);
    P(PIndex, arr, IS_LONG, 1, 5 * 10);
    P(PIndex, arr, IS_STRING, 2, UTF8String('Hello index 2'));

    P(PNext, arr, IS_LONG, 7 * 10);
    P(PNext, arr, IS_LONG, 8 * 10);
    P(PNext, arr, IS_STRING, UTF8String('Hello index 5'));

    ShowMessage('Count: ' + array_count(arr).ToString + #13 + printR(arr, 0));


    // Set global const
    P(PConst, nil, IS_STRING, UTF8String('ConstGlobal'), UTF8String('PHP Const Global'));

    // Set global function pre(...)
    RegFunction(nil, 'pre', @PreHandler, nil, 0, 0);

    // New Class Test
    var RegClass := RegPHPClass('Test');

    // Set function callBack
    RegFunction(RegClass, 'pre', @PreHandler, nil, 0, ZEND_ACC_PUBLIC);

    // Set const class Test::ConstName = Hello
    P(PConstClass, RegClass, IS_STRING, UTF8String('ConstName'), UTF8String('Hello'));

    // Set static. Test::$StaticLong
    P(PDeclare, RegClass, IS_LONG, UTF8String('StaticLong'), 10, ZEND_ACC_STATIC);

    // Update static. Test::$StaticLong. Fatal error if Declare is not installed
    P(PUpdateStatic, RegClass, IS_LONG, UTF8String('StaticLong'), 2020);

    // Set default class prop (new Test)->Str = Val Set
    P(PDeclare, RegClass, IS_STRING, UTF8String('Str'), UTF8String('Val Set'), ZEND_ACC_PUBLIC);

    // Init Class Test to zval *
    var NewClas := NewPzval;
    object_init_ex(NewClas, RegClass);

    // Example of other initializations
    P(PUpdate, RegClass, IS_NULL,   UTF8String('UpdateNull'),   NewClas);
    P(PUpdate, RegClass, IS_LONG,   UTF8String('UpdateLong'),   NewClas, 2020);
    P(PUpdate, RegClass, IS_BOOL,   UTF8String('UpdateBool'),   NewClas, True);
    P(PUpdate, RegClass, IS_DOUBLE, UTF8String('UpdateDouble'), NewClas, Double(Pi));
    P(PUpdate, RegClass, IS_STRING, UTF8String('UpdateString'), NewClas, UTF8String('Hello'));

    ShowMessage(string(UTF8String(printR(NewClas, 0))));  // PrintClass
    free(NewClas, 0);  // Free Init Class
  }

function LoadPHP(const DLLPath: PChar; Name, Pretty_name: UTF8String; var LibHandle: HMODULE): PPHPOptions;
procedure FreePHP(var php: PPHPOptions; var LibHandle: HMODULE);

var
  php: PPHPOptions;
  LibHandle: HMODULE;

implementation

function TPHPOptions.ZStr(zval: TPtr): STRING;
begin
  Result := string(UTF8String(Z_STRVAL_P(zval)));
end;

// -------------------------------------------------------------------
function LoadPHP(const DLLPath: PChar; Name, Pretty_name: UTF8String; var LibHandle: HMODULE): PPHPOptions;
var
  init: function(Name, Pretty_name: UTF8String): PPHPOptions; cdecl;
begin
  if FileExists(DLLPath) then
  begin
    LibHandle := LoadLibrary(DLLPath);

    if LibHandle <= 32 then
      RaiseLastOSError;

    @init := GetProcAddress(LibHandle, 'PHPInit');

    if @init = Nil then
      raise EListError.Create('NotFound PHPInit: ' + DLLPath);

    Result := init(Name, Pretty_name);
  end
  else
    raise EListError.Create('NotFound: ' + DLLPath);
end;

procedure FreePHP(var php: PPHPOptions; var LibHandle: HMODULE);
begin
  if @php.&destructor <> nil then
    php.&destructor;

  if LibHandle > 32 then
  begin
    FreeLibrary(LibHandle);
    LibHandle := 0;
  end;
end;

initialization

try
  php := LoadPHP(dll, 'cli', 'TestEval', LibHandle);

  if (php.SessionInit <> 1) and (php.SessionInit2 <> 1) then
  begin
    ShowMessage('Библиотека php не иницилизирована');
    ExitProcess(0);
  end;

except
  on E: Exception do
  begin
    ShowMessage(E.ClassName + ' : ' + E.Message);
    ExitProcess(0);
  end;
end;

finalization

FreePHP(php, LibHandle);

end.

unit PHPForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Engine, Vcl.StdCtrls, System.Generics.Collections;

type
  TForm1 = class(TForm)
    Code: TMemo;
    Log: TMemo;
    EvalCode: TButton;
    PHPArrayLog: TMemo;
    DelphiArrayLog: TMemo;
    PHPSpeedArr: TButton;
    DelphiSpeedArr: TButton;
    procedure EvalCodeClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PHPSpeedArrClick(Sender: TObject);
    procedure DelphiSpeedArrClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }

    function PHPLineFill: AnsiString;
    function PHPLineFillString: AnsiString;
    function PHPLineFillStringIndex: AnsiString;
    function PHPLineFillStringString: AnsiString;
    function PHPLineFillMul: AnsiString;

    function DelphiLineFill: AnsiString;
    function DelphiLineFillString: AnsiString;
    function DelphiLineFillStringIndex: AnsiString;
    function DelphiLineFillStringString: AnsiString;
    function DelphiLineFillMul: AnsiString;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  T, T1, T3: Int64;
  i, A: integer;

function sprintf(S: PAnsiChar; const Format: PAnsiChar): integer; cdecl; varargs; external 'msvcrt.dll';

function PrintTime(T: Int64): AnsiString;
var
  A, b: Int64;
begin
  Result := '';
  if QueryPerformanceCounter(A) and QueryPerformanceFrequency(b) then
  begin
    SetLength(Result, 25);
    SetLength(Result, sprintf(PAnsiChar(Result), '%f', single((A - T) / b)));
  end;
end;

procedure TForm1.EvalCodeClick(Sender: TObject);
begin
  with php^ do
  begin
    EvalCode(Code.Text, nil, 'Test Runner', 1);
  end;
end;

function ub_write(const Str: PAnsiChar; Len: Size_t): Size_t cdecl;
begin
  Form1.Log.Lines.Add(UTF8String(Str));
  Result := Len;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  php^.ub_write := ub_write;
end;

function TForm1.PHPLineFill: AnsiString;
var
  arr: Pointer;
  i, r: integer;
begin
  QueryPerformanceCounter(T1);
  with php^ do
  begin
    arr := array_init_size(1000000);
    for r := 0 to 3 do
      for i := 0 to 1000000 do
        P(PIndex, arr, IS_LONG, i, i);
    array_destroy(arr);
  end;
  Result := PrintTime(T1);
end;

function TForm1.PHPLineFillString: AnsiString;
var
  arr: Pointer;
  i, r: integer;
begin
  QueryPerformanceCounter(T1);
  with php^ do
  begin
    arr := array_init_size(1000000);
    for r := 0 to 3 do
      for i := 0 to 1000000 do
        P(PIndex, arr, IS_STRING, i, 'ValueString' + i.ToString);
    array_destroy(arr);
  end;
  Result := PrintTime(T1);
end;

function TForm1.PHPLineFillStringIndex: AnsiString;
var
  arr: Pointer;
  i, r: integer;
begin
  QueryPerformanceCounter(T1);
  with php^ do
  begin
    arr := array_init_size(1000000);
    for r := 0 to 3 do
      for i := 0 to 1000000 do
        P(PAssoc, arr, IS_LONG, 'KeyString' + i.ToString, i);
    array_destroy(arr);
  end;
  Result := PrintTime(T1);
end;

function TForm1.PHPLineFillStringString: AnsiString;
var
  arr: Pointer;
  i, r: integer;
begin
  QueryPerformanceCounter(T1);
  with php^ do
  begin
    arr := array_init_size(1000000);
    for r := 0 to 3 do
      for i := 0 to 1000000 do
        P(PAssoc, arr, IS_STRING, 'KeyString' + i.ToString, 'ValueString' + i.ToString);
    array_destroy(arr);
  end;
  Result := PrintTime(T1);
end;

function TForm1.PHPLineFillMul: AnsiString;
var
  arr: Pointer;
  i, r: integer;
begin
  QueryPerformanceCounter(T1);
  with php^ do
  begin
    arr := array_init_size(1000000);
    for r := 0 to 3 do
      for i := 0 to 1000000 do
      begin
        P(PIndex, arr, IS_LONG, i, i);
        P(PIndex, arr, IS_LONG, i, ArrayGetIntIndex(arr, i) * i);
      end;
    array_destroy(arr);
  end;
  Result := PrintTime(T1);
end;

procedure TForm1.PHPSpeedArrClick(Sender: TObject);
begin
  with PHPArrayLog.Lines do
  begin
    Add('PHP. Каждое действие выполняется по 3 раза от 0 до 1000000');
    Add('Arr[$i] = $i;                                            Time: ' + PHPLineFill);
    Add('Arr[$i] = ''ValueString'' + $i;                    Time: ' + PHPLineFillString);
    Add('Arr[''KeyString'' + $i] = $i;                       Time: ' + PHPLineFillStringIndex);
    Add('Arr[''KeyString'' + $i] = ''TestString'' + $i; Time: ' + PHPLineFillStringString);
    Add('Arr[i] = i; & Arr[i] = Arr[i] * Arr[i];      . Time: ' + PHPLineFillMul);
  end;
end;

function TForm1.DelphiLineFill: AnsiString;
var
  arr: Pointer;
  i, r: integer;

  l: TDictionary<integer, integer>;
begin
  QueryPerformanceCounter(T1);

  l := TDictionary<integer, integer>.Create(1000000);
  for r := 0 to 3 do
    for i := 0 to 1000000 do
      l.AddOrSetValue(i, i);

  l.Free;
  Result := PrintTime(T1);
end;

function TForm1.DelphiLineFillString: AnsiString;
var
  arr: Pointer;
  i, r: integer;

  l: TDictionary<integer, string>;
begin
  QueryPerformanceCounter(T1);

  l := TDictionary<integer, string>.Create(1000000);
  for r := 0 to 3 do
    for i := 0 to 1000000 do
      l.AddOrSetValue(i, 'ValueString' + i.ToString);

  l.Free;
  Result := PrintTime(T1);
end;

function TForm1.DelphiLineFillStringIndex: AnsiString;
var
  arr: Pointer;
  i, r: integer;

  l: TDictionary<string, integer>;
begin
  QueryPerformanceCounter(T1);

  l := TDictionary<string, integer>.Create(1000000);
  for r := 0 to 3 do
    for i := 0 to 1000000 do
      l.AddOrSetValue('KeyString' + i.ToString, i);

  l.Free;
  Result := PrintTime(T1);
end;

function TForm1.DelphiLineFillStringString: AnsiString;
var
  arr: Pointer;
  i, r: integer;

  l: TDictionary<string, string>;
begin
  QueryPerformanceCounter(T1);

  l := TDictionary<string, string>.Create(1000000);
  for r := 0 to 3 do
    for i := 0 to 1000000 do
      l.AddOrSetValue('KeyString' + i.ToString, 'ValueString' + i.ToString);

  l.Free;
  Result := PrintTime(T1);
end;

function TForm1.DelphiLineFillMul: AnsiString;
var
  arr: Pointer;
  i, r: integer;

  l: TDictionary<integer, integer>;
begin
  QueryPerformanceCounter(T1);

  l := TDictionary<integer, integer>.Create(1000000);
  for r := 0 to 3 do
    for i := 0 to 1000000 do
    begin
      l.AddOrSetValue(i, i);
      l.AddOrSetValue(i, l.Items[i] * i);
    end;

  l.Free;
  Result := PrintTime(T1);
end;

procedure TForm1.DelphiSpeedArrClick(Sender: TObject);
begin
  with DelphiArrayLog.Lines do
  begin
    Add('Delphi. Каждое действие выполняется по 3 раза от 0 до 1000000');
    Add('Arr[$i] = $i;                                            Time: ' + DelphiLineFill);
    Add('Arr[$i] = ''ValueString'' + $i;                    Time: ' + DelphiLineFillString);
    Add('Arr[''KeyString'' + $i] = $i;                       Time: ' + DelphiLineFillStringIndex);
    Add('Arr[''KeyString'' + $i] = ''TestString'' + $i; Time: ' + DelphiLineFillStringString);
    Add('Arr[i] = i; & Arr[i] = Arr[i] * Arr[i];      . Time: ' + DelphiLineFillMul);
  end;

end;

end.

#define HT_HASH_EX(data, idx) \
	((uint32_t*)(data))[(int32_t)(idx)]

# define HT_HASH_TO_BUCKET_EX(data, idx) \
	((Bucket*)((char*)(data) + (idx)))

#define Z_LVAL(zval)				(zval).value.lval
#define Z_LVAL_P(zval_p)			Z_LVAL(*(zval_p))
#define Z_TYPE(zval)				zval_get_type(&(zval))
#define Z_NEXT(zval)				(zval).u2.next
#define HT_FLAGS(ht) (ht)->u.flags

int ArrayGetIntIndex(zval *Arr, zend_ulong Key) {
	zval *z = zend_hash_index_find(Z_ARRVAL_P(Arr), Key);
	return (z!=NULL) ? Z_LVAL_P(z) : 0;
}

static zend_always_inline Bucket *zend_hash_index_find_bucket(const HashTable *ht, zend_ulong h)
{
	uint32_t nIndex;
	uint32_t idx;
	Bucket *p, *arData;

	arData = ht->arData;
	nIndex = h | ht->nTableMask;
	idx = HT_HASH_EX(arData, nIndex);
	while (idx != HT_INVALID_IDX) {
		ZEND_ASSERT(idx < HT_IDX_TO_HASH(ht->nTableSize));
		p = HT_HASH_TO_BUCKET_EX(arData, idx);
		if (p->h == h && !p->key) {
			return p;
		}
		idx = Z_NEXT(p->val);
	}
	return NULL;
}


ZEND_API zval* ZEND_FASTCALL zend_hash_index_find(const HashTable *ht, zend_ulong h)
{
	Bucket *p;

	IS_CONSISTENT(ht);

	if (HT_FLAGS(ht) & HASH_FLAG_PACKED) {
		if (h < ht->nNumUsed) {
			p = ht->arData + h;
			if (Z_TYPE(p->val) != IS_UNDEF) {
				return &p->val;
			}
		}
		return NULL;
	}

	p = zend_hash_index_find_bucket(ht, h);
	return p ? &p->val : NULL;
}

static zend_always_inline zend_uchar zval_get_type(const zval* pz) {
	return pz->u1.v.type;
}

static void _zend_is_inconsistent(const HashTable *ht, const char *file, int line)
{
	if ((HT_FLAGS(ht) & HASH_FLAG_CONSISTENCY) == HT_OK) {
		return;
	}
	switch (HT_FLAGS(ht) & HASH_FLAG_CONSISTENCY) {
		case HT_IS_DESTROYING:
			zend_output_debug_string(1, "%s(%d) : ht=%p is being destroyed", file, line, ht);
			break;
		case HT_DESTROYED:
			zend_output_debug_string(1, "%s(%d) : ht=%p is already destroyed", file, line, ht);
			break;
		case HT_CLEANING:
			zend_output_debug_string(1, "%s(%d) : ht=%p is being cleaned", file, line, ht);
			break;
		default:
			zend_output_debug_string(1, "%s(%d) : ht=%p is inconsistent", file, line, ht);
			break;
	}
	ZEND_ASSERT(0);
}
#define IS_CONSISTENT(a) _zend_is_inconsistent(a, __FILE__, __LINE__);

unit PHPForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Engine, Vcl.StdCtrls, System.Generics.Collections, ArrayEx;

type
  TForm1 = class(TForm)
    Code: TMemo;
    Log: TMemo;
    EvalCode: TButton;
    PHPArrayLog: TMemo;
    DelphiArrayLog: TMemo;
    PHPSpeedArr: TButton;
    DelphiSpeedArr: TButton;
    procedure EvalCodeClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PHPSpeedArrClick(Sender: TObject);
    procedure DelphiSpeedArrClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }

    function PHPLineFill: AnsiString;
    function PHPLineFillString: AnsiString;
    function PHPLineFillStringIndex: AnsiString;
    function PHPLineFillStringString: AnsiString;
    function PHPLineFillMul: AnsiString;

    function DelphiLineFill: AnsiString;
    function DelphiLineFillString: AnsiString;
    function DelphiLineFillStringIndex: AnsiString;
    function DelphiLineFillStringString: AnsiString;
    function DelphiLineFillMul: AnsiString;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  T, T1, T3: Int64;
  i, A: integer;

function sprintf(S: PAnsiChar; const Format: PAnsiChar): integer; cdecl; varargs; external 'msvcrt.dll';

function PrintTime(T: Int64): AnsiString;
var
  A, b: Int64;
begin
  Result := '';
  if QueryPerformanceCounter(A) and QueryPerformanceFrequency(b) then
  begin
    SetLength(Result, 25);
    SetLength(Result, sprintf(PAnsiChar(Result), '%f', single((A - T) / b)));
  end;
end;

procedure TForm1.EvalCodeClick(Sender: TObject);
begin
  with php^ do
  begin
    EvalCode(Code.Text, nil, 'Test Runner', 1);
  end;
end;

function ub_write(const Str: PAnsiChar; Len: Size_t): Size_t cdecl;
begin
  Form1.Log.Lines.Add((Str));
  Result := Len;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  php^.ub_write := ub_write;
end;

function TForm1.PHPLineFill: AnsiString;
var
  arr: Pointer;
  i, r: integer;
begin
  QueryPerformanceCounter(T1);
  with php^ do
  begin
    arr := array_init_size();
    for r := 0 to 3 do
      for i := 0 to 1000000 do
        P(PIndex, arr, IS_LONG, i, i);
    array_destroy(arr);
  end;
  Result := PrintTime(T1);
end;

function TForm1.PHPLineFillString: AnsiString;
var
  arr: Pointer;
  i, r: integer;
begin
  QueryPerformanceCounter(T1);
  with php^ do
  begin
    arr := array_init_size();
    for r := 0 to 3 do
      for i := 0 to 1000000 do
        P(PIndex, arr, IS_STRING, i, 'ValueString' + i.ToString);
    array_destroy(arr);
  end;
  Result := PrintTime(T1);
end;

function TForm1.PHPLineFillStringIndex: AnsiString;
var
  arr: Pointer;
  i, r: integer;
begin
  QueryPerformanceCounter(T1);
  with php^ do
  begin
    arr := array_init_size();
    for r := 0 to 3 do
      for i := 0 to 1000000 do
        P(PAssoc, arr, IS_LONG, 'KeyString' + i.ToString, i);
    array_destroy(arr);
  end;
  Result := PrintTime(T1);
end;

function TForm1.PHPLineFillStringString: AnsiString;
var
  arr: Pointer;
  i, r: integer;
begin
  QueryPerformanceCounter(T1);
  with php^ do
  begin
    arr := array_init_size();
    for r := 0 to 3 do
      for i := 0 to 1000000 do
        P(PAssoc, arr, IS_STRING, 'KeyString' + i.ToString, 'ValueString' + i.ToString);
    array_destroy(arr);
  end;
  Result := PrintTime(T1);
end;

function TForm1.PHPLineFillMul: AnsiString;
var
  arr: Pointer;
  i, r: integer;
begin
  QueryPerformanceCounter(T1);
  with php^ do
  begin
    arr := array_init_size();
    for r := 0 to 3 do
      for i := 0 to 1000000 do
      begin
        P(PIndex, arr, IS_LONG, i, i);
        P(PIndex, arr, IS_LONG, i, ArrayGetIntIndex(arr, i) * i);
      end;
    array_destroy(arr);
  end;
  Result := PrintTime(T1);
end;

procedure TForm1.PHPSpeedArrClick(Sender: TObject);
begin
  with PHPArrayLog.Lines do
  begin
    Add('PHP. Каждое действие выполняется по 3 раза от 0 до 1000000');
    Add('Arr[$i] = $i;                                            Time: ' + PHPLineFill);
    Add('Arr[$i] = ''ValueString'' + $i;                    Time: ' + PHPLineFillString);
    Add('Arr[''KeyString'' + $i] = $i;                       Time: ' + PHPLineFillStringIndex);
    Add('Arr[''KeyString'' + $i] = ''TestString'' + $i; Time: ' + PHPLineFillStringString);
    Add('Arr[i] = i; & Arr[i] = Arr[i] * Arr[i];      . Time: ' + PHPLineFillMul);
  end;
end;

function TForm1.DelphiLineFill: AnsiString;
var
  arr: Pointer;
  i, r: integer;

  l: TDictionary<integer, integer>;
begin
  QueryPerformanceCounter(T1);

  l := TDictionary<integer, integer>.Create();
  for r := 0 to 3 do
    for i := 0 to 1000000 do
      l.AddOrSetValue(i, i);

  l.Free;
  Result := PrintTime(T1);
end;

function TForm1.DelphiLineFillString: AnsiString;
var
  arr: Pointer;
  i, r: integer;

  l: TDictionary<integer, string>;
begin
  QueryPerformanceCounter(T1);

  l := TDictionary<integer, string>.Create();
  for r := 0 to 3 do
    for i := 0 to 1000000 do
      l.AddOrSetValue(i, 'ValueString' + i.ToString);

  l.Free;
  Result := PrintTime(T1);
end;

function TForm1.DelphiLineFillStringIndex: AnsiString;
var
  arr: Pointer;
  i, r: integer;

  l: TDictionary<string, integer>;
begin
  QueryPerformanceCounter(T1);

  l := TDictionary<string, integer>.Create();
  for r := 0 to 3 do
    for i := 0 to 1000000 do
      l.AddOrSetValue('KeyString' + i.ToString, i);

  l.Free;
  Result := PrintTime(T1);
end;

function TForm1.DelphiLineFillStringString: AnsiString;
var
  arr: Pointer;
  i, r: integer;

  l: TDictionary<string, string>;
begin
  QueryPerformanceCounter(T1);

  l := TDictionary<string, string>.Create();
  for r := 0 to 3 do
    for i := 0 to 1000000 do
      l.AddOrSetValue('KeyString' + i.ToString, 'ValueString' + i.ToString);

  l.Free;
  Result := PrintTime(T1);
end;

function TForm1.DelphiLineFillMul: AnsiString;
var
  arr: Pointer;
  i, r: integer;

  l: TDictionary<integer, integer>;
begin
  QueryPerformanceCounter(T1);

  l := TDictionary<integer, integer>.Create();
  for r := 0 to 3 do
    for i := 0 to 1000000 do
    begin
      l.AddOrSetValue(i, i);
      l.AddOrSetValue(i, l.Items[i] * i);
    end;
  l.Free;
  Result := PrintTime(T1);
end;

function DelphiLineFillMulArr: AnsiString;
var
  arr: Pointer;
  i, r: integer;

  l: TArrayEx<integer>;
begin
  QueryPerformanceCounter(T1);

  for r := 0 to 3 do
    for i := 0 to 1000000 do
    begin
      l.Add(i);
      l.Items[i] := l.Items[i] * i;
    end;

  Result := PrintTime(T1);
end;

procedure TForm1.DelphiSpeedArrClick(Sender: TObject);
begin
  with DelphiArrayLog.Lines do
  begin
    Add('Delphi. Каждое действие выполняется по 3 раза от 0 до 1000000');
    Add('Arr[$i] = $i;                                            Time: ' + DelphiLineFill);
    Add('Arr[$i] = ''ValueString'' + $i;                    Time: ' + DelphiLineFillString);
    Add('Arr[''KeyString'' + $i] = $i;                       Time: ' + DelphiLineFillStringIndex);
    Add('Arr[''KeyString'' + $i] = ''TestString'' + $i; Time: ' + DelphiLineFillStringString);
    Add('Arr[i] = i; & Arr[i] = Arr[i] * Arr[i];      . Time: ' + DelphiLineFillMul);

    Add('rgreat TArrayEx<integer>      . Time: ' + DelphiLineFillMulArr);
  end;

end;

end.

#define __PDeclare 1
#define __PUpdate 2
#define __PUpdateStatic 3
#define __PAssoc 4
#define __PConst 5
#define __PConstClass 6
#define __PProperty 7
#define __PIndex 8
#define __PNext 9


int __P(int Operation, void * ptr, int TypeSet) {
	int ret = 0;
	
	va_list args;
	va_start(args, TypeSet);
	
	char *key;
	int len;
	if(Operation >= __PDeclare && Operation <= __PProperty) {
		key = va_arg(args, char*);
		len = strlen(key);
	}
	
	switch(Operation) {
		case __PDeclare: switch(TypeSet) {
				_ClassSet(IS_NULL,   declare, _null  , int);
				_ClassSet(IS_PTR,    declare,        , zval *   , va_arg(args, int));
				_ClassSet(_IS_BOOL,  declare, _bool  , zend_bool, va_arg(args, int));
				_ClassSet(IS_LONG,   declare, _long  , zend_long, va_arg(args, int));
				_ClassSet(IS_DOUBLE, declare, _double, double   , va_arg(args, int));
				_ClassSet(IS_STRING, declare, _string, char *   , va_arg(args, int));
			}
		break;
		case __PUpdate: switch(TypeSet) {
				_ClassSet2(IS_VOID,   unset,           );
				_ClassSet2(IS_NULL,   update,	_null  );
				_ClassSet2(IS_PTR,    update,          , va_arg(args, zval *));
				_ClassSet2(IS_LONG,   update,   _long  , va_arg(args, zend_long));
				_ClassSet2(_IS_BOOL,  update,   _bool  , va_arg(args, zend_bool));
				_ClassSet2(IS_DOUBLE, update,   _double, va_arg(args, double));
				_ClassSet2(IS_STRING, update,   _string, va_arg(args, char *));
				_ClassSet2(100,       update,   _str   , va_arg(args, zend_string *));
			}
		break;
		case __PUpdateStatic: switch(TypeSet) {
				_ClassSet3(IS_NULL,   update_static, _null);
				_ClassSet3(IS_PTR,    update_static,        , va_arg(args, zval *));
				_ClassSet3(_IS_BOOL,  update_static, _bool  , va_arg(args, zend_bool));
				_ClassSet3(IS_LONG,   update_static, _long  , va_arg(args, zend_long));
				_ClassSet3(IS_DOUBLE, update_static, _double, va_arg(args, double));
				_ClassSet3(IS_STRING, update_static, _string, va_arg(args, char *));
			}
		break;
		case __PAssoc:
			switch(TypeSet) {
				_Arr1(assoc,  IS_NULL,     null);
				_Arr1(assoc,  IS_LONG,     long,     va_arg(args, zend_long));
				_Arr1(assoc,  IS_DOUBLE,   double,   va_arg(args, double));
				_Arr1(assoc, _IS_BOOL,     bool,     va_arg(args, zend_bool));
				_Arr1(assoc,  IS_STRING,   string,   va_arg(args, char *));
				_Arr1(assoc,  IS_PTR,      zval,     va_arg(args, zval *));
				_Arr1(assoc,  IS_RESOURCE, resource, va_arg(args, zend_resource *));
				_Arr1(assoc,  100,         str,      va_arg(args, zend_string *));
			}
		break;
		case __PIndex:
			int key2 = va_arg(args, int);
			switch(TypeSet) {
				_Arr2(index,  IS_NULL,     null,     key2);
				_Arr2(index,  IS_LONG,     long,     key2, va_arg(args, zend_long));
				_Arr2(index,  IS_DOUBLE,   double,   key2, va_arg(args, double));
				_Arr2(index, _IS_BOOL,     bool,     key2, va_arg(args, zend_bool));
				_Arr2(index,  IS_STRING,   string,   key2, va_arg(args, char *));
				_Arr2(index,  IS_PTR,      zval,     key2, va_arg(args, zval *));
				_Arr2(index,  IS_RESOURCE, resource, key2, va_arg(args, zend_resource *));
				_Arr2(index,  100,         str,      key2, va_arg(args, zend_string *));
			}
		break;
		case __PNext:
			switch(TypeSet) {
				_Arr3(next,  IS_NULL,     null);
				_Arr3(next,  IS_LONG,     long,     va_arg(args, zend_long));
				_Arr3(next,  IS_DOUBLE,   double,   va_arg(args, double));
				_Arr3(next, _IS_BOOL,     bool,     va_arg(args, zend_bool));
				_Arr3(next,  IS_STRING,   string,   va_arg(args, char *));
				_Arr3(next,  IS_PTR,      zval,     va_arg(args, zval *));
				_Arr3(next,  IS_RESOURCE, resource, va_arg(args, zend_resource *));
				_Arr3(next,  100,         str,      va_arg(args, zend_string *));
			}
		break;
		case __PConst:
			switch(TypeSet) {
				_MacrosComplit2(IS_NULL,   null);
				_MacrosComplit3(IS_LONG,   long,   zend_long);
				_MacrosComplit3(IS_DOUBLE, double, double);
				_MacrosComplit3(_IS_BOOL,  bool,   zend_bool);
				_MacrosComplit3(IS_STRING, string, char *);
				case IS_PTR:
					int flags3 = va_arg(args, int); 
					int module_numbe3 = va_arg(args, int);
					
					zend_constant c;
					
					ZVAL_ZVAL(&c.value, va_arg(args, zval *), 1, 0);
					
					ZEND_CONSTANT_SET_FLAGS(&c, flags3, module_numbe3);
					
					c.name = zend_string_init_interned(key, len, flags3 & CONST_PERSISTENT);
					zend_register_constant(&c);
				break;
			};
		break;
		case __PConstClass:
			switch(TypeSet) {
				_MacrosComplit(IS_NULL,    _null);
				_MacrosComplit(IS_LONG,    _long,   va_arg(args, zend_long));
				_MacrosComplit(IS_DOUBLE,  _double, va_arg(args, double)); 
				_MacrosComplit(_IS_BOOL,   _bool,   va_arg(args, zend_bool));
				_MacrosComplit(IS_STRING,  _string, va_arg(args, char *));
				_MacrosComplit(IS_PTR,            , va_arg(args, zval *));
			};	
		break;
		case __PProperty:
			switch(TypeSet) {
				Prop(IS_NULL,     null);
				Prop(IS_LONG,     long,     va_arg(args, zend_long));
				Prop(IS_DOUBLE,   double,   va_arg(args, double));
				Prop(_IS_BOOL,    bool,     va_arg(args, zend_bool));
				Prop(IS_STRING,   string,   va_arg(args, char *));
				Prop(IS_PTR,      zval,     va_arg(args, zval *));
				Prop(IS_RESOURCE, resource, va_arg(args, zend_resource *));
				Prop(100,         str,      va_arg(args, zend_string *));
			};	
		break;
	}
	
	va_end(args);
	return ret;	
}

procedure PreHandler(Execute_data, Return_value: Pointer); cdecl;
var
  Count: Integer;
  Ptr, v: Pointer;
  W: UTF8String;
begin
  W := '';
  with php^ do
  begin
    Ptr := ARG_CALL(Execute_data, 1); // Поулчим стэк-массив аргументов
    Count := ARGS_NUM(Execute_data); // Количество вызываемых аргументов
    while Count > 0 do
    begin
      dec(Count);

      v := PByte(Ptr) + (Count * SizeZval); // ARG_GET (Функция работает так)

      if Z_TYPE_P(v) in [IS_ARRAY, IS_OBJECT, IS_RESOURCE] then
        W := UTF8String(printR(v, 0)) + W
      else
        W := UTF8String(Z_STRVAL_P(Zval_Type(v, IS_STRING))) + W;
    end;
    ShowMessage(string(W));
  end;
end;