unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls,
Buttons, ExtCtrls, CodyCtrls, IdTCPClient, IdFTP, IdFTPCommon;
type
{ TForm1 }
TForm1 = class(TForm)
IdFTP1: TIdFTP;
IdTCPClient1: TIdTCPClient;
LbDirectory: TListBox;
SaveFile: TSaveDialog;
procedure ConnettiServerFTP;
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure Download_FTP(NomeFile: string);
procedure ListafileFTP;
private
public
end;
var
Form1: TForm1;
mDir: string = '/public_html/gescomp/download/' ;
sRootDirFTP : string;
implementation
{$R *.lfm}
procedure TForm1.ConnettiServerFTP;
var sMesg: string;
bEsito: Boolean;
FLastDirStack : TStringList;
tempStream: TFileStream;
IdFTP: TIdFtp;
begin
sMesg := 'L''aggiornamento non è andato a buon fine, riprova più tardi..';
//Test Client su Server
bEsito := False;
idTCPClient1.Host := 'ftp.xxxxxxxx.xx';
idTCPClient1.Port := 21; //porta per comuicare con il server FTP
//un test per verificare se il servizio Host risponde
try
idTCPClient1.Connect;
try
IdTCPClient1.IOHandler.WriteLn('Client message');
//Self.Caption := IdTCPClient1.IOHandler.ReadLn;
finally
IdTCPClient1.Disconnect;
bEsito := True;
end;
except
ShowMessage(sMesg);
IdTCPClient1.Disconnect;
end;
//se il server ha risposto possiamo procedere
if bEsito then
begin
IdFTP1.Host := 'ftp.xxxxxxxx.xx';
IdFTP1.Port := 21;
try
//utilizzate il vostro account per accedere al server FTP
IdFTP1.Username := 'xxxxxxxxxx';
IdFTP1.Password := 'xxxxxxxxxx';
//per utilizzare la modalita ftBinary dovete aggiungere
//nelle uses la unit IdFTPCommon
IdFTP1.TransferType := ftBinary;
if IdFTP1.Connected then IdFTP1.Disconnect;
IdFTP1.Connect;
IdFtp1.Passive:= true;
IdFtp1.ChangeDir(mDir);
FLastDirStack := TStringList.Create;
FLastDirStack.Clear;
sRootDirFTP := IdFTP1.RetrieveCurrentDir; //memorizziamo la directory radice
IdFTP1.List;
//DisplayFTP;
ListafileFTP;
except
ShowMessage(sMesg);
IdFTP1.Disconnect;
end;
end;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
ConnettiServerFTP;
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
IdTCPClient1.Disconnect;
end;
procedure TForm1.ListafileFTP;
var i, c : Integer;
s : String;
Lista: TStringList;
begin
Lista := TStringList.Create;
IdFTP1.List(Lista ,'',false);
//DMPcopia.ZDati.GetTableNames('', Lista);
For c:= 0 to Lista.Count-1 do
begin
s := lista[c];
i := IdFTP1.Size(s);
if s='Aggiorna_Gescomp.exe' then
if MessageDlg('c''è un aggiornamento, vuoi scaricarlo?', mtConfirmation, mbYesNo, 0) = mrYes then
Download_FTP(s) else IdTCPClient1.Disconnect;
end;
Lista.Free;
end;
procedure TForm1.Download_FTP(NomeFile: string);
var i, iDimFile : Integer;
ext, s : String;
b : boolean;
begin
Screen.Cursor := crHourGlass;
i := lbDirectory.ItemIndex;
s := nomefile;
i := IdFTP1.Size(s);
// File
ext := ExtractFileExt(s);
SaveFile.Filter := ext + ' files|*' + ext + '|All Files|*.*';
SaveFile.FileName := s;
if SaveFile.Execute then
begin
b := true;
if FileExists(SaveFile.FileName) then
if MessageDlg('File già presente : sovrascrivere ?', mtWarning, [mbYes,mbNo], 0) = mrYes then
DeleteFile(SaveFile.FileName);
IdFTP1.TransferType := ftBinary;
if b then
IdFTP1.Get(s, SaveFile.FileName, True, IdFTP1.ResumeSupported);
end;
Screen.Cursor := crDefault;
IdTCPClient1.Disconnect;
end;
end.