Author Archives: Stanislav_Panteleev

Delphi. Первый опыт работы с библиотекой Marshmallow в реальном проекте

Posted on 17.02.2019 by Stanislav_Panteleev

Как известно, Marshmallow это ORM библиотека для Delphi. Она входит в состав Spring4D – потрясающей библиотеки коллекций, Dependency Injection и др. Решил поделиться первым опытом работы с библиотекой Marshmallow в своем проекте, который я делаю на основе своего RobustServer – … Continue reading →

Posted in Delphi | Leave a comment

Delphi.RobustServer.Работа с общими ресурсами

Posted on 10.02.2019 by Stanislav_Panteleev

Здесь все обычно, то есть так, на примере критической секции.

procedure TRPTests.SharedResourceExample;
var
  json: ISuperObject;
  i: Integer;
begin
  Main.CS.Enter();
  try
    json := SO;
    for i := 0 to Main.SomeSharedResource.Count - 1 do
      json.S['value_' + i.ToString] := Main.SomeSharedResource.ValueFromIndex[i];
    FResponses.OkWithJson(json.AsJSon(false, false));
  finally
    Main.CS.Leave();
  end;
end;

procedure TRPTests.SharedResourceExample;

var

json: ISuperObject;

i: Integer;

begin

Main.CS.Enter();

try

json := SO;

for i := 0 to Main.SomeSharedResource.Count - 1 do

json.S['value_' + i.ToString] := Main.SomeSharedResource.ValueFromIndex[i];

FResponses.OkWithJson(json.AsJSon(false, false));

finally

Main.CS.Leave();

end;

Есть у нас в памяти некоторый общий ресурс, обратиться к нему могут 300 000 потоков, поэтому защищаем его критической секцией.

Posted in Delphi | Leave a comment

Delphi.RobustServer. Работа с длинными операциями

Posted on 10.02.2019 by Stanislav_Panteleev

Короткие запросы хороши тем, что мы можем получить ответ сразу, а вот как обрабатывать длинные запросы? На StackOverflow Remy Lebeau советует дать ответ о старте работы клиенту сразу, и саму работу выносить в отдельный поток. Я уже писал на эту … Continue reading →

Posted in Delphi | Leave a comment

Delphi.Spring4D.Marshmallow

Posted on 05.02.2019 by Stanislav_Panteleev

Открыл для себя потрясающий ORM framework Marshmallow, который является частью библиотеки Spring4D и работает с его коллекциями. Вообще, надо сказать, что такие вещи, как ORM призваны сокращать время разработки и создавать код более высокой абстракции. Если, скажем, понадобится переехать на другой … Continue reading →

Posted in Delphi | Leave a comment

Delphi.IsSingleInstance

Posted on 02.02.2019 by Stanislav_Panteleev

Проверка “а один ли экземпляр запущен ?”. Работает в мультипользовательском режиме, в отличие от “обычного” мьютекса.

//Creates a mutex to see if the program is already running.
function IsSingleInstance(MutexName: string; KeepMutex: boolean = true): boolean;
const
  MUTEX_GLOBAL = 'Global\'; //Prefix to explicitly create the object in the global or session namespace. I.e. both client app (local user) and service (system account)
var
  MutexHandel: THandle;
  SecurityDesc: TSecurityDescriptor;
  SecurityAttr: TSecurityAttributes;
  ErrCode: integer;
begin
    // By default (lpMutexAttributes =nil) created mutexes are accessible only by
    // the user running the process. We need our mutexes to be accessible to all
    // users, so that the mutex detection can work across user sessions.
    // I.e. both the current user account and the System (Service) account.
    // To do this we use a security descriptor with a null DACL.
  InitializeSecurityDescriptor(@SecurityDesc, SECURITY_DESCRIPTOR_REVISION);
  SetSecurityDescriptorDacl(@SecurityDesc, True, nil, False);
  SecurityAttr.nLength := SizeOf(SecurityAttr);
  SecurityAttr.lpSecurityDescriptor := @SecurityDesc;
  SecurityAttr.bInheritHandle := False;

    // The mutex is created in the global name space which makes it possible to
    // access across user sessions.
  MutexHandel := CreateMutex(@SecurityAttr, True, PChar(MUTEX_GLOBAL + MutexName));
  ErrCode := GetLastError;

    // If the function fails, the return value is 0
    // If the mutex is a named mutex and the object existed before this function
    // call, the return value is a handle to the existing object, GetLastError
    // returns ERROR_ALREADY_EXISTS.
  if {(MutexHandel = 0) or } (ErrCode = ERROR_ALREADY_EXISTS) then
  begin
    result := false;
    closeHandle(MutexHandel);
  end
  else
  begin
    // Mutex object has not yet been created, meaning that no previous
    // instance has been created.
    result := true;

    if not KeepMutex then
      CloseHandle(MutexHandel);
  end;
    // The Mutexhandle is not closed because we want it to exist during the
    // lifetime of the application. The system closes the handle automatically
    //when the process terminates.
end;

//Creates a mutex to see if the program is already running.

function IsSingleInstance(MutexName: string; KeepMutex: boolean = true): boolean;

const

MUTEX_GLOBAL = 'Global\'; //Prefix to explicitly create the object in the global or session namespace. I.e. both client app (local user) and service (system account)

var

MutexHandel: THandle;

SecurityDesc: TSecurityDescriptor;

SecurityAttr: TSecurityAttributes;

ErrCode: integer;

begin

// By default (lpMutexAttributes =nil) created mutexes are accessible only by

// the user running the process. We need our mutexes to be accessible to all

// users, so that the mutex detection can work across user sessions.

// I.e. both the current user account and the System (Service) account.

// To do this we use a security descriptor with a null DACL.

InitializeSecurityDescriptor(@SecurityDesc, SECURITY_DESCRIPTOR_REVISION);

SetSecurityDescriptorDacl(@SecurityDesc, True, nil, False);

SecurityAttr.nLength := SizeOf(SecurityAttr);

SecurityAttr.lpSecurityDescriptor := @SecurityDesc;

SecurityAttr.bInheritHandle := False;

// The mutex is created in the global name space which makes it possible to

// access across user sessions.

MutexHandel := CreateMutex(@SecurityAttr, True, PChar(MUTEX_GLOBAL + MutexName));

ErrCode := GetLastError;

// If the function fails, the return value is 0

// If the mutex is a named mutex and the object existed before this function

// call, the return value is a handle to the existing object, GetLastError

// returns ERROR_ALREADY_EXISTS.

if {(MutexHandel = 0) or } (ErrCode = ERROR_ALREADY_EXISTS) then

begin

result := false;

closeHandle(MutexHandel);

end

else

begin

// Mutex object has not yet been created, meaning that no previous

// instance has been created.

result := true;

if not KeepMutex then

CloseHandle(MutexHandel);

end;

// The Mutexhandle is not closed because we want it to exist during the

// lifetime of the application. The system closes the handle automatically

//when the process terminates.

end;

Posted in Delphi | Leave a comment

Delphi. Работа с вариантными массивами

Posted on 29.01.2019 by Stanislav_Panteleev

Каноничный пример одномерного массива

var
  Arr: Variant;
  I: Integer;
begin
  { Create a variant array of 10 elements, starting at 0
    and ending at 9. The array contains elements of type integer }
  Arr := VarArrayCreate([0, 9], varInteger);

  { Increase the length of the variant array }
  VarArrayRedim(Arr, 49);

  MessageDlg('Variant array has ' + IntToStr(VarArrayDimCount(Arr)) + ' dimensions', mtInformation, [mbOK], 0);

  { Traverse the array from lower to higher bounds }
  for I := VarArrayLowBound(Arr, 1) to VarArrayHighBound(Arr, 1) do
  begin
    { Put the element I at index I}
    VarArrayPut(Arr, 'Привет', [I]);
  end;

  { Now read the elements of the array }
  for I := VarArrayLowBound(Arr, 1) to VarArrayHighBound(Arr, 1) do
  begin
    { Put the element I at index I}
    if VarArrayGet(Arr, [I]) <> I then
      MessageDlg('Error! Invalid element found at current position!', mtError, [mbOK], 0);
  end;

  { Clear the variant array }
  VarClear(Arr);
end;

var

Arr: Variant;

I: Integer;

begin

{ Create a variant array of 10 elements, starting at 0

and ending at 9. The array contains elements of type integer }

Arr := VarArrayCreate([0, 9], varInteger);

{ Increase the length of the variant array }

VarArrayRedim(Arr, 49);

MessageDlg('Variant array has ' + IntToStr(VarArrayDimCount(Arr)) + ' dimensions', mtInformation, [mbOK], 0);

{ Traverse the array from lower to higher bounds }

for I := VarArrayLowBound(Arr, 1) to VarArrayHighBound(Arr, 1) do

begin

{ Put the element I at index I}

VarArrayPut(Arr, 'Привет', [I]);

end;

{ Now read the elements of the array }

for I := VarArrayLowBound(Arr, 1) to VarArrayHighBound(Arr, 1) do

begin

{ Put the element I at index I}

if VarArrayGet(Arr, [I]) <> I then

MessageDlg('Error! Invalid element found at current position!', mtError, [mbOK], 0);

end;

{ Clear the variant array }

VarClear(Arr);

end;

Далее пример двумерного массива

procedure TMain.VarArrayExample2D;
var
  arr2D: Variant;
  cols, rows: integer;
  i, j: integer;
  lowCols, lowRows: Integer;
  highCols, highRows: Integer;
begin
  cols := 2;
  rows := 2;
  arr2D := VarArrayCreate([1, cols, 1, rows], varInteger);

  lowCols := VarArrayLowBound(arr2D, 1);
  highCols := VarArrayHighBound(arr2D, 1);

  lowRows := VarArrayLowBound(arr2D, 2);
  highRows := VarArrayHighBound(arr2D, 2);

  Memo1.Lines.Clear();

  for i := lowCols to highCols do
    for j := lowRows to highRows do
    begin
      arr2D[i, j] := i.ToString() + ' ' + j.ToString();
      Memo1.Lines.Add((arr2D[i, j]));
    end;
end;

procedure TMain.VarArrayExample2D;

var

arr2D: Variant;

cols, rows: integer;

i, j: integer;

lowCols, lowRows: Integer;

highCols, highRows: Integer;

begin

cols := 2;

rows := 2;

arr2D := VarArrayCreate([1, cols, 1, rows], varInteger);

lowCols := VarArrayLowBound(arr2D, 1);

highCols := VarArrayHighBound(arr2D, 1);

lowRows := VarArrayLowBound(arr2D, 2);

highRows := VarArrayHighBound(arr2D, 2);

Memo1.Lines.Clear();

for i := lowCols to highCols do

for j := lowRows to highRows do

begin

arr2D[i, j] := i.ToString() + ' ' + j.ToString();

Memo1.Lines.Add((arr2D[i, j]));

end;

Довольно хорошая документация по вариантным массивам от Emba

Posted in Delphi | Leave a comment

Delphi.Linq или sugar Spring4D

Posted on 26.01.2019 by Stanislav_Panteleev

Delphi Linq Искал какое-то время аналог C# Linq в Delphi. Встретил много чего интересного, но когда наткнулся на openSource библиотеку Spring4D, понял, что это то, что нужно. В чем профит ? Дело в том, что в System.Generics.Collections нет, как ни странно, … Continue reading →

Posted in Delphi | Leave a comment

DelphiRobustServer. Autocollection of API. WindowsService or Desktop modes.

Posted on 08.01.2019 by Stanislav_Panteleev

Added new features Autocollection of API. Collects methods and its params and can be used as a draft. Works through Delphi RTTI methods. Result looks like

Posted in Delphi | Leave a comment

Delphi.Rtti.Overloaded methods

Posted on 07.01.2019 by Stanislav_Panteleev

That is known that overloaded methods works not so well in Rtti Delphi by default. To fix this RRUZ created this method

function TRP.RttiMethodInvokeEx(const MethodName:string; RttiType : TRttiType; Instance: TValue; const Args: array of TValue): TValue;
var
 Found   : Boolean;
 LMethod : TRttiMethod;
 LIndex  : Integer;
 LParams : TArray<TRttiParameter>;
begin
  Result:=nil;
  LMethod:=nil;
  Found:=False;
  for LMethod in RttiType.GetMethods do
   if SameText(LMethod.Name, MethodName) then
   begin
     LParams:=LMethod.GetParameters;
     if Length(Args)=Length(LParams) then
     begin
       Found:=True;
       for LIndex:=0 to Length(LParams)-1 do
       if LParams[LIndex].ParamType.Handle<>Args[LIndex].TypeInfo then
       begin
         Found:=False;
         Break;
       end;
     end;

     if Found then Break;
   end;

   if (LMethod<>nil) and Found then
     Result:=LMethod.Invoke(Instance, Args)
   else
     raise Exception.CreateFmt('method %s not found',[MethodName]);
end;

function TRP.RttiMethodInvokeEx(const MethodName:string; RttiType : TRttiType; Instance: TValue; const Args: array of TValue): TValue;

var

Found : Boolean;

LMethod : TRttiMethod;

LIndex : Integer;

LParams : TArray<TRttiParameter>;

begin

Result:=nil;

LMethod:=nil;

Found:=False;

for LMethod in RttiType.GetMethods do

if SameText(LMethod.Name, MethodName) then

begin

LParams:=LMethod.GetParameters;

if Length(Args)=Length(LParams) then

begin

Found:=True;

for LIndex:=0 to Length(LParams)-1 do

if LParams[LIndex].ParamType.Handle<>Args[LIndex].TypeInfo then

begin

Found:=False;

Break;

end;

if Found then Break;

end;

if (LMethod<>nil) and Found then

Result:=LMethod.Invoke(Instance, Args)

else

raise Exception.CreateFmt('method %s not found',[MethodName]);

end;

So, you can use them like

   r := RttiMethodInvokeEx('Create', t, t.MetaclassType, [444]);
   r := RttiMethodInvokeEx('Create', t, t.MetaclassType, ['hello from constructor string']);
   r := RttiMethodInvokeEx('Create', t, t.MetaclassType, []);
   RttiMethodInvokeEx('Bar', t, r.AsObject , ['this is a string']);
   RttiMethodInvokeEx('Bar', t, r.AsObject , [9999]);

r := RttiMethodInvokeEx('Create', t, t.MetaclassType, [444]);

r := RttiMethodInvokeEx('Create', t, t.MetaclassType, ['hello from constructor string']);

r := RttiMethodInvokeEx('Create', t, t.MetaclassType, []);

RttiMethodInvokeEx('Bar', t, r.AsObject , ['this is a string']);

RttiMethodInvokeEx('Bar', t, r.AsObject , [9999]);

Posted in Delphi | Leave a comment

Algos.Hackerrank.Birthday Cake Candles

Posted on 21.12.2018 by Stanislav_Panteleev

You are in charge of the cake for your niece’s birthday and have decided the cake will have one candle for each year of her total age. When she blows out the candles, she’ll only be able to blow out … Continue reading →

Posted in C# | Leave a comment

Author Archives: Stanislav_Panteleev

Delphi. Первый опыт работы с библиотекой Marshmallow в реальном проекте

Delphi.RobustServer.Работа с общими ресурсами

Delphi.RobustServer. Работа с длинными операциями

Delphi.Spring4D.Marshmallow

Delphi.IsSingleInstance

Delphi. Работа с вариантными массивами

Delphi.Linq или sugar Spring4D

DelphiRobustServer. Autocollection of API. WindowsService or Desktop modes.

Delphi.Rtti.Overloaded methods

Algos.Hackerrank.Birthday Cake Candles

MY PROJECTS

DELPHI WORLD

C# WORLD

MySQL WORLD

JS WORLD

PHP World

IIS World

Recent Posts

Categories