HTTPGet z TGauge

0

Witam pisze program który będzie pobierał pliki z internetu i próbuje zrobić aby można było pobierać ich kilka jednocześnie. Napisałem coś takiego:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, HTTPGet, Gauges;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure KlikPrzycisku(Sender: TObject);
    procedure Progress(Sender: TObject; TotalSize,Readed: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  i: Byte = 0;
  y: Integer = 8;
  NumName: Byte;
  TagHTTP: String;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  NewButton: TButton;
  NewGauge: TGauge;
  NewHTTPGet: THTTPGet;
begin
  i := i + 1;

// Tworzenie przycisku pobierania
  NewButton := TButton.Create(Self);
  NewButton.Width:=75;
  NewButton.Height:=25;
  NewButton.Top := y;
  NewButton.Left := 8;
  NewButton.Name := 'Download'+IntToStr(i);
  NewButton.Caption := 'Pobierz';
  NewButton.Tag := i;
  NewButton.Visible := True;
  NewButton.Parent := Self;
  NewButton.OnClick := KlikPrzycisku;

// Tworzenie paska postępu
  NewGauge := TGauge.Create(Self);
  NewGauge.Name := 'Gauge'+IntToStr(i);
  NewGauge.Width:=250;
  NewGauge.Height:=20;
  NewGauge.Top := y;
  NewGauge.Left := 91;
  NewGauge.MinValue := 0;
  NewGauge.Parent := Self;
  NewGauge.Visible := True;

// Tworzenie komponentu HTTPGet
  NewHTTPGet := THTTPGet.Create(Self);
  NewHTTPGet.Name := 'HTTPGet'+IntToStr(i);
  NewHTTPGet.URL := Edit1.Text;
  NewHTTPGet.Tag := i;
  NewHTTPGet.FileName := 'C:\Documents and Settings\Qbek\Pulpit\' + Edit2.Text;
  NewHTTPGet.OnProgress := Progress;

  y := y + 30;
end;

procedure TForm1.KlikPrzycisku(Sender: TObject);
begin
  NumName := TButton(Sender).Tag;
  THTTPGet(FindComponent('HTTPGet' + IntToStr(NumName))).GetFile;
end;

procedure TForm1.Progress(Sender: TObject; TotalSize, Readed: Integer);
begin
  NumName := TButton(Sender).Tag;
  TGauge(FindComponent('Gauge'+IntToStr(NumName))).MaxValue := TotalSize;
  TGauge(FindComponent('Gauge'+IntToStr(NumName))).Progress := Readed;
end;

end.

Ale gdy pobieram dwa lub więcej plików to wtedy postęp pobierania tych plików jest wyświetlany na przemian na jednym TGauge :/

0

Spróbuj pozamieniać w Button1Click:

New{...} := T{...}.Create(Self);
{...}
New{...}.Parent := Self;

na:

New{...} := T{...}.Create(Form1);
{...}
New{...}.Parent := Form1;
0

Niestety to nic nie pomoże. Tu chodzi o to że po jednym wykonaniu procedury KlikPrzycisku NumName przyjmuje wartość 1 i wtedy postęp jest pokazywany w Gauge1 a jak wykona się drugi raz to wartość NumName przyjmuje wartość 2 i postęp pobierania wszystkich plików jest wyświetlany w Gauge2. <ort>na razie </ort>jedynym rozwiązaniem jakie przychodzi mi do głowy to jest zrobienie 100 procedur Progress1, Progress2, Progress3 itd... które będą wyglądać tak:

procedure TForm1.Progress1(Sender: TObject; TotalSize, Readed: Integer);
begin
  NumName := TButton(Sender).Tag;
  TGauge(FindComponent('Gauge1')).MaxValue := TotalSize;
  TGauge(FindComponent('Gauge1')).Progress := Readed;
end;
procedure TForm1.Progress2(Sender: TObject; TotalSize, Readed: Integer);
begin
  NumName := TButton(Sender).Tag;
  TGauge(FindComponent('Gauge2')).MaxValue := TotalSize;
  TGauge(FindComponent('Gauge2')).Progress := Readed;
end;

ITD.

Ale jak ktoś bedzie chciał pobrać 101 plików to juz nie zadzaiała :/ Macie może pomysł na jakieś lepsze rozwiązanie tego problemu?

0

Ja bym spróbował tak:

procedure TForm1.Progress(Sender: TObject; TotalSize, Readed: Integer);
begin
//  NumName := TButton(Sender).Tag;
  NumName:=THTTPGet(Sender).Tag;
  TGauge(FindComponent('Gauge'+IntToStr(NumName))).MaxValue := TotalSize;
  TGauge(FindComponent('Gauge'+IntToStr(NumName))).Progress := Readed;
end;
0

@up
Niestety i to nie pomogło :/ nie wiem dlaczego ale wtedy NumName cały czas przyjmuje wartość 1 mimo tego ze tag komponentu ma wartość 2 :/

0

oryginalny błąd jest spowodowany tym, że Progress() jest wywoływane przez httpget, a nie button.
drugie rozwiązanie wydaje się prawidłowe - ale:

  • skąd wiesz, jaką wartość ma THTTPGet(Sender).Tag wewnątrz Progress()? sprawdziłeś to debugerem?
  • imho błąd bierze się z tego (o ile sprawdziłes, że THTTPGet(Sender).Tag wewnątrz Progress() ma na pewno prawidłowe wartości), że numname jest zmienną globalną (nie rozumiem czemu). wtedy jeśli httpget działa wielowątkowo, to poszczególne wątki nawzajem nadpisują sobie wartość tej zmiennej w losowych momentach. zrób z tej zmiennej lokalną i daj znać, czy problem został rozwiązany.
0

Zrobiłem tak jak mówiłeś, czyli tak:

procedure TForm1.Progress1(Sender: TObject; TotalSize, Readed: Integer);
var
  ii: integer;
begin
ii := THTTPGet(Sender).Tag;
TGauge(FindComponent('Gauge' + IntToStr(ii))).MaxValue := TotalSize;
TGauge(FindComponent('Gauge' + IntToStr(ii))).Progress := Readed;
end;

ale wtedy gdy uruchomię pobieranie to wyskakuje błąd:
user image

0

przejedź debugerem po kodzie (Debugowanie), nie będziemy zgadywać co w nim nie tak, przynajmniej ja nie zamierzam. postaw breakpoint na linijce z ii := THTTPGet(Sender).Tag, wykonaj od tego miejsca kod linijka po linijce i zobacz, w którym miejscu konkretnie powstaje błąd, czy do ii jest przypisywana prawidłowa wartość itp.

0

Zrobiłem tak jak kazałeś błąd powstaje przy linijce:

TGauge(FindComponent('Gauge' + IntToStr(ii))).MaxValue := TotalSize;

a spowodowane to jest tym że zminnej ii jest przypisywana wartość 16777217 i program nie może poszukać na formie komponentu Gauge16777217 ponieważ go tam nie ma :P Teraz to ja już nie mam pojęcia jak rozwiązać ten problem :/

0

W procedurze Progress sprawdź Sender.ClassName.
Twoją metodą nie da się zidentyfikować, który komponent HTTPGet wywołał procedurę Progress.

1 użytkowników online, w tym zalogowanych: 0, gości: 1, botów: 0