Einzelnen Beitrag anzeigen

mr2

Registriert seit: 3. Mai 2003
140 Beiträge
 
Delphi 2006 Enterprise
 
#2

Re: upload local auf einem server

  Alt 14. Nov 2003, 20:04
Hallo,

also den Inhalt eines Verzeichnisses kannst Du wie folgt ermitteln:
Delphi-Quellcode:
type
  // Angabe der Sortierreihenfolge für @link(ReadFileNames)
  TSortOrder = (soNone, soName, soTime, soSize, soExtension);

const
  MaskAllFiles = '*.*';

{ liest sämtliche Dateinamen eines Verzeichnisses aus


  SortOrder kann wie folgt belegt werden:


  soNone: es erfolgt keine Sortierung (default)


  soName: Sortierung nach dem Dateinamen


  soTime: Sortierung nach der letzten Dateiänderung


  soSize: Sortierung nach der Dateigröße


  soExtension: Sortierung nach der Dateiendung


  die optionale Suchmaske schränkt per default nicht ein ('*.*')


  bei Bedarf können Unterverzeichnisse mit durchsucht werden}

procedure ReadFileNames(
  const Files: TStrings;
  const Directory: string;
  const SortOrder: TSortOrder = soNone;
  const FileMask: string = MaskAllFiles;
  const AddDirectory: Boolean = False;
  const IncludeSubDirs: Boolean = False);

implementation

uses
  ShlObj, ShellApi, SysUtils, Classes;

type
  // Klasse für die Suche nach Dateien
  TFileFinder = class(TStringList)
  private
    FDirs: TStrings;
    FDirectory: string;
    procedure DoReadFileNames;
    procedure DoReadDirectories(const Dir: string);
    procedure DoReadFiles(const Dir: string);
    procedure SortFiles;
    function IsDirectory(const FileProps: TSearchRec): Boolean;
    function IsFile(const FileProps: TSearchRec): Boolean;
    procedure SetDirectory(const Value: string);
  protected
    SortOrder: TSortOrder;
    AddDirectory: Boolean;
    IncludeSubDirs: Boolean;
    FileMask: string;
    property Directory: string read FDirectory write SetDirectory;
  public
    constructor Create;
    destructor Destroy; override;
    class procedure ReadFileNames(
      const Files: TStrings;
      const aDirectory: string;
      const aSortOrder: TSortOrder;
      const aFileMask: string;
      const aAddDirectory, aIncludeSubDirs: Boolean);
    procedure CopyStrings(const Dest: TStrings);
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
  end;

  // Hilfsklasse zum Sortieren von Dateinamen
  TFileEntry = class(TObject)
  protected
    FileTime: Integer;
    FileSize: Integer;
    Extension: string;
  public
    constructor Create(const FileProp: TSearchRec; const SortOrder: TSortOrder);
  end;

{ TFileEntry }

constructor TFileEntry.Create(const FileProp: TSearchRec;
  const SortOrder: TSortOrder);
begin
  case SortOrder of
    soTime: FileTime := FileProp.Time;
    soSize: FileSize := FileProp.Size;
    soExtension: Extension := ExtractFileExt(FileProp.Name);
  end;
end;

// Hilfsfunktion zum Sortieren einer StringList mit Dateinamen nach der Dateiendung
function SortFileExtension(List: TStringList; Index1, Index2: Integer): Integer;
begin
  Result := AnsiCompareText(TFileEntry(List.Objects[Index1]).Extension,
                            TFileEntry(List.Objects[Index2]).Extension);
end;

// Hilfsfunktion zum Sortieren einer StringList mit Dateinamen nach dem Alter
function SortFileTime(List: TStringList; Index1, Index2: Integer): Integer;
begin
  Result := TFileEntry(List.Objects[Index1]).FileTime
            - TFileEntry(List.Objects[Index2]).FileTime;
end;

// Hilfsfunktion zum Sortieren einer StringList mit Dateinamen nach der Größe
function SortFileSize(List: TStringList; Index1, Index2: Integer): Integer;
begin
  Result := TFileEntry(List.Objects[Index1]).FileSize
            - TFileEntry(List.Objects[Index2]).FileSize;
end;

{ TFileFinder }

constructor TFileFinder.Create;
begin
  inherited;
  FDirs := TStringList.Create;
end;

destructor TFileFinder.Destroy;
begin
  FreeAndNil(FDirs);
  Clear;
  inherited;
end;

class procedure TFileFinder.ReadFileNames(const Files: TStrings;
  const aDirectory: string; const aSortOrder: TSortOrder;
  const aFileMask: string; const aAddDirectory, aIncludeSubDirs: Boolean);
var
  Finder: TFileFinder;
begin
  Finder := Create;
  try
    Finder.Directory := aDirectory;
    Finder.SortOrder := aSortOrder;
    Finder.FileMask := aFileMask;
    Finder.AddDirectory := aAddDirectory;
    Finder.IncludeSubDirs := aIncludeSubDirs;
    Finder.DoReadFileNames;
    Finder.CopyStrings(Files);
  finally
    FreeAndNil(Finder);
  end;
end;

procedure TFileFinder.DoReadFileNames;
var
  i: Integer;
begin
  Clear;
  FDirs.Clear;
  FDirs.Add(Directory);
  if IncludeSubDirs
  then DoReadDirectories(Directory);
  for i:=0 to Pred(FDirs.Count)
    do DoReadFiles(FDirs[i]);
  SortFiles;
end;

procedure TFileFinder.DoReadDirectories(const Dir: string);
var
  aDir: string;
  FileProps: TSearchRec;
  res: Integer;
  actDir: string;
begin
  aDir := IncludeTrailingPathDelimiter(Dir);
  res := FindFirst(aDir + MaskAllFiles, faDirectory, FileProps);
  try
    while (res = 0) do begin
      if IsDirectory(FileProps) then begin
        actDir := aDir + FileProps.Name + PathDelim;
        FDirs.Add(actDir);
        DoReadDirectories(actDir);
      end;
      res := FindNext(FileProps);
    end;
  finally
    FindClose(FileProps);
  end;
end;

procedure TFileFinder.DoReadFiles(const Dir: string);
var
  FileName: string;
  FileProps: TSearchRec;
  res: Integer;
begin
  res := FindFirst(Dir + FileMask, faAnyFile, FileProps);
  try
    while (res = 0) do begin
      if IsFile(FileProps) then begin
        if AddDirectory
        then FileName := Dir + FileProps.Name
        else FileName := FileProps.Name;
        case SortOrder of
          soTime, soSize, soExtension: AddObject(FileName,
                                          TFileEntry.Create(FileProps, SortOrder));
          soNone, soName: Add(FileName);
        end;
      end;
      res := FindNext(FileProps);
    end;
  finally
    FindClose(FileProps);
  end;
end;

procedure TFileFinder.SortFiles;
begin
  case SortOrder of
    soName: Sort;
    soTime: CustomSort(SortFileTime);
    soSize: CustomSort(SortFileSize);
    soExtension: CustomSort(SortFileExtension);
  end;
end;

function TFileFinder.IsDirectory(const FileProps: TSearchRec): Boolean;
begin
  Result := ((FileProps.Name <> EmptyStr)
             and (FileProps.Name[1] <> '.')
             and ((FileProps.Attr and faDirectory) = faDirectory));
end;

function TFileFinder.IsFile(const FileProps: TSearchRec): Boolean;
begin
  Result := ((FileProps.Name <> EmptyStr)
             and (FileProps.Name[1] <> '.')
             and ((FileProps.Attr and faDirectory) <> faDirectory));
end;

procedure TFileFinder.SetDirectory(const Value: string);
begin
  if (FDirectory <> Value)
  then FDirectory := IncludeTrailingPathDelimiter(Trim(Value));
end;

procedure TFileFinder.CopyStrings(const Dest: TStrings);
var
  i: Integer;
begin
  Dest.BeginUpdate;
  try
    Dest.Clear;
    for i:=0 to Pred(Count)
      do Dest.Add(Strings[i]);
  finally
    Dest.EndUpdate;
  end;
end;

procedure TFileFinder.Clear;
var
  i: Integer;
begin
  for i:=Pred(Count) downto 0
    do Delete(i);
  inherited;
end;

procedure TFileFinder.Delete(Index: Integer);
var
  aObj: TObject;
begin
  // Objekte freigeben
  if Assigned(Objects[Index]) then begin
    aObj := Objects[Index];
    Objects[Index] := nil;
    aObj.Free;
  end;
  inherited;
end;

procedure ReadFileNames(
  const Files: TStrings;
  const Directory: string;
  const SortOrder: TSortOrder = soNone;
  const FileMask: string = '*.*';
  const AddDirectory: Boolean = False;
  const IncludeSubDirs: Boolean = False);
begin
  TFileFinder.ReadFileNames(Files, Directory, SortOrder, FileMask,
    AddDirectory, IncludeSubDirs);
end;
Das geht auch einfacher bzw. kürzer, aber so hat man die meisten Möglichkeiten die Suche einzuschränken bzw. zu erweitern.

und den Upload machst Du am besten mit der FTP-Komponente TIdFTP (ist bei Delphi6 schon mit dabei, kann man sich aber auch kostenlos bei Nevrona runterladen.

Beispielaufruf:
Delphi-Quellcode:
var
  Files: TStringList;
begin
  Files := TStringList.Create;
  try
    ReadFileNames(Files, 'C:\Daten\', soNone, '*.*', True, False);
    IdFTP.Host := ftp.heise.de;
    IdFTP.User := 'Knut';
    IdFTP.Password := 'geheim';
    IdFTP.Connect;
    IdFTP.Put(Files[i], ExtractFileName(Files[i]));
  finally
    FreeAndNil(Files);
    IdFTP.Disconnect;
  end;
end;
"... we know, there are known knowns; there are things we know we know. We also know there are known unknowns; that is to say we know there are some things we don't know. But there are also unknown unknowns - the ones we don't know we don't know."
  Mit Zitat antworten Zitat