Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- UNIT TesterForm;
- INTERFACE
- USES
- WinApi.Windows, System.SysUtils, System.Classes, Vcl.StdCtrls, VCL.Forms, Vcl.Controls, Vcl.Samples.Spin, Vcl.ComCtrls,
- cRichEdit, cLog, IdComponent, IdBaseComponent, IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase, IdFTP;
- TYPE
- TfrmTester = class(TForm)
- Button1: TButton;
- Log: TRichLog;
- FTP: TIdFTP;
- procedure Button1Click(Sender: TObject);
- procedure FTPDisconnected(Sender: TObject);
- procedure FTPConnected(Sender: TObject);
- procedure FTPStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
- private
- public
- end;
- VAR
- frmTester: TfrmTester;
- IMPLEMENTATION {$R *.dfm}
- {-----------------------------------------------------------------------------------------------------------------------
- DOWNLOAD PROGRESS
- -----------------------------------------------------------------------------------------------------------------------}
- procedure TfrmTester.FTPConnected(Sender: TObject);
- begin
- Log.AddInfo('Connected');
- Log.Update;
- end;
- procedure TfrmTester.FTPDisconnected(Sender: TObject);
- begin
- Log.AddHint('Disconnected');
- Log.Update;
- end;
- procedure TfrmTester.FTPStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
- begin
- Log.AddVerb(' > ' + AStatusText);
- Log.Update;
- end;
- CONST
- MyFTP = 'ftp.ncbi.nlm.nih.gov';
- usr = 'anonymous';
- psw = 'anonymous';
- FtpBlastDbDir = '/blast/db/';
- function Connect2FTP_(FTP: TIdFTP; RemoteFolder: string; Log: TRichLog): Boolean;
- begin
- Result:= FTP.Connected;
- if NOT Result then
- begin { We are already connected }
- Log.AddVerb('Connecting to '+ MyFTP);
- Log.Update; { I need this for the case when the Internet connection is slow/broken }
- FTP.Host := MyFTP;
- FTP.Username:= usr;
- FTP.Password:= psw;
- TRY
- FTP.Connect; // <-------------- 'Read time out' here
- EXCEPT
- on E: Exception DO Log.AddError(E.Message); { Don't crash. Just show error on log }
- END;
- Result:= FTP.Connected;
- if Result
- then FTP.ChangeDir(RemoteFolder) { Go to DB folder on FTP }
- else Log.AddError('Error!');
- end;
- end;
- procedure TfrmTester.Button1Click(Sender: TObject);
- VAR
- i: Integer;
- CONST
- FtpFile= 'nr.00.tar.gz.md5'; // ftp://ftp.ncbi.nlm.nih.gov/blast/db/nr.00.tar.gz.md5
- begin
- if Connect2FTP_(FTP, FtpBlastDbDir, Log) then
- for i:= 1 to 5 DO
- begin
- Connect2FTP_(FTP, FtpBlastDbDir, Log); { We try to connect before each download because the unpacking may take longer than 60 sec and the connection may get interrupted (Connection close greatfuly) }
- if FTP.Connected
- then Log.AddVerb('Still connected to FTP.')
- else Log.AddVerb('Not connected to FTP.');
- Application.ProcessMessages;
- { Download file }
- FTP.Get(FtpFile, ExtractFilePath(Application.ExeName)+ 'Downloaded.bin', TRUE, FALSE); //<--------- socket error 10038
- Log.AddVerb('Download end. Going to sleep.');
- Application.ProcessMessages;
- Sleep(62000);
- Application.ProcessMessages;
- end;
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement