?
Solved

Is this a correct way to MultiThread ?

Posted on 2011-09-24
1
Medium Priority
?
827 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 2000 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

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

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

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
In this video we outline the Physical Segments view of NetCrunch network monitor. By following this brief how-to video, you will be able to learn how NetCrunch visualizes your network, how granular is the information collected, as well as where to f…
Add bar graphs to Access queries using Unicode block characters. Graphs appear on every record in the color you want. Give life to numbers. Hopes this gives you ideas on visualizing your data in new ways ~ Create a calculated field in a query: …
Suggested Courses

765 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