ftptst1.pas

包含常用Internet协议TCP,UDP、HTTP、FTP、Telnet等

    IniFile.WriteInteger(SectionWindow, KeyTop,    Top);
    IniFile.WriteInteger(SectionWindow, KeyLeft,   Left);
    IniFile.WriteInteger(SectionWindow, KeyWidth,  Width);
    IniFile.WriteInteger(SectionWindow, KeyHeight, Height);
    IniFile.Free;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFDEF VER80}
function DeleteFile(const FileName: string): Boolean;
var
   F : File of char;
begin
    Result := TRUE;
    try
        AssignFile(F, FileName);
        Erase(F);
    except
        Result := FALSE;
    end;
end;
{$ENDIF}


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.Display(Sender : TObject; var Msg : String);
begin
    DisplayMemo.Lines.Add(Msg);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.ExitButtonClick(Sender: TObject);
begin
    Close;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.FtpClient1Progress(Sender: TObject;
  Count: Longint; var Abort: Boolean);
begin
    FProgressCount := Count;
    { Be sure to update screen only once every second }
    if FLastProgress < GetTickCount then begin
        FLastProgress := GetTickCount + 1000;
        InfoLabel.Caption := IntToStr(FProgressCount);
        InfoLabel.Repaint;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.DisplayFile(FileName : String);
begin
    try
        DirectoryForm.DirListBox.Items.LoadFromFile(FileName);
    except
        DirectoryForm.DirListBox.Clear;
    end;
    DirectoryForm.ShowModal;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.FtpClient1RequestDone(Sender: TObject;
  RqType: TFtpRequest; Error: Word);
begin
    DisplayMemo.Lines.Add('Request ' + IntToStr(Ord(RqType)) + ' Done.');
    DisplayMemo.Lines.Add('StatusCode = ' + IntToStr(FtpClient1.StatusCode));
    DisplayMemo.Lines.Add('LastResponse was : ''' +
                          FtpClient1.LastResponse + '''');
    if Error = 0 then
        DisplayMemo.Lines.Add('No error')
    else
        DisplayMemo.Lines.Add('Error = ' + IntToStr(Error) +
                              ' (' + FtpClient1.ErrorMessage + ')');

    { Display last progress value }
    InfoLabel.Caption := IntToStr(FProgressCount);

    if Error = 0 then begin
        case RqType of
        ftpDirAsync, ftpDirectoryAsync,
        ftpLsAsync,  ftpListAsync       : DisplayFile(TEMP_FILE_NAME);
        ftpSizeAsync                    : DisplayMemo.Lines.Add(
                                             'File size is ' +
                                             IntToStr(FtpClient1.SizeResult) +
                                             ' bytes' );
        ftpPwdAsync, ftpMkdAsync,
        ftpCDupAsync, ftpCwdAsync       : DisplayMemo.Lines.Add(
                                             'Directory is "' +
                                             FtpClient1.DirResult + '"');
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.FtpClient1SessionConnected(Sender: TObject;
  Error: Word);
begin
    DisplayMemo.Lines.Add('Session Connected, error = ' + IntToStr(Error));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.FtpClient1SessionClosed(Sender: TObject;
  Error: Word);
begin
    DisplayMemo.Lines.Add('Session Closed, error = ' + IntToStr(Error));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.FtpClient1StateChange(Sender: TObject);
begin
{   DisplayMemo.Lines.Add('State = ' + IntToStr(Ord(FtpClient1.State))); }
    StateLabel.Caption := IntToStr(Ord(FtpClient1.State));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.ExecuteCmd(SyncCmd : TSyncCmd; ASyncCmd : TAsyncCmd);
begin
    DisplayMemo.Lines.Add('Executing Requested Command');
    { Initialize progress stuff }
    FLastProgress  := 0;
    FProgressCount := 0;
    
    if SyncCheckBox.Checked then begin
        if SyncCmd then
            DisplayMemo.Lines.Add('Command Success')
        else
            DisplayMemo.Lines.Add('Command Failure');
    end
    else
        ASyncCmd;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.OpenAsyncButtonClick(Sender: TObject);
begin
    DisplayMemo.Clear;
    DisplayMemo.Lines.Add('Connect Async');
    FtpClient1.HostName        := HostNameEdit.Text;
    FtpClient1.Port            := PortEdit.Text;
    FtpClient1.DisplayFileFlag := cbDisplay.Checked;
    FtpClient1.OnDisplay       := Display;
    ExecuteCmd(FtpClient1.Open, FtpClient1.OpenAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.QuitAsyncButtonClick(Sender: TObject);
begin
    FtpClient1.DisplayFileFlag := cbDisplay.Checked;
    FtpClient1.OnDisplay       := Display;
    ExecuteCmd(FtpClient1.Quit, FtpClient1.QuitAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.CwdAsyncButtonClick(Sender: TObject);
begin
    FtpClient1.HostDirName     := HostDirEdit.Text;
    FtpClient1.DisplayFileFlag := cbDisplay.Checked;
    FtpClient1.OnDisplay       := Display;
    ExecuteCmd(FtpClient1.Cwd, FtpClient1.CwdAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.UserAsyncButtonClick(Sender: TObject);
begin
    FtpClient1.UserName        := UserNameEdit.Text;
    FtpClient1.DisplayFileFlag := cbDisplay.Checked;
    FtpClient1.OnDisplay       := Display;
    ExecuteCmd(FtpClient1.User, FtpClient1.UserAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.PassAsyncButtonClick(Sender: TObject);
begin
    FtpClient1.Password        := PasswordEdit.Text;
    FtpClient1.DisplayFileFlag := cbDisplay.Checked;
    FtpClient1.OnDisplay       := Display;
    ExecuteCmd(FtpClient1.Pass, FtpClient1.PassAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.ConnectAsyncButtonClick(Sender: TObject);
begin
    FtpClient1.HostName        := HostNameEdit.Text;
    FtpClient1.Port            := PortEdit.Text;
    FtpClient1.UserName        := UserNameEdit.Text;
    FtpClient1.Password        := PasswordEdit.Text;
    FtpClient1.DisplayFileFlag := cbDisplay.Checked;
    FtpClient1.OnDisplay       := Display;
    ExecuteCmd(FtpClient1.Connect, FtpClient1.ConnectAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.GetAsyncButtonClick(Sender: TObject);
begin
    FtpClient1.HostDirName     := HostDirEdit.Text;
    FtpClient1.HostFileName    := HostFileEdit.Text;
    FtpClient1.LocalFileName   := LocalFileEdit.Text;
    FtpClient1.Passive         := PassiveCheckBox.Checked;
    ExecuteCmd(FtpClient1.Get, FtpClient1.GetAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.ReceiveAsyncButtonClick(Sender: TObject);
begin
    FtpClient1.HostName        := HostNameEdit.Text;
    FtpClient1.Port            := PortEdit.Text;
    FtpClient1.UserName        := UserNameEdit.Text;
    FtpClient1.PassWord        := PassWordEdit.Text;
    FtpClient1.HostDirName     := HostDirEdit.Text;
    FtpClient1.HostFileName    := HostFileEdit.Text;
    FtpClient1.LocalFileName   := LocalFileEdit.Text;
    FtpClient1.Binary          := cbBinary.Checked;
    FtpClient1.Passive         := PassiveCheckBox.Checked;
    FtpClient1.DisplayFileFlag := cbDisplay.Checked;
    FtpClient1.OnDisplay       := Display;
    ExecuteCmd(FtpClient1.Receive, FtpClient1.ReceiveAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.AbortAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.Abort, FtpClient1.AbortAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.DirAsyncButtonClick(Sender: TObject);
begin
    DeleteFile(TEMP_FILE_NAME);
    FtpClient1.HostFileName    := HostFileEdit.Text;
    FtpClient1.LocalFileName   := TEMP_FILE_NAME;
    FtpClient1.DisplayFileFlag := cbDisplay.Checked;
    FtpClient1.Passive         := PassiveCheckBox.Checked;
    FtpClient1.OnDisplay       := Display;
    ExecuteCmd(FtpClient1.Dir, FtpClient1.DirAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.DirectoryAsyncButtonClick(Sender: TObject);
begin
    DeleteFile(TEMP_FILE_NAME);
    FtpClient1.HostName        := HostNameEdit.Text;
    FtpClient1.Port            := PortEdit.Text;
    FtpClient1.UserName        := UserNameEdit.Text;
    FtpClient1.PassWord        := PassWordEdit.Text;
    FtpClient1.HostDirName     := HostDirEdit.Text;
    FtpClient1.HostFileName    := HostFileEdit.Text;
    FtpClient1.LocalFileName   := TEMP_FILE_NAME;
    FtpClient1.DisplayFileFlag := cbDisplay.Checked;
    FtpClient1.Passive         := PassiveCheckBox.Checked;
    FtpClient1.OnDisplay       := Display;
    ExecuteCmd(FtpClient1.Directory, FtpClient1.DirectoryAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.LsAsyncButtonClick(Sender: TObject);
begin
    DeleteFile(TEMP_FILE_NAME);
    FtpClient1.HostFileName    := HostFileEdit.Text;
    FtpClient1.LocalFileName   := TEMP_FILE_NAME;
    FtpClient1.DisplayFileFlag := cbDisplay.Checked;
    FtpClient1.Passive         := PassiveCheckBox.Checked;
    FtpClient1.OnDisplay       := Display;
    ExecuteCmd(FtpClient1.Ls, FtpClient1.LsAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.ListAsyncButtonClick(Sender: TObject);
begin
    DeleteFile(TEMP_FILE_NAME);
    FtpClient1.HostName        := HostNameEdit.Text;
    FtpClient1.Port            := PortEdit.Text;
    FtpClient1.UserName        := UserNameEdit.Text;
    FtpClient1.PassWord        := PassWordEdit.Text;
    FtpClient1.HostDirName     := HostDirEdit.Text;
    FtpClient1.HostFileName    := HostFileEdit.Text;
    FtpClient1.LocalFileName   := TEMP_FILE_NAME;
    FtpClient1.DisplayFileFlag := cbDisplay.Checked;
    FtpClient1.Passive         := PassiveCheckBox.Checked;
    FtpClient1.OnDisplay       := Display;
    ExecuteCmd(FtpClient1.List, FtpClient1.ListAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.SystAsyncButtonClick(Sender: TObject);
begin
    FtpClient1.DisplayFileFlag := cbDisplay.Checked;
    FtpClient1.OnDisplay       := Display;
    ExecuteCmd(FtpClient1.Syst, FtpClient1.SystAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.SystemAsyncButtonClick(Sender: TObject);
begin
    FtpClient1.HostName        := HostNameEdit.Text;
    FtpClient1.Port            := PortEdit.Text;
    FtpClient1.UserName        := UserNameEdit.Text;
    FtpClient1.PassWord        := PassWordEdit.Text;
    FtpClient1.DisplayFileFlag := cbDisplay.Checked;
    FtpClient1.OnDisplay       := Display;
    ExecuteCmd(FtpClient1.System, FtpClient1.SystemAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.FileSizeAsyncButtonClick(Sender: TObject);
begin
    FtpClient1.HostName        := HostNameEdit.Text;
    FtpClient1.Port            := PortEdit.Text;
    FtpClient1.UserName        := UserNameEdit.Text;
    FtpClient1.PassWord        := PassWordEdit.Text;
    FtpClient1.HostDirName     := HostDirEdit.Text;
    FtpClient1.HostFileName    := HostFileEdit.Text;
    FtpClient1.DisplayFileFlag := cbDisplay.Checked;
    FtpClient1.OnDisplay       := Display;