Help with IDhttp and thread

Version imprimable

26/10/2020, 04h28
clubreseau

Help with IDhttp and thread

Hi,

Here is what I would like to do.

a simple Form with a Tlistbox which would contain several URLs with a TButton and a TMemo.

To make it simple, I try as quickly as possible to go to all the URLs of my listbox and take the source page of each URL in my listbox and if in the page the word Welcome is there. then insert the url in the Tmemo

I have watched several tutorials that talk about Thread and Parallel Programming Library I can't seem to do this. I'm trying from this tutorial https://stackoverflow.com/questions/37123765/how-t... but it doesn't work.

Could someone give me a piece of code that will do the job.

Thank you and sorry for my english
26/10/2020, 08h30
SergioMaster

Bonjour,

Citation:

Envoyé par clubreseau

Thank you and sorry for my english

D'autant plus que vous êtes sur un forum francophone ! cf régles étrange quand même que vous soyez passé à côté, d'autant que vos autres messages (2) ont été rédigés en français !

Citation:

Could someone give me a piece of code that will do the job.

Cela ne se passe pas comme ça, généralement nous préférons que vous nous montriez le code que vous avez pu produire, code entre balises (utilisation du bouton #) pour une meilleure lecture,
afin de vous proposer les corrections/solutions adaptées.

Citation:

I have watched several tutorials that talk about Thread and Parallel Programming Library I can't seem to do this.

Peut-être n'êtes vous pas tombé sur les bons, je vous conseille la présentation hyper pédagogique d'Olaf Monien (Bootcamp 2018) https://www.embarcaderoacademy.com/p...otcamp-threads
26/10/2020, 08h35
Paul TOTH

Bonjour,

pas de soucis, sur ce forum francophone, nous sommes non seulement très forts mais aussi polyglottes :)

Dans le code proposé, il est fait accès à Memo1 directement depuis le Thread ce qui n'est pas possible, il faut passer par Synchronize.

Sinon la réponse de Remy est tout à fait pertinente, et "ça marche pas" n'est pas un message d'erreur valide.

Très cordialement

Bonjour a tous,

VOici mon code dans le bouton 1

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
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
lpath:string;
 
begin
 
    for i := 0 to ListBox1.Items.Count-1 do
  begin
    lPath := ListBox1.Items.Strings[i];
 
TTask.Create(
              procedure
              var HTTP : TidHTTP;
                        IdSSL: TIdSSLIOHandlerSocketOpenSSL;
                          content : String;
                          URI: TIdURI;
              begin
                HTTP := TIdHTTP.Create(nil);
 
 
                         try
 
        HTTP.ReadTimeout := 30000;
        HTTP.HandleRedirects := True;
        IdSSL := TIdSSLIOHandlerSocketOpenSSL.Create(HTTP);
        IdSSL.SSLOptions.Method := sslvTLSv1_2;
        IdSSL.SSLOptions.Mode := sslmClient;
        HTTP.IOHandler := IdSSL;
        HTTP.AllowCookies:=true;
        HTTP.Request.UserAgent := 'Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/41.0.2227.0 Safari/537.36';
    HTTP.Request.Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
    HTTP.Request.AcceptLanguage := 'en-GB,en;q=0.5';
    HTTP.Request.Connection := 'keep-alive';
    HTTP.Request.ContentType := 'application/x-www-form-urlencoded';
 
    HTTP.CookieManager := TIdCookieManager.Create(HTTP);
 
 
 
    URI := TIdURI.Create('http://localhost');
    try
      HTTP.CookieManager.AddServerCookie('habari=10283454', URI);
    finally
      URI.Free;
    end;
 
 
                   Content := HTTP.Get(lpath);
 
 
                         finally
 
 
                   TThread.queue(TThread.Current, procedure begin
                //form1.memo1.lines.add('2222');
                    memo1.text := 'AAA= '+Content+' =BBB';
                    listbox2.Items.Add(lpath);
                  end);
 
 
 
                 end;
 
  end ).Start;
end;
 end;

bizarrement il semble ajouter toujours dans le listbox2 le dernier Url dans listbox1 qui est lpath.
il

c'est normal, c'est le bug classique des boucles et des closures...lpath capturé mais pas sa valeur.

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
 
procedure TForm1.Button1Click(Sender: TObject);
var
  i:integer;
  lpath:string; 
begin
  for i := 0 to ListBox1.Items.Count-1 do
  begin
    lPath := ListBox1.Items.Strings[i];
    download(lPath);
   end;
 end;
 
 procedure TForm1.Download(lpath: string)
 begin
    TTask.Create(
      procedure
      var 
        HTTP : TidHTTP;
        IdSSL: TIdSSLIOHandlerSocketOpenSSL;
        content : String;
        URI: TIdURI;
      begin
        HTTP := TIdHTTP.Create(nil);
        try
          HTTP.ReadTimeout := 30000;
          HTTP.HandleRedirects := True;
          IdSSL := TIdSSLIOHandlerSocketOpenSSL.Create(HTTP);
          IdSSL.SSLOptions.Method := sslvTLSv1_2;
          IdSSL.SSLOptions.Mode := sslmClient;
          HTTP.IOHandler := IdSSL;
          HTTP.AllowCookies:=true;
          HTTP.Request.UserAgent := 'Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/41.0.2227.0 Safari/537.36';
          HTTP.Request.Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
          HTTP.Request.AcceptLanguage := 'en-GB,en;q=0.5';
          HTTP.Request.Connection := 'keep-alive';
          HTTP.Request.ContentType := 'application/x-www-form-urlencoded';
          HTTP.CookieManager := TIdCookieManager.Create(HTTP);
          URI := TIdURI.Create('http://localhost');
          try
            HTTP.CookieManager.AddServerCookie('habari=10283454', URI);
          finally
            URI.Free;
          end;
          Content := HTTP.Get(lpath);
        finally
          TThread.queue(TThread.Current, 
          procedure 
          begin
            //form1.memo1.lines.add('2222');
            memo1.text := 'AAA= '+Content+' =BBB';
            listbox2.Items.Add(lpath);
          end);
        end;
 
      end 
    ).Start;
  end;
end;

26/10/2020, 19h16
clubreseau

Bonjour,

de cette façon ca fonctionne mais ses très lent, ce que je veux dire, quelque fois 1 url prend 2 secondes avant de passer le source de la page dans le memo, alors avant de continuer il attend les 2 secondes.

Comment dison utiliser 5 thread en meme temps, passer la sources de l'URL dans 1 memo different pour chaque source , je peux remplacer le memo par 1 string pour aller plus vite. J'essaye d'optimiser :)

J'aimerais utlisers plusieurs thread pour passer les urls dans la listbox plus rapidement.

on ma dit d'utliser plutot TParallel.For() mais je connais pas ca ! a tu une idée ?

Aussi dans memo1 à chaque URl source j'ai ce message



comment enlever ça !

Merci pour ton aide

Citation:

Envoyé par clubreseau

alors avant de continuer il attend les 2 secondes.

J'en doute puisque les ITask tournent en parallèle. Le problème se situerait plutôt au niveau de la tâche principale qui est trop occupée pour traiter les appels TThread.Queue.

Citation:

Envoyé par clubreseau

on ma dit d'utliser plutot TParallel.For() mais je connais pas ca ! a tu une idée ?

TParallel.For est bloquant, il ne retourne que lorsque toutes les tâches secondaires sont terminées. Ce n'est pas ce que tu veux.

Mais il s'utiliserait ainsi :
Code:

1 2 3 4 5 6 7 8 var URIs := ListBox1.Items.ToStringArray; TParallel.For(0, High(URIs), procedure(i: integer) begin ... Content := HTTP.Get(URIs[i]); ... end);

27/10/2020, 10h45
ShaiLeTroll

Qu'est ce que c'est moche et illisible !
Pourquoi ne pas revenir aux fondamentaux ?

Si le code d'utilisation de TIdHTTP est toujours le même, faire une petite classe héritée de TThread avec juste Path passé au constructeur, garder la récupération du Content aussi en thread dans des TStringList (oui si le Content est important, l'affectation à Text provoque un parsage du contenu ligne par ligne) et enfin une notification envoyée vers l'IHM pour recopier la TStringList (autant par thread donc autant que d'URL) vers Lines; je ferais des onglets pour avoir autant de TMemo que nécessaire pour afficher tous les contenus
27/10/2020, 12h56
clubreseau

Bonjour,

Citation:

Envoyé par ShaiLeTroll

Qu'est ce que c'est moche et illisible !
Pourquoi ne pas revenir aux fondamentaux ?

Si le code d'utilisation de TIdHTTP est toujours le même, faire une petite classe héritée de TThread avec juste Path passé au constructeur, garder la récupération du Content aussi en thread dans des TStringList (oui si le Content est important, l'affectation à Text provoque un parsage du contenu ligne par ligne) et enfin une notification envoyée vers l'IHM pour recopier la TStringList (autant par thread donc autant que d'URL) vers Lines; je ferais des onglets pour avoir autant de TMemo que nécessaire pour afficher tous les contenus

Tu pourrais me donner un bout de code svp pour m'aider, je suis très visuel.

Merci Beaucoup
27/10/2020, 13h09
Paul TOTH
par ailleurs, je soupçonne que ceci ne devrait être fait qu'une fois
Code:

1 2 3 4 5 6 7 URI := TIdURI.Create('http://localhost'); try HTTP.CookieManager.AddServerCookie('habari=10283454', URI); finally URI.Free; end;
après si le server met 2s à répondre, aucune optimisation côté client ne pourra accélérer les choses :)
27/10/2020, 13h24
clubreseau

Bonjour,
Je pensait plutôt à cree 3 idhttp avec 3 memo et envoi 3 URL d'un coup. Si 1 bloque les 2 autres continue.

On peut faire ça ?
27/10/2020, 15h43
clubreseau

Quelqun peux me donné un bout de code pour pouvoir envoyer 3 lien du listbox dans 3 memo différents a la fois

Pourquoi mon code quand j'ai plus de 50 URL dans mon listbox la fenetre Freeze ?

voici mon code...

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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
procedure TForm1.Button2Click(Sender: TObject);
begin
ShellExecute(Handle,'open', PChar(form1.ListBox2.Items[form1.ListBox2.ItemIndex]),nil, nil, SW_SHOWNORMAL);
end;
 
function TFORM1.Download(lPath: string): ITask;
begin
  Result := TTask.Run(
    procedure
    var
      lHTTP: TIdHTTP;
      IdSSL: TIdSSLIOHandlerSocketOpenSSL;
      URI: TIdURI;
      content:string;
      fmatch : TMatchCollection;
      regex2 : TRegEx;
      fmatchcount:string;
    begin
      lHTTP := TIdHTTP.Create(nil);
      try
        lHTTP.ReadTimeout := 5000;
        lHTTP.HandleRedirects := True;
        IdSSL := TIdSSLIOHandlerSocketOpenSSL.Create(lHTTP);
        IdSSL.SSLOptions.SSLVersions := [sslvTLSv1, sslvTLSv1_1, sslvTLSv1_2];
        IdSSL.SSLOptions.Mode := sslmClient;
        lHTTP.IOHandler := IdSSL;
        lHTTP.AllowCookies := True;
        lHTTP.Request.UserAgent := 'Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/41.0.2227.0 Safari/537.36';
        lHTTP.Request.Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
        lHTTP.Request.AcceptLanguage := 'en-GB,en;q=0.5';
 
        content:=lHTTP.Get(lPath);
      except
        on E: EIdHTTPProtocolException do
        begin
          if E.ErrorCode = 404 then
          begin
            TThread.Synchronize(nil,
              procedure
              begin
                ListBox2.Items.Add(lPath);
              end
            );
          end;
            end;
 
       on E: Exception do
        begin
 
        TThread.Synchronize(nil,
              procedure
              begin
                lHTTP.Disconnect(False);
                lHTTP.Free;
              end
            );
 
 
          Exit;
        end;
      end;
 
      TThread.Queue(nil, // or Synchronize()
        procedure
        begin
 
         // Memo1.Lines.Add(content);
 
        Regex2 := TRegEx.Create('Welcome', [roIgnoreCase]);
 
        fmatch := regex2.Matches(content);
        fmatchcount:=IntToStr(fmatch.Count);
 
 
           if fmatchcount > '0' then
 
           listbox2.items.Add(lpath);
 
        end
      );
    end
  );
end;
 
 
procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
  TaskList: TList<ITask>;
  T: ITask;
begin
  TaskList := TList<ITask>.Create;
  try
    for i := 0 to ListBox1.Items.Count-1 do begin
      T := Download(ListBox1.Items.Strings[i]);
      TaskList.Add(T);
    end;
 
    while not TTask.WaitForAll(TaskList.ToArray, 500) do begin
      CheckSynchronize();
      Update;
    end;
 
  finally
    TTask.WaitForAll(T);
    TaskList.Free;
  end;
end;