Sujet Précédent Sujet Suivant

Bugs de threads

MiniApp Messages postés 654 Date d'inscription lundi 21 juillet 2014 Statut Membre Dernière intervention 22 février 2019 - Modifié par MiniApp le 17/12/2014 à 14:46
MiniApp Messages postés 654 Date d'inscription lundi 21 juillet 2014 Statut Membre Dernière intervention 22 février 2019 - 11 mars 2015 à 15:46
Bonjour

En tout premier désolée j'ai fait une boulette. J'ai oublier de spécifiez le language. C'est du Delphi.

J'essaie de crée un composant qui affiche les fichiers et dossier d'un répertoire. Mais en activant CreateThread et quand je doit le détruire par exemple je veux réactualiser de force il bug. Merci si vous résolvez mon problème. J'ai postez beaucoup de code qui représente toutes les étapes et déclarations de mon composant, désolée mais c'est un peu long. Merci beaucoup (et bonne lecture). 

uses
  SysUtils, Windows, Classes, Controls, ComCtrls, Graphics, Forms, ShellAPI;

type
  {TFileListView est un ListView qui affiche les icônes des fichier.
  Ce composant permet de proposer une sélection précise d'un fichier sans problème.
  Ce composant peut crée un Thread qui actualise la liste des fichiers.
  Sa vitesse d'éxécution est assez rapide.}
  TFileLstViewUpdtProgressState = (FLVUPSPrepa,FLVUPSSearchFileCount,FLVUPGetFiles,FLVUPFinish);
  TFileLstViewUpdtProgressEvent=procedure(Sender:TObject;State:TFileLstViewUpdtProgressState;
  CurrentFile,FileCount:Integer) of object;
  EFileListView = class(Exception);
  TFileListView = class(TCustomListView)
  private
    { Déclarations privées }
    FParentDirName,FCurrentDirName:String;
    FParentDirIcon,FCurrentDirIcon,FInvalidIconFile:TIcon;
    FShowIcons:Boolean;
    procedure SetMask(Value:String);
    procedure SetDirectory(Value:String);
    procedure SetInvalidIconFile(Value:TIcon);
    procedure SetParentDirIcon(Value:TIcon);
    procedure SetCurrentDirIcon(Value:TIcon);
  protected
    { Déclarations protégées }
    type
     ThdUpdtFiles = class(TThread)
      private
        { Déclarations privées }
        FLV:TFileListView;
        procedure Execute; override;
      public
        { Déclarations publique }
        OkToTerminate:Boolean;
    end;
  strict protected//Variables
    { Déclarations strictement protégées }
    Thd:ThdUpdtFiles;//Représentation du thread
    SearchHandle:THandle;
  protected
    { Déclarations protégées }
    FMask,FDirectory,FOldParentDirName,FOldCurrentDirName,FOldDirectory:String;
    FCreateThread,RequestTerminateRefresh:Boolean;
      //RequestTerminateRefresh:Mettez le à True pour demander l'arrêt de l'actualisation
    ImgList:TImageList;
    FOnProgress:TFileLstViewUpdtProgressEvent;
    ThreadHandle:THandle;
    procedure UpdtFiles;
  public
    { Déclarations publiques }
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
    procedure UpdateFiles(ForceDestroyThread:Boolean=False);
    property Directory:String read FDirectory write SetDirectory;
    function GetFile(Index:Integer;var FileName:String):Cardinal;
    function GetIconFiles(Index:Integer):TIcon;
    //Publication de l'héritage
    Property ItemIndex;
    //Méthodes
    function ThreadCreated:Boolean;
  published
    { Déclarations publiées }

    property CreateThread:Boolean read FCreateThread write FCreateThread default True;
      //Indique si un thread est crée pour actualiser les fichiers
    property ShowIcons:Boolean read FShowIcons write FShowIcons default True;
      //Indique si les icones des fichiers sont afficher.
      //Notes:Si c'est False InvalidIconFile est utiliser. Sauf pour les dossier '.' et '..' qui ont leurs icones de bases
    property Mask:String read FMask write SetMask;
      //Indique le masque
    property ParentDirName:String read FParentDirName write FParentDirName;
      //Indique le nom du dossier '..'. $HIDE-DIR$ cache ce dossier.
    property CurrentDirName:String read FCurrentDirName write FCurrentDirName;
      //Indique le nom du dossier '.'. $HIDE-DIR$ cache ce Dossier
    property OldParentDirName:String read FOldParentDirName;
      //Indique le nom du dossier '..' afficher.
    property OldCurrentDirName:String read FOldCurrentDirName;
      //Indique le nom du dossier '.' afficher.
    property OldDirectory:String read FOldDirectory;
      //Indique le nom du dossier dont le contenu est actuellement.
    property ParentDirIcon:TIcon read FParentDirIcon write SetParentDirIcon{TODO:Crée SetInvalidIconFile};
      //Indique l'icone du dossier '..'.
    property CurrentDirIcon:TIcon read FCurrentDirIcon write SetCurrentDirIcon;
      //Indique l'icone quand l'icone du fichier est trop petite
    property OnProgress:TFileLstViewUpdtProgressEvent read FOnProgress write FOnProgress;
      //événement de progression
  end;


implementation

constructor TFileListView.Create(AOwner:TComponent);
{Constructeur par défault}
begin
  inherited Create(AOwner);
  //Initialisation des composants
  ImgList := TImageList.Create(ImgList);
  FParentDirIcon := TIcon.Create;
  FCurrentDirIcon := TIcon.Create;
  FInvalidIconFile := TIcon.Create;
  //Affectations des propriétés par défault
  FParentDirName := 'Dossier parent';
  FCurrentDirName := '$HIDE-DIR$';
  FMask := '*.*';
  FCreateThread := True;
  FShowIcons := True;
  DoubleBuffered := True;
  //***
  LargeImages := ImgList;
  ImgList.SetSize(32,32);
  FInvalidIconFile.SetSize(32,32);
  FParentDirIcon.SetSize(32,32);
  FCurrentDirIcon.SetSize(32,32);
end;

destructor TFileListView.Destroy;
{Destructeur par défault}
begin
  RequestTerminateRefresh := True;
  Hide;
  DestroyHandle;
  //Arrêt de l'actualisation
  if ThreadCreated then
    begin
      //Arrêt du thread
        TerminateThread(Thd.Handle,0);
      //Fermetures des handles
        FindClose(SearchHandle);//Fermeture de la recherche
    end;
  //Destruction des composant
    ImgList.Free;
    FParentDirIcon.Free;
  inherited Destroy;
end;

function TFileListView.ThreadCreated:Boolean;
{Indique si le thread est lancé}
begin
  Result := Thd<>nil;
end;

Function TFileListView.GetFile(Index:Integer;var FileName:String):Cardinal;
{Permet de récupérez les propriétés du fichier.
FileName permet aussi de récupérez le nom du fichier.
Avertissement:Si l'utilisateur a sélectionné le dossier '..' et que ParrentDirName est 'Parent'. Parent est renvoyé}
begin
  if Index < Items.Count then
    begin
      Result := GetFileAttributes(PChar(Items.Item[Index].Caption));
      FileName := Items.Item[Index].Caption;
    end
  Else raise EFileListView.Create('Impossible de chercher un fichier si son indice est supérieur ou égal au nombre d''items');
end;

procedure TFileListView.UpdateFiles(ForceDestroyThread:Boolean=False);
{Actualise les fichiers présent
Notes:ForceDestroyThread permet de détruire le thread si celui ci est lancer.}
begin
  if ThreadCreated then
    if ForceDestroyThread then
      begin
        //Arrêt du thread
        TerminateThread(Thd.Handle,0);
      end
    else Exit;
FindClose(SearchHandle);//Fermeture de la recherche
  if FCreateThread then
    begin
      Thd := ThdUpdtFiles.Create(True);
      Thd.FLV := Self;
      Thd.Start;
    end
  Else UpdtFiles;
end;

procedure TFileListView.SetDirectory(Value:String);
begin
  if (Value = FDirectory)or(Value = '') then
    Exit;
  if not DirectoryExists(Value) then
    raise EFileListView.Create('Le répertoire spécifié n''existe pas') ;
  if copy(Value,Length(Value)-1,1)<>'\' then
    FDirectory := Value + '\'
  else FDirectory := Value;
end;

Function TFileListView.GetIconFiles(Index:Integer):TIcon;
{Renvoie l'icone du fichier}
begin
Result := TIcon.Create;
  if Index < Items.Count then
    ImgList.GetIcon(Index,Result)
  Else raise EFileListView.Create('Impossible de chercher l''icone d''un fichier si son indice est supérieur ou égal au nombre d''items');
end;

procedure TFileListView.UpdtFiles;
var
FileName:array[0..2048] of char;
IndexFile,FileCount:Cardinal;
TempIcon:TIcon;
IndexIcon:Word;
Attr:WIN32_FIND_DATA;
begin
Try
  //Préparation
    if Assigned(FOnProgress) then
      FOnProgress(Self,FLVUPSPrepa,0,1);
    IndexIcon := 0;
    FileCount := 0;
    TempIcon := TIcon.Create;
    TempIcon.SetSize(32,32);
    ImgList.Clear;
    Items.Clear;
  FOldParentDirName := FParentDirName;
  FOldCurrentDirName := FCurrentDirName;
  //***
  //Recherche
  //évaluation du nombre de fichier
    SearchHandle := FindFirstFile(Pchar(FDirectory+Mask),Attr);
    while FindNextFile(SearchHandle,Attr)=True do
      begin
        Inc(FileCount);
        if Assigned(FOnProgress) then
          FOnProgress(Self,FLVUPSSearchFileCount,FileCount,FileCount);
      end;
  //Recherche des fichiers
    SearchHandle := FindFirstFile(PChar(FDirectory+Mask),Attr);
    IndexFile := 0;
    Repeat
      begin
        if Assigned(FOnProgress) then
          FOnProgress(Self,FLVUPGetFiles,IndexFile-1,FileCount+1);
        if (attr.cFileName = PChar('.'))or(attr.cFileName = PChar('..')) then
          begin
            if (attr.cFileName = PChar('.'))and(FCurrentDirName <> '$HIDE-DIR$') then
              begin
                With Items.Add do
                  begin
                    Caption := FCurrentDirName;
                    if Assigned(FCurrentDirIcon) then
                      ImageIndex := ImgList.AddIcon(FCurrentDirIcon)
                    else ImageIndex := ImgList.AddIcon(FInvalidIconFile)
                  end;
              end;
            if (attr.cFileName = Pchar('..'))and(FParentDirName <> '$HIDE-DIR$') then
              begin
                With Items.Add do
                  begin
                    Caption := FParentDirName;
                    if Assigned(FCurrentDirIcon) then
                      ImageIndex := ImgList.AddIcon(FCurrentDirIcon)
                    else ImageIndex := ImgList.AddIcon(FInvalidIconFile)
                  end;
              end;
          end
        Else With Items.Add do
              begin
                Caption := Attr.cFileName;
                StrCopy(FileName,PChar(FDirectory+Caption));
                TempIcon.Handle := ExtractAssociatedIcon(Application.Handle,FileName,indexIcon);
                ImageIndex := ImgList.AddIcon(TempIcon);
              end;
      end;
    if (Application.Terminated) or (RequestTerminateRefresh) then
      begin
        RequestTerminateRefresh := False;
        Exit;
      end;
    if Thd <> nil then
      begin
        if (Thd.Terminated and FCreateThread)or (Thd.OkToTerminate) then
          begin
            RequestTerminateRefresh := False;
            Exit;
          end;
      end;
    inc(IndexFile);
    Until FindNextFile(SearchHandle,Attr)<>True;
    if Assigned(FOnProgress) then
      FOnProgress(Self,FLVUPGetFiles,IndexFile,FileCount);
Finally
  FOldDirectory := FDirectory;
  TempIcon.Free;
End;
end;

procedure TFileListView.ThdUpdtFiles.Execute;
begin
Try
  while (FLV = nil) do;
  FreeOnTerminate := True;
  FLV.UpdtFiles;
Finally
End;
end;



Chercher et essayer : vous trouverez la solution!
Fouiner et regarder partout : vous trouverez la connaissance!!

2 réponses

Réponse 1 / 2
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
17 déc. 2014 à 16:55
Bonjour,
Je déplace donc vers DELPHI.
0
MiniApp Messages postés 654 Date d'inscription lundi 21 juillet 2014 Statut Membre Dernière intervention 22 février 2019 5
17 déc. 2014 à 17:52
Merci Beaucoup. Maintenant je suis :-D
0
Réponse 2 / 2
cs_cantador Messages postés 4720 Date d'inscription dimanche 26 février 2006 Statut Modérateur Dernière intervention 31 juillet 2021 13
20 févr. 2015 à 12:26
Bonjour,

Un composant "scrute dossier"
fait tout ça très bien.
mais le plus amusant est de le programmer soi-même.
il y a aussi des essais en méthodes récursives qui donnent de bons résultats aussi.
0
MiniApp Messages postés 654 Date d'inscription lundi 21 juillet 2014 Statut Membre Dernière intervention 22 février 2019 5
11 mars 2015 à 15:46
Bonjour désolée du retard mais en ce moment je ne vais que très rarement sur CCM. Tu as raison j'adore faire des composants. Le mien permettrait de ne pas devoir passer par un dialogue ou un TWebBroswer pour avoir les vrais icônes des fichiers.
0

Discussions similaires

threads qui tournent en parallele
sparetime -
neodante -

2 réponses
Socket et Threading
dabcorp -
asma40 -

7 réponses
Fermer tout les thread d'un programme ?
cs_Sobieski -
Whismeril -

9 réponses
utiliser un thread
shefiu -
Arto_8000 -

1 réponse
Fin d'un thread en .NET
Frederyck -
zanzan -

3 réponses
Rejoignez-nous