frmmain.pas

一些关于电子邮件SMTP`POP3 MIME`的源码·个人感觉还不错

unit FrmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls,  Buttons, ActnList,
  ImgList, Menus, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdFTP,IdFTPList, FileCtrl;

type
  TFMain = class(TForm)
    GroupBox1: TGroupBox;
    EditFTPAddr: TLabeledEdit;
    EditPortNum: TLabeledEdit;
    EditUserName: TLabeledEdit;
    EditPassWord: TLabeledEdit;
    MemoMsg: TMemo;
    QueueList: TListView;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    ActionList1: TActionList;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Splitter3: TSplitter;
    Panel1: TPanel;
    Panel2: TPanel;
    RemoteFileList: TListView;
    ComboHistory: TComboBox;
    ImageList1: TImageList;
    PopLocal: TPopupMenu;
    PopRemote: TPopupMenu;
    SiteManage: TAction;
    QuickConnect: TAction;
    ReConnect: TAction;
    DisConnect: TAction;
    ViewIcon: TAction;
    ViewSmallIcon: TAction;
    ViewList: TAction;
    ViewReport: TAction;
    General: TAction;
    Advanced: TAction;
    Upload: TAction;
    DownLoad: TAction;
    QueueAdd: TAction;
    QueueDel: TAction;
    QueueDelAll: TAction;
    ResetStatus: TAction;
    QueueSave: TAction;
    QueueLoad: TAction;
    QueueMoveTop: TAction;
    QueueMoveBotton: TAction;
    QueueMoveUP: TAction;
    QueueMoveDown: TAction;
    ToggleLocal: TAction;
    ToggleRemote: TAction;
    ToggleLog: TAction;
    ToggleQueue: TAction;
    CopyToClipBoard: TAction;
    HelpAbout: TAction;
    HelpHelp: TAction;
    WriteToMe: TAction;
    Registe: TAction;
    LocalMakeDir: TAction;
    LocalDel: TAction;
    Quit: TAction;
    N62: TMenuItem;
    N63: TMenuItem;
    N64: TMenuItem;
    N67: TMenuItem;
    shu1: TMenuItem;
    N68: TMenuItem;
    N69: TMenuItem;
    N70: TMenuItem;
    N71: TMenuItem;
    N85: TMenuItem;
    RemoteChangeDir: TAction;
    RemoteNewDir: TAction;
    RemoteDel: TAction;
    RemoteRename: TAction;
    RemoteUpDir: TAction;
    LocalDirUp: TAction;
    FTPClient: TIdFTP;
    N86: TMenuItem;
    N87: TMenuItem;
    N88: TMenuItem;
    N89: TMenuItem;
    N92: TMenuItem;
    N93: TMenuItem;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    LocalFileList: TListView;
    DriveComboBox1: TDriveComboBox;
    LocalChangeDir: TAction;
    procedure QuickConnectExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RemoteChangeDirExecute(Sender: TObject);
    procedure RemoteFileListDblClick(Sender: TObject);
    procedure RemoteUpDirExecute(Sender: TObject);
    procedure DownLoadExecute(Sender: TObject);
    procedure UploadExecute(Sender: TObject);
    procedure LocalDirUpExecute(Sender: TObject);
    procedure LocalMakeDirExecute(Sender: TObject);
    procedure RemoteDelExecute(Sender: TObject);
    procedure RemoteNewDirExecute(Sender: TObject);
    procedure LocalChangeDirExecute(Sender: TObject);
    procedure LocalFileListContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure RemoteFileListContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure DriveComboBox1Change(Sender: TObject);
    procedure LocalFileListDblClick(Sender: TObject);
    procedure ViewIconExecute(Sender: TObject);
    procedure ViewSmallIconExecute(Sender: TObject);
    procedure ViewListExecute(Sender: TObject);
    procedure ViewReportExecute(Sender: TObject);
  private
    { Private declarations }
    IsTransParent : Boolean;
    LocalPath : String;
  public
    { Public declarations }
  end;

var
  FMain: TFMain;

implementation

{$R *.dfm}

procedure TFMain.QuickConnectExecute(Sender: TObject);
begin
    //下面判断是否已经建立连接
    if FTPClient.Connected then
    begin
      if MessageDlg('是否中止当前连接及下载过程？', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
      begin
        try
          if IsTransParent then
             FTPClient.Abort;
          FTPClient.Quit;
        Except
          ShowMessage('中止当前下载过程出错');
        end;
      end
      else
        exit;
    end;

    try
      FTPClient.UserName:=EditUserName.Text;
      FTPClient.Password:=EditPassWord.Text;
      FTPClient.Host:=EditFTPAddr.Text;
      FTPClient.Port:=StrToInt(EditPortNum.Text);
      FTPClient.Connect;
      DisConnect.Enabled :=true;
      MemoMsg.Lines.AddStrings(FTPClient.LoginMsg.Text);
      ComboHistory.Clear;
      ComboHistory.Items.Add('/');
      ComboHistory.ItemIndex :=0;
      RemoteChangeDirExecute(Sender);
    except
      ShowMessage('连接服务器出错');
    end;
end;

procedure TFMain.FormCreate(Sender: TObject);
begin
  IsTransParent := false;
  DisConnect.Enabled := false;
end;



procedure TFMain.RemoteChangeDirExecute(Sender: TObject);
Var
  LS: TStringList;
  FileCount : Integer;
  newItem : TListItem;
  FolderCount : Integer;
begin
  try
    LS := TStringList.Create;
    FTPClient.ChangeDir(ComboHistory.Text);
    RemoteFileList.Items.Clear;
    FTPClient.List(LS);
    FolderCount := 0;
    for FileCount:=0 to LS.Count - 1 do
    begin
      if FTPClient.DirectoryListing.Items[FileCount].ItemType = ditDirectory then
      begin
        newItem := RemoteFileList.Items.Insert(FolderCount);
        newItem.ImageIndex := 0;
        newItem.subItems.Add('文件夹');
      end
      else begin
        newItem := RemoteFileList.Items.Add;
        newItem.ImageIndex := 1;
        newItem.subItems.Add('');
      end ;
      newItem.Caption := FTPClient.DirectoryListing.Items[FileCount].FileName;
      newItem.subItems.Add(IntToStr(FTPClient.DirectoryListing.Items[FileCount].Size));
      newItem.subItems.Add(DateToStr(FTPClient.DirectoryListing.Items[FileCount].ModifiedDate));
    end;
  finally
    LS.Free;
  end;

end;

procedure TFMain.RemoteFileListDblClick(Sender: TObject);
var
  FileName : String;
begin
  if not FTPClient.Connected Then Exit;
  if RemoteFileList.Selected = nil then Exit;

  FileName := RemoteFileList.Selected.Caption;
  if RemoteFileList.Selected.SubItems[0]='文件夹' then
  begin
    if ComboHistory.ItemIndex = 0 then
       FileName := '/'+FileName
    else
       FileName := ComboHistory.Items[ComboHistory.ItemIndex]+'/'+FileName;
    if ComboHistory.Items.IndexOf(FileName) = -1 then
       ComboHistory.Items.Add(FileName);
    ComboHistory.ItemIndex := ComboHistory.Items.IndexOf(FileName);
    RemoteChangeDirExecute(Sender);
  end
  else
    if MessageDlg('是否下载该文件？', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
       DownLoadExecute(Sender);
end;

procedure TFMain.RemoteUpDirExecute(Sender: TObject);
begin
  //返回上一级目录
  if FTPClient.Connected then
  begin
    FTPClient.ChangeDirUp;
    ComboHistory.ItemIndex:= ComboHistory.Items.IndexOf(FtpClient.RetrieveCurrentDir);
    RemoteChangeDirExecute(Sender);
  end;
end;

procedure TFMain.DownLoadExecute(Sender: TObject);
var
  FileName : String;
  Item : TListItem;
  QueueItem : TListItem;
begin
  if not FTPClient.Connected Then Exit;
  if RemoteFileList.Selected = nil then Exit;
  Item := RemoteFileList.Selected;
  QueueList.Clear;
  while Item <> nil do
  begin
    QueueItem := QueueList.Items.Add;
    QueueItem.Caption := Item.Caption;
    QueueItem.SubItems.Add(LocaLPath);
    QueueItem.SubItems.Add(Item.SubItems[1]);
    QueueItem.SubItems.Add('<-');
    QueueItem.SubItems.Add('');
    QueueItem.SubItems.Add(ComboHistory.Text);
    Item:=RemoteFileList.GetNextItem(Item,sdAll, [isSelected]);
  end;
  QueueList.Refresh;

  RemoteFileList.Enabled:=false;
  ComboHistory.Enabled:=false;
  RemoteUpDir.Enabled:=false;
  IsTransParent:=True;
  try
    while QueueList.Items.Count > 0 do
    begin