nmftp.pas

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

begin
  BeenCanceled := False; {Reset Cancelled flag}
  CertifyConnect;
  if Connected then
      {If connected}
  begin
    if DataAvailable then Read(0);
    StatusMessage(Status_Informational, Cont_Rnfr + Filename); {Show Outgoing Message}
    Replymess := Transaction(Cont_Rnfr + Filename); {Send Rename from and check result}
    if (ReplyNumber > 351) and (ReplyNumber < 600) then
      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, cmdRename);
        if not Handled then raise FTPException.Create(Replymess);
            {Raise exception on errors}
      end; {_ NOT if not assigned(FOnFailure) then raise FTPException.Create(Replymess) _}
    StatusMessage(Status_Informational, Cont_Rnto + FileName2); {Show Outgoing Message}
    Replymess := Transaction(Cont_Rnto + FileName2); {Send Rename to and check result}
    if (ReplyNumber > 300) and (ReplyNumber < 600) then
    begin
      if Assigned(FOnUnSupportedFunction) and (ReplyNumber >= 500) and (ReplyNumber <= 502) then FOnUnSupportedFunction(cmdRename);
      if not Assigned(FOnFailure) then
        raise FTPException.Create(Replymess)
            {Raise exception on errors}
      else {_ NOT if not assigned(FOnFailure) then _}
      begin
        Handled := False;
        FOnFailure(Handled, cmdRename);
        if not Handled then
          raise FTPException.Create(Replymess);
            {Raise exception on errors}
      end {_ NOT if not assigned(FOnFailure) then _}
    end {_ if (ReplyNumber > 300) and (ReplyNumber < 600) then _}
    else if Assigned(FOnSuccess) then FOnSuccess(cmdRename);
  end; {_ if Connected then _} {Resume Asynchronous Processing}
end; {_ procedure TNMFTP.Rename(Filename, FileName2: string); _}

{*******************************************************************************************
Delete file in remote server
********************************************************************************************}


procedure TNMFTP.Delete(Filename: string);

begin
  DoCommand(Cont_Dele + Filename); {Send Delete command and check result}
end; {_ procedure TNMFTP.Delete(Filename: string); _}

{*******************************************************************************************
Delete file in remote server
********************************************************************************************}

procedure TNMFTP.MakeDirectory(DirectoryName: string);

begin
  DoCommand(Cont_Mkd + DirectoryName); {Send Delete command and check result}
end; {_ procedure TNMFTP.MakeDirectory(DirectoryName: string); _}

{*******************************************************************************************
Delete file in remote server
********************************************************************************************}

procedure TNMFTP.RemoveDir(DirectoryName: string);
begin
  DoCommand(Cont_Rmd + DirectoryName); {Send Delete command and check result}
end; {_ procedure TNMFTP.RemoveDir(DirectoryName: string); _}


{*******************************************************************************************
Upload file to Remote Server with unique name
********************************************************************************************}

procedure TNMFTP.UploadUnique(LocalFile: string);
var
  Replymess: string;
  strm: TFileStream;
  Done, Handled: Boolean;
  Tsck: TSocket;
label CleanUp;
begin
  Done := False;
  BeenCanceled := False; {Reset Cancelled flag}
  CertifyConnect;
  if Connected then
      {If connected}
  begin
    DataSocket := TPowersock.Create(self); {Create a Data socket}
    DataSocket.TimeOut := TimeOut;
    try
      if DataAvailable then Read(0);
      DataSocket.TimeOut := TimeOut;
      DataSocket.Port := 0; {Set Port to Zero}
      DataSocket.Listen(True); {Listen in the datasocket}
      strm := TFileStream.Create(LocalFile, fmOpenRead);
      try
        FBytesTotal := strm.Size;
      finally
        strm.Destroy;
      end; {_ try _}
      StatusMessage(Status_Informational, Cont_Port + GetLocalAddress + DataSocket.GetPortString); {Show Outgoing Message}
      Replymess := Transaction(Cont_Port + GetLocalAddress + DataSocket.GetPortString); {Send Port for data socket}
      if (ReplyNumber > 300) and (ReplyNumber < 600) then
        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, cmdUpload);
          if not Handled then raise FTPException.Create(Replymess)
          else goto CleanUp;
               {Raise exception on errors}
        end; {_ NOT if not assigned(FOnFailure) then raise FTPException.Create(Replymess) _}
      if Assigned(FPacketSent) then
        DataSocket.OnPacketSent := FPacketSent; {Set function to handle data socket status}
      StatusMessage(Status_Informational, Cont_Stou); {Show Outgoing Message}
      Replymess := Transaction(Cont_Stou); {Give store unique cmmand}
      if (ReplyNumber > 300) and (ReplyNumber < 600) then
      begin
        if Assigned(FOnUnSupportedFunction) and (ReplyNumber >= 500) and (ReplyNumber <= 502) then FOnUnSupportedFunction(cmdUpload);
        if not Assigned(FOnFailure) then
          raise FTPException.Create(Replymess)
               {Raise exception on errors}
        else {_ NOT if not assigned(FOnFailure) then _}
        begin
          Handled := False;
          FOnFailure(Handled, cmdUpload);
          if not Handled then
            raise FTPException.Create(Replymess)
          else goto CleanUp;
               {Raise exception on errors}
        end; {_ NOT if not assigned(FOnFailure) then _}
      end; {_ if (ReplyNumber > 300) and (ReplyNumber < 600) then _}
      Tsck := DataSocket.handle;
      DataSocket.ThisSocket := DataSocket.Accept; {Accept the datasocket}
      WinSock.CloseSocket(Tsck);
      if Assigned(FTransactionStart) then FTransactionStart(self);
      if not (BeenCanceled or BeenTimedOut) then DataSocket.SendFile(LocalFile);
         {If no Local filename specified save file same as remote}
      if Assigned(FTransactionStop) then FTransactionStop(self);
      DataSocket.RequestCloseSocket;
      if not (BeenCanceled or BeenTimedOut) then
        if DataAvailable then Readln
        else {_ NOT if DataAvailable > 0 then read (0); _}  Replymess := sFTP_Cont_Msg_UpldS;
      StatusMessage(Status_Informational, Replymess);
      if not (BeenCanceled or BeenTimedOut) then ReadExtraLines(Replymess); {Read Extra Lines}
      Done := True;
      CleanUp:
    finally
      DataSocket.Destroy; {Destroy datasocket}
      DataSocket := nil;
      if Done then if Assigned(FOnSuccess) then FOnSuccess(cmdUpload);
    end; {_ try _}
  end; {_ if Connected then _}
end; {_ procedure TNMFTP.UploadUnique(LocalFile: string); _}



{*******************************************************************************************
List Current Directory in Remote Server
********************************************************************************************}

procedure TNMFTP.List;
var
  Replymess: string;
  Success, Handled: Boolean;
  Tsck: TSocket;
label CleanUp;
begin
  EnterCriticalSection(ProcessLock);
  Success := False;
  BeenCanceled := False; {If there is a cancelled process reset it}
   //if Fabort then
   //  begin
   //    ReplyMess:= transaction('ABOR');
   //    Fabort := False;
   //  end;

  CertifyConnect; {Make sure Connection exists}
  if Connected then
  begin
    if DataAvailable then Read(0);
    DataSocket := TPowersock.Create(self); {Create a Data socket}
    DataSocket.TimeOut := TimeOut;
    if Assigned(FPacketRecvd) then
      DataSocket.OnPacketRecvd := FPacketRecvd; {Set function to handle data socket status}
    if FParseList then
    begin
      if FFTPDirectoryList = nil then
      begin
        if Vendor = NMOS_AUTO then
        begin
          try DoCommand('SYST')except end;
          if (Pos('UNIX', TransactionReply) > 0) then
            FVendor := NMOS_UNIX
          else if (Pos('NETWARE', TransactionReply) > 0) then
            FVendor := NMOS_NETWARE
          else if (Pos('DOS', TransactionReply) > 0) then
            FVendor := NMOS_WINDOWS
          else if (Pos('VMS', TransactionReply) > 0) then
            FVendor := NMOS_VMS
          else if (Pos('MVS', TransactionReply) > 0) then
            FVendor := NMOS_MVS_IBM
          else if (Pos('VM', TransactionReply) > 0) then
            FVendor := NMOS_VM
          else if (Pos('MACOS', TransactionReply) > 0) then
            FVendor := NMOS_MAC
          else if (Pos('OS/400', TransactionReply) > 0) then
            FVendor := NMOS_AS400
          else {_ NOT if (Pos('OS/400', TransactionReply) > 0) then _}
            FVendor := NMOS_OTHER;
        end; {_ if Vendor = NMOS_AUTO then _}
        case FVendor of
          NMOS_UNIX: FFTPDirectoryList := TFTPUnixList.Create;
          NMOS_NETWARE: FFTPDirectoryList := TFTPUnixList.Create;
          NMOS_WINDOWS: FFTPDirectoryList := TFTPUnixList.Create;
          NMOS_VMS: FFTPDirectoryList := TFTPUnixList.Create;
          NMOS_MVS_IBM: FFTPDirectoryList := TFTPUnixList.Create;
          NMOS_VM: FFTPDirectoryList := TFTPUnixList.Create;
          NMOS_MAC: FFTPDirectoryList := TFTPUnixList.Create;
          NMOS_AS400: FFTPDirectoryList := TFTPUnixList.Create;
          NMOS_OTHER: FFTPDirectoryList := TFTPUnixList.Create;
        end; {_ case FVendor of _}
      end; {_ if FFTPDirectoryList <> nil then _}
      FFTPDirectoryList.Clear;
    end; {_ if FParseList then _}
    DataSocket.TimeOut := TimeOut;

    try
      if FPassive then
      begin
        Replymess := Transaction('PASV');
        if (ReplyNumber > 499) then
          if not Assigned(FOnFailure) then
            raise FTPException.Create(Replymess)
          else
          begin
            Handled := False;
            FOnFailure(Handled, cmdList);
            if not Handled then
              raise FTPException.Create(Replymess)
            else goto CleanUp;
                              {Raise exception on errors}
          end; {_ NOT if not assigned(FOnFailure) then _}
        DataSocket.Port := StrToInt(Copy(NthWord(Replymess, ',', 6), 1, Pos(')', NthWord(Replymess, ',', 6)) - 1)) + (256 * StrToInt(NthWord(Replymess, ',', 5)));
        DataSocket.Host := Host;
        DataSocket.Connect;
      end
      else { _FPassive_ }
      begin
        DataSocket.Port := 0; {Set Port to Zero}
        DataSocket.Listen(True); {Listen in the datasocket}
        Replymess := Transaction(Cont_Port + GetLocalAddress + DataSocket.GetPortString); {Send Port for data socket}
        if (ReplyNumber > 300) and (ReplyNumber < 600) then
          if not Assigned(FOnFailure) then
            raise FTPException.Create(Replymess)
                        {Raise exception on errors}
          else {_ NOT if not assigned(FOnFailure) then _}
          begin
            Handled := False;
            FOnFailure(Handled, cmdList);
            if not Handled then
              raise FTPException.Create(Replymess)
            else goto CleanUp;
                           {Raise exception on errors}
          end; {_ NOT if not assigned(FOnFailure) then _}

      end { not _FPassive_ };
      StatusMessage(Status_Informational, Cont_List); {Show Outgoing Message}
      if FListMask = '' then Replymess := Transaction(Cont_List)
      else Replymess := Transaction(Cont_List + ' ' + FListMask); {Send List command}
      if (ReplyNumber > 300) and (ReplyNumber < 600) then
      begin
        if Assigned(FOnUnSupportedFunction) and (ReplyNumber >= 500) and (ReplyNumber <= 502) then FOnUnSupportedFunction(cmdList);
        if not Assigned(FOnFailure) then
          raise FTPException.Create(Replymess)
                    {Raise exception on errors}
        else {_ NOT if not assigned(FOnFailure) then _}
        begin
          Handled := False;
          FOnFailure(Handled, cmdList);
          if not Handled then
            raise FTPException.Create(Replymess)
          else goto CleanUp;
                  {Raise exception on errors}
        end; {_ NOT if not assigned(FOnFailure) then _}
      end; {_ if (ReplyNumber > 300) and (ReplyNumber < 600) then _}
      if not FPassive then
      begin
        Tsck := DataSocket.handle;
        DataSocket.ThisSocket := DataSocket.Accept; {Accept the datasocket}
        WinSock.CloseSocket(Tsck);
      end;
      if Assigned(FTransactionStart) then FTransactionStart(self);
      while not (BeenCanceled or BeenTimedOut or DataSocket.DataAvailable) and DataSocket.Connected do
        DataSocket.wait;
      if not (BeenCanceled or BeenTimedOut) then
        repeat
          if DataSocket.DataAvailable then
          begin
            Replymess := DataSocket.Readln;
            if (Replymess = '') then Break;
            if Length(Replymess) > 2 then
              if Replymess[Length(Replymess) - 1] = #13 then
                SetLength(Replymess, Length(Replymess) - 2)
              else
                SetLength(Replymess, Length(Replymess) - 1);
            if FParseList then
              FFTPDirectoryList.ParseLine(Replymess);
            if Assigned(FOnListItem) then FOnListItem(Replymess);
          end
          else
            DataSocket.wait; //Application.ProcessMessages;
        until (((not DataSocket.Connected) or DataAvailable) and (not DataSocket.DataAvailable)) or BeenTimedOut or BeenCanceled;
      if Assigned(FTransactionStop) then FTransactionStop(self);
      if DataSocket.Connected then DataSocket.RequestCloseSocket;
      if not (BeenCanceled or BeenTimedOut) then
        Replymess := Readln;
      if Replymess = '' then Replymess := '226 Data Transfer successful';
      StatusMessage(Status_Informational, Replymess);
      if not (BeenCanceled or BeenTimedOut) then ReadExtraLines(Replymess); {Read Extra Lines}
      Success := True;
      CleanUp:
    finally