[Last Call] Learn about multicloud storage options and how to improve your company's cloud strategy. Register Now

x
?
Solved

Is this a correct way to MultiThread ?

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

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
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…
Sometimes it takes a new vantage point, apart from our everyday security practices, to truly see our Active Directory (AD) vulnerabilities. We get used to implementing the same techniques and checking the same areas for a breach. This pattern can re…
This lesson discusses how to use a Mainform + Subforms in Microsoft Access to find and enter data for payments on orders. The sample data comes from a custom shop that builds and sells movable storage structures that are delivered to your property. …
Suggested Courses

650 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