unit Uprint; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, DB, ADODB, StdCtrls, Mask, DBCtrlsEh, Buttons, ExtCtrls, Grids, DBGridEh, frxDesgn, frxClass,IniFiles, frxDBSet, frxExportXLS, frxExportImage, frxExportCSV, frxExportPDF, frxOLE, frxDCtrl, frxADOComponents, DBCtrls, bsSkinCtrls, frxExportMail, frxExportText, frxExportHTML, frxExportRTF, frxCross, bsDialogs; type TfrmPrint = class(TForm) conn: TADOConnection; DBGridEh1: TDBGridEh; Panel3: TPanel; SpeedButton1: TSpeedButton; SpeedButton2: TSpeedButton; SpeedButton4: TSpeedButton; SpeedButton5: TSpeedButton; SpeedButton6: TSpeedButton; SpeedButton3: TSpeedButton; DBEditEh1: TDBEditEh; frxReport1: TfrxReport; frxDesigner1: TfrxDesigner; t_sys_reportfile: TADOQuery; SaveDialog1: TSaveDialog; DataSource1: TDataSource; qry1: TADOQuery; db1: TfrxDBDataset; db2: TfrxDBDataset; db3: TfrxDBDataset; db4: TfrxDBDataset; db5: TfrxDBDataset; frxXLSExport1: TfrxXLSExport; qry2: TADOQuery; qry3: TADOQuery; qry4: TADOQuery; qry5: TADOQuery; ADOQuery1: TADOQuery; Splitter1: TSplitter; db6: TfrxDBDataset; db7: TfrxDBDataset; db8: TfrxDBDataset; db9: TfrxDBDataset; qry6: TADOQuery; qry7: TADOQuery; qry8: TADOQuery; qry9: TADOQuery; frxPDFExport1: TfrxPDFExport; frxCSVExport1: TfrxCSVExport; frxJPEGExport1: TfrxJPEGExport; frxDialogControls1: TfrxDialogControls; frxOLEObject1: TfrxOLEObject; frxADOComponents1: TfrxADOComponents; ds9: TDataSource; frxHTMLExport1: TfrxHTMLExport; frxBMPExport1: TfrxBMPExport; frxTIFFExport1: TfrxTIFFExport; frxGIFExport1: TfrxGIFExport; frxSimpleTextExport1: TfrxSimpleTextExport; frxMailExport1: TfrxMailExport; frxRTFExport1: TfrxRTFExport; QryUserEdit: TADOQuery; Panel1: TPanel; SpeedButton7: TSpeedButton; t_sys_report: TADOQuery; frxCrossObject1: TfrxCrossObject; t_sys_reportfileGID: TStringField; t_sys_reportfileRPTNAME: TStringField; t_sys_reportfileRPTCONTENT: TMemoField; t_sys_reportfileRPTPROP: TStringField; t_sys_reportfileISDEFAULT: TBooleanField; t_sys_reportfileCOMPANYID: TStringField; ADOQuery2: TADOQuery; procedure SpeedButton4Click(Sender: TObject); function frxDesigner1SaveReport(Report: TfrxReport; SaveAs: Boolean): Boolean; procedure SpeedButton5Click(Sender: TObject); procedure connBeforeConnect(Sender: TObject); procedure SpeedButton6Click(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure SpeedButton3Click(Sender: TObject); procedure FormShow(Sender: TObject); function frxReport1UserFunction(const MethodName: String; var Params: Variant): Variant; procedure FormCreate(Sender: TObject); procedure SpeedButton7Click(Sender: TObject); private { Private declarations } public { Public declarations } Comp,OpType,dsr,Uid,RmServer,dbstr,database,userid,password:string; function connect_string(file_name:string):string; function CreateAdoQuery(sql:string): TAdoQuery; function AyalisisPararm(wepararm:string):string; procedure RegPrintDataset(myName:string;mydb1,mydb2,mydb3,mydb4,mydb5,mydb6,mydb7,mydb8,mydb9:TDataset); end; var frmPrint: TfrmPrint; function ReadPassword(target:string): string; implementation uses u_sys_progress,my_sys_function; {$R *.dfm} function ReadPassword(target:string): string; var s:string[20]; i:byte; s1:string; begin { setlength(s,length(target)); for i:=1 to length(target) do s[i]:=chr(ord(target[i])-ord('d')); result:=s; } s1:=Copy(Trim(target),7,Length(Trim(target))); result:=Copy(Trim(s1),1,Length(Trim(s1))-9); end; function TfrmPrint.AyalisisPararm(wepararm:string):string; begin if pos('Password',wepararm)>1 then begin wepararm:=Copy(wepararm,Pos('?',wepararm)+1,Length(wepararm)); Comp:=Copy(wepararm,Pos('=',wepararm)+1,Pos('&',wepararm)-Pos('=',wepararm)-1); wepararm:=Copy(wepararm,Pos('&',wepararm)+1,Length(wepararm)); OpType:=Copy(wepararm,Pos('=',wepararm)+1,Pos('&',wepararm)-Pos('=',wepararm)-1); wepararm:=Copy(wepararm,Pos('&',wepararm)+1,Length(wepararm)); dsr:=Copy(wepararm,Pos('=',wepararm)+1,Pos('&',wepararm)-Pos('=',wepararm)-1); wepararm:=Copy(wepararm,Pos('&',wepararm)+1,Length(wepararm)); Uid:=Copy(wepararm,Pos('=',wepararm)+1,Pos('&',wepararm)-Pos('=',wepararm)-1); wepararm:=Copy(wepararm,Pos('&',wepararm)+1,Length(wepararm)); RmServer:=Copy(wepararm,Pos('=',wepararm)+1,Pos('&',wepararm)-Pos('=',wepararm)-1); wepararm:=Copy(wepararm,Pos('&',wepararm)+1,Length(wepararm)); dbstr:=Copy(wepararm,Pos('=',wepararm)+1,Length(wepararm)); wepararm:=Copy(dbstr,Pos('Database',dbstr)+8,Length(dbstr)); database:=Copy(wepararm,Pos('=',wepararm)+1,Pos(';',wepararm)-Pos('=',wepararm)-1); wepararm:=Copy(dbstr,Pos('User ID',dbstr)+7,Length(dbstr)); userid:=Copy(wepararm,Pos('=',wepararm)+1,Pos(';',wepararm)-Pos('=',wepararm)-1); wepararm:=Copy(wepararm,Pos('Password',wepararm)+8,Length(wepararm)); password:=Copy(wepararm,Pos('=',wepararm)+1,Length(wepararm)); end else begin wepararm:=Copy(wepararm,Pos('?',wepararm)+1,Length(wepararm)); Comp:=Copy(wepararm,Pos('=',wepararm)+1,Pos('&',wepararm)-Pos('=',wepararm)-1); wepararm:=Copy(wepararm,Pos('&',wepararm)+1,Length(wepararm)); OpType:=Copy(wepararm,Pos('=',wepararm)+1,Pos('&',wepararm)-Pos('=',wepararm)-1); wepararm:=Copy(wepararm,Pos('&',wepararm)+1,Length(wepararm)); dsr:=Copy(wepararm,Pos('=',wepararm)+1,Pos('&',wepararm)-Pos('=',wepararm)-1); wepararm:=Copy(wepararm,Pos('&',wepararm)+1,Length(wepararm)); Uid:=Copy(wepararm,Pos('=',wepararm)+1,Length(wepararm)); end; end; function TfrmPrint.connect_string(file_name:string):string; var str,psw:WideString; inifile1:Tinifile; begin str:=''; if RmServer='' then begin inifile1:=Tinifile.Create(ExtractFilePath(application.ExeName)+file_name); psw:=inifile1.ReadString('database','Password',''); psw:=ReadPassword(psw); str:='Provider='+inifile1.ReadString('database','Provider',''); str:=str+' Password='+Trim(psw)+';'; str:=str+' Persist Security Info='+inifile1.ReadString('database','Persist Security Info',''); str:=str+'User ID='+inifile1.ReadString('database','User ID',''); str:=str+'Initial Catalog='+inifile1.ReadString('database','Initial Catalog',''); str:=str+'Data Source='+inifile1.ReadString('database','Data Source',''); inifile1.Free; end else begin str:='Provider=SQLOLEDB.1;'; str:=str+' Password='+Trim(password)+';'; str:=str+' Persist Security Info=False;'; str:=str+'User ID='+userid+';'; str:=str+'Initial Catalog='+database+';'; str:=str+'Data Source='+RmServer+';'; end; result:=str; end; procedure TfrmPrint.RegPrintDataset(myName: string; mydb1, mydb2, mydb3, mydb4,mydb5,mydb6,mydb7,mydb8,mydb9: TDataset); var ifdefault:boolean ; begin ifdefault:=False ; caption:=myname+'-打印报表设置' ; frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+1; //11 db1.DataSet:=mydb1; frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+1; //12 db2.DataSet:=mydb2; frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+1; //13 db3.DataSet:=mydb3; frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+1; //14 db4.DataSet:=mydb4; frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+1; //15 db5.DataSet:=mydb5; frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+1; //16 db6.DataSet:=mydb6; frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+1; //17 db7.DataSet:=mydb7; frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+1; //18 db8.DataSet:=mydb8; frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+1; //19 db9.DataSet:=mydb9; end; procedure TfrmPrint.SpeedButton4Click(Sender: TObject); begin { if t_sys_report.IsEmpty then begin t_sys_report.Close; t_sys_report.SQL.Clear; t_sys_report.SQL.Add('select top 0 * from sys_report '); t_sys_report.Open; end else begin end; } t_sys_reportfile.Insert; t_sys_reportfile['RPTNAME']:=InputBox('更改名称','新的名称',t_sys_reportfile.fieldbyname('RPTNAME').asstring); t_sys_reportfile['RPTCONTENT']:='1'; t_sys_reportfile['RPTPROP']:=OpType; t_sys_reportfile['ISDEFAULT']:=false; t_sys_reportfile['COMPANYID']:=Comp; t_sys_reportfile.post; frxReport1.DesignReport; end; function TfrmPrint.CreateAdoQuery(sql:string): TAdoQuery; begin Result:=TAdoQuery.Create(nil); with Result do begin Close;SQL.Clear; connection:=conn; end; end; function TfrmPrint.frxDesigner1SaveReport(Report: TfrxReport; SaveAs: Boolean): Boolean; var template : TStream; begin if saveas then begin try if SaveDialog1.Execute then frxReport1.savetofile(SaveDialog1.filename); except showmessage('另存格式失败！'); end; end else begin template := TMemoryStream.Create; template.Position := 0; frxReport1.SaveToStream(template); t_sys_report.Edit; { t_sys_report['RPTNAME']:=t_sys_reportfile['RPTNAME']; t_sys_report['RPTPROP']:=OpType; t_sys_report['ISDEFAULT']:=false; t_sys_report['COMPANYID']:=Comp; } try t_sys_report.DisableControls; (t_sys_report.FieldByName('Report') as TBlobField).LoadFromStream(template); t_sys_report.Post; finally t_sys_report.EnableControls; template.Free; end; result:=true; t_sys_reportfile.Requery(); end; end; procedure TfrmPrint.SpeedButton5Click(Sender: TObject); var template : TStream; begin if t_sys_report.isempty then exit; if t_sys_report.isempty then begin showmessage('没有要设计的格式！'); exit; end; try if not t_sys_report.fieldbyname('report').IsNull then begin try template := t_sys_report.CreateBlobStream(t_sys_report.FieldByName('report'), bmRead); template.Position := 0; frxReport1.LoadFromStream(template); finally template.Free; end; end; frxReport1.DesignReport; except showmessage('格式设计失败！'); end; end; procedure TfrmPrint.connBeforeConnect(Sender: TObject); begin // Conn.ConnectionString:=connect_string('main.ini'); end; procedure TfrmPrint.SpeedButton6Click(Sender: TObject); begin if t_sys_reportfile.isempty then begin showmessage('没有要删除的格式！'); exit; end; if application.MessageBox('您确定要删除格式吗?','警告:',MB_OKCANCEL)=IDOK then t_sys_reportfile.delete; end; procedure TfrmPrint.SpeedButton1Click(Sender: TObject); var template : TStream; begin if t_sys_report.isempty then exit; try try template := t_sys_report.CreateBlobStream(t_sys_report.FieldByName('report'), bmRead); template.Position := 0; frxReport1.LoadFromStream(template); finally template.Free; end; frxReport1.ShowReport; except showmessage('打印预览失败！'); end; end; procedure TfrmPrint.SpeedButton2Click(Sender: TObject); var template : TStream; begin if t_sys_report.isempty then exit; try try template := t_sys_report.CreateBlobStream(t_sys_report.FieldByName('report'), bmRead); template.Position := 0; frxReport1.LoadFromStream(template); finally template.Free; end; frxReport1.PrepareReport; frxReport1.Print; except showmessage('打印输出失败！'); end; end; procedure TfrmPrint.SpeedButton3Click(Sender: TObject); begin Close; end; procedure TfrmPrint.FormShow(Sender: TObject); var s : string; begin if not ASSIGNED(frm_sys_progress) then frm_sys_progress:=tfrm_sys_progress.Create(application); frm_sys_progress.bsSkinGauge1.ProgressText:='正在提取报表数据。。。'; frm_sys_progress.Show; frm_sys_progress.bsSkinGauge1.MaxValue:=100; frm_sys_progress.bsSkinGauge1.MinValue:=0; frm_sys_progress.bsSkinGauge1.Value:=0; try OpType:='SEAEOP'; AyalisisPararm(ParamStr(1)); Conn.ConnectionString:=connect_string('main.ini'); // s:='select * from op_seae where bsno=''EDI512997f4bc3a461a827b9fe932882f90'''; frm_sys_progress.bsSkinGauge1.Value:=1; Conn.Connected:=True; with ADOQuery1 do begin Close;SQL.Clear; SQL.Add('Select * from sys_report_dbsource'); SQL.Add('Where GID=:GID'); Parameters.ParamByName('GID').Value:=dsr; Open; if not IsEmpty then begin if FieldByName('SQLSTRING1').AsString<>'' then begin qry1.Close; qry1.SQL.Clear; qry1.SQL.Add(FieldByName('SQLSTRING1').AsString); qry1.Open; end; frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+1; if FieldByName('SQLSTRING2').AsString<>'' then begin qry2.Close; qry2.SQL.Clear; qry2.SQL.Add(FieldByName('SQLSTRING2').AsString); qry2.Open; end; frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+1; if FieldByName('SQLSTRING3').AsString<>'' then begin qry3.Close; qry3.SQL.Clear; qry3.SQL.Add(FieldByName('SQLSTRING3').AsString); qry3.Open; end; frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+1; if FieldByName('SQLSTRING4').AsString<>'' then begin qry4.Close; qry4.SQL.Clear; qry4.SQL.Add(FieldByName('SQLSTRING4').AsString); qry4.Open; end; frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+1; if FieldByName('SQLSTRING5').AsString<>'' then begin qry5.Close; qry5.SQL.Clear; qry5.SQL.Add(FieldByName('SQLSTRING5').AsString); qry5.Open; end; frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+1; if FieldByName('SQLSTRING6').AsString<>'' then begin qry6.Close; qry6.SQL.Clear; qry6.SQL.Add(FieldByName('SQLSTRING6').AsString); qry6.Open; end; frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+1; if FieldByName('SQLSTRING7').AsString<>'' then begin qry7.Close; qry7.SQL.Clear; qry7.SQL.Add(FieldByName('SQLSTRING7').AsString); qry7.Open; end; frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+1; if FieldByName('SQLSTRING8').AsString<>'' then begin qry8.Close; qry8.SQL.Clear; qry8.SQL.Add(FieldByName('SQLSTRING8').AsString); qry8.Open; end; frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+1; //9 end; end; with qry9 do begin Close;SQL.Clear; SQL.Add('Select * from company'); SQL.Add('Where GID=:GID'); Parameters.ParamByName('GID').Value:=Comp; Open; end; frm_sys_progress.bsSkinGauge1.Value:=10; //10 RegPrintDataset(OpType+'1',qry1,qry2,qry3,qry4,qry5,qry6,qry7,qry8,qry9); frm_sys_progress.bsSkinGauge1.Value:=20; //11 with QryUserEdit do begin Close;SQL.Clear; SQL.Add('select V.OPERATERANGE from VW_User_Authority v '); SQL.Add(' where V.USERID=:USERID AND V.NAME=:RptPrint'); SQL.Add(' and V.ISDELETE=0'); Parameters.ParamByName('USERID').Value:=Uid; Parameters.ParamByName('RptPrint').Value:='modRptPrintSet'; Open; if not IsEmpty then begin if (FieldByName('OPERATERANGE').AsInteger=1) or (FieldByName('OPERATERANGE').AsInteger=2) or (FieldByName('OPERATERANGE').AsInteger=3) or (FieldByName('OPERATERANGE').AsInteger=0) then begin SpeedButton4.Enabled:=True; SpeedButton3.Enabled:=True; SpeedButton5.Enabled:=True; SpeedButton6.Enabled:=True; SpeedButton7.Enabled:=True; end else begin SpeedButton4.Enabled:=false; SpeedButton3.Enabled:=false; SpeedButton5.Enabled:=false; SpeedButton6.Enabled:=false; SpeedButton7.Enabled:=false; end; end else begin SpeedButton4.Enabled:=false; SpeedButton3.Enabled:=false; SpeedButton5.Enabled:=false; SpeedButton6.Enabled:=false; SpeedButton7.Enabled:=false; end; end; with t_sys_reportfile do begin Close;SQL.Clear; SQL.Add('select GID,RPTNAME,RPTCONTENT,RPTPROP,ISDEFAULT,COMPANYID from sys_report'); SQL.Add('where RPTPROP=:RPTPROP and COMPANYID=:COMPANYID'); Parameters.ParamByName('RPTPROP').Value:=OpType; Parameters.ParamByName('COMPANYID').Value:=Comp; SQL.Add('order by RPTPROP,COMPANYID'); frm_sys_progress.bsSkinGauge1.Value:=21; //11 Open; frm_sys_progress.bsSkinGauge1.Value:=22; //11 t_sys_report.Open; end; frm_sys_progress.bsSkinGauge1.Value:=100; finally frm_sys_progress.close; frm_sys_progress:=nil; end; end; function TfrmPrint.frxReport1UserFunction(const MethodName: String; var Params: Variant): Variant; begin if uppercase(MethodName)='MONEYCN' then Result := MoneyCn(Params[0],Params[1]); if uppercase(MethodName)='ENGDATEFMT' then Result := EngDateFmt(Params[0],Params[1],Params[2],Params[3],Params[4],Params[5],Params[6]); if uppercase(MethodName)='GETCUSTBALDATE' then Result :=formatdatetime('YYYY-MM-DD',getstlDate(Params[0],Params[1],Params[2])); if uppercase(MethodName)='GETCUSTBALDAY' then Result :=inttostr(getstlDay(Params[0],Params[1],Params[2])); if uppercase(MethodName)='MONEYEN' then Result := EWords(Params[0],0); end; procedure TfrmPrint.FormCreate(Sender: TObject); begin frxReport1.AddFunction('function MoneyCn(num:real;lx:boolean=false):widestring;','自定义'); frxReport1.AddFunction('function MoneyEn(num:real;):widestring;','自定义'); frxReport1.AddFunction('function EngDateFmt(ADateTime:TDateTime;JX,DX:boolean;MDY:Boolean=true;MD:Boolean=false;DIAN:Boolean=false;MY:Boolean=false):string;','自定义'); frxReport1.AddFunction('function GETCUSTBALDATE(ADateTime:TDateTime;Cust,Sale:String):TDateTime;','自定义'); frxReport1.AddFunction('function GETCUSTBALDAY(ADateTime:TDateTime;Cust,Sale:String):integer;','自定义'); end; procedure TfrmPrint.SpeedButton7Click(Sender: TObject); begin if t_sys_reportfile.isempty then begin showmessage('没有要更改名称的格式！'); exit; end; t_sys_reportfile.edit; t_sys_reportfile['RPTNAME']:=InputBox('更改名称','新的名称',t_sys_reportfile.fieldbyname('RPTNAME').asstring); t_sys_reportfile.post; end; end.