Solved

Is this a correct way to MultiThread ?

Posted on 2011-09-24
1
816 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
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 video Micro Tutorial shows how to password-protect PDF files with free software. Many software products can do this, such as Adobe Acrobat (but not Adobe Reader), Nuance PaperPort, and Nuance Power PDF, but they are not free products. This vide…
Michael from AdRem Software explains how to view the most utilized and worst performing nodes in your network, by accessing the Top Charts view in NetCrunch network monitor (https://www.adremsoft.com/). Top Charts is a view in which you can set seve…

707 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