io Programmo 53/IOPROG_53.ISO/soft/c++/xceedftp.exe/Samples/Delphi/MethodDemo/Main.pas

Pascal/Delphi Source File | 2000-10-05 | 25.3 KB | 601 lines

unit Main;
{ ----------------------------------------------------------------- }
{ Xceed FTP Library - Method Demonstrator sample application        }
{ Copyright (c) 2000 Xceed Software Inc.                            }
{                                                                   }
{ [frmXceedFTP.pas]                                                 }
{                                                                   }
{  This unit contains all the code for the Method Demonstrator      }
{  sample application                                               }
{                                                                   }
{  This file is part of the Xceed FTP Library samples applications. }
{  The source code in this file is only intended as a supplement    }
{  to Xceed FTP Library's documentation, and is provided "as is",   }
{  without warranty of any kind, either expressed or implied.       }
{ ----------------------------------------------------------------- }

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtrls, ComCtrls, StdCtrls, checklst, XceedFtpLib_TLB;

const
  { Property hints }
  cServerAddress = 'ServerAddress property:' + #13#10 +
                   'Use this property to specify the address of the FTP' + #13#10 +
                   'server to connect to. The address you specify can be either' + #13#10 +
                   'a host name (ex: ftp.cdrom.com) or an IP address' + #13#10 +
                   'in dot-notation (ex: 192.168.0.1). WINS computer names also work.';

  cServerPort = 'ServerPort property:' + #13#10 +
                'This property allows you to specify the port number of the FTP' + #13#10 +
                'server to connect to.';

  cUsername = 'Username property:' + #13#10 +
              'Use this property to specify the user to log in when connecting' + #13#10 +
              'to the FTP server.';

  cPassword = 'Password property:' + #13#10 +
              'This property allows you to specify the password to use to log in' + #13#10 +
              'to the FTP server if the user being logged in requires a password.' + #13#10 +
              'If an invalid password is entered, the PasswordRequired event will be' + #13#10 +
              'triggered.';

  cConnect = 'Connect method:' + #13#10 +
             'Establishes a connection to an FTP server.' + #13#10 +
             'The FTP server to connect to must be specified by setting the' + #13#10 +
             'ServerAddress property. Please see the "applicable properties"' + #13#10 +
             'section below to find out which other properties are referred to' + #13#10 +
             'by this method.';

  cDisconnect = 'Disconnect method:' + #13#10 +
                'Terminates the connection with the FTP server.' + #13#10 +
                'If a file transfer is currently underway, it will be' + #13#10 +
                'aborted before disconnecting.';

  cListRemoteFolder = 'sFolderMask parameter of the ListFolderContents or' + #13#10 +
                      'GetFolderContents method:' + #13#10 +
                      'The remote folder that both methods will retreive the' + #13#10 +
                      'contents of.';

  cPassiveMode = 'PassiveMode property:' + #13#10 +
                 'This property affects the way the data connection is initiated.' + #13#10 +
                 'False means that the client (the Xceed FTP Library) will listen for a data connection from the FTP server.' + #13#10 +
                 'True (the default value) means that the library will initiate the data connection to the FTP server.';

  cListFolderContents = 'ListFolderContents method:' + #13#10 +
                        'Retrieves the listing of a folder''s contents via the ListingFolderItem' + #13#10 +
                        'event.';

  cGetFolderContents = 'GetFolderContents method:' + #13#10 +
                       'Retrieves a listing of a folder''s contents in the form of an' + #13#10 +
                       'XceedFtpFolderItems collection object. You must specify the type of object you' + #13#10 +
                       'want to receive from this method with the eFormat parameter.';

  cLocalFilename = 'The sLocalFilename parameter of both the SendFile and ReceiveFile methods:' + #13#10 +
                   'the full path and filename of the local file.';

  cRemoteFilename = 'The sRemoteFilename parameter of both the SendFile and the' + #13#10 +
                    'ReceiveFile methods:' + #13#10 +
                    'In the case of the SendFile method, it is the name of the file as it' + #13#10 +
                    'should be sent to the FTP server. In the case of the ReceiveFile' + #13#10 +
                    'method, it is the name of the file to receive.';

  cAllocateStorage = 'AllocateStorage property :' + #13#10 +
                     'This property allows you to inform the library that the FTP' + #13#10 +
                     'server requires the library to reserve enough space on the' + #13#10 +
                     'server side before sending any files.';

  cAppend = 'bAppend parameter of the SendFile method:' + #13#10 +
            'Set to True if you want to append to the remote file if it already exists.' + #13#10 +
            'Set to False if you want to overwrite the remote file if it already exists';

  cRepType = 'RepresentationType property:' + #13#10 +
             'This property allows you to specify the format of the' + #13#10 +
             'data to send or receive (ASCII or binary).';

  cSendFile = 'SendFile method:' + #13#10 +
              'Send a local file to the FTP server.';

  cReceiveFile = 'ReceiveFile method:' + #13#10 +
                 'Receive a file from the FTP server.';

  cRemoteFilenameModification = 'sFilename parameter of both the DeleteFile and RenameFile methods:' + #13#10 +
                                'In the case of the DeleteFile method, it specifies the file that will' + #13#10 +
                                'be deleted from the FTP server. In the case of the RenameFile method,' + #13#10 +
                                'it specifies the name of the remote file that will be modified.';

  cRemoteFolderNameModification = 'The sNewFolder parameter of the CreateFolder method or the sFolder parameter of the RemoveFolder method:' + #13#10 +
                                  'In the case of the CreateFolder method, the sNewFolder parameter specifies the name of the new folder' + #13#10 +
                                  'that will be created in the Ftp server. In the case of the RemoveFolder method, it is the name of the' + #13#10 +
                                  'folder that will be removed/deleted from the server.';

  cNewName = 'sNewName parameter of the RenameFile method:' + #13#10 +
             'The new filename.';

  cDeleteFile = 'DeleteFile method:' + #13#10 +
                'Deletes a file on the FTP server.';

  cRenameFile = 'RenameFile method:' + #13#10 +
                'renames a file on the FTP server.';

  cCreateFolder = 'CreateFolder method:' + #13#10 +
                  'Creates a folder on the remote server.';

  cRemoveFolder = 'RemoveFolder method:' + #13#10 +
                  'Removes (deletes) a folder from the FTP server.';

type
  TfrmMain = class(TForm)
    Label1                    : TLabel;
    shtList                   : TTabSheet;
    shtConnect                : TTabSheet;
    shtSendReceive            : TTabSheet;
    shtItemHandling           : TTabSheet;
    tabExamples               : TPageControl;
    Label3                    : TLabel;
    Label4                    : TLabel;
    Label5                    : TLabel;
    Label6                    : TLabel;
    btConnect                 : TButton;
    StatusBar1                : TStatusBar;
    Label7                    : TLabel;
    Label9                    : TLabel;
    txtRemoteFolder           : TEdit;
    chkPassiveMode            : TCheckBox;
    btListFolderContents      : TButton;
    Label17                   : TLabel;
    txtLocalFilename          : TEdit;
    Label20                   : TLabel;
    txtRemoteFilename         : TEdit;
    btSendFile                : TButton;
    Label23                   : TLabel;
    txtRemoteFilenameModif    : TEdit;
    Label24                   : TLabel;
    txtRemoteFolderNameModif  : TEdit;
    btDeleteFile              : TButton;
    barFile                   : TProgressBar;
    barGlobal                 : TProgressBar;
    txtUsername               : TEdit;
    txtServerAddress          : TEdit;
    txtServerPort             : TEdit;
    txtPassword               : TEdit;
    btDisconnect              : TButton;
    btGetFolderContents       : TButton;
    btReceiveFile             : TButton;
    chkAllocateStorage        : TCheckBox;
    chkAppend                 : TCheckBox;
    chkPassiveMode2           : TCheckBox;
    grpRepType                : TGroupBox;
    optAscii                  : TRadioButton;
    optBinary                 : TRadioButton;
    Label2                    : TLabel;
    txtNewName                : TEdit;
    btRenameFile              : TButton;
    btCreateFolder            : TButton;
    btRemoveFolder            : TButton;
    xFtp: TXceedFtp;
    lblConnectionInfo: TLabel;
    lstLogAndErrors: TListBox;
    Label8: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    lstFolderListing: TListView;
    lblSendReceiveInfo: TLabel;
    Label14: TLabel;

    procedure FormCreate(Sender: TObject);
    procedure btConnectClick(Sender: TObject);
    procedure btListFolderContentsClick(Sender: TObject);
    procedure btSendFileClick(Sender: TObject);
    procedure btDeleteFileClick(Sender: TObject);
    procedure xFtpListingFolderItem(Sender: TObject;
      const sName: WideString; dtDate: TDateTime; lFileSize: Integer;
      eItemType: TOleEnum; const sUserData: WideString);
    procedure btDisconnectClick(Sender: TObject);
    procedure btGetFolderContentsClick(Sender: TObject);
    procedure btReceiveFileClick(Sender: TObject);
    procedure btRenameFileClick(Sender: TObject);
    procedure btCreateFolderClick(Sender: TObject);
    procedure btRemoveFolderClick(Sender: TObject);
    procedure xFtpFileTransferStatus(Sender: TObject; const sLocalFilename,
      sRemoteFilename: WideString; lFileSize, lBytesTransferred: Integer;
      nBytesPercent: Smallint; lTotalSize, lTotalBytesTransferred: Integer;
      nTotalBytesPercent: Smallint; lTotalFiles,
      lTotalFilesTransferred: Integer; nTotalFilesPercent: Smallint;
      lBytesPerSecond, lTotalBytesPerSecond: Integer);
    procedure xFtpReceivingFile(Sender: TObject;
      const sRemoteFilename: WideString; var sLocalFilename: WideString;
      lFileSize: Integer);
    procedure xFtpSendingFile(Sender: TObject;
      const sLocalFilename: WideString; var sRemoteFilename: WideString;
      lFileSize: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure xFtpDisconnected(Sender: TObject);
    procedure xFtpSkippingFile(Sender: TObject; const sLocalFilename,
      sRemoteFilename: WideString; lSkippingReason: Integer);
    procedure xFtpLoggingCommandLine(Sender: TObject;
      const sLine: WideString; eCommandType: TOleEnum);
  private
    { Private declarations }
    procedure UpdateFieldHints;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.DFM}

{-----------------------------------------------------------------------------}
{ Update hints with linefeeds for better output                               }
{-----------------------------------------------------------------------------}

procedure TfrmMain.UpdateFieldHints;
begin
  txtServerAddress.Hint := cServerAddress;
  txtServerPort.Hint    := cServerPort;
  txtUsername.Hint      := cUsername;
  txtPassword.Hint      := cPassword;
  btConnect.Hint        := cConnect;
  btDisconnect.Hint     := cDisconnect;

  txtRemoteFolder.Hint      := cListRemoteFolder;
  chkPassiveMode.Hint       := cPassiveMode;
  btListFolderContents.Hint := cListFolderContents;
  btGetFolderContents.Hint  := cGetFolderContents;

  txtLocalFilename.Hint   := cLocalFilename;
  txtRemoteFilename.Hint  := cRemoteFilename;
  chkAllocateStorage.Hint := cAllocateStorage;
  chkAppend.Hint          := cAppend;
  chkPassiveMode2.Hint    := cPassiveMode;
  grpRepType.Hint         := cRepType;
  btSendFile.Hint         := cSendFile;
  btReceiveFile.Hint      := cReceiveFile;

  txtRemoteFilenameModif.Hint   := cRemoteFilenameModification;
  txtRemoteFolderNameModif.Hint := cRemoteFolderNameModification;
  txtNewName.Hint               := cNewName;
  btDeleteFile.Hint             := cDeleteFile;
  btRenameFile.Hint             := cRenameFile;
  btCreateFolder.Hint           := cCreateFolder;
  btRemoveFolder.Hint           := cRemoveFolder;
end;

{-----------------------------------------------------------------------------}
{ We update hints for better look. We can't put linefeeds in property editor! }
{-----------------------------------------------------------------------------}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  UpdateFieldHints;
end;

{-----------------------------------------------------------------------------}
{ Connect to the FTP server                                                   }
{-----------------------------------------------------------------------------}

procedure TfrmMain.btConnectClick(Sender: TObject);
begin

  { Copy values from the form's fields into the XceedFtp object's properties }

  xFtp.ServerAddress := txtServerAddress.Text;
  xFtp.ServerPort := StrToInt( txtServerPort.Text );
  xFtp.UserName := txtUsername.Text;
  xFtp.Password := txtPassword.Text;

  { Now run the Connect method }

  try
    xFtp.Connect();
    lblConnectionInfo.Caption := 'Status: Connected to ' + xFtp.ServerAddress;
  except
    on xErr: Exception do
      lstLogAndErrors.Items.Add( 'ERROR: ' + xErr.Message );
  end;
end;

{-----------------------------------------------------------------------------}
{ The ListFolderContents method will trigger the ListingFolderItem event for  }
{ each item being listed                                                      }
{-----------------------------------------------------------------------------}

procedure TfrmMain.btListFolderContentsClick(Sender: TObject);
begin
  lstFolderListing.Items.Clear();
  try
    xFtp.PassiveMode := chkPassiveMode.Checked;
    xFtp.ListFolderContents( txtRemoteFolder.Text );
  except
    on xErr: Exception do
      lstLogAndErrors.Items.Add( 'ERROR: ' + xErr.Message );
  end;
end;

{-----------------------------------------------------------------------------}
{ Send a file to the FTP server                                               }
{-----------------------------------------------------------------------------}

procedure TfrmMain.btSendFileClick(Sender: TObject);
begin
  try
    { Copy values from the form's fields into the XceedFtp object's properties }

    xFtp.AllocateStorage := chkAllocateStorage.Checked;
    xFtp.PassiveMode := chkPassiveMode2.Checked;

    if optAscii.Checked then xFtp.RepresentationType := frtASCII;
    if optBinary.Checked then xFtp.RepresentationType := frtBinary;

    { Run the SendFile method }

    xFtp.SendFile(txtLocalFilename.Text, 0, txtRemoteFilename.Text, chkAppend.Checked);
    lblSendReceiveInfo.Caption := '';
  except
    on xErr: Exception do
      lstLogAndErrors.Items.Add( 'ERROR: ' + xErr.Message );
  end;
end;

{-----------------------------------------------------------------------------}
{ Delete a file from the FTP server                                           }
{-----------------------------------------------------------------------------}

procedure TfrmMain.btDeleteFileClick(Sender: TObject);
begin
  try
    xFtp.DeleteFile(txtRemoteFilenameModif.Text);
  except
    on xErr:Exception do
      lstLogAndErrors.Items.Add( 'ERROR: ' + xErr.Message );
  end;
end;

{-----------------------------------------------------------------------------}
{ The ListingFolderItem event will be triggered by the Xceed FTP Library for  }
{ each item that is being listed as a result of calling the                   }
{ ListFolderContents method                                                   }
{-----------------------------------------------------------------------------}

procedure TfrmMain.xFtpListingFolderItem(Sender: TObject;
  const sName: WideString; dtDate: TDateTime; lFileSize: Integer;
  eItemType: TOleEnum; const sUserData: WideString);
var
  xItem : TListItem;
begin
  xItem := lstFolderListing.Items.Add;

  xItem.Caption := sName;
  case eItemType of
    fitFile   : xItem.SubItems.Add('File');
    fitFolder : xItem.SubItems.Add('Dir');
    fitLink   : xItem.SubItems.Add('Link');
  end;
end;

{-----------------------------------------------------------------------------}
{ Disconnect from FTP server. Requires no proerties to be set.                }
{-----------------------------------------------------------------------------}

procedure TfrmMain.btDisconnectClick(Sender: TObject);
begin
  try
    xFtp.Disconnect();
    { The Disconnected event will be triggered, and in that event
      we will update the lblConnectionInfo.Caption to show it }
  except
    on xErr: Exception do
      lstLogAndErrors.Items.Add( 'ERROR: ' + xErr.Message );
  end;
end;

{-----------------------------------------------------------------------------}
{ The GetFolderContents method retrieves an XceedFtpFolderItems collection    }
{ containing information on each item in a remote folder. It does the same    }
{ thing as the ListFolderContents method, but does not trigger any events.    }
{-----------------------------------------------------------------------------}

procedure TfrmMain.btGetFolderContentsClick(Sender: TObject);
var
  iFolderItems  : IXceedFtpFolderItems;
  iItem         : IXceedFtpFolderItem;
  nItemIndex    : integer;
  vaIndex       : OleVariant;
  xListItem     : TListItem;
begin
    lstFolderListing.Items.Clear();
  try
    xFtp.PassiveMode := chkPassiveMode.Checked;
    iFolderItems := xFtp.GetFolderContents( txtRemoteFolder.Text, fcfCollection ) As IXceedFtpFolderItems;
    nItemIndex := 1;

    while nItemIndex <= iFolderItems.Count do
    begin
      vaIndex := nItemIndex;
      iItem := iFolderItems.Item[ vaIndex ];

      xListItem := lstFolderListing.Items.Add;

      xListItem.Caption := iItem.ItemName;
      case iItem.ItemType of
        fitFile   : xListItem.SubItems.Add('File');
        fitFolder : xListItem.SubItems.Add('Dir');
        fitLink   : xListItem.SubItems.Add('Link');
      end;
      nItemIndex := nItemIndex + 1;
    end;
  except
    on xErr: Exception do
      lstLogAndErrors.Items.Add( 'ERROR: ' + xErr.Message );
  end;
end;

{-----------------------------------------------------------------------------}
{ The ReceiveFile method will transfer a file from the FTP server to our      }
{ selected location. We can also rename the file or change its location.      }
{-----------------------------------------------------------------------------}

procedure TfrmMain.btReceiveFileClick(Sender: TObject);
begin
  try

    { Copy values from the form's fields into the XceedFtp object's properties }

    xFtp.PassiveMode := chkPassiveMode2.Checked;

    { Run the ReceiveFile method }

    xFtp.ReceiveFile(txtRemoteFilename.Text, 0, txtLocalFilename.Text);
    lblSendReceiveInfo.Caption := '';
  except
    on xErr:Exception do
      lstLogAndErrors.Items.Add( 'ERROR: ' + xErr.Message );
  end;
end;

{-----------------------------------------------------------------------------}
{ Rename a file on the FTP server                                             }
{-----------------------------------------------------------------------------}

procedure TfrmMain.btRenameFileClick(Sender: TObject);
begin
  try
    xFtp.RenameFile(txtRemoteFilenameModif.Text, txtNewName.Text);
  except
    on xErr: Exception do
      lstLogAndErrors.Items.Add( 'ERROR: ' + xErr.Message );
  end;
end;

{-----------------------------------------------------------------------------}
{ Create a new remote folder                                                  }
{-----------------------------------------------------------------------------}

procedure TfrmMain.btCreateFolderClick(Sender: TObject);
begin
  try
    xFtp.CreateFolder(txtRemoteFolderNameModif.Text);
  except
    on xErr: Exception do
      lstLogAndErrors.Items.Add( 'ERROR: ' + xErr.Message );
  end;
end;

{-----------------------------------------------------------------------------}
{ Remove a folder from the FTP server                                         }
{-----------------------------------------------------------------------------}

procedure TfrmMain.btRemoveFolderClick(Sender: TObject);
begin
  try
    xFtp.RemoveFolder(txtRemoteFolderNameModif.Text);
  except
    on xErr: Exception do
      lstLogAndErrors.Items.Add( 'ERROR: ' + xErr.Message );
  end;
end;

{-----------------------------------------------------------------------------}
{ The FileTransferStatus event provides statistics on the current transfer    }
{ operation                                                                   }
{-----------------------------------------------------------------------------}

procedure TfrmMain.xFtpFileTransferStatus(Sender: TObject;
  const sLocalFilename, sRemoteFilename: WideString; lFileSize,
  lBytesTransferred: Integer; nBytesPercent: Smallint; lTotalSize,
  lTotalBytesTransferred: Integer; nTotalBytesPercent: Smallint;
  lTotalFiles, lTotalFilesTransferred: Integer;
  nTotalFilesPercent: Smallint; lBytesPerSecond,
  lTotalBytesPerSecond: Integer);
begin
  barFile.Position := nBytesPercent;
  barGlobal.Position := nTotalBytesPercent;
end;

{-----------------------------------------------------------------------------}
{ The ReceivingFile event informs our application that we are about to start  }
{ receiving data for a specific file. We can change the location and filename }
{ where the file will be received to by changing the sLocalFilename parameter }
{-----------------------------------------------------------------------------}

procedure TfrmMain.xFtpReceivingFile(Sender: TObject;
  const sRemoteFilename: WideString; var sLocalFilename: WideString;
  lFileSize: Integer);
begin
  lstLogAndErrors.Items.Add('EVENT: ReceivingFile');
  lblSendReceiveInfo.Caption := 'Receiving ' + sRemoteFilename;
end;

{-----------------------------------------------------------------------------}
{ The SendingFile event informs our application that we are about to send a   }
{ file to the FTP server. During this event we can change the location and    }
{ filename where the file will be uploaded to by changing the                 }
{ sRemoteFilename parameter                                                   }
{-----------------------------------------------------------------------------}

procedure TfrmMain.xFtpSendingFile(Sender: TObject;
  const sLocalFilename: WideString; var sRemoteFilename: WideString;
  lFileSize: Integer);
begin
  lstLogAndErrors.Items.Add('EVENT: SendingFile');
  lblSendReceiveInfo.Caption := 'Sending ' + sLocalFilename;
end;

{ --------------------------------------------------------------------------- }
{ If form is closed, make sure we disconnect!
{ --------------------------------------------------------------------------- }

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  if xFtp.CurrentState <> fstNotConnected then
    xFtp.Disconnect();
end;

{ --------------------------------------------------------------------------- }
{ The Disconnected event is triggered when the library disconnects, or        }
{ gets disconnected from the FTP server                                       }
{ --------------------------------------------------------------------------- }

procedure TfrmMain.xFtpDisconnected(Sender: TObject);
begin
  lstLogAndErrors.Items.Add('EVENT: Disconnected');
  lblConnectionInfo.Caption := 'Status: Not connected';
  lstFolderListing.Items.Clear;
end;

{ --------------------------------------------------------------------------- }
{ The SkippingFile event is triggered each time a file about to be sent       }
{ or received is skipped for any reason                                       }
{ --------------------------------------------------------------------------- }

procedure TfrmMain.xFtpSkippingFile(Sender: TObject; const sLocalFilename,
  sRemoteFilename: WideString; lSkippingReason: Integer);
begin
  if sLocalFilename <> '' then
    lstLogAndErrors.Items.Add('EVENT: SkippingFile (File: '+ sLocalFilename +')')
  else
    lstLogAndErrors.Items.Add('EVENT: SkippingFile (File: '+ sRemoteFilename +')')
end;

{ --------------------------------------------------------------------------- }
{ The LoggingCommandLine event is triggered whenever log information is       }
{ being provided by the Xceed FTP Library. You can use it for debugging.      }
{ --------------------------------------------------------------------------- }

procedure TfrmMain.xFtpLoggingCommandLine(Sender: TObject;
  const sLine: WideString; eCommandType: TOleEnum);
begin
  lstLogAndErrors.Items.Add('LOG: ' + sLine)
end;

end.