Witam!
Mam problem, kiedyś napisałem procedury do mierzenia transferu przy wysyłaniu POSTa przy pomocy idHTTP i działało to dobrze. Teraz potrzebuje tego użyć w innym programie, zatem wyciąłem je i wkleiłem. No i nie mam pojęcia czemu, ale teraz już nie działają dobrze, wyświetlany transfer to cały czas 1000 - 2000kb/s co jest nie możliwe.
Kod:
procedure TCos.Postep;
var
Transfer: Double;
begin
Transfer:= 0;
if (NewTime - OldTime) / 1000 > 0 then
Transfer:= ((NewDownload - OldDownload) / 1024) / ((NewTime - OldTime) / 1000);
frmMain.lblSpeed.Caption:= FloatToStrF(Transfer, ffFixed, 10, 2) + ' kb/s';
end;
procedure TCos.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
if AWorkMode <> wmWrite then Exit;
NewDownload := AWorkCount;
NewTime := GetTickCount;
Synchronize(Postep);
OldTime := NewTime;
OldDownload := AWorkCount;
end;
procedure TCos.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
begin
if AWorkMode <> wmWrite then Exit;
if AWorkCountMax > 0 then RozmiarPliku:= AWorkCountMax;
NewTime := GetTickCount;
OldTime := GetTickCount;
OldDownload :=0;
end;
Kod jak widać działa na tej zasadzie, że sprawdza ile danych zostało pobranych oraz w jakim przedziale czasowym to nastąpiło.