Author Archives: Stanislav_Panteleev

Delphi. Firemonkey. Fatal error

Posted on 16.07.2018 by Stanislav_Panteleev

Embarcadero Rad Studio 10.1.2 Delphi Linker error code 1 ($00000001) [DCC Error] E2597 C:\Users\Public\Documents\Embarcadero\Studio\18.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: fatal error: .AndroidDebuglibAlamcenistaImpo.so: mmap: failed to allocate 202548716 bytes for output file: Not enough space http://support.embarcadero.com/article/44279

Posted in Delphi | Leave a comment

C# Делегаты и события

Posted on 03.07.2018 by Stanislav_Panteleev

Понравилось видео

Posted in C# | Leave a comment

Delphi. Firemonkey. Делаем круглое изображение наложением маски

Posted on 29.06.2018 by Stanislav_Panteleev

Нам нужно 2 изображения – то, которое нужно сделать круглым и сама маска в виде круга. В процессе этого кода размеры этих изображений выравниваются, чтобы маска могла наложиться корректно, иначе это будет невозможно. Помог вот это код с официального сайта … Continue reading →

Posted in Delphi | Leave a comment

Delphi. Json. Получение всей структуры ключей-значений

Posted on 28.06.2018 by Stanislav_Panteleev

Писал сервер, и понадобилось обработать application/json запрос, очень помог код со stackOverflow для получения всей структуры json, делается это вот так… Источник

procedure ParseJSON;
var
  JSONText: string;
  JSON: ISuperObject;
begin
  // Retrieve JSON as a string into JSONText variable any way you like.
  JSON := SO(JSONText);
  ProcessObject(JSON.AsObject);
end;

procedure ProcessObject(const aAsObject: TSuperTableString; const aPrefix: string = '');
var
  Names: ISuperObject;
  Name: string;
  Items: ISuperObject;
  Item: ISuperObject;
  idx: Integer;
  Value: string;
  ArrayItem: ISuperObject;
begin
  if Assigned(aAsObject) then
  begin
    Names := aAsObject.GetNames;
    Items := aAsObject.GetValues;

    for idx := 0 to Items.AsArray.Length - 1 do
    begin
      Name := Names.AsArray[idx].AsString;
      Item := Items.AsArray[idx];
      if Item.DataType = stObject then
        Value := '<Object>'
      else if Item.DataType = stArray then
        Value := '<Array>'
      else
        Value := Item.AsString;

      if SameText(Name, 'id') then
        WriteLn(Format('%s: %s', [aPrefix + Name, Value]));

      if Item.DataType = stArray then
        for ArrayItem in Item do
          ProcessObject(ArrayItem.AsObject, aPrefix + Name + '.');

      if Item.DataType = stObject then
        ProcessObject(Item.AsObject, aPrefix + Name + '.');
    end;
  end;
end;

procedure ParseJSON;

var

JSONText: string;

JSON: ISuperObject;

begin

// Retrieve JSON as a string into JSONText variable any way you like.

JSON := SO(JSONText);

ProcessObject(JSON.AsObject);

end;

procedure ProcessObject(const aAsObject: TSuperTableString; const aPrefix: string = '');

var

Names: ISuperObject;

Name: string;

Items: ISuperObject;

Item: ISuperObject;

idx: Integer;

Value: string;

ArrayItem: ISuperObject;

begin

if Assigned(aAsObject) then

begin

Names := aAsObject.GetNames;

Items := aAsObject.GetValues;

for idx := 0 to Items.AsArray.Length - 1 do

begin

Name := Names.AsArray[idx].AsString;

Item := Items.AsArray[idx];

if Item.DataType = stObject then

Value := '<Object>'

else if Item.DataType = stArray then

Value := '<Array>'

else

Value := Item.AsString;

if SameText(Name, 'id') then

WriteLn(Format('%s: %s', [aPrefix + Name, Value]));

if Item.DataType = stArray then

for ArrayItem in Item do

ProcessObject(ArrayItem.AsObject, aPrefix + Name + '.');

if Item.DataType = stObject then

ProcessObject(Item.AsObject, aPrefix + Name + '.');

end;

В моем исполнении это получилось вот так…

procedure TDecodePostRequest.ParseJson(const aAsObject: TSuperTableString; var postParams: TStringList);
//https://stackoverflow.com/questions/14082886/superobject-extract-all
var
  Names: ISuperObject;
  Name: string;
  Items: ISuperObject;
  Item: ISuperObject;
  idx: Integer;
  Value: string;
  ArrayItem: ISuperObject;
begin
  if Assigned(aAsObject) then
  begin
    Names := aAsObject.GetNames;
    Items := aAsObject.GetValues;

    for idx := 0 to Items.AsArray.Length - 1 do
    begin
      Name := Names.AsArray[idx].AsString;
      Item := Items.AsArray[idx];
      if Item.DataType = stObject then
        Value := '<Object>'
      else if Item.DataType = stArray then
        Value := '<Array>'
      else
        Value := Item.AsString;

      postParams.Add(Name + '=' + Value);

      //if SameText(Name, 'id') then
       // WriteLn(Format('%s: %s', [aPrefix + Name, Value]));

       {
      if Item.DataType = stArray then
        for ArrayItem in Item do
          ProcessObject(ArrayItem.AsObject, aPrefix + Name + '.');

      if Item.DataType = stObject then
        ProcessObject(Item.AsObject, aPrefix + Name + '.');
        }
    end;
  end;
end;

procedure TDecodePostRequest.ParseJson(const aAsObject: TSuperTableString; var postParams: TStringList);

//https://stackoverflow.com/questions/14082886/superobject-extract-all

var

Names: ISuperObject;

Name: string;

Items: ISuperObject;

Item: ISuperObject;

idx: Integer;

Value: string;

ArrayItem: ISuperObject;

begin

if Assigned(aAsObject) then

begin

Names := aAsObject.GetNames;

Items := aAsObject.GetValues;

for idx := 0 to Items.AsArray.Length - 1 do

begin

Name := Names.AsArray[idx].AsString;

Item := Items.AsArray[idx];

if Item.DataType = stObject then

Value := '<Object>'

else if Item.DataType = stArray then

Value := '<Array>'

else

Value := Item.AsString;

postParams.Add(Name + '=' + Value);

//if SameText(Name, 'id') then

// WriteLn(Format('%s: %s', [aPrefix + Name, Value]));

{

if Item.DataType = stArray then

for ArrayItem in Item do

ProcessObject(ArrayItem.AsObject, aPrefix + Name + '.');

if Item.DataType = stObject then

ProcessObject(Item.AsObject, aPrefix + Name + '.');

}

end;

Posted in Delphi | Leave a comment

Delphi. FireMonkey. Модальные окна

Posted on 28.06.2018 by Stanislav_Panteleev

В Android нет модальных окон, в Windows они есть. Обойти это можно так.

procedure TfrmParent.TestModalWindowClick(Sender: TObject);
var
  f: TForm1;
begin
  f := TForm1.Create(Self);
  f.ShowModal(procedure(ModalResult : TModalResult)
                begin
                  if ModalResult = mrOK then
                    // do something here
                end);
end;

procedure TfrmParent.TestModalWindowClick(Sender: TObject);

var

f: TForm1;

begin

f := TForm1.Create(Self);

f.ShowModal(procedure(ModalResult : TModalResult)

begin

if ModalResult = mrOK then

// do something here

end);

end;

Уничтожить форму можно в момент закрытия

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := TCloseAction.caFree;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Action := TCloseAction.caFree;

end;

Гениально и просто !) Взял отсюда

Posted in Delphi, FireMonkey | Leave a comment

Delphi. FireMonkey. Get IMEI

Posted on 24.06.2018 by Stanislav_Panteleev

Получение IMEI, пример работает на Delphi Berlin

function TSplashForm.GetIMEI: string;
var
obj: JObject;
tm: JTelephonyManager;
identifier: String;
begin
obj := SharedActivityContext.getSystemService(TJContext.JavaClass.TELEPHONY_SERVICE);
if obj <> nil then
begin
tm := TJTelephonyManager.Wrap( (obj as ILocalObject).GetObjectID );
if obj<>nil then
identifier := JStringToString(tm.getDeviceId);
end;
if identifier = '' then
identifier := JStringToString(TJSettings_Secure.JavaClass.getString(SharedActivity.getContentResolver,
TJSettings_Secure.JavaClass.ANDROID_ID));
result:=identifier;
end;

function TSplashForm.GetIMEI: string;

var

obj: JObject;

tm: JTelephonyManager;

identifier: String;

begin

obj := SharedActivityContext.getSystemService(TJContext.JavaClass.TELEPHONY_SERVICE);

if obj <> nil then

begin

tm := TJTelephonyManager.Wrap( (obj as ILocalObject).GetObjectID );

if obj<>nil then

identifier := JStringToString(tm.getDeviceId);

end;

if identifier = '' then

identifier := JStringToString(TJSettings_Secure.JavaClass.getString(SharedActivity.getContentResolver,

TJSettings_Secure.JavaClass.ANDROID_ID));

result:=identifier;

end;

Posted in Delphi, FireMonkey | Leave a comment

Delphi. FireMonkey. Настраиваем SDK, NDK, Java

Posted on 22.06.2018 by Stanislav_Panteleev

Пишу небольшое приложение на FireMonkey для Android, пару часов настраивал вкладку SDK Manager, скачивал SDK, NDK, JRE, выставлял пути сам пару часов, бился об ошибки, но Delphi оказался умнее, надо было просто нажать кнопку на Add и далее Delphi ищет … Continue reading →

Posted in Delphi, FireMonkey | Leave a comment

Delphi. WInAPI. Пример отправки сообщения из одного потока в другой

Posted on 08.06.2018 by Stanislav_Panteleev

Основной поток

unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
  Vcl.Buttons, uApiTestThread;

const
  WM_DATA_UPDATE = WM_APP + 1000;

type
  TMain = class(TForm)
    pTop: TPanel;
    bTest: TBitBtn;
    mAllTests: TMemo;
    mErrors: TMemo;
    procedure bTestClick(Sender: TObject);
  private
    { Private declarations }
    procedure HandleProc(var aMsg: TMessage); message WM_DATA_UPDATE;
  public
    { Public declarations }
  end;

var
  Main: TMain;

implementation

{$R *.dfm}

procedure TMain.bTestClick(Sender: TObject);
var
  t: TApiTestThread;
begin
  t := TApiTestThread.Create(true);
  t.MainHandle := Self.Handle;
  t.FreeOnTerminate := true;
  t.Start;
end;

procedure TMain.HandleProc(var aMsg: TMessage);
var
  txt: PWideChar;
begin
  txt := PWideChar(aMsg.lParam);
  mAllTests.Lines.Add(aMsg.WParam.ToString());
  mErrors.Lines.Add(txt);

end;

end.

unit uMain;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,

Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,

Vcl.Buttons, uApiTestThread;

const

WM_DATA_UPDATE = WM_APP + 1000;

type

TMain = class(TForm)

pTop: TPanel;

bTest: TBitBtn;

mAllTests: TMemo;

mErrors: TMemo;

procedure bTestClick(Sender: TObject);

private

{ Private declarations }

procedure HandleProc(var aMsg: TMessage); message WM_DATA_UPDATE;

public

{ Public declarations }

end;

var

Main: TMain;

implementation

{$R *.dfm}

procedure TMain.bTestClick(Sender: TObject);

var

t: TApiTestThread;

begin

t := TApiTestThread.Create(true);

t.MainHandle := Self.Handle;

t.FreeOnTerminate := true;

t.Start;

end;

procedure TMain.HandleProc(var aMsg: TMessage);

var

txt: PWideChar;

begin

txt := PWideChar(aMsg.lParam);

mAllTests.Lines.Add(aMsg.WParam.ToString());

mErrors.Lines.Add(txt);

end;

end.

Дополнительный поток

unit uApiTestThread;

interface

uses
  System.Classes, Winapi.Messages, Winapi.Windows;

const
  WM_DATA_UPDATE = WM_APP + 1000;

type
  TApiTestThread = class(TThread)
  private
    FMainHandle: Hwnd;
    procedure Test;
    procedure SetMainHandle(const Value: Hwnd);
    { Private declarations }
  public
    property MainHandle: Hwnd read FMainHandle write SetMainHandle;
  protected
    procedure Execute; override;
  end;

implementation

{
  Important: Methods and properties of objects in visual components can only be
  used in a method called using Synchronize, for example,

      Synchronize(UpdateCaption);

  and UpdateCaption could look like,

    procedure TApiTestThread.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end;

    or

    Synchronize(
      procedure
      begin
        Form1.Caption := 'Updated in thread via an anonymous method'
      end
      )
    );

  where an anonymous method is passed.

  Similarly, the developer can call the Queue method with similar parameters as
  above, instead passing another TThread class as the first parameter, putting
  the calling thread in a queue with the other thread.

}

{ TApiTestThread }

procedure TApiTestThread.SetMainHandle(const Value: Hwnd);
begin
  FMainHandle := Value;
end;

procedure TApiTestThread.Test();
var
  h: hwnd;
  s: string;
begin
  h := FMainHandle;
  s := 'Привет';
  Sendmessage(h, WM_DATA_UPDATE, 20, DWORD(PChar(s)));
end;

procedure TApiTestThread.Execute;
begin
  { Place thread code here }
  Test;
end;

end.

unit uApiTestThread;

interface

uses

System.Classes, Winapi.Messages, Winapi.Windows;

const

WM_DATA_UPDATE = WM_APP + 1000;

type

TApiTestThread = class(TThread)

private

FMainHandle: Hwnd;

procedure Test;

procedure SetMainHandle(const Value: Hwnd);

{ Private declarations }

public

property MainHandle: Hwnd read FMainHandle write SetMainHandle;

protected

procedure Execute; override;

end;

implementation

{

Important: Methods and properties of objects in visual components can only be

used in a method called using Synchronize, for example,

Synchronize(UpdateCaption);

and UpdateCaption could look like,

procedure TApiTestThread.UpdateCaption;

begin

Form1.Caption := 'Updated in a thread';

end;

Synchronize(

procedure

begin

Form1.Caption := 'Updated in thread via an anonymous method'

end

)

);

where an anonymous method is passed.

Similarly, the developer can call the Queue method with similar parameters as

above, instead passing another TThread class as the first parameter, putting

the calling thread in a queue with the other thread.

}

{ TApiTestThread }

procedure TApiTestThread.SetMainHandle(const Value: Hwnd);

begin

FMainHandle := Value;

end;

procedure TApiTestThread.Test();

var

h: hwnd;

s: string;

begin

h := FMainHandle;

s := 'Привет';

Sendmessage(h, WM_DATA_UPDATE, 20, DWORD(PChar(s)));

end;

procedure TApiTestThread.Execute;

begin

{ Place thread code here }

Test;

end;

end.

Posted in Delphi | Leave a comment

Delphi. Импорт данных в базу из Excel. Пример из проекта

Posted on 31.05.2018 by Stanislav_Panteleev

Пример из проекта – импорт данных в базу из Excel

procedure TRPAvitoImport.Execute;

  procedure parseParams(aParams: string; var aCategory: string; var aSubCategory: string);
  var
    sa, sa1, sa2: TArray<string>;
  begin
    sa := aParams.Split(['=']);
    if length(sa) > 1 then
      aCategory := stringReplace(sa[1], ', Тип услуги', '', [rfReplaceAll]);
    if length(sa) > 2 then
      aSubCategory := sa[2];
  end;

var
  e, sheet: OLEVariant;
  r: integer;
  c: integer;
  j: integer;
  i: Integer;
  rawPhone: string;
  contactName: string;
  regionName: string;
  cityName: string;
  adress: string;
  description: string;
  params: string;
  keywords: string;
  subCategoryName: string;
  categoryName: string;
  phone: string;
  idRegion: Integer;
  idCity: Integer;
  idCategory: integer;
  idUser: integer;
  currKeyWords: string;
  filePath: string;
  idSubCategory: Integer;
begin
  e := CreateOleObject('Excel.Application');
  e.DisplayAlerts := false; //отключаем запросы Excel
  e.Visible := false;
  filePath := 'avito_Orenburg_20180420.xls';
  if TFile.Exists(ExtractFilePath(Application.ExeName) + filePath) then
  begin
    e.Workbooks.Open(ExtractFilePath(Application.ExeName) + filePath);
    sheet := e.Workbooks[ExtractFileName(filePath)].WorkSheets[1];
    i := 2; // first row
    j := e.ActiveCell.SpecialCells(xlCellTypeLast).Row; // last row
    while i <> j do
    begin
      rawPhone := sheet.cells[i, 5];
      contactName := sheet.cells[i, 7];
      regionName := sheet.cells[i, 8];
      cityName := sheet.cells[i, 9];
      adress := sheet.cells[i, 12];
      description := sheet.cells[i, 13]; //users_has_categories
      keywords := sheet.cells[i, 3]; // users_has_categories
      params := sheet.cells[i, 18];
      parseParams(params, categoryName, subCategoryName);

      // ------------ INSERTION IN DB
        // --- region
      idRegion := getRegionID(regionName);
      if idRegion = -1 then
        idRegion := insertRegion(regionName);
       // --- city
      idCity := getCityID(cityName, idRegion);
      if idCity = -1 then
        idCity := insertCity(cityName, idRegion);
      // insert in users
      phone := TCommon.TryGetUserPhone(rawPhone);
      if (phone <> '') //
        then
      begin
        idUser := getUsersID(phone);
        if idUser = -1 then
        begin
          TCommon.InsertUser( //
            phone, //
            'password', //
            3, // aUserStatusCode // with status freezed
            2,  // aRoleCode
            contactName, //
            adress, //
            1, // Russia
            idRegion, //
            idCity); //
          idUser := db.GetLastID;
        end;
      end;
      // update user keyWords
      currKeyWords := GetUserKeyWords(idUser);
      if currKeyWords = '' then
        currKeyWords := keywords
      else
        currKeyWords := currKeyWords + ',' + keywords;
      UpdateUserKeyWords(idUser, currKeyWords);

      // insert in categories
      idCategory := getCategoryID(categoryName);
      if idCategory = -1 then
        idCategory := insertCategory(categoryName, '');
      //
      idSubCategory := getCategoryID(subCategoryName);
      if (subCategoryName <> '') and (idSubCategory = -1) then
        idSubCategory := insertCategory(subCategoryName, idCategory.toString);

      // insert in user_has_categories
      if GetUsersHasCategoriesID(idUser, idCategory) then
        UpdateUsersHasCategories(idUser, idCategory, description)
      else
        InsertUsersHasCategories(idUser, idCategory, description);

      inc(i);
    end;
  end;
  e.ActiveWorkBook.Close;
  e.Quit;
  e := Unassigned;
end;

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

procedure TRPAvitoImport.Execute;

procedure parseParams(aParams: string; var aCategory: string; var aSubCategory: string);

var

sa, sa1, sa2: TArray<string>;

begin

sa := aParams.Split(['=']);

if length(sa) > 1 then

aCategory := stringReplace(sa[1], ', Тип услуги', '', [rfReplaceAll]);

if length(sa) > 2 then

aSubCategory := sa[2];

end;

var

e, sheet: OLEVariant;

r: integer;

c: integer;

j: integer;

i: Integer;

rawPhone: string;

contactName: string;

regionName: string;

cityName: string;

adress: string;

description: string;

params: string;

keywords: string;

subCategoryName: string;

categoryName: string;

phone: string;

idRegion: Integer;

idCity: Integer;

idCategory: integer;

idUser: integer;

currKeyWords: string;

filePath: string;

idSubCategory: Integer;

begin

e := CreateOleObject('Excel.Application');

e.DisplayAlerts := false; //отключаем запросы Excel

e.Visible := false;

filePath := 'avito_Orenburg_20180420.xls';

if TFile.Exists(ExtractFilePath(Application.ExeName) + filePath) then

begin

e.Workbooks.Open(ExtractFilePath(Application.ExeName) + filePath);

sheet := e.Workbooks[ExtractFileName(filePath)].WorkSheets[1];

i := 2; // first row

j := e.ActiveCell.SpecialCells(xlCellTypeLast).Row; // last row

while i <> j do

begin

rawPhone := sheet.cells[i, 5];

contactName := sheet.cells[i, 7];

regionName := sheet.cells[i, 8];

cityName := sheet.cells[i, 9];

adress := sheet.cells[i, 12];

description := sheet.cells[i, 13]; //users_has_categories

keywords := sheet.cells[i, 3]; // users_has_categories

params := sheet.cells[i, 18];

parseParams(params, categoryName, subCategoryName);

// ------------ INSERTION IN DB

// --- region

idRegion := getRegionID(regionName);

if idRegion = -1 then

idRegion := insertRegion(regionName);

// --- city

idCity := getCityID(cityName, idRegion);

if idCity = -1 then

idCity := insertCity(cityName, idRegion);

// insert in users

phone := TCommon.TryGetUserPhone(rawPhone);

if (phone <> '') //

then

begin

idUser := getUsersID(phone);

if idUser = -1 then

begin

TCommon.InsertUser( //

phone, //

'password', //

3, // aUserStatusCode // with status freezed

2, // aRoleCode

contactName, //

adress, //

1, // Russia

idRegion, //

idCity); //

idUser := db.GetLastID;

end;

// update user keyWords

currKeyWords := GetUserKeyWords(idUser);

if currKeyWords = '' then

currKeyWords := keywords

else

currKeyWords := currKeyWords + ',' + keywords;

UpdateUserKeyWords(idUser, currKeyWords);

// insert in categories

idCategory := getCategoryID(categoryName);

if idCategory = -1 then

idCategory := insertCategory(categoryName, '');

idSubCategory := getCategoryID(subCategoryName);

if (subCategoryName <> '') and (idSubCategory = -1) then

idSubCategory := insertCategory(subCategoryName, idCategory.toString);

// insert in user_has_categories

if GetUsersHasCategoriesID(idUser, idCategory) then

UpdateUsersHasCategories(idUser, idCategory, description)

else

InsertUsersHasCategories(idUser, idCategory, description);

inc(i);

end;

e.ActiveWorkBook.Close;

e.Quit;

e := Unassigned;

end;

Posted in Delphi | Leave a comment

Delphi. SuperObject для json формата

Posted on 26.05.2018 by Stanislav_Panteleev

Перешел superobject библиотеку с System.Json и ощутил массу удобств. Работать с ней показалось на порядок проще! Чуть позже напишу развернутый пост, но пока зафиксирую ссылки, которые мне помогли с ней разобраться. https://github.com/hgourvest/superobject https://stackoverflow.com/questions/16790006/how-to-create-json-file-in-delphi-using-superobject-lib

Posted in Delphi | Leave a comment

Author Archives: Stanislav_Panteleev

Delphi. Firemonkey. Fatal error

C# Делегаты и события

Delphi. Firemonkey. Делаем круглое изображение наложением маски

Delphi. Json. Получение всей структуры ключей-значений

Delphi. FireMonkey. Модальные окна

Delphi. FireMonkey. Get IMEI

Delphi. FireMonkey. Настраиваем SDK, NDK, Java

Delphi. WInAPI. Пример отправки сообщения из одного потока в другой

Delphi. Импорт данных в базу из Excel. Пример из проекта

Delphi. SuperObject для json формата

MySQL WORLD

DELPHI WORLD

JS WORLD

PHP World

IIS World

C# WORLD

Recent Posts

Categories