Einzelnen Beitrag anzeigen

Benutzerbild von ErazerZ
ErazerZ

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

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

  Alt 18. Okt 2006, 16:19
hey
ich hab diese funktion grad für dich gemacht, ist nicht ganz fertig, ich ändere es später wieder wenn ich wieder komme (falls ich fehler finde), ich muss jetzt wieder los


Edit:
Code geändert und getestet, alles funktioniert wunderbar

Delphi-Quellcode:
function UploadFolder(lpszServer, lpszUsername, lpszPassword, lpszLocalDirectory, lpszRemoteDirectory: String; 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 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;
    // 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 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;
        until not (FindNextFile(hFindFile, lpFindFileData));
        Windows.FindClose(hFindFile);
        // cd ..
        if not FtpSetCurrentDirectory(hConnect, '..') then
        begin
          MessageBox(HWND_DESKTOP, PChar(Format(sErrorDirectorySet, ['..'])), 'Error', MB_ICONERROR);
          Exit;
        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', 'admin', 'r00t', 'c:\tmp', 'etc') then
    showmessage('Verzeichnis wurde auf den server geuppt!');
  Mit Zitat antworten Zitat