ftptst1.pas

ics Internet 控件

    ExecuteCmd(FtpClient1.MkDir, FtpClient1.MkdirAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.RmdAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.Rmd, FtpClient1.RmdAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.RmdirAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.RmDir, FtpClient1.RmDirAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.RenAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.Ren, FtpClient1.RenAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.RenameAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.Rename, FtpClient1.RenameAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.DeleAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.Dele, FtpClient1.DeleAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.DeleteAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.Delete, FtpClient1.DeleteAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.PwdAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.Pwd, FtpClient1.PwdAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.QuoteAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.Quote, FtpClient1.QuoteAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.DoQuoteAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.DoQuote, FtpClient1.DoQuoteAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.PutAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.Put, FtpClient1.PutAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.TransmitAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.Transmit, FtpClient1.TransmitAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.TypeSetAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.TypeSet, FtpClient1.TypeSetAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.RestGetAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.RestGet, FtpClient1.RestGetAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.RestartGetAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.RestartGet, FtpClient1.RestartGetAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.CDupAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.CDup, FtpClient1.CDupAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.ClearButtonClick(Sender: TObject);
begin
    DisplayMemo.Clear;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.AppendAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.Append, FtpClient1.AppendAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.AppendFileAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.AppendFile, FtpClient1.AppendFileAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.AbortXferAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.AbortXfer, FtpClient1.AbortXferAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.AuthSslButtonClick(Sender: TObject);
begin
    AuthSslCheckBox.Checked := TRUE;   { 24/08/2004 }
    ExecuteCmd(FtpClient1.AuthSsl, FtpClient1.AuthSslAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.Button1Click(Sender: TObject);
var
    Count : Integer;
begin
    SyncCheckBox.Checked := TRUE;
    if not FtpClient1.Connected then begin
        FtpClient1.HostName        := HostNameEdit.Text;
        FtpClient1.Port            := PortEdit.Text;
        FtpClient1.UserName        := UserNameEdit.Text;
        FtpClient1.Password        := PasswordEdit.Text;
        FtpClient1.DisplayFileFlag := cbDisplay.Checked;
        FtpClient1.OnDisplay       := DisplayHandler;
        ExecuteCmd(FtpClient1.Connect, FtpClient1.ConnectAsync);
        if Copy(FtpClient1.LastResponse, 1, 3) <> '230' then
            Exit;
    end;
    Count := 0;
    repeat
        DisplayMemo.Clear;
        Inc(Count);
        Display('Count=' + IntToStr(Count));
        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       := DisplayHandler;
        ExecuteCmd(FtpClient1.Put, FtpClient1.PutAsync);
    until Copy(FtpClient1.LastResponse, 1, 3) <> '226';
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.RestPutAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.RestPut, FtpClient1.RestPutAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.RestartPutAsyncButtonClick(Sender: TObject);
begin
    ExecuteCmd(FtpClient1.RestartPut, FtpClient1.RestartPutAsync);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.TransmitUsingStreamButtonClick(Sender: TObject);
var
    MyStream : TStream;
begin
    MyStream := TFileStream.Create(LocalFileEdit.Text, fmOpenRead);
    try
        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.LocalStream     := MyStream;
        FtpClient1.Binary          := cbBinary.Checked;
        FtpClient1.DisplayFileFlag := cbDisplay.Checked;
        FtpClient1.OnDisplay       := DisplayHandler;
        if ResumeAtEdit.Text > '' then
            FtpClient1.ResumeAt    := StrToInt(ResumeAtEdit.Text);
        FtpClient1.Transmit;
    finally
        FtpClient1.LocalStream     := nil;
        MyStream.Free;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.ReceiveUsingStreamButtonClick(Sender: TObject);
var
    MyStream : TStream;
begin
    MyStream := TFileStream.Create(LocalFileEdit.Text, fmCreate);
    try
        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.LocalStream     := MyStream;
        FtpClient1.Binary          := cbBinary.Checked;
        FtpClient1.DisplayFileFlag := cbDisplay.Checked;
        FtpClient1.OnDisplay       := DisplayHandler;
        if ResumeAtEdit.Text > '' then
            FtpClient1.ResumeAt    := StrToInt(ResumeAtEdit.Text);
        FtpClient1.Receive;
    finally
        FtpClient1.LocalStream     := nil;
        MyStream.Free;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function GetFileSize(const FileName: string): LongInt;
var
    SearchRec: TSearchRec;
begin
    if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then begin
        Result := SearchRec.Size;
        SysUtils.FindClose(SearchRec);
    end
    else
        Result := -1;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TFtpReceiveForm.SendFile : Boolean;
var
    LocalSize : LongInt;
begin
    try
        FtpClient1.Abort;  { Whatever occured, abort ! }
        FtpClient1.LocalFileName := LocalFileEdit.Text;
        FtpClient1.HostDirName   := HostDirEdit.Text;
        FtpClient1.HostFileName  := HostFileEdit.Text;
        FtpClient1.HostName      := HostNameEdit.Text;
        FtpClient1.Port          := PortEdit.Text;
        FtpClient1.UserName      := UserNameEdit.Text;
        FtpClient1.Password      := PassWordEdit.Text;
        FtpClient1.Passive       := PassiveCheckBox.Checked;
        FtpClient1.Binary        := cbBinary.Checked;
        FtpClient1.Timeout       := 30;
        FtpClient1.ShareMode     := ftpShareDenyNone;
        if not FtpClient1.Connect then
            raise Exception.Create('FtpClient1.Connect failed: ' + FtpClient1.ErrorMessage);
        if FtpClient1.HostDirName <> '' then begin
            if not FtpClient1.Cwd then
                raise Exception.Create('FtpClient1.Cwd failed: ' + FtpClient1.ErrorMessage);
        end;
        if not FtpClient1.TypeSet then
            raise Exception.Create('FtpClient1.TypeSet failed: ' + FtpClient1.ErrorMessage);
        if not FtpClient1.Put then
            raise Exception.Create('FtpClient1.Put failed: ' + FtpClient1.ErrorMessage);
        if FtpClient1.StatusCode <> 226 then
            raise Exception.Create('FtpClient1.Put failed: ' + FtpClient1.LastResponse);
        if not FtpClient1.Size then
            raise Exception.Create('FtpClient1.Size failed: ' + FtpClient1.ErrorMessage);
        LocalSize := GetFileSize(FtpClient1.LocalFileName);
        Result    := (FtpClient1.SizeResult = LocalSize);
        if not Result then
            Display('Incorrect file size on server (S=' +
                    IntToStr(FtpClient1.SizeResult) + ' L=' +
                    IntToStr(LocalSize) + ')');
        if not FtpClient1.Quit then
            raise Exception.Create('FtpClient1.Quit failed: ' + FtpClient1.ErrorMessage);
    except
        on E:Exception do begin
            Display('Exception ' + E.ClassName + ': ' + E.Message);
            Result := FALSE;
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpReceiveForm.StressPutButtonClick(Sender: TObject);
var
    Count : Integer;
begin
    if FRunning then begin
        FRunning := FALSE;
        Display('Stress Put interrupted.');
        StressPutButton.Caption := 'Stress Put';
        Exit;
    end;
    FRunning := TRUE;
    try
        Display('Stress Put started.');
        StressPutButton.Caption := 'STOP';
        Count := 0;
        while FRunning and (not Application.Terminated) do begin
            Inc(Count);
            Display('STRESS COUNT = ' + IntToStr(Count));
            if not SendFile then
                break;
            Application.ProcessMessages;
        end;
    finally
        FRunning := FALSE;
        Display('Stress Put finished.');
        StressPutButton.Caption := 'Stress Put';
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.