ftpsend.pas

snmp设计增加相应SNMP的OID,是实时处理的.

  FFWPort := cFtpProtocol;
  FFWUsername := '';
  FFWPassword := '';
  FFWMode := 0;
  FBinaryMode := True;
  FAutoTLS := False;
  FFullSSL := False;
  FIsTLS := False;
  FIsDataTLS := False;
  FTLSonData := True;
end;

destructor TFTPSend.Destroy;
begin
  FDSock.Free;
  FSock.Free;
  FFTPList.Free;
  FDataStream.Free;
  FFullResult.Free;
  inherited Destroy;
end;

procedure TFTPSend.DoStatus(Response: Boolean; const Value: string);
begin
  if assigned(OnStatus) then
    OnStatus(Self, Response, Value);
end;

function TFTPSend.ReadResult: Integer;
var
  s, c: string;
begin
  FFullResult.Clear;
  c := '';
  repeat
    s := FSock.RecvString(FTimeout);
    if c = '' then
      if length(s) > 3 then
        if s[4] in [' ', '-'] then
          c :=Copy(s, 1, 3);
    FResultString := s;
    FFullResult.Add(s);
    DoStatus(True, s);
    if FSock.LastError <> 0 then
      Break;
  until (c <> '') and (Pos(c + ' ', s) = 1);
  Result := StrToIntDef(c, 0);
  FResultCode := Result;
end;

function TFTPSend.FTPCommand(const Value: string): integer;
begin
  FSock.SendString(Value + CRLF);
  DoStatus(False, Value);
  Result := ReadResult;
end;

// based on idea by Petr Esner <[e-mail]>
function TFTPSend.Auth(Mode: integer): Boolean;
const
  //if not USER <username> then
  //  if not PASS <password> then
  //    if not ACCT <account> then ERROR!
  //OK!
  Action0: TLogonActions =
    (0, FTP_OK, 3,
     1, FTP_OK, 6,
     2, FTP_OK, FTP_ERR,
     0, 0, 0, 0, 0, 0, 0, 0, 0);

  //if not USER <FWusername> then
  //  if not PASS <FWPassword> then ERROR!
  //if SITE <FTPServer> then ERROR!
  //if not USER <username> then
  //  if not PASS <password> then
  //    if not ACCT <account> then ERROR!
  //OK!
  Action1: TLogonActions =
    (3, 6, 3,
     4, 6, FTP_ERR,
     5, FTP_ERR, 9,
     0, FTP_OK, 12,
     1, FTP_OK, 15,
     2, FTP_OK, FTP_ERR);

  //if not USER <FWusername> then
  //  if not PASS <FWPassword> then ERROR!
  //if USER <UserName>'@'<FTPServer> then OK!
  //if not PASS <password> then
  //  if not ACCT <account> then ERROR!
  //OK!
  Action2: TLogonActions =
    (3, 6, 3,
     4, 6, FTP_ERR,
     6, FTP_OK, 9,
     1, FTP_OK, 12,
     2, FTP_OK, FTP_ERR,
     0, 0, 0);

  //if not USER <FWusername> then
  //  if not PASS <FWPassword> then ERROR!
  //if not USER <username> then
  //  if not PASS <password> then
  //    if not ACCT <account> then ERROR!
  //OK!
  Action3: TLogonActions =
    (3, 6, 3,
     4, 6, FTP_ERR,
     0, FTP_OK, 9,
     1, FTP_OK, 12,
     2, FTP_OK, FTP_ERR,
     0, 0, 0);

  //OPEN <FTPserver>
  //if not USER <username> then
  //  if not PASS <password> then
  //    if not ACCT <account> then ERROR!
  //OK!
  Action4: TLogonActions =
    (7, 3, 3,
     0, FTP_OK, 6,
     1, FTP_OK, 9,
     2, FTP_OK, FTP_ERR,
     0, 0, 0, 0, 0, 0);

  //if USER <UserName>'@'<FTPServer> then OK!
  //if not PASS <password> then
  //  if not ACCT <account> then ERROR!
  //OK!
  Action5: TLogonActions =
    (6, FTP_OK, 3,
     1, FTP_OK, 6,
     2, FTP_OK, FTP_ERR,
     0, 0, 0, 0, 0, 0, 0, 0, 0);

  //if not USER <FWUserName>@<FTPServer> then
  //  if not PASS <FWPassword> then ERROR!
  //if not USER <username> then
  //  if not PASS <password> then
  //    if not ACCT <account> then ERROR!
  //OK!
  Action6: TLogonActions =
    (8, 6, 3,
     4, 6, FTP_ERR,
     0, FTP_OK, 9,
     1, FTP_OK, 12,
     2, FTP_OK, FTP_ERR,
     0, 0, 0);

  //if USER <UserName>@<FTPServer> <FWUserName> then ERROR!
  //if not PASS <password> then
  //  if not ACCT <account> then ERROR!
  //OK!
  Action7: TLogonActions =
    (9, FTP_ERR, 3,
     1, FTP_OK, 6,
     2, FTP_OK, FTP_ERR,
     0, 0, 0, 0, 0, 0, 0, 0, 0);

  //if not USER <UserName>@<FWUserName>@<FTPServer> then
  //  if not PASS <Password>@<FWPassword> then
  //    if not ACCT <account> then ERROR!
  //OK!
  Action8: TLogonActions =
    (10, FTP_OK, 3,
     11, FTP_OK, 6,
     2, FTP_OK, FTP_ERR,
     0, 0, 0, 0, 0, 0, 0, 0, 0);
var
  FTPServer: string;
  LogonActions: TLogonActions;
  i: integer;
  s: string;
  x: integer;
begin
  Result := False;
  if FFWHost = '' then
    Mode := 0;
  if (FTargetPort = cFtpProtocol) or (FTargetPort = '21') then
    FTPServer := FTargetHost
  else
    FTPServer := FTargetHost + ':' + FTargetPort;
  case Mode of
    -1:
      LogonActions := CustomLogon;
    1:
      LogonActions := Action1;
    2:
      LogonActions := Action2;
    3:
      LogonActions := Action3;
    4:
      LogonActions := Action4;
    5:
      LogonActions := Action5;
    6:
      LogonActions := Action6;
    7:
      LogonActions := Action7;
    8:
      LogonActions := Action8;
  else
    LogonActions := Action0;
  end;
  i := 0;
  repeat
    case LogonActions[i] of
      0:  s := 'USER ' + FUserName;
      1:  s := 'PASS ' + FPassword;
      2:  s := 'ACCT ' + FAccount;
      3:  s := 'USER ' + FFWUserName;
      4:  s := 'PASS ' + FFWPassword;
      5:  s := 'SITE ' + FTPServer;
      6:  s := 'USER ' + FUserName + '@' + FTPServer;
      7:  s := 'OPEN ' + FTPServer;
      8:  s := 'USER ' + FFWUserName + '@' + FTPServer;
      9:  s := 'USER ' + FUserName + '@' + FTPServer + ' ' + FFWUserName;
      10: s := 'USER ' + FUserName + '@' + FFWUserName + '@' + FTPServer;
      11: s := 'PASS ' + FPassword + '@' + FFWPassword;
    end;
    x := FTPCommand(s);
    x := x div 100;
    if (x <> 2) and (x <> 3) then
      Exit;
    i := LogonActions[i + x - 1];
    case i of
      FTP_ERR:
        Exit;
      FTP_OK:
        begin
          Result := True;
          Exit;
        end;
    end;
  until False;
end;


function TFTPSend.Connect: Boolean;
begin
  FSock.CloseSocket;
  FSock.Bind(FIPInterface, cAnyPort);
{$IFDEF STREAMSEC}
  if FFullSSL then
  begin
    if assigned(FTLSServer) then
      FSock.TLSServer := FTLSServer
    else
    begin
      result := False;
      Exit;
    end;
  end
  else
    FSock.TLSServer := nil;
{$ELSE}
  if FFullSSL then
    FSock.SSLEnabled := True;
{$ENDIF}
  if FSock.LastError = 0 then
    if FFWHost = '' then
      FSock.Connect(FTargetHost, FTargetPort)
    else
      FSock.Connect(FFWHost, FFWPort);
  Result := FSock.LastError = 0;
end;

function TFTPSend.Login: Boolean;
var
  x: integer;
begin
  Result := False;
  FCanResume := False;
  if not Connect then
    Exit;
  FIsTLS := FFullSSL;
  FIsDataTLS := False;
  repeat
    x := ReadResult div 100;
  until x <> 1;
  if x <> 2 then
    Exit;
  if FAutoTLS and not(FIsTLS) then
    if (FTPCommand('AUTH TLS') div 100) = 2 then
    begin
{$IFDEF STREAMSEC}
      if Assigned(FTLSServer) then
      begin
        Fsock.TLSServer := FTLSServer;
        Fsock.Connect('','');
        FIsTLS := FSock.LastError = 0;
      end;
{$ELSE}
      FSock.SSLDoConnect;
      FIsTLS := FSock.LastError = 0;
      FDSock.SSLCertificateFile := FSock.SSLCertificateFile;
      FDSock.SSLPrivateKeyFile := FSock.SSLPrivateKeyFile;
      FDSock.SSLCertCAFile := FSock.SSLCertCAFile;
{$ENDIF}
      if not FIsTLS then
      begin
        Result := False;
        Exit;
      end;
    end;
  if not Auth(FFWMode) then
    Exit;
  if FIsTLS then
  begin
    FTPCommand('PBSZ 0');
    if FTLSonData then
      FIsDataTLS := (FTPCommand('PROT P') div 100) = 2;
    if not FIsDataTLS then
      FTPCommand('PROT C');
  end;
  FTPCommand('TYPE I');
  FTPCommand('STRU F');
  FTPCommand('MODE S');
  if FTPCommand('REST 0') = 350 then
    if FTPCommand('REST 1') = 350 then
    begin
      FTPCommand('REST 0');
      FCanResume := True;
    end;
  Result := True;
end;

function TFTPSend.Logout: Boolean;
begin
  Result := (FTPCommand('QUIT') div 100) = 2;
  FSock.CloseSocket;
end;

procedure TFTPSend.ParseRemote(Value: string);
var
  n: integer;
  nb, ne: integer;
  s: string;
  x: integer;
begin
  Value := trim(Value);
  nb := Pos('(',Value);
  ne := Pos(')',Value);
  if (nb = 0) or (ne = 0) then
  begin
    nb:=RPos(' ',Value);
    s:=Copy(Value, nb + 1, Length(Value) - nb);
  end
  else
  begin
    s:=Copy(Value,nb+1,ne-nb-1);
  end;
  for n := 1 to 4 do
    if n = 1 then
      FDataIP := Fetch(s, ',')
    else
      FDataIP := FDataIP + '.' + Fetch(s, ',');
  x := StrToIntDef(Fetch(s, ','), 0) * 256;
  x := x + StrToIntDef(Fetch(s, ','), 0);
  FDataPort := IntToStr(x);
end;

procedure TFTPSend.ParseRemoteEPSV(Value: string);
var
  n: integer;
  s, v: string;
begin
  s := SeparateRight(Value, '(');
  s := Trim(SeparateLeft(s, ')'));
  Delete(s, Length(s), 1);
  v := '';
  for n := Length(s) downto 1 do
    if s[n] in ['0'..'9'] then
      v := s[n] + v
    else
      Break;
  FDataPort := v;
  FDataIP := FTargetHost;
end;

function TFTPSend.DataSocket: boolean;
var
  s: string;
begin
  Result := False;
  if FPassiveMode then
  begin
    if FSock.IP6used then
      s := '2'
    else
      s := '1';
    if not(FForceOldPort) and ((FTPCommand('EPSV ' + s) div 100) = 2) then
    begin
      ParseRemoteEPSV(FResultString);
    end
    else
      if FSock.IP6used then
        Exit
      else
      begin
        if (FTPCommand('PASV') div 100) <> 2 then
          Exit;
        ParseRemote(FResultString);
      end;
    FDSock.CloseSocket;
    FDSock.Bind(FIPInterface, cAnyPort);
    FDSock.Connect(FDataIP, FDataPort);
    Result := FDSock.LastError = 0;
  end
  else
  begin
    FDSock.CloseSocket;
    if FForceDefaultPort then
      s := cFtpDataProtocol
    else
      s := '0';
    //data conection from same interface as command connection
    FDSock.Bind(FSock.GetLocalSinIP, s);
    if FDSock.LastError <> 0 then
      Exit;
    FDSock.SetLinger(True, 10);
    FDSock.Listen;
    FDSock.GetSins;
    FDataIP := FDSock.GetLocalSinIP;
    FDataIP := FDSock.ResolveName(FDataIP);
    FDataPort := IntToStr(FDSock.GetLocalSinPort);
    if not FForceOldPort then
    begin
      if IsIp6(FDataIP) then
        s := '2'
      else
        s := '1';
      s := 'EPRT |' + s +'|' + FDataIP + '|' + FDataPort + '|';
      Result := (FTPCommand(s) div 100) = 2;
    end;
    if not Result and IsIP(FDataIP) then
    begin
      s := ReplaceString(FDataIP, '.', ',');
      s := 'PORT ' + s + ',' + IntToStr(FDSock.GetLocalSinPort div 256)
        + ',' + IntToStr(FDSock.GetLocalSinPort mod 256);
      Result := (FTPCommand(s) div 100) = 2;
    end;
  end;
end;

function TFTPSend.AcceptDataSocket: Boolean;
var
  x: TSocket;
begin
  if FPassiveMode then
    Result := True
  else
  begin
    Result := False;
    if FDSock.CanRead(FTimeout) then
    begin
      x := FDSock.Accept;
      if not FDSock.UsingSocks then
        FDSock.CloseSocket;
      FDSock.Socket := x;
      Result := True;
    end;
  end;
  if Result and FIsDataTLS then
  begin
{$IFDEF STREAMSEC}
    if Assigned(FTLSServer) then
    begin
      FDSock.TLSServer := FTLSServer;
      FDSock.Connect('','');
      Result := FDSock.LastError = 0;
    end
    else
      Result := False;
{$ELSE}
    FDSock.SSLDoConnect;
    Result := FDSock.LastError = 0;
{$ENDIF}
  end;
end;

function TFTPSend.DataRead(const DestStream: TStream): Boolean;
var
  x: integer;
begin
  Result := False;
  try
    if not AcceptDataSocket then
      Exit;
    FDSock.RecvStreamRaw(DestStream, FTimeout);
    FDSock.CloseSocket;
    x := ReadResult;
    Result := (x div 100) = 2;
  finally
    FDSock.CloseSocket;