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, Menus, IdMessage,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,IdAttachmentFile,
IdExplicitTLSClientServerBase, IdMessageClient, IdSMTPBase, IdSMTP,
IdHTTP,IdMultipartFormData,IdGlobalProtocols, frxBarcode, frxRich,
frxPreview;
type
TfrmPrint = class(TForm)
conn: TADOConnection;
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;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
EXCEL1: TMenuItem;
N5: TMenuItem;
RTF1: TMenuItem;
N3: TMenuItem;
WORD1: TMenuItem;
N4: TMenuItem;
PDF1: TMenuItem;
SpeedButton8: TSpeedButton;
DBEdit1: TDBEdit;
DBEdit2: TDBEdit;
Label1: TLabel;
Label2: TLabel;
SpeedButton9: TSpeedButton;
SpeedButton10: TSpeedButton;
qryMailSend: TADOQuery;
SMTP1: TIdSMTP;
IdMsg: TIdMessage;
frxBarCodeObject1: TfrxBarCodeObject;
frxUserDataSet1: TfrxUserDataSet;
frxRichObject1: TfrxRichObject;
Panel2: TPanel;
DBGridEh1: TDBGridEh;
frxPreview1: TfrxPreview;
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);
procedure N1Click(Sender: TObject);
procedure EXCEL1Click(Sender: TObject);
procedure RTF1Click(Sender: TObject);
procedure WORD1Click(Sender: TObject);
procedure PDF1Click(Sender: TObject);
procedure SpeedButton8Click(Sender: TObject);
procedure SpeedButton9Click(Sender: TObject);
procedure SpeedButton10Click(Sender: TObject);
private
{ Private declarations }
procedure ReportPreview(repid:string);
procedure ReportDesign(repid:string);
procedure wndProc(var msg: Tmessage);
public
{ Public declarations }
Comp,OpType,dsr,Uid,RmServer,dbstr,database,userid,password:string;
RpID,RptMode,Mailid:string;
function connect_string(file_name:string):string;
function CreateAdoQuery(sql:string): TAdoQuery;
function AyalisisPararm(wepararm:string):string;
function GetGid: string;
procedure RegPrintDataset(myName:string;mydb1,mydb2,mydb3,mydb4,mydb5,mydb6,mydb7,mydb8,mydb9:TDataset);
procedure MyMessage(var m:TWmCopyData);message WM_CopyData;
end;
var
frmPrint: TfrmPrint;
billno:string;
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 fnGetParaValue(strkey,strcontent:string):string ;
var
ipos:Integer;
strtmp:string;
begin
result:='';
ipos:=Pos(strkey,strcontent);
if(ipos>1) then
begin
strtmp:= Copy(strcontent,ipos+1,Length(strcontent)-ipos);
if(Pos('&',strtmp)>1) then
result:= Copy(strtmp,Pos('=',strtmp)+1 , Pos('&',strtmp)-Pos('=',strtmp)-1)
else
result:=Copy(strtmp,Pos('=',strtmp)+1,Length(strtmp)-Pos('=',strtmp));
end;
end;
function TfrmPrint.GetGid: string;
begin
ADOQuery2.Close;
ADOQuery2.SQL.Text:='select newid() as GID ';
ADOQuery2.Open;
result:=ADOQuery2.fieldbyname('GID').AsString;
end;
function TfrmPrint.AyalisisPararm(wepararm:string):string;
begin
wepararm:=StringReplace(StringReplace(wepararm,'%20',' ',[rfReplaceAll]),'%5C','\',[rfReplaceAll]);
if (pos('RpID',wepararm)>1) and (pos('RptMode',wepararm)>1 ) then
begin
RpID:=fnGetParaValue('RpID',wepararm);
RptMode:=fnGetParaValue('RptMode',wepararm);
Mailid:=fnGetParaValue('Mailid',wepararm);
end;
if (pos('Mailid',wepararm)>1) then
begin
Mailid:=fnGetParaValue('Mailid',wepararm);
end;
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));
dbstr:=Copy(wepararm,Pos('=',wepararm)+1,Pos('&',wepararm)-Pos('=',wepararm)-1);
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;
isini:Boolean;
begin
str:='';
isini:=false;
// isini:=FileExists(ExtractFilePath(application.ExeName)+file_name);
if (RmServer='') or isini 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;';
password:=Copy(password,0,Pos(';',password)-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);
var
gid:string;
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;
}
gid:=GetGid;
t_sys_reportfile.Insert;
t_sys_reportfile['RPTNAME']:=InputBox('更改名称','新的名称',t_sys_reportfile.fieldbyname('RPTNAME').asstring);
t_sys_reportfile['RPTCONTENT']:='1';
t_sys_reportfile['GID']:=gid;
t_sys_reportfile['RPTPROP']:=OpType;
t_sys_reportfile['ISDEFAULT']:=false;
t_sys_reportfile['COMPANYID']:=Comp;
t_sys_reportfile.post;
t_sys_report.close;
t_sys_report.Parameters.ParamByName('GID').Value:=t_sys_reportfile['GID'];
t_sys_report.Open;
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;
if t_sys_reportfile.Active then
t_sys_reportfile.Requery();
end;
end;
procedure TfrmPrint.SpeedButton5Click(Sender: TObject);
var
template : TStream;
begin
t_sys_report.close;
t_sys_report.Parameters.ParamByName('GID').Value:=t_sys_reportfile['GID'];
t_sys_report.Open;
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
t_sys_report.close;
t_sys_report.Parameters.ParamByName('GID').Value:=t_sys_reportfile['GID'];
t_sys_report.Open;
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
t_sys_report.close;
t_sys_report.Parameters.ParamByName('GID').Value:=t_sys_reportfile['GID'];
t_sys_report.Open;
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,paramallstr : string;
sl:TStringList;
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
SL:=TStringList.Create;
OpType:='SEAEOP';
paramallstr:=ParamStr(1)+ParamStr(2)+ParamStr(3);
// if Pos('///',paramallstr)<0 then
paramallstr:=StringReplace(paramallstr,'//','///',[]);
paramallstr:=StringReplace(paramallstr,'UserID','User ID',[]);
paramallstr:=StringReplace(paramallstr,'ConnectTimeout','Connect Timeout',[]);
// SL.Add(ParamStr(1));
//sl.SaveToFile('D:\HXT.TXT');
AyalisisPararm(paramallstr);
// frxUserDataSet1.fi
Conn.ConnectionString:=connect_string('main.ini');
// SL.Add(Conn.ConnectionString);
// sl.SaveToFile('D:\HXT.TXT');
// ShowMessage(Conn.ConnectionString);
frm_sys_progress.bsSkinGauge1.Value:=10;
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+5;
if FieldByName('SQLSTRING2').AsString<>'' then
begin
qry2.Close;
qry2.SQL.Clear;
qry2.SQL.Add(FieldByName('SQLSTRING2').AsString);
if pos('=:',FieldByName('SQLSTRING2').AsString)>0 then begin
qry2.DataSource:=dsr1;
paramname:=getparamname(FieldByName('SQLSTRING2').AsString);
qry2.Parameters.ParamByName(paramname).Value:=qry1.fieldbyname(paramname).AsString;
end;
qry2.Open;
end;
frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+5;
if FieldByName('SQLSTRING3').AsString<>'' then
begin
qry3.Close;
qry3.SQL.Clear;
qry3.SQL.Add(FieldByName('SQLSTRING3').AsString);
if pos('=:',FieldByName('SQLSTRING3').AsString)>0 then begin
qry3.DataSource:=dsr1;
paramname:=getparamname(FieldByName('SQLSTRING3').AsString);
qry3.Parameters.ParamByName(paramname).Value:=qry1.fieldbyname(paramname).AsString;
end;
qry3.Open;
end;
frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+5;
if FieldByName('SQLSTRING4').AsString<>'' then
begin
qry4.Close;
qry4.SQL.Clear;
qry4.SQL.Add(FieldByName('SQLSTRING4').AsString);
if pos('=:',FieldByName('SQLSTRING4').AsString)>0 then begin
qry4.DataSource:=dsr1;
paramname:=getparamname(FieldByName('SQLSTRING4').AsString);
qry4.Parameters.ParamByName(paramname).Value:=qry1.fieldbyname(paramname).AsString;
end;
qry4.Open;
end;
frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+5;
if FieldByName('SQLSTRING5').AsString<>'' then
begin
qry5.Close;
qry5.SQL.Clear;
qry5.SQL.Add(FieldByName('SQLSTRING5').AsString);
if pos('=:',FieldByName('SQLSTRING5').AsString)>0 then qry5.DataSource:=dsr1;
qry5.Open;
end;
frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+5;
if FieldByName('SQLSTRING6').AsString<>'' then
begin
qry6.Close;
qry6.SQL.Clear;
qry6.SQL.Add(FieldByName('SQLSTRING6').AsString);
if pos('=:',FieldByName('SQLSTRING6').AsString)>0 then qry6.DataSource:=dsr1;
qry6.Open;
end;
frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+5;
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+5;
if FieldByName('SQLSTRING8').AsString<>'' then
begin
qry8.Close;
qry8.SQL.Clear;
qry8.SQL.Add(FieldByName('SQLSTRING8').AsString);
qry8.Open;
end;
billno:=FieldByName('DESCRIPTION').AsString;
if (billno<>'') then
frxReport1.FileName:=billno;
frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+5; //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:=frm_sys_progress.bsSkinGauge1.Value+5; //10
RegPrintDataset(OpType+'1',qry1,qry2,qry3,qry4,qry5,qry6,qry7,qry8,qry9);
frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+5; //11
if (RpID<>'') then
begin
if( RptMode='1') then
ReportPreview(RpID)
else if (RptMode='2') then
ReportDesign(RpID);
end else begin
// s:='select * from op_seae where bsno=''EDI512997f4bc3a461a827b9fe932882f90''';
frxReport1.Preview:=nil;
Panel2.Visible:=True;
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 qryMailSend do
begin
Close;SQL.Clear;
SQL.Add('select * from op_mail_send ');
SQL.Add(' where GID=:MAILID');
Parameters.ParamByName('MAILID').Value:=Mailid;
Open;
if not IsEmpty then begin
SpeedButton10.Enabled:=True;
end else begin
SpeedButton10.Enabled:=false;
end;
end;
frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+5; //11
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 and GID NOT IN (SELECT RPTGID FROM sys_report_userrange WHERE USERID=:USERID) ');
Parameters.ParamByName('RPTPROP').Value:=OpType;
Parameters.ParamByName('COMPANYID').Value:=Comp;
Parameters.ParamByName('USERID').Value:=Uid;
SQL.Add('order by RPTPROP,COMPANYID');
Open;
frm_sys_progress.bsSkinGauge1.Value:=frm_sys_progress.bsSkinGauge1.Value+5; //11
end;
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)='MONEYCNUSD' then
Result := MoneyCnUSD(Params[0]);
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);
if uppercase(MethodName)='AMOUNT2STR' then
Result :=Amount2Str(Params[0],Params[1],Params[2]);
if uppercase(MethodName)='MONEYEN2' then
Result := FloatToEnglish(Params[0],Params[1]);
if uppercase(MethodName)='STRINGREPLACE' then
Result := StringReplace(Params[0],Params[1],Params[2],[rfReplaceAll]);
end;
procedure TfrmPrint.FormCreate(Sender: TObject);
begin
frxReport1.AddFunction('function MoneyCn(num:real;lx:boolean=false):widestring;','自定义');
frxReport1.AddFunction('function moneycnusd(num:real;):widestring;','自定义');
frxReport1.AddFunction('function MoneyEn(num:real;):widestring;','自定义');
frxReport1.AddFunction('function MoneyEn2(num:real,curr:String;):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;','自定义');
frxReport1.AddFunction('function Amount2Str(amount:Real;numpos:Integer;curr:string):widestring;','自定义');
frxReport1.AddFunction('function StringReplace(S, OldPattern, NewPattern: string):widestring;','自定义');
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;
procedure TfrmPrint.N1Click(Sender: TObject);
var
template : TStream;
begin
t_sys_report.close;
t_sys_report.Parameters.ParamByName('GID').Value:=t_sys_reportfile['GID'];
t_sys_report.Open;
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.Export(frxJPEGExport1);
except
showmessage('打印输出失败!');
end;
end;
procedure TfrmPrint.EXCEL1Click(Sender: TObject);
var
template : TStream;
begin
t_sys_report.close;
t_sys_report.Parameters.ParamByName('GID').Value:=t_sys_reportfile['GID'];
t_sys_report.Open;
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.Export(frxXLSExport1);
except
showmessage('打印输出失败!');
end;
end;
procedure TfrmPrint.RTF1Click(Sender: TObject);
var
template : TStream;
begin
t_sys_report.close;
t_sys_report.Parameters.ParamByName('GID').Value:=t_sys_reportfile['GID'];
t_sys_report.Open;
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.Export(frxRTFExport1);
except
showmessage('打印输出失败!');
end;
end;
procedure TfrmPrint.WORD1Click(Sender: TObject);
var
template : TStream;
begin
t_sys_report.close;
t_sys_report.Parameters.ParamByName('GID').Value:=t_sys_reportfile['GID'];
t_sys_report.Open;
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.Export(frxHTMLExport1);
except
showmessage('打印输出失败!');
end;
end;
procedure TfrmPrint.PDF1Click(Sender: TObject);
var
template : TStream;
begin
t_sys_report.close;
t_sys_report.Parameters.ParamByName('GID').Value:=t_sys_reportfile['GID'];
t_sys_report.Open;
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.Export(frxPDFExport1);
except
showmessage('打印输出失败!');
end;
end;
procedure TfrmPrint.SpeedButton8Click(Sender: TObject);
var
Pnt:Tpoint;
begin
Pnt:=SpeedButton8.ClientToScreen(Point(0,SpeedButton8.Height));
PopupMenu1.Popup(Pnt.x,Pnt.y);
end;
procedure TfrmPrint.SpeedButton9Click(Sender: TObject);
begin
frmSendMail := TfrmSendMail.Create(self);
try
frmSendMail.ShowModal;
finally
freeandnil(frmSendMail);
end;
end;
///
/// 打印预览
///
procedure TfrmPrint.ReportPreview(repid:string);
var
template : TStream;
begin
if Length(repid)<30 then begin
frxReport1.Preview:=frxPreview1;
Panel2.Visible:=false;
frmPrint.Width:=850;
frmPrint.Height:=800;
end;
t_sys_report.close;
t_sys_report.Parameters.ParamByName('GID').Value:=repid;//t_sys_reportfile['GID'];
t_sys_report.Open;
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(True);
except
showmessage('打印预览失败!');
close();
end;
// close;
end;
///
///
///
procedure TfrmPrint.ReportDesign(repid:string);
var
template : TStream;
begin
t_sys_report.close;
t_sys_report.Parameters.ParamByName('GID').Value:= repid;//t_sys_reportfile['GID'];
t_sys_report.Open;
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;
Close();
except
showmessage('格式设计失败!');
end;
end;
procedure TfrmPrint.SpeedButton10Click(Sender: TObject);
var
template : TStream;
str,s:widestring;
ScriptPath,naspath:string;
str_memo:Tmemo;
MultiPartFormDataStream: TIdMultiPartFormDataStream;
IdHTTP1:TIdHTTP;
begin
t_sys_report.close;
t_sys_report.Parameters.ParamByName('GID').Value:=t_sys_reportfile['GID'];//t_sys_reportfile['GID'];
t_sys_report.Open;
if t_sys_report.isempty then
exit;
if (qryMailSend.FieldByName('RECEIVER').AsString='') or (qryMailSend.FieldByName('SENDER').AsString='') then begin
showmessage('邮件模板不正确,不能发送!');
exit;
end;
try
template := t_sys_report.CreateBlobStream(t_sys_report.FieldByName('report'), bmRead);
template.Position := 0;
frxReport1.LoadFromStream(template);
finally
template.Free;
end;
frxReport1.PrepareReport;
try
str_memo:=Tmemo.create(application);
str_memo.Parent:=frmPrint;
str_memo.visible:=False;
try
SMTP1.AuthType := satDefault; //(satNone, satDefault, satSASL);
SMTP1.username:=qryMailSend.FieldByName('SENDERUSERNAME').AsString;
SMTP1.Password :=qryMailSend.FieldByName('SENDERPASSWORD').AsString;
SMTP1.Host:=qryMailSend.FieldByName('SENDSERVICE').AsString;
SMTP1.Port:=StrToIntDef(qryMailSend.FieldByName('SENDERPORT').AsString,25);
try
SMTP1.Connect;
except
on e : Exception do
begin
ShowMessage('连接邮箱出错:'+E.Message);
end;
end;
if not SMTP1.Connected then
begin
Sleep(1000);
SMTP1.Connect;
end;
ScriptPath:=ExtractFilePath(ParamStr(0))+'CUSTOMFILE\';
if not DirectoryExists(ScriptPath) then CreateDir(ScriptPath);
str:=ScriptPath +qryMailSend.fieldbyname('ATTACHMENT').AsString+'.PDF';
frxPDFExport1.FileName:=str;
frxPDFExport1.ShowDialog:=false;
frxReport1.Export(frxPDFExport1);
ScriptPath:=ExtractFilePath(ParamStr(0))+'CUSTOMFILE\';
if not DirectoryExists(ScriptPath) then CreateDir(ScriptPath);
try
with IdMsg do
begin
body.Clear;
Body.Text :=str_memo.lines.Text;
From.address :=qryMailSend.fieldbyname('SENDER').AsString;
Recipients.EMailAddresses :=qryMailSend.fieldbyname('RECEIVER').AsString;
Subject:=qryMailSend.fieldbyname('SUBJECT').AsString;
TIdAttachmentFile.Create(MessageParts,str);
end;
if not SMTP1.Connected then
begin
Sleep(1000);
SMTP1.Connect;
end;
SMTP1.Send(IdMsg);
MultiPartFormDataStream := TIdMultiPartFormDataStream.Create;
IdHTTP1:=TIdHTTP.Create(Application);
try
IdHttp1.Request.Accept := '*/*';
IdHttp1.Request.AcceptLanguage:='zh-CN';
IdHttp1.Request.ContentType := MultiPartFormDataStream.RequestContentType;
MultiPartFormDataStream.AddFormField('Mailid',Mailid);
MultiPartFormDataStream.AddFile('filename',str,GetMIMETypeFromFile(str));
MultiPartFormDataStream.Position := 0;
IdHTTP1.Post(qryMailSend.fieldbyname('HTTPURL').AsString, MultiPartFormDataStream);
finally
MultiPartFormDataStream.Free;
FreeAndNil(IdHTTP1);
end;
finally
SMTP1.Disconnect;
end;
MessageDlg('发送成功!',mtConfirmation,[mbOK],0);
except
MessageDlg('发送失败!',mtError,[mbOK],0);
end;
str_memo.free;
if SMTP1.Connected then SMTP1.Disconnect;
except
showmessage('存为文件失败!');
end;
close;
end;
procedure TfrmPrint.wndProc(var msg: Tmessage);
begin
end;
procedure TfrmPrint.MyMessage(var m: TWmCopyData);
var
msg:string;
begin
msg :=StrPas(m.CopyDataStruct^.lpData); //获取参数数据
Application.BringToFront;
// ShowMessage(msg);
AyalisisPararm(msg);
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;
if FieldByName('SQLSTRING2').AsString<>'' then
begin
qry2.Close;
qry2.SQL.Clear;
qry2.SQL.Add(FieldByName('SQLSTRING2').AsString);
qry2.Open;
end;
if FieldByName('SQLSTRING3').AsString<>'' then
begin
qry3.Close;
qry3.SQL.Clear;
qry3.SQL.Add(FieldByName('SQLSTRING3').AsString);
qry3.Open;
end;
if FieldByName('SQLSTRING4').AsString<>'' then
begin
qry4.Close;
qry4.SQL.Clear;
qry4.SQL.Add(FieldByName('SQLSTRING4').AsString);
qry4.Open;
end;
if FieldByName('SQLSTRING5').AsString<>'' then
begin
qry5.Close;
qry5.SQL.Clear;
qry5.SQL.Add(FieldByName('SQLSTRING5').AsString);
qry5.Open;
end;
if FieldByName('SQLSTRING6').AsString<>'' then
begin
qry6.Close;
qry6.SQL.Clear;
qry6.SQL.Add(FieldByName('SQLSTRING6').AsString);
qry6.Open;
end;
if FieldByName('SQLSTRING7').AsString<>'' then
begin
qry7.Close;
qry7.SQL.Clear;
qry7.SQL.Add(FieldByName('SQLSTRING7').AsString);
qry7.Open;
end;
if FieldByName('SQLSTRING8').AsString<>'' then
begin
qry8.Close;
qry8.SQL.Clear;
qry8.SQL.Add(FieldByName('SQLSTRING8').AsString);
qry8.Open;
end;
billno:=FieldByName('DESCRIPTION').AsString;
if (billno<>'') then
frxReport1.FileName:=billno;
end;
end;
if (RpID<>'') then
begin
if( RptMode='1') then
ReportPreview(RpID)
else if (RptMode='2') then
ReportDesign(RpID);
end else begin
// s:='select * from op_seae where bsno=''EDI512997f4bc3a461a827b9fe932882f90''';
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 qryMailSend do
begin
Close;SQL.Clear;
SQL.Add('select * from op_mail_send ');
SQL.Add(' where GID=:MAILID');
Parameters.ParamByName('MAILID').Value:=Mailid;
Open;
if not IsEmpty then begin
SpeedButton10.Enabled:=True;
end else begin
SpeedButton10.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 and GID NOT IN (SELECT RPTGID FROM sys_report_userrange WHERE USERID=:USERID) ');
Parameters.ParamByName('RPTPROP').Value:=OpType;
Parameters.ParamByName('COMPANYID').Value:=Comp;
Parameters.ParamByName('USERID').Value:=Uid;
SQL.Add('order by RPTPROP,COMPANYID');
Open;
end;
end;
end;
end.