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.
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.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.