>Digital-flame

Delphi. Отправка строки из одного потока в другой

Posted on 17.11.2018 by Stanislav_Panteleev

Простой пример, отправка из дополнительного потока в основной

Отправка…

const WM_WORK_TIME = WM_USER + 1000;
...
TThread.CreateAnonymousThread(
    procedure
    var
      s: string;
    begin
      s := DateTimeToStr(Now());
      PostMessage(Main.Handle, WM_WORK_TIME, 0, LParam(PChar(s)));
    end).Start;
...

const WM_WORK_TIME = WM_USER + 1000;

...

TThread.CreateAnonymousThread(

procedure

var

s: string;

begin

s := DateTimeToStr(Now());

PostMessage(Main.Handle, WM_WORK_TIME, 0, LParam(PChar(s)));

end).Start;

...

Прием

const
  WM_WORK_TIME = WM_USER + 1000;
  procedure UpdateWorkTime(var aMsg: TMessage); message WM_WORK_TIME;
...
procedure TMain.UpdateWorkTime(var aMsg: TMessage);
begin
  StatusBar.Panels[1].Text := PChar(aMsg.LParam);
end;
...

const

WM_WORK_TIME = WM_USER + 1000;

procedure UpdateWorkTime(var aMsg: TMessage); message WM_WORK_TIME;

...

procedure TMain.UpdateWorkTime(var aMsg: TMessage);

begin

StatusBar.Panels[1].Text := PChar(aMsg.LParam);

end;

...

Continue reading →

Posted in Без рубрики | Leave a comment

Delphi. RobustServer. Пишем мощный и надежный сервер на Indy

Posted on 11.11.2018 by Stanislav_Panteleev

На мой взгляд, более менее универсальная архитектура приложения выглядит так…

В этом и последующем постах будем писать мощный и надежный сервер. Это будет шаблон для будущих проектов. Стэк технологий у нас будет следующий

Delphi Seattle
MySQL
FireDAC
SuperObject
…

Ближайшие задачи

Создать архитектуру модулей, подключить к SVN или GIT, скорее всего второе, в public режиме
Авторизация запроса
Авторизация пользователя: одно и двухуровневая ( авторизацию через номер телефона можно сделать абстрактно, через интерфейс)
Система логгирования (скорее всего LDS Logger)
Пример буфера для высоконагруженных запросов
Тестер нагрузки для сервера
Загрузка файлов на сервер (возможно с интерфейсом проверки на вирусы)
Клиента для теста API (Веб и Windows)
Перевести запросы на HTTPs
Научиться переводить приложение из EXE в сервис Windows…
…

Остальные задачи для шаблона напишем по ходу дела…

Posted in Delphi | Leave a comment

Delphi. Потоки по книге Мартина Харви. Конспект

Posted on 11.11.2018 by Stanislav_Panteleev

Запуск потока

Примеры анонимных запусков

// Если нужно настраивать какие-то параметры проекта после его запуска
 t := TThread.CreateAnonymousThread(
    procedure
    var
      i: Integer;
    begin
      for i := 0 to 10 do
        Sleep(15);
    end).Start;
  t.FreeOnTerminate := true;
 ...
  // Если нужно настраивать какие-то параметры потока до его запуска...
  with TThread.CreateAnonymousThread(
    procedure
    var
      i: Integer;
    begin
      for i := 0 to 10 do
        Sleep(15);
    end) do
  begin
    FreeOnTerminate := true;
    Start;
  end;
...
// From StackOverflow - пример анонимного запуска с параметрами запускаемой процедуры
procedure DoSomething(const aWebAddress: String);
begin
end;
 
procedure BuildThread;
var
  myThread: TThread;
  fetchURL: string;
begin
  fetchURL := 'http://stackoverflow.com';
  // Create an anonymous thread that calls a method and passes in
  // the fetchURL to that method.
  myThread := TThread.CreateAnonymousThread(
    procedure
    begin
      DoSomething(fetchURL);
    end);
  ...
end;

// Если нужно настраивать какие-то параметры проекта после его запуска

t := TThread.CreateAnonymousThread(

procedure

var

i: Integer;

begin

for i := 0 to 10 do

Sleep(15);

end).Start;

t.FreeOnTerminate := true;

...

// Если нужно настраивать какие-то параметры потока до его запуска...

with TThread.CreateAnonymousThread(

procedure

var

i: Integer;

begin

for i := 0 to 10 do

Sleep(15);

end) do

begin

FreeOnTerminate := true;

Start;

end;

...

// From StackOverflow - пример анонимного запуска с параметрами запускаемой процедуры

procedure DoSomething(const aWebAddress: String);

begin

end;

procedure BuildThread;

var

myThread: TThread;

fetchURL: string;

begin

fetchURL := 'http://stackoverflow.com';

// Create an anonymous thread that calls a method and passes in

// the fetchURL to that method.

myThread := TThread.CreateAnonymousThread(

procedure

begin

DoSomething(fetchURL);

end);

...

end;

Традиционный запуск

...
with TTestThread.Create(true) do
  begin
    FreeOnTerminate := true;
    Start;
  end;
...

...

with TTestThread.Create(true) do

begin

FreeOnTerminate := true;

Start;

end;

...

Полный модуль традиционного запуска из Main

unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, //
  SyncObjs //
;

const
  WM_DATA_IN_BUF = WM_APP + 1000;

type
  TMain = class(TForm)
    bStart: TButton;
    procedure bStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FBuffer: TStringList;
    FCS: TCriticalSection;
    procedure HandleBuffer(var aMessage: TMessage); message WM_DATA_IN_BUF;
    procedure SetBuffer(const Value: TStringList);
    procedure SetCS(const Value: TCriticalSection);
    { Private declarations }
  public
    { Public declarations }
    property Buffer: TStringList read FBuffer write SetBuffer;
    property CS: TCriticalSection read FCS write SetCS;
  end;

var
  Main: TMain;

implementation

{$R *.dfm}
uses
  uTestThread;

procedure TMain.bStartClick(Sender: TObject);
begin
  with TTestThread.Create(true) do
  begin
    FreeOnTerminate := true;
    Start;
  end;
end;

procedure TMain.HandleBuffer(var aMessage: TMessage);
begin
  FCS.Enter;
  Caption := FBuffer.Text;
  FCS.Leave;
end;


procedure TMain.SetBuffer(const Value: TStringList);
begin
  FBuffer := Value;
end;

procedure TMain.SetCS(const Value: TCriticalSection);
begin
  FCS := Value;
end;

procedure TMain.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutdown := true;
  FCS := TCriticalSection.Create;
  FBuffer := TStringList.Create;
end;

procedure TMain.FormDestroy(Sender: TObject);
begin
  FCS.Free();
  FBuffer.Free;
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.StdCtrls, //

SyncObjs //

;

const

WM_DATA_IN_BUF = WM_APP + 1000;

type

TMain = class(TForm)

bStart: TButton;

procedure bStartClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

FBuffer: TStringList;

FCS: TCriticalSection;

procedure HandleBuffer(var aMessage: TMessage); message WM_DATA_IN_BUF;

procedure SetBuffer(const Value: TStringList);

procedure SetCS(const Value: TCriticalSection);

{ Private declarations }

public

{ Public declarations }

property Buffer: TStringList read FBuffer write SetBuffer;

property CS: TCriticalSection read FCS write SetCS;

end;

var

Main: TMain;

implementation

{$R *.dfm}

uses

uTestThread;

procedure TMain.bStartClick(Sender: TObject);

begin

with TTestThread.Create(true) do

begin

FreeOnTerminate := true;

Start;

end;

procedure TMain.HandleBuffer(var aMessage: TMessage);

begin

FCS.Enter;

Caption := FBuffer.Text;

FCS.Leave;

end;

procedure TMain.SetBuffer(const Value: TStringList);

begin

FBuffer := Value;

end;

procedure TMain.SetCS(const Value: TCriticalSection);

begin

FCS := Value;

end;

procedure TMain.FormCreate(Sender: TObject);

begin

ReportMemoryLeaksOnShutdown := true;

FCS := TCriticalSection.Create;

FBuffer := TStringList.Create;

end;

procedure TMain.FormDestroy(Sender: TObject);

begin

FCS.Free();

FBuffer.Free;

end;

end.

С объявлением класса потока, например так…

unit uTestThread;

interface

uses
  System.Classes, SyncObjs, SysUtils;

type
  TTestThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  public
  end;

implementation

{ TTestThread }

uses
  uMain, Winapi.Windows;

procedure TTestThread.Execute;
var
  i, j: Integer;
begin
  if Assigned(Main.CS) then
  begin
    for i := 0 to 5 do
    begin
      Main.CS.Enter;
      Main.Buffer.Add(intToStr(i));
      Main.CS.Leave;
      Sleep(1000);
      PostMessage(Main.Handle, WM_DATA_IN_BUF, 0, 0);
    end;
  end;
end;

end.

unit uTestThread;

interface

uses

System.Classes, SyncObjs, SysUtils;

type

TTestThread = class(TThread)

private

{ Private declarations }

protected

procedure Execute; override;

public

end;

implementation

{ TTestThread }

uses

uMain, Winapi.Windows;

procedure TTestThread.Execute;

var

i, j: Integer;

begin

if Assigned(Main.CS) then

begin

for i := 0 to 5 do

begin

Main.CS.Enter;

Main.Buffer.Add(intToStr(i));

Main.CS.Leave;

Sleep(1000);

PostMessage(Main.Handle, WM_DATA_IN_BUF, 0, 0);

end;

end.

Флаг Terminated для потока

Досрочная остановка потока
В некоторых ситуациях одному потоку может потребоваться уведомить
другой поток о своем завершении. Это обычно происходит, когда поток
выполняет длительную операцию, и пользователь решает выйти из
приложения, или операция должна быть прервана. TThread обеспечивает
простой механизм для поддержки таких действий, а именно, метод
Terminate и свойство Terminated. Когда поток создается, свойство
Terminated установлено в False, а всякий раз, когда вызывается метод
Terminate, свойство Terminated для этого потока устанавливается в True.
Таким образом, на всех потоках лежит ответственность за периодическую
проверку, не были ли они остановлены, и если это случается, за
корректное завершение своей работы. Заметьте, что никакой
крупномасштабной синхронизации при этом не происходит: когда один
поток устанавливает свойство Terminated другого, нельзя предполагать,
что другой поток тут же прочитает значение своего свойства Terminated и
начнет процесс завершения. Свойство Terminated является просто флагом,
говорящим “пожалуйста, завершайся как можно скорее”.

Continue reading →

Posted in Без рубрики | Leave a comment

Delphi. Запуск анонимного потока

Posted on 11.11.2018 by Stanislav_Panteleev

Увидел в блоге следующий пример, по-моему оч. удобно для каких-то простых случаев….

TThread.CreateAnonymousThread(
          procedure   
          begin
            // do smth...
          end).Start;

TThread.CreateAnonymousThread(

procedure

begin

// do smth...

end).Start;

Немного модифицировал

 // Если нужно настраивать какие-то параметры проекта после его запуска
 t := TThread.CreateAnonymousThread(
    procedure
    var
      i: Integer;
    begin
      for i := 0 to 10 do
        Sleep(15);
    end).Start;
  t.FreeOnTerminate := true;

  // Если нужно настраивать какие-то параметры потока до его запуска...
  with TThread.CreateAnonymousThread(
    procedure
    var
      i: Integer;
    begin
      for i := 0 to 10 do
        Sleep(15);
    end) do
  begin
    FreeOnTerminate := true;
    Start;
  end;
e

// Если нужно настраивать какие-то параметры проекта после его запуска

t := TThread.CreateAnonymousThread(

procedure

var

i: Integer;

begin

for i := 0 to 10 do

Sleep(15);

end).Start;

t.FreeOnTerminate := true;

// Если нужно настраивать какие-то параметры потока до его запуска...

with TThread.CreateAnonymousThread(

procedure

var

i: Integer;

begin

for i := 0 to 10 do

Sleep(15);

end) do

begin

FreeOnTerminate := true;

Start;

end;

Со StackOverflow, в тему, запуск анонимного потока процедуры с параметрами

procedure DoSomething(const aWebAddress: String);
begin
end;

procedure BuildThread;
var
  myThread: TThread;
  fetchURL: string;
begin
  fetchURL := 'http://stackoverflow.com';
  // Create an anonymous thread that calls a method and passes in
  // the fetchURL to that method.
  myThread := TThread.CreateAnonymousThread(
    procedure
    begin
      DoSomething(fetchURL);
    end);
  ...
end;

procedure DoSomething(const aWebAddress: String);

begin

end;

procedure BuildThread;

var

myThread: TThread;

fetchURL: string;

begin

fetchURL := 'http://stackoverflow.com';

// Create an anonymous thread that calls a method and passes in

// the fetchURL to that method.

myThread := TThread.CreateAnonymousThread(

procedure

begin

DoSomething(fetchURL);

end);

...

end;

Posted in Delphi | Leave a comment

Delphi. Поиск имени свойства в объектном инспекторе

Posted on 10.11.2018 by Stanislav_Panteleev

В Seattle привык пользоваться фильтром по свойствам, но в XE4, например такого фильтра нет. Как быть? Открыл для себя

“Тык на любом свойстве в объектном инспекторе”

“Жмем Tab”

“Начинаем печатать имя свойства, например Name”

При этом, если свойство находится в другом свойстве, то оно не найдется.

Более подробно на сайте Эмбы )

Posted in Без рубрики | Leave a comment

Delphi – методы уничтожения объекта

Posted on 30.10.2018 by Stanislav_Panteleev

Небольшая заметка по книге Delphi Memory Management.

Ниже перечислены методы освобождения объектов при ручном управлении памятью. Continue reading →

Posted in Без рубрики | Leave a comment

Delphi. “Nullable” Post by Allen Bauer

Posted on 30.10.2018 by Stanislav_Panteleev

В Delphi вроде как нет Nullable типов, но если нет, но очень хочется, то они могут появиться ))) Читал книгу Delphi Memory Management, и там наткнулся на раздел про Nullable, автор книги ссылался на MVP Allen Bauer.

Идея проста…

To implement a nullable type, we need to create a wrapper around a value type and add an
undefined flag. That part can be easily achieved with a generic record storing our wrapped
Value and HasValue flag.

А вот и первоисточник…

Класс Nullable Continue reading →

Posted in Delphi | Leave a comment

Delphi. ARC. Основные моменты

Posted on 30.10.2018 by Stanislav_Panteleev

Читаю книгу Delphi Memory Management, делаю небольшой конспект основных моментов. Учился под музыку Emy Care Read my Mind

Automatic Reference Counting – система, в которой использование каждого объекта отслеживается по ссылкам на него. Что это дает? Простоту кодирования. Например, мы можем писать так…

var
sl: ISmartPointer<TStringList>;
begin
sl := TSmartPointer<TStringList>.Create();
sl.Add('I am inside automanaged StringList');
end;

var

sl: ISmartPointer<TStringList>;

begin

sl := TSmartPointer<TStringList>.Create();

sl.Add('I am inside automanaged StringList');

end;

Вместо традиционного…

var
sl: TStringList;
begin
sl := TStringList.Create;
try
sl.Add('I am inside regular StringList');
finally
sl.Free;
end;
end;

var

sl: TStringList;

begin

sl := TStringList.Create;

try

sl.Add('I am inside regular StringList');

finally

sl.Free;

end;

Но когда же уничтожается объект? В момент, когда число ссылок на него станет равным нулю.

Золотое правило ARC Continue reading →

Posted in Без рубрики | Leave a comment

Delphi. SmartPointers – меньше кода больше дела

Posted on 30.10.2018 by Stanislav_Panteleev

Читая Delphi Memory Management, открыл для себя SmartPointers. Подход, основанный на ARC, позволяет, применяя данный класс писать меньше кода, заниматься больше делом, сосредоточиться на бизнес-задаче.

unit uSmartPointer;

interface

type
  ISmartPointer<T> = reference to function: T;

  TSmartPointer<T: class, constructor> = class(TInterfacedObject, ISmartPointer<T>)
  private
    FValue: T;
    function Invoke: T;
    procedure SetValue(const Value: T);
  public
    constructor Create; overload;
    constructor Create(AValue: T); overload;
    destructor Destroy; override;
    function Extract: T;
    property Value: T read FValue write SetValue;
  end;

implementation

constructor TSmartPointer<T>.Create;
begin
  inherited Create;
  FValue := T.Create;
end;

constructor TSmartPointer<T>.Create(AValue: T);
begin
  inherited Create;
  FValue := AValue;
end;

destructor TSmartPointer<T>.Destroy;
begin
  FValue.Free;
  inherited;
end;

function TSmartPointer<T>.Invoke: T;
begin
  Result := FValue;
end;

procedure TSmartPointer<T>.SetValue(const Value: T);
begin
  FValue := Value;
end;

function TSmartPointer<T>.Extract: T;
begin
  Result := FValue;
  FValue := nil;
end;

end.

unit uSmartPointer;

interface

type

ISmartPointer<T> = reference to function: T;

TSmartPointer<T: class, constructor> = class(TInterfacedObject, ISmartPointer<T>)

private

FValue: T;

function Invoke: T;

procedure SetValue(const Value: T);

public

constructor Create; overload;

constructor Create(AValue: T); overload;

destructor Destroy; override;

function Extract: T;

property Value: T read FValue write SetValue;

end;

implementation

constructor TSmartPointer<T>.Create;

begin

inherited Create;

FValue := T.Create;

end;

constructor TSmartPointer<T>.Create(AValue: T);

begin

inherited Create;

FValue := AValue;

end;

destructor TSmartPointer<T>.Destroy;

begin

FValue.Free;

inherited;

end;

function TSmartPointer<T>.Invoke: T;

begin

Result := FValue;

end;

procedure TSmartPointer<T>.SetValue(const Value: T);

begin

FValue := Value;

end;

function TSmartPointer<T>.Extract: T;

begin

Result := FValue;

FValue := nil;

end;

end.

Теперь можно писать так…

var
sl: ISmartPointer<TStringList>;
begin
sl := TSmartPointer<TStringList>.Create();
sl.Add('I am inside automanaged StringList');
end;

var

sl: ISmartPointer<TStringList>;

begin

sl := TSmartPointer<TStringList>.Create();

sl.Add('I am inside automanaged StringList');

end;

Вместо… Continue reading →

Posted in Delphi | Leave a comment

Delphi. Memory Management. Book

Posted on 27.10.2018 by Stanislav_Panteleev

Купил сегодня книгу по управлению памятью в Delphi. Понравилось содержание, хочу углубить свои знания в этом вопросе.

А вот и содержание на английском… Continue reading →

Posted in Delphi | Leave a comment

Delphi. Отправка строки из одного потока в другой

Delphi. RobustServer. Пишем мощный и надежный сервер на Indy

Ближайшие задачи

Delphi. Потоки по книге Мартина Харви. Конспект

Запуск потока

Флаг Terminated для потока

Delphi. Запуск анонимного потока

Delphi. Поиск имени свойства в объектном инспекторе

Delphi – методы уничтожения объекта

Delphi. “Nullable” Post by Allen Bauer

Delphi. ARC. Основные моменты

Delphi. SmartPointers – меньше кода больше дела

Delphi. Memory Management. Book

MY PROJECTS

DELPHI WORLD

C# WORLD

MySQL WORLD

JS WORLD

PHP World

IIS World

Recent Posts

Categories