Einzelnen Beitrag anzeigen

Benutzerbild von ErazerZ
ErazerZ

Registriert seit: 27. Mai 2005
Ort: Baden
315 Beiträge
 
Delphi 2007 Enterprise
 
#11

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

  Alt 20. Okt 2006, 12:47
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 = ''.
  Mit Zitat antworten Zitat