AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Netzwerke Delphi upload local auf einem server
Thema durchsuchen
Ansicht
Themen-Optionen

upload local auf einem server

Ein Thema von M4ST3R · begonnen am 14. Nov 2003 · letzter Beitrag vom 17. Nov 2003
 
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
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 03:14 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz