TFtpClient files download wrong files size

[Guest]

Hi All,

I am using the TFtpClient ICS component with Delphi 7 under Win7.
The files upload are OK but when I download files I get :

1 - image zero size (jpeg or png)

2 - word document file is empty (zero size)
3 - pdf file is OK

UPDATE: pdf was OK and know no (don't understand)

On the site images and documents files are corrects (???)
I wonder if it is a corrupt files.........

Can you please help me to solve this problem ?
Thank you
Regards,

 

Here is my code

Function FtpDownLoadFile(FHost: String;FUserName: String;FPassword: String;F_FileName: String;F_FromHostDir,F_LocalDir : String ):Boolean;
var
FTP:TFtpClient;
begin

Result:=False;
FTP:=TFtpClient.Create(nil);

  try 
    FTP.HostName := FHost;
    FTP.Username := FUserName;
    FTP.Password :='xxx';// FPassword;
    FTP.Timeout:= ftpTimeOut;
    FTP.LocalFileName      := F_LocalDir+'\'+F_FileName;
    FTP.HostDirName        := F_FromHostDir;
    FTP.HostFileName       := F_FileName;
    FTP.Binary   := TRUE;
    FTP.Passive  := TRUE;

  if not  FTP.Connected then FTP.Connect;
  FTP.Get;
   
  finally
  If Assigned(FTP) then FTP.Free;
  Result:=True;
  end;
 end;

Edited March 20, 2023 by Guest

[Guest]

Forgot to tell that I use OverbyteIcsFtpServ demo for uploading files
Regards,

[Fr0sT.Brutal 900]

Did you even look at FTP client demo? You're using it fundamentally wrong. ICS is asynchronous - this means you start an action and wait for some events to happen

[Angus Robertson 574]

Most ICS high level protocol components provide both sync and async methods, the former are often easier to work with for many applications. 

 

Impossible to say why the presented code is not working, since there are no given parameters or any logging of what the component actually does. 

 

It is also the old way to create FTP applications.  You should build the sample OverbyteIcsXferTst.dpr which uses the modern TIcsFtpMulti component.  Look at the Single FTP tab and the

doFtpDown1Click method which shows how to download a single file, although it is just as easy to tell it to download a complete directory structure of thousands of files,

 

I appreciate OverbyteIcsXferTst.dpr is a complex sample illustrating several different components, I'll do a simple FTP snippet later today. 

 

Angus

 

 

[Guest]

Before I used that code directly from the component and not creating
 

if not  FtpClient1.Connected then
FtpClient1.OpenAsync
else
 try
FtpClient1.GetAsync;
Result:=true;
except
Result:=false;
Screen.Cursor:=crDefault;
end;

 

So  I used asynchronous and the downloaded files are corrects but I can dowload only one file until I restart either the application or the server so I changed the method instead of asynchronous and can download files at time but with empty files as explained in the previous post
 

The code for the RequestDone (frm the demo)  is:

procedure FtpClient1RequestDone(Sender: TObject; RqType: TFtpRequest;
  ErrCode: Word);
begin
 if ((RqType = ftpGetAsync) or (RqType = ftpRenameAsync) or (RqType = ftpDeleteAsync) or (RqType = ftpRenAsync) or
 (RqType = ftpListAsync) or (RqType = ftpConnectAsync) )  then begin

        if RqType = ftpConnectAsync  then
        begin
        If (ErrCode<>0) then
         begin           
         MessageBeep(MB_ICONEXCLAMATION);
         MessageDlg(Server stopped',mtInformation,[mbOk],0);
         abort;
         end;
        end;

        if ErrCode = 0 then
        begin
        // MessageBeep(MB_ICONEXCLAMATION);
        // MessageDlg('File received recu ' ,mtInformation,[mbOk],0);
        // FtpClient1.Quit;
        exit;
         end
         else
         If ((ErrCode=10061) or (ErrCode=500)) then
         begin
         Screen.Cursor:=crDefault;
         MessageBeep(MB_ICONEXCLAMATION);
         MessageDlg('Connection refused or service stopped ',mtInformation,[mbOk],0);
         abort;
         end;

         begin
         MessageBeep(MB_ICONEXCLAMATION);
         MessageDlg('Failed (Error ' +IntToStr(ErrCode) + ') '  ,mtInformation,[mbOk],0);
         abort;
         end;

         If ((ErrCode=10061) or (ErrCode=500)) then
         begin     
         MessageBeep(MB_ICONEXCLAMATION);
         MessageDlg('Connection refused or service stopped',mtInformation,[mbOk],0);
         abort;
         end;
    end
    else begin
        if ErrCode <> 0 then
        begin
         MessageBeep(MB_ICONEXCLAMATION);
         MessageDlg('Error #' + IntToStr(ErrCode),mtInformation,[mbOk],0);
         If ((ErrCode=10061) or (ErrCode=500)) then
         begin
         Screen.Cursor:=crDefault;
         MessageBeep(MB_ICONEXCLAMATION);
         MessageDlg('Connection refused or service stopped',mtInformation,[mbOk],0);
         end;
         Exit;
        end;
    end;

    try
        case RqType of
        ftpOpenAsync:    FtpClient1.User;
        ftpUserAsync:    FtpClient1.Pass;
        ftpPassAsync:    FtpClient1.Cwd;
        ftpCwdAsync:     FtpClient1.TypeSet;
        ftpConnectAsync:
        begin
        exit;
        end;

        ftpTypeSetAsync:
        begin
      //  if FtpClient1.Tag=2 then GetFile(fLocalFileName,fHostFileName,fLocalDirName,'get');
      //  if FtpClient1.Tag=3 then  GetFile(fLocalFileName,fHostFileName,fHostFileName,'rename');
        exit;
        end;

               

        ftpQuitAsync:    FtpClient1.Quit;
        else
        Begin
        // MessageBeep(MB_ICONEXCLAMATION);
        // MessageDlg('Unexpected RqType ' + IntToStr(Ord(RqType)),mtInformation,[mbOk],0);
          //  ResultsListBox.Items.Add('Unexpected RqType ' + IntToStr(Ord(RqType)));
        end;
        end;
    except
        on E:Exception do begin       
         MessageBeep(MB_ICONEXCLAMATION);
         MessageDlg( E.Message ,mtInformation,[mbOk],0);
        end;
    end;
end;

Thanks

 

 

 

 

 

 

 

 

Edited March 21, 2023 by Guest

[Guest]

I simplified and corrected the code using asynchronous methods writing in the RequestDone event of the component and now I can download multiple files at the time with the corrects sizes but the problem now the server seems to be looping (writing through the memo)  waiting for something maybe a closing connection (even I do FtpClient1.QuitAsync; without result)   and I cannot close the window of the application using the close button (X)  until I stop the service.

Thanks you for the help

 

 

procedure TDM1.FtpClient1RequestDone(Sender: TObject; RqType: TFtpRequest;ErrCode: Word);
begin
        if ErrCode <> 0 then
        begin
         MessageBeep(MB_ICONEXCLAMATION);
         MessageDlg('Error #' + IntToStr(ErrCode),mtInformation,[mbOk],0);
         If ((ErrCode=10061) or (ErrCode=500)) then
         begin
         Screen.Cursor:=crDefault;
         MessageBeep(MB_ICONEXCLAMATION);
         MessageDlg('Service stopped',mtInformation,[mbOk],0);
         end;
         Exit;
        end;   
    try
        case RqType of
        ftpOpenAsync:    FtpClient1.User;
        ftpUserAsync:    FtpClient1.Pass;
        ftpPassAsync:    FtpClient1.Cwd;
        ftpCwdAsync:     FtpClient1.TypeSet;
        ftpConnectAsync:
        begin
        exit;
        end;

        ftpTypeSetAsync:
        begin   
        GetFile(fLocalFileName,fHostFileName,fLocalDirName,'get');
        exit;
        end;

        ftpGetAsync:
        begin
        GetFile(fLocalFileName,fHostFileName,fLocalDirName,'get');
        exit;
        end;

        ftpRenameAsync:
        begin
        //
        end;

        ftpDeleteAsync:
        begin
        //
        end;

        ftpQuitAsync:    FtpClient1.QuitAsync;
        else
        Begin
        //
        end;
        end;
    except
        on E:Exception do begin           
         MessageBeep(MB_ICONEXCLAMATION);
         MessageDlg( E.Message ,mtInformation,[mbOk],0);
        end;
    end;
end;

 

Procedure GetFile
 

procedure TDM1.GetFile(LocalFileName,HostFileName, LocalDirName,CommandType: string);
begin

  if CommandType='get' then
  begin
  FtpClient1.LocalFileName := Trim(fLocalDirName) + '\' +fLocalFileName;
  FtpClient1.HostFileName  := fLocalFileName;
  FtpClient1.GetAsync;
  end;

end;

 

Code for the connection 

FtpClient1.HostName    := fHostName; 
FtpClient1.UserName    :=fUserName;
FtpClient1.PassWord    :='xxxxxx';
FtpClient1.HostDirName :=fHostDirName;
FtpClient1.LocalFileName:=fLocalFileName;
FtpClient1.TimeOut :=ftpTimeOut;
FtpClient1.Binary   := TRUE;
FtpClient1.Passive  := TRUE;
if not  FtpClient1.Connected then
FtpClient1.OpenAsync
else
 try
FtpClient1.GetAsync;
Result:=true;
except
Result:=false;
Screen.Cursor:=crDefault;
exit;
end;

Edited March 21, 2023 by Guest

[Guest]

Sorry I don't see the tag SOLVED so it 's  solved
Thanks for all and have a good day

[Angus Robertson 574]

Uses   OverbyteIcsWsocket, OverbyteIcsFtpcli, OverbyteIcsFileCopy, OverbyteIcsFtpMulti;

procedure TSnippets.AddLogText(const Line: String);
begin
    LogWin.Lines.Add(Line);
end;

procedure TSnippets.onXferEvent (LogLevel: TIcsCopyLogLevel ; Info: string ; var Cancel: boolean) ;
begin
    if (LogLevel = LogLevelInfo) or (LogLevel = LogLevelFile) then
    begin
        AddLogText (Info) ;
        LabelProgress.Caption := Info ;
    end ;
    if (LogLevel = LogLevelProg) then
    begin
        if Info <> '' then
            LabelProgress.Caption := 'Progress: ' + Info
        else
            LabelProgress.Caption := '' ;
    end ;
    if (LogLevel = LogLevelDiag) and ShowDiags.Checked  then
        AddLogText (Info) ;
    if AbortFlag then
        Cancel := true ;
end;


procedure TSnippets.doFtpDownOneFileClick(Sender: TObject);
var
    FtpMultiClient: TIcsFtpMulti ;
    taskres: TIcsTaskResult ;
    myftppath, myftpfile, myfiletarget: String;
    myftphost, myftpusername, myftppassword: String;
    myftptype: TFtpType;
    myfilereplace: TIcsFileCopyRepl;
begin

// parameters for the single FTP download operation
    myftppath := '/testing' ;        // FTP server path for file
    myftpfile := 'speed50meg.zip';   // FTP file to download
    myfiletarget := IncludeTrailingPathDelimiter(DirTemp.Text) + myftpfile;  // where we download to
    myftphost := 'ics.ftptest.org' ;   // supports IPv4 and IPv6
    myftpusername := 'anonymous' ;     // no uploads
    myftppassword := 'icssnippets' ;
    myftptype := FtpTypeAuthSslBoth;  // or FtpTypeNone, FtpTypeConnSslBoth  (no SSL or only SSL)
    myfilereplace := FCReplAlways;    // or FCReplNever, FCReplNewer

// create component and events to see progress
    FtpMultiClient := TIcsFtpMulti.Create (self) ;
    FtpMultiClient.CopyEvent := onXferEvent ;
    doFtpDownOneFile.Enabled := false ;
    AbortFlag := false ;
    LabelProgress.Caption := '' ;
    try
        try
         // essential FTP parameters
            FtpMultiClient.SocketFamily := sfIPv4;  // or sfIPv6 or sfAny
            FtpMultiClient.HostName1 := myftphost ;
            FtpMultiClient.FtpType := myftptype ;
            FtpMultiClient.UserName := myftpusername ;
            FtpMultiClient.PassWord := myftppassword ;
            FtpMultiClient.MaxAttempts := 2 ;  // logon attempts, may try IPv6 then IPv4
            FtpMultiClient.FailRepeat := 2 ;   // retries for failed xfers
            FtpMultiClient.PassiveX := True ;  // must be after connection type
            FtpMultiClient.FtpSslVerMethod := ftpSslVerBundle;  // or ftpSslVerNone to skip checking certificates
            FtpMultiClient.FtpSslReportChain := False;  // true to list SSL certificates
            FtpMultiClient.SrcDir := '/' ;   // required
            FtpMultiClient.BulkMode := BulkModeDownload ;   // required

          // connect, login, get features
            taskres := FtpMultiClient.FtpLogon ;
            if taskres = TaskResOKNew then
            begin
                taskres := FtpMultiClient.FtpDownOneFile (myftppath, myftpfile, myfiletarget, myfilereplace) ;
            end ;
            AddLogText ('Task Result: ' + IcsGetTaskResName (taskres)) ;
            AddLogText (FtpMultiClient.ReqResponse) ;
        except
            AddLogText ('FTP Error - ' + IcsGetExceptMess (ExceptObject)) ;
        end ;
    finally
        FtpMultiClient.FtpLogoff ;
        FreeAndNil (FtpMultiClient) ;
        LabelProgress.Caption := 'FTP Completed' ;
        doFtpDownOneFile.Enabled := true ;
    end ;
end;

This code is from a new ICS snippets application that has simple examples of many common ICS tasks, this one downloads a single file using SSL from one of my public FTP servers, using the modern TIcsFtpMulti component.  It only needs a couple more properties and it will download multiple directories of files.

 

Angus

[Guest]

Thanks you very much for the Angus Robertson but it is enough complicated, anyway I will try to undertand it 
Have a good day

[Angus Robertson 574]

Much of my code is similar to yours, except it uses different methods that do vastly more complicated things than the simple methods in the older component.  Just build it and run it, with a log window, and it will just download a file.  Or you can run the OverbyteIcsXferTst.dpr sample that does the same thing.

 

It will be in SVN in a few days when I've done more snippets.

 

Angus