clftp.pas

Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码

begin
  SendCommandSync('CWD %s', [200, 250], [ANewDir]);
end;

procedure TclCustomFtp.ChangeToParentDir;
begin
  SendCommandSync('CDUP', [200, 250]);
end;

procedure TclCustomFtp.MakeDir(const ANewDir: string);
begin
  SendCommandSync('MKD %s', [257], [ANewDir]);
end;

procedure TclCustomFtp.RemoveDir(const ADir: string);
begin
  SendCommandSync('RMD %s', [250], [ADir]);
end;

procedure TclCustomFtp.ParseDirectoryListing(AList: TStrings);
var
  i: Integer;
  info: TclFtpFileInfo;
begin
  info := TclFtpFileInfo.Create();
  try
    for i := 0 to AList.Count - 1 do
    begin
      info.Parse(AList[i]);
      DoDirectoryListing(info, AList[i]);
    end;
  finally
    info.Free();
  end;
end;

procedure TclCustomFtp.GetList(AList: TStrings; const AParam: string;
  ADetails: Boolean);
var
  stream: TStringStream;
begin
  stream := TStringStream.Create('');
  try
    FResourcePos := 0;

    if (ADetails) then
    begin
      InternalGetData(Trim(Format('LIST %s', [AParam])), stream, -1, 0);
    end else
    begin
      InternalGetData(Trim(Format('NLST %s', [AParam])), stream, -1, 0);
    end;
    AList.Text := stream.DataString;
  finally
    stream.Free();
  end;
end;

function TclCustomFtp.GetCurrentDir: string;
var
  ind: Integer;
  s: string;
begin
  Result := '';
  SendCommandSync('PWD', [257]);
  ind := System.Pos('"', Response.Text);
  if (ind > 0) then
  begin
    s := System.Copy(Response.Text, ind + 1, 1000);
    ind := System.Pos('"', s);
    if (ind > 0) then
    begin
      Result := System.Copy(s, 1, ind - 1);
    end;
  end;
end;

procedure TclCustomFtp.SetPassiveMode(const Value: Boolean);
begin
  if (UseTLS = ctNone) and (FPassiveMode <> Value) then
  begin
    FPassiveMode := Value;
    Changed();
  end;
end;

procedure TclCustomFtp.SetTransferMode(const Value: TclFtpTransferMode);
begin
  if (FTransferMode <> Value) then
  begin
    FTransferMode := Value;
    Changed();
  end;
end;

procedure TclCustomFtp.SetTransferStructure(
  const Value: TclFtpTransferStructure);
begin
  if (FTransferStructure <> Value) then
  begin
    FTransferStructure := Value;
    Changed();
  end;
end;

procedure TclCustomFtp.SetDataPortMode(const AServer: string; ADataPort: Integer);
begin
  SendCommandSync('PORT ' + GetFtpHostStr(AServer, ADataPort), [200]);
end;

procedure TclCustomFtp.SetTransferParams;
begin
  SendSilentCommand('MODE %s', [200, 500], [Modes[TransferMode]]);
  SendSilentCommand('STRU %s', [200, 500], [Structures[TransferStructure]]);
  SendSilentCommand('TYPE %s', [200], [TransferTypes[TransferType]]);
end;

procedure TclCustomFtp.InitDataConnection(AConnection: TclSyncConnection; ABytesToProceed, ADataSize: Int64);
const                                                                      
  protectionLevels: array[Boolean] of string = ('C', 'P');
begin
  if (UseTLS <> ctNone) then
  begin
    SendSilentCommand('PBSZ 0', [200]);
    SendSilentCommand('PROT %s', [200], [protectionLevels[DataProtection]]);
  end;

  if (UseTLS <> ctNone) and DataProtection then
  begin
    AssignTlsStream(AConnection);
  end else
  begin
    AConnection.NetworkStream := TclNetworkStream.Create();
  end;
  AConnection.TimeOut := TimeOut;
  AConnection.BatchSize := BatchSize;
  AConnection.BitsPerSec := BitsPerSec;              
  AConnection.IsReadUntilClose := True;
  AConnection.BytesToProceed := ABytesToProceed;
  AConnection.OnProgress := DoDataProgress;
  AConnection.InitProgress(FResourcePos, ADataSize);
end;

procedure TclCustomFtp.DoDataProgress(Sender: TObject; ABytesProceed, ATotalBytes: Int64);
begin
  DoProgress(ABytesProceed, ATotalBytes);
end;

procedure TclCustomFtp.SetPositionIfNeed;
begin
  if (FResourcePos > 0) then
  begin
    SendCommandSync('REST %d', [350], [FResourcePos]);
  end;
end;

procedure TclCustomFtp.InternalGetData(const ACommand: string; ADestination: TStream;
  AMaxReadSize, ADataSize: Int64);
var
  dataIP: string;
  dataPort: Integer;
begin
  SetTransferParams();
  try
    if PassiveMode then
    begin
      FDataConnection := TclTcpClientConnection.Create();
      InitDataConnection(FDataConnection, AMaxReadSize, ADataSize);
      SetDataPassiveMode(dataIP, dataPort);

      SetPositionIfNeed();

      ClearResponse();
      SendCommand(ACommand);
      TclTcpClientConnection(FDataConnection).Open(dataIP, dataPort);
      WaitingMultipleResponses([125, 150, 154]);
    end else
    begin
      FDataConnection := TclTcpServerConnection.Create();
      InitDataConnection(FDataConnection, AMaxReadSize, ADataSize);
      dataPort := TclTcpServerConnection(FDataConnection).Open(0);

      SetDataPortMode(GetFtpLocalHostStr(Server), dataPort);
      SetPositionIfNeed();

      ClearResponse();
      SendCommand(ACommand);
      WaitingMultipleResponses([125, 150, 154]);
      TclTcpServerConnection(FDataConnection).AcceptConnection();
    end;

{$IFDEF LOGGER}
  if not FDataConnection.Active then
    clPutLogMessage(Self, edInside, 'InternalGetData: FDataConnection.Active = False');
{$ENDIF}
    if FDataConnection.Active or FDataConnection.NetworkStream.HasReadData then
    begin
      BeginAccess();
      try
        ADestination.Position := FResourcePos;
        FDataConnection.ReadData(ADestination);
        FResourcePos := ADestination.Position;
      finally
        EndAccess();
      end;
    end;

    if not FDataConnection.IsAborted and (AMaxReadSize > -1) then
    begin
      SendCommand('ABOR');
    end;

    if FDataConnection.Active then
    begin
      FDataConnection.Close(True);
    end;

    WaitingMultipleResponses([225, 226, 250, 426, 450]);
    if (LastResponseCode = 426) or (LastResponseCode = 450) then
    begin
      WaitingMultipleResponses([225, 226]);
    end;
  finally
    FDataConnection.Free();
    FDataConnection := nil;
  end;
end;

procedure TclCustomFtp.GetFile(const AFileName: string;
  ADestination: TStream);
begin
  BeginAccess();
  try
    FResourcePos := ADestination.Position;
  finally
    EndAccess();
  end;
  InternalGetData(Format('RETR %s', [AFileName]), ADestination, -1, GetFileSizeIfNeed(AFileName));
end;

procedure TclCustomFtp.PutFile(const AFileName: string; ASource: TStream);
begin
  FResourcePos := 0;
  InternalPutData('STOR ' + AFileName, ASource, -1);
end;

procedure TclCustomFtp.AppendFile(const AFileName: string; ASource: TStream);
begin
  FResourcePos := 0;
  InternalPutData('APPE ' + AFileName, ASource, -1);
end;

procedure TclCustomFtp.PutUniqueFile(ASource: TStream);
begin
  FResourcePos := 0;
  InternalPutData('STOU', ASource, -1);
end;

procedure TclCustomFtp.Rename(const ACurrentName, ANewName: string);
begin
  SendCommandSync('RNFR %s', [350], [ACurrentName]);
  SendCommandSync('RNTO %s', [250], [ANewName]);
end;

procedure TclCustomFtp.Delete(const AFileName: string);
begin
  SendCommandSync('DELE %s', [250], [AFileName]);
end;

function TclCustomFtp.GetFileSize(const AFileName: string): Int64;
begin
  SendCommandSync('TYPE %s', [200], [TransferTypes[TransferType]]);
  SendCommandSync('SIZE %s', [213], [AFileName]);
  Result := ParseFileSize();
end;

function TclCustomFtp.ParseFileSize: Int64;
var
  s: string;
begin
  s := Trim(Copy(Response.Text, 4, 1000));
  Result := StrToInt64Def(s, -1);
end;

procedure TclCustomFtp.InternalPutData(const ACommand: string; ASource: TStream; AMaxWriteSize: Int64);
var
  dataIP: string;
  dataPort: Integer;
begin
  SetTransferParams();
  try
    if PassiveMode then
    begin
      FDataConnection := TclTcpClientConnection.Create();
      InitDataConnection(FDataConnection, AMaxWriteSize, ASource.Size);
      SetDataPassiveMode(dataIP, dataPort);

      SetPositionIfNeed();

      ClearResponse();
      SendCommand(ACommand);
      TclTcpClientConnection(FDataConnection).Open(dataIP, dataPort);
      WaitingMultipleResponses([110, 125, 150]);
    end else
    begin
      FDataConnection := TclTcpServerConnection.Create();
      InitDataConnection(FDataConnection, AMaxWriteSize, ASource.Size);
      dataPort := TclTcpServerConnection(FDataConnection).Open(0);

      SetDataPortMode(GetFtpLocalHostStr(Server), dataPort);
      SetPositionIfNeed();

      ClearResponse();
      SendCommand(ACommand);
      WaitingMultipleResponses([110, 125, 150]);
      TclTcpServerConnection(FDataConnection).AcceptConnection();
    end;

{$IFDEF LOGGER}
  if not FDataConnection.Active then
    clPutLogMessage(Self, edInside, 'InternalGetData: FDataConnection.Active = False');
{$ENDIF}
    
    if FDataConnection.Active then
    begin
      BeginAccess();
      try
        ASource.Position := FResourcePos;
        FDataConnection.WriteData(ASource);
        FResourcePos := ASource.Position;
      finally
        EndAccess();
      end;

      FDataConnection.Close(True);
    end;

    WaitingMultipleResponses([225, 226, 250, 426, 450]);
    if (LastResponseCode = 426) or (LastResponseCode = 450) then
    begin
      WaitingMultipleResponses([226, 225]);
    end;
  finally
    FDataConnection.Free();
    FDataConnection := nil;
  end;
end;

procedure TclCustomFtp.SetDataPassiveMode(var AHost: string; var ADataPort: Integer);
begin
  SendCommandSync('PASV', [227]);
  ParsePassiveModeResponse(AHost, ADataPort);
end;

procedure TclCustomFtp.ParsePassiveModeResponse(var AHost: string; var ADataPort: Integer);
var
  ind: Integer;
  s: string;
begin
  s := Trim(Response.Text);
  ind := TextPos('(', s);
  if (ind < 1) then
  begin
    ind := RTextPos(#32, s);