Einzelnen Beitrag anzeigen

C.Schoch

Registriert seit: 2. Jan 2006
Ort: Wüstenrot
235 Beiträge
 
Turbo Delphi für Win32
 
#5

Re: Dynamisches Array "weg" nach Thread beendigung

  Alt 7. Mai 2006, 15:07
Aufruf:
Delphi-Quellcode:
procedure TMainForm.btBackupClick(Sender: TObject);
var
  i, j, k, l : integer;
  WaitResult : DWORD;
begin
  btBackup.Enabled := false;
  btCancel.Enabled := true;
  bCanceled := false;
  for i := 0 to lvSourceDestination.Items.Count - 1 do
  begin
    if bCanceled then
    begin
      break;
    end;
    DestThread := TtSearchFiles.create(true);
    SourceThread := TtSearchFiles.create(true);
    SortThread := TtSortFiles.Create(true);
    DestThread.sDir := lvSourceDestination.Items[i].SubItems[1];
    SourceThread.sDir := lvSourceDestination.Items[i].SubItems[0];
    DestThread.FileList := DestFileList;
    SourceThread.FileList := SourceFileList;
    SortThread.sDestDir := lvSourceDestination.Items[i].SubItems[1];
    SortThread.sSourceDir := lvSourceDestination.Items[i].SubItems[0];
    DestThread.Resume;
    SourceThread.Resume;
    SortThread.Resume;
    ThreadArray[0] := DestThread.Handle;
    ThreadArray[1] := SourceThread.Handle;
    ThreadArray[2] := SortThread.Handle;
    repeat
      WaitResult := msgWaitforMultipleObjects(length(ThreadArray) - 2, ThreadArray, true, 1000{INFINITE}, QS_ALLINPUT);
      if WaitResult <> WAIT_OBJECT_0 then
      begin
        Application.ProcessMessages;
      end;
  end;
end;
Thread:
Delphi-Quellcode:
unit tSearchFiles;

interface

uses
  Classes, Windows, dialogs;

type
  TArrayofStringList = packed array of TStringList;
  TtSearchFiles = class(TThread)
  private
  iDirCount : Integer;
  protected
  procedure Execute; override;
  procedure GetFiles(const Directory : string; var Files : TArrayofStringList; (*type TArrayofStringList = packed array of TStringList;*)
                     const FileMask : string = '*.*'; const SubFolders : Boolean = True);
  public
    sDir : String; // wird übergeben vom Haupt code
    FileList : TArrayofStringList; // wird übergeben vom Haupt code
  end;

implementation

uses
  Sysutils, MainFrame;

{ TSearchFiles }

///////////////////////////GetFiles/////////////////////////////////////////////
// Autor: Daniel B
// Editor: C.Schoch
////////////////////////////////////////////////////////////////////////////////
procedure tTSearchFiles.GetFiles(const Directory : string; var Files : TArrayofStringList;
const FileMask : string = '*.*'; const SubFolders : Boolean = True);

  function SlashSep(const Path, S : string): string;
  // Backslash zum Pfadende hinzufügen wenn keiner vorhanden
  begin
    if AnsiLastChar(Path)^ <> '\then
      Result := Path + '\' + S
    else
      Result := Path + S;
  end;

var
  SearchRec : TSearchRec;

begin
  // Verzeichniss nach Dateien durchsuchen
  SetLength(Files,iDirCount+1); // hier set length
  Files[iDirCount] := TStringList.Create;
  if FindFirst(SlashSep(Directory, FileMask),
    faAnyFile - faDirectory - faVolumeID, SearchRec) = 0 then
  begin
    if not Terminated then
    begin
      try
        repeat
          Files[iDirCount].Add(SlashSep(Directory, SearchRec.Name));
        until
          (FindNext(SearchRec) <> 0) or Terminated;
      finally
        SysUtils.FindClose(SearchRec);
    end;
  end;
end;

  if SubFolders and not Terminated then
  begin
  // Unterordner suchen
    inc(iDirCount);
    if FindFirst(SlashSep(Directory,'*.*'), faAnyFile, SearchRec) = 0 then
    begin
      try
        repeat
          if (SearchRec.Attr and faDirectory) <> 0 then
          begin
            if ((SearchRec.Name <> '.') and (SearchRec.Name <> '..')) then
            begin
              GetFiles(SlashSep(Directory, SearchRec.Name),Files,FileMask, SubFolders);
            end;
          end;
        until
          FindNext(SearchRec) <> 0;
      finally
        SysUtils.FindClose(SearchRec);
      end;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////


procedure TtSearchFiles.Execute;
begin
  iDirCount := 0;
  MainForm.test1 := true;
  GetFiles(sDir, FileList, '*.*', true);
  MainForm.test1:= false;
end;
end.
ich denke das sollte reichen
aber nicht gleich wegen irgendwelche bezeichnernamen verhauen.
der Typ ist eigendlich nur wegen der Procedure, da ich sonst nichts übergeben kann.
Tschau Christian
Das System hofft auf Besserung
[Siemens]
  Mit Zitat antworten Zitat