Текущий архив: 2011.06.19;
Скачать: CL | DM;

Вниз

много 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;
Скачать: CL | DM;

Наверх

Память: 0.52 MB
Время: 0.006 c