Delphi-PRAXiS
Seite 2 von 2     12   

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Netzwerke (https://www.delphipraxis.net/14-netzwerke/)
-   -   Delphi Dateien von einem Ftp server runter/hochladen (https://www.delphipraxis.net/101401-dateien-von-einem-ftp-server-runter-hochladen.html)

OldGrumpy 4. Nov 2007 18:33

Re: Dateien von einem Ftp server runter/hochladen
 
Zitat:

Zitat von Time2Play
Dann bekomme ich den EidProtokollError: "File not Found"

...was bedeutet dass der übergebene Name so nicht auf dem Server existiert...

little_budda 4. Nov 2007 18:49

Re: Dateien von einem Ftp server runter/hochladen
 
Hallo,

hier noch ein paar Funktionen um Daten per WinInet und Delphi FTP zu bewegen.
Der Wert "frm_load_firmware.cb_use_different_ftp_on_dual_co re.checked = true" schaltet zwischen den Win-Inet und den Delphi FTP Funktionen um.

Delphi-Quellcode:
procedure StatusCallback(hInet: HINTERNET; Context, Status: DWORD; pInformation: Pointer; InfoLength: DWORD); stdcall;
// Rückgabewerte der FTP-Aktionen
var
  s                : string;
begin
  case Status of

//    INTERNET_STATUS_REQUEST_SENT: s := 'Successfully sent the information request to the server: ' + IntToStr(Integer(pInformation^)) + ' Byte';
//    INTERNET_STATUS_RESPONSE_RECEIVED: s := 'Successfully received a response from the server: ' +   IntToStr(Integer(pInformation^)) + ' Byte';
    INTERNET_STATUS_REQUEST_SENT: begin
                                    iUpLoadedFileSize := iUpLoadedFileSize + Integer(pInformation^);
                                    s := 'Bisher wurden ' + formatIntValue(iUpLoadedFileSize) + ' Byte übertragen.';
                                  end;
    INTERNET_STATUS_RESPONSE_RECEIVED: begin
                                         iDownLoadedFileSize := iDownLoadedFileSize + Integer(pInformation^);
                                         s := 'Bisher wurden ' +   IntToStr(iDownLoadedFileSize) + ' Byte empfangen.';
                                       end;
  end;
  if (s <> '') then
    begin
      frm_load_firmware.lb_status.caption := s;
      frm_load_firmware.GaugeProgress.Progress := iUpLoadedFileSize;
      Application.ProcessMessages;
    end;
end;


procedure GetDir;
var
  szBuffer: array[0..1024] of Char;
  sSaveBuffer, sSaveSize : string;
  finddata: TWin32FindData;
  hFile  : HINTERNET;
begin
  frm_load_firmware.LB_ftp_content.items.clear;
  SetCursor(LoadCursor(0, IDC_WAIT));

  if (frm_load_firmware.cb_use_different_ftp_on_dual_core.checked = true) then
    begin
      // alternative Funktionen
      frm_load_firmware.LB_ftp_content.items.clear;
      frm_load_firmware.NMFTP1.List;
      if (iIndySubDirLevel > 0)
        then frm_load_firmware.LB_ftp_content.items.Insert(0, '                     <DIR>         ..');
    end
  else
    begin
      // WinInetFunktionen
      frm_load_firmware.LB_ftp_content.items.add('[..]');
      lstrcpy(szBuffer, finddata.cFilename);
      // Verzeichnisse
      hFile := FTPFindFirstFile(hFTPSession, '*.*', finddata, 0, 0);
      if hFile <> nil then
      begin
        repeat
          if (finddata.dwFileAttributes and not FILE_ATTRIBUTE_DIRECTORY = 0) then
          begin
            lstrcpy(szBuffer, finddata.cFilename);
            frm_load_firmware.LB_ftp_content.items.add('[' + string(szBuffer) + ']');
          end;
        until not InternetFindNextFile(hFile, @finddata);
        InternetCloseHandle(hFile);
      end;
      // Dateien
      hFile := FTPFindFirstFile(hFTPSession, '*.*', finddata, 0, 0);
      if hFile <> nil then
      begin
        repeat
          if (finddata.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0) then
          begin
            lstrcpy(szBuffer, finddata.cFilename);
            sSaveBuffer := string(szBuffer);
            sSaveSize := formatIntValue(finddata.nFileSizeLow);
            frm_load_firmware.LB_ftp_content.items.add(fillString(sSaveBuffer, 24, true) + fillString(sSaveSize, 16, false));
          end;
        until not InternetFindNextFile(hFile, @finddata);
        InternetCloseHandle(hFile);
      end;
    end;
  SetCursor(LoadCursor(0, IDC_ARROW));
  frm_load_firmware.MemoProtokoll.lines.add('Hole Verzeichnisinhalt');
end;


procedure GetCurDir;
const
  LEN_CUR_DIR = 23; // Length('aktuelles Verzeichnis: ')
var
  szBuffer, szDir: array[0..MAX_PATH - 1 + LEN_CUR_DIR] of Char;
  lenDir: DWORD;
begin
  frm_load_firmware.lb_status.caption := 'aktuelles Verzeichnis ermitteln...';
  Application.ProcessMessages;

  lenDir := MAX_PATH;
  FTPGetCurrentDirectory(hFTPSession, szDir, lenDir);
  frm_load_firmware.lb_status.caption := 'aktuelles Verzeichnis anzeigen ... ';
  lstrcat(szBuffer, szDir);
  frm_load_firmware.ed_akt_ftp_dir.text := szDir;

  Application.ProcessMessages;
  GetDir;
end;

function Connect(szHost, szUser, szPW: pchar):boolean;
 var bKrit1, bKrit2 : boolean;
begin
  frm_load_firmware.MemoProtokoll.lines.add('Verbinden mit :' + string(szhost));
  SetCursor(LoadCursor(0, IDC_WAIT));
  Application.ProcessMessages;

  if (frm_load_firmware.cb_use_different_ftp_on_dual_core.checked = true) then
    begin
      // Zugangsdaten für alternativen FTP Client
      iAktionsNummer := iAktionsNummer + 1;
      sAktionsStatus := 'wait';

      frm_load_firmware.NMFTP1.host    := string(szHost);
      frm_load_firmware.NMFTP1.UserID  := string(szUser);
      frm_load_firmware.NMFTP1.password := string(szPW);
      frm_load_firmware.NMFTP1.Connect;

      // Auf Rückgabe warten
      while (sAktionsStatus = 'wait') do
        begin
          sleep(10);
          Application.processMessages;
        end;
      // Rückgabewert setzen
      if (sAktionsStatus = 'true') then
        begin
          frm_load_firmware.LB_ftp_content.items.clear;
          frm_load_firmware.NMFTP1.List;
          bFtpConnectValid := true;
          result := true;
        end
      else
        begin
          bFtpConnectValid := false;
          result := false;
        end;
    end
  else
    begin
      hIntSession := InternetOpen('FTP-CLIENT', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
      if hIntSession = nil then
        begin
          frm_load_firmware.lb_status.caption := 'Internet-Session konnte nicht geöffnet werden';
          result := false;
          exit;
        end
      else
        begin
          InternetSetStatusCallback(hIntSession, @StatusCallback);
          frm_load_firmware.lb_status.caption := 'Internet-Session erfolgreich angelegt';
          bKrit1 := true;
        end;

      hFTPSession := InternetConnect(hIntSession, szHost, INTERNET_DEFAULT_FTP_PORT, szUser, szPW, INTERNET_SERVICE_FTP, 0, 0);
      if hFTPSession = nil then
        begin
          frm_load_firmware.lb_status.caption := 'FTP-Session konnte nicht geöffnet werden';
          InternetCloseHandle(hIntSession);
          result := false;
          exit;
        end
      else
        begin
          frm_load_firmware.lb_status.caption := 'FTP-Session erfolgreich angelegt';
          frm_load_firmware.lb_status.caption := 'aktuelles Verzeichnis anzeigen ...';
          Application.ProcessMessages;
          GetCurDir;
          // Application.ProcessMessages;
          // GetDir;
          bKrit2 := true;
        end;
      if ((bKrit1 = true) and (bKrit2 = true))
        then result := true
        else result := false;
    end;
  SetCursor(LoadCursor(0, IDC_ARROW));
end;


function ChangeDir(szDir : pchar) : boolean;
begin
  frm_load_firmware.MemoProtokoll.lines.add('Verzeichniswechsel nach : ' + string(szdir));
  if (frm_load_firmware.cb_use_different_ftp_on_dual_core.checked = true) then
    begin
      // alternative Funktionen
      iAktionsNummer := iAktionsNummer + 1;
      sAktionsStatus := 'wait';

      if (string(szDir) = '..')
        then iIndySubDirLevel := iIndySubDirLevel - 1
        else iIndySubDirLevel := iIndySubDirLevel + 1;

      frm_load_firmware.NMFTP1.ChangeDir(string(szDir));
      frm_load_firmware.LB_ftp_content.items.clear;
      frm_load_firmware.NMFTP1.list;

      if (iIndySubDirLevel > 0)
        then frm_load_firmware.LB_ftp_content.items.Insert(0, '                     <DIR>         ..');

      // Auf Rückgabe warten
      while (sAktionsStatus = 'wait') do
        begin
          sleep(10);
          Application.processMessages;
        end;
      // Rückgabewert setzen
      if (sAktionsStatus = 'true')
        then result := true
        else result := false;
    end
  else
    begin
      // WinInetFunktionen
      if FTPSetCurrentDirectory(hFTPSession, szDir) then
        begin
          frm_load_firmware.lb_status.caption := 'Verzeichnisinhalt ermitteln...';
          Application.ProcessMessages;
          frm_load_firmware.MemoProtokoll.lines.add('.. erfolgreich');
          GetCurDir;
          result := true;
          Application.ProcessMessages;
        end
      else
        begin
          frm_load_firmware.lb_status.caption := 'Verzeichnis konnte nicht gewechselt werden';
          result := false;
          frm_load_firmware.MemoProtokoll.lines.add('.. nicht erfolgreich');
          Application.ProcessMessages;
        end;
    end;
end;


function getFileSize(sFileName : string) : integer;
// Ermittelt die Dateigröße in Byte der übergebenen Datei
// Wenn die Datei nicht erreichbar ist dann ist die Rückgabe 0
var
  fs: TFileStream;
begin
  frm_load_firmware.MemoProtokoll.lines.add('Dateigröße holen');
  if FileExists(sFileName) then
    begin
      try
        fs := TFileStream.Create(sFileName, fmOpenRead or fmShareDenyWrite);
        Application.ProcessMessages;
        result := fs.Size;
        frm_load_firmware.MemoProtokoll.lines.add(inttostr(fs.Size) + 'Bytes');
        fs.Free;
      except
        result :=0;
      end;
    end
  else
    begin
      result := 0;
    end;
end;


function UpLoad(pMyHomeFile, pMyRemoteFile : pchar) : boolean;
var iFileSize : integer;
begin
  frm_load_firmware.MemoProtokoll.lines.add('DateiUebertragung von: ' + string(pMyRemotefile));
  SetCursor(LoadCursor(0, IDC_WAIT));

  iUpLoadedFileSize := 0;
  iFileSize := getFileSize (string(pMyHomeFile));
  if (iFileSize > 0) then
    begin
      frm_load_firmware.GaugeProgress.MaxValue := iFileSize;
      frm_load_firmware.GaugeProgress.Progress := 0;
      frm_load_firmware.GaugeProgress.Visible := true;
    end;

  if (frm_load_firmware.cb_use_different_ftp_on_dual_core.checked = true) then
    begin
      // alternative Funktionen
      iAktionsNummer := iAktionsNummer + 1;
      sAktionsStatus := 'wait';
      frm_load_firmware.NMFTP1.Upload(string(pMyHomeFile), string(pMyRemoteFile));
      frm_load_firmware.LB_ftp_content.items.clear;
      frm_load_firmware.NMFTP1.list;
      // Auf Rückgabe warten
      while (sAktionsStatus = 'wait') do
        begin
          sleep(10);
          Application.processMessages;
        end;
      // Rückgabewert setzen
      if (sAktionsStatus = 'true')
        then result := true
        else result := false;
    end
  else
    begin
       // WinInetFunktionen
      if FTPPutFile(hFTPSession, pMyHomeFile, pMyRemoteFile, FTP_TRANSFER_TYPE_BINARY, 1) then
        begin
          frm_load_firmware.lb_status.caption := 'Datei erfolgreich hochgeladen';
          result := true;
          frm_load_firmware.MemoProtokoll.lines.add('.. erfolgreich');
          Application.ProcessMessages;
        end
      else
        begin
          frm_load_firmware.lb_status.caption := 'Datei-Upload fehlgeschlagen';
          result := false;
          frm_load_firmware.MemoProtokoll.lines.add('.. nicht erfolgreich');
          Application.ProcessMessages;
        end;
    end;
  frm_load_firmware.lb_status.caption := 'Verzeichnisinhalt ermitteln...';
  Application.ProcessMessages;
//  GetDir;
  frm_load_firmware.GaugeProgress.Visible := false;
  SetCursor(LoadCursor(0, IDC_ARROW));
end;


function DelFile(szBuffer : pchar) : boolean;
begin
  frm_load_firmware.MemoProtokoll.lines.add('Datei löschen: ' + string(szBuffer));
  frm_load_firmware.lb_status.caption := 'Datei wird gelöscht ...';
  Application.ProcessMessages;
  if (frm_load_firmware.cb_use_different_ftp_on_dual_core.checked = true) then
    begin
      // alternative Funktionen
      iAktionsNummer := iAktionsNummer + 1;
      sAktionsStatus := 'wait';
      frm_load_firmware.NMFTP1.Delete(string(szBuffer));
      frm_load_firmware.LB_ftp_content.items.clear;
      frm_load_firmware.NMFTP1.list;
      // Auf Rückgabe warten
      while (sAktionsStatus = 'wait') do
        begin
          sleep(10);
          Application.processMessages;
        end;
      // Rückgabewert setzen
      if (sAktionsStatus = 'true')
        then result := true
        else result := false;
    end
  else
    begin
      // WinInetFunktionen
      if FTPDeleteFile(hFTPSession, szBuffer) then
        begin
          frm_load_firmware.lb_status.caption := 'Datei gelöscht';
          result := true;
          frm_load_firmware.MemoProtokoll.lines.add('.. erfolgreich');
          Application.ProcessMessages;
        end
      else
        begin
          frm_load_firmware.lb_status.caption := 'Datei konnte nicht gelöscht werden';
          result := false;
          frm_load_firmware.MemoProtokoll.lines.add('.. nicht erfolgreich');
          Application.ProcessMessages;
        end;
    end;
//  GetDir;
end;


function RenameFile(szOldName, szNewName : pchar) : boolean;
begin
  frm_load_firmware.MemoProtokoll.lines.add('Datei umbenennen.');
  frm_load_firmware.MemoProtokoll.lines.add('Von: ' + string(szOldName) + ' in: ' + string(szNewName));

  frm_load_firmware.lb_status.caption := 'Datei umbenennen ...';
  Application.ProcessMessages;
  if (frm_load_firmware.cb_use_different_ftp_on_dual_core.checked = true) then
    begin
      // alternative Funktionen
      iAktionsNummer := iAktionsNummer + 1;
      sAktionsStatus := 'wait';
      frm_load_firmware.NMFTP1.Rename(string(szOldName), string(szNewName));

      frm_load_firmware.LB_ftp_content.items.clear;
      frm_load_firmware.NMFTP1.list;
      // Auf Rückgabe warten
      while (sAktionsStatus = 'wait') do
        begin
          sleep(10);
          Application.processMessages;
        end;
      // Rückgabewert setzen
      if (sAktionsStatus = 'true')
        then result := true
        else result := false;
    end
  else
    begin
      // WinInetFunktionen
      if FTPRenameFile(hFTPSEssion, szOldName, szNewName) then
        begin
          frm_load_firmware.lb_status.caption := 'Datei umbenannt';
          result := true;
          frm_load_firmware.MemoProtokoll.lines.add('.. erfolgreich');
          Application.ProcessMessages;
        end
      else
        begin
          frm_load_firmware.lb_status.caption := 'Datei konnte nicht umbenannt werden';
          result := false;
          frm_load_firmware.MemoProtokoll.lines.add('.. nicht erfolgreich');
          Application.ProcessMessages;
        end;
    end;
//  GetDir;
end;


function DelDir(szBuffer : pchar) : boolean;
begin
  frm_load_firmware.MemoProtokoll.lines.add('Verzeichnis loeschen: ' + string(szBuffer));
  frm_load_firmware.lb_status.caption := 'Verzeichnis wird gelöscht ...';
  Application.ProcessMessages;
  if (frm_load_firmware.cb_use_different_ftp_on_dual_core.checked = true) then
    begin
      // alternative Funktionen
      iAktionsNummer := iAktionsNummer + 1;
      sAktionsStatus := 'wait';
      frm_load_firmware.NMFTP1.RemoveDir(string(szBuffer));
      frm_load_firmware.LB_ftp_content.items.clear;
      frm_load_firmware.NMFTP1.list;
      // Auf Rückgabe warten
      while (sAktionsStatus = 'wait') do
        begin
          sleep(10);
          Application.processMessages;
        end;
      // Rückgabewert setzen
      if (sAktionsStatus = 'true')
        then result := true
        else result := false;
    end
  else
    begin
      // WinInetFunktionen
      if FTPRemoveDirectory(hFTPSession, szBuffer) then
        begin
          frm_load_firmware.lb_status.caption := 'Verzeichnis gelöscht';
          result := true;
          frm_load_firmware.MemoProtokoll.lines.add('.. erfolgreich');
          Application.ProcessMessages;
        end
      else
        begin
          frm_load_firmware.lb_status.caption := 'Verzeichnis konnte nicht gelöscht werden';
          result := false;
          frm_load_firmware.MemoProtokoll.lines.add('.. nicht erfolgreich');
          Application.ProcessMessages;
        end;
    end;
//  GetDir;
end;


function MakeDir(szNewDir : pchar) : boolean;
begin
  frm_load_firmware.lb_status.caption := 'Verzeichnis anlegen ... ' ;
  Application.ProcessMessages;
  frm_load_firmware.MemoProtokoll.lines.add('Verzeichnis anlegen: ' + string(szNewdir));
  if (frm_load_firmware.cb_use_different_ftp_on_dual_core.checked = true) then
    begin
      // alternative Funktionen
      iAktionsNummer := iAktionsNummer + 1;
      sAktionsStatus := 'wait';
      frm_load_firmware.NMFTP1.MakeDirectory(string(szNewDir));
      frm_load_firmware.LB_ftp_content.items.clear;
      frm_load_firmware.NMFTP1.list;
      // Auf Rückgabe warten
      while (sAktionsStatus = 'wait') do
        begin
          sleep(10);
          Application.processMessages;
        end;
      // Rückgabewert setzen
      if (sAktionsStatus = 'true')
        then result := true
        else result := false;
    end
  else
    begin
      // WinInetFunktionen
      if FTPCreateDirectory(hFTPSEssion, szNewDir) then
        begin
          frm_load_firmware.lb_status.caption := 'Verzeichnis angelegt';
          frm_load_firmware.MemoProtokoll.lines.add('.. erfolgreich');
          //  GetDir;
          result := true;
          Application.ProcessMessages;
        end
      else
        begin
          frm_load_firmware.lb_status.caption := 'Verzeichnis konnte nicht angelegt werden';
          result := false;
          frm_load_firmware.MemoProtokoll.lines.add('.. nicht erfolgreich');
          Application.ProcessMessages;
        end;
    end;
end;

Time2Play 4. Nov 2007 19:01

Re: Dateien von einem Ftp server runter/hochladen
 
@OldGrumpy: Aber wieso? Wenn ich das mit dem Savedialog mache kann ich auch alles runterladen, wenn ich ihn rausnehme gehts plötzlich nicht mehr :-O

@little-budda: danke schonmal, werd mir den ganzen code aufjedenfall mal in ruhe angucken, welche komponenten brauche ich um daten per WinInet zu verschicken? Auch Indy?

little_budda 4. Nov 2007 19:06

Re: Dateien von einem Ftp server runter/hochladen
 
Für WinInet brauchst du nichts.
Sind alles Windows Funktionen.

Gruß Holger.

Time2Play 4. Nov 2007 19:27

Re: Dateien von einem Ftp server runter/hochladen
 
ah okay thx, werd ich morgen ausprobieren muss noch latein übersetzen :D

schöni 1. Sep 2010 19:19

AW: Dateien von einem Ftp server runter/hochladen
 
Hab bisher verstanden das das Hoch- und runterladen mit Pu() bzw. Get() geht.

Wie aber kann ich mir das Homeverzeichnis des Servers anzeigen lassen? Welche Methode aus Indy FTP ist da zuständig?

himitsu 1. Sep 2010 20:02

AW: Dateien von einem Ftp server runter/hochladen
 
Mit ChangeDir ins gewünschte Verzeichnis, falls man noch nicht dort ist
und dann über eine der "List"-Methoden das Verzeichnis "auslisten" lassen. :angel2:


Alle Zeitangaben in WEZ +1. Es ist jetzt 15:09 Uhr.
Seite 2 von 2     12   

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz