Solved

Is this a correct way to MultiThread ?

Posted on 2011-09-24
1
800 Views
Last Modified: 2016-09-29
I want to know if there's anything i can do to make my code better...


unit uMain;

interface

uses
  // WinApi uses
  WinApi.WinInet,
  WinApi.Windows,
  // System uses (VCL)
  System.SysUtils,
  System.UITypes,
  System.Classes,
  // FMX uses (FireMonkey)
  FMX.Types,
  FMX.Controls,
  FMX.Forms,
  FMX.Dialogs,
  FMX.Colors,
  FMX.Edit,
  FMX.ExtCtrls,
  FMX.Layouts,
  FMX.ListBox,
  FMX.Menus,
  FMX.Objects,
  // Indy uses
  IdBaseComponent,
  IdComponent,
  IdTCPConnection,
  IdTCPClient,
  IdHTTP,
  // Custom headers
  uDownloadThread;

type
  TFileInfo = packed record
    FileSize: Int64;  // file size (byte)
    FileType: String; // file meta type
    FileHost: String; // server location
    FileUrl : String;
  end;

type
  TThreadInfo = record
    Thread       : TFetchDataThread;
    IsTerminated : Boolean;
  end;

type
  TFetchDataThreadMgr = class(TThread)
    private
      HandleArray  : Array Of THandle;
      ThreadArray  : Array Of TThreadInfo;
      procedure CreateRuntimeComponents;
    protected
      procedure Execute; override;
      procedure DoTerminate; override;
  end;

type
  TDAPClass = class(TForm)
    MainPanel: TPanel;
    ceUrl: TClearingEdit;
    bStartDL: TButton;
    cbVerifyLnk: TCornerButton;
    gbFileInfo: TGroupBox;
    lblFileType: TLabel;
    lblFileSize: TLabel;
    lblFileHost: TLabel;
    btnStop: TButton;
    btnSuspend: TButton;
    IdHTTP1: TIdHTTP;
    MainMenu1: TMainMenu;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    gbSaveTo: TGroupBox;
    ceSaveTo: TClearingEdit;
    lblSaveTo: TLabel;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    cbAcceleration: TComboBox;
    Label1: TLabel;
    btnRefreshUI: TButton;
    procedure cbVerifyLnkClick(Sender: TObject);
    procedure MenuItem4Click(Sender: TObject);
    procedure MenuItem2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure cbAccelerationChange(Sender: TObject);
    procedure bStartDLClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
  private
    FetchDataThreadMgr: TFetchDataThreadMgr;

    procedure GetFileInfo(
     sUrl: String );

    procedure SplitInt64(
     const i64FileSize: Int64 );

    function GetURLAsString(
     aURL: string ): String;

    function FormatByteSize(
     const Bytes: Int64 ): string;
  public
  {  procedure UpdateProgressBar(
    AProgressBar : TProgressBar;
    aProcent     : Integer );   }
    FileInfo        : TFileInfo;
  end;

var
  DAPClass : TDAPClass;
  //
  nConnections    : Integer;
  hInet           : HINTERNET;
  i64StartOffset,
  i64EndOffset    : Array Of Int64;
  alabel          : Array of TLabel;
  apbar           : Array of TProgressBar;
  hOpenFile       : Array of THandle;
  hInetFile       : Array of HINTERNET;

implementation

{$R *.fmx}

{procedure TDAPClass.UpdateProgressBar(
AProgressBar : TProgressBar;
aProcent     : Integer);
begin
  // Assuming min = 0 and Max = 100
  AProgressBar.Value := aProcent;
  AProgressBar.Repaint;
end;}

procedure TDAPClass.SplitInt64(
const i64FileSize: Int64
);
var
  i,
  nEndDiv      : Integer;
  i64Start,
  i64End       : Int64;
begin
  i64Start := 0; // initialize i64Start

  SetLength( i64StartOffset, nConnections );
  SetLength( i64EndOffset  , nConnections );

  nEndDiv := nConnections;

  for i := 0 to Pred( nConnections ) do
  begin
    i64End :=
     i64FileSize div ( nEndDiv );

    dec( nEndDiv );

    i64StartOffset[i] := i64Start;
    i64EndOffset[i]   := i64End;

  {  ShowMessageFmt( 'Start: %dkb, End: %dkb',
    [i64StartOffset[i] div 1024, i64EndOffset[i] div 1024]); }

    i64Start := i64End;
  end;
end;

procedure TDAPClass.btnStopClick(Sender: TObject);
var
  I: Integer;
begin
 with FetchDataThreadMgr do
 begin
   for I := 0 to Pred( SizeOf(ThreadArray) ) do
   begin
     if ThreadArray[I].Thread.CheckTerminated = False then
     begin
      ThreadArray[I].Thread.Terminate;
      CloseHandle( HandleArray[I] );
     end else ShowMessage('Hey');
   end;
 end;
end;

procedure TDAPClass.cbAccelerationChange(Sender: TObject);
begin
  case cbAcceleration.ItemIndex of
  0{Normal speed}: nConnections := 1;
  1{Above normal}: nConnections := 2;
  2{Accelerated }: nConnections := 4;
  3{Broadband Op}: nConnections := 6;
  4{High acceler}: nconnections := 8;
  5{Extreme acce}: nConnections := 10;
  end;
end;

procedure TDAPClass.cbVerifyLnkClick(Sender: TObject);
const
  TmpFileBuffer : Byte = ($00);
var
  hTmpFile      : THandle;
  nBytesWritten : DWORD;
begin
  if ( nConnections = 0 ) then
  begin
    MessageDlg( 'Please choose an acceleration mode',
    TMsgDlgType.mtWarning, [TMsgDlgBtn.mbClose], 0 );
    Exit;
  end;
  if ( ceUrl.Text <> '' ) then
  begin
    GetFileInfo( ceUrl.Text );
    with FileInfo do
    begin
      lblFileType.Text := 'Type:  ' + FileType;
      lblFileSize.Text := ' Size:   ' + FormatByteSize( FileSize );
      lblFileHost.Text := 'From:  ' + FileHost;
    end;
    // Split the file into segments
    SplitInt64( FileInfo.FileSize );
    // Change array's size to number of connections
    SetLength( hOpenFile, nConnections );
    SetLength( apbar    , nConnections );
    SetLength( alabel   , nConnections );
    SetLength( hInetFile, nConnections );
    // Create a temp blank file
    hTmpFile := CreateFile(
    PChar( ceSaveTo.Text ),
    GENERIC_WRITE,
    0,
    nil,
    CREATE_ALWAYS,
    FILE_ATTRIBUTE_NORMAL,
    0 );
    //  Seek to the end of the file [offset]
    SetFilePointer(
     hTmpFile, FileInfo.FileSize - 1, nil, FILE_BEGIN );
    // Write 1 byte to the end of the file
    WriteFile(
     hTmpFile, TmpFileBuffer, SizeOf(TmpFileBuffer), nBytesWritten, nil );
    // Close Temp file handle
    CloseHandle( hTmpFile );
  end else MessageDlg(
  'No link has been inserted',
  TMsgDlgType.mtWarning,
  [TMsgDlgBtn.mbClose],
  0 );
end;



procedure TDAPClass.bStartDLClick(Sender: TObject);
begin
  if ( FileInfo.FileSize = 0 ) then
  begin
    MessageDlg( 'Please verify the link',
    TMsgDlgType.mtWarning, [TMsgDlgBtn.mbClose], 0 );
    Exit;
  end;
  with TFetchDataThreadMgr.Create( False ) do
   Priority := tpNormal;
end;

procedure TFetchDataThreadMgr.Execute;
var
  I   : Integer;
  Ret : DWORD;
begin
  FreeOnTerminate := True;

  Synchronize( CreateRuntimeComponents );

  for I := 0 to Pred( nConnections ) do
  begin
    with TFetchDataThread.Create(
    alabel[I],
    apbar[I],
    hOpenFile[I],
    hInetFile[I],
    i64StartOffset[I],
    i64EndOffset[I]) do
    begin
      HandleArray[I] := Handle;
    end;
  end;

  while not Terminated do
  begin
    Sleep( Random(15) );
    Ret := WaitForMultipleObjects( nConnections, @HandleArray, False, 1000 );
    if Ret = WAIT_TIMEOUT then Continue;
    ThreadArray[ Ret - WAIT_OBJECT_0 ].IsTerminated := True;
  end;
end;

procedure TFetchDataThreadMgr.CreateRuntimeComponents;
const
  dwFlagsAndAttr
   = FILE_ATTRIBUTE_NORMAL or FILE_FLAG_RANDOM_ACCESS;
var
  I,
  iPBARX,
  iPBARY,
  iLblX,
  iLblY   : Integer;
begin
  hInet :=
   InternetOpen( 'FireMonkey/1.1', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0 );

  iPBARX := 8;
  iPBARY := 216;

  iLblX  := 8;
  iLblY  := 248;

  SetLength( HandleArray, nConnections );
  SetLength( ThreadArray, nConnections );

  with DAPClass do
  for I := 0 to Pred( nConnections ) do
  begin
    hInetFile[I] :=
     InternetOpenURL(
      hInet, PChar( FileInfo.FileUrl ), nil, 0, 0, 0 );

    hOpenFile[I] :=
     CreateFile(
      PChar( ceSaveTo.Text ),
      GENERIC_WRITE, File_Share_Write, nil, OPEN_EXISTING, dwFlagsAndAttr, 0 );

    Height := Height + 40;

    apbar[I] := TProgressBar.Create( DAPClass );
    with apbar[I] do
    begin
      Parent := MainPanel;
      Width := 50;
      Min := 0;
      Max := 1;
      with Position do
       begin
        X := iPBARX;
        Y := iPBARY;
      end;
      Value := 0;
      iPBARX := iPBARX + 49;
    end;

    alabel[I] := TLabel.Create( DAPClass );
    with alabel[I] do
    begin
      Parent := MainPanel;
      AutoSize := True;
      With Position do
      begin
        X := iLblX;
        Y := iLblY;
      end;
      iLblY := iLblY + 30;
    end;
  end;
end;

procedure TFetchDataThreadMgr.DoTerminate;
var
  I, NumHandles: Integer;
begin
  ShowMessage('hello');
  NumHandles := 0;
  for I := 0 to Pred( nConnections ) do
  begin
    if Assigned( ThreadArray[I].Thread ) and ( not ThreadArray[I].IsTerminated ) then
    begin
      ThreadArray[I].Thread.Terminate;
      HandleArray[NumHandles] := ThreadArray[I].Thread.Handle;
      Inc( NumHandles );
    end;
  end;
  if NumHandles > 0 then
  WaitForMultipleObjects( NumHandles, @HandleArray, True, INFINITE );
end;


end.

Open in new window

unit uDownloadThread;

interface

uses
  System.Classes,
  System.SysUtils,
  //
  WinApi.Windows,
  WinApi.WinInet,
  //
  FMX.Controls,
  //
  uProgressThread;

type
  TFetchDataThread = class(TThread)
  private
    FStartOffset,
    FEndOffset      : Int64;
    FInetFile       : HINTERNET;
    FDestFile       : THandle;
    FProgressBar    : TProgressBar;
    FLabelProgress  : TLabel;
    FCurrentOffset  : Int64;
    procedure ProgressGui;
  protected
    procedure Execute; override;
  public
    constructor Create(
    LabelProgress : TLabel;
    Progress      : TProgressBar;
    DestFile      : THandle;
    InetFile      : HINTERNET;
    StartOffset,
    EndOffset     : Int64 );
    destructor Destroy;
  end;

implementation

uses
  uMain;



constructor TFetchDataThread.Create(
LabelProgress: TLabel;
Progress     : TProgressBar;
DestFile     : THandle;
InetFile     : HINTERNET;
StartOffset,
EndOffset    : Int64 );
begin
  FStartOffset    := StartOffset;
  FEndOffset      := EndOffset;
  FInetFile       := InetFile;
  FDestFile       := DestFile;
  FProgressBar    := Progress;
  FLabelProgress  := LabelProgress;
  inherited Create( {DAPClass.UpdateProgressBar,} False );
end;

procedure TFetchDataThread.ProgressGui;
begin
  FProgressBar.Value := FCurrentOffset;
  FProgressBar.Repaint; // Avoid gui problems
  FLabelProgress.Text :=
  Format( 'Thread: %d, Start Offset: %d Current Offset: [HEX: 0x%s, DEC: %d], End Offset: %d',
   [ThreadID, FStartOffset, IntToHex(FCurrentOffset, 8), FCurrentOffset, FEndOffset ] );
end;

procedure TFetchDataThread.Execute;
type
  TypeByteArray = array [1..1024*2] of Byte;
var
  Buffer            : TypeByteArray;
  BytesToReadWrite,
  BytesLeft,
  BufferLen,
  BytesWritten,
  EndProgress       : DWORD;
begin
  FreeOnTerminate := True;

  FProgressBar.Min :=  FStartOffset;
  FProgressBar.Max :=  FEndOffset;

  InternetSetFilePointer( FInetFile, FStartOffset, nil, FILE_BEGIN, 0 );

  EndProgress := SetFilePointer( FDestFile, FEndOffset, nil, FILE_BEGIN );

  SetFilePointer( FDestFile, FStartOffset, nil, FILE_BEGIN );

  try
    repeat

      BytesToReadWrite := EndProgress - FCurrentOffset;
      if ( BytesToReadWrite > SizeOf( TypeByteArray ) ) Then
        BytesToReadWrite  := SizeOf( Buffer )
       else
      begin
        BytesLeft := ( EndProgress - FCurrentOffset );
        BytesToReadWrite  := BytesLeft;
      end;

      InternetReadFile(
       FInetFile, @Buffer, BytesToReadWrite, BufferLen );

      LockFile(
       FDestFile, FStartOffset, 0, BytesToReadWrite, 0 );

      WriteFile(
       FDestFile, Buffer, BytesToReadWrite, BytesWritten, nil );

      UnlockFile(
       FDestFile, FStartOffset, 0, BytesToReadWrite, 0 );

      FCurrentOffset :=
       SetFilePointer( FDestFile, 0, nil, FILE_CURRENT );

      Synchronize( ProgressGui );

      Sleep( Random( 15 ) ); // Avoid cpu usage

    until (FCurrentOffset >= EndProgress) or (Terminated);
  finally
    CloseHandle( FDestFile );
    InternetCloseHandle( FInetFile );
  end;
end;

end.

Open in new window

0
Comment
Question by:rotem156
1 Comment
 
LVL 25

Accepted Solution

by:
epasquier earned 500 total points
ID: 36597675
the thing is to understand why Suspend/Resume have been deprecated : because they can pause a thread anywhere. And sometimes that's not a good idea, because the thread was locking some file or other critical resource.
Instead, it is recommended to use Signals :
Each loop (reading/writing 1kb in your case), you check for a 'Pause' signal. If it is set, you put your thread in an infinite wait of a 'Resume' signal.
That way you know precisely WHEN your thread is suspended.
0

Featured Post

NAS Cloud Backup Strategies

This article explains backup scenarios when using network storage. We review the so-called “3-2-1 strategy” and summarize the methods you can use to send NAS data to the cloud

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
proper way to parse url in delphi 2 201
Printing problem 2 92
Print Graphic and Text to Epson TM-T88v 12 252
Drag & Drop... Data from one grid to another 2 14
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
Nobody understands Phishing better than an anti-spam company. That’s why we are providing Phishing Awareness Training to our customers. According to a report by Verizon, only 3% of targeted users report malicious emails to management. With compan…

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question