idftp.pas

Indy控件的使用源代码

  // RFC lists 200 as the proper response, but in another section says that it can return the
  // same as CWD, which expects 250. That is it contradicts itself.
  // MS in their infinite wisdom chnaged IIS 5 FTP to return 250.
  SendCmd('CDUP', [200, 250]);   {Do not translate}
end;

procedure TIdFTP.Site(const ACommand: string);
begin
  SendCmd('SITE ' + ACommand, 200);   {Do not translate}
end;

procedure TIdFTP.Rename(const ASourceFile, ADestFile: string);
begin
  SendCmd('RNFR ' + ASourceFile, 350);  {Do not translate}
  SendCmd('RNTO ' + ADestFile, 250);    {Do not translate}
end;

function TIdFTP.Size(const AFileName: String): Integer;
var
  SizeStr: String;
begin
  result := -1;
  if SendCmd('SIZE ' + AFileName) = 213 then begin  {Do not translate}
    SizeStr := Trim(LastCmdResult.Text.Text);
    system.delete(SizeStr, 1, IndyPos(' ', SizeStr)); // delete the response   {Do not translate}
    result := StrToIntDef(SizeStr, -1);
  end;
end;

//Added by SP
procedure TIdFTP.ReInitialize(ADelay: Cardinal = 10);
begin
  Sleep(ADelay); //Added
  if SendCmd('REIN', [120, 220, 500]) <> 500 then begin  {Do not translate}
    FLoginMsg.Clear;
    FCanResume := False;
    FDirectoryListing.Clear;
    FUsername := '';                 {Do not translate}
    FPassword := '';                 {Do not translate}
    FPassive := Id_TIdFTP_Passive;
    FCanResume := False;
    FResumeTested := False;
    FSystemDesc := '';
    FTransferType := Id_TIdFTP_TransferType;
  end;
end;

procedure TIdFTP.Allocate(AAllocateBytes: Integer);
begin
  SendCmd('ALLO ' + IntToStr(AAllocateBytes), [200]); {Do not translate}
end;

procedure TIdFTP.Status(var AStatusList: TStringList);
var
  LStrm: TStringStream;
  LList: TStringList;
begin
  if SendCmd('STAT', [211, 212, 213, 500]) <> 500 then   {Do not translate}
  begin
    if not Assigned(FDirectoryListing) then
    begin
      DoFTPList;
    end;
    LStrm := TStringStream.Create('');      {Do not translate}
    LList := TStringList.Create;
    //Read stream through control connection - not data channel
    ReadStream(LStrm, -1, True);
    LList.Text := LStrm.DataString;
    try
      try
        ConstructDirListing;
        FDirectoryListing.Clear;
      except
        on EAccessViolation do ConstructDirListing;
      end;
      // Parse directory listing
      if LList.Count > 0 then
      begin
        FDirectoryListing.ListFormat := FDirectoryListing.CheckListFormat(LList[0], True);
        DoCheckListFormat(LList[0]);
        FDirectoryListing.LoadList(LList);
      end;
    except
      if Assigned(AStatusList) = True then
      begin
        AStatusList.Text := LStrm.DataString;
      end;
    end;
    FreeAndNil(LStrm);
    FreeAndNil(LList);
  end;
end;

procedure TIdFTP.Help(var AHelpContents: TStringList; ACommand: String = ''); {Do not translate}
var
  LStrm: TStringStream;
begin
  LStrm := TStringStream.Create('');    {Do not translate}
  if SendCmd('HELP ' + ACommand, [211, 214, 500]) <> 500 then       {Do not translate}
  begin
    ReadStream(LStrm, -1, True);
    AHelpContents.Text := LStrm.DataString;
  end;
  FreeAndNil(LStrm);
end;

procedure TIdFTP.Account(AInfo: String);
begin
  SendCmd('ACCT ' + AInfo, [202, 230, 500]);   {Do not translate}
end;

procedure TIdFTP.StructureMount(APath: String);
begin
  SendCmd('SMNT ' + APath, [202, 250, 500]);  {Do not translate}
end;

procedure TIdFTP.FileStructure(AStructure: TIdFTPDataStructure);
var
  s: String;
begin
  case AStructure of
    dsFile: s := 'F';         {Do not translate}
    dsRecord: s := 'R';       {Do not translate}
    dsPage: s := 'P';         {Do not translate}
  end;
  SendCmd('STRU ' + s, [200, 500]);  {Do not translate}
  { TODO: Needs to be finished }
end;

procedure TIdFTP.TransferMode(ATransferMode: TIdFTPTransferMode);
var
  s: String;
begin
  case ATransferMode of
    dmBlock: begin
      s := 'B';                {Do not translate}
    end;
    dmCompressed: begin
      s := 'C';                {Do not translate}
    end;
    dmStream: begin
      s := 'S';                {Do not translate}
    end;
  end;
  SendCmd('MODE ' + s, [200, 500]);  {Do not translate}
  { TODO: Needs to be finished }
end;

destructor TIdFTP.Destroy;
begin
  FreeAndNil(FListResult);
  FreeAndNil(FLoginMsg);
  FreeAndNil(FDirectoryListing);
  FreeAndNIL(FProxySettings); //APR
  inherited Destroy;
end;

function TIdFTP.Quote(const ACommand: String): SmallInt;
begin
  result := SendCmd(ACommand);
end;

//APR 011216: ftp proxy support
// TODO: need help - "//?"
procedure TIdFTP.Login;
begin
  case ProxySettings.ProxyType of
  fpcmNone:
    begin
      if SendCmd('USER ' + FUserName, [230, 331]) = 331 then begin   {Do not translate}
        SendCmd('PASS ' + FPassword, 230);                           {Do not translate}
      end;
    end;//fpcmNone
  fpcmUserSite:
    begin
      if (Length(ProxySettings.UserName)>0) then begin
        if SendCmd('USER ' + ProxySettings.UserName, [230, 331]) = 331 then begin  {Do not translate}
          SendCmd('PASS ' + ProxySettings.Password, 230);             {Do not translate}
        end;
      end;//proxy login
      if SendCmd('USER ' + FUserName+'@'+FHost, [230, 331]) = 331 then begin     {Do not translate}
        SendCmd('PASS ' + FPassword, 230);                       {Do not translate}
      end;
    end;//fpcmUserSite
  fpcmSite:
    begin
      if (Length(ProxySettings.UserName)>0) then begin
        if SendCmd('USER ' + ProxySettings.UserName, [230, 331]) = 331 then begin  {Do not translate}
          SendCmd('PASS ' + ProxySettings.Password, 230);  {Do not translate}
        end;
      end;//proxy login
      SendCmd('SITE '+FHost);//? Server Reply? 220?
      if SendCmd('USER ' + FUserName, [230, 331]) = 331 then begin {Do not translate}
        SendCmd('PASS ' + FPassword, 230);    {Do not translate}
      end;
    end;//fpcmSite
  fpcmOpen:
    begin
      if (Length(ProxySettings.UserName)>0) then begin
        if SendCmd('USER ' + ProxySettings.UserName, [230, 331]) = 331 then begin   {Do not translate}
          SendCmd('PASS ' + ProxySettings.Password, 230);   {Do not translate}
        end;
      end;//proxy login
      SendCmd('OPEN '+FHost);//? Server Reply? 220?     {Do not translate}
      if SendCmd('USER ' + FUserName, [230, 331]) = 331 then begin  {Do not translate}
        SendCmd('PASS ' + FPassword, 230);         {Do not translate}
      end;
    end;//fpcmSite
  fpcmUserPass: //USER user@firewalluser@hostname / PASS pass@firewallpass
    begin
      if SendCmd(Format('USER %s@%s@%s',[FUserName,ProxySettings.UserName,FHost]), [230, 331])=331 then begin    {Do not translate}
        if Length(ProxySettings.Password)>0 then begin
          SendCmd('PASS '+FPassword+'@'+ProxySettings.Password, 230); {Do not translate}
        end
        else begin
          SendCmd('PASS '+FPassword, 230); {Do not translate}
        end;//if @
      end;
    end;//fpcmUserPass
  fpcmTransparent: //? +Host
    begin
      if (Length(ProxySettings.UserName)>0) then begin
        if SendCmd('USER ' + ProxySettings.UserName, [230, 331]) = 331 then begin    {Do not translate}
          SendCmd('PASS ' + ProxySettings.Password, 230);     {Do not translate}
        end;
      end;//proxy login
      if SendCmd('USER ' + FUserName, [230, 331]) = 331 then begin   {Do not translate}
        SendCmd('PASS ' + FPassword, 230);  {Do not translate}
      end;
    end;//fpcmTransparent
  fpcmHttpProxyWithFtp:
    begin
{GET ftp://XXX:[e-mail]/ HTTP/1.0
Host: indy.nevrona.com
User-Agent: Mozilla/4.0 (compatible; Wincmd; Windows NT)
Proxy-Authorization: Basic B64EncodedUserPass==
Connection: close}
      raise EIdException.Create(RSSocksServerCommandError);
    end;//fpcmHttpProxyWithFtp
  end;//case
  FLoginMsg.Assign(LastCmdResult);
  SendTransferType;
End;//TIdFTP.Login

procedure TIdFTP.DoAfterLogin;
begin
  if Assigned(FOnAfterClientLogin) then begin
    OnAfterClientLogin(self);
  end;
end;

procedure TIdFTP.DoFTPList;
begin
  if Assigned(FOnCreateFTPList) then begin
    FOnCreateFTPList(self, FDirectoryListing);
  end;
end;

procedure TIdFTP.DoCheckListFormat(const ALine: String);
Var
  LListFormat: TIdFTPListFormat;
Begin
  if Assigned(FOnCheckListFormat) then begin //APR: User always right!
    LListFormat := FDirectoryListing.ListFormat; //APR: user MUST see Indy opinion
    OnCheckListFormat(Self, ALine, LListFormat);
    FDirectoryListing.ListFormat := LListFormat;
  end;
End;//TIdFTP.DoCheckListFormat

function TIdFTP.GetDirectoryListing: TIdFTPListItems;
begin
  if not Assigned(FDirectoryListing) then begin
    try
      ConstructDirListing;
    except
      on EAccessViolation do ConstructDirListing;
    end;
    // Parse directory listing
    if FListResult.Count > 0 then begin
      FDirectoryListing.ListFormat := FDirectoryListing.CheckListFormat(FListResult[0],TRUE);//APR: TRUE for IndyCheck, else always Unknown
      DoCheckListFormat(FListResult[0]);
      FDirectoryListing.LoadList(FListResult);
    end;
  end;
  Result := FDirectoryListing;
end;

function TIdFTP.GetOnParseCustomListFormat: TIdOnParseCustomListFormat;
begin
  Result := DirectoryListing.OnParseCustomListFormat
end;

procedure TIdFTP.SetOnParseCustomListFormat(const AValue: TIdOnParseCustomListFormat);
begin
  DirectoryListing.OnParseCustomListFormat := AValue;
end;

procedure TIdFTP.SetProxySettings(const Value: TIdFtpProxySettings);
Begin
  FProxySettings.Assign(Value);
End;//

{ TIdFtpProxySettings }

procedure TIdFtpProxySettings.Assign(Source: TPersistent);
Begin
  if Source is TIdFtpProxySettings then begin
    with TIdFtpProxySettings(Source) do begin
      SELF.FProxyType  := ProxyType;
      SELF.FHost := Host;
      SELF.FUserName := UserName;
      SELF.FPassword := Password;
      SELF.FPort := Port;
    end;
  end
  else begin
    inherited Assign(Source);
  end;
End;//


end.