FTP upload ohne INDY ! Kann mir jemand das erklären ?

[ErazerZ]

hey!
ich habe den code einwenig umgeändert damit man auch in das homeverzeichnis uploaden kann und man kann angeben ob man subfolders uploaden will

Delphi-Quellcode:

function UploadFolder(lpszServer, lpszUsername, lpszPassword, lpszLocalDirectory, lpszRemoteDirectory: String; 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!';
var
  hOpen, hConnect: HINTERNET;
  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 FtpPutFile(hConnect,
                               PChar(Format('%s%s', [lpszPath, lpFindFileData.cFileName])),
                               PChar(Format('%s', [lpFindFileData.cFileName])), FTP_TRANSFER_TYPE_UNKNOWN, 0) 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);
    if (hConnect <> nil) then
    begin
      Result := UploadDirectory(lpszLocalDirectory, lpszRemoteDirectory);
      InternetCloseHandle(hConnect);
      InternetCloseHandle(hOpen);
    end;
  end;
end;

Hier ist die erklärung:

Delphi-Quellcode:

function UploadFolder(
lpszServer,                       // Server Adresse, z.b. xyz.meineseite.de
lpszUsername,                     // Username ..
lpszPassword,                     // Password ..
lpszLocalDirectory,               // Lokaler Ordner, also der der raufgeladen werden soll
lpszRemoteDirectory: String;      // Ordner der auf den server, z.B '' ist das Homeverzeichnis, der Ordner muss nicht existieren auf den Server (es wird zuerst versucht ihn zu erstellen)
UploadSubFolders: Boolean = True; // Angeben ob man will das Unterordner raufgeladen werden auf den Server
wPort: Word = 21)                 // Port vom Server
: Boolean;

Ich habe die funktion getestet auf funpic.de, und es scheint perfekt zu funktionieren, hast du rechte um Ordner zu erstellen oder so? Falls nicht, versuch mit lpszRemoteDirectory = ''.

[eLse-maestro]

coool danke .. BIG THX ! nach sowas hab ich schon lange gesucht !!
Danke
hdl

[ErazerZ]

Hi,
Ich habe mal eine neue Funktion geschrieben die das Uploaden selber übernimmt und man somit z.B die Upload Zeit berechnen kann oder die KB pro Sekunde.

Delphi-Quellcode:

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

procedure MyUploadCallback(lpszLocal, lpszRemote: string; dwBytesTotal, dwBytesDone: DWORD; Elapsed: Single);
begin
  with frmMain do
  begin
    Label1.Caption := 'Filename: ' + lpszLocal;
    Label2.Caption := 'Remotename: ' + lpszRemote;
    Label3.Caption := 'Done: ' + Format('%2.n KB/%2.n KB', [dwBytesDone / 1024, dwBytesTotal / 1024]);
    Label4.Caption := 'Percent: ' + IntToStr(Integer(Round((dwBytesDone * 100) / dwBytesTotal)));
    ProgressBar1.Max := 100;
    ProgressBar1.Position := Integer(Round((dwBytesDone * 100) / dwBytesTotal));
    Label5.Caption := 'Elapsed: ' + Format('%2.n sec', [Elapsed]);
    if (Elapsed > 0) then
      Label6.Caption := 'Speed: ' + Format('%2.n KB/sec', [dwBytesDone / Elapsed]);
  end;
end;

function UploadFolder(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;  // Download 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);
    if (hConnect <> nil) then
    begin
      Result := UploadDirectory(lpszLocalDirectory, lpszRemoteDirectory);
      InternetCloseHandle(hConnect);
      InternetCloseHandle(hOpen);
    end;
  end;
end;

Beispiel aufruf:

Delphi-Quellcode:

 
  if UploadFolder('meinserver.de', 'meinusername', 'meinpassword', 'c:\tmp', 'etc', @MyUploadCallback) then
    ShowMessage('Verzeichnis erfolgreich geuploaded!');