Multithread application ile çözüm üretmek

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Cevapla
Lord_Ares
Üye
Mesajlar: 1070
Kayıt: 15 Eki 2006 04:33
Konum: Çorlu

Re: Multithread application ile çözüm üretmek

Mesaj gönderen Lord_Ares »

fatihbarut yazdı: 08 Oca 2018 05:40 basit ve güzel bir anlatım
https://www.youtube.com/watch?v=uLt-Tw-OA1I
Teşekkürler , gerçekten de güzel anlatmış.
Kullanıcı avatarı
Opt2000
Üye
Mesajlar: 216
Kayıt: 09 Tem 2003 10:04

Re: Multithread application ile çözüm üretmek

Mesaj gönderen Opt2000 »

Maalesef çok da yanlış anlatmış. VCL bileşenler thread safe değildir ve ayrı bir thread içinden VCL bileşenlerine direkt erişmek YANLIŞTIR. Bu yanlışlık yoruma açık değil, teknik bir yanlışlıktır. Eğer threadlerle ilgili düzgün Türkçe doküman arıyorsanız http://www.tugrulhelvaci.com/ adresindeki Thread etiketli yazılara bakabilirsiniz.

İyi çalışmalar
Kullanıcı avatarı
SimaWB
Üye
Mesajlar: 1316
Kayıt: 07 May 2009 10:42
Konum: İstanbul
İletişim:

Re: Multithread application ile çözüm üretmek

Mesaj gönderen SimaWB »

MultiThread çalışmanın en büyük zorluğu da budur zaten:
Kodunuzu derlerken sorun olmaz.
Onlarca kez çalıştırırsınız sorun olmaz.
Ama bir bakmışsınız "bazı" müşterilerde "bazen" sorun çıkar.
Bizler doğal olarak sorunu işletim sisteminde, donanımda vs. ararız. Çünkü aynı yazılım bir sürü yerde sorunsuz çalışmaktadır.
Fakat sorunun kaynağı "thread safe" kod yazmamaktır.
There's no place like 127.0.0.1
ertank
Kıdemli Üye
Mesajlar: 1650
Kayıt: 12 Eyl 2015 12:45

Re: Multithread application ile çözüm üretmek

Mesaj gönderen ertank »

fatihbarut yazdı: 10 Oca 2018 12:08 denedim, (TThread.Queue) ve (TThread.Synchronize) kullanmasam da VCL erişimi sırasında görünürde sorun yaratmadı.
Yazdığınız kodu paylaşabilir misiniz?
ertank
Kıdemli Üye
Mesajlar: 1650
Kayıt: 12 Eyl 2015 12:45

Re: Multithread application ile çözüm üretmek

Mesaj gönderen ertank »

Thread çağırmak için kullandığınız kodu da paylaşabilir misiniz?
ertank
Kıdemli Üye
Mesajlar: 1650
Kayıt: 12 Eyl 2015 12:45

Re: Multithread application ile çözüm üretmek

Mesaj gönderen ertank »

Özetle TThread kullanımı ile ilgili aşağıdaki kuralları çiğnemişsiniz.
1- Her bir thread içinde kullanılacak database bağlantısı ayrı olmalıdır. Başka bir deyişle form üzerindeki AdoConnection nesnesini thread içinde kullanamazsınız. Aksi takdirde öngörülmemiş sorunlar ile karşılaşabilirsiniz. En basiti dead-lock olabilir.
2- Thread içinde GUI (grafiksel bileşenler, buton, memo, edit, vb) ile ilgili işlem yapılamaz. Bu kuralı Microsoft firması koymuştur. Delphi veya Visual Studio için veya Java için bu kural aynen geçerlidir.

Bunlar dışında, Memo bileşeni içine bir bilgi yazdıktan sonra anında ekranda görünmesini istiyorsanız

Kod: Tümünü seç

Application.ProcessMessages;
kullanmayın. Bunun yerine basitçe Memo bileşeninin Update veya Refresh prosedürlerini kullanın.

Kod: Tümünü seç

MemoLog.Update();
// veya
MemoLog.Refresh();
Mutlaka TThread kullanmak istiyor iseniz, aşağıdaki şekilde kullanmanız mümkün olabilir. Birçok bilinmeyen bilgi olduğu için kod test edilmemiştir. Kod ve form Delphi 10.2.2 ile sorunsuz derlenmektedir.
UNIT:

Kod: Tümünü seç

unit Unit1;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  IdBaseComponent,
  IdComponent,
  IdTCPConnection,
  IdTCPClient,
  IdExplicitTLSClientServerBase,
  IdMessageClient,
  IdSMTPBase,
  IdSMTP,
  IdSSLOpenSSL,
  IdMessage,
  IdAttachment,
  IdAttachmentFile,
  Data.DB,
  Data.Win.ADODB,
  Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    btnStart: TButton;
    MemoLog: TMemo;
    procedure btnStartClick(Sender: TObject);
  private
    { Private declarations }
    procedure ThreadUpdate(Sender: TObject; const Value: string);
    procedure ThreadError(Sender: TObject);
  public
    { Public declarations }
  end;



type
  TSendMailThreadUpdateEvent = procedure(Sender: TObject; const Text: string) of object;
  TSendMailThreadErrorEvent = procedure(Sender: TObject) of object;

type
  TSendMail= class(TThread)
  private
    FAdoConnection: TAdoConnection;
    FAdoQuery: TAdoQuery;
    FIdSMTP: TIdSMTP;
    FIdMessage: TIdMessage;
    FIdAttachment: TIdAttachment;
    FIdSSLIOHandlerSocket: TIdSSLIOHandlerSocketOpenSSL;
    FOnUpdate: TSendMailThreadUpdateEvent;
    FOnError: TSendMailThreadErrorEvent;
    FConnectionString: string;
    FQuerySQL: string;
    FBackupFileName: string;
    FZipFileName: string;
    FSenderName: string;
    FSenderEmail: string;
    FRecipientEmail: string;
    FSmtpServer: string;
    FSmtpUsername: string;
    FSmtpPassword: string;
    FMailBody: string;
    FLastError: string;
    FSmtpPort: Word;
    FTag: Integer;
    FStatus: string;
    procedure DoUpdate();
    procedure DoError();
    function DoConnection(): Boolean;
    function RunQuery(): Boolean;
    function PrepareZipFile(): Boolean;
    function GetFileSize(const FileName: string): UInt64;
  protected
    procedure Execute(); override;
  public
    constructor Create(); reintroduce; overload;
    destructor Destroy(); override;
    property ConnectionString: string read FConnectionString write FConnectionString;
    property QuerySQL: string read FQuerySQL write FQuerySQL;
    property OnUpdate: TSendMailThreadUpdateEvent read FOnUpdate write FOnUpdate;
    property OnError: TSendMailThreadErrorEvent read FOnError write FOnError;
    property SenderName: string read FSenderName write FSenderName;
    property SenderEmail: string read FSenderEmail write FSenderEmail;
    property MailBody: string read FMailBody write FMailBody;
    property LastError: string read FLastError;
    property Status: string read FStatus;
    property Tag: Integer read FTag write FTag;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  Zip;

  { TSendMail }

//------------------------------------------------------------------------------
constructor TSendMail.Create();
begin
  inherited Create(True);
  FreeOnTerminate := True;
  FAdoConnection := TADOConnection.Create(nil);
  FAdoQuery := TADOQuery.Create(nil);
  FAdoQuery.Connection := FAdoConnection;
  FIdSMTP := TIdSMTP.Create(nil);
  FIdMessage := TIdMessage.Create(nil);
  FIdSSLIOHandlerSocket := TIdSSLIOHandlerSocketOpenSSL.Create(FIdSMTP);
  FTag := 0;
  FStatus := EmptyStr;
  FLastError := EmptyStr;
end;


//------------------------------------------------------------------------------
destructor TSendMail.Destroy();
begin
  FIdSMTP.Free();
  FIdMessage.Free();
  FAdoQuery.Close();
  FAdoQuery.Free();
  FAdoConnection.Close();
  FAdoConnection.Free();

  inherited;
end;


//------------------------------------------------------------------------------
procedure TSendMail.DoUpdate();
begin
  if Assigned(FOnUpdate) then
    FOnUpdate(Self, FStatus);
end;


//------------------------------------------------------------------------------
procedure TSendMail.DoError();
begin
  if Assigned(FOnError) then
    FOnUpdate(Self, FStatus);
end;


//------------------------------------------------------------------------------
function TSendMail.DoConnection(): Boolean;
begin
  FAdoConnection.ConnectionString := FConnectionString;
  try
    FAdoConnection.Open();
  except
    on E: Exception do
    begin
      FStatus := 'Database connection failed';
      FLastError := E.Message;
      if Assigned(FOnError) then DoError();
      Result := False;
      Exit();
    end;
  end;
  Result := FAdoConnection.Connected;
end;


//------------------------------------------------------------------------------
function TSendMail.RunQuery(): Boolean;
begin
  FAdoQuery.SQL.Text := FQuerySQL;
  try
    FAdoQuery.Open();
  except
    on E: Exception do
    begin
      FStatus := 'Cannot run SQL';
      FLastError := E.Message;
      if Assigned(FOnError) then DoError();
      Result := False;
      Exit();
    end;
  end;
  Result := FAdoQuery.Active;
  if Result then Result := FAdoQuery.IsEmpty;
end;


//------------------------------------------------------------------------------
function TSendMail.PrepareZipFile(): Boolean;
var
  Zip: TZipFile;
begin
  FBackupFileName := FAdoQuery.FieldByName('BackupFolder').AsString +
                     '\' +
                     FAdoQuery.FieldByName('BackupName').AsString + '-' +
                     FormatDateTime('yyyy-mm-dd_hh.nn', now()) +
                     '.sql';
  FZipFileName := ChangeFileExt(FBackupFileName, '.zip');
  FSmtpServer := FAdoQuery.FieldByName('ServerName').AsString;
  FSmtpPort := FAdoQuery.FieldByName('Port').AsInteger;
  FSmtpUsername := FAdoQuery.FieldByName('User').AsString;
  FSmtpPassword := FAdoQuery.FieldByName('PW').AsString;

  Zip := TZipFile.Create();
  try
    Zip.Open(FZipFileName, zmWrite);
    try
      try
        Zip.Add(FBackupFileName);
      except
        on E: Exception do
        begin
          FStatus := 'Database compression failed';
          FLastError := E.Message;
          if Assigned(FOnError) then DoError();
          Result := False;
          Exit();
        end;
      end;
    finally
      Zip.Close();
    end;
  finally
    Zip.Free();
  end;

  FRecipientEmail := FAdoQuery.FieldByName('email').AsString;

  Result := True;
end;


//------------------------------------------------------------------------------
function TSendMail.GetFileSize(const FileName: string): UInt64;
var
  F: File;
begin
  AssignFile(F, FileName);
  {$I-}
  Reset(F);
  if IOResult <> 0 then 
  begin
    FLastError := 'IOError: ' + IntToStr(IOResult);
    FStatus := 'Could not determine size of compressed file';
    if Assigned(FOnError) then DoError();
  end;
  Result := FileSize(F);
  CloseFile(F);
  {$I+}
end;


//------------------------------------------------------------------------------
procedure TSendMail.Execute();
var
  CalculatedFileSize: UInt64;
begin
  if not DoConnection() then Exit();
  if not RunQuery() then Exit();
  if not PrepareZipFile() then Exit();

  CalculatedFileSize := GetFileSize(FZipFileName);
  if CalculatedFileSize >= (25 * 1024 * 1024) then
  begin
    FStatus := 'Compressed file size exceeds 25MB in size: ' + IntToStr(CalculatedFileSize) + ' byte(s)';
    if Assigned(FOnUpdate) then DoUpdate();
    Exit();
  end;

  FStatus := 'Starting SMTP delivery';
  if Assigned(FOnUpdate) then DoUpdate();
  
  FIdMessage.MessageParts.Clear();
  FIdMessage.Subject      := 'DB Backup ' + FIdSMTP.Host + ' ' + FBackupFileName;
  FIdMessage.From.Name    := FSenderName;
  FIdMessage.From.Address := FSenderEmail;
  FIdMessage.Recipients.EMailAddresses := FRecipientEmail;
  FIdMessage.Body.Text := FMailBody;

  FIdMessage.CharSet := 'utf-8';
  FIdMessage.AttachmentEncoding := 'MIME';
  FIdMessage.Encoding  := meMIME;
  FIdMessage.NoEncode  := False;
  FIdMessage.NoDecode  := False;
  FIdMessage.IsEncoded := True;
  FIdAttachment := TIdAttachmentFile.Create(FIdMessage.MessageParts, FZipFileName);

  FIdSSLIOHandlerSocket.SSLOptions.Method      := sslvTLSv1_2;
  FIdSSLIOHandlerSocket.SSLOptions.SSLVersions := [sslvTLSv1_2];
  FIdSSLIOHandlerSocket.SSLOptions.Mode        := sslmUnassigned;
  FIdSSLIOHandlerSocket.PassThrough            := False;

  FIdSMTP.IOHandler := FIdSSLIOHandlerSocket;
  FIdSMTP.UseTLS    := utUseRequireTLS;
  FIdSMTP.AuthType  := satDefault;
  FIdSMTP.Host      := FSmtpServer;
  FIdSMTP.Port      := FSmtpPort;
  FIdSMTP.Username  := FSmtpUsername;
  FIdSMTP.Password  := FSmtpPassword;

  FLastError := EmptyStr; // Starting operation

  if Terminated then
  begin
    if Assigned(FOnUpdate) then Synchronize(DoUpdate);
    Exit();
  end;

  // Connect
  try
    FIdSMTP.Connect();
  except
    on E: Exception do
    begin
      FLastError := E.Message;
    end;
  end;

  if Terminated then
  begin
    if FLastError = EmptyStr then FStatus := 'Connected';
    if Assigned(FOnUpdate) then Synchronize(DoUpdate);
    Exit();
  end;

  // Authenticate
  try
    FIdSMTP.Authenticate();
  except
    on E: Exception do
    begin
      FLastError := E.Message;
      if Assigned(FOnError) then DoError();
    end;
  end;

  if Terminated then
  begin
    if FLastError = EmptyStr then FStatus := 'Authenticated';
    if Assigned(FOnUpdate) then Synchronize(DoUpdate);
    Exit();
  end;

  // Send the e-mail
  if FLastError = EmptyStr then
  begin
    try
      FIdSMTP.Send(FIdMessage);
    except
      on E: Exception do
      begin
        FLastError := E.Message;
        if Assigned(FOnError) then DoError();
      end;
    end;
  end;

  if Terminated then
  begin
    if FLastError = EmptyStr then FStatus := 'Email delivered';
    if Assigned(FOnUpdate) then Synchronize(DoUpdate);
    Exit();
  end;

  // Disconnect
  if FLastError = EmptyStr then
  begin
    try
      if FIdSMTP.Connected() then FIdSMTP.Disconnect();
    except
      on E: Exception do
      begin
        FLastError := E.Message;
        if Assigned(FOnError) then DoError();
      end;
    end;
  end;

  if FLastError = EmptyStr then
  begin
    FStatus := 'Disconnected';
    if Assigned(FOnUpdate) then Synchronize(DoUpdate);
  end;

  FAdoQuery.Delete();
end;


  { TForm1 }


//------------------------------------------------------------------------------
procedure TForm1.btnStartClick(Sender: TObject);
var
  MailThread: TSendMail;
begin
  MailThread := TSendMail.Create();
  MailThread.OnUpdate := ThreadUpdate;
  MailThread.OnError := ThreadError;
  MailThread.ConnectionString := '';
  MailThread.QuerySQL := 'select * from ...';
  MailThread.SenderName := 'MyBackup';
  MailThread.SenderEmail := 'xxx@gmail.com';
  MailThread.MailBody := 'This email contains backed up and zipped db as attachment';
  MailThread.Start();
end;


//------------------------------------------------------------------------------
procedure TForm1.ThreadUpdate(Sender: TObject; const Value: string);
begin
  MemoLog.Lines.Add(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz   ', Now()) + Value);
  MemoLog.Refresh();
end;


//------------------------------------------------------------------------------
procedure TForm1.ThreadError(Sender: TObject);
begin
  MemoLog.Lines.Add(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz   ***ERROR: ', Now()) + TSendMail(Sender).LastError);
  MemoLog.Refresh();
  ShowMessage(TSendMail(Sender).LastError);
end;

end.
FORM:

Kod: Tümünü seç

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 201
  ClientWidth = 447
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object btnStart: TButton
    Left = 0
    Top = 0
    Width = 447
    Height = 65
    Align = alTop
    Caption = 'Start Backup'
    TabOrder = 0
    OnClick = btnStartClick
    ExplicitLeft = 8
    ExplicitTop = 8
    ExplicitWidth = 113
  end
  object MemoLog: TMemo
    Left = 0
    Top = 65
    Width = 447
    Height = 136
    Align = alClient
    Lines.Strings = (
      'MemoLog')
    TabOrder = 1
    ExplicitLeft = 136
    ExplicitTop = 80
    ExplicitWidth = 185
    ExplicitHeight = 89
  end
end
Göreceğiniz üzere Thread kullanımı sizin yazdığınız koda göre çok ciddi farklılıklar göstermektedir. Bu sebeple kurallarına uymadan kullanım şu anda çalışır gibi gözüken kodun daha sonra sebebi çok zor tespit edilebilecek anlamsız hatalara sebep olabilir.

Yazdığınız kodun çalışması tamamen şans eseridir.

Alternatif bir yöntem olarak ayrı bir uygula geliştirerek gerekli bilgileri parametre/ini dosyası vb yöntem ile bu uygulamaya bildirip ana uygulamanızdan yedekleme alacak diğer uygulamayı çağırabilirsiniz. Bu durumda yedek uygulamasında donmalar olacağı kabul edilip arka planda çalışması için bırakılır. Sizin esas uygulamanız normal şekilde çalışmaya devam edebilir.
Kullanıcı avatarı
sabanakman
Kıdemli Üye
Mesajlar: 3077
Kayıt: 17 Nis 2006 08:11
Konum: Ah bi Antalya olaydı keşke (Ankara)

Re: Multithread application ile çözüm üretmek

Mesaj gönderen sabanakman »

VCL bir kenara, ortak bir değişkene farklı kanallardan erişirken bile sorun çıkabilmektedir. Örnektekine benzer bir önlem almak bazı sorunları çözebilir..: https://stackoverflow.com/questions/197 ... 1#19703381
Şaban Şahin AKMAN
_________________
Derin olan kuyu değil kısa olan iptir. - .
thelvaci
Kıdemli Üye
Mesajlar: 770
Kayıt: 11 Tem 2010 07:17
Konum: Istanbul
İletişim:

Re: Multithread application ile çözüm üretmek

Mesaj gönderen thelvaci »

Yani yazdığımız onca makale, onca cevap hiç bir işe yaramamış mı :(

Arkadaşlar, Allah'ın rızası için lütfen biraz okuyun.
thelvaci
Kıdemli Üye
Mesajlar: 770
Kayıt: 11 Tem 2010 07:17
Konum: Istanbul
İletişim:

Re: Multithread application ile çözüm üretmek

Mesaj gönderen thelvaci »

fatihbarut yazdı: 01 Şub 2018 03:52 sizin daha önce yazdığınız benim okumadığım hangi makale var?
Bir de benim kod mutlaka vcl kullanıyor herkes multithread ve vcl arasında bu kadar sıkıntıdan bahsederken neden bunu tercih edeyim.
İnanın ne demek istediğinizi anlayamadım Fatih bey ? Multi-thread hakkında benim de aralarında olduğum pek çok arkadaşımın yazdıklarını okudu iseniz; size okumadınız diyemem elbette; lâkin gördüğüm kadarı ile bir faydası olmamış :(

Aksi durumda, tamamı ile hatalı olan bir video'yu beğenip paylaşmazdınız sanıyorum. Herneyse, niyetim kimseyi üzmek değil; sadece öğrenmeye teşvik etmek. Lâkin sık sık yanlış anlaşılıyorum. VCL kullanıyor olmanız, yani thread içinden GUI'ye erişmeye çalışmanız zaten başlı başına bir husus. Velhasıl, thread'ler ve senkronizasyon hususlarında malümatlarınızı tazelemeniz sizin yazacağınız programlar ve sizin akıl sağlığınız açısından faydalı olacaktır.

Çünkü , video'daki gibi thread kullanmak; ileride kafanızda saç bıraktırmayacak sorunlara neden olacaktır.
Cevapla