Multithread application ile çözüm üretmek

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
fatihbarut
Üye
Mesajlar: 392
Kayıt: 15 Ara 2011 08:02

Multithread application ile çözüm üretmek

Mesaj gönderen fatihbarut » 08 Oca 2018 04:13

Arkadaşlar,
Multithread application konusunu bilen biri nasıl olduğunu açıklayabilir mi?
Şöyle ki her saniye çalışması fakat uzun süren başka bir kodu tetiklemesi gereken bir kod var. Bunun için ikinci kod programda freeze oluşturmasın diye başka bir thread içinde çalışmalı.
Ayrı bir program yazmadan işi çözmek istiyorum. Nasıl olabileceğini bilen var mı?
Selam.

fatihbarut
Üye
Mesajlar: 392
Kayıt: 15 Ara 2011 08:02

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

Mesaj gönderen fatihbarut » 08 Oca 2018 04:40

basit ve güzel bir anlatım
https://www.youtube.com/watch?v=uLt-Tw-OA1I

Lord_Ares
Üye
Mesajlar: 1008
Kayıt: 15 Eki 2006 03:33
Konum: Çorlu

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

Mesaj gönderen Lord_Ares » 10 Oca 2018 01:46

fatihbarut yazdı:
08 Oca 2018 04: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 09:04

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

Mesaj gönderen Opt2000 » 10 Oca 2018 07:16

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

fatihbarut
Üye
Mesajlar: 392
Kayıt: 15 Ara 2011 08:02

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

Mesaj gönderen fatihbarut » 10 Oca 2018 07:47

evet onu ben de duydum. Ama küçük çaplı işlerde iş görüyor gibi...

fatihbarut
Üye
Mesajlar: 392
Kayıt: 15 Ara 2011 08:02

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

Mesaj gönderen fatihbarut » 10 Oca 2018 11:08

denedim, (TThread.Queue) ve (TThread.Synchronize) kullanmasam da VCL erişimi sırasında görünürde sorun yaratmadı.

Kullanıcı avatarı
SimaWB
Üye
Mesajlar: 1286
Kayıt: 07 May 2009 09:42
Konum: İstanbul
İletişim:

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

Mesaj gönderen SimaWB » 10 Oca 2018 11:19

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

fatihbarut
Üye
Mesajlar: 392
Kayıt: 15 Ara 2011 08:02

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

Mesaj gönderen fatihbarut » 10 Oca 2018 11:27

kendime kadar program yazdım, ondan sorun olmayabilir :)

fatihbarut
Üye
Mesajlar: 392
Kayıt: 15 Ara 2011 08:02

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

Mesaj gönderen fatihbarut » 10 Oca 2018 03:48

Thread safe kod nasıl yazılır?

ertank
Üye
Mesajlar: 982
Kayıt: 11 Eyl 2015 11:45

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

Mesaj gönderen ertank » 10 Oca 2018 09:15

fatihbarut yazdı:
10 Oca 2018 11: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?

fatihbarut
Üye
Mesajlar: 392
Kayıt: 15 Ara 2011 08:02

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

Mesaj gönderen fatihbarut » 10 Oca 2018 10:16

Kod: Tümünü seç

  
  procedure MyThread.Execute;
var
  ZipFileName, FileName, user, pw, DatabaseName: string;
  Host: string;
  Port: string;
  Addressee: TIdEmailAddressItem;
  Attachment: TIdAttachmentFile;
begin
  with Form1 do
  begin
    try
      if TempDBsQ.IsEmpty = false then
      begin
        TempDBsQ.First;
        FileName := TempDBsQ.fieldbyname('BackupFolder').AsString + '\' + TempDBsQ.fieldbyname('BackupName').AsString + '-' +
          formatdatetime('yyyy-mm-dd_hh.nn', now()) + '.sql';
        ZipFileName := TempDBsQ.fieldbyname('BackupFolder').AsString + '\' + TempDBsQ.fieldbyname('BackupName').AsString + '-' +
          formatdatetime('yyyy-mm-dd_hh.nn', now()) + '.zip';
        Host := TempDBsQ.fieldbyname('ServerName').AsString;
        Port := TempDBsQ.fieldbyname('Port').AsString;
        user := TempDBsQ.fieldbyname('User').AsString;
        pw := TempDBsQ.fieldbyname('PW').AsString;
        DatabaseName := TempDBsQ.fieldbyname('DBName').AsString;

        try
          zipFile(ZipFileName, FileName);
        Except
          showmessage('Error in zipping the backuped database file');
          CheckTempTimer.Enabled := false;
          Exit;
        end;

        if FindFileSize(ZipFileName) > 25000000 then
        begin
          MemoLog.Lines.Add('Zipped db file couldn''t send because it exceeds 25 mb (' + IntToStr(FindFileSize(ZipFileName)) + ')');
          CheckTempTimer.Enabled := false;
          Exit;
        end;
        Application.ProcessMessages;
        MemoLog.Lines.Add(DateTimeToStr(now) + ' SMTP started');
        try
          if SMTP.Connected then
            SMTP.Disconnect;
          SMTP.Host := 'smtp.gmail.com';
          // SMTP.AuthType := satNone;
          SMTP.AuthType := satDefault;
          SMTP.Username := 'mybackupprogram@gmail.com';
          SMTP.Password := 'fatomse123';
          SMTP.Port := 587;

          MemoLog.Lines.Add(DateTimeToStr(now) + ' SSL setting up.');
          LHandler.Destination := SMTP.Host + ':' + IntToStr(SMTP.Port);
          LHandler.Host := SMTP.Host;
          LHandler.Port := SMTP.Port;
          LHandler.DefaultPort := 0;
          LHandler.SSLOptions.Method := sslvTLSv1;
          LHandler.SSLOptions.Mode := sslmUnassigned; // sslmClient;
          LHandler.SSLOptions.VerifyMode := [];
          LHandler.SSLOptions.VerifyDepth := 0;
          SMTP.IOHandler := LHandler;
          // case EditCRYPTION.ItemIndex of
          // 1:
          // SMTP.UseTLS := utUseImplicitTLS; // SSL
          // 2:
          SMTP.UseTLS := utUseExplicitTLS; // SSL/TLS
          // end;
          SMTP.ConnectTimeout := 10000;

          MemoLog.Lines.Add(DateTimeToStr(now) + ' Connecting to mail server');
          SMTP.Connect;

          MemoLog.Lines.Add(DateTimeToStr(now) + ' Sending email (this could be a while if attached zip file is big)');

          EPosta.Clear;

          EPosta.From.Address := 'xxx@gmail.com';
          EPosta.From.Name := 'MyBackup';
          Attachment := TIdAttachmentFile.Create(EPosta.MessageParts, ZipFileName);
          with EPosta.Recipients.Add do
          begin
            Name := TempDBsQ.fieldbyname('email').AsString;

            Address := 'xxx@gmail.com'; // trim(TempDBsQ.FieldByName('email').AsString);
            EPosta.Subject := 'DB Backup ' + Host + ' ' + FileName;
            EPosta.CharSet := 'utf-8'; // 'iso-8859-9';
            EPosta.ContentType := 'multipart/alternative';
            with TIdText.Create(EPosta.MessageParts, nil) do
            begin
              Body.Text :=
                '<html><body>' +
                'This email contains backed up and zipped db as attachment' + '</body></html>';;
              CharSet := 'iso-8859-9';
              ContentType := 'text/html';
            end;
            SMTP.Send(EPosta);
            MemoLog.Lines.Add(DateTimeToStr(now) + ' Connection succeed. An email with attached db is being sent to "' +
              TempDBsQ.fieldbyname('email')
              .AsString + '"');
          end;
        finally
          MemoLog.Lines.Add(DateTimeToStr(now) + ' Connection to mail server is ending.');
          if SMTP.Connected then
            SMTP.Disconnect;
        end;
        MemoLog.Lines.Add('E-mail sent.');
        MemoLog.Lines.SaveToFile(ExtractFilePath(Application.ExeName) + 'Log.txt');

        TempDBsQ.Delete;
        TempDBsQ.refresh;
      end;

    except

      MemoLog.Lines.Add
        ('An error happened in process and stoped, you can check your hdd is full or your network and/or internet working, mysql server is running and all the information you entered is true, then contact to xxx@gmail.com');
      showmessage
        ('An error happened in process and stoped, you can check your hdd is full or your network and/or internet working, mysql server is running and all the information you entered is true, then contact to xxx@gmail.com');
    end;
    CheckTempTimer.Enabled := True;
  end;

ertank
Üye
Mesajlar: 982
Kayıt: 11 Eyl 2015 11:45

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

Mesaj gönderen ertank » 10 Oca 2018 11:10

Thread çağırmak için kullandığınız kodu da paylaşabilir misiniz?

fatihbarut
Üye
Mesajlar: 392
Kayıt: 15 Ara 2011 08:02

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

Mesaj gönderen fatihbarut » 10 Oca 2018 11:37

with MyThread.Create do
FreeOnTerminate := True;

fatihbarut
Üye
Mesajlar: 392
Kayıt: 15 Ara 2011 08:02

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

Mesaj gönderen fatihbarut » 10 Oca 2018 11:39

bu arada


type
MyThread= class(TThread)
protected
procedure Execute(); override;
end;

ertank
Üye
Mesajlar: 982
Kayıt: 11 Eyl 2015 11:45

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

Mesaj gönderen ertank » 11 Oca 2018 12:33

Ö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.

Cevapla