Category Archives: Delphi

Delphi.IdHTTPServer.Решение проблемы с русскими символами

Posted on 04.04.2019 by Stanislav_Panteleev

Есть такая проблема, а точнее 2 проблемы, Параметры POST / Get запросов, если это русский текст, превращаются в кракозябры при парсинге запроса. То есть

aRequestInfo.Params.Text = ' Ð Ñ'#$0083'Ñ'#$0081'Ñ'#$0081'ÐºÐ¸Ð¹ Ð¿Ð°Ñ'#$0080'Ð°Ð¼ÐµÑ'#$0082'Ñ'#$0080 '

1	aRequestInfo.Params.Text = ' Ð Ñ'#$0083'Ñ'#$0081'Ñ'#$0081'ÐºÐ¸Ð¹ Ð¿Ð°Ñ'#$0080'Ð°Ð¼ÐµÑ'#$0082'Ñ'#$0080 '

Видно, что это UTF, поэтому нам понадобится следующая функция UtfToAnsi, например такая

function TRP.ConvertUtf8ToAnsi(const Source: string): string;
var
  Iterator, SourceLength, FChar, NChar: Integer;
begin
  Result := '';
  Iterator := 0;
  SourceLength := Length(Source);
  while Iterator < SourceLength do
  begin
    Inc(Iterator);
    FChar := Ord(Source[Iterator]);
    if FChar >= $80 then
    begin
      Inc(Iterator);
      if Iterator > SourceLength then
        break;
      FChar := FChar and $3F;
      if (FChar and $20) <> 0 then
      begin
        FChar := FChar and $1F;
        NChar := Ord(Source[Iterator]);
        if (NChar and $C0) <> $80 then
          break;
        FChar := (FChar shl 6) or (NChar and $3F);
        Inc(Iterator);
        if Iterator > SourceLength then
          break;
      end;
      NChar := Ord(Source[Iterator]);
      if (NChar and $C0) <> $80 then
        break;
      Result := Result + WideChar((FChar shl 6) or (NChar and $3F));
    end
    else
      Result := Result + WideChar(FChar);
  end;
end;

function TRP.ConvertUtf8ToAnsi(const Source: string): string;

var

Iterator, SourceLength, FChar, NChar: Integer;

begin

Result := '';

Iterator := 0;

SourceLength := Length(Source);

while Iterator < SourceLength do

begin

Inc(Iterator);

FChar := Ord(Source[Iterator]);

if FChar >= $80 then

begin

Inc(Iterator);

if Iterator > SourceLength then

break;

FChar := FChar and $3F;

if (FChar and $20) <> 0 then

begin

FChar := FChar and $1F;

NChar := Ord(Source[Iterator]);

if (NChar and $C0) <> $80 then

break;

FChar := (FChar shl 6) or (NChar and $3F);

Inc(Iterator);

if Iterator > SourceLength then

break;

end;

NChar := Ord(Source[Iterator]);

if (NChar and $C0) <> $80 then

break;

Result := Result + WideChar((FChar shl 6) or (NChar and $3F));

end

else

Result := Result + WideChar(FChar);

end;

Применение она … Continue reading →

Posted in Delphi | Comments Off

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

Posted on 17.02.2019 by Stanislav_Panteleev

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

Posted in Delphi | Comments Off

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 | Comments Off

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

Posted on 10.02.2019 by Stanislav_Panteleev

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

Posted in Delphi | Comments Off

Delphi.Spring4D.Marshmallow

Posted on 05.02.2019 by Stanislav_Panteleev

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

Posted in Delphi | Comments Off

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 | Comments Off

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 | Comments Off

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 | Comments Off

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 | Comments Off

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 | Comments Off

Category Archives: Delphi

Delphi.IdHTTPServer.Решение проблемы с русскими символами

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

MY PROJECTS

Recent Posts

Categories