ftpunit.pas

来自「著名的SecureBlackBox控件完整源码」· PAS 代码 · 共 656 行 · 第 1/2 页

end;

procedure TFTPForm.btnPWDClick(Sender: TObject);
begin
  if FClient.Active then
  begin
    try
      memoOutput.Text := memoOutput.Text + 'Current directory is: ' + FClient.GetCurrentDir + #13#10;
    except
      on E : Exception do
        Log(E.Message, true);
    end;
  end
  else
    Log(sNotConnected, true);
end;

procedure TFTPForm.FormDestroy(Sender: TObject);
begin
  FinalizeApp;
end;

procedure TFTPForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Disconnect;
  CanClose := true;
end;

procedure TFTPForm.btnCWDClick(Sender: TObject);
begin
  if FClient.Active then
  begin
    if editCmdParam.Text = '' then
    begin
      ShowMessage(sNoParameter);
    end
    else
    begin
      try
        Log('Changing directory...', false);
        FClient.Cwd(Trim(editCmdParam.Text));
        Log('Directory changed.' + #13#10 + 'Current directory is: ' + FClient.GetCurrentDir, false);
      except
        on E : Exception do
          Log(E.Message, true);
      end;
    end;
  end
  else
    Log(sNotConnected, true);
end;

procedure TFTPForm.btnCDUpClick(Sender: TObject);
begin
  if FClient.Active then
  begin
    try
      Log('Changing directory...', false);
      FClient.CDUp();
      Log('Directory changed.' + #13#10 + 'Current directory is: ' + FClient.GetCurrentDir, false);
    except
      on E : Exception do
        Log(E.Message, true);
    end;
  end
  else
    Log(sNotConnected, true);
end;

procedure TFTPForm.mnuAboutClick(Sender: TObject);
begin
  ShowAbout;
end;

procedure TFTPForm.FormCreate(Sender: TObject);
begin
  InitializeApp;
end;

procedure TFTPForm.btnListClick(Sender: TObject);
begin
  if FClient.Active then
  begin
    try
      Log('Retrieving directory contents ...', false);
      FClient.GetFileList;
      Log('Directory contents retrieved', false);
    except
      on E : Exception do
        Log(E.Message, true);
    end;
  end
  else
    Log(sNotConnected, true);
end;

procedure TFTPForm.ClientTextDataLine(Sender: TObject;
  const TextLine: string);
begin
  memoOutput.Text := memoOutput.Text + TextLine + #13#10;
end;

procedure TFTPForm.btnMKDClick(Sender: TObject);
begin
  if FClient.Active then
  begin
    if editCmdParam.Text = '' then
    begin
      ShowMessage(sNoParameter);
    end
    else
    begin
      try
        Log('Creating directory...', false);
        FClient.MakeDir(Trim(editCmdParam.Text));
        Log('Directory created.', false);
      except
        on E : Exception do
          Log(E.Message, true);
      end;
    end;
  end
  else
    Log(sNotConnected, true);
end;

procedure TFTPForm.btnRMDClick(Sender: TObject);
begin
  if FClient.Active then
  begin
    if editCmdParam.Text = '' then
    begin
      ShowMessage(sNoParameter);
    end
    else
    begin
      try
        Log('Removing directory...', false);
        FClient.RemoveDir(Trim(editCmdParam.Text));
        Log('Directory removed.', false);
      except
        on E : Exception do
          Log(E.Message, true);
      end;
    end;
  end
  else
    Log(sNotConnected, true);
end;

procedure TFTPForm.btnDownloadClick(Sender: TObject);
var FDataStream : TStream;
begin
  if FClient.Active then
  begin
    if editCmdParam.Text = '' then
    begin
      ShowMessage(sNoParameter);
    end
    else
    begin
      dlgSave.Filename := ExtractFileName(editCmdParam.Text);
      if dlgSave.Execute then
      try
        FDataStream := TFileStream.Create(dlgSave.Filename, fmCreate or fmShareDenyWrite);
        try
          Log('Recieving file...', false);

          frmProgress.lSourceFile.Caption := Trim(editCmdParam.Text);
          frmProgress.lDestFile.Caption := dlgSave.Filename;

          frmProgress.pbProgress.Min := 0;
          frmProgress.pbProgress.Position := 0;
          frmProgress.Show;
          try
            try
              FClient.Receive(Trim(editCmdParam.Text), FDataStream, 0, 0);
            finally
              frmProgress.Hide;
            end;
          except
            on E : EOperationCancelledError do ;
          end;
          Log('File received.', false);
        finally
          FreeAndNil(FDataStream);
        end;
      except
        on E : Exception do
          Log(E.Message, true);
      end;
    end;
  end
  else
    Log(sNotConnected, true);
end;

procedure TFTPForm.btnUploadClick(Sender: TObject);
var FDataStream : TStream;
begin
  if FClient.Active then
  begin
    if editCmdParam.Text = '' then
    begin
      ShowMessage(sNoParameter);
    end
    else
    begin
      dlgOpen.Filename := ExtractFileName(editCmdParam.Text);
      if dlgOpen.Execute then
      try
        FDataStream := TFileStream.Create(dlgOpen.Filename, fmOpenRead or fmShareDenyWrite);
        try
          Log('Sending file...', false);
          frmProgress.lSourceFile.Caption := Trim(editCmdParam.Text);
          frmProgress.lDestFile.Caption := dlgSave.Filename;

          frmProgress.pbProgress.Min := 0;
          frmProgress.pbProgress.Position := 0;
          frmProgress.Show;
          try
            try
              FClient.Send(FDataStream, Trim(editCmdParam.Text), 0, FDataStream.Size - 1, false, 0);
            finally
              frmProgress.Hide;
            end;
          except
            on E : EOperationCancelledError do ;
          end;
          
          Log('File sent.', false);
        finally
          FreeAndNil(FDataStream);
        end;
      except
        on E : Exception do
          Log(E.Message, true);
      end;
    end;
  end
  else
    Log(sNotConnected, true);
end;

procedure TFTPForm.btnDeleteClick(Sender: TObject);
begin
  if FClient.Active then
  begin
    if editCmdParam.Text = '' then
    begin
      ShowMessage(sNoParameter);
    end
    else
    begin
      try
        Log('Deleting file...', false);
        FClient.Delete(Trim(editCmdParam.Text));
        Log('File deleted.', false);
      except
        on E : Exception do
          Log(E.Message, true);
      end;
    end;
  end
  else
    Log(sNotConnected, true);
end;

procedure TFTPForm.ClientControlreceive(Sender: TObject;
  const TextLine: string);
begin
  memoOutput.Text := memoOutput.Text + '<<<' + TextLine + #13#10;
end;

procedure TFTPForm.ClientControlSend(Sender: TObject;
  const TextLine: string);
begin
  memoOutput.Text := memoOutput.Text + '>>>' + TextLine + #13#10;
end;

procedure TFTPForm.ClientProgress(Sender : TObject; Total, Current : Int64; var Cancel : boolean);
begin
  if Total <= 0 then
  begin
    frmProgress.pbProgress.Max := 100;
    frmProgress.pbProgress.Position := Current mod 100;
  end
  else
  begin
    frmProgress.pbProgress.Max := Total;
    frmProgress.pbProgress.Position := Current;
  end;
  Application.ProcessMessages;
  if frmProgress.Canceled then Cancel := true;
  frmProgress.Canceled := false;
end;

procedure TFTPForm.ClientSSLError(Sender: TObject; ErrorCode: integer;
  Fatal, Remote: boolean);
var S : string;
begin
  if Fatal then
    S := 'Fatal '
  else
    S := '';
  if Remote then
    S := S + 'Remote '
  else
    S := s + 'Local ';

  S := S + 'Error ' + IntToStr(ErrorCode);
  Log(S, true);
  Log('If you are getting error 75778, this can mean that the remote server doesn''t support specified SSL/TLS version', true);
end;

initialization

SetLicenseKey('ADDCD14AD06709806817E0B3D7BFD0A2222D536FE156466C5D5FE65DB5DEAE76' + 
  'FFDEBC07E915A5751C12C01C783958872A38E4A5EDA140E7247E0F2E56442A3C' + 
  'F3E9347AD8FDE52083A0DFC86BC00ECB0FD0CF1B51159A2BCB84F6EA6349EF47' + 
  '5C15A59AFCC55F7C3AAD26C279628B5D91B1DC94BD2385354A70CCA3B76101D9' + 
  'F41C84A639FC3CCE4BA8F0CC4A66DCD150114A3F58C1AD46B7B94643741BC20A' + 
  '8DCA83AB921480951B423CAA19EF1863A47CA2C3422E7E5634BED98939A5AE43' + 
  'DE1E4BAD79E66D8A5C973B3455656C8C9B6FF024FADD6CDA02D0F506D98493C8' + 
  'BD1ED7B237DB75FA31F2C82654490CDDDEE24E19939137B9E1DB05508733B22F');

end.