ftpserv1.pas

< Delphi网络通信协议分析与应用实现>>一书的源代码。

unit FtpServ1;

interface

uses
  WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, IniFiles, FtpSrv, FtpSrvC, WSocket, StdCtrls, ExtCtrls, Menus;

const
  FtpServVersion = 101;
  WM_APPSTARTUP  = WM_USER + 1;

type
  TLogMsg = class(TComponent)
  public
     procedure Text(Prefix : Char; Msg : String);
  end;

  TFtpServerForm = class(TForm)
    FtpServer1: TFtpServer;
    InfoMemo: TMemo;
    Panel1: TPanel;
    StartMinimizedCheckBox: TCheckBox;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    MnuStartServer: TMenuItem;
    MnuStopServer: TMenuItem;
    MnuQuit: TMenuItem;
    N1: TMenuItem;
    About1: TMenuItem;
    GreenImage: TImage;
    ClientCountLabel: TLabel;
    RedImage: TImage;
    Tools1: TMenuItem;
    Cleardisplay1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FtpServer1ClientConnect(Sender: TObject;
      Client: TFtpCtrlSocket; Error: Word);
    procedure FtpServer1ClientDisconnect(Sender: TObject;
      Client: TFtpCtrlSocket; Error: Word);
    procedure FtpServer1Start(Sender: TObject);
    procedure FtpServer1Stop(Sender: TObject);
    procedure FtpServer1ClientCommand(Sender: TObject;
      Client: TFtpCtrlSocket; var Keyword, Params, Answer: TFtpString);
    procedure FtpServer1StorSessionConnected(Sender: TObject;
      Client: TFtpCtrlSocket; Data: TWSocket; Error: Word);
    procedure FtpServer1StorSessionClosed(Sender: TObject;
      Client: TFtpCtrlSocket; Data: TWSocket; Error: Word);
    procedure FtpServer1RetrDataSent(Sender: TObject;
      Client: TFtpCtrlSocket; Data: TWSocket; Error: Word);
    procedure FtpServer1RetrSessionConnected(Sender: TObject;
      Client: TFtpCtrlSocket; Data: TWSocket; Error: Word);
    procedure FtpServer1RetrSessionClosed(Sender: TObject;
      Client: TFtpCtrlSocket; Data: TWSocket; Error: Word);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FtpServer1AnswerToClient(Sender: TObject;
      Client: TFtpCtrlSocket; var Answer: TFtpString);
    procedure FtpServer1Authenticate(Sender: TObject;
      Client: TFtpCtrlSocket; UserName, Password: TFtpString;
      var Authenticated: Boolean);
    procedure FtpServer1ChangeDirectory(Sender: TObject;
      Client: TFtpCtrlSocket; Directory: TFtpString; var Allowed: Boolean);
    procedure MnuQuitClick(Sender: TObject);
    procedure MnuStopServerClick(Sender: TObject);
    procedure MnuStartServerClick(Sender: TObject);
    procedure ImagesDblClick(Sender: TObject);
    procedure FtpServer1BuildDirectory(Sender: TObject;
      Client: TFtpCtrlSocket; var Directory: TFtpString; Detailed: Boolean);
    procedure FtpServer1AlterDirectory(Sender: TObject;
      Client: TFtpCtrlSocket; var Directory: TFtpString; Detailed: Boolean);
    procedure Cleardisplay1Click(Sender: TObject);
  private
    FInitialized      : Boolean;
    FIniFileName      : String;
    FPort             : String;
    FXTop             : Integer;
    FXLeft            : Integer;
    FXWidth           : Integer;
    FXHeight          : Integer;
    procedure WMAppStartup(var msg: TMessage); message WM_APPSTARTUP;
    procedure LoadConfig;
    procedure SaveConfig;
    procedure StartServer;
    procedure StopServer;
    procedure UpdateClientCount;
  end;

var
  FtpServerForm: TFtpServerForm;
  Log          : TLogMsg;

implementation

{$R *.DFM}

const
    MainTitle         = 'FTP Server';

    { Ini file layout }
    SectionData       = 'Data';
    KeyPort           = 'Port';

    SectionWindow     = 'Window';
    KeyTop            = 'Top';
    KeyLeft           = 'Left';
    KeyWidth          = 'Width';
    KeyHeight         = 'Height';
    KeyMinim          = 'RunMinimized';

    STATUS_GREEN      = 0;
    STATUS_YELLOW     = 1;
    STATUS_RED        = 2;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TLogMsg.Text(Prefix : Char; Msg : String);
begin
end;


{显示窗口时触发}
procedure TFtpServerForm.FormShow(Sender: TObject);
var
    IniFile : TIniFile;
    Minim   : Integer;
begin
    if not FInitialized then begin
        FInitialized        := TRUE;
        Caption             := 'Starting ' + MainTitle;
        Left := -Width;

        IniFile  := TIniFile.Create(FIniFileName);
        FXTop    := IniFile.ReadInteger(SectionWindow, KeyTop,    Top);
        FXLeft   := IniFile.ReadInteger(SectionWindow, KeyLeft,   Left);
        FXWidth  := IniFile.ReadInteger(SectionWindow, KeyWidth,  Width);
        FXHeight := IniFile.ReadInteger(SectionWindow, KeyHeight, Height);
        Minim    := IniFile.ReadInteger(SectionWindow, KeyMinim,  0);

        IniFile.Free;

        LoadConfig;
        SaveConfig;    { Create the inifile keys if they don't exists }
        {调整窗口的大小}

        if FXLeft < 0 then
            FXLeft := 0;
        if FXTop < 0 then
            FXTop := 0;
        if FXWidth < 310 then
            FXWidth := 310;
        if FXHeight <= 250 then
            FXHeight := 250;
        if (FXLeft + FXWidth) > Screen.Width then
            FXLeft := Screen.Width - FXWidth;
        if (FXTop + FXHeight) > Screen.Height then
            FXTop := Screen.Height - FXHeight;

        StartMinimizedCheckBox.Checked := (Minim <> 0);
        {发送消息触发初始化函数}
        PostMessage(Handle, WM_APPSTARTUP, 0, 0);
    end;
end;


{关闭窗体触发}
procedure TFtpServerForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
var
    IniFile : TIniFile;
    Minim   : Integer;
begin
    try
        StopServer;
        Minim   := ord(StartMinimizedCheckBox.Checked);
        IniFile := TIniFile.Create(FIniFileName);
        IniFile.WriteInteger(SectionWindow, KeyTop,    Top);
        IniFile.WriteInteger(SectionWindow, KeyLeft,   Left);
        IniFile.WriteInteger(SectionWindow, KeyWidth,  Width);
        IniFile.WriteInteger(SectionWindow, KeyHeight, Height);
        IniFile.WriteInteger(SectionWindow, KeyMinim,  Minim);
        IniFile.WriteString(SectionData,    KeyPort,   FPort);
        IniFile.Free;
    except
        { 关闭时忽略所有错误}
    end;
end;


{读取设置}
procedure TFtpServerForm.LoadConfig;
var
    IniFile : TIniFile;
begin
    IniFile := TIniFile.Create(FIniFileName);
    FPort   := IniFile.ReadString(SectionData,    KeyPort,   'ftp');
    IniFile.Free;
end;


{保存设置}
procedure TFtpServerForm.SaveConfig;
var
    IniFile : TIniFile;
begin
    IniFile := TIniFile.Create(FIniFileName);
    IniFile.WriteString(SectionData, KeyPort, FPort);
    IniFile.Free;
end;

{ 该函数在窗体显示时触发 }
procedure TFtpServerForm.WMAppStartup(var msg: TMessage);
var
    PrvWnd  : HWND;
    Buf     : String;
begin
    if StartMinimizedCheckBox.Checked then
        Application.Minimize;
    Top    := FXTop;
    Left   := FXLeft;
    Width  := FXWidth;
    Height := FXHeight;

    {防止程序启动两次}
    Buf    := ClassName + #0;
    PrvWnd := FindWindow(@Buf[1], MainTitle);
    if PrvWnd <> 0 then begin
        Log.Text('E', '服务器已经启动');
        Close;
        Exit;
    end;
    Caption := MainTitle;
    Update;

    StartServer;
    UpdateClientCount;
end;

{创建窗体时触发}
procedure TFtpServerForm.FormCreate(Sender: TObject);
begin
    {根据可执行文件名得到ini文件名}
    FIniFileName := LowerCase(ExtractFileName(Application.ExeName));
    FIniFileName := Copy(FIniFileName, 1, Length(FIniFileName) - 3) + 'ini';
    {创建日志对象}
    Log := TLogMsg.Create(Self);

    InfoMemo.Clear;
    GreenImage.Visible := FALSE;
    RedImage.Visible   := TRUE;
    RedImage.Top       := GreenImage.Top;
    RedImage.Left      := GreenImage.Left;
end;

{启动服务器}
procedure TFtpServerForm.StartServer;
begin
    GreenImage.Visible := FALSE;
    RedImage.Visible   := TRUE;
    Update;
    
    FtpServer1.Start;
end;

{停止服务器}
procedure TFtpServerForm.StopServer;
begin
    FtpServer1.Stop;