Link to home
Start Free TrialLog in
Avatar of Member_2_5194534
Member_2_5194534

asked on

Is this a correct way to MultiThread ?

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

ASKER CERTIFIED SOLUTION
Avatar of Emmanuel PASQUIER
Emmanuel PASQUIER
Flag of France image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial