FTP Upload mit WinInet -> FTP Download benötigt

[StoRmtec]

Hallo Leute
Habe bei meinem Programm eine FTP Sicherung eingebaut mit dem unten angeführten Code

Delphi-Quellcode:

// -- FTP Upload ---------------------------------------------------------------
type
  TUploadCallback = procedure(lpszLocal, lpszRemote: string; dwBytesTotal, dwBytesDone: DWORD; Elapsed: Single);

procedure MyUploadCallback(lpszLocal, lpszRemote: string; dwBytesTotal, dwBytesDone: DWORD; Elapsed: Single);
begin
  with frm_depot do
  begin
    filenamelabel.Caption := 'Dateiname: ' + lpszLocal;
    Label11.Caption := 'Remotename: ' + lpszRemote;
    Label12.Caption := 'Erledigt: ' + Format('%2.n KB/%2.n KB', [dwBytesDone / 1024, dwBytesTotal / 1024]);
    Label14.Caption := 'Prozent: ' + IntToStr(Integer(Round((dwBytesDone * 100) / dwBytesTotal))) + '%';
    ProgressBar1.Max := 100;
    ProgressBar1.Position := Integer(Round((dwBytesDone * 100) / dwBytesTotal));
    Label15.Caption := 'verstrichen: ' + Format('%2.n sec', [Elapsed]);
    if (Elapsed > 0) then
      Label16.Caption := 'Speed: ' + Format('%2.n KB/sec', [dwBytesDone / Elapsed]);
  end;
end;

function UploadFileorFolder(lpszServer, lpszUsername, lpszPassword, lpszLocalDirectory, lpszRemoteDirectory: String; lpUploadCallback: TUploadCallback = nil; UploadSubFolders: Boolean = True; wPort: Word = 21): Boolean;
const
  sErrorDirectoryUpload = 'Das Verzeichnis "%s" konnte nicht auf den Server geladen werden!';
  sErrorDirectoryCreate = 'Das Verzeichnis "%s" konnte nicht auf dem Server erstellt werden!';
  sErrorDirectorySet    = 'Es konnte nicht in das Verzeichnis "%s" gewechselt werden!';
  sErrorFileCreate      = 'Datei "%s%s" konnte nicht erstellt werden!';
  sErrorFileNotFound    = 'Datei "%s" konnte nicht gefunden werden!';
  sErrorWriting         = 'Es trat ein Fehler während des schreibens in die Datei auf!';
const
  PACKET_SIZE           = 1024 * 2;
var
  hOpen, hConnect: HINTERNET;

  function UploadFile(lpszLocal, lpszRemote: String): Boolean;
  var
    hFile: HINTERNET;
    hLocalFile: THandle;
    dwFileSize: DWORD;
    lpNumberOfBytesRead, lpNumberOfBytesWritten, lpBytesDone, lpStartTicker, lpTicker: DWORD;
    lpBuffer: array[0..PACKET_SIZE] of Byte;
  begin
    // wir sind schon im aktuellem Verzeichnis, deswegen kein FtpSetCurrentDirectory..
    Result := False;
    // ok, jetzt mal lokal überprüfen ob alles da ist und die dateigröße auslesen
    hLocalFile := CreateFile(PChar(lpszLocal), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
    if (hLocalFile <> INVALID_HANDLE_VALUE) or (hLocalFile <> 0) then
    begin
      dwFileSize := Windows.GetFileSize(hLocalFile, nil);
      hFile := FtpOpenFile(hConnect, PChar(lpszRemote), GENERIC_WRITE, INTERNET_FLAG_TRANSFER_BINARY, 0);
      if (hFile <> nil) then
      begin
        SetFilePointer(hLocalFile, 0, nil, FILE_BEGIN);
        InternetSetFilePointer(hFile, 0, nil, FILE_BEGIN, 0);
        ZeroMemory(@lpBuffer, SizeOf(lpBuffer));
        lpBytesDone := 0;
        lpNumberOfBytesWritten := 0;
        lpStartTicker := GetTickCount;  // Upload start
        repeat
          Application.ProcessMessages;
          lpNumberOfBytesRead := 0;
          Sleep(1);
          lpTicker := GetTickCount;
          ReadFile(hLocalFile, lpBuffer, PACKET_SIZE, lpNumberOfBytesRead, nil);
          InternetWriteFile(hFile, @lpBuffer, lpNumberOfBytesRead, lpNumberOfBytesWritten);
          if (lpNumberOfBytesWritten = lpNumberOfBytesRead) then
          begin
            Result := True;
            Inc(lpBytesDone, lpNumberOfBytesWritten);
            if Assigned(lpUploadCallback) then
              lpUploadCallback(lpszLocal, lpszRemote, dwFileSize, lpBytesDone, (lpTicker - lpStartTicker) / 1000);
          end else
          begin
            Result := False;
            MessageBox(HWND_DESKTOP, PChar(sErrorWriting), 'Error', MB_ICONERROR);
            Break;
          end;
        until (lpBytesDone >= dwFileSize);
        InternetCloseHandle(hFile);
      end;
      // datei handle schließen ..
      CloseHandle(hLocalFile);
    end else
    begin
      // datei konnte nicht gefunden werden
      MessageBox(HWND_DESKTOP, PChar(Format(sErrorFileNotFound, [lpszLocal])), 'Error', MB_ICONERROR);
    end;
  end;

  function UploadDirectory(lpszPath, lpszRemote: String): Boolean;
  var
    lpFindFileData: TWIN32FindData;
    hFindFile: THandle;
    szLastDirectory: String;
  begin
    Result := False;
    lpszPath := IncludeTrailingPathDelimiter(lpszPath);
    // wir brauchen hier den Namen vom letzten Verzeichnis, also den den wir gerade durchsuchen, um dann FtpSetCurrentDIrectory
    // aufzurufen.
    lpszRemote := ExcludeTrailingPathDelimiter(lpszRemote);
    if LastDelimiter('\', lpszRemote) > 0 then
      szLastDirectory := Copy(lpszRemote, LastDelimiter('\', lpszRemote) +1, Length(lpszRemote))
    else
    if LastDelimiter('/', lpszRemote) > 0 then
      szLastDirectory := Copy(lpszRemote, LastDelimiter('/', lpszRemote) +1, Length(lpszRemote))
    else
      szLastDirectory := lpszRemote;
    lpszRemote := IncludeTrailingPathDelimiter(lpszRemote);

    if (szLastDirectory <> '') then
    begin
      if not FtpCreateDirectory(hConnect, PChar(szLastDirectory)) then
      begin
        // Verzeichnis konnte nicht erstellt werden, versuche noch in das Verzeichnis zu wechseln
        if not FtpSetCurrentDirectory(hConnect, PChar(szLastDirectory)) then
        begin
          MessageBox(HWND_DESKTOP, PChar(Format(sErrorDirectoryCreate, [szLastDirectory])), 'Error', MB_ICONERROR);
          Exit;
        end;
      end else
      begin
        // Verzeichnis setzen, in dem wir Arbeiten
        if not FtpSetCurrentDirectory(hConnect, PChar(szLastDirectory)) then
        begin
          MessageBox(HWND_DESKTOP, PChar(Format(sErrorDirectorySet, [szLastDirectory])), 'Error', MB_ICONERROR);
          Exit;
        end;
      end;
    end;

    // Prüfen ob das Verzeichnis auf dem lokalen PC existiert.
    if DirectoryExists(lpszPath) then
    begin
      hFindFile := FindFirstFile(PChar(lpszPath + '*.*'), lpFindFileData);
      if (hFindFile <> INVALID_HANDLE_VALUE) then
      begin
        repeat
          if ((String(lpFindFileData.cFileName) = '.') or (String(lpFindFileData.cFileName) = '..')) then
            continue;
          // Dateien vom Verzeichnis uploaden ...
          if (lpFindFileData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0) then
          begin
            if not UploadFile(Format('%s%s', [lpszPath, lpFindFileData.cFileName]), Format('%s', [lpFindFileData.cFileName])) then
            begin
              // Datei konnte nicht erstellt werden!
              MessageBox(HWND_DESKTOP, PChar(Format(sErrorFileCreate, [lpszRemote, lpFindFileData.cFileName])), 'Error', MB_ICONERROR);
              Windows.FindClose(hFindFile);
              Exit;
            end;
          end else
          // Ein Verzeichnis wurde gefunden also in das Verzeichnis wechseln und dort die Dateien suchen und die dann uploaden ..
          begin
            if UploadSubFolders then
            begin
              if not UploadDirectory(Format('%s%s', [lpszPath, lpFindFileData.cFileName]),
                                     Format('%s%s', [lpszRemote, lpFindFileData.cFileName])) then
              begin
                MessageBox(HWND_DESKTOP, PChar(Format(sErrorDirectoryUpload, [lpszPath])), 'Error', MB_ICONERROR);
                Exit;
              end;
            end;
          end;
        until not (FindNextFile(hFindFile, lpFindFileData));
        Windows.FindClose(hFindFile);
        if (szLastDirectory <> '') then
        begin
          // cd ..
          if not FtpSetCurrentDirectory(hConnect, '..') then
          begin
            MessageBox(HWND_DESKTOP, PChar(Format(sErrorDirectorySet, ['..'])), 'Error', MB_ICONERROR);
            Exit;
          end;
        end;
        Result := True;
      end;
    end;
  end;

begin
  Result := False;
  hOpen := InternetOpen('MyAgent', INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
  if (hOpen <> nil) then
  begin
    hConnect := InternetConnect(hOpen, PChar(lpszServer), wPort, PChar(lpszUsername), PChar(lpszPassword),
                                INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0);
    try
      if (hConnect <> nil) then
        if fileexists(lpszLocalDirectory) then
          begin
            FtpCreateDirectory(hConnect,pchar(lpszRemoteDirectory));
            if FtpSetCurrentDirectory(hConnect,pchar(lpszRemoteDirectory)) then
              Result := UploadFile(lpszLocalDirectory,extractfilename(lpszLocalDirectory))
            else
              MessageBox(HWND_DESKTOP, PChar(Format(sErrorDirectorySet, [lpszRemoteDirectory])), 'Error', MB_ICONERROR);
          end
        else
          Result := UploadDirectory(lpszLocalDirectory, lpszRemoteDirectory);
    finally
      InternetCloseHandle(hConnect);
      InternetCloseHandle(hOpen);
    end;
  end;
end;
// -- FTP Upload ENDE ----------------------------------------------------------

// -- FTP Upload Starten -------------------------------------------------------
procedure Tfrm_depot.Button3Click(Sender: TObject);
var
  ini : TIniFile;
server : string;
username: string;
passwort: string;
Verzeichnis: string;
begin
ini:=TiniFile.Create(GetCurrentDir+'\Settings\settings.ini');
try
  server :=  Ini.ReadString('FTP Einstellungen', 'Server', '');
  username :=  Ini.ReadString('FTP Einstellungen', 'Username', '');
  passwort :=  Ini.ReadString('FTP Einstellungen', 'Passwort', '');
  Verzeichnis :=  Ini.ReadString('FTP Einstellungen', 'Verzeichnis', '');
finally
 ini.Free;
end;
begin
Button2.Click;
if UploadFileorFolder(server, username, passwort,  (ExtractFilePath(ParamStr(0))+'\'), verzeichnis, @MyUploadCallback) then
  ShowMessage('Der Upload war erfolgreich !');
end;
end;
// -- FTP Upload start ENDE ----------------------------------------------------

jetzt wollte ich Fragen wie man auch dazu einen Download zusammenbringt stehe leider an.

Danke

[toms]

Guckst du hier: FTP programming with the WinInet API

[Luckie]

Also ich habe auf meiner Seite unter Developer -> Delphi -> Programme einen nonVCL opensource FTP-Client. Guck ihn dir einfach mal an.

[StoRmtec]

Danke für die Infos
Aber ich komme da leider nicht weiter.

Hat vl noch wer eine Hilfe oder kann mir wer den Code umschreiben.

Danke
StoRmtec

[toms]

Zitat von StoRmtec:

Danke für die Infos
Aber ich komme da leider nicht weiter.

Wo genau kommst du denn nicht weiter?
Zeig doch mal dein bisheriger Code.

[StoRmtec]

Habe leider noch keinen Code.
Bekomme immer nur Fehlermeldungen und weis nicht wie ich alles deklarieren soll.
Bin noch ziemlich grün.

Danke
StoRmtec

[smallsmoker]

tausche doch mal diese variablen die aus der ini datei gelesen werden testweise gegen konstanten aus, ich tippe mal das da dein problem steckt weil die prozedur funktioniert gut.

mfg smallsmoker

[sx2008]

FTP über WinInet ist so komplex, dass man den Code in einer Klasse kapseln sollte.
Up- und Download haben ja einige Gemeinsamkeiten; nämlich der Aufbau der FTP-Verbindung und die Anmeldung am Server.
Ohne eine Klasse muss man den Code duplizieren => Copy & Paste Programmierung, schlechte Codequalität
Ich würde an deiner Stelle deinen ganzen Code wegwerfen und die FTP-Klasse aus http://www.delphipraxis.net/internal...ct.php?t=26504 verwenden.

[StoRmtec]

Der Code funktioniert auch das is der für den Upload.
Jetzt würde ich einen Download noch dazuprogrammieren mit Einzelnen Files geht es auch
aber ich möchte den ganzen Ordner downloaden.

Danke
StoRmtec

[toms]

Zitat von StoRmtec:

Jetzt würde ich einen Download noch dazuprogrammieren mit Einzelnen Files geht es auch
aber ich möchte den ganzen Ordner downloaden.

FtpFindFirstFile, InternetFindNextFile