【摘自网上】Delphi TppReport

转载 2011年01月17日 15:43:00

在TppBDEPipeline的DataSource中关联数据源

TppReport中的DataPipeline中设置TppBDEPipeline

TppViewer的Report中设置TppReport

 

 

 

技术原理

     通过在TppReport的BeforePrint事件中对TPrinterDevice的PageSetting属性和PageList属性进行赋值

为何要如此处理?

根据分析ReportBuilder源码,我们得到如下的调用顺序TppViewer -> TppProducer -> TppPrinterDevice -> TppPageRequest -> TppPublisher,其中 TppPageRequest 封装了打印页范围信息,而TppPrinterDevice 负责将指定的页发送到PrinterCanvas

实现步骤

  1、在调用单元声明一个类私有变量,用于保存打印页范围

  type

    ...

  private

    sPageRange: string;

    ...

  end;

  2、在调用单元声明一个类私有过程,用于处理TppReport.BeforePrint事件

procedure TfrmMain.ppReportBeforePrint(Sender: TObject);

begin

  if Sender is TppReport then

    if (Sender as TppReport).PrinterDevice <> nil then

    begin

      (Sender as TppReport).PrinterDevice.PageSetting := psPageList;

      ppTextToPageList(sPageRange, (Sender as TppReport).PrinterDevice.PageList, True);

    end;

end;

  3、在打印之前设置打印页范围,将TppReport.BeforePrint引导到自定义过程

  sPageRange := '3-5';

  (ppViewer1.Report as TppReport).BeforePrint := ppReportBeforePrint;

  (ppViewer1.Report as TppReport).ShowPrintDialog := False;

  ppViewer1.Print;

注意事项

  1,如果找不到TppReport类别,在接口引用单元添加ppReport单元

  2,如果找不到psPageList类别,在接口引用单元添加ppTypes单元

  3,如果找不到ppTextToPageList函数,在接口引用单元添加ppUtils单元

  4,sPageRange可以定义三种类型的页范围

     A:起止页:'3-10'//连接线分隔

     B:分隔页:'3,5,7'//逗号分隔

     C:单独页:'7'

 

unit SecDComConnection;

interface

uses

  windows,SysUtils, Classes,ActiveX, DB, DBClient, MConnect,comobj,Midas;

type

{typedef struct _SEC_WINNT_AUTH_IDENTITY

 unsigned short __RPC_FAR* User;

  unsigned long UserLength;

  unsigned short __RPC_FAR* Domain;

  unsigned long DomainLength;

  unsigned short __RPC_FAR* Password;

  unsigned long PasswordLength;

  unsigned long Flags;

 SEC_WINNT_AUTH_IDENTITY, *PSEC_WINNT_AUTH_IDENTITY;

}

  {typedef struct _COAUTHIDENTITY

    USHORT * User;

    ULONG UserLength;

    USHORT * Domain;

    ULONG DomainLength;

    USHORT * Password;

    ULONG PasswordLength;

    ULONG Flags;

COAUTHIDENTITY;}

{#define RPC_C_AUTHN_NONE            0

#define RPC_C_AUTHN_DCE_PRIVATE     1

#define RPC_C_AUTHN_DCE_PUBLIC      2

#define RPC_C_AUTHN_DEC_PUBLIC      4

#define RPC_C_AUTHN_GSS_NEGOTIATE   9

#define RPC_C_AUTHN_WINNT          10

#define RPC_C_AUTHN_GSS_SCHANNEL   14

#define RPC_C_AUTHN_GSS_KERBEROS   16

#define RPC_C_AUTHN_MSN            17

#define RPC_C_AUTHN_DPA            18

#define RPC_C_AUTHN_MQ            100

#define RPC_C_AUTHN_DEFAULT       0xFFFFFFFFL

}

{#define RPC_C_AUTHZ_NONE      0

#define RPC_C_AUTHZ_NAME      1

#define RPC_C_AUTHZ_DCE       2

#define RPC_C_AUTHZ_DEFAULT   0xFFFFFFFF }

{

#define RPC_C_AUTHN_LEVEL_DEFAULT         0

#define RPC_C_AUTHN_LEVEL_NONE            1

#define RPC_C_AUTHN_LEVEL_CONNECT         2

#define RPC_C_AUTHN_LEVEL_CALL            3

#define RPC_C_AUTHN_LEVEL_PKT             4

#define RPC_C_AUTHN_LEVEL_PKT_INTEGRITY   5

#define RPC_C_AUTHN_LEVEL_PKT_PRIVACY     6 }

{SEC_WINNT_AUTH_IDENTITY_UNICODE=2 }

   pUnShort=^Word;

   pCoAuthIdentity=^_CoAuthIdentity;

   _CoAuthIdentity=record

     user:pUnShort;

     UserLength:ULONG;

     Domain:pUnShort;

     DomainLength:Ulong;

     password:pUnShort;

     PasswordLength:ulong;

     Flags:ulong;

   end;

  _CoAuthInfo=record

    dwAuthnSvc:DWORD;

    dwAuthzSvc:DWORD;

    pwszServerPrincName:WideString;

    dwAuthnLevel:Dword;

    dwImpersonationLevel:dword;

    pAuthIdentityData:pCoAuthIdentity;

    dwCapabilities:DWORD;

  end;

  TSecDComConnection = class(TDCOMConnection)

  private

   FCai:_CoAuthInfo;

   FCid:_CoAuthIdentity;

   FSvInfo:COSERVERINFO;

   FUser:WideString;

   FPassWord:WideString;

   procedure SetPassword(const Value: wideString);

   procedure SetUser(const Value: wideString);

    procedure SetSvInfo(const Value: COSERVERINFO);

  protected

    procedure DoConnect; override;

  public

    property SvInfo:COSERVERINFO read FSvInfo write SetSvInfo;

    constructor Create(AOwner: TComponent); override;

    procedure MySetBlanket(itf:IUnknown;const vCai:_CoAuthInfo);

    function GetServer: IAppServer; override;

  published

    property User:wideString read FUser write SetUser;

    Property Password:wideString read FPassword write SetPassword;

  end;

procedure Register;

implementation

constructor TSecDCOMConnection.Create(AOwner: TComponent);

begin

  inherited Create(AOwner);

  FillMemory(@Fcai,sizeof(Fcai),0);

  FillMemory(@FCid,sizeof(FCid),0);

  FillMemory(@FSvInfo,sizeof(FSvInfo),0);

  with FCai do begin

    dwAuthnSvc:=10;//RPC_C_AUTHN_WINNT

    dwAuthzSvc:=0;// RPC_C_AUTHZ_NONE

    dwAuthnLevel:=0;//RPC_C_AUTHN_LEVEL_DEFAULT

    dwImpersonationLevel:=3;

    pAuthIdentityData:=@fcid;

    dwCapabilities:=$0800;

  end;

end;

procedure TSecDCOMConnection.DoConnect;

var

 tmpCmpName:widestring;

 IID_IUnknown:TGUID;

 iiu:IDispatch;

 Mqi:MULTI_QI;

 qr:HRESULT;

begin

  if (ObjectBroker) <> nil then

  begin

    repeat

      if ComputerName = '' then

        ComputerName := ObjectBroker.GetComputerForGUID(GetServerCLSID);

      try

        SetAppServer(CreateRemoteComObject(ComputerName, GetServerCLSID) as IDispatch);

        ObjectBroker.SetConnectStatus(ComputerName, True);

      except

        ObjectBroker.SetConnectStatus(ComputerName, False);

        ComputerName := '';

      end;

    until Connected;

  end

  else if (ComputerName <> '') then

    begin

      with fcid do begin

        user:=pUnshort(@fuser);

        UserLength:=length(fuser);

        tmpCmpName:=ComputerName;

        Domain:=pUnshort(@tmpCmpName);

        DomainLength:=length(TmpCmpName);

        password:=pUnShort(@FPassword);

        PasswordLength:=length(FPassword);

        Flags:=2;//Unicode

      end;

      FSvInfo.pwszName:=pwidechar(tmpCmpName);

      FSvinfo.pAuthInfo:=@Fcai;

      IID_IUnknown:=IUnknown;

      mqi.IID:=@IID_IUnknown;mqi.Itf:=nil;mqi.hr:=0;

      olecheck(CoCreateInstanceEx(GetServerCLSID,nil,CLSCTX_REMOTE_SERVER,@FSvinfo,1,@mqi));

      olecheck(mqi.hr);

      MySetBlanket(mqi.Itf,Fcai);

      qr:=mqi.Itf.QueryInterface(idispatch,iiu);

      olecheck(qr);

      MySetBlanket(IUnknown(iiu),FCai);

      SetAppServer(iiu);

    end

    else

      inherited DoConnect;

end;

function TSecDComConnection.GetServer: IAppServer;

var

  QIResult: HResult;

begin

  Connected := True;

  QIResult := IDispatch(AppServer).QueryInterface(IAppServer, Result);

  if QIResult <> S_OK then

  begin

    Result := TDispatchAppServer.Create(IAppServerDisp(IDispatch(AppServer)));

  end;

  MySetBlanket(IUnknown(Result),FCai);

end;

procedure TSecDCOMConnection.MySetBlanket(itf: IUnknown;

  const vCai: _CoAuthInfo);

begin

 with vCai do

 CoSetProxyBlanket(Itf,dwAuthnSvc,dwAuthzSvc,pwidechar(pAuthIdentityData^.Domain),

    dwAuthnLevel,dwImpersonationLevel,pAuthIdentityData,dwCapabilities);

end;

procedure TSecDCOMConnection.SetPassword(const Value: wideString);

begin

  FPassword := Value;

end;

procedure TSecDCOMConnection.SetSvInfo(const Value: COSERVERINFO);

begin

  FSvInfo := Value;

end;

procedure TSecDCOMConnection.SetUser(const Value: wideString);

begin

  FUser := Value;

end;

procedure Register;

begin

  RegisterComponents('DataSnap', );

end;

end.

代码中有一些C风格的注释,是因为delphi没有为我们预定义这些变量和数据结构。如何使用呢?将这个组件安装在IDE中,并将其放到你的现有代码的远程数据模块中去,将原有指向TDOCMConnection的数据集控件设置成这个新的TSecDCOMConnection控件。然后你可以在远程计算机中设置最严格的安全选项。但是要记住应该为你要使用的用户设置合适的权限:给予远程激活权限、给予远程访问权限。4、到现在还没有谈到访问的问题。首先激活和访问并不是一回事。一个用户可能拥有激活权限但没有访问权限,也有可能只有访问权限却无激活权限。前面谈到CoCreateInstacnceEx可以用另一身份激活对象并取得IunKnown指针的一个本地引用。如果你直接用这个指针去取得IappServer接口并调用方法,那么你很可能又会见到“拒绝访问”信息。这是IUnKnown指针的本地引用存在于客户机的进程中,再没有做特殊设置前,该指针继承了客户机进程的本地令牌,也就是说当用这个指针获取远程IappServer接口时,会用客户机当前登录令牌调用QueryInterface,在调用过程中远程计算机将有此令牌中缓存的用户名和密码进行再次登录验证,当然此时又会被拒绝,而后远程计算机再次尝试用GUEST帐户登录并获取com对象接口,此时若没有找开GUEST访问权限,则客户端访问失败,windows

返回“拒绝访问”信息。那么怎样才能使QueryInterface调用也使用远程用户身份呢,这就要调用CoSetProxyBlanket强制设置本地接口引用使用远程用户的令牌。在上面的代码中,我用MySetBlanket包装了该API,以便使用激活时的用户身份调用QueryInterface。而后在取得的IappServer接口上再次调用MySetBlanket,保证在使用该接口时也采用远程用户身份。

      MySetBlanket(mqi.Itf,Fcai);

      qr:=mqi.Itf.QueryInterface(idispatch,iiu);

      olecheck(qr);

      MySetBlanket(IUnknown(iiu),FCai); 为保证直接引用DataProvider的TclientDataSet也能按上述要求工作,在扩展的TSecDCOMConnection控件中,重载了GetServer方法。这样TSecDCOMConnection已能完全替换TDCOMConnection实现便利的com+应用编程了。由于时间仓促,写这篇时很多术语没有做解释交待,因此可能会有一些不太好理解,但是出于为delphi Fans提供一个简单的实现安全性com访问的方法,我还是将这篇贴上来,主要是可以让需要的朋友直接复制代码用在自己的应用上。使用TSecDCOMConnection后,服务器方的com+对象可以强制找开访问检查,并打开组件级的访问检查。在打开访问检查的情况下,必须将服务器中允许访问com+对象的用户名加入到角色中才能正确访问。(上述代码在delphi7/winXP sp2中调试通过,对于windows98和windows nt4.0及以下操作系统,由于CoCreateInstanceEx不能直接生成com+对象的安全上下文,因此代码不可用)

Delphi编写天气预报查询小程序(IXMLHttpRequest版)

其实那些内置天气预报功能的软件的天气预报功能也都是来源于网上!因为也没有哪个软件公司会自己去架一个气象站了哈哈,现在我就来说说如何通过互联网上的信息来获取天气情况!  目前能查询天气的网站有不少,比...
  • gzxiaorou
  • gzxiaorou
  • 2015年03月22日 15:54
  • 1026

Delphi 的消息机制

=============================================================================== ⊙ 一个 GUI Applicatio...
  • zang141588761
  • zang141588761
  • 2016年09月05日 15:36
  • 1279

Delphi 集合 使用资料收集

集合的使用      (一)       delphi中的集合是对数学中集合的概念的简单实现。要求是集合中的元素必须同类型,且必须是序数类型,且集合中可能的元素个数不能大于255。     定义: t...
  • ainixiaozhuzi
  • ainixiaozhuzi
  • 2013年10月20日 10:12
  • 1111

Delphi xe7并行编程快速入门

现在多数设备、计算机都有多个CPU单元,即使是手机也是多核的。但要在开发中使用多核的优势,却需要一些技巧,花费时间编写额外的代码。好了,现在可以使用Delphi做并行编程了。在Delphi、C++ B...
  • henreash
  • henreash
  • 2014年11月20日 16:19
  • 6856

Delphi中Chrome Chromium、Cef3学习笔记(一)

官方下载地址:https://cefbuilds.com/ CEF简介:     嵌入式Chromium框架(简称CEF) 是一个由Marshall Greenblatt在20...
  • xtfnpgy
  • xtfnpgy
  • 2015年06月25日 13:25
  • 4890

Delphi 的绘图功能

//TPen 的主要属性有四: Color、Width、Style、Mode              {Color: 颜色}              {Width: 宽度; 默认是 1; ...
  • gzxiaorou
  • gzxiaorou
  • 2015年03月22日 15:34
  • 477

Delphi url 编码及转码及特殊字符串替换--百度和腾讯用的就是这个

先介绍一下,Delphi中处理Google的URL编码解码,其中就会明白URL编码转换的方法的 从delphi的角度看Google(谷歌)URL编码解码方式 在网上搜索了一下,似乎没有什么关于goo...
  • Syndicator
  • Syndicator
  • 2014年01月03日 11:59
  • 1951

Delphi 文件处理(4)

9.3.1 文件类型 1.文件类型概念 Delphi使用文件类型来读写存储在外部存储介质上的文件。一个文件变量能够与任意种类的外部设备建立通信,包括磁盘、打印机、键盘、绘图仪、调制解调器等。 ...
  • lailai186
  • lailai186
  • 2013年04月10日 10:01
  • 4847

Delphi实现通用的定时自动关机程序

一、问题的提出:运行某任务的计算机,尤其是服务器,如果能实现在无人职守的情况下,到达指定时间时自动关机,那么将极大地减轻系统管理员的负担,也会给我们的日常工作带来很大方便。    笔者用Delp...
  • my98800
  • my98800
  • 2016年08月29日 09:12
  • 1010

Delphi字符串分隔(似split函数功能)

Delphi字符串实现了和split()函数的功能. unit Unit1; interface uses Windows, Messages, SysUtils, Variant...
  • my98800
  • my98800
  • 2016年12月08日 08:40
  • 1768
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:【摘自网上】Delphi TppReport
举报原因:
原因补充:

(最多只允许输入30个字)