Delphi 2 - Developers' Solutions/Delphi 2 Developers' Solutions.iso/dds/chap11/howto05/delphi10/ccftp.pas

Pascal/Delphi Source File | 1996-06-12 | 69.9 KB | 2,038 lines

unit Ccftp;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Menus, FileCtrl, CCWSock;

type
  { This record holds the information for a number of internet connections }
  PConnectionsRecord = ^TConnectionsRecord;
  TConnectionsRecord = record
    CProfile   : String; { Connection profile; used in lists }
    CIPAddress : String; { Dotted character IP Address       }
    CUserName  : String; { Login name to site; can be anonym }
    CPassword  : String; { Password; won't be shown          }
    CStartDir  : String; { Starting directory; used for FTP  }
  end;
  { Array of TCR }
  CRFile = file of TConnectionsRecord; { File type for TCRec }
  { Component to hold FTP handling capabilities }
  TFTPComponent = class( TWinControl )
  public
    FTPCommandInProgress ,
    Connection_Established : Boolean;
    Socket1 : TCCSocket;
    Socket2 : TCCSocket;
    constructor Create( AOwner : TComponent ); override;
    destructor Destroy; override;
    function GetTotalBytesToReceive( TheString : String ) : Longint;
    function StripBrackets( TheString : String ) : String;
    function GetShortPathname( TheString : String ) : String;
    function GetWin16FileName( InputName : String ) : String;
    function GetRemoteWorkingDirectory( var RemoteDir : String ) : Boolean;
    function SetRemoteDirectory( TheDir : String ) : Boolean;
    function DeleteRemoteDirectory( TheDir : String ) : Boolean;
    function CreateRemoteDirectory( TheDir : String ) : Boolean;
    function DeleteRemoteFile( TheFileName : String ) : Boolean;
    function EstablishConnection( PCRPointer : PConnectionsRecord ) : Boolean;
    function LoginUser( PCRPointer : PConnectionsRecord ) : Boolean;
    function SendPassword( PCRPointer : PConnectionsRecord ) : Boolean;
    function SetRemoteStartupDirectory( PCRPointer : PConnectionsRecord )
              : Boolean;
    function GetRemoteDirectoryListing( TheListBox : TListBox ) : Boolean;
    function GetRemoteDirectoryListingToMemo : Boolean;
    procedure SendASCIILocalFile( LocalName : String );
    procedure SendBinaryLocalFile( LocalName : String );
    procedure ReceiveASCIIRemoteFile( RemoteName , LocalName : String );
    procedure ReceiveBinaryRemoteFile( RemoteName , LocalName : String );
    function GetLocalDirectoryAndListing( var TheString : String;
                                              TheListBox : TListBox )
              : Boolean;
    function GetUNIXTextString( var StringIn : String ) : String;
    procedure ReceiveASCIIRemoteFileToMemo( RemoteName : String );
    function GetListeningPort : Integer;
    procedure GetFileNameFromUNIXFileName( var TheName : String );
    function Disconnect : Boolean;
    function DoCStyleFormat(       TheText      : string;
                             const TheArguments : array of const ) : String;
    procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
    function GetQuotedString( TheString : String ) : String;
    procedure AddProgressText( WhatText : String );
    procedure ShowProgressText( WhatText : String );
    procedure ShowProgressErrorText( WhatText : String );
    function GetFTPServerResponse( var ResponseString : String ) : integer;
    procedure FTPSocketsErrorOccurred( Sender     : TObject;
                                     ErrorCode  : Integer;
                                     TheMessage : String   );
    function PerformFTPCommand(
                    TheCommand   : string;
              const TheArguments : array of const ) : Integer;
  end;

const
  POV_MEMO                 = 1; { Progress to the Memo           }
  POV_STAT                 = 2; { Progress to the status caption }
  TCPIP_STATUS_PRELIMINARY   = 1; { Wait; command being processed  }
  TCPIP_STATUS_COMPLETED     = 2; { Done; command fully succeded   }
  TCPIP_STATUS_CONTINUING    = 3; { OK; send more data to finish   }
  TCPIP_STATUS_RETRY_COMMAND = 4; { Temporary Error; try cmd again }
  TCPIP_STATUS_FATAL_ERROR   = 5; { Fatal Error; don't retry cmd   }

var
  GlobalErrorCode      : Integer;        { Used to pass around error info  }
  GlobalAbortedFlag    : Boolean;        { Used to signal timeout error    }

implementation

uses CCICCFRM;

{ This is the FTP component constructor; it creates 2 sockets }
constructor TFTPComponent.Create( AOwner : TComponent );
begin
  { do inherited create }
  inherited Create( AOwner );
  { Create sockets, put in their parents, and error procs }
  Socket1 := TCCSocket.Create( Self );
  Socket1.Parent := Self;
  Socket1.OnErrorOccurred := FTPSocketsErrorOccurred;
  Socket2 := TCCSocket.Create( Self );
  Socket2.Parent := Self;
  Socket2.OnErrorOccurred := FTPSocketsErrorOccurred;
  { Set up booleans }
  Connection_Established := false;
  FTPCommandInProgress := false;
end;

{ This is the FTP component destructor; it frees 2 sockets }
destructor TFTPComponent.Destroy;
begin
  { Free the sockets }
  Socket1.Free;
  Socket2.Free;
  { and call inherited }
  inherited Destroy;
end;

function TFTPComponent.GetShortPathname( TheString : String ) : String;
var HoldingString : String;
begin
  HoldingString := Copy( TheString , 1 , 3 );
  HoldingString := HoldingString + '..\' + ExtractFileName( TheString );
  Result := HoldingString;
end;

function TFTPComponent.StripBrackets( TheString : String ) : String;
var HoldingString : String;
    HoldingPosition : Integer;
begin
  HoldingPosition := Pos( '[' , TheString );
  if HoldingPosition = 0 then
  begin
    Result := TheString;
    exit;
  end
  else
  begin
    HoldingString := Copy( TheString , HoldingPosition + 1 , 255 );
    HoldingPosition := Pos( ']' , HoldingString );
    if HoldingPosition = 0 then
    begin
      Result := HoldingString;
      exit;
    end
    else
    begin
      HoldingString := Copy( HoldingString , 1 , HoldingPosition - 1 );
      Result := HoldingString;
      exit;
    end;
  end;
end;

{ This function takes a UNIX filespec and turns it into a Win16 filename }
function TFTPComponent.GetWin16FileName( InputName : String ) : String;
var WorkingString ,
    HoldingString   : String; { Holding string }
begin
  WorkingString := ExtractFileExt( InputName );
  if WorkingString = '' then
  begin
    if Length( InputName ) > 8 then
     WorkingString := Copy( InputName , 1 , 8 ) else
      WorkingString := InputName;
  end
  else
  begin
    if Length( WorkingString ) > 4 then
     WorkingString := Copy( WorkingString , 1 , 4 );
    HoldingString :=
     Copy( InputName , 1 , Pos( WorkingString , InputName ) - 1 );
    if Length( HoldingString ) > 8 then
     HoldingString := Copy( HoldingString , 1 , 8 );
    if HoldingString = '' then
    begin
      { Dot file }
      HoldingString := Copy( InputName , 2 , 255 ) + '.TXT';
      WorkingString := HoldingString;
    end
    else WorkingString := HoldingString + WorkingString;
  end;
  Result := WorkingString;
end;

{ This sends a local file in binary mode to the remote server }
procedure TFTPComponent.SendBinaryLocalFile( LocalName : String );
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
    Through         : Boolean;
    FileNamePChar   : array[ 0 .. 255 ] of char;
    OutputFileHandle : Integer;
    TotalBytesSent ,
    BytesRead ,
    FileToSendSize    : Longint;
    CopyBuffer       : array[ 0 .. 255 ] of char absolute TheReturnString;
begin
  LocalName := ExpandFileName( LocalName );
  StrPCopy( FileNamePChar , LocalName );
  OutputFileHandle := _lopen( FileNamePChar , 0 );
  if OutputFileHandle = -1 then
  begin
    MessageDlg( 'Cannot Open local file ' + LocalName ,
     mtError , [mbOK] , 0 );
    exit;
  end;
  FileToSendSize := _llseek( OutputFileHandle , 0 , 2 );
  _llseek( OutputFileHandle , 0 , 0 );
  TheReturnString :=
   DoCStyleFormat( 'TYPE I' ,
    [ nil ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Send Password sequence }
  TheResult := PerformFTPCommand( 'TYPE I',
                                  [ nil ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    FTPCommandInProgress := false;
    exit;
  end;
  repeat
    TheResult := GetFTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  FTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'FTP File Send Failed!' ,
      [ nil ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { leave }
    exit;
  end
  else
  begin
    { Set up socket 2 for listening }
    Socket2.AsynchMode := False;
    Socket2.NonAsynchTimeoutValue := 60;
    { do a listen and send command to server that this is receipt socket }
    if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
    begin
      Socket2.CCSockCancelListen;
      exit;
    end;
    Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
    TheReturnString :=
     DoCStyleFormat( 'STOR %s' ,
      [ ExtractFileName( LocalName ) ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
    TheResult := PerformFTPCommand( 'STOR %s' , [ ExtractFileName( LocalName ) ] );
    GetFTPServerResponse( TheReturnString );
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
    Socket1.NonAsynchTimeoutValue := 30;
    if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
       ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
    begin
      TheReturnString :=
       DoCStyleFormat( 'Could not create remote file!' ,
        [ nil ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      Socket2.CCSockCancelListen;
      exit;
    end;
    Socket2.CCSockAccept;
    if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
    begin
      TheReturnString :=
       DoCStyleFormat( 'Could not establish send socket!' ,
        [ nil ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      exit;
    end;
    Through := false;
    TotalBytesSent := 0;
    BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
    repeat
      if BytesRead = 0 then Through := true;
      if BytesRead > 0 then
      begin
        CopyBuffer[ 0 ] := Chr( BytesRead );
        Socket2.StringData := TheReturnString;
        TotalBytesSent := TotalBytesSent + BytesRead;
        UpdateGauge( TotalBytesSent , FileToSendSize );
        BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
        if BytesRead = -1 then
        begin
          MessageDlg( 'File Read Error on ' + LocalName , mtError , [mbOK] , 0 );
          GlobalAbortedFlag := True;
        end;
      end;
      if GlobalAbortedFlag then
      begin
        Socket1.OutOfBand := 'ABOR'+#13#10;
        repeat
          TheResult := GetFTPServerResponse( TheReturnString );
          { Put result in progress and status line }
          AddProgressText( TheReturnString );
          ShowProgressText( TheReturnString );
        until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
        exit;
      end;
    until Through;
    FTPCommandInProgress := false;
    { cancel listening on second socket and close it }
    Socket2.CCSockCancelListen;
    Socket2.CCSockClose;
    TheReturnString := 'Transfer Succeeded' + #13#10;
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
    FTPCommandInProgress := false;
    PerformFTPCommand( 'TYPE A',
                                    [ nil ] );
    Through := false;
    repeat
      GetFTPServerResponse( TheReturnString );
      if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
       Through := true;
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressText( TheReturnString );
    until (( GlobalAbortedFlag ) or Through );
  end;
  _lclose( OutputFileHandle );
  FTPCommandInProgress := false;
end;

{ This sends a local file in ascii mode to remote server }
procedure TFTPComponent.SendASCIILocalFile( LocalName : String );
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
    Through         : Boolean;
    FileNamePChar   : array[ 0 .. 255 ] of char;
    OutputFileHandle : Integer;
    TotalBytesSent ,
    BytesRead ,
    FileToSendSize    : Longint;
    CopyBuffer       : array[ 0 .. 255 ] of char absolute TheReturnString;
begin
  LocalName := ExpandFileName( LocalName );
  StrPCopy( FileNamePChar , LocalName );
  OutputFileHandle := _lopen( FileNamePChar , 0 );
  if OutputFileHandle = -1 then
  begin
    MessageDlg( 'Cannot Open local file ' + LocalName ,
     mtError , [mbOK] , 0 );
    exit;
  end;
  FileToSendSize := _llseek( OutputFileHandle , 0 , 2 );
  _llseek( OutputFileHandle , 0 , 0 );
  TheReturnString :=
   DoCStyleFormat( 'TYPE A' ,
    [ nil ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Send Password sequence }
  TheResult := PerformFTPCommand( 'TYPE A',
                                  [ nil ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    FTPCommandInProgress := false;
    exit;
  end;
  repeat
    TheResult := GetFTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  FTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'FTP File Send Failed!' ,
      [ nil ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { leave }
    exit;
  end
  else
  begin
    { Set up socket 2 for listening }
    Socket2.AsynchMode := False;
    Socket2.NonAsynchTimeoutValue := 60;
    { do a listen and send command to server that this is receipt socket }
    if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
    begin
      Socket2.CCSockCancelListen;
      exit;
    end;
    Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
    TheReturnString :=
     DoCStyleFormat( 'STOR %s' ,
      [ ExtractFileName( LocalName ) ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
    TheResult := PerformFTPCommand( 'STOR %s' , [ ExtractFileName( LocalName )]);
    GetFTPServerResponse( TheReturnString );
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
    Socket1.NonAsynchTimeoutValue := 30;
    if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
       ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
    begin
      TheReturnString :=
       DoCStyleFormat( 'Could not create remote file!' ,
        [ nil ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      Socket2.CCSockCancelListen;
      exit;
    end;
    Socket2.CCSockAccept;
    if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
    begin
      TheReturnString :=
       DoCStyleFormat( 'Could not establish send socket!' ,
        [ nil ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      exit;
    end;
    Through := false;
    TotalBytesSent := 0;
    BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
    repeat
      if BytesRead = 0 then Through := true;
      if BytesRead > 0 then
      begin
        CopyBuffer[ 0 ] := Chr( BytesRead );
        Socket2.StringData := TheReturnString;
        TotalBytesSent := TotalBytesSent + BytesRead;
        UpdateGauge( TotalBytesSent , FileToSendSize );
        BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
        if BytesRead = -1 then
        begin
          MessageDlg( 'File Read Error on ' + LocalName , mtError , [mbOK] , 0 );
          GlobalAbortedFlag := True;
        end;
      end;
      if GlobalAbortedFlag then
      begin
        Socket1.OutOfBand := 'ABOR'+#13#10;
        repeat
          TheResult := GetFTPServerResponse( TheReturnString );
          { Put result in progress and status line }
          AddProgressText( TheReturnString );
          ShowProgressText( TheReturnString );
        until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
        exit;
      end;
    until Through;
    { cancel listening on second socket and close it }
    Socket2.CCSockCancelListen;
    Socket2.CCSockClose;
    TheReturnString := 'Transfer Succeeded' + #13#10;
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
    FTPCommandInProgress := false;
    PerformFTPCommand( 'TYPE A', [ nil ] );
    Through := false;
    repeat
      GetFTPServerResponse( TheReturnString );
      if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
       Through := true;
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressText( TheReturnString );
    until (( GlobalAbortedFlag ) or Through );
  end;
  _lclose( OutputFileHandle );
  FTPCommandInProgress := false;
end;

{ This function strips out the FTP response for bytes to send }
function TFTPComponent.GetTotalBytesToReceive( TheString : String ) : Longint;
var
  LeftPosition ,
  RightPosition  : integer;
  TempString     : string;
begin
  LeftPosition := Pos( '(' , TheString );
  TempString := Copy( TheString ,
                      LeftPosition + 1 , 255 );
  RightPosition := Pos( ' ' , TempString );
  if (( LeftPosition = 0 ) or ( RightPosition = 0 )) then
  begin
    Result := 0;
    exit;
  end;
  if RightPosition <> 0 then
    TempString := Copy( TempString , 1 , RightPosition - 1  );
  try
    Result := StrToInt( TempString );
  except
    on EConvertError do Result := 0;
  end;
end;

procedure TFTPComponent.UpdateGauge( BytesFinished , TotalToHandle : longint );
begin
  CCInetCCForm.UpdateGauge( BytesFinished , TotalToHandle );
end;

{ This sends FTP progress text to the Inet form }
procedure TFTPComponent.AddProgressText( WhatText : String );
begin
  CCInetCCForm.AddProgressText( WhatText );
end;

{ This sends FTP progress text to the Inet form }
procedure TFTPComponent.ShowProgressText( WhatText : String );
begin
  CCInetCCForm.ShowProgressText( WhatText );
end;

{ This procedure receives a binary remote file }
procedure TFTPComponent.ReceiveASCIIRemoteFileToMemo( RemoteName : String );
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
    Through         : Boolean;
    TotalBytesSent ,
    FileToGetSize    : Longint;
begin
  TheReturnString :=
   DoCStyleFormat( 'TYPE A' ,
    [ nil ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Send Password sequence }
  FTPCommandInProgress := false;
  TheResult := PerformFTPCommand( 'TYPE A',
                                  [ nil ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    FTPCommandInProgress := false;
    exit;
  end;
  repeat
    TheResult := GetFTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  FTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'FTP File Receive Failed!' ,
      [ nil ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { leave }
    exit;
  end
  else
  begin
    { Set up socket 2 for listening }
    Socket2.AsynchMode := False;
    Socket2.NonAsynchTimeoutValue := 60;
    { do a listen and send command to server that this is receipt socket }
    if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
    begin
      Socket2.CCSockCancelListen;
      exit;
    end;
    Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
    TheReturnString :=
     DoCStyleFormat( 'RETR %s' ,
      [ RemoteName ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
    TheResult := PerformFTPCommand( 'RETR %s' , [RemoteName] );
    GetFTPServerResponse( TheReturnString );
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
    FileToGetSize := GetTotalBytesToReceive( TheReturnString );
    Socket1.NonAsynchTimeoutValue := 30;
    if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
       ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
    begin
      TheReturnString :=
       DoCStyleFormat( 'Could not obtain remote file!' ,
        [ nil ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      Socket2.CCSockCancelListen;
      exit;
    end;
    Socket2.CCSockAccept;
    if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
    begin
      TheReturnString :=
       DoCStyleFormat( 'Could not establish receive socket!' ,
        [ nil ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      exit;
    end;
    Through := false;
    TotalBytesSent := 0;
    repeat
      TheReturnString := Socket2.StringData;
      if Length( TheReturnString ) = 0 then Through := true;
      if Length( TheReturnString ) > 0 then
      begin
        TotalBytesSent := TotalBytesSent + Length( TheReturnString );
        UpdateGauge( TotalBytesSent , FileToGetSize );
        { Put result in progress and status line }
        AddProgressText( TheReturnString );
        ShowProgressText( TheReturnString );
      end;
      if GlobalAbortedFlag then
      begin
        Socket1.OutOfBand := 'ABOR'+#13#10;
        repeat
          TheResult := GetFTPServerResponse( TheReturnString );
          { Put result in progress and status line }
          AddProgressText( TheReturnString );
          ShowProgressText( TheReturnString );
        until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
        exit;
      end;
    until Through;
    { cancel listening on second socket and close it }
    Socket2.CCSockCancelListen;
    Socket2.CCSockClose;
    FTPCommandInProgress := false;
    PerformFTPCommand( 'TYPE A', [ nil ] );
    Through := false;
    repeat
      GetFTPServerResponse( TheReturnString );
      if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
       Through := true;
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressText( TheReturnString );
    until (( GlobalAbortedFlag ) or Through );
  end;
  FTPCommandInProgress := false;
end;

{ This procedure receives a binary remote file }
procedure TFTPComponent.ReceiveASCIIRemoteFile( RemoteName , LocalName : String );
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
    Through         : Boolean;
    FileNamePChar   : array[ 0 .. 255 ] of char;
    OutputFileHandle : Integer;
    TotalBytesSent ,
    FileToGetSize    : Longint;
    CopyBuffer       : array[ 0 .. 255 ] of char;
begin
  LocalName := ExpandFileName( LocalName );
  StrPCopy( FileNamePChar , LocalName );
  OutputFileHandle := _lcreat( FileNamePChar , 0 );
  if OutputFileHandle = -1 then
  begin
    MessageDlg( 'Cannot Create local file ' + LocalName ,
     mtError , [mbOK] , 0 );
    exit;
  end;
  TheReturnString :=
   DoCStyleFormat( 'TYPE A' ,
    [ nil ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Send Password sequence }
  TheResult := PerformFTPCommand( 'TYPE A',
                                  [ nil ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    FTPCommandInProgress := false;
    exit;
  end;
  repeat
    TheResult := GetFTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  FTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'FTP File Receive Failed!' ,
      [ nil ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { leave }
    exit;
  end
  else
  begin
    { Set up socket 2 for listening }
    Socket2.AsynchMode := False;
    Socket2.NonAsynchTimeoutValue := 60;
    { do a listen and send command to server that this is receipt socket }
    if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
    begin
      Socket2.CCSockCancelListen;
      exit;
    end;
    Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
    TheReturnString :=
     DoCStyleFormat( 'RETR %s' ,
      [ RemoteName ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
    TheResult := PerformFTPCommand( 'RETR %s' , [RemoteName] );
    GetFTPServerResponse( TheReturnString );
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
    FileToGetSize := GetTotalBytesToReceive( TheReturnString );
    Socket1.NonAsynchTimeoutValue := 30;
    if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
       ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
    begin
      TheReturnString :=
       DoCStyleFormat( 'Could not obtain remote file!' ,
        [ nil ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      Socket2.CCSockCancelListen;
      exit;
    end;
    Socket2.CCSockAccept;
    if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
    begin
      TheReturnString :=
       DoCStyleFormat( 'Could not establish receive socket!' ,
        [ nil ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      exit;
    end;
    Through := false;
    TotalBytesSent := 0;
    repeat
      TheReturnString := Socket2.StringData;
      if Length( TheReturnString ) = 0 then Through := true;
      if Length( TheReturnString ) > 0 then
      begin
        StrPCopy( CopyBuffer , TheReturnString );
        TotalBytesSent := TotalBytesSent + Length( TheReturnString );
        UpdateGauge( TotalBytesSent , FileToGetSize );
        if _lwrite( OutputFileHandle , CopyBuffer , Length( TheReturnString ))
         = -1 then
        begin
          MessageDlg( 'File Write Error on ' + LocalName , mtError , [mbOK] , 0 );
          GlobalAbortedFlag := True;
        end;
      end;
      if GlobalAbortedFlag then
      begin
        Socket1.OutOfBand := 'ABOR'+#13#10;
        repeat
          TheResult := GetFTPServerResponse( TheReturnString );
          { Put result in progress and status line }
          AddProgressText( TheReturnString );
          ShowProgressText( TheReturnString );
        until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
        exit;
      end;
    until Through;
    { cancel listening on second socket and close it }
    Socket2.CCSockCancelListen;
    Socket2.CCSockClose;
    FTPCommandInProgress := false;
    PerformFTPCommand( 'TYPE A', [ nil ] );
    Through := false;
    repeat
      GetFTPServerResponse( TheReturnString );
      if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
       Through := true;
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressText( TheReturnString );
    until (( GlobalAbortedFlag ) or Through );
  end;
  _lclose( OutputFileHandle );
  FTPCommandInProgress := false;
end;

{ This procedure receives a binary remote file }
procedure TFTPComponent.ReceiveBinaryRemoteFile( RemoteName , LocalName : String );
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
    Through         : Boolean;
    FileNamePChar   : array[ 0 .. 255 ] of char;
    OutputFileHandle : Integer;
    TotalBytesSent ,
    FileToGetSize    : Longint;
    CopyBuffer       : array[ 0 .. 255 ] of char;
begin
  LocalName := ExpandFileName( LocalName );
  StrPCopy( FileNamePChar , LocalName );
  OutputFileHandle := _lcreat( FileNamePChar , 0 );
  if OutputFileHandle = -1 then
  begin
    MessageDlg( 'Cannot Create local file ' + LocalName ,
     mtError , [mbOK] , 0 );
    exit;
  end;
  TheReturnString :=
   DoCStyleFormat( 'TYPE I' ,
    [ nil ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Send Password sequence }
  TheResult := PerformFTPCommand( 'TYPE I',
                                  [ nil ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    FTPCommandInProgress := false;
    exit;
  end;
  repeat
    TheResult := GetFTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  FTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'FTP File Receive Failed!' ,
      [ nil ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { leave }
    exit;
  end
  else
  begin
    { Set up socket 2 for listening }
    Socket2.AsynchMode := False;
    Socket2.NonAsynchTimeoutValue := 60;
    { do a listen and send command to server that this is receipt socket }
    if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
    begin
      Socket2.CCSockCancelListen;
      exit;
    end;
    Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
    TheReturnString :=
     DoCStyleFormat( 'RETR %s' ,
      [ RemoteName ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
    TheResult := PerformFTPCommand( 'RETR %s' , [RemoteName] );
    GetFTPServerResponse( TheReturnString );
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
    FileToGetSize := GetTotalBytesToReceive( TheReturnString );
    Socket1.NonAsynchTimeoutValue := 30;
    if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
       ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
    begin
      TheReturnString :=
       DoCStyleFormat( 'Could not obtain remote file!' ,
        [ nil ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      Socket2.CCSockCancelListen;
      exit;
    end;
    Socket2.CCSockAccept;
    if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
    begin
      TheReturnString :=
       DoCStyleFormat( 'Could not establish receive socket!' ,
        [ nil ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      exit;
    end;
    Through := false;
    TotalBytesSent := 0;
    repeat
      TheReturnString := Socket2.StringData;
      if Length( TheReturnString ) = 0 then Through := true;
      if Length( TheReturnString ) > 0 then
      begin
        StrPCopy( CopyBuffer , TheReturnString );
        TotalBytesSent := TotalBytesSent + Length( TheReturnString );
        UpdateGauge( TotalBytesSent , FileToGetSize );
        if _lwrite( OutputFileHandle , CopyBuffer , Length( TheReturnString ))
         = -1 then
        begin
          MessageDlg( 'File Write Error on ' + LocalName , mtError , [mbOK] , 0 );
          GlobalAbortedFlag := True;
        end;
      end;
      if GlobalAbortedFlag then
      begin
        Socket1.OutOfBand := 'ABOR'+#13#10;
        repeat
          TheResult := GetFTPServerResponse( TheReturnString );
          { Put result in progress and status line }
          AddProgressText( TheReturnString );
          ShowProgressText( TheReturnString );
        until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
        exit;
      end;
    until Through;
    { cancel listening on second socket and close it }
    Socket2.CCSockCancelListen;
    Socket2.CCSockClose;
    FTPCommandInProgress := false;
    PerformFTPCommand( 'TYPE A', [ nil ] );
    Through := false;
    repeat
      GetFTPServerResponse( TheReturnString );
      if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
       Through := true;
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressText( TheReturnString );
    until (( GlobalAbortedFlag ) or Through );
  end;
  _lclose( OutputFileHandle );
  FTPCommandInProgress := false;
end;

{ This sends FTP progress text to the Inet form }
procedure TFTPComponent.ShowProgressErrorText( WhatText : String );
begin
  CCInetCCForm.ShowProgressErrorText( WhatText );
end;

{ This is a core function! It performs an FTP command and if no timeout }
{ return a preliminary ok.                                              }
function TFTPComponent.PerformFTPCommand(
                 TheCommand        : string;
           const TheArguments      : array of const ) : Integer;
var TheBuffer : string; { Text buffer }
begin
  { If command in progress send back -1 error }
  if FTPCommandInProgress then
  begin
    Result := -1;
    exit;
  end;
  { Set status variable }
  FTPCommandInProgress := True;
  { Set global error code }
  GlobalErrorCode := 0;
  { Format output string }
  TheBuffer := Format( TheCommand , TheArguments );
  { Preset failure code }
  Result := TCPIP_STATUS_FATAL_ERROR;
  { If invalid socket or no connection abort }
  if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
   exit;
  { Send the buffer plus EOL chars }
  Socket1.StringData := TheBuffer + #13#10;
  { if abort due to timeout or other error exit }
  if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  { Otherwise return preliminary code }
  Result := TCPIP_STATUS_PRELIMINARY;
end;

{ This function gets up to 255 chars of data plus a return code from FTP serv }
function TFTPComponent.GetFTPServerResponse(
          var ResponseString : String ) : integer;
var
  { Buffer string for response line }
  TheBuffer     : string;
  { Pointer to the response string }
  BufferPointer : array[0..255] of char absolute TheBuffer;
  { Character to check for response code }
  ResponseChar   : char;
  { Pointers into returned string }
  TheIndex ,
  TheLength     : integer;
  { Control variable }
  LeftoversInPan ,
  Finished      : Boolean;
begin
  { Preset fatal error }
  Result := TCPIP_STATUS_FATAL_ERROR;
  { Start loop control }
  LeftoversInPan := false;
  Finished := false;
  repeat
    { Do a peek }
    TheBuffer := Socket1.PeekData;
    { If timeout or other error exit }
    if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
    { Find end of line character }
    TheIndex := Pos( #10 , TheBuffer );
    if TheIndex = 0 then
    begin
      TheIndex := Pos( #13 , TheBuffer );
      if TheIndex = 0 then
      begin
        TheIndex := Pos( #0 , TheBuffer );
        if TheIndex = 0 then
        begin
          TheIndex := Length( TheBuffer );
          LeftoversInPan := True;
          LeftoverText := LeftoverText + TheBuffer;
          LeftoversOnTable := false;
        end;
      end;
    end;
    { If an end of line then process the line }
    if TheIndex > 0 then
    begin
      { Get length of string }
      TheLength := TheIndex;
      { Receive actual data }
      Socket1.CCSockReceive( Socket1.TheSocket   ,
                             @BufferPointer[ 1 ] ,
                             TheLength              );
      { Abort if timeout or error }
      if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
      { Put in the length byte }
      BufferPointer[ 0 ] := Chr( TheLength );
      if LeftOversOnTable then
      begin
        LeftOversOnTable := false;
        ResponseString := LeftoverText + TheBuffer;
        TheBuffer := ResponseString;
        LeftoverText := '';
      end;
      if LeftoversInPan then
      begin
        LeftoversInPan := false;
        LeftoversOnTable := true;
      end;
      { If not a continuation line }
      if TheBuffer[ 4 ] <> '-' then
      begin
        { Get first number character }
        ResponseChar := TheBuffer[ 1 ];
        { Get the value of the number from 1 to 5 }
        if (( ResponseChar >= '1' ) and ( ResponseChar <= '5' )) then
        begin
          Finished := true;
          Result := Ord( ResponseChar ) - 48;
        end;
      end
      else
      begin
        { otherwise return preliminary result }
        Finished := true;
        Result := TCPIP_STATUS_PRELIMINARY;
      end;
    end
    else
    begin
    end;
  until ( Finished and ( not LeftoversOnTable ));
  { Return buffer as response string }
  ResponseString := TheBuffer;
end;

{ Boilerplate error routine }
procedure TFTPComponent.FTPSocketsErrorOccurred( Sender     : TObject;
                                                 ErrorCode  : Integer;
                                                 TheMessage : String   );
begin
  CCInetCCForm.SocketsErrorOccurred( Sender,ErrorCode,TheMessage );
end;

{ This is the FTP components initial connection routine }
function TFTPComponent.EstablishConnection(
          PCRPointer : PConnectionsRecord ) : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  { Set default FTP Port value }
  Socket1.PortName := '21';
  { Get the ip address from the record }
  Socket1.IPAddressName := PCRPointer^.CIPAddress;
  { Set blocking mode }
  Socket1.AsynchMode := False;
  { Clear condition variables }
  GlobalErrorCode := 0;
  GlobalAbortedFlag := false;
  { Actually attempt to connect }
  Socket1.CCSockConnect;
  { Check if connected }
  if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 ) or
      ( Socket1.TheSocket = INVALID_SOCKET )) then
  begin { Didn't connect; signal error and abort }
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
      [ PCRPointer^.CIPAddress ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end
  else
  begin
    Connection_Established := true;
    { Signal successful connection }
    TheReturnString := DoCStyleFormat(
      'Connected on Local port: %s with IP: %s',
      [ Socket1.GetSocketPort( Socket1.TheSocket ),
        Socket1.GetSocketIPAddress( Socket1.TheSocket )]);
    { Put result in progress and status line }
    CCINetCCForm.AddProgressText( TheReturnString );
    CCINetCCForm.ShowProgressText( TheReturnString );
    TheReturnString := DoCStyleFormat(
     'Connected to Remote port: %s with IP: %s',
      [ Socket1.GetSocketPeerPort( Socket1.TheSocket ),
        Socket1.GetSocketPeerIPAddress( Socket1.TheSocket )]);
    { Put result in progress and status line }
    CCINetCCForm.AddProgressText( TheReturnString );
    CCINetCCForm.ShowProgressText( TheReturnString );
    TheReturnString := DoCStyleFormat( 'Successfully connected to %s',
     [ Socket1.IPAddressName ]);
    { Put result in progress and status line }
    CCINetCCForm.AddProgressText( TheReturnString );
    CCINetCCForm.ShowProgressText( TheReturnString );
    repeat
      TheResult := GetFTPServerResponse( TheReturnString );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressText( TheReturnString );
    until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
    if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
    begin
      { Do clever C formatting trick }
      TheReturnString :=
       DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
        [ PCRPointer^.CIPAddress ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      { Signal error }
      Result := False;
      { leave }
      exit;
    end
    else Result := true; { Signal no problem }
  end;
end;

{ This is the FTP components USER login routine }
function TFTPComponent.LoginUser(
          PCRPointer : PConnectionsRecord ) : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  TheReturnString :=
   DoCStyleFormat( 'USER %s' ,
    [ PCRPointer^.CUserName ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Begin login sequence with user name }
  TheResult := PerformFTPCommand( 'USER %s',
                                  [ PCRPointer^.CUserName ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    FTPCommandInProgress := false;
    Result := false;
    exit;
  end;
  repeat
    TheResult := GetFTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  FTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_CONTINUING )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
      [ PCRPointer^.CIPAddress ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end
  else Result := true; { Signal no problem }
end;

function TFTPComponent.DeleteRemoteDirectory( TheDir : String ) : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  TheReturnString := DoCStyleFormat( 'RMD %s' ,
   [ TheDir ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Send Password sequence }
  TheResult := PerformFTPCommand( 'RMD %s',
                                  [ TheDir ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    Result := false;
    FTPCommandInProgress := false;
    exit;
  end;
  repeat
    TheResult := GetFTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  FTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'Delete Directory %s Failed!' ,
      [ TheDir ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end
  else Result := true; { Signal no problem }
end;

function TFTPComponent.CreateRemoteDirectory( TheDir : String ) : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  TheReturnString := DoCStyleFormat( 'MKD %s' ,
    [ TheDir ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Send Password sequence }
  TheResult := PerformFTPCommand( 'MKD %s',
                                  [ TheDir ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    Result := false;
    FTPCommandInProgress := false;
    exit;
  end;
  repeat
    TheResult := GetFTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  FTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'Create Directory %s Failed!' ,
      [ TheDir ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end
  else Result := true; { Signal no problem }
end;


function TFTPComponent.DeleteRemoteFile( TheFileName : String ) : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  TheReturnString := DoCStyleFormat( 'DELE %s' ,
    [ TheFileName ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Send Password sequence }
  TheResult := PerformFTPCommand( 'DELE %s',
                                  [ TheFileName ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    Result := false;
    FTPCommandInProgress := false;
    exit;
  end;
  repeat
    TheResult := GetFTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  FTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'Delete File %s Failed!' ,
      [ TheFileName ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end
  else Result := true; { Signal no problem }
end;

{ This is the FTP components PASSWORD routine }
function TFTPComponent.SendPassword(
          PCRPointer : PConnectionsRecord ) : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  TheReturnString := 'PASS XXXXXX' + #13#10;
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Send Password sequence }
  TheResult := PerformFTPCommand( 'PASS %s',
                                  [ PCRPointer^.CPassword ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    Result := false;
    FTPCommandInProgress := false;
    exit;
  end;
  repeat
    TheResult := GetFTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  FTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
      [ PCRPointer^.CIPAddress ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end
  else Result := true; { Signal no problem }
end;

{ This is the FTP components CWD routine }
function TFTPComponent.SetRemoteStartupDirectory(
          PCRPointer : PConnectionsRecord ) : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  Result := true;
  if PCRPointer^.CStartDir <> '' then
  begin
    TheReturnString :=
     DoCStyleFormat( 'CWD %s' ,
      [ PCRPointer^.CStartDir ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
    { Send Password sequence }
    TheResult := PerformFTPCommand( 'CWD %s',
                                    [ PCRPointer^.CStartDir ] );
    if TheResult <> TCPIP_STATUS_PRELIMINARY then
    begin
      Result := false;
      FTPCommandInProgress := false;
      exit;
    end;
    repeat
      TheResult := GetFTPServerResponse( TheReturnString );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressText( TheReturnString );
   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
   FTPCommandInProgress := false;
   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
    begin
      { Do clever C formatting trick }
      TheReturnString :=
       DoCStyleFormat( 'CWD to %s Failed!' ,
        [ PCRPointer^.CStartDir ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      { Signal error }
      Result := False;
      { leave }
      exit;
    end
    else Result := true; { Signal no problem }
  end;
end;

{ This is the FTP components CWD routine }
function TFTPComponent.SetRemoteDirectory( TheDir : String ) : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  Result := true;
  if TheDir <> '' then
  begin
    TheReturnString :=
     DoCStyleFormat( 'CWD %s' ,
      [ TheDir ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
    { Send Password sequence }
    TheResult := PerformFTPCommand( 'CWD %s',
                                    [ TheDir ] );
    if TheResult <> TCPIP_STATUS_PRELIMINARY then
    begin
      Result := false;
      FTPCommandInProgress := false;
      exit;
    end;
    repeat
      TheResult := GetFTPServerResponse( TheReturnString );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressText( TheReturnString );
   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
   FTPCommandInProgress := false;
   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
    begin
      { Do clever C formatting trick }
      TheReturnString :=
       DoCStyleFormat( 'CWD to %s Failed!' ,
        [ TheDir ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      { Signal error }
      Result := False;
      { leave }
      exit;
    end
    else Result := true; { Signal no problem }
  end;
end;

{ This is the FTP components QUIT routine }
function TFTPComponent.Disconnect : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  TheReturnString :=
   DoCStyleFormat( 'QUIT' ,
    [ nil ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Begin login sequence with user name }
  PerformFTPCommand( 'QUIT', [ nil ] );
  repeat
    TheResult := GetFTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  FTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'FTP Host Connection Failed!' ,
      [ nil ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end
  else Result := true; { Signal no problem }
end;

{ This is the FTP components PWD routine }
function TFTPComponent.GetRemoteWorkingDirectory( var RemoteDir : String )
          : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  TheReturnString :=
   DoCStyleFormat( 'PWD' ,
    [ nil ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Send Password sequence }
  TheResult := PerformFTPCommand( 'PWD',
                                  [ nil ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    Result := false;
    FTPCommandInProgress := false;
    exit;
  end;
  repeat
    TheResult := GetFTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  FTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'FTP Host Connection Failed!' ,
      [ nil ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end
  else
  begin
    Result := true; { Signal no problem }
    RemoteDir := TheReturnString; { Send back last string on faith }
  end;
end;

{ This function sets up a listening port on socekt 2 and handle text replies }
function TFTPComponent.GetListeningPort : Integer;
var
  Address1 ,
  Address2 ,
  Address3 ,
  Address4        : integer; { Address integer conversions }
  IPAddress       : string;  { IP Address holder           }
  PortCommand     : string;  { Command holder              }
  TheResult       : Integer; { Result holder               }
  TheReturnString : String;  { ditto                       }
begin
  { Set up any port on socket 2 }
  Socket2.PortName := '0';
  { Listen on a socket }
  Socket2.CCSockListen;
  { Get the IP Address of socket 1 and convert it to numbers }
  IPAddress := Socket1.GetSocketIPAddress( Socket1.TheSocket );
  Address1 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress ) -1 ));
  IPAddress := copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 );
  Address2 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress) -1 ));
  IPAddress := copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 );
  Address3 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress ) -1 ));
  Address4 := StrToInt( copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 ));
  { Turn it into a command and add socket 2 stuff }
  PortCommand := format( 'PORT %d,%d,%d,%d,%d,%d' ,
   [ Address1 , Address2 , Address3 , Address4 ,
    StrToInt( Socket2.GetSocketPort( Socket2.TheMasterSocket )) Shr 8,
    StrToInt( Socket2.GetSocketPort( Socket2.TheMasterSocket )) and $ff ]);
  { Put result in progress and status line }
  AddProgressText( PortCommand + #13#10 );
  ShowProgressText( PortCommand  + #13#10 );
  TheResult := PerformFTPCommand( PortCommand , [nil] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    Result := TCPIP_STATUS_FATAL_ERROR;
    FTPCommandInProgress := false;
    exit;
  end;
  repeat
    TheResult := GetFTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  FTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'FTP Host Connection Failed!' ,
      [ nil ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := TheResult;
    { leave }
    exit;
  end
  else
  begin
    { Return good result and leave }
    Result := TheResult;
    exit;
  end;
end;

{ This function returns part of a unit text string }
function TFTPComponent.GetUNIXTextString( var StringIn : String ) : String;
var
  ReturnString : String;
  TheLength ,
  Counter_1   : integer;
begin
  TheLength := Length( StringIn );
  if TheLength > 1 then
  begin
    for Counter_1 := 1 to TheLength do
    begin
      if StringIn[ Counter_1 ] = #10 then
      begin
        ReturnString := HolderLine;
        HolderLine := '';
        StringIn := Copy( StringIn , Counter_1 + 1 , 255 );
        Result := ReturnString;
        exit;
      end
      else
      begin
        if StringIn[ Counter_1 ] <> #0 then
        begin
          if StringIn[ Counter_1 ] <> #13 then
           HolderLine := HolderLine + StringIn[ Counter_1 ];
        end
        else
        begin
          Result := '';
          StringIn := '';
        end;
      end;
    end;
  end;
  Result := '';
  StringIn := '';
end;

procedure TFTPComponent.GetFileNameFromUNIXFileName( var TheName : String );
var Counter_1 : Integer;
    ResultString : String;
    Finished : Boolean;
begin
  if Pos( 'TOTAL' , Uppercase( TheName )) <> 0 then
  begin
    TheName := '';
    exit;
  end;
  Counter_1 := Length( TheName );
  ResultString := '';
  Finished := false;
  while not Finished do
  begin
    if TheName[ Counter_1 ] <> ' ' then
    begin
      Counter_1 := Counter_1 - 1;
      if Counter_1 = 0 then
      begin
        ResultString := TheName;
        Finished := true;
      end;
    end
    else
    begin
      Finished := true;
      ResultString := Copy( TheName , Counter_1 + 1 , 255 );
    end;
  end;
  TheName := ResultString;
end;

{ This is the FTP components get remote directory listing into a list box }
function TFTPComponent.GetRemoteDirectoryListing( TheListBox : TListBox )
          : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
    InputString     : String;
    Through ,
    Finished        : Boolean;
begin
  TheListBox.Clear;
  TheListbox.Tag := 2;
  TheListBox.Items.Add('..');
  Result := true;
  TheReturnString :=
   DoCStyleFormat( 'TYPE A' ,
    [ nil ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Send Password sequence }
  TheResult := PerformFTPCommand( 'TYPE A',
                                  [ nil ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    Result := true;
    FTPCommandInProgress := false;
    exit;
  end;
  repeat
    TheResult := GetFTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  FTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'FTP Host Connection Failed!' ,
      [ nil ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := true;
    { leave }
    exit;
  end
  else
  begin
    { Set up socket 2 for listening }
    Socket2.AsynchMode := False;
    Socket2.NonAsynchTimeoutValue := 60;
    { do a listen and send command to server that this is receipt socket }
    if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
    begin
      Socket2.CCSockCancelListen;
      exit;
    end;
    Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
    TheResult := PerformFTPCommand( 'LIST' , [nil] );
    GetFTPServerResponse( TheReturnString );
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
    Socket1.NonAsynchTimeoutValue := 30;
    if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
       ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
    begin
      TheReturnString :=
       DoCStyleFormat( 'Could not obtain remote directory!' ,
        [ nil ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      Socket2.CCSockCancelListen;
      Result := true;
      exit;
    end;
    Socket2.CCSockAccept;
    if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
    begin
      TheReturnString :=
       DoCStyleFormat( 'Could not establish receive socket!' ,
        [ nil ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      Result := true;
      exit;
    end;
    Through := false;
    repeat
      TheReturnString := Socket2.StringData;
      if Length( TheReturnString ) = 0 then Through := true;
      if Length( TheReturnString ) > 0 then
      begin
        finished := false;
        while not finished do
        begin
          InputString := GetUNIXTextString( TheReturnString );
          if InputString = '' then Finished := true else
          begin
            GetFileNameFromUNIXFileName( InputString);
            If InputString <> '' then
            TheListBox.Items.Add( InputString );
          end;
        end;
      end;
      if GlobalAbortedFlag then
      begin
        Socket1.OutOfBand := 'ABOR'+#13#10;
        repeat
          TheResult := GetFTPServerResponse( TheReturnString );
          { Put result in progress and status line }
          AddProgressText( TheReturnString );
          ShowProgressText( TheReturnString );
        until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
        result := true;
        exit;
      end;
    until Through;
    GetFTPServerResponse( TheReturnString );
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
    { cancel listening on second socket and close it }
    Socket2.CCSockCancelListen;
    Socket2.CCSockClose;
  end;
  FTPCommandInProgress := false;
end;

{ This is the FTP components get remote directory listing into a list box }
function TFTPComponent.GetRemoteDirectoryListingToMemo : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
    Through         : Boolean;
begin
  Result := true;
  TheReturnString :=
   DoCStyleFormat( 'TYPE A' ,
    [ nil ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Send Password sequence }
  TheResult := PerformFTPCommand( 'TYPE A',
                                  [ nil ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    Result := true;
    FTPCommandInProgress := false;
    exit;
  end;
  repeat
    TheResult := GetFTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  FTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'FTP Host Connection Failed!' ,
      [ nil ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := true;
    { leave }
    exit;
  end
  else
  begin
    { Set up socket 2 for listening }
    Socket2.AsynchMode := False;
    Socket2.NonAsynchTimeoutValue := 30;
    { do a listen and send command to server that this is receipt socket }
    if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
    begin
      Socket2.CCSockCancelListen;
      exit;
    end;
    Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
    TheResult := PerformFTPCommand( 'LIST' , [nil] );
    GetFTPServerResponse( TheReturnString );
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
    Socket1.NonAsynchTimeoutValue := 30;
    if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
       ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
    begin
      TheReturnString :=
       DoCStyleFormat( 'Could not obtain remote directory!' ,
        [ nil ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      Socket2.CCSockCancelListen;
      Result := true;
      exit;
    end;
    Socket2.CCSockAccept;
    if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
    begin
      TheReturnString :=
       DoCStyleFormat( 'Could not establish receive socket!' ,
        [ nil ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      Result := true;
      exit;
    end;
    Through := false;
    repeat
      TheReturnString := Socket2.StringData;
      if Length( TheReturnString ) = 0 then Through := true;
      if Length( TheReturnString ) > 0 then
      begin
        { Put result in progress and status line }
        AddProgressText( TheReturnString );
        ShowProgressText( TheReturnString );
      end;
      if GlobalAbortedFlag then
      begin
        Socket1.OutOfBand := 'ABOR'+#13#10;
        repeat
          TheResult := GetFTPServerResponse( TheReturnString );
          { Put result in progress and status line }
          AddProgressText( TheReturnString );
          ShowProgressText( TheReturnString );
        until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
        result := true;
        exit;
      end;
    until Through;
    GetFTPServerResponse( TheReturnString );
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
    { cancel listening on second socket and close it }
    Socket2.CCSockCancelListen;
    Socket2.CCSockClose;
  end;
end;

{ This is the FTP components get local directory listing into a list box }
function TFTPComponent.GetLocalDirectoryAndListing( var TheString : String;
                                                        TheListBox : TListBox )
          : Boolean;
var TheFLB : TFileListBox;
begin
  { Get the working directory }
  GetDir( 0 , TheString );
  { Clear incoming LB }
  TheListBox.Clear;
  TheListBox.Tag := 2;
  TheFLB := TFileListBox.Create( Application.MainForm );
  TheFLB.Visible := false;
  TheFLB.Parent := Application.MainForm;
  TheFLB.FileType := [ ftNormal , ftDirectory ];
  TheFLB.Directory := TheString;
  TheFLB.Update;
  TheListBox.Items.Assign( TheFLB.Items );
  TheFLB.Free;
  result := true;
end;

{ This is a clever c-style formatting trick }
function TFTPComponent.DoCStyleFormat(
                TheText      : string;
          const TheArguments : array of const ) : String;
begin
  Result := Format( TheText , TheArguments ) + #13#10;
end;

function TFTPComponent.GetQuotedString( TheString : String ) : String;
var TheIndex     : Integer; { Holder var }
    ResultString : String;  { ditto      }
begin
  { Find out if " present at all }
  TheIndex := Pos( '"' , TheString );
  If TheIndex = 0 then
  begin
    { If not, return null string and exit }
    Result := '';
    exit;
  end
  else
  begin
    { Get from first " to end of string in holder }
    ResultString := Copy( TheString , TheIndex + 1 , 255 );
    { Find position to second " }
    TheIndex := Pos( '"' , ResultString );
    { If no ending " then return whole string and leave }
    if TheIndex = 0 then
    begin
      Result := ResultString;
      exit;
    end
    else
    begin
      { Get internal text between quotes and exit }
      ResultString := Copy( ResultString , 1 , TheIndex - 1 );
      Result := ResultString;
    end;
  end;
end;

end.