AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Neuen Beitrag zur Code-Library hinzufügen Delphi Ordner oder Datei ohne indys per ftp uploaden mit fortschrit

Ordner oder Datei ohne indys per ftp uploaden mit fortschrit

Ein Thema von smallsmoker · begonnen am 29. Aug 2008 · letzter Beitrag vom 16. Sep 2008
Antwort Antwort
Benutzerbild von smallsmoker
smallsmoker

Registriert seit: 12. Nov 2007
Ort: Duisburg
283 Beiträge
 
#1

Ordner oder Datei ohne indys per ftp uploaden mit fortschrit

  Alt 29. Aug 2008, 11:25
Hallo DP,
hier habe eine funktion von ErazerZ gefunden die ich um die funktionalität erweitert habe auch eine datei hochzuladen (was ja eigentlich schon integriert war).

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 Form4 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 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;
Beispielaufruf für ordner upload:
Delphi-Quellcode:
if UploadFileorFolder('meinname.meinhost.de', 'meinusername', 'meinpasswort', 'C:\Testordner\', 'remoteordner', @MyUploadCallback) then
  ShowMessage('Der Upload war erfolgreich !');
Beispielaufruf für Datei upload:
Delphi-Quellcode:
if UploadFileorFolder('meinname.meinhost.de', 'meinusername', 'meinpasswort', 'C:\Testordner\meinedatei.txt', '', @MyUploadCallback) then
  ShowMessage('Der Upload war erfolgreich !');
wenn lpszRemoteDirectory = "" ist dann wird in den root ordner geuploaded

mfg smallsmoker
  Mit Zitat antworten Zitat
StoRmtec

Registriert seit: 6. Jan 2003
209 Beiträge
 
#2

Re: Ordner oder Datei ohne indys per ftp uploaden mit fortsc

  Alt 16. Sep 2008, 23:21
Hallo
Danke sowas habe ich schon lämger gesucht.
Kann man da auch noch dazu machen das er den Ordner auch wieder downloaded ????????
Wäre echt cool

Danke
StoRmtec
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 07:52 Uhr.
Powered by vBulletin® Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf