upload local auf einem server

[M4ST3R]

hi delphianer,

-:NEWBIE:- AM BASTELN

habe ein kleines Problem. Möchte ein kleines FTP-Tool schreiben aber hänge gerade beim upload

weiß net wie ich lokale Verzeichnisse durschsuche und dann diese per put-Befehl die dann hochlade.

Kann mir jemand HELFEN.

Für jede Hilfe wär ich DANKBAR.


Mit freundlichen Grüßen
M4ST3R

[mr2]

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;

[mr2]

Zitat:

Zitat von M4ST3R

danke für deine Hilfe und für das schnelle reagieren
hab da was ähliches Programmiert, aber ich hab da noch ein Problem, vielleicht siehst du ja mein Fehler, bzw. was ich Falsch mache.
Da ich noch ein zweites memo feld habe wo die felgeschlagende uploade zu sehen sind würde ich gerne diese auch noch zum schluß uploaden.

weißt du da wie ich das am besten machen kann???

Danke für deine Hilfe.

Meine Procedure sieht so aus:

Delphi-Quellcode:

procedure TDASSUpload.UploadAll(localpath: String; serverpath: String);

var
    i : integer;
    searchrec: TSearchRec;
    newdir: String;

begin

    newdir := localpath + '\';

  if AnsiLastChar(localpath) <> '\' then
        newdir := localpath + '\'
    else
        localpath:= localpath;



    MemoUpload.Lines.Append('> lokales Verzeichnis übermittelt : '+ localpath);
    SetCurrentDir(localpath);
    MemoUpload.Lines.Append('> cd locale Verzeichnis gewechlselt: ' + localpath);
    MemoUpload.Lines.Add('> server Verzeichnis übermittelt : '+ serverpath);
    DataConnectModule.FTPClient.MakeDir(serverpath);
    DataConnectModule.FTPClient.ChangeDir(serverpath);
    MemoUpload.Lines.Append('> md server Verzeichnis angelegt : '+ serverpath);
    MemoUpload.Lines.Append('>cd server Verzeichnis : '+ serverpath);

    if AnsiLastChar(localpath) <> '\' then
        localpath := localpath + '\*.*'
    else
        localpath:= localpath +'*.*';

    if AnsiLastChar(serverpath) <> '/' then
        serverpath := serverpath + '/';


     if FindFirst(localpath, faAnyFile, SearchRec) = 0 then
     begin
         try
             repeat
                 if (searchrec.Name <> '.') AND (searchrec.Name <> '..') then
                 begin
                     if (searchrec.Attr and faDirectory) <> 0 then
                         uploadAll(newdir+searchrec.name,searchrec.name)
                     else
                     begin
                         try
                              DataConnectModule.FTPClient.Put(searchrec.Name,extractfilename(searchrec.Name));
                              MemoUpload.Lines.Append('> up file : '+searchrec.Name);
                         except
                              MemoError.Lines.Add('> up abotive : '+newdir+searchrec.Name+ ' to '+ serverpath);
                         end;
                     end;
                 end
                 until FindNext(searchrec)<> 0;
                 DataConnectModule.FTPClient.ChangeDirUp;
         finally
             sysUtils.FindClose(searchrec);
         end;
     end;

übermittelt werden diese Variablen : localpath und serverpath.

Problem : Beim lokalem Verzeichnis c:\temp\test3\*.* versucht mein Programm
eine Datei hochzulanden die im c:\temp\ liegt.
In der Fehlermeldung wird diese Datei nicht gefunden bzw. kann nicht geöffnet werden c:\temp\test3\default.html.
Ist auch RICHTIG die default.html befindet sich unter c:\temp\default.html

memoUpload = Protokollfenster
memoError = Protokollfehlerfenster

ändere ich diese zeile

Delphi-Quellcode:

    if FindFirst(localpath, faAnyFile, SearchRec) = 0 then

in

Delphi-Quellcode:

    if FindFirst(localpath, faAnyFile-faDirectory-faVolumeId, SearchRec) = 0 then

findet mein Programm welcome.html und default.hatml und läd diese auf dem server hoch. lol


Verzeichnisstrucktur das durchlaufen wird:

c:\temp\
c:\temp\test1
c:\temp\test1\testA
c:\temp\test1\testA\datei1.html
c:\temp\test1\testA\datei2.html
c:\temp\test1\testA\etc.
c:\temp\test1\testB
c:\temp\test1\testB\datei1.html
c:\temp\test1\testB\datei2.html
c:\temp\test1\testB\etc.
c:\temp\test1\testC
c:\temp\test1\testC\datei1.html
c:\temp\test1\testC\datei2.html
c:\temp\test1\testC\etc.
c:\temp\test1\testC\datei1.html
c:\temp\test1\testC\datei2.html
c:\temp\test1\testC\etc.
c:\temp\test2
c:\temp\test2\testA
c:\temp\test2\testA\datei1.html
c:\temp\test2\testA\datei2.html
c:\temp\test2\testA\etc.
c:\temp\test2\testB
c:\temp\test2\testB\datei1.html
c:\temp\test2\testB\datei2.html
c:\temp\test2\testB\etc.
c:\temp\test2\testC
c:\temp\test2\testC\datei1.html
c:\temp\test2\testC\datei2.html
c:\temp\test2\testC\etc.
c:\temp\test2\testC\datei1.html
c:\temp\test2\testC\datei2.html
c:\temp\test2\testC\etc.
c:\temp\test3
c:\temp\test3\datei1.html
c:\temp\test3\datei2.html
c:\temp\test3\datei3.html
c:\temp\test3\etc.
c:\temp\default.html
c:\temp\welcome.html

[mr2]

Hallo,

ändere einfach den Beispielaufruf aus meinem ersten Posting wie folgt ab:

Delphi-Quellcode:

var
  Files, Errors: TStringList;
  i: Integer;
begin
  Errors := nil;
  Files := TStringList.Create;
  try
    Errors := TStringList.Create;
    ReadFileNames(Files, 'C:\Daten\', soNone, '*.*', True, False);
    IdFTP.Host := 'ftp.heise.de';
    IdFTP.User := 'Knut';
    IdFTP.Password := 'geheim';
    IdFTP.Connect;
    for i:=0 to Pred(Files.Count) do
      try
        IdFTP.Put(Files[i], ExtractFileName(Files[i]));
      except
        Errors.Add(Files[i]);
      end;
    for i:=0 to Pred(Errors.Count) do
      try
        IdFTP.Put(Errors[i], ExtractFileName(Errors[i]));
      except
        on E: Exception do Application.HandleException(E);
      end;
  finally
    FreeAndNil(Files);
    FreeAndNil(Errors);
    IdFTP.Disconnect;
  end;
end;

[M4ST3R]

hallo @ all,

Danke für die Hilfe.

Hab das Problem uploaden gelöst.
:dancer2: :dancer:
mfg
M4ST3R