nmftp.pas

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

      DataSocket.Destroy; { _Destroy datasocket_ }
      DataSocket := nil;
      if BeenCanceled then
      begin
        BeenCanceled := False;
        Replymess := Transaction('ABOR');
      end;
      LeaveCriticalSection(ProcessLock);
      if Success then if Assigned(FOnSuccess) then FOnSuccess(cmdList);
    end {_ try _}
  end; { _Connected_ }
end;

{*******************************************************************************************
Upload a file to a Remote Server
********************************************************************************************}

procedure TNMFTP.Upload(LocalFile, RemoteFile: string);
var
  Replymess: string;
  strm: TFileStream;
  Success, Handled: Boolean;
  Tsck: TSocket;
label CleanUp;
begin
  try
    Success := False;
    BeenCanceled := False; {If there is a cancelled process reset it}
    CertifyConnect; {Make sure Connection exists}
    if Connected then
    begin
      EnterCriticalSection(ProcessLock);
      if DataAvailable then Read(0);
      DataSocket := TPowersock.Create(self); {Create a Data socket}
      DataSocket.TimeOut := TimeOut;
      strm := TFileStream.Create(LocalFile, fmOpenRead);
      DataSocket.TimeOut := TimeOut;
      if Assigned(FPacketSent) then
        DataSocket.OnPacketSent := FPacketSent; {Set function to handle data socket status}
      try
        FBytesTotal := strm.Size;
      finally
        strm.Destroy;
      end; {_ try _}
      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, cmdUpload);
              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, cmdUpload);
              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_ };
        if RemoteFile = '' then
        begin
          StatusMessage(Status_Informational, Cont_Stor + LocalFile); {Show Outgoing Message}
          Replymess := Transaction(Cont_Stor + ExtractFileName(LocalFile)) {Give store unique cmmand}
        end {_ if RemoteFile = '' then _}
        else {_ NOT if RemoteFile = '' then _}
        begin
          StatusMessage(Status_Informational, Cont_Stor + RemoteFile); {Show Outgoing Message}
          Replymess := Transaction(Cont_Stor + RemoteFile); {Give store unique cmmand}
        end; {_ NOT if RemoteFile = '' then _}
        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 _}
        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);
        DataSocket.CloseAfterData;
        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);
        WinSock.CloseSocket(DataSocket.ThisSocket);
        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
        DataSocket.Destroy; { _Destroy datasocket_ }
        DataSocket := nil;
        LeaveCriticalSection(ProcessLock);
        if Success then if Assigned(FOnSuccess) then FOnSuccess(cmdUpload);

      end {_ try _}
    end; { _Connected_ }
  except
    Handled := False;
    FOnFailure(Handled, cmdUpload);
    if not Handled then
      raise;
  end;
end;

{*******************************************************************************************
Upload a file to a Remote Server
********************************************************************************************}

procedure TNMFTP.UploadRestore(LocalFile, RemoteFile: string; Position: integer);
var
  Replymess: string;
  strm: TFileStream;
  Success, Handled: Boolean;
  Tsck: TSocket;
  gudtLinger: Tlinger;
label CleanUp;

begin
  Success := False;
  BeenCanceled := False; {If there is a cancelled process reset it}
  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;
    strm := TFileStream.Create(LocalFile, fmOpenRead);
    DataSocket.TimeOut := TimeOut;
    if Assigned(FPacketSent) then
      DataSocket.OnPacketSent := FPacketSent; {Set function to handle data socket status}
    try
      FBytesTotal := strm.Size;
    finally
      strm.Destroy;
    end; {_ try _}
    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, cmdUpload);
            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, cmdUpload);
            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_ };
      if RemoteFile = '' then
      begin
        StatusMessage(Status_Informational, Cont_Rest + IntToStr(Position) + '' + Cont_Stor); {Show Outgoing Message}
        Replymess := Transaction(Cont_Rest + IntToStr(Position));
        Replymess := Transaction(Cont_Stor + ExtractFileName(LocalFile)); {Give store unique cmmand}
      end {_ if RemoteFile = '' then _}
      else {_ NOT if RemoteFile = '' then _}
      begin
        StatusMessage(Status_Informational, Cont_Rest + IntToStr(Position) + '' + Cont_Stor); {Show Outgoing Message}
        Replymess := Transaction(Cont_Rest + IntToStr(Position));
        Replymess := Transaction(Cont_Stor + RemoteFile); {Give store unique cmmand}
      end; {_ NOT if RemoteFile = '' then _}
      if (ReplyNumber > 399) 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 _}
      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);
      strm := TFileStream.Create(LocalFile, fmOpenRead);
      strm.Position := Position;
      try
        if not (BeenCanceled or BeenTimedOut)
          then DataSocket.SendRestStream(strm);
      finally
        strm.free;
      end;
            {If no Local filename specified save file same as remote}
      if Assigned(FTransactionStop) then FTransactionStop(self);
      gudtLinger.l_onoff := 0;
      gudtLinger.l_linger := 0;
      setsockopt(DataSocket.ThisSocket, SOL_SOCKET, SO_LINGER, @gudtLinger, 4);
      DataSocket.RequestCloseSocket;
      if not (BeenCanceled or BeenTimedOut) then
        Replymess := Read(0);
      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
      DataSocket.Destroy; { _Destroy datasocket_ }
      DataSocket := nil;
      if Success then if Assigned(FOnSuccess) then FOnSuccess(cmdUpload);
    end {_ try _}
  end; { _Connected_ }
end;

{*******************************************************************************************
Download a file from a Remote Server
********************************************************************************************}

procedure TNMFTP.Download(RemoteFile, LocalFile: string);
var
  Replymess: string;
  Success, Handled: Boolean;
  Tsck: TSocket;
label CleanUp;
begin
  try
    Success := False;
    BeenCanceled := False; {If there is a cancelled process reset it}
    CertifyConnect; {Make sure Connection exists}
    if Connected then
    begin
      EnterCriticalSection(ProcessLock);
      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}
      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, cmdDownload);
              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}