{ +-------------------------------------------------------------+ }
{ |                                                             | }
{ |   GM-Software                                               | }
{ |   ===========                                               | }
{ |                                                             | }
{ |   Project: All Projects                                     | }
{ |                                                             | }
{ |   Description: Implementation of the FTP protocol.          | }
{ |                                                             | }
{ |                                                             | }
{ |   Copyright (C) - 2012 - Gerrit Moeller.                    | }
{ |                                                             | }
{ |   Source code distributed under MIT license.                | }
{ |                                                             | }
{ |   See: https://www.gm-software.de                           | }
{ |                                                             | }
{ +-------------------------------------------------------------+ }

{$INCLUDE GMCompilerSettings.inc}

unit GMFtp;

interface

uses {$IFDEF JEDIAPI}{$ELSE}Windows,{$ENDIF}
     GMActiveX, GMStrDef, GMCollections, GMIntf, GMCommon, GMSockets, GMSocketAPI, GMINetBase
     {$IFDEF TLS_SUPPORT},GMOpenSSL{$ENDIF}; 

const

  cDfltFtpPort = '21';
  cFtpProtocol = 'ftp';
  {$IFDEF TLS_SUPPORT}
  cFtpsProtocol = 'ftps';
  {$ENDIF}
  cFtpNotLoggedInCode = '530';


type

  PGMFtpLoginData = ^TGMFtpLoginData;
  TGMFtpLoginData = record
    UserName: PGMChar;
    Password: PGMChar;
    Account: PGMChar;
  end;

  IGMGetFtpLoginData = interface(IUnknown)
    ['{27622CAC-876C-460F-B94F-2BF8A4D48207}']
    function GetFtpLoginData(LoginData: PGMFtpLoginData): HResult; stdcall;
  end;


  RGMFtpConnectStateData = record
   Protocol, Host, Port, User, Pwd, Account: TGMString;
  end;


  TGMFtpClient = class;

  IGMFtpClient = interface(IUnknown)
    ['{D87BC86F-1718-4B6D-8978-EE59A8355223}']
    function Obj: TGMFtpClient;
  end;

  TFtpListCmd = (flcLIST, flcMLSD);

  TGMFtpClient = class(TGMINetProtocolBase, IGMFtpClient)
   protected
    FAskCanceled: IUnknown;
    FAskLoginData: IGMGetFtpLoginData;
    FUseIP6Address: Boolean;
//  FPassiveMode: Boolean;
    FLocalDataConnectionPort: TGMString;
    FCmdConnection: IGMSocket;
    FDataSocket: IGMSocket;
    FDataConnection: IGMSocketIO;
    FCmdStream: ISequentialStream;
    FExecCmdStrRecurseLevel: LongInt;
//  FRootDir: AnsiString;
    FCurrentConnState: RGMFtpConnectStateData;
    FKeepDataConnection: Boolean;
    {$IFDEF TLS_SUPPORT}
    FCmdTlsNegotiated: Boolean;
    FUseSecureDataConnections: Boolean;
    FCertMessageEmitter: IUnknown;
    {$ENDIF}

    procedure AcceptDataConnection;
    procedure PrepareDataConnection;

    function ExceptClassForCode(const ACode: AnsiString): TGMINetExceptionClass; override;

    function PreparePath(const APath: TGMString): AnsiString;
    function ExecCommandWithRetry(const ACommand, ASuccessCodes: AnsiString; const AShowTrace: Boolean = True): TCmdResponse;
    function ExecDataCommandStr(ACommand, ASuccessCodes: AnsiString): TCmdResponse;
    {$IFDEF TLS_SUPPORT}
    function CertMessageEmitter: IUnknown;
    procedure ExecuteTLSNegotiation;
    {$ENDIF}

   public
    constructor Create(const ARefLifeTime: Boolean = True); overload; override;
    constructor Create(//const APassiveMode: Boolean;
                       const ALocalDataConnectionPort: TGMString; // <- empty string => passive mode
                       const AAskCanceled, AAskLoginData: IUnknown; const ARefLifeTime: Boolean = True); reintroduce; overload;
    destructor Destroy; override;
    function Obj: TGMFtpClient;

    function ProtocolDisplayName: TGMString; override;
    procedure Connect(AProtocol, AHost: TGMString; APort: TGMString = cDfltFtpPort);
    procedure Login(const AUsername, APassword: TGMString; const AAccount: TGMString = '');
    procedure Logout;
    procedure Disconnect(const ALogout: Boolean = True);
    function GetCurrentDir: AnsiString;
    procedure Quit;
    function PassiveMode: Boolean;
    {$IFDEF TLS_SUPPORT}
    function UseTls: Boolean;
//  procedure ShowCertificateVerifyStatus(const AHost: TGMString; const ACertCode: Int64);
    {$ENDIF}

    procedure List(const AListCmd: TFtpListCmd; const AEnumSink: IUnknown; const APath: AnsiString = ''; const AEnumParam: Pointer = nil;  const AEnumItemKind: LongInt = 0);
    function GetUploadStream(const AFilePath: TGMString): IStream;
    function GetDownloadStream(const AFilePath: TGMString): IStream;
    procedure CreateDirectory(const ADirPath: TGMString);
    procedure DeleteDirectory(const ADirPath: TGMString);
    procedure DeleteFile(const AFilePath: TGMString);
    procedure ChangeDirectory(const ADirPath: TGMString);
    procedure ChangeDirUp;
    procedure SetLastModTime(const AFileOrFolderPath: TGMString; const ALstModUTC: TDateTime);
    procedure RenameEntry(const AExistingNamePath, ANewNamePath: TGMString);

    property CmdStream: ISequentialStream read FCmdStream;
  end;


  TFtpDataStream = class(TGMSocketStream)
   protected
    FGMFtpClient: IGMFtpClient;
    FSuccessCodes: TGMString;
    //FCommand: TGMString;
   public
    constructor Create(const AGMFtpClient: IGMFtpClient; const ASuccessCodes: TGMString = '2'; const AMode: LongWord = STGM_READ or STGM_WRITE; const AName: UnicodeString = ''; const ARefLifeTime: Boolean = True); reintroduce;
    destructor Destroy; override;
  end;


  TFptRecursiveDeleter = class(TGMRefCountedObj, IGMTellEnumIntf)
   public
    constructor DeleteAllEntries(const AGMFtpClient: IGMFtpClient; const APath: TGMString; const AListCmd: TFtpListCmd; const ARefLifeTime: Boolean = True);
    procedure TellEnumIntf(const ASender: IUnknown; const AItemKind: LongInt; const AValue: IUnknown; const AParameter: Pointer); stdcall;
  end;


  EGMFtpException = class(EGMINetException);
  EGMFtpNotLoggedIn = class(EGMFtpException);


function FtpTimeValToDateTime(const AFtpDateTime: TGMString): TDateTime;
function FtpTimeValFromDateTime(const ADateTime: TDateTime): TGMString;

function GMInitFtpConnectStateData(const AProtocol, AHost, APort, AUser, APwd, AAccount: TGMString): RGMFtpConnectStateData;

//procedure FptDeleteRecursive(const AGMFtpClient: IGMFtpClient; const APath: TGMString; const AListCmd: TFtpListCmd; const ARefLifeTime: Boolean = True);


const

  cFtpDirSeparator = '/';

  cFtpListCmd: array [TFtpListCmd] of AnsiString = ('LIST', 'MLSD');

  cFtpFactName = 'Name';
  cFtpFactType = 'Type';
  cFtpFactSize = 'Size';
  cFtpFactModify = 'Modify';
  cFtpFactUnique = 'Unique';

  cFtpTypeFile = 'File';
  cFtpTypeFolder = 'Dir';


implementation

uses {$IFDEF JEDIAPI}{$IFNDEF FPC}jwaWinBase, jwaWinType,{$ENDIF}{$ENDIF} SysUtils, TypInfo;


resourcestring

  RStrTheFtpCtrlConnection = 'The FTP control connection';
  RStrPasswordRequired = 'Password required for FTP login';
  RStrAccountRequired = 'Account required for FTP login';
  RStrInvalidPASVResponse = 'Invalid response to FTP PASV command: %s';
  RStrListKindNotImplementedFmt = 'List kind "%s" not implemented';
  RStrInvalidFactFmt = 'Invalid FTP MLSD fact: %s';
  RStrTheDataConnection = 'The FTP data connection';
  RStrTheFtpSession = 'The FTP session';
//RStrTheDataStream = 'The FTP data stream';
  RStrReceivingDataTransferResult = 'Receiving data transfer Result';


{ ------------------------- }
{ ---- Global Routines ---- }
{ ------------------------- }

function ParsePASVResponse(const AResponse: TGMString; const ACaller: TObject): IGMSocketAddress;
var chPos, i: PtrInt; port: u_short; ipAddress: TGMIPAddrUnion;
  function NextNumber(var AChPos: PtrInt; const AValue: TGMString): LongInt;
  begin
    Result := GMStrToInt(GMMakeDezInt(GMNextWord(AChPos, AValue, ','), -1));
    if not GMIsInRange(Result, 0, 255) then raise EGMFtpException.ObjError(GMFormat(RStrInvalidPASVResponse, [AValue]), ACaller, {$I %CurrentRoutine%});
    if AChPos > Length(AValue) then raise EGMFtpException.ObjError(GMFormat(RStrInvalidPASVResponse, [AValue]), ACaller, {$I %CurrentRoutine%});
  end;
  function LastNumber(const AChPos: LongInt; const AValue: TGMString): LongInt;
  begin
    Result := GMStrToInt(GMMakeDezInt(Copy(AValue, AChPos, Length(AValue)-AChPos+1), -1));
    if not GMIsInRange(Result, 0, 255) then raise EGMFtpException.ObjError(GMFormat(RStrInvalidPASVResponse, [AValue]), ACaller, {$I %CurrentRoutine%});
  end;
begin
  FillByte(ipAddress, SizeOf(ipAddress), 0);

  ipAddress.AddressFamily := AF_INET;

  chPos:=1;
  while (chPos <= Length(AResponse)) and not GMIsDigit(AResponse[chPos]) do Inc(chPos);

  for i:=Low(ipAddress.IP4Addr.s_b_Arr.s_bArr) to High(ipAddress.IP4Addr.s_b_Arr.s_bArr) do
   ipAddress.IP4Addr.s_b_Arr.s_bArr[i] := NextNumber(chPos, AResponse);

  port := NextNumber(chPos, AResponse) shl 8;
  port := port or LastNumber(chPos, AResponse);
  ipAddress.IP4Port := GMSocketAPI.htons(port);

  Result := TGMIPSocketAddress.CreateFromIPAddress(ipAddress);
end;

procedure ParseMLSDLine(const ALine: AnsiString; const AAttributes: IGMIntfCollection; const ACaller: TObject);
var pstart, pend: PAnsiChar;
  procedure AddFact(const AFact: AnsiString);
  var sep: PAnsiChar;
  begin
    sep := GMStrLScanA(PAnsiChar(AFact), '=', Length(AFact));
    if sep = nil then raise EGMFtpException.ObjError(GMFormat(RStrInvalidFactFmt, [AFact]), ACaller, {$I %CurrentRoutine%});
    AAttributes.Add(TGMNameAndStrValueObj.Create(Copy(AFact, 1, sep - PAnsiChar(AFact)),
        Copy(AFact, sep - PAnsiChar(AFact) + 2, Length(AFact) - (sep - PAnsiChar(AFact)) - 1)));
  end;
begin
  if (Length(ALine) <= 0) or (AAttributes = nil) then Exit;
  pstart := PAnsiChar(ALine);
  repeat
   pend := GMStrLScanA(pstart, ';', Length(ALine) - (pstart - PAnsiChar(ALine)));
   if pend <> nil then
    begin
     AddFact(Copy(ALine, pstart - PAnsiChar(ALine) + 1, pend - pstart));
     Inc(pend);
     pstart := pend;
    end;
  until pend = nil;

  AAttributes.Add(TGMNameAndStrValueObj.Create(cFtpFactName, GMUtf8ToString(Copy(ALine, pstart - PAnsiChar(ALine) + 2, Length(ALine) - (pstart - PAnsiChar(ALine)) - 1))));
end;

function FtpTimeValToDateTime(const AFtpDateTime: TGMString): TDateTime;
var tm: TSystemTime; secFrac: TGMString;
begin
  FillByte(tm, SizeOf(tm), 0);

  tm.wYear := GMStrToInt(Copy(AFtpDateTime, 1, 4));
  tm.wMonth := GMStrToInt(Copy(AFtpDateTime, 5, 2));
  tm.wDay := GMStrToInt(Copy(AFtpDateTime, 7, 2));
  tm.wHour := GMStrToInt(Copy(AFtpDateTime, 9, 2));
  tm.wMinute := GMStrToInt(Copy(AFtpDateTime, 11, 2));
  tm.wSecond := GMStrToInt(Copy(AFtpDateTime, 13, 2));

  secFrac := Copy(AFtpDateTime, 16, 3);
  if Length(secFrac) > 0 then
   begin
    while Length(secFrac) < 3 do  secFrac := secFrac + '0';
    tm.wMilliseconds := GMStrToInt(secFrac);
   end;

  Result := SystemTimeToDateTime(tm);
end;

function FtpTimeValFromDateTime(const ADateTime: TDateTime): TGMString;
var tm: TSystemTime;
begin
  DateTimeToSystemTime(ADateTime, tm);
  Result := GMFormat('%.4d%.2d%.2d%.2d%.2d%.2d', [tm.wYear, tm.wMonth, tm.wDay, tm.wHour, tm.wMinute, tm.wSecond]);
  if tm.wMilliseconds <> 0 then Result := Result + '.' + GMFormat('%.3d', [tm.wMilliseconds]);
end;

function GMInitFtpConnectStateData(const AProtocol, AHost, APort, AUser, APwd, AAccount: TGMString): RGMFtpConnectStateData;
begin
  Result.Protocol := AProtocol;
  Result.Host := AHost;
  Result.Port := APort;
  Result.User := AUser;
  Result.Pwd := APwd;
  Result.Account := AAccount;
end;


{ ------------------------------ }
{ ---- TFptRecursiveDeleter ---- }
{ ------------------------------ }

constructor TFptRecursiveDeleter.DeleteAllEntries(const AGMFtpClient: IGMFtpClient; const APath: TGMString; const AListCmd: TFtpListCmd;
  const ARefLifeTime: Boolean);
  procedure LocalDeleteAllEntries(const APath: TGMString);
  var entries, attributes: IGMIntfCollection; it: IGMIterator; unkEntry: IUnknown;
      searchAttr, unkAttr: IUnknown; getStrValue: IGMGetStringValue; name: TGMString;
  begin
    entries := TGMIntfArrayCollection.Create(True, False, nil, True);
    AGMFtpClient.Obj.List(AListCmd, Self, APath, Pointer(entries));
    it := entries.CreateIterator;
    while it.NextEntry(unkEntry) do
     if GMQueryInterface(unkEntry, IGMIntfCollection, attributes) then
      begin
       searchAttr := TGMNameObj.Create(cFtpFactName, True);
       if attributes.Find(searchAttr, unkAttr) and GMQueryInterface(unkAttr, IGMGetStringValue, getStrValue) then
          name := getStrValue.StringValue else name := '';

       if Length(name) > 0 then
        begin
         searchAttr := TGMNameObj.Create(cFtpFactType, True);
         if attributes.Find(searchAttr, unkAttr) and GMQueryInterface(unkAttr, IGMGetStringValue, getStrValue) then
           if GMSameText(getStrValue.StringValue, cFtpTypeFile) then AGMFtpClient.Obj.DeleteFile(GMAppendPath(APath, name, cFtpDirSeparator))
           else
           if GMSameText(getStrValue.StringValue, cFtpTypeFolder) then
            begin
             LocalDeleteAllEntries(GMAppendPath(APath, name, cFtpDirSeparator));
             AGMFtpClient.Obj.DeleteDirectory(GMAppendPath(APath, name, cFtpDirSeparator));
            end;
         end;
      end;
  end;
begin
  inherited Create(ARefLifeTime);
  if (Length(APath) > 0) and (AGMFtpClient <> nil) then LocalDeleteAllEntries(APath);
end;

procedure TFptRecursiveDeleter.TellEnumIntf(const ASender: IUnknown; const AItemKind: LongInt; const AValue: IUnknown; const AParameter: Pointer);
var collection, attributes: IGMIntfCollection;
begin
  if not GMQueryInterface(IUnknown(AParameter), IGMIntfCollection, collection) or
     not GMQueryInterface(AValue, IGMIntfCollection, attributes) then Exit;

  collection.Add(attributes);
end;

//procedure TFptRecursiveDeleter.TellEnumIntf(const ASender: IUnknown; const AItemKind: LongInt; const AValue, AParameter: IUnknown);
//var collection, attributes, attributesCopy: IGMIntfCollection; it: IGMIterator; unkEntry: IUnknown;
//begin
//if not GMQueryInterface(AParameter, IGMIntfCollection, collection) or
//   not GMQueryInterface(AValue, IGMIntfCollection, attributes) then Exit;
//
//attributesCopy := TGMIntfArrayCollection.Create(False, True, GMCompareByName, True);
//it := attributes.CreateIterator;
//while it.NextEntry(unkEntry) do attributesCopy.Add(unkEntry);
//collection.Add(attributesCopy);                                                   
//end;


{ ------------------------ }
{ ---- TFtpDataStream ---- }
{ ------------------------ }                                                                          

constructor TFtpDataStream.Create(const AGMFtpClient: IGMFtpClient; const ASuccessCodes: TGMString; const AMode: LongWord;
  const AName: UnicodeString; const ARefLifeTime: Boolean);
//var socketIO: IGMSocketIO;
begin
  GMCheckPointerAssigned(Pointer(AGMFtpClient), RStrTheFtpSession, Self);
//GMQueryInterface(AGMFtpClient.Obj.FDataConnection, IGMSocketIO, socketIO);
  inherited Create(AGMFtpClient.Obj.FDataConnection, AMode, AName, ARefLifeTime);
  FGMFtpClient := AGMFtpClient;
  FSuccessCodes := ASuccessCodes;
  //FCommand := ACommand;
end;

destructor TFtpDataStream.Destroy;
//var ftp: IGMFtpClient; successCodes: TGMString;
begin
  inherited Destroy;
  if FGMFtpClient <> nil then
   begin
    //
    // Release all refernces to the socket to close it which informs the server of the end of the data transfer
    //
    if not FGMFtpClient.Obj.FKeepDataConnection then
     begin
      FGMFtpClient.Obj.FDataConnection := nil;
      FGMFtpClient.Obj.FDataSocket := nil;
     end;
    FSocket := nil;
//  successCodes := FSuccessCodes;
//  ftp :=  FGMFtpClient;
//  FGMFtpClient := nil; FSuccessCodes := '';
    try
     // Never raise in destructors!   // FCommand
     FGMFtpClient.Obj.CheckCmdResponse(RStrReceivingDataTransferResult, FGMFtpClient.Obj.ReceiveCmdResponse(FGMFtpClient.Obj.CmdStream), FSuccessCodes, {$I %CurrentRoutine%});
    except
     vfGMHrExceptionHandler(ExceptObject, cDfltPrntWnd);
    end;
   end;
end;


{ ---------------------- }
{ ---- TGMFtpClient ---- }
{ ---------------------- }

constructor TGMFtpClient.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
//FPassiveMode := True;
  {$IFDEF TLS_SUPPORT}
  FUseSecureDataConnections := True;
  {$ENDIF}
end;
                              // const APassiveMode: Boolean
constructor TGMFtpClient.Create(const ALocalDataConnectionPort: TGMString; const AAskCanceled, AAskLoginData: IUnknown; const ARefLifeTime: Boolean);
begin
  Create(ARefLifeTime);
  FAskCanceled := AAskCanceled;
//FPassiveMode := APassiveMode;
  FLocalDataConnectionPort := GMStrip(ALocalDataConnectionPort);
  GMQueryInterface(AAskLoginData, IGMGetFtpLoginData, FAskLoginData);
end;

destructor TGMFtpClient.Destroy;
begin
  try Quit; except end; // <- never raise in destructors!
  inherited Destroy;
end;

function TGMFtpClient.Obj: TGMFtpClient;
begin
  Result := Self;
end;

function TGMFtpClient.ProtocolDisplayName: TGMString;
begin
  {$IFDEF TLS_SUPPORT}
  if FCmdTlsNegotiated then Result := GMUpperCase(cFtpsProtocol) else Result := GMUpperCase(cFtpProtocol);
  {$ELSE}
   Result := UpperCase(FCurrentConnState.Protocol);
  {$ENDIF}
end;

{$IFDEF TLS_SUPPORT}
function TGMFtpClient.UseTls: Boolean;
begin
  Result := GMSameText(FCurrentConnState.Protocol, cFtpsProtocol);
end;
{$ENDIF}

function TGMFtpClient.PassiveMode: Boolean;
begin
  Result := Length(FLocalDataConnectionPort) <= 0;
end;

function TGMFtpClient.ExceptClassForCode(const ACode: AnsiString): TGMINetExceptionClass;
begin
  if ACode = cFtpNotLoggedInCode then Result := EGMFtpNotLoggedIn else Result := EGMFtpException;
end;

function TGMFtpClient.PreparePath(const APath: TGMString): AnsiString;
begin
  Result := GMStringToUtf8(APath);
end;

{$IFDEF TLS_SUPPORT}
function TGMFtpClient.CertMessageEmitter: IUnknown;
begin
  if FCertMessageEmitter = nil then FCertMessageEmitter := TGMCertMessageEmitter.Create(FAskCanceled);
  Result := FCertMessageEmitter;
end;
{$ENDIF}

{$IFDEF TLS_SUPPORT}
procedure TGMFtpClient.ExecuteTLSNegotiation;
var tlsSocket: IGMSocketIO;
begin
  tlsSocket := GMAddTlsLayer(FCmdConnection, FCurrentConnState.Host, CertMessageEmitter);
  FCmdStream := TGMSocketStream.Create(tlsSocket);
  FCmdTlsNegotiated := True;
end;
{$ENDIF}

procedure TGMFtpClient.Connect(AProtocol, AHost, APort: TGMString);
var implicitTLS: Boolean;
begin
  if (Length(AProtocol) <= 0) then AProtocol := cFtpProtocol;
  if (Length(APort) <= 0) then APort := cDfltFtpPort;

  if not GMSameText(AProtocol, cFtpProtocol) {$IFDEF TLS_SUPPORT}and not GMSameText(AProtocol, cFtpsProtocol){$ENDIF} then
     raise EGMFtpException.ObjError(GMFormat(RStrUnsupportedINetProtocol, [AProtocol]), Self, {$I %CurrentRoutine%});

  if GMSameText(AProtocol, FCurrentConnState.Protocol) and GMSameText(AHost, FCurrentConnState.Host) and
     GMSameText(APort, FCurrentConnState.Port) then Exit;

  implicitTLS := APort = '990';

  Disconnect;

  FCmdConnection := TGMTcpSocket.Create(vDfltInetAddrFamily, FAskCanceled);
  FCmdConnection.Connect(AHost, APort);
  FCurrentConnState.Protocol := AProtocol;
  FCurrentConnState.Host := AHost;
  FCurrentConnState.Port := APort;

  FCmdStream := TGMSocketStream.Create(FCmdConnection);

  {$IFDEF TLS_SUPPORT}
  if implicitTLS then ExecuteTLSNegotiation;
  {$ENDIF}

  //CheckCmdResponse(ReceiveCmdResponse(CmdStream), '12', {$I %CurrentRoutine%});
  ExecCommandWithRetry('', '12'); // <- retrieve greeting message from server
end;

procedure TGMFtpClient.Disconnect(const ALogout: Boolean);
begin
  if ALogout then Quit;
  FDataConnection := nil;
  FDataSocket := nil;
  FCmdStream := nil;
  FCmdConnection := nil;
  {$IFDEF TLS_SUPPORT}
  FCmdTlsNegotiated := False;
  {$ENDIF}

  FCurrentConnState := GMInitFtpConnectStateData('', '', '', '', '', '');
end;

function TGMFtpClient.GetCurrentDir: AnsiString;
var cmDRes: TCmdResponse; line: AnsiString; pStart, pEnd: PAnsiChar; // pos1, pos2: LongInt;
begin
  Result := '';
  cmDRes := ExecCommandWithRetry('PWD', '2');
  line := cmDRes.Text[Low(cmDRes.Text)];

  pStart := GMStrLScanA(PAnsiChar(line), '"', Length(line));
  if pStart <> nil then
   begin
    Inc(pStart);
    pEnd := GMStrLScanA(pStart, '"', Length(line) - (pStart - PAnsiChar(line)));
    if pEnd <> nil then Result := Copy(line, pStart - PAnsiChar(line)+1, pEnd - pstart);
   end;

//pos1 := 1;
//while (pos1 <= Length(line)) and (line[pos1] <> '"') do Inc(pos1);
//if pos1 >= Length(line) then Exit;
//Inc(pos1);
//pos2 := pos1;
//while (pos2 <= Length(line)) and (line[pos2] <> '"') do Inc(pos2);
//Result := Copy(line, pos1, pos2 - pos1);
end;

procedure TGMFtpClient.Login(const AUsername, APassword, AAccount: TGMString);
var cmDRes: TCmdResponse; // {$IFDEF TLS_SUPPORT}tlsSocket: IGMSocketIO;{$ENDIF}
begin
  if GMSameText(AUsername, FCurrentConnState.User) and GMSameText(APassword, FCurrentConnState.Pwd) and
     GMSameText(AAccount, FCurrentConnState.Account) then Exit;

  {$IFDEF TLS_SUPPORT}
  if UseTls and not FCmdTlsNegotiated then
   begin
    ExecCommandWithRetry('AUTH TLS', '2');
    ExecuteTLSNegotiation;
   end;
  {$ENDIF}

  if Length(AUsername) > 0 then
   begin
    vfGMTrace(cStrCommand + ': ' + 'USER ' + cStrHidden, ProtocolDisplayName);
    cmDRes := ExecCommandWithRetry('USER ' + GMStringToUtf8(AUsername), '23', False);
    if cmDRes.Code[1] = '3' then // or (Length(APassword) > 0)
     begin
      if Length(APassword) <= 0 then raise EGMFtpException.ObjError(RStrPasswordRequired, Self, {$I %CurrentRoutine%});
      vfGMTrace(cStrCommand + ': ' + 'PASS ' + cStrHidden, ProtocolDisplayName);
      cmDRes := ExecCommandWithRetry('PASS ' + GMStringToUtf8(APassword), '23', False);
      if cmDRes.Code[1] = '3' then
       begin
        if Length(AAccount) <= 0 then raise EGMFtpException.ObjError(RStrAccountRequired, Self, {$I %CurrentRoutine%});
        ExecCommandWithRetry('ACCT ' + AAccount, '2');
       end;
     end;
    FCurrentConnState.User := AUsername;
    FCurrentConnState.Pwd := APassword;
    FCurrentConnState.Account := AAccount;
   end;

  {$IFDEF TLS_SUPPORT}
  if UseTls and FUseSecureDataConnections then
   begin
    ExecCommandWithRetry('PBSZ 0', '2');
    ExecCommandWithRetry('PROT P', '2');
   end;
  {$ENDIF}

// Microsoft: ODS: [FTP] Response: 211 Extended features supported:<NL> LANG EN*<NL> UTF8<NL> AUTH TLS;TLS-C;SSL;TLS-P;<NL> PBSZ<NL> PROT C;P;<NL> CCC<NL> HOST<NL> SIZE<NL> MDTM<NL> REST STREAM<NL>END

// Filezilla ODS: [FTP] Response: 211 Features:<NL> MDTM<NL> REST STREAM<NL> SIZE<NL> MLST type*;size*;modify*;<NL> MLSD<NL> UTF8<NL> CLNT<NL> MFMT<NL>End

//ExecCommandWithRetry('MODE S', '2');
//ExecCommandWithRetry('STRU F', '2');
  ExecCommandWithRetry('TYPE I', '2');

//ExecCommandWithRetry('SYST', '2');
//cmDRes := ExecCommandWithRetry('FEAT', '2');

//FRootDir := GetCurrentDir;
//ExecCommandWithRetry('CWD '+ FRootDir, '2');
end;

procedure TGMFtpClient.Logout;
begin
  if Length(FCurrentConnState.User) > 0 then
   begin
    ExecCommandStr(CmdStream, 'REIN', '12');
    FCurrentConnState := GMInitFtpConnectStateData(FCurrentConnState.Protocol, FCurrentConnState.Host, FCurrentConnState.Port, '', '', '');
   end;
end;

procedure TGMFtpClient.Quit;
begin
  if Length(FCurrentConnState.User) > 0 then
   begin
    ExecCommandStr(CmdStream, 'QUIT', '2');
    FCurrentConnState := GMInitFtpConnectStateData(FCurrentConnState.Protocol, FCurrentConnState.Host, FCurrentConnState.Port, '', '', '');
   end;
end;

function TGMFtpClient.ExecCommandWithRetry(const ACommand, ASuccessCodes: AnsiString; const AShowTrace: Boolean): TCmdResponse;
var oldConnectData: RGMFtpConnectStateData; loginData: TGMFtpLoginData; // cmdWithTerm: AnsiString;
begin
  GMCheckPointerAssigned(Pointer(CmdStream), RStrTheFtpCtrlConnection, self, {$I %CurrentRoutine%});

  Inc(FExecCmdStrRecurseLevel);
  try
   repeat
    try
     try
//    if Length(ACommand) > 0 then
//     begin
//      if AShowTrace then GMTrace(cStrCommand  + ': ' + ACommand, tpFtp);
//      GMSafeIStreamWrite(CmdStream, PChar(cmdWithTerm), Length(cmdWithTerm), {$I %CurrentRoutine%});
//     end;
//
//     Result := CheckCmdResponse(ReceiveCmdResponse(CmdStream), ASuccessCodes, {$I %CurrentRoutine%});
//
//     if (Length(ASuccessCodes) > 1) and (Result.Code[1] = '1') then
//      begin
//       ASuccessCodes := GMDeleteChars(ASuccessCodes, '1');
//       if Length(ASuccessCodes) <= 0 then ASuccessCodes := '2';
//       Result := CheckCmdResponse(ReceiveCmdResponse(CmdStream), ASuccessCodes, {$I %CurrentRoutine%});
//      end;

      Result := ExecCommandStr(CmdStream, ACommand, ASuccessCodes, {$I %CurrentRoutine%}, AShowTrace);

      Break; // <- Always leave loop, will be skipped by exceptions!
     except
      if (Length(ACommand) <= 0) or (FAskLoginData = nil) or (FExecCmdStrRecurseLevel > 1) or (Length(FCurrentConnState.Host) <= 0) or
         not GMIsClassByName(ExceptObject, EGMFtpNotLoggedIn) then raise
       else
        begin
         FillByte(loginData, SizeOf(loginData), 0);
         GMHrCheckObj(FAskLoginData.GetFtpLoginData(@loginData), Self, 'GetFtpLoginData');
         Login(loginData.UserName, loginData.Password, loginData.Account);
        end;
     end;
    except
     if (Length(ACommand) <= 0) or (FExecCmdStrRecurseLevel > 1) or (Length(FCurrentConnState.Host) <= 0) or
         not GMIsSocketReConnectErrorCode(GMGetObjHRCode(exceptObject)) then raise
      else
       begin
        oldConnectData := FCurrentConnState;
        Disconnect(False);
        Connect(oldConnectData.Protocol, oldConnectData.Host, oldConnectData.Port);
        if Length(oldConnectData.User) > 0 then Login(oldConnectData.User, oldConnectData.Pwd, oldConnectData.Account);
       end;
    end;
   until False;
  finally
   Dec(FExecCmdStrRecurseLevel);
  end;
end;
  
procedure TGMFtpClient.PrepareDataConnection;
var cmdRes: TCmdResponse; dataConnectionAddress: IGMSocketAddress; ftpAddr: TGMString; portInt: u_short; bindHost: TGMString;
begin
  if PassiveMode then
   begin
    cmDRes := ExecCommandWithRetry('PASV', '2');
    dataConnectionAddress := ParsePASVResponse(cmDRes.Text[High(cmDRes.Text)], Self);
    FDataSocket := TGMTcpSocket.Create(vDfltInetAddrFamily, FAskCanceled);
    FDataSocket.Connect2(dataConnectionAddress);
   end
  else
   begin
    if GMSameText(FCurrentConnState.Host, cLocalHost) then bindHost := cLocalHost else bindHost := '';
    FDataSocket := TGMTcpSocket.Create(vDfltInetAddrFamily, FAskCanceled);

    if GMSameText(FLocalDataConnectionPort, 'Any') then
      FDataSocket.Bind('0', bindHost) // <- port 0 => let system choose an unused port
    else
      FDataSocket.Bind(FLocalDataConnectionPort, bindHost);

    FDataSocket.Listen;

    if (FDataSocket.LocalAddress <> nil) and (FDataSocket.LocalAddress.Obj is TGMIPSocketAddress) then
     with FDataSocket.LocalAddress.Obj as TGMIPSocketAddress do
      begin
       portInt := GMSocketAPI.ntohs(IPAddress.IP4Port);
       ftpAddr := GMFormat('%d,%d,%d,%d,%d,%d', [IPAddress.IP4Addr.S_un_b.s_b1, IPAddress.IP4Addr.S_un_b.s_b2,
                                                 IPAddress.IP4Addr.S_un_b.s_b3, IPAddress.IP4Addr.S_un_b.s_b4,
                                                 portInt and $FF00 shr 8, portInt and $FF]);
       ExecCommandWithRetry('PORT ' + ftpAddr, '2');
      end;
   end;
end;

procedure TGMFtpClient.AcceptDataConnection;
{$IFDEF TLS_SUPPORT}var dataTlsSocket: IGMTlsSocket;{$ENDIF}
begin
  if not PassiveMode then FDataSocket.AcceptAndTakeOver;

  {$IFDEF TLS_SUPPORT}
  if not (UseTls and FUseSecureDataConnections) then FDataConnection := FDataSocket else
   begin
//  FDataConnection := GMAddTlsLayer(FDataSocket, Self)
    FDataConnection := TGMOpenSslClientSocket.Create(FDataSocket, '', CertMessageEmitter);
    GMCheckQueryInterface(FDataConnection, IGMTlsSocket, dataTlsSocket);
    GMCopyTlsSession((GMObjFromIntf(FCmdStream) as TGMSocketStream).Socket, dataTlsSocket, Self);
//  dataTlsSocket.CopySession((GMObjFromIntf(FCmdStream) as TGMSocketStream).Socket);
    dataTlsSocket.ExecTlsNegotiation;
   end;
  {$ELSE}
  FDataConnection := FDataSocket;
  {$ENDIF}
end;

function TGMFtpClient.ExecDataCommandStr(ACommand, ASuccessCodes: AnsiString): TCmdResponse;
begin
  PrepareDataConnection;
  Result := ExecCommandWithRetry(ACommand, ASuccessCodes);
  AcceptDataConnection;
  GMcheckPointerAssigned(Pointer(FDataConnection), RStrTheDataConnection, Self, {$I %CurrentRoutine%});
end;

procedure TGMFtpClient.List(const AListCmd: TFtpListCmd; const AEnumSink: IUnknown; const APath: AnsiString; const AEnumParam: Pointer; const AEnumItemKind: LongInt);
const cCacheSize = 8192;
var bufPos: LongInt; bufStr, line: AnsiString; attributes: IGMIntfCollection; tellIntf: IGMTellEnumIntf;
    dataStream: IStream;

  function ReadStr(var ADestStr: AnsiString; const AReadSeparators: Boolean; var ABufPos: LongInt): Boolean;
  var startPos: LongInt; found: Boolean;
    procedure ReadMore;
    var N: LongInt;
    begin
      SetLength(bufStr, cCacheSize);
      GMHrCheckObj(dataStream.Read(PAnsiChar(bufStr), Length(bufStr), Pointer(@N)), Self, {$I %CurrentRoutine%}); // , RStrStreamRead + ': '
      SetLength(bufStr, N);
      ABufPos := 1;
    end;
  begin
    Result := dataStream <> nil;
    if not Result then Exit;
    repeat
     startPos := ABufPos;
     if AReadSeparators then
      while (ABufPos <= Length(bufStr)) and (bufStr[ABufPos] in [#10, #13]) do Inc(ABufPos)
     else
      while (ABufPos <= Length(bufStr)) and not (bufStr[ABufPos] in [#10, #13]) do Inc(ABufPos);

     found := ABufPos <= Length(bufStr);
     if ABufPos > Length(bufStr) then
      begin
       ADestStr := ADestStr + Copy(bufStr, startPos, Length(bufStr) - startPos + 1);
       ReadMore;
      end;
     if Length(bufStr) <= 0 then Exit(False); // <- End of input stream!
    until found;
    ADestStr := ADestStr + Copy(bufStr, startPos, bufPos - startPos);
  end;

  function ReadNextLine(var ABufPos: LongInt): AnsiString;
  var sepStr: AnsiString;
  begin
    sepStr := ''; Result := '';
    if not ReadStr(sepStr, True, ABufPos) then Exit; // <- End of input stream!
    if not ReadStr(Result, False, ABufPos) then Exit; // <- End of input stream!
  end;
begin
  if not GMQueryInterface(AEnumSink, IGMTellEnumIntf, tellIntf) then Exit;
  ExecDataCommandStr(GMStringJoin(cFtpListCmd[AListCmd], ' ', PreparePath(APath)), '1'); // , AcceptDataConnection

  dataStream := TFtpDataStream.Create(Self);

  bufPos := 1;
  repeat
   line := ReadNextLine(bufPos);
   if Length(line) > 0 then
    begin
     GMTrace(line);
     attributes := TGMIntfArrayCollection.Create(False, True, GMCompareByName, True); // <- Always create a new collection, otherwise TFptRecursiveDeleter will have to make a copy
     //attributes.Clear;
     case AListCmd of
      flcMLSD: ParseMLSDLine(line, attributes, Self);
      else raise EGMFtpException.ObjError(GMFormat(RStrListKindNotImplementedFmt, [GetEnumName(TypeInfo(TFtpListCmd), Ord(AListCmd))]), Self, {$I %CurrentRoutine%});
     end;
     tellIntf.TellEnumIntf(Self, AEnumItemKind, attributes, AEnumParam);
    end;
  until Length(line) <= 0;
end;

function TGMFtpClient.GetUploadStream(const AFilePath: TGMString): IStream;
begin
//ExecCommandWithRetry('TYPE I', '2'); // <- done only once after login instead
  ExecDataCommandStr('STOR ' + PreparePath(AFilePath), '1');
  Result := TFtpDataStream.Create(Self);
end;

function TGMFtpClient.GetDownloadStream(const AFilePath: TGMString): IStream;
begin
//ExecCommandWithRetry('TYPE I', '2'); // <- done only once after login instead
  ExecDataCommandStr('RETR ' + PreparePath(AFilePath), '1'); 
  Result := TFtpDataStream.Create(Self);
end;

procedure TGMFtpClient.ChangeDirectory(const ADirPath: TGMString);
begin
  ExecCommandWithRetry('CWD ' + PreparePath(ADirPath), '2');
end;

procedure TGMFtpClient.ChangeDirUp;
begin
  ExecCommandWithRetry('CDUP', '2');
end;

procedure TGMFtpClient.CreateDirectory(const ADirPath: TGMString);
begin
  ExecCommandWithRetry('MKD ' + PreparePath(ADirPath), '2');
end;

procedure TGMFtpClient.DeleteDirectory(const ADirPath: TGMString);
begin
  ExecCommandWithRetry('RMD ' + PreparePath(ADirPath), '2');
end;

procedure TGMFtpClient.DeleteFile(const AFilePath: TGMString);
begin
  ExecCommandWithRetry('DELE ' + PreparePath(AFilePath), '2');
end;

procedure TGMFtpClient.SetLastModTime(const AFileOrFolderPath: TGMString; const ALstModUTC: TDateTime);
begin
  ExecCommandWithRetry('MFMT ' + FtpTimeValFromDateTime(ALstModUTC) + ' ' + PreparePath(AFileOrFolderPath), '2');
end;

procedure TGMFtpClient.RenameEntry(const AExistingNamePath, ANewNamePath: TGMString);
begin
  ExecCommandWithRetry('RNFR ' + PreparePath(AExistingNamePath), '3');
  ExecCommandWithRetry('RNTO ' + PreparePath(ANewNamePath), '2');
end;


end.