Contrôle d'Url TIdHttp

Version imprimable

Bonjour a tous , Est bonne années :)

Me voila confronté a un petit problème pour contrôler plus de 1 000 000 D’URL avec la fonction ci dessous, Je vous laisse imaginer le temps que sa prend de tout contrôlé :?.
Donc je me demander si il existé une autre méthode pour traité le contrôle des URL un peu plus vite.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Function CheckUrl(Url: String): Boolean; var CtrlUrl: TIdHTTP; begin Result := False; CtrlUrl := TIdHTTP.Create(nil); try CtrlUrl.Get(Url); Result := True; except Result := False; end; FreeAndNil(CtrlUrl); end;
Un grand merci pour votre réponse est votre aide.

02/01/2015, 12h04
tourlourou

1) ne pas détruire/recréer l'objet à chaque fois ;
2) utiliser un pool de threads pour paralléliser ;
3) je ne sais pas si un simple ping suffit, qui irait certainement plus vite ?
02/01/2015, 14h14
Andnotor

Egalement utiliser Head à la place de Get pour ne récupérer que l'entête et non la page complète.
En multi-thread, le temps total serait fortement divisé puisque l'application passe son temps à attendre une réponse des serveurs ;)
Essayer aussi de jouer avec un timeout si le serveur n'est pas accessible.

Je suis pas un grand spécialiste dans les Threads

Merci pour votre aide :) donc j'ai tester se code si dessous mais cela ne change en rien a la vitesse de traitement des URL

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
type
  TMyThread = class(TThread)
  protected
    procedure Execute; override;
  end;
 
var
  Form1: TForm1;
 
  Controle: String;
  ResultCtrl: Boolean;
 
  IdHTTP: TIdHTTP;
 
implementation
 
{$R *.dfm}
 
procedure TMyThread.Execute;
begin
  ResultCtrl := False;
  if Terminated then Exit;
  try
    IdHTTP.Head(Controle);
    ResultCtrl := True;
  except
    ResultCtrl := False;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
  LThread: TMyThread;
begin
  LThread := TMyThread.Create(True);
  IdHTTP := TIdHTTP.Create(nil);
 
  for I := 0 to Memo1.Lines.Count - 1 do
   begin
     Controle := Memo1.Lines.Strings[I];
     LThread.Execute;
     if ResultCtrl = False then
     begin
       Showmessage('Error :' + Memo1.Lines.Strings[I]);
     end;
   end;
   LThread.Free;
   IdHTTP.Free;
end;

02/01/2015, 17h37
tourlourou

Il est question de paralléliser le travail des threads et non de sérialiser les traitements dans un thread pour gagner du temps.

Il faut donc créer plusieurs threads (optimum = ?) et avoir une gestion de type queue pour relancer un nouveau test à chaque fois qu'un thread est libre.

ShaiLeTroll a souvent évoqué ce type de choses, avec du code pour l'illustrer.
02/01/2015, 18h39
Andnotor

Tu n'utilises pas de thread là. Tu en crées un à l'état suspendu, ne le démarre jamais et appelles simplement une de ses méthodes depuis la tâche principale :koi:
Execute ne doit pas être appelé directement, c'est le thread Windows (encapsulé dans TThread) qui s'en charge.

Et comme le dit tourlourou, il en faut plusieurs pour constater une amélioration, 10 voire plus.
J'avais fait un petit tuto sur l'accélération du téléchargement. C'est un peu compliqué pour ce que tu veux faire mais le principe général est le même.
03/01/2015, 15h52
Gregory666

Essayer aussi de jouer avec un timeout si le serveur n'est pas accessible.

Oui cela est intéressent , ReadTimeout mais quel est la valeur minimum que je pourrai maitre (100) Trop juste (1500) Trop long mais avec un résultat 100% OK. :D

Combien de temps il faut pour savoir si URL est valide ou pas ? Merci ;)
03/01/2015, 18h32
tourlourou

Je ne sais pas quel est le "bon" TimeOut. Mais le code peut être adaptatif : on passe l'URL à un pool de threads avec TimeOut court : selon le taux de réussite, on allonge ce TimeOut, tout en passant les URL rejetées pour TimeOut à un pool de threads avec TimeOut plus long. Reste à faire la balance entre nombre de threads pour chaque longueur de TimeOut.

Après, reste à savoir quel est le besoin : donner une réponse certaine (ne pas rejeter d'URL à tort), ou traiter le plus vite possible avec une fiabilité relative. Ceci dépendant des traitements à faire ensuite : si les URL validées sont transmises ensuite à un processus qui peut être long (pendant lequel on peut encore valider les plus lentes) ou seulement enregistrées comme valides.
03/01/2015, 23h43
Andnotor

Ce n'est pas tant à la lecture que je pensais. En ne récupérant que l'entête, le volume de données est faible mais au temps de connexion (ConnectTimeout) si le serveur est hors ligne. Une fois connecté et si l'url est invalide, l'erreur 404 ne va pas tarder ;)
Il faudrait tout de même le définir à plusieurs secondes.

Maintenant, il peut aussi y avoir une gestion d'erreur au niveau .htaccess qui redirige par exemple sur la page principale et renverra ainsi un faux-positif... 100% de réussite est difficilement envisageable. Il faudrait encore voir ce qui serait utilisable dans l'entête.

Contrôle Url multi thread

Pièce jointe 166340Bonjour a tous,

Grasse a 2 Threads je viens de diviser le temps de traitement par 2 :D

Tout les URL html son dans un fichier Xml séparer d'un #13 exemple: (http://www.AAA.html#13http://www.BBB.html)...

Voici le code si dessous

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
var
  FCtrlHtml: TFCtrlHtml;
 
  IdThread1, IdThread2: TIdhttp;
  Thread1, Thread2: Cardinal;
  HandleThread1, HandleThread2: Integer;
 
  TabThread1: Array of String;
  TabThread2: Array of String;
 
  IArray: Array[1..2] of Integer;
 
implementation
 
{$R *.dfm}

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
{Thread N°1}
procedure TThread1;
var
  I: Integer;
begin
  IdThread1 := TIdHttp.Create(nil);
  FCtrlHtml.GThread1.MaxValue := Length(TabThread1);
  for I := Low(TabThread1) to High(TabThread1) do
   begin
      FCtrlHtml.LabThread1.Caption := TabThread1[I];
     try
       IdThread1.Head(TabThread1[I]);
     except
       FCtrlHtml.ListErr.Lines.Add('Thread N° 1 : ' + TabThread1[I]);
     end;
    FCtrlHtml.GThread1.Progress := FCtrlHtml.GThread1.Progress +1;
    FCtrlHtml.GThread1.Suffix := '% | ' + IntToStr(FCtrlHtml.GThread1.Progress) + ' / ' + IntToStr(Length(TabThread1));
   end;
  TerminateThread(HandleThread1 ,0);
  IdThread1.Free;
end;

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
{Thread N°2}
procedure TThread2;
var
  I: Integer;
begin
  IdThread2 := TIdHttp.Create(nil);
  FCtrlHtml.GThread2.MaxValue := Length(TabThread2);
  for I := Low(TabThread2) to High(TabThread2) do
   begin
      FCtrlHtml.LabThread2.Caption := TabThread2[I];
     try
       IdThread2.Head(TabThread2[I]);
     except
       FCtrlHtml.ListErr.Lines.Add('Thread N° 2 : ' + TabThread2[I]);
     end;
    FCtrlHtml.GThread2.Progress := FCtrlHtml.GThread2.Progress +1;
    FCtrlHtml.GThread2.Suffix := '% | ' + IntToStr(FCtrlHtml.GThread2.Progress) + ' / ' + IntToStr(Length(TabThread2));
   end;
  TerminateThread(HandleThread2 ,0);
  IdThread2.Free;
end;

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
{Démarrer le contrôle}
procedure TFCtrlHtml.BtnStartThreadClick(Sender: TObject);
var
 ListHtml, Html: TStringList;
 I, RcCount, DivRc: Integer;
begin
  BtnStartThread.Enabled := False;
  BtnStopThread.Enabled := True;
  RcCount := 0;
  ListHtml := TStringList.Create;
  Html := TStringList.Create;
  DataSetXml.Active := True;
 with DataSetXml do
  while not Eof do
   begin
     ListHtml.Text := FieldByName('Html').Value;
 
     for I := 0 to ListHtml.Count - 1 do
      begin
        Html.Add(ListHtml.Strings[I]);
      end;
 
     RcCount := RcCount + ListHtml.Count;
     Stat.Panels[1].Text := IntTostr(RcCount);
     ListHtml.Clear;
     I := 0;
     Next;
   end;
 
  DataSetXml.Active := False;
  ListHtml.Free;
 
  I := 0;
  DivRc := RcCount div 2; {Divise la liste des URL en 2}
 
  for I := 0 to DivRc do
   begin {Liste url Html N°1}
     SetLength(TabThread1, IArray[1] +1);
     TabThread1[IArray[1]] := Html.Strings[I];
     Inc(IArray[1]);
   end;
  Stat.Panels[3].Text := IntTostr(Length(TabThread1));
 
  I := 0;
  Inc(DivRc);
 
  for I := DivRc to Html.Count - 1 do
   begin {Liste url Html N°2}
     SetLength(TabThread2, IArray[2] +1);
     TabThread2[IArray[2]] := Html.Strings[I];
     Inc(IArray[2]);
   end;
  Stat.Panels[5].Text := IntTostr(Length(TabThread2));
 
  Html.Free;
 
  {Créer le Thread N°1}
  HandleThread1 := BeginThread(nil, 1024, @TThread1, nil, 0, Thread1);
  SetThreadPriority(HandleThread1,  THREAD_PRIORITY_HIGHEST);
 
  {Créer le Thread N°2}
  HandleThread2 := BeginThread(nil, 1024, @TThread2, nil, 0, Thread2);
  SetThreadPriority(HandleThread2,  THREAD_PRIORITY_HIGHEST);
end;

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
{Arrêter le contrôle}
procedure TFCtrlHtml.BtnStopThreadClick(Sender: TObject);
begin
  TerminateThread(HandleThread1 ,0);
  TerminateThread(HandleThread2 ,0);
  IdThread1.Free;
  IdThread2.Free;
  ListErr.Clear;
  GThread1.Progress := 0;
  GThread2.Progress := 0;
  LabThread1.Caption := '...';
  LabThread2.Caption := '...';
  BtnStartThread.Enabled := True;
  BtnStopThread.Enabled := False;
end;

Code:

1
2
3
4
5
{A la fermeture du form}
procedure TFCtrlHtml.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  BtnStopThreadClick(Self);
end;

Code:

1
2
3
4
5
{Compte le nombre d'url invalide}
procedure TFCtrlHtml.ListErrChange(Sender: TObject);
begin
  Stat.Panels[7].Text := IntToStr(ListErr.Lines.Count);
end;

Voila maintenant j'aimerai créer un Thread qui peu traiter 10 URL ou plus d'un coup , je pence que la méthode ne dois pas être la même ?

Merci de votre réponse.

Il suffit d'utiliser une liste unique et d'incrémenter un index. L'accès à cet index doit bien évidemment être synchronisé (ici par InterlockedIncrement).

Au plus simple, ça donnerait ceci:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
type
  TURLThread = class(TThread)
  private
    Id  :integer;
  protected
    procedure Execute; override;
  public
    constructor Create(aId :integer);
  end;
 
  TForm1 = class(TForm)
    bStart: TButton;
    Memo1: TMemo;
    procedure bStartClick(Sender: TObject);
  private
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses StrUtils, Types;
 
const
  ThreadCount = 10;
 
var
  URLList  :TStringDynArray;
  URLIndex :integer;
 
procedure TForm1.bStartClick(Sender: TObject);
var
  i: Integer;
 
begin
  URLList  := SplitString('http://www.google.fr/'#13'http://www.developpez.net/forums/', #13);
  URLIndex := -1;
 
  for i := 1 to ThreadCount do
    TURLThread.Create(i);
end;
 
{ TURLThread }
 
constructor TURLThread.Create(aId :integer);
begin
  inherited Create;
 
  Id := aId;
  FreeOnTerminate := TRUE;
end;
 
procedure TURLThread.Execute;
var
  i :integer;
  s :string;
 
begin
  with TIdHTTP.Create do
  begin
 
    while not Terminated do
    begin
      i := InterlockedIncrement(URLIndex);
      if i > high(URLList) then Break;
 
      try
        Head(URLList[i]);
      except
        on E:Exception do
        begin
          s := Format('Thread N°%d : %s (%s)', [Id, E.Message, URLList[i]]);
 
          Synchronize(procedure
                      begin
                        Form1.Memo1.Lines.Add(s);
                      end);
        end;
      end;
    end;
 
    Free;
  end;
end;

Thread

A super je vais tester sa Merci Andnotor, par contre au-bout d'un serre tin temps j'ai un message d’erreur : Descripteur non valide , est le programme plante de quoi pourrai venir cette erreur ? J'ai remarquer que le message a parai pas toujours au même en droit un coup sa plante a 23% (Gauge) , je relance le thread est sa plante a ~ 60% :( le thread s’endort peu être. est cela le fait avec les 2 threads un coup c'est le thread N°1 qui plante ou des fois c'est le N° 2 j'ai l’impression qui manque quel que chose dans le code du thread ?
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 {Thread N°1} procedure TThread1; var I: Integer; begin IdThread1 := TIdHttp.Create(nil); FCtrlHtml.GThread1.MaxValue := Length(TabThread1); for I := Low(TabThread1) to High(TabThread1) do begin FCtrlHtml.LabThread1.Caption := TabThread1[I]; try IdThread1.Head(TabThread1[I]); except FCtrlHtml.ListErr.Lines.Add('Thread N° 1 : ' + TabThread1[I]); end; FCtrlHtml.GThread1.Progress := FCtrlHtml.GThread1.Progress +1; FCtrlHtml.GThread1.Suffix := '% | ' + IntToStr(FCtrlHtml.GThread1.Progress) + ' / ' + IntToStr(Length(TabThread1)); end; TerminateThread(HandleThread1 ,0); IdThread1.Free; end;
Cela pourrait' il venir du TIdHttp peu être les déclarer en ThreadVar ? J'ai rechercher sur le net d’après plusieurs commentaire sa pourrai venir des 2 threads qui voudrai charger ou modifier en même temps le même Objet ou la même variable. Pour les Objets je pence pas que sa viens de la chaque thread a c'est propre objets mais en regardent de plus prés je vois qui on chacun leur variable attitré. :?
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 var FCtrlHtml: TFCtrlHtml; IdThread1, IdThread2: TIdhttp; Thread1, Thread2: Cardinal; HandleThread1, HandleThread2: Integer; TabThread1: Array of String; TabThread2: Array of String; IArray: Array[1..2] of Integer; implementation {$R *.dfm}

18/01/2015, 11h18
Andnotor

Accéder aux éléments graphiques depuis un thread secondaire est très mauvais. Il faut les modifier uniquement depuis la tâche principale (d'où le Synchronize dans mon exemple).
L'idéal serait de ne pas du tout gérer l'affichage depuis ces threads mais uniquement de notifier la fenêtre principale du résultat par PostMessage.
18/01/2015, 16h49
Gregory666

SplitString n'est pas reconnue par Delphi 2010

Merci Andnotor pour l'info :D , Par contre SplitString n'est pas reconnue par Delphi 2010 :? donc je vais replacer cette par partir par un tableau dynamique avec tout les Url en une liste, Dans quel partie du programme je pourrai voir la progression général des url traiter par les Threads ?

Est encore Merci :D