Solved

Indy10 TrivialFTP client

Posted on 2007-11-25
14
1,636 Views
Last Modified: 2010-04-21
Hello.
I am using RAD 2007 with Indy10 components.
I need to do custom but simply TrivialFTP client application, which provide only "PUT" function (may be with progressbar)
My piece of code is  very simply, but, if i start PUT procedure, it return to me an TIME-OUT error.
On SolarWinds TFTP server I can see a request for recieving data, but there isnt data flow...
Please can you help me?
Can You make a functionaly example of TrivialFTP client application?
thank you all!!!
My code...
 

procedure TForm1.UpdateButton1Click(Sender: TObject);

var

LoFileName,ReFileName: string;

begin

 LoFileName := 'c:\test\test.dat';

 ReFileName := ExtractFileName(LoFileName);
 

 with IdTrivialFTP1 do begin

    Host := Edit1.Text;

    Connect();

    Put(LoFileName, ReFileName);

  end;

  ShowMessage('Done!');

end;

Open in new window

0
Comment
Question by:Urumov
  • 7
  • 7
14 Comments
 
LVL 28

Expert Comment

by:ciuly
Comment Utility
0
 
LVL 28

Expert Comment

by:ciuly
Comment Utility
btw, registration on that site is free :)
0
 

Author Comment

by:Urumov
Comment Utility
hmm...i was try this code from delphi3000.com, but it  doesnt work.
If i try Upload or download procedure it say:
'range check error'
and if I try close apps it say:
'socket error #10054, connection reset by peer'
unit Unit1;
 

interface
 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer,

  IdTrivialFTPServer, StdCtrls, IdTrivialFTP, IdUDPClient;
 

type

  TForm1 = class(TForm)

    IdTrivialFTPServer1: TIdTrivialFTPServer;

    IdTrivialFTP1: TIdTrivialFTP;

    Button1: TButton;

    Button2: TButton;

    procedure FormCreate(Sender: TObject);

    procedure IdTrivialFTPServer1ReadFile(Sender: TObject;

      var FileName: String; const PeerInfo: TPeerInfo;

      var GrantAccess: Boolean; var AStream: TStream;

      var FreeStreamOnComplete: Boolean);
 
 

    procedure IdTrivialFTPServer1WriteFile(Sender: TObject;

      var FileName: String; const PeerInfo: TPeerInfo;

      var GrantAccess: Boolean; var AStream: TStream;

      var FreeStreamOnComplete: Boolean);

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure IdUDPClient1Connected(Sender: TObject);

    procedure IdTrivialFTPServer1TransferComplete(Sender: TObject;

      const Success: Boolean; const PeerInfo: TPeerInfo; var AStream: TStream;

      const WriteOperation: Boolean);

  private

    { Private declarations }

  public

    { Public declarations }

    TFTPPath              : String;

  end;
 

var

  Form1: TForm1;
 

implementation
 

{$R *.dfm}

{

procedure TForm1.IdTrivialFTPServer1TransferComplete(Sender: TObject;

  const Success: Boolean; const PeerInfo: TPeerInfo; AStream: TStream;

  const WriteOperation: Boolean);

begin
 

end; }
 

procedure TForm1.FormCreate(Sender: TObject);

begin

     IdTrivialFTPServer1.ThreadedEvent := True;

     IdTrivialFTPServer1.Active := True;

     { Set the path to where the files will be stored/retreived }

     TFTPPath := IncludeTrailingPathDelimiter('C:\Temp');

end;
 

procedure TForm1.IdTrivialFTPServer1ReadFile(Sender: TObject;

  var FileName: String; const PeerInfo: TPeerInfo;

  var GrantAccess: Boolean; var AStream: TStream;

  var FreeStreamOnComplete: Boolean);

Var

   FS : TFileStream;

begin

     FreeStreamOnComplete := True;

     Try

        { Convert UNIX style filenames to WINDOWS style }

        While Pos('/',Filename)<>0 do Filename[Pos('/',Filename)] := '\';

        { Assure that the filename DOES NOT CONTAIN any path information }

        Filename := ExtractFileName( Filename );

        { Check if file exists }

        If FileExists( TFTPPath+Filename ) then

        Begin

          { Open file in READ ONLY mode }

          FS := TFileStream.Create( TFTPPath+Filename,

                                    fmOpenRead OR fmShareDenyWrite );

          { Assign stream to variable }

          AStream := FS;

          { Set parameters }

          GrantAccess := True;

        End Else

        Begin

          GrantAccess := False;

        End;

     Except

        { On errors, deny access }

        GrantAccess := False;

        If Assigned(FS) then FreeAndNil( FS );

     End;

end;
 

procedure TForm1.IdTrivialFTPServer1TransferComplete(Sender: TObject;

  const Success: Boolean; const PeerInfo: TPeerInfo; var AStream: TStream;

  const WriteOperation: Boolean);

begin

      // Success = TRUE if the read/write operation was successfull

     // WriteOperation = TRUE if the client SENT a file to the server

     Try
 

        If Assigned(AStream) then FreeAndNil(AStream);

     Except

     End;

end;
 

procedure TForm1.IdTrivialFTPServer1WriteFile(Sender: TObject;

  var FileName: String; const PeerInfo: TPeerInfo;

  var GrantAccess: Boolean; var AStream: TStream;

  var FreeStreamOnComplete: Boolean);

Var

   FS : TFileStream;

begin

     Try

        { Convert UNIX style filenames to WINDOWS style }

        While Pos('/',Filename)<>0 do Filename[Pos('/',Filename)] := '\';

        { Assure that the filename DOES NOT CONTAIN any path information }

        Filename := ExtractFileName( Filename );

        { Open file in WRITE ONLY mode }

        FS := TFileStream.Create( TFTPPath+Filename,

                                  fmCreate OR fmShareExclusive );

        { Copy all the data }

        AStream := FS;

        { Set parameters }

        FreeStreamOnComplete := True;

        GrantAccess := True;

     Except

        { On errors, deny access }

        GrantAccess := False;

        If Assigned(FS) then FreeAndNil( FS );

     End;

end;
 
 
 

procedure TForm1.IdUDPClient1Connected(Sender: TObject);

begin
 

end;
 

// Example of how to DOWNLOAD a file from the server

procedure TForm1.Button1Click(Sender: TObject);

Var

   ST : TMemoryStream;

begin

     ST := TMemoryStream.Create;

     IdTrivialFTP1.Get('testfile.dat',ST);

     If Assigned(ST) then

     begin

          ShowMessage('Filesize='+IntToStr(ST.Size));

          FreeAndNil(ST);

     end;

end;
 

// Example of how to UPLOAD a file to the server

procedure TForm1.Button2Click(Sender: TObject);

Var

   ST : TMemoryStream;

   I  : Integer;

   S  : String;

begin

     { Create stream }

     ST := TMemoryStream.Create;

     { Initialize data }

     S := 'This is a test file. It whould appear in the '+

          'TFTP Server''s upload directory.'+#13#10;

     { Store in stream }

     ST.Write( S[1], Length(S) );

     ST.Position := 0;

     { Send Stream to TFTP Server }

     IdTrivialFTP1.Put(ST,'textfile.txt');

     { Free Stream }

     If Assigned(ST) then FreeAndNil(ST);

     { Show a dialog }

     ShowMessage('Done!');

end;
 

end. 

Open in new window

0
 
LVL 28

Expert Comment

by:ciuly
Comment Utility
you can ignore the range check error (or configure your compiler not to mess with it)

unfortunatly I have to leave, but will be back in a few hours and if noone fixes your problem until then, I'll look into it.

btw, the connection reset by peer means just that: that eitehr your client discnnected or that the server end has disconnected.

bbl
0
 

Author Comment

by:Urumov
Comment Utility
Ok, i will try it
Thank You
0
 
LVL 28

Expert Comment

by:ciuly
Comment Utility
there seems to be some bug in indy

go in idtrivialftp.pas, line 272 in latest indy 10.

looe for the line
        CurrentDataBlk := WordToStr(GStack.HostToNetwork(Word(TFTP_DATA))) + WordToStr(GStack.HostToNetwork(BlockCtr));

and make it look like

        CurrentDataBlk := WordToStr(GStack.HostToNetwork(Word(TFTP_DATA))) + WordToStr(GStack.HostToNetwork(word(BlockCtr)));

notice the word explicit type conversion of BlockCtr

this fixes the range check error. (I thought you got a compiler warnign :D )

then, on line 274 uncomment the line

        SourceStream.ReadBuffer(CurrentDataBlk[hdrsize+1], DataLen);

and that should do it. the example at least, clicking on button2, will upload that text from the memory stream)
0
 

Author Comment

by:Urumov
Comment Utility
Hello, me next question may be stupid :) but after change idtrivialftp.pas must I reinstall/recompile Indy 10 suite?
...btw i do this changes. And now "range check" error is gone. But I have still problem with them.
It is the same problem as in my totaly first question - TIME OUT.
if I try it with XP native TFTP (tftp -i 192.168.1.11 PUT  c:\test.txt test.txt) everything working well.
Firewall and this things is turned off.
I was made packet analyze by Ethereal, and there are some diferences in packet size. I mean difrences between standard Win TFTP  and Indy TFTP client.

How its your test result? Everything works well?
0
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 
LVL 28

Accepted Solution

by:
ciuly earned 500 total points
Comment Utility
>> must I reinstall/recompile Indy 10 suite?

only recompile the protocols package.

>> How its your test result? Everything works well?

yes.

attached is my button 1 click

I'm on winxp sp1. no firewall.

could be a connection issue. is your windows firewall running? if so ... that could be the problem.
procedure TForm1.Button2Click(Sender: TObject);

Var 

{   ST : TMemoryStream;

   S  : String;}

   f:tfilestream;

begin

  f:=tfilestream.create('c:\test.bmp', fmopenread);

     IdTrivialFTP1.Put(f,'test_up.bmp');

  freeandnil(f);
 

(*     { Create stream }

     ST := TMemoryStream.Create;

     { Initialize data }

     S := 'This is a test file. It whould appear in the '+

          'TFTP Server''s upload directory.'+#13#10;

     { Store in stream }

     ST.Write( S[1], Length(S) );

     ST.Position := 0;

     { Send Stream to TFTP Server }

     IdTrivialFTP1.Put(ST,'test.txt');

     { Free Stream }

     If Assigned(ST) then FreeAndNil(ST);(**)

     { Show a dialog }

     ShowMessage('Done!');

end; 

Open in new window

0
 

Author Comment

by:Urumov
Comment Utility
I am no network beginner ;)
Windows firewall is turned off. I say, if i use command "TFTP" in win xp command promt its OK.
0
 

Author Comment

by:Urumov
Comment Utility
and actually your code working :)
0
 
LVL 28

Expert Comment

by:ciuly
Comment Utility
>> I am no network beginner ;)

most people are, so it doesn't hurt asking :P

>> and actually your code working :)

finally :)
0
 

Author Comment

by:Urumov
Comment Utility
>> I am no network beginner ;)
>>most people are, so it doesn't hurt asking :P
   You have right:)

May I ask?
Where was the problem?
0
 

Author Closing Comment

by:Urumov
Comment Utility
Great thanks for help!!
Hail to You!
0
 
LVL 28

Expert Comment

by:ciuly
Comment Utility
well, I said above: it's an indy bug. actually 2 bugs. both are mentioned above. I'[m not sure why the bugs are there, probably poor testing.
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Suggested Solutions

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now