Problème avec TList et Threads

Version imprimable

Bonjour tous le monde,

J'ai un petit soucis j'essaye de faire un programme qui teste une liste d'ips qu'on lui charge depuis un fichier texte pour qu'il fasse differents tests dessus.

Pour avoir une gestion dynamique des threads et pour que l'utilisateur puisse choisir sur combien de threads testes etc ... j'ai utilise une TList mais j'ai un soucis lors de la creation du thread une exception est soulevee.

Unit1.pas

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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons;
 
type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    ListBox1: TListBox;
    BitBtn2: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses
   Unit2;
 
Type
   PTestThread = ^TTestThread;
 
Var
   IpToTest   : TStringList;
   ThreadList : TList;
   TestThread : PTestThread;
   MaxThreads : Integer;
   i          : Integer;
 
{$R *.dfm}
 
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
   i := 0;
 
   while i < IpToTest.count do
   begin
      if ThreadList.count <= MaxThreads then
      begin
         new(TestThread);
         TestThread^.create(true);
         TestThread^.FreeOnTerminate := true;
         TestThread^.resume;
         ThreadList.add(TestThread);
         inc(i);
      end;
   end;
end;
 
procedure TForm1.BitBtn2Click(Sender: TObject);
var
   openDialog : TOpenDialog;
begin
   openDialog := TOpenDialog.Create(self);
   try
      openDialog.InitialDir := GetCurrentDir;
      openDialog.Options := [ofFileMustExist];
      openDialog.Filter := 'Tous les fichiers|*.*';
      openDialog.FilterIndex := 2;
      if openDialog.Execute then begin
         IpToTest.LoadFromFile(openDialog.FileName);
         ListBox1.Items.LoadFromFile(openDialog.FileName);
      end;
   finally
      openDialog.Free;
   end;
end;
 
Initialization
   IpToTest := TStringList.Create;
   ThreadList := TList.Create;
 
Finalization
   IpToTest.Free;
   ThreadList.Free;
 
end.

Unit2.pas

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
unit Unit2;
 
interface
 
uses
  Classes;
 
type
  TTestThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;
 
implementation
 
{ Important: Methods and properties of objects in visual components can only be
  used in a method called using Synchronize, for example,
 
      Synchronize(UpdateCaption);
 
  and UpdateCaption could look like,
 
    procedure TTestThread.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }
 
{ TTestThread }
 
procedure TTestThread.Execute;
begin
  { Place thread code here }
end;
 
end.

Je suis sur (quasi) que le probleme vient des pointeurs, si qqn peut m'eclairer je lui en serait tres reconnaissant, merci

P.S : desole pour la poncutatiom j'utilise un clavier qwerty

Pourquoi utiliser un pointeur?

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
 
var
  Form1: TForm1;
 
implementation
 
uses
   Unit2;
 
Var
   IpToTest   : TStringList;
   ThreadList : TList;
   TestThread : TTestThread;
   MaxThreads : Integer;
   i          : Integer;
 
{$R *.dfm}
 
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
   i := 0;
 
   while i < IpToTest.count do
   begin
      if ThreadList.count <= MaxThreads then
      begin
         TestThread := TTestThread.Create;
         TestThread.FreeOnTerminate := True;
         TestThread.Resume;
         ThreadList.add(TestThread);
         inc(i);
      end;
   end;
end;
 
procedure TForm1.BitBtn2Click(Sender: TObject);
var
   openDialog : TOpenDialog;
begin
   openDialog := TOpenDialog.Create(self);
   try
      openDialog.InitialDir := GetCurrentDir;
      openDialog.Options := [ofFileMustExist];
      openDialog.Filter := 'Tous les fichiers|*.*';
      openDialog.FilterIndex := 2;
      if openDialog.Execute then begin
         IpToTest.LoadFromFile(openDialog.FileName);
         ListBox1.Items.LoadFromFile(openDialog.FileName);
      end;
   finally
      openDialog.Free;
   end;
end;
 
Initialization
   IpToTest := TStringList.Create;
   ThreadList := TList.Create;
 
Finalization
   IpToTest.Free;
   ThreadList.Free;
 
end.

Par contre une TList ne libère pas ses objets quand elle est détuite, contrairement à une TObjectList

21/08/2007, 17h36
necralbert

Merci pour les indication enfaite j'utilise les pointeurs car les Tlists ont comme elements aue des pointeurs non ?

Normalement a la fin la Tlist est vide donc l4utilisation d'une TList est suffisante :)
21/08/2007, 19h23
Pedro

Salut :)
Je pense avoir compris ton problème: tu crées la classe de ton thread comme un pointeur (avec New).
Comme te l'as montré Linkin, il faut créer ta classe de cette façon:

Code:

TestThread := TTestThread.Create;

Du coup, tu as le choix entre rester à la Tlist, ou bien passer à la TObjectList qui peut "owner" les objets qu'elles contient: elle les libère lors de sa destruction.
23/08/2007, 11h08
ShaiLeTroll

Attention, vouloir un ensemble TThread via une TObjetList , cela semble périlleux ... surtout avec l'option FreeOnTerminate activé, qui peut rendre l'objet TThread caduque à n'importe quel moment ...

Sinon, je rappèle qu'un objet c'est un pointeur déguisé ... et qu'un TObjectList n'est qu'une TList typé TObject avec OwnsObjects comme option parfois sympathique

Citation:

Envoyé par Linkin

Par contre une TList ne libère pas ses objets quand elle est détuite, contrairement à une TObjectList

heureusement car avec FreeOnTerminate, bonjour les dégats ...
23/08/2007, 13h18
Pedro

Citation:

Envoyé par ShaiLeTroll

Attention, vouloir un ensemble TThread via une TObjetList , cela semble périlleux ... surtout avec l'option FreeOnTerminate activé, qui peut rendre l'objet TThread caduque à n'importe quel moment ...

Sauf si on spécifie OwnsObject à false lors de la création de la TObjectList ;)

Dans ce cas, je ne vois presque aucun intérêt à utiliser une TObjectList, car il faudra toujours caster un TObject en TThread, ce qui ne change rien de caster un Pointer en TThread ...

Ensuite, conserver les Thread en FreeOnTerminate à true, c'est s'exposé à des violations d'accès sur un thread qui a terminé son execution, ... et si l'on veut gérer leur arrêt, vaut mieux FreeOnTerminate à false, et faire soit même Terminate, WaitFor et Free ...

sinon pour éclairer necralbert, ton erreur est simplement une méconnaissance de l'objet

la forme est toujours

Code:

Instance := Class.Create();

ce que tu as bien fait pour IpToTest

Ensuite, même si avec des objets, le passage par pointeur n'est pas utile, il est bon de rapperl Chaque New doit avoir son Dispose, par exemple faire sa propre List comme ceci pour typé fortement sa liste est simplifier son utilisation

dans l'exemple qui suit, TModeleType peut être une chaine, un entier, une structure.

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
109
110
111
unit uModeleTypeList;
 
interface
 
uses Classes;
 
type
  TModeleType = Double; // A Titre d'Exemple ...
  PModeleType = ^TModeleType;
 
  TModeleTypeList = class(TList)
  protected
    function GetItem(const Index: Integer): TModeleType;
    procedure SetItem(const Index: Integer; const Value: TModeleType);
  public
    function Add(const AModeleType: TModeleType): Integer;
    procedure Clear; override;
    procedure Delete(const Index: Integer);
    procedure Insert(const Index: Integer; const AModeleType: TModeleType);
    function First: TModeleType;
    function Last: TModeleType;
    // Propriétés
    property Items[const Index: Integer]: TModeleType read GetItem write SetItem; default;
  end;
 
 
implementation
 
// TModeleTypeList ---------------------------------------------------------------
//                                                                           -
//                    TModeleTypeList - Protected                                -
//                                                                           -
// TModeleTypeList ---------------------------------------------------------------
 
// TModeleTypeList - Protected ---------------------------------------------------
function TModeleTypeList.GetItem(const Index: Integer): TModeleType;
begin
     // On veut une Structure ModeleType, et n'ont pas un pointeur, donc déférencement (^)
     Result := PModeleType(inherited Items[Index])^;
end;
 
// TModeleTypeList - Protected ---------------------------------------------------
procedure TModeleTypeList.SetItem(const Index: Integer; const Value: TModeleType);
begin
     // On veut une Structure ModeleType, et n'ont pas un pointeur, donc déférencement (^)
     PModeleType(inherited Items[Index])^ := Value;
end;
 
// TModeleTypeList ---------------------------------------------------------------
//                                                                           -
//                     TModeleTypeList - Public                                  -
//                                                                           -
// TModeleTypeList ---------------------------------------------------------------
 
// TModeleTypeList - Public ------------------------------------------------------
function TModeleTypeList.Add(const AModeleType: TModeleType): Integer;
var
   TmpModeleType: PModeleType;
begin
     New(TmpModeleType);
     TmpModeleType^ := AModeleType;
     Result := inherited Add(TmpModeleType);
end;
 
// TModeleTypeList - Public ------------------------------------------------------
procedure TModeleTypeList.Clear;
var
   Index: Integer;
begin
     for Index := Count - 1 downto 0 do begin
         if Assigned(inherited Items[Index]) then begin
            Dispose(PModeleType(inherited Items[Index]));
         end;
     end;
 
     inherited Clear();
end;
 
// TModeleTypeList - Public ------------------------------------------------------
procedure TModeleTypeList.Delete(const Index: Integer);
begin
     Dispose(PModeleType(inherited Items[Index]));
 
     inherited Delete(Index);
end;
 
// TModeleTypeList - Public ------------------------------------------------------
procedure TModeleTypeList.Insert(const Index: Integer; const AModeleType: TModeleType);
var
   TmpModeleType: PModeleType;
begin
     New(TmpModeleType);
     TmpModeleType^ := AModeleType;
     inherited Insert(Index, TmpModeleType);
end;
 
// TModeleTypeList - Public ------------------------------------------------------
function TModeleTypeList.First: TModeleType;
begin
     // On veut un ModeleType, et n'ont pas un pointeur, donc déférencement (^)
     Result := PModeleType(inherited First())^;
end;
 
// TModeleTypeList - Public ------------------------------------------------------
function TModeleTypeList.Last: TModeleType;
begin
     // On veut un ModeleType, et n'ont pas un pointeur, donc déférencement (^)
     Result := PModeleType(inherited Last())^;
end;
 
end.