Форум: "Начинающим";
Текущий архив: 2011.06.19;
Скачать: [xml.tar.bz2];
Внизмного get-запросов Найти похожие ветки
← →
LDV (2011-03-12 11:28) [0]есть список url (фотки размером от 2 до 7 кб, около 4000). Задача: пройти по списку скачивая фото в локальную директорию. Первые 500 фото скачиваются очень быстро, потом процесс скачивания замедляется и доходит до того что одно фото в среднем скачивается около миниту. как обойти эту проблему. Подключение идет через прокси.
алгоритм примерно такой:
function download_file(const AUrl, Afile_name: string): Boolean;
var
Stream: TStream;
begin
Stream := TFileStream.Create(Afile_name, fmCreate);
try
try
IdHTTP1.Get(AUrl, Stream);
except
try
DeleteFile(Afile_name);
except
end;
end;
finally
Stream.Free;
end;
end;
← →
tippa (2011-03-12 11:53) [1]попробуй ставить задержку - случайное число от 1 до 10 секунд
← →
Virgo_Style © (2011-03-12 12:34) [2]DeleteFile вроде не поднимает исключений
и едва ли отработает при открытом TFileStream"ом файле
← →
Slym © (2011-03-12 14:47) [3]
unit Unit2;
interface
uses
Classes,IdHTTP,SysUtils;
type
TOnEvent=procedure(const Message:string) of object;
THttpThread = class(TThread)
private
FIdHTTP:TIdHTTP;
FMask:string;
FFileMask:string;
FPath:string;
FList:TThreadList;
FOnEvent:TOnEvent;
FMsg:string;
procedure SetMsg(const AMsg:string);
procedure DoEvent;
protected
procedure Execute; override;
property Msg:string write SetMsg;
public
constructor Create;
destructor Destroy; override;
procedure Terminate;
property IdHTTP:TIdHTTP read FIdHTTP;
property Path:string read FPath write FPath;
property Mask:string read FMask write FMask;
property FileMask:string read FFileMask write FFileMask;
property List:TThreadList read FList write FList;
property OnEvent:TOnEvent read FOnEvent write FOnEvent;
end;
var Threads:TThreadList;
implementation
{ THttpThread }
function ExtractFileName(const FileName: string): string;
var
I: Integer;
begin
I := LastDelimiter("\/" + DriveDelim, FileName);
Result := Copy(FileName, I + 1, MaxInt);
end;
constructor THttpThread.Create;
begin
Threads.Add(self);
FIdHTTP:=TIdHTTP.Create(nil);
inherited Create(true);
end;
destructor THttpThread.Destroy;
begin
Threads.Remove(self);
FIdHTTP.Free;
inherited;
end;
procedure THttpThread.DoEvent;
begin
if assigned(FOnEvent) then
FOnEvent(FMsg);
end;
procedure THttpThread.Execute;
var i,j:integer;
L:TList;
URL,FileName:string;
Stream:TMemoryStream;
begin
Stream:=TMemoryStream.Create;
try
while not Terminated do
begin
L:=FList.LockList;
try
if L.Count>0 then
begin
i:=integer(L[0]);
L.Delete(0);
end else
break;
finally
FList.UnlockList;
end;
URL:=stringReplace(FMask,"%","~",[rfReplaceAll, rfIgnoreCase]);
URL:=stringReplace(URL,"!","%",[rfReplaceAll, rfIgnoreCase]);
URL:=Format(URL,[i]);
URL:=stringReplace(URL,"~","%",[rfReplaceAll, rfIgnoreCase]);
if FFileMask<>"" then
FileName:=Path+Format(FFileMask,[i])
else
FileName:=Path+ExtractFileName(URL);
for j:=1 to 3 do
try
if Terminated then break;
if not FileExists(FileName) then
begin
ForceDirectories(FPath);
FIdHTTP.Get(URL,Stream);
Stream.SaveToFile(FileName);
Msg:=ExtractFileName(FileName)+" - OK("+IntToStr(Stream.Size)+")";
Stream.Clear;
end else
Msg:=ExtractFileName(FileName)+" - EXISTS";
break;
except
on E:Exception do
begin
if E is EIdHTTPProtocolException then
begin
Msg:=Format("%s ERROR %d (%s)",[ExtractFileName(FileName),EIdHTTPProtocolException(E).ErrorCode,E.Message]) ;
Break;
end else
Msg:=Format("%s ERROR %s",[ExtractFileName(FileName),E.Message]);
end;
end;
end;
finally
Stream.Free;
end;
Msg:="Finished";
end;
procedure THttpThread.SetMsg(const AMsg: string);
begin
FMsg:=AMsg;
Synchronize(DoEvent);
end;
procedure THttpThread.Terminate;
begin
inherited;
if FIdHTTP.Connected then
FIdHTTP.Disconnect;
end;
initialization
Threads:=TThreadList.Create;
Threads.Duplicates:=dupError;
finalization
if assigned(Threads) then
FreeAndNil(Threads);
end.
← →
Slym © (2011-03-12 14:49) [4]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Controls, Forms,
Spin, StdCtrls, ExtCtrls, IdHTTP, StdCtrls,Unit2, ExtCtrls, ActnList,IniFiles;
type
TForm1 = class(TForm)
Memo1: TMemo;
Panel1: TPanel;
Edit1: TEdit;
SpinEdit1: TSpinEdit;
SpinEdit2: TSpinEdit;
SpinEdit3: TSpinEdit;
Button1: TButton;
ActionList1: TActionList;
RunAcnt: TAction;
Edit2: TEdit;
StopAcnt: TAction;
Action1: TAction;
Button2: TButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure RunAcntExecute(Sender: TObject);
procedure RunAcntUpdate(Sender: TObject);
procedure StopAcntUpdate(Sender: TObject);
procedure StopAcntExecute(Sender: TObject);
procedure Action1Update(Sender: TObject);
procedure Action1Execute(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
FList:TThreadList;
FIniFile:TMemIniFile;
procedure OnEvent(const msg:string);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property IniFile:TMemIniFile read FIniFile;
end;
var
Form1: TForm1;
function Encrypt(const Str:string):string;
function Decrypt(const Str:string):string;
implementation
uses ProxyEditUn;
{$R *.dfm}
function ExtractFileName(const FileName: string): string;
var
I: Integer;
begin
I := LastDelimiter("\/" + DriveDelim, FileName);
Result := Copy(FileName, I + 1, MaxInt);
end;
procedure TForm1.OnEvent(const msg: string);
begin
Memo1.Lines.Add(msg);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
StopAcnt.Execute;
end;
procedure TForm1.RunAcntExecute(Sender: TObject);
var i:integer;
Path,s:string;
FileStream:TFileStream;
HttpThread:THttpThread;
L:TList;
begin
if Edit1.Text="" then exit;
Memo1.Clear;
Path:=ExtractFilePath(Application.ExeName)+"files\";
ForceDirectories(Path);
try
FileStream:=TFileStream.Create(Path+"mask.txt",fmCreate);
try
s:=Edit1.Text;
FileStream.WriteBuffer(PChar(s)^,length(s));
finally
FileStream.Free;
end;
except
end;
L:=FList.LockList;
try
for i:=SpinEdit1.Value to SpinEdit2.Value do
L.Add(pointer(i));
finally
FList.UnlockList;
end;
for i:=0 to SpinEdit3.Value-1 do
begin
HttpThread:=THttpThread.Create;
HttpThread.FreeOnTerminate:=true;
HttpThread.OnEvent:=OnEvent;
HttpThread.Path:=Path;
if IniFile.ReadBool("Proxy","Use",false) then
begin
HttpThread.IdHTTP.HTTPOptions:=[hoInProcessAuth,hoForceEncodeParams];
HttpThread.IdHTTP.ProxyParams.BasicAuthentication:=IniFile.ReadBool("Proxy","Bas icAuth",true);
HttpThread.IdHTTP.ProxyParams.ProxyPort:=IniFile.ReadInteger("Proxy","Port",3128 );
HttpThread.IdHTTP.ProxyParams.ProxyServer:=IniFile.ReadString("Proxy","Host","") ;
HttpThread.IdHTTP.ProxyParams.ProxyUsername:=IniFile.ReadString("Proxy","Usernam e","");
HttpThread.IdHTTP.ProxyParams.ProxyPassword:=IniFile.ReadString("Proxy","Passwor d","");
end;
HttpThread.IdHTTP.AllowCookies:= False;
HttpThread.Mask:=Edit1.Text;
HttpThread.FileMask:=Edit2.Text;
HttpThread.List:=FList;
HttpThread.Resume;
end;
end;
procedure TForm1.RunAcntUpdate(Sender: TObject);
var List:TList;
begin
List:=Threads.LockList;
try
TAction(Sender).Enabled:=List.Count=0;
finally
Threads.UnlockList;
end;
end;
constructor TForm1.Create(AOwner: TComponent);
begin
inherited;
FList:=TThreadList.Create;
FIniFile:=TMemIniFile.Create(ChangeFileExt(ParamStr(0),".ini"));
end;
destructor TForm1.Destroy;
begin
FIniFile.Free;
FList.Free;
inherited;
end;
procedure TForm1.StopAcntUpdate(Sender: TObject);
var List:TList;
begin
List:=Threads.LockList;
try
TAction(Sender).Enabled:=List.Count<>0;
finally
Threads.UnlockList;
end;
end;
procedure TForm1.StopAcntExecute(Sender: TObject);
var i:integer;
List:TList;
begin
List:=Threads.LockList;
try
for i:=0 to List.Count-1 do
if assigned(List.Items[i]) then
THttpThread(List.Items[i]).Terminate;
finally
Threads.UnlockList;
end;
end;
procedure TForm1.Action1Update(Sender: TObject);
var List:TList;
begin
List:=Threads.LockList;
try
if List.Count=0 then
TAction(Sender).Caption:="Run"
else
TAction(Sender).Caption:="Stop";
finally
Threads.UnlockList;
end;
end;
procedure TForm1.Action1Execute(Sender: TObject);
begin
if Action1.Caption="Run" then
RunAcnt.Execute
else
StopAcnt.Execute;
end;
procedure TForm1.Button2Click(Sender: TObject);
var ProxyEdit:TProxyEdit;
begin
ProxyEdit:=TProxyEdit.Create(nil);
try
ProxyEdit.ShowModal;
finally
ProxyEdit.Free;
end;
end;
end.
← →
Slym © (2011-03-12 14:49) [5]
object Form1: TForm1
Left = 240
Top = 156
Width = 409
Height = 332
Caption = "Downloader"
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = "MS Sans Serif"
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
PixelsPerInch = 96
TextHeight = 13
object Memo1: TMemo
Left = 0
Top = 82
Width = 393
Height = 212
Align = alClient
TabOrder = 0
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 393
Height = 82
Align = alTop
AutoSize = True
BevelOuter = bvNone
BorderWidth = 5
TabOrder = 1
object Edit1: TEdit
Left = 8
Top = 5
Width = 385
Height = 21
Hint = "!d, !.2d"
ParentShowHint = False
ShowHint = True
TabOrder = 0
Text = "!d.html"
end
object SpinEdit1: TSpinEdit
Left = 8
Top = 29
Width = 121
Height = 22
MaxValue = 0
MinValue = 0
TabOrder = 1
Value = 1
end
object SpinEdit2: TSpinEdit
Left = 136
Top = 29
Width = 121
Height = 22
MaxValue = 0
MinValue = 0
TabOrder = 2
Value = 10
end
object SpinEdit3: TSpinEdit
Left = 264
Top = 29
Width = 49
Height = 22
MaxValue = 0
MinValue = 0
TabOrder = 3
Value = 5
end
object Button1: TButton
Left = 320
Top = 29
Width = 73
Height = 25
Action = Action1
TabOrder = 4
end
object Edit2: TEdit
Left = 8
Top = 56
Width = 121
Height = 21
Hint = "%d, %.2d"
TabOrder = 5
end
object Button2: TButton
Left = 320
Top = 56
Width = 73
Height = 21
Caption = "Proxy"
TabOrder = 6
OnClick = Button2Click
end
end
object ActionList1: TActionList
Left = 296
Top = 96
object RunAcnt: TAction
Caption = "Run"
OnExecute = RunAcntExecute
OnUpdate = RunAcntUpdate
end
object StopAcnt: TAction
Caption = "Stop"
OnExecute = StopAcntExecute
OnUpdate = StopAcntUpdate
end
object Action1: TAction
Caption = "Run"
OnExecute = Action1Execute
OnUpdate = Action1Update
end
end
end
← →
Slym © (2011-03-12 14:50) [6]Сей проект тупо по маске многопоточно качает файлы...
← →
Slym © (2011-03-12 14:52) [7]гдето валяется проект на wsh (vbs) качка файлоф по списку, если надо поищу
← →
DVM © (2011-03-12 15:22) [8]
> try
> IdHTTP1.Get(AUrl, Stream);
> except
> try
> DeleteFile(Afile_name);
> except
>
> end;
>
> end;
У тебя сокеты кончаются вероятно, а ты глушишь все исключения не глядя.
Сокеты они не сразу освобождаются.
← →
LDV (2011-03-12 17:51) [9]
> Сокеты они не сразу освобождаются.
а если, например, через каждые 25 файлов делать sleep на 15-20 сек?
← →
DVM © (2011-03-12 19:11) [10]
> LDV (12.03.11 17:51) [9]
Попробуй, если конечно проблема в этом. Тут еще дело может быть в том, что прокси не позволяет делать множество коннектов через него так быстро или сам сайт с которого качают. А исключения надо не давить, а логгировать хотя бы. Наверняка Indy что то да выбрасывает. А то гадание на кофейной гуще получается.
Страницы: 1 вся ветка
Форум: "Начинающим";
Текущий архив: 2011.06.19;
Скачать: [xml.tar.bz2];
Память: 0.5 MB
Время: 0.003 c