nmftp.pas

来自「DELPHI里面一些常用的控件」· PAS 代码 · 共 1,630 行 · 第 1/5 页

  until j > Length(Line);
  NoTokens := i;


end; {_ procedure skipblanks; _}

procedure TFTPDirectoryList.Clear;
begin
  FAttribute.Clear;
  FName.Clear;
  FSize.Clear;
  FModifDate.Clear;
end; {_ procedure TFTPDirectoryList.Clear; _}


procedure TFTPUnixList.ParseLine(Line: string);
begin
  inherited ParseLine(Line);
  if NoTokens > 7 then
  begin
    FName.add(tokens[NoTokens]);
    FSize.add(tokens[NoTokens - 4]);
    FModifDate.add(tokens[NoTokens - 3] + ' ' + tokens[NoTokens - 2] + ' ' + tokens[NoTokens - 1]);
    FAttribute.add(tokens[1]);
  end; {_ if NoTokens > 7 then _}
end; {_ procedure TFTPUnixList.ParseLine(Line: string); _}

procedure TFTPNETWAREList.ParseLine(Line: string);
begin
  inherited ParseLine(Line);
  if NoTokens > 7 then
  begin
    FName.add(tokens[NoTokens - 1]);
    FSize.add(tokens[NoTokens - 5]);
    FModifDate.add(tokens[NoTokens - 4] + ' ' + tokens[NoTokens - 3] + ' ' + tokens[NoTokens - 2]);
    FAttribute.add(tokens[1]);
  end; {_ if NoTokens > 7 then _}
end; {_ procedure TFTPNETWAREList.ParseLine(Line: string); _}

procedure TFTPDOSList.ParseLine(Line: string);
begin
  inherited ParseLine(Line);
  if NoTokens > 7 then
  begin
    FName.add(tokens[NoTokens - 1]);
    FSize.add(tokens[NoTokens - 5]);
    FModifDate.add(tokens[NoTokens - 4] + ' ' + tokens[NoTokens - 3] + ' ' + tokens[NoTokens - 2]);
    FAttribute.add(tokens[1]);
  end; {_ if NoTokens > 7 then _}
end; {_ procedure TFTPDOSList.ParseLine(Line: string); _}

procedure TFTPVMSList.ParseLine(Line: string);
begin
  inherited ParseLine(Line);
  if NoTokens > 7 then
  begin
    FName.add(tokens[NoTokens - 1]);
    FSize.add(tokens[NoTokens - 5]);
    FModifDate.add(tokens[NoTokens - 4] + ' ' + tokens[NoTokens - 3] + ' ' + tokens[NoTokens - 2]);
    FAttribute.add(tokens[1]);
  end; {_ if NoTokens > 7 then _}
end; {_ procedure TFTPVMSList.ParseLine(Line: string); _}

procedure TFTPMVSList.ParseLine(Line: string);
begin
  inherited ParseLine(Line);
  if NoTokens > 7 then
  begin
    FName.add(tokens[NoTokens - 1]);
    FSize.add(tokens[NoTokens - 5]);
    FModifDate.add(tokens[NoTokens - 4] + ' ' + tokens[NoTokens - 3] + ' ' + tokens[NoTokens - 2]);
    FAttribute.add(tokens[1]);
  end; {_ if NoTokens > 7 then _}
end; {_ procedure TFTPMVSList.ParseLine(Line: string); _}

procedure TFTPVMList.ParseLine(Line: string);
begin
  inherited ParseLine(Line);
  if NoTokens > 7 then
  begin
    FName.add(tokens[NoTokens - 1]);
    FSize.add(tokens[NoTokens - 5]);
    FModifDate.add(tokens[NoTokens - 4] + ' ' + tokens[NoTokens - 3] + ' ' + tokens[NoTokens - 2]);
    FAttribute.add(tokens[1]);
  end; {_ if NoTokens > 7 then _}
end; {_ procedure TFTPVMList.ParseLine(Line: string); _}

procedure TFTPMACOSList.ParseLine(Line: string);
begin
  inherited ParseLine(Line);
  if NoTokens > 7 then
  begin
    FName.add(tokens[NoTokens - 1]);
    FSize.add(tokens[NoTokens - 5]);
    FModifDate.add(tokens[NoTokens - 4] + ' ' + tokens[NoTokens - 3] + ' ' + tokens[NoTokens - 2]);
    FAttribute.add(tokens[1]);
  end; {_ if NoTokens > 7 then _}
end; {_ procedure TFTPMACOSList.ParseLine(Line: string); _}

procedure TFTPAS400List.ParseLine(Line: string);
begin
  inherited ParseLine(Line);
  if NoTokens > 3 then
  begin
    if tokens[NoTokens][1] = '*' then
      FName.add(tokens[NoTokens])
    else FName.add(tokens[NoTokens - 1]);
    FAttribute.add(tokens[1]);
  end; {_ if NoTokens > 7 then _}
end; {_ procedure TFTPAS400List.ParseLine(Line: string); _}

procedure TFTPOTHERList.ParseLine(Line: string);
begin
  inherited ParseLine(Line);
  if NoTokens > 7 then
  begin
    FName.add(tokens[NoTokens]);
    FSize.add(tokens[NoTokens - 4]);
    FModifDate.add(tokens[NoTokens - 3] + ' ' + tokens[NoTokens - 2] + ' ' + tokens[NoTokens - 1]);
    FAttribute.add(tokens[1]);
  end; {_ if NoTokens > 7 then _}
end; {_ procedure TFTPOTHERList.ParseLine(Line: string); _}


{*******************************************************************************************
Initialize the  TNMFTP Component
********************************************************************************************}

constructor TNMFTP.Create;

begin
  inherited Create(AOwner); {Do Inherited create}
  Port := 21; {Set Default Port}
   {OnRead:=ProcessIdleRead;}{Set read functions for Asyncronous Reads}
  DataSocket := nil;
  FFTPDirectoryList := nil;
  FVendor := NMOS_AUTO;
  OnRead := CheckRead;
  InitializeCriticalSection(ProcessLock);
end; {_ constructor TNMFTP.Create; _}

destructor TNMFTP.Destroy;
begin
  Cancel;
  DeleteCriticalSection(ProcessLock);
 //  if Connected then Disconnect;
  if FFTPDirectoryList <> nil then
    FFTPDirectoryList.free;
  inherited Destroy;
end; {_ destructor TNMFTP.Destroy; _}

{*******************************************************************************************
Disconnect from server
********************************************************************************************}

procedure TNMFTP.Disconnect;
var
  Replymess: string;
begin
  BeenCanceled := False; {Reset Cancelled flag}
  if Connected then
      {If Connected}
  begin
    StatusMessage(Status_Informational, Cont_Quit); {Inform Status}
    try
      FFTPDirectoryList.free;
      FFTPDirectoryList := nil;
      FVendor := NMOS_AUTO;
      if DataAvailable then Read(0);
      Replymess := Transaction(Cont_Quit); {Do a Quit transaction}
      if ((ReplyNumber > 300) and (ReplyNumber < 600))
        then raise FTPException.Create(Replymess); {If Error raise exception}
      CloseImmediate;
    finally
      inherited Disconnect; {Finally Disconnect}
    end {_ try _}
  end; {_ if Connected then _}
end; {_ procedure TNMFTP.Disconnect; _}

{*******************************************************************************************
Initialize a FTP connection
********************************************************************************************}

procedure TNMFTP.Connect;
var
  Replymess: string;
  Handled: Boolean;

begin
  BeenCanceled := False; {Reset Cancelled flag}
  if not Connected then
      {If not already connected}
  begin
    ClearInput;
    inherited Connect; {Do the inherited connect}
    try
      Replymess := ' ';
      ReadExtraLines(Replymess);
      if ReplyNumber > 400 then
      begin
        if Assigned(OnConnectionFailed) then OnConnectionFailed(self);
        raise FTPException.Create(Replymess); {If Error show exception}
      end;
         // Below this line added by Edward T. Smith 11/18/1998
// FFWUserID is the firewall user ID
      if FFWAuth then
      begin
        Replymess := Transaction(Cont_User + FFWUserID); {Send User Name and check result}
        if (ReplyNumber > 400) and (ReplyNumber < 600) then
        begin
          if Assigned(OnConnectionFailed) then OnConnectionFailed(self);
          raise FTPException.Create(Replymess); {If Error show exception}
        end;
        if ReplyNumber = 331 then
              {If Password Needed}
        begin
          StatusMessage(Status_Informational, Cont_Pass); {Show outgoing Message} {Show Outgoing Message}
          Replymess := Transaction(Cont_Pass + FFWPassword); {Send Password and check result}
// FFWPassword is the firewall password
          if (ReplyNumber > 400) and (ReplyNumber < 600) then
          begin
            if Assigned(OnConnectionFailed) then OnConnectionFailed(self);
            raise FTPException.Create(Replymess); {If Error show exception}
          end;
        end; {_ if ReplyNumber = 331 then _}
      end; // FIrewall Authentication

// Above this line added by Edward T. Smith 11/18/1998
      if (FUserID = '') or (Password = '') then
        if Assigned(FOnAuthenticationNeeded) then FOnAuthenticationNeeded(Handled);
      if Proxy <> '' then
      begin
        case FFirewallType of
          FTUser: Replymess := Transaction('USER ' + UserID + '@' + Host);
          FtOpen: Replymess := Transaction('OPEN ' + Host);
          FtSite: Replymess := Transaction('SITE ' + Host);
        end;
      end;
      if (Proxy = '') or (FFirewallType <> FTUser) then
      begin
        StatusMessage(Status_Informational, Cont_User + UserID); {Show Outgoing message}
        Replymess := Transaction(Cont_User + UserID); {Send User Name and check result}
        if (ReplyNumber > 400) and (ReplyNumber < 600) then
        begin
          if Assigned(OnConnectionFailed) then OnConnectionFailed(self);
          raise FTPException.Create(Replymess); {If Error show exception}
        end;
      end;
      if ReplyNumber = 331 then
            {If Password Needed}
      begin
        StatusMessage(Status_Informational, Cont_Pass); {Show outgoing Message} {Show Outgoing Message}
        Replymess := Transaction(Cont_Pass + Password); {Send Password and check result}
        if (ReplyNumber > 400) and (ReplyNumber < 600) then
        begin
          if Assigned(OnConnectionFailed) then OnConnectionFailed(self);
          raise FTPException.Create(Replymess); {If Error show exception}
        end;
      end; {_ if ReplyNumber = 331 then _}
      if Assigned(FOnConnect) then FOnConnect(self);
    except {If fault}
      if Connected then Disconnect; {Disconnect}
      StatusMessage(Status_Informational, sFTP_Msg_Disconnect); {Show Status}
      raise; {Show disconnected status}
    end; {_ try _}
  end; {_ if not Connected then _}
end; {_ procedure TNMFTP.Connect; _}
{*******************************************************************************************
Do a generic FTP Command
********************************************************************************************}

procedure TNMFTP.DoCommand(CommandStr: string);
var Replymess: string;
  Handled: Boolean;
  ThisCmd: TCmdType;
begin
  if NthWord(CommandStr, ' ', 1) + ' ' = Cont_Cwd then ThisCmd := cmdChangeDir
  else if NthWord(CommandStr, ' ', 1) + ' ' = Cont_Dele then ThisCmd := cmdDelete
  else if NthWord(CommandStr, ' ', 1) + ' ' = Cont_Mkd then ThisCmd := cmdMakeDir
  else if NthWord(CommandStr, ' ', 1) + ' ' = Cont_Rmd then ThisCmd := cmdRemoveDir
  else if CommandStr = Cont_Pwd then ThisCmd := cmdCurrentDir
  else {_ NOT if CommandStr = Cont_Pwd then ThisCmd := cmdCurrentDir _}  ThisCmd := cmdDoCommand;
  BeenCanceled := False; {Reset Cancelled flag}
  CertifyConnect;
  if Connected then
      {If connected}
  begin
    StatusMessage(Status_Informational, CommandStr); {Show Outgoing Message}
    if DataAvailable then Read(0);
    Replymess := Transaction(CommandStr); {Send command and chectk result}
    if (ReplyNumber > 399) and (ReplyNumber < 600) then
    begin
      if Assigned(FOnUnSupportedFunction) and (ReplyNumber >= 500) and (ReplyNumber <= 502) then FOnUnSupportedFunction(ThisCmd);
      if not Assigned(FOnFailure) then raise FTPException.Create(Replymess)
            {Raise exception on errors}
      else {_ NOT if not assigned(FOnFailure) then raise FTPException.Create(Replymess) _}
      begin
        Handled := False;
        FOnFailure(Handled, ThisCmd);
        if not Handled then raise FTPException.Create(Replymess);
            {Raise exception on errors}
      end {_ NOT if not assigned(FOnFailure) then raise FTPException.Create(Replymess) _}
    end {_ if (ReplyNumber > 399) and (ReplyNumber < 600) then _}
    else if Assigned(FOnSuccess) then FOnSuccess(ThisCmd);
  end; {_ if Connected then _}
end; {_ procedure TNMFTP.DoCommand(CommandStr: string); _}

{*******************************************************************************************
Change the Dirctory at remote host
********************************************************************************************}

procedure TNMFTP.ChangeDir(DirName: string);
begin
  DoCommand(Cont_Cwd + DirName); {Do Change Directory}
end; {_ procedure TNMFTP.ChangeDir(DirName: string); _}

{*******************************************************************************************
Rename  File in Remote Server
********************************************************************************************}


procedure TNMFTP.Rename(Filename, FileName2: string);
var
  Replymess: string;
  Handled: Boolean;