Segítene nekem valaki delphi tthread megvalósításba? A mellékelt linken van egy egyszerű program és a txt tartalmaz mindent ami a feladat.

A probléma az, hogy nem használsz tthread-od. A Timer1 az nem önáló thread (szál), az csak megadott időközönként egy megszakítást vált ki és a Timer1Timer metódust hajtja vére akkor ha a program (aktuális szál) várakozó állapotba van, ha hosszabb műveletet hajtasz végre (pl letöltés) akkor, ez amíg nem fejeződik be a timer1 az ablak addig nem kapja meg a CPU-t. Ezért szokták külön szálba rakni az idő igényesebb műveleteket. Külön szálat delphiben a tThread osztály-ból származtatni kell egy saját osztályt és ennek az Execute absztrakt virtuális metódosát kell felüldefiniálni, és a származtatott osztályt kell példányosítani. A főszálat és a gyerekszálat szinkronizálni kell egymással.

Itt is volt egy ilyesmi kérdés : [link]

Én is belefutottam ebbe a hibába (még több éve amikor delphiztem) a softwareonline van ThreadComponent. Ha jól emlékszem még a saját programjuk sem záródnak be normálisan,

a ThreadComponent-nek a hibája. Application.Terminate előtt a külön szálat termináld. (Talán ez megoldja, én sajnos nem tudom kiróbálni.)

Lehet, hogy nincsen is szükséged a szálak használatára. Én inkább használnám az Ararat Synapse nevű Unitcsomagot. Működik Delphi alatt is, nem csak Lazarus/Free Pascal alatt. És remekül meg lehet vele csinálni amit szeretnél szálak programozása nélkül. Az alábbi kód (bár Lazarussal (Free Pascal) készült) működhet Delphi alatt is:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses

Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,

ComCtrls, httpsend, blcksock, synacode;

type

{ TForm1 }

TForm1 = class(TForm)

Button1: TButton;

Label1: TLabel;

ProgressBar1: TProgressBar;

procedure Button1Click(Sender: TObject);

private

{ private declarations }

Download : THTTPSend;

TotalBytes : int64;

CurrentBytes : int64;

SavedFile : TFileStream;

procedure SockCallBack(Sender: TObject; Reason: THookSocketReason; const Value: string);

public

{ public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.lfm}

const cFFDownloadURL=' [link] Setup 4.0.exe';

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);

begin

ProgressBar1.position:=0;

TotalBytes:=0;

CurrentBytes:=0;

Download:=THTTPSend.Create;

try

Download.MimeType:='application/octet-stream';

Button1.Enabled:=False;

Application.Processmessages;

Download.Sock.OnStatus:=@SockCallBack;

Download.HTTPMethod('GET',EncodeURL(cFFDownloadURL));

Totalbytes:=Download.DownloadSize;

finally

SavedFile:=TFileStream.Create('ff4.exe',fmCreate);

try

SavedFile.Seek(0,soFromBeginning);

SavedFile.CopyFrom(DownLoad.Document,0);

finally

SavedFile.Free;

end;

Download.clear;

Download.free;

ShowMessage('A Fájl letöltődött!');

Button1.Enabled:=True;

end;

end;

procedure TForm1.SockCallBack(Sender: TObject; Reason: THookSocketReason; const Value: string);

begin

if TotalBytes=0 then Totalbytes:=Download.DownloadSize;

Application.Processmessages;

case Reason of

HR_ReadCount:

begin

CurrentBytes:=CurrentBytes+StrToInt(Value);

Label1.Caption:=IntToStr(CurrentBytes)+' / '+IntToStr(Totalbytes)+' ('+IntToStr(Progressbar1.Position)+'%)';

ProgressBar1.Position := Round(100 * (CurrentBytes / TotalBytes));

end;

HR_Connect: CurrentBytes := 0;

end;

end;

end.

Persze a felhasznált unitok neked másak lesznek a uses után, de a httpsend, a blcksock és a synacode unit a synapse része, így azt neked is be kell majd oda írni.

Nekem most jelen esetben van egy sima form amire feldobtam egy Button, egy Label és egy Progressbar komponenst. Amint a kódban láthatod, a button klikkre beállítjuk az onstatus eseményét a THTTPSend komponensünknek ezzel kiküszöbölve, hogy szálakat kelljen használni. És az eseményhez rendelt eljárásban pedig lerendezzük a Progressbar frissítését. Az Application.processmessages azért van kódban, hogy a letöltés elindultával az élet ne álljon meg az ablakban, tehát ha odakattintasz legyen válasz, működjenek a gombok, stb. Így ha esetleg szeretnél oda egy megszakítás gombot is, akkor az is működni fog.

Ha esetleg szeretnéd, akkor felteszek egy letölthető verziót a teljes forráskóddal meg a futtatható binárissal valahová, ha úgy jobban átlátod a dolgot.