?? ftpcli.pas
字號:
HandleError('UserName emtpy');
Exit;
end;
FFctPrv := ftpFctUser;
case FConnectionType of
ftpDirect, ftpSocks4, ftpSocks4A, ftpSocks5: ExecAsync(ftpUserAsync, 'USER '+FUserName, [331, 230], nil);
ftpProxy: ExecAsync(ftpUserAsync, 'USER '+FUserName+'@'+FHostName, [331, 230], nil);
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomFtpCli.PassAsync;
begin
if Length(FPassword) <= 0 then begin
HandleError('Password emtpy');
Exit;
end;
FFctPrv := ftpFctPass;
ExecAsync(ftpPassAsync, 'PASS '+ FPassword, [230], nil);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomFtpCli.SystAsync;
begin
FFctPrv := ftpFctSyst;
ExecAsync(ftpSystAsync, 'SYST', [215], nil);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomFtpCli.RestAsync;
begin
FFctPrv := ftpFctRest;
{ When restarting a download, we always start from current local file }
{ size. When restarting a upload, we restart from ResumeAt property }
{ value. This property could be initialized using Size command. }
if (not (FRequestType in [ftpRestartPutAsync, ftpRestPutAsync])) and
(not (ftpNoAutoResumeAt in FOptions)) then
FResumeAt := GetFileSize(FLocalFileName);
if FResumeAt > 0 then
ExecAsync(ftpRestAsync, 'REST ' + IntToStr(FResumeAt), [0], nil)
else begin
FRequestDoneFlag := FALSE;
FNext := NextExecAsync;
FDoneAsync := nil;
TriggerRequestDone(0);
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomFtpCli.SizeAsync;
begin
FSizeResult := 0;
FFctPrv := ftpFctSize;
ExecAsync(ftpSizeAsync, 'SIZE ' + FHostFileName, [213], nil);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomFtpCli.TypeSetAsync;
begin
FFctPrv := ftpFctTypeSet;
ExecAsync(ftpTypeSetAsync, 'TYPE ' + FType, [200], nil);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomFtpCli.TypeBinaryAsync;
begin
Binary := TRUE;
TypeSetAsync;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomFtpCli.TypeAsciiAsync;
begin
Binary := FALSE;
TypeSetAsync;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomFtpCli.MkdAsync;
begin
FFctPrv := ftpFctMkd;
ExecAsync(ftpMkdAsync, 'MKD ' + FHostFileName, [257], nil);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomFtpCli.RmdAsync;
begin
FFctPrv := ftpFctRmd;
ExecAsync(ftpRmdAsync, 'RMD ' + FHostFileName, [250, 257], nil);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomFtpCli.DeleAsync;
begin
FFctPrv := ftpFctDele;
ExecAsync(ftpDeleAsync, 'DELE ' + FHostFileName, [250, 257], nil);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomFtpCli.QuoteAsync;
begin
FFctPrv := ftpFctQuote;
ExecAsync(ftpQuoteAsync, FLocalFileName, [0], nil);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomFtpCli.PwdAsync;
begin
FFctPrv := ftpFctPwd;
ExecAsync(ftpPwdAsync, 'PWD', [250, 257], nil);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomFtpCli.CDupAsync;
begin
FFctPrv := ftpFctCDup;
ExecAsync(ftpCDupAsync, 'CDUP', [250], nil);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomFtpCli.RenFromAsync;
begin
FFctPrv := ftpFctRenFrom;
ExecAsync(ftpRenFromAsync, 'RNFR ' + FHostFileName, [350], nil);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomFtpCli.RenToAsync;
begin
FFctPrv := ftpFctRenTo;
ExecAsync(ftpRenToAsync, 'RNTO ' + FLocalFileName, [200, 250, 257], nil);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomFtpCli.AbortAsync;
var
bFlag : Boolean;
begin
{$IFDEF TRACE} TriggerDisplay('! Aborting'); {$ENDIF}
bFlag := (FState = ftpDnsLookup);
StateChange(ftpAbort);
DestroyLocalStream;
if bFlag then
FControlSocket.CancelDnsLookup;
if FControlSocket.State <> wsClosed then
FControlSocket.Close;
if FDataSocket.State <> wsClosed then
FDataSocket.Close;
DestroyLocalStream;
FConnected := FALSE;
StateChange(ftpReady);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomFtpCli.DoHighLevelAsync;
begin
{$IFDEF TRACE} TriggerDisplay('! HighLevelAsync ' + IntToStr(FRequestResult)); {$ENDIF}
if FState = ftpAbort then begin
{$IFDEF TRACE} TriggerDisplay('! Abort detected'); {$ENDIF}
FFctSet := [];
FHighLevelResult := 426;
FErrorMessage := '426 Operation aborted.';
end;
FNextRequest := DoHighLevelAsync;
if FRequestResult <> 0 then begin
{ Previous command had errors }
FHighLevelResult := FRequestResult;
if (FFctPrv = ftpFctQuit) or (not (ftpFctQuit in FFctSet)) then
FFctSet := []
else
FFctSet := [ftpFctQuit];
end;
ExtractMoreResults;
if ftpFctOpen in FFctSet then begin
FFctPrv := ftpFctOpen;
FFctSet := FFctSet - [FFctPrv];
OpenAsync;
Exit;
end;
if ftpFctUser in FFctSet then begin
FFctPrv := ftpFctUser;
FFctSet := FFctSet - [FFctPrv];
UserAsync;
Exit;
end;
if ftpFctPass in FFctSet then begin
FFctSet := FFctSet - [ftpFctPass];
if (FFctPrv <> ftpFctUser) or
((FfctPrv = ftpFctUser) and (FStatusCode = 331)) then begin
FFctPrv := ftpFctPass;
PassAsync;
Exit;
end;
end;
if ftpFctCwd in FFctSet then begin
FFctSet := FFctSet - [ftpFctCwd];
if Length(FHostDirName) > 0 then begin
FFctPrv := ftpFctCwd;
CwdAsync;
Exit;
end;
end;
if ftpFctCDup in FFctSet then begin
FFctPrv := ftpFctCDup;
FFctSet := FFctSet - [FFctPrv];
CDupAsync;
Exit;
end;
if ftpFctTypeSet in FFctSet then begin
FFctPrv := ftpFctTypeSet;
FFctSet := FFctSet - [FFctPrv];
TypeSetAsync;
Exit;
end;
if ftpFctPort in FFctSet then begin
FFctPrv := ftpFctPort;
FFctSet := FFctSet - [FFctPrv];
PortAsync;
Exit;
end;
if ftpFctRest in FFctSet then begin
FFctPrv := ftpFctRest;
FFctSet := FFctSet - [FFctPrv];
RestAsync;
Exit;
end;
if ftpFctGet in FFctSet then begin
if (FFctPrv <> ftpFctRest) or
(FResumeAt < 0) or
((FFctPrv = ftpFctRest) and (FStatusCode <> 350)) then
FResumeAt := 0;
FFctPrv := ftpFctGet;
FFctSet := FFctSet - [FFctPrv];
ExecGetAsync;
Exit;
end;
if ftpFctPut in FFctSet then begin
FFctPrv := ftpFctPut;
FFctSet := FFctSet - [FFctPrv];
ExecPutAsync;
Exit;
end;
if ftpFctAppend in FFctSet then begin
FFctPrv := ftpFctAppend;
FFctSet := FFctSet - [FFctPrv];
ExecAppendAsync;
Exit;
end;
if ftpFctDir in FFctSet then begin
FFctPrv := ftpFctDir;
FFctSet := FFctSet - [FFctPrv];
ExecDirAsync;
Exit;
end;
if ftpFctLs in FFctSet then begin
FFctPrv := ftpFctLs;
FFctSet := FFctSet - [FFctPrv];
ExecLsAsync;
Exit;
end;
if ftpFctSyst in FFctSet then begin
FFctPrv := ftpFctSyst;
FFctSet := FFctSet - [FFctPrv];
SystAsync;
Exit;
end;
if ftpFctMkd in FFctSet then begin
FFctPrv := ftpFctMkd;
FFctSet := FFctSet - [FFctPrv];
MkdAsync;
Exit;
end;
if ftpFctRmd in FFctSet then begin
FFctPrv := ftpFctRmd;
FFctSet := FFctSet - [FFctPrv];
RmdAsync;
Exit;
end;
if ftpFctRenFrom in FFctSet then begin
FFctPrv := ftpFctRenFrom;
FFctSet := FFctSet - [FFctPrv];
RenFromAsync;
Exit;
end;
if ftpFctRenTo in FFctSet then begin
FFctPrv := ftpFctRenTo;
FFctSet := FFctSet - [FFctPrv];
RenToAsync;
Exit;
end;
if ftpFctSize in FFctSet then beg
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -