Critical Errors - Print Reports in ISAPI DLL - HELP!!!
This is a DESPERATE PLEA FOR ASSISTANCE - I have now spent 3 weeks
trying to resolve this problem.
Environment:
Delphi 5 Pro
ReportBuilder EnterPrise 6.03
NativeBD or ODBCExpress (SQLAnywhere Database)
Win2000 Pro \ W2000 Server
OmniHTTPD.exe Web Server (for testing).
I need to produce reports for a web application and initially designed
a standalone socket ReportServer application that received the
requests from the users, generated the reports in PDF format to disk
and returned the name of the PDF to the user. This system seemd to
work ok but after say 35 reports (of about 20K eack) it stopped
working and started giving weird errors - Out of memory, Unable to
print tocanvas etc. SleuthQA did not report any memory leaks and I
have ensured the printer drivers are the latest - HP LaserJet 4 Plus,
The ReportServer application was the only application operating from
the computer (Win2000 Pro).
I have now created a simple web application which receives a request
(GET) and produces a report from the supplied information. The
information supplied to the ReportServerWeb is:
- Database Connection Information
- Report Name
- Report Output Name
- SQLWhere Statement.
I have created a test program which sends requests to this ISAPI DLL
and only one request is sent at a time (ie no multi threading). The
system produces the PDF reports ok but when I exit the application I
receive the message:
Project c:\httpd\httpd.exe raised too many consecutive
exceptions...... and the system then fails to close.
I cannot see any errors in this code after spending hours searching.
Could someone \ anyone PLEASE look at the following code and advise if
I have overlooked an obvious errors - I am really getting desperate
with this one!!!!!
The other weird situation is the the following codes generates a dll
of 2.7Mb and it has only the basics??
unit ReportWebPrintMain;
interface
uses
Windows, Messages, SysUtils, Classes, HTTPApp, Db,
NdbBase, NdbAsa, daNDB, NdbBasDS, NdbAsaDS,
daSQL, daDataModule, daDataView, daQueryDataView,
ppComm, ppRelatv, ppProd, ppClass, ppReport, ppTypes, raCodMod,
ppDBPipe,TXtraDev;
type
TWebModule1 = class(TWebModule)
procedure WebModuleCreate(Sender: TObject);
procedure WebModuleDestroy(Sender: TObject);
procedure WebModuleBeforeDispatch(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled:
Boolean);
private
{ Private declarations }
fSQLWhere:TStrings;
fRBReport:TppReport;
fReportFullName:String;
fReportname:String;
fReportOutputName:String;
fReportWorkName:String;
fReportOutputType:String;
fReportPreProcess:String;
fReportError:String;
fDebug:String;
fLoginEngineName:String;
fLoginDatabase:String;
fResponseType:String;
fErrorList:TStrings;
fErrorCount:integer;
fAsaSession: TAsaSession;
fQWork:TAsaDataset;
fIniFileName:String;
fModulePath:String;
function ProcessWebRequest(Sender: TObject; Request: TWebRequest;
Response: TWebResponse):Boolean;
function RunDefinedProcess(ProcessString:String):Boolean;
procedure AddError(Sender:TObject; ErrorMessage:String);
function CheckOutputFileAfterExecute: Boolean;
function ExportReportExecute: Boolean;
function GetFirstDataview(aReport: TppReport): TdaQueryDataview;
function GetSQLObject(aReport: TppReport): TdaSQL;
function LoadReport(Sender: TObject): Boolean;
function PrintReport(Sender: TObject): Boolean;
function ReportExecute: Boolean;
function SetWhere(Sender: TObject): Boolean;
procedure GetIniName;
public
{ Public declarations }
end;
var
WebModule1: TWebModule1;
implementation
{$R *.DFM}
procedure TWebModule1.WebModuleCreate(Sender: TObject);
begin
//Create
fAsaSession := TAsaSession.Create(self);
fAsaSession.Name := 'AsaSession';
fAsaSession.ClientParams := 'CommLinks=tcpip';
fAsaSession.LoginUser :='infobase';
fAsaSession.LoginPassword :='infobase';
fQWork := TAsaDataset.Create(Nil);
fQWork.Session := fAsaSession;
fErrorList := TStringList.Create;
fSQLWhere := TStringList.Create;
fRBReport := Nil;
GetIniName;
end;
procedure TWebModule1.WebModuleDestroy(Sender: TObject);
begin
//Destroy
if Assigned(fRBReport) then
FreeAndNil(fRBReport);
FreeAndNil(fAsaSession);
FreeAndNil(fQWork);
fErrorList.Free;
fSQLWhere.Free;
end;
procedure TWebModule1.WebModuleBeforeDispatch(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
fErrorList.Clear;
fSQLWhere.Clear;
fErrorCount := 0;
fReportError := '';
fReportPreProcess := '';
if ProcessWebRequest(Sender,Request,Response) then
PrintReport(Sender);
if fErrorList.Count>0 then
Response.Content := 'ERROR: '+fErrorList.Text
else
Response.Content := 'OK: '+fReportOutputType+' File
'+fReportOutputName+' generated!';
Handled := True;
end;
function TWebModule1.ProcessWebRequest(Sender: TObject;
Request: TWebRequest; Response: TWebResponse):Boolean;
var slWork:TStrings;
x:integer;
bValid:Boolean;
begin
try
slWork := TStringList.Create;
slWork.Assign(Request.ContentFields);
for x := 0 to Request.QueryFields.Count-1 do
slWork.Append(Request.QueryFields[x]);
fResponseType := slWork.Values['ResponseType'];
fDebug := slWork.Values['Debug'];
fLoginEngineName := slWork.Values['LoginEngineName'];
if fLoginEngineName='' then
AddError(Sender,'LoginEngineName: No Value Supplied');
fLoginDatabase := slWork.Values['LoginDatabase'];
if fLoginDatabase='' then
AddError(Sender,'LoginDatabase: No Value Supplied');
if fErrorCount=0 then
begin
try
if fAsaSession.Connected and
((CompareText(fAsaSession.LoginEngineName,fLoginEngineName)<>0) or
(CompareText(fAsaSession.LoginDatabase,fLoginDatabase)<>0)) then
fAsaSession.Connected := False;
if not fAsaSession.Connected then
begin
fAsaSession.LoginEngineName := fLoginEngineName;
fAsaSession.LoginDatabase := fLoginDatabase;
fAsaSession.Name := fAsaSession.LoginDatabase;
fAsaSession.Connected := True;
end;
except
AddError(Sender,'Database Connect: '+
Exception(ExceptObject).Message);
end;
end;
fReportName := slWork.Values['ReportName'];
if fReportName='' then
AddError(Sender,'ReportFullName: No Value Supplied');
fReportFullName :=
ChangeFileExt(IncludeTrailingBackSlash(fModulePath)+'Reports\'+fReportName,'.RTM');
fSQLWhere.Text := slWork.Values['SQLWhere'];
if fSQLWhere.Count=0 then
AddError(Sender,'SQLWhere: No Value Supplied');
fReportOutputType := slWork.Values['ReportOutputType'];
fReportOutputName := slWork.Values['ReportOutputName'];
fReportPreProcess := slWork.Values['ReportPreProcess'];
if fReportOutputType='' then
fReportOutputType:='PDF';
bValid := (fErrorCount=0);
finally
slWork.Free;
Result := bValid;
end;
end;
function TWebModule1.PrintReport(Sender:TObject):Boolean;
var bValid:Boolean;
slFile, slWhere:TStrings;
begin
bValid := False;
try
slFile := TStringList.Create;
slWhere := TStringList.Create;
fReportError := '';
fReportWorkName := ExtractFilePath(fReportOutputName)+
FormatDateTime('YYYYMMDDHHNNZZZ',Now)+
ExtractFileExt(fReportOutputName);
if not RunDefinedProcess(fReportPreProcess) then
Exit;
fReportError := 'LoadReport';
if not LoadReport(Sender) then
begin
Exit;
end;
if not SetWhere(Sender) then
Exit;
bValid := ReportExecute;
finally
slFile.Free;
slWhere.Free;
if Assigned(fRBReport) then
FreeAndNil(fRBReport);
Result := bValid;
end;
end;
function TWebModule1.ReportExecute:Boolean;
var bValid:Boolean;
nRetries:integer;
bRetry:Boolean;
begin
bValid := False;
try
nRetries := 0;
fReportError := '';
while True do
begin
bRetry := False;
if nRetries>1 then
Break;
try
fRBReport.Reset;
fRBReport.CachePages := False;
fRBReport.Printer.Initialize;
with fRBReport do
begin
fRBReport.ShowCancelDialog := False;
fRBReport.ShowPrintDialog := False;
if
Pos(fReportOutputType,'PDF,XLS,RTF,RTF,GIF,HTML,JPEG,BMP,EMF,WMF')>0
then
bValid := ExportReportExecute
else
if fReportOutputType='RPT' then
begin
fRBReport.DeviceType := dtArchive;
fRBReport.ArchiveFileName := fReportOutputName;
fRBReport.Print;
bValid := CheckOutputFileAfterExecute;
end
else
if fReportOutputType='PRN' then
begin
fRBReport.DeviceType := dtReportTextFile;
fRBReport.TextFileName := fReportOutputName;
fRBReport.Print;
bValid := CheckOutputFileAfterExecute;
end
else
if fReportOutputType='TXT' then
begin
fRBReport.DeviceType := dtTextFile;
fRBReport.TextFileName := fReportOutputName;
fRBReport.Print;
bValid := CheckOutputFileAfterExecute;
end
else
begin
fRBReport.AllowPrintToFile := False;
fRBReport.DeviceType := dtPrinter;
fRBReport.Print;
bValid := True;
end;
end;
except
bValid := False;
fReportError := Exception(ExceptObject).Message;
bRetry := (Pos('CANVAS DOES NOT ALLOW
DRAWING',Uppercase(fReportError))>0);
end;
if not bRetry then
Break;
Inc(nRetries);
end;
try
//fRBReport.DataPipeline.Close;
except
end;
finally
Result := bValid;
end;
end;
function TWebModule1.ExportReportExecute:Boolean;
var bValid:Boolean;
begin
try
bValid := False;
if fReportOutputType='PDF' then
begin
fRBReport.AllowPrintToFile := True;
fRBReport.ShowCancelDialog := False;
fRBReport.ShowPrintDialog := False;
fRBReport.TextFileName := fReportWorkName;
fRBReport.DeviceType := 'PDFFile';
fRBReport.Print;
end;
bValid := CheckOutputFileAfterExecute;
finally
Result := bValid;
end;
end;
function TWebModule1.CheckOutputFileAfterExecute:Boolean;
var cExt:String;
begin
Result := False;
try
cExt := ExtractFileExt(fReportOutputName);
if cExt='' then
begin
cExt := ExtractFileExt(fReportWorkName);
fReportOutputName := ChangeFileExt(fReportOutputName,cExt);
end;
if fReportWorkName=fReportOutputName then
Exit;
if not FileExists(fReportWorkName) then
Exit;
if FileExists(fReportOutputName) then
Exit;
try
if not FileExists(fReportOutputName) then
CopyFile(PChar(fReportWorkName),PChar(fReportOutputName),True);
SysUtils.DeleteFile(fReportWorkName);
except
end;
finally
Result := FileExists(fReportOutputName);
end;
end;
function TWebModule1.LoadReport(Sender: TObject):Boolean;
var slReport:TStrings;
sMessage:String;
stStream:TStream;
bValid:Boolean;
begin
bValid := False;
try
try
slReport := TStringList.Create;
slReport.LoadFromFile(fReportFullName);
slReport.Text :=
StringReplace(slReport.Text,'daODBCExpress','daNDB',[rfReplaceAll,
rfIgnoreCase]);
stStream := TStringStream.Create('');
slReport.SaveToStream(stStream);
if Assigned(fRBReport) then
FreeAndNil(fRBReport);
fRBReport := TppReport.Create(self);
fRBReport.Template.FileName := '';
fRBReport.Template.LoadFromStream(stStream);
bValid := True;
except
sMessage := 'Load Report Error:
'+Exception(ExceptObject).Message;
AddError(Sender,sMessage);
bValid := False;
end;
finally
slReport.Free;
stStream.Free;
Result := bValid;
end;
end;
function TWebModule1.SetWhere(Sender:TObject):Boolean;
var bValid:Boolean;
slFields:TStrings;
x,y:integer;
slSQL:TStrings;
oSQL: TdaSQL;
oDataView: TdaQueryDataview;
sMessage:String;
begin
bValid := False;
try
try
slSQL := TStringList.Create;
slFields := TStringList.Create;
oSQL := GetSQLObject(fRBReport);
oSQL.DatabaseName := fAsaSession.LoginDatabase;
fRBReport.FreeAutoSearchFields;
for x := 0 to oSQL.AvailableFieldCount-1 do
slFields.Add(oSQL.AvailableFields[x].FieldName);
//Create new criteria for remaining fields
for x := 0 to fSQLWhere.Count-1 do
begin
{determine if fieldname is in query}
y := slFields.IndexOf(fSQLWhere.Names[x]);
{if field is in query, then add criteria}
if (y <> -1) then
begin
fRBReport.CreateAutoSearchCriteria(
fRBReport.DataPipeLine.Name,
fSQLWhere.Names[x],
soEqual,
fSQLWhere.Values[fSQLWhere.Names[x]],
True);
end
else
AddError(Nil,'SQLWhere: Field '+fSQLWhere[x]+' not
defined');
end;
fRBReport.ShowAutoSearchDialog := False;
slSQL.Text := oSQL.SQLText.Text;
oDataview := GetFirstDataview(fRBReport);
oDataView.Active := True;
bValid := oDataView.Active and (fErrorCount=0);
except
bValid := False;
sMessage := 'Init SQLWhere: '+Exception(ExceptObject).Message;
AddError(Sender,sMessage);
end;
finally
slSQL.Free;
slFields.Free;
Result := bValid;
end;
end;
function TWebModule1.GetFirstDataview(aReport: TppReport):
TdaQueryDataview;
var
lDataModule: TdaDataModule;
lDataView: TdaDataView;
begin
Result := nil;
{get the datamodule}
lDataModule := daGetDataModule(aReport);
if (lDataModule <> nil) then
begin
lDataView := lDataModule.DataViews[0];
if (lDataView <> nil) and (lDataView is TdaQueryDataView) then
Result := TdaQueryDataView(lDataview);
end;
end;
function TWebModule1.GetSQLObject(aReport: TppReport): TdaSQL;
var
lDataView: TdaDataView;
begin
Result := nil;
lDataView := GetFirstDataview(aReport);
if (lDataView <> nil) and
(lDataView is TdaQueryDataView) then
begin
Result := TdaQueryDataView(lDataView).SQL;
end;
end;
procedure TWebModule1.AddError(Sender:TObject; ErrorMessage:String);
begin
fErrorList.Append(ErrorMessage);
Inc(fErrorCount);
end;
function TWebModule1.RunDefinedProcess(ProcessString:String):Boolean;
var bValid:Boolean;
sWork:String;
begin
bValid := True;
try
if ProcessString='' then
Exit;
//ProcessString := ReplaceTags(ProcessString);
with fQWork do
begin
Close;
SQL.Clear;
if CompareText(Copy(ProcessString,1,4),'CALL')=0 then
begin
sWork := 'E';
end
else
if CompareText(Copy(ProcessString,1,6),'SELECT')=0 then
begin
sWork := 'S';
end
else
begin
SQL.Add('CALL');
sWork := 'E';
AddError(Nil,'PreProcess Error: '+ProcessString);
end;
SQL.Add(ProcessString);
if sWork='E' then
begin
try
ExecSQL;
bValid := True;
except
bValid := False;
AddError(Nil,'PreProcess Error:
'+Exception(ExceptObject).Message);
end;
if not bValid then
Exit;
end
else
begin
try
Open;
bValid := True;
except
bValid := False;
AddError(Nil,'Init SQLWhere:
'+Exception(ExceptObject).Message);
end;
if not bValid then
Exit;
end;
end;
bValid := True;
finally
fQWork.Close;
Result := bValid;
end;
end;
procedure TWebModule1.GetIniName;
var sResult:String;
begin
SetLength(sResult, MAX_PATH+1); // Add 1 for the null character
GetModuleFileName(hInstance, PChar(sResult), MAX_PATH+1);
SetLength(sResult, Length(PChar(sResult)));
fModulePath := ExtractFilePath(sResult);
fIniFileName := ChangeFileExt(sResult,'.INI');
end;
end.
trying to resolve this problem.
Environment:
Delphi 5 Pro
ReportBuilder EnterPrise 6.03
NativeBD or ODBCExpress (SQLAnywhere Database)
Win2000 Pro \ W2000 Server
OmniHTTPD.exe Web Server (for testing).
I need to produce reports for a web application and initially designed
a standalone socket ReportServer application that received the
requests from the users, generated the reports in PDF format to disk
and returned the name of the PDF to the user. This system seemd to
work ok but after say 35 reports (of about 20K eack) it stopped
working and started giving weird errors - Out of memory, Unable to
print tocanvas etc. SleuthQA did not report any memory leaks and I
have ensured the printer drivers are the latest - HP LaserJet 4 Plus,
The ReportServer application was the only application operating from
the computer (Win2000 Pro).
I have now created a simple web application which receives a request
(GET) and produces a report from the supplied information. The
information supplied to the ReportServerWeb is:
- Database Connection Information
- Report Name
- Report Output Name
- SQLWhere Statement.
I have created a test program which sends requests to this ISAPI DLL
and only one request is sent at a time (ie no multi threading). The
system produces the PDF reports ok but when I exit the application I
receive the message:
Project c:\httpd\httpd.exe raised too many consecutive
exceptions...... and the system then fails to close.
I cannot see any errors in this code after spending hours searching.
Could someone \ anyone PLEASE look at the following code and advise if
I have overlooked an obvious errors - I am really getting desperate
with this one!!!!!
The other weird situation is the the following codes generates a dll
of 2.7Mb and it has only the basics??
unit ReportWebPrintMain;
interface
uses
Windows, Messages, SysUtils, Classes, HTTPApp, Db,
NdbBase, NdbAsa, daNDB, NdbBasDS, NdbAsaDS,
daSQL, daDataModule, daDataView, daQueryDataView,
ppComm, ppRelatv, ppProd, ppClass, ppReport, ppTypes, raCodMod,
ppDBPipe,TXtraDev;
type
TWebModule1 = class(TWebModule)
procedure WebModuleCreate(Sender: TObject);
procedure WebModuleDestroy(Sender: TObject);
procedure WebModuleBeforeDispatch(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled:
Boolean);
private
{ Private declarations }
fSQLWhere:TStrings;
fRBReport:TppReport;
fReportFullName:String;
fReportname:String;
fReportOutputName:String;
fReportWorkName:String;
fReportOutputType:String;
fReportPreProcess:String;
fReportError:String;
fDebug:String;
fLoginEngineName:String;
fLoginDatabase:String;
fResponseType:String;
fErrorList:TStrings;
fErrorCount:integer;
fAsaSession: TAsaSession;
fQWork:TAsaDataset;
fIniFileName:String;
fModulePath:String;
function ProcessWebRequest(Sender: TObject; Request: TWebRequest;
Response: TWebResponse):Boolean;
function RunDefinedProcess(ProcessString:String):Boolean;
procedure AddError(Sender:TObject; ErrorMessage:String);
function CheckOutputFileAfterExecute: Boolean;
function ExportReportExecute: Boolean;
function GetFirstDataview(aReport: TppReport): TdaQueryDataview;
function GetSQLObject(aReport: TppReport): TdaSQL;
function LoadReport(Sender: TObject): Boolean;
function PrintReport(Sender: TObject): Boolean;
function ReportExecute: Boolean;
function SetWhere(Sender: TObject): Boolean;
procedure GetIniName;
public
{ Public declarations }
end;
var
WebModule1: TWebModule1;
implementation
{$R *.DFM}
procedure TWebModule1.WebModuleCreate(Sender: TObject);
begin
//Create
fAsaSession := TAsaSession.Create(self);
fAsaSession.Name := 'AsaSession';
fAsaSession.ClientParams := 'CommLinks=tcpip';
fAsaSession.LoginUser :='infobase';
fAsaSession.LoginPassword :='infobase';
fQWork := TAsaDataset.Create(Nil);
fQWork.Session := fAsaSession;
fErrorList := TStringList.Create;
fSQLWhere := TStringList.Create;
fRBReport := Nil;
GetIniName;
end;
procedure TWebModule1.WebModuleDestroy(Sender: TObject);
begin
//Destroy
if Assigned(fRBReport) then
FreeAndNil(fRBReport);
FreeAndNil(fAsaSession);
FreeAndNil(fQWork);
fErrorList.Free;
fSQLWhere.Free;
end;
procedure TWebModule1.WebModuleBeforeDispatch(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
fErrorList.Clear;
fSQLWhere.Clear;
fErrorCount := 0;
fReportError := '';
fReportPreProcess := '';
if ProcessWebRequest(Sender,Request,Response) then
PrintReport(Sender);
if fErrorList.Count>0 then
Response.Content := 'ERROR: '+fErrorList.Text
else
Response.Content := 'OK: '+fReportOutputType+' File
'+fReportOutputName+' generated!';
Handled := True;
end;
function TWebModule1.ProcessWebRequest(Sender: TObject;
Request: TWebRequest; Response: TWebResponse):Boolean;
var slWork:TStrings;
x:integer;
bValid:Boolean;
begin
try
slWork := TStringList.Create;
slWork.Assign(Request.ContentFields);
for x := 0 to Request.QueryFields.Count-1 do
slWork.Append(Request.QueryFields[x]);
fResponseType := slWork.Values['ResponseType'];
fDebug := slWork.Values['Debug'];
fLoginEngineName := slWork.Values['LoginEngineName'];
if fLoginEngineName='' then
AddError(Sender,'LoginEngineName: No Value Supplied');
fLoginDatabase := slWork.Values['LoginDatabase'];
if fLoginDatabase='' then
AddError(Sender,'LoginDatabase: No Value Supplied');
if fErrorCount=0 then
begin
try
if fAsaSession.Connected and
((CompareText(fAsaSession.LoginEngineName,fLoginEngineName)<>0) or
(CompareText(fAsaSession.LoginDatabase,fLoginDatabase)<>0)) then
fAsaSession.Connected := False;
if not fAsaSession.Connected then
begin
fAsaSession.LoginEngineName := fLoginEngineName;
fAsaSession.LoginDatabase := fLoginDatabase;
fAsaSession.Name := fAsaSession.LoginDatabase;
fAsaSession.Connected := True;
end;
except
AddError(Sender,'Database Connect: '+
Exception(ExceptObject).Message);
end;
end;
fReportName := slWork.Values['ReportName'];
if fReportName='' then
AddError(Sender,'ReportFullName: No Value Supplied');
fReportFullName :=
ChangeFileExt(IncludeTrailingBackSlash(fModulePath)+'Reports\'+fReportName,'.RTM');
fSQLWhere.Text := slWork.Values['SQLWhere'];
if fSQLWhere.Count=0 then
AddError(Sender,'SQLWhere: No Value Supplied');
fReportOutputType := slWork.Values['ReportOutputType'];
fReportOutputName := slWork.Values['ReportOutputName'];
fReportPreProcess := slWork.Values['ReportPreProcess'];
if fReportOutputType='' then
fReportOutputType:='PDF';
bValid := (fErrorCount=0);
finally
slWork.Free;
Result := bValid;
end;
end;
function TWebModule1.PrintReport(Sender:TObject):Boolean;
var bValid:Boolean;
slFile, slWhere:TStrings;
begin
bValid := False;
try
slFile := TStringList.Create;
slWhere := TStringList.Create;
fReportError := '';
fReportWorkName := ExtractFilePath(fReportOutputName)+
FormatDateTime('YYYYMMDDHHNNZZZ',Now)+
ExtractFileExt(fReportOutputName);
if not RunDefinedProcess(fReportPreProcess) then
Exit;
fReportError := 'LoadReport';
if not LoadReport(Sender) then
begin
Exit;
end;
if not SetWhere(Sender) then
Exit;
bValid := ReportExecute;
finally
slFile.Free;
slWhere.Free;
if Assigned(fRBReport) then
FreeAndNil(fRBReport);
Result := bValid;
end;
end;
function TWebModule1.ReportExecute:Boolean;
var bValid:Boolean;
nRetries:integer;
bRetry:Boolean;
begin
bValid := False;
try
nRetries := 0;
fReportError := '';
while True do
begin
bRetry := False;
if nRetries>1 then
Break;
try
fRBReport.Reset;
fRBReport.CachePages := False;
fRBReport.Printer.Initialize;
with fRBReport do
begin
fRBReport.ShowCancelDialog := False;
fRBReport.ShowPrintDialog := False;
if
Pos(fReportOutputType,'PDF,XLS,RTF,RTF,GIF,HTML,JPEG,BMP,EMF,WMF')>0
then
bValid := ExportReportExecute
else
if fReportOutputType='RPT' then
begin
fRBReport.DeviceType := dtArchive;
fRBReport.ArchiveFileName := fReportOutputName;
fRBReport.Print;
bValid := CheckOutputFileAfterExecute;
end
else
if fReportOutputType='PRN' then
begin
fRBReport.DeviceType := dtReportTextFile;
fRBReport.TextFileName := fReportOutputName;
fRBReport.Print;
bValid := CheckOutputFileAfterExecute;
end
else
if fReportOutputType='TXT' then
begin
fRBReport.DeviceType := dtTextFile;
fRBReport.TextFileName := fReportOutputName;
fRBReport.Print;
bValid := CheckOutputFileAfterExecute;
end
else
begin
fRBReport.AllowPrintToFile := False;
fRBReport.DeviceType := dtPrinter;
fRBReport.Print;
bValid := True;
end;
end;
except
bValid := False;
fReportError := Exception(ExceptObject).Message;
bRetry := (Pos('CANVAS DOES NOT ALLOW
DRAWING',Uppercase(fReportError))>0);
end;
if not bRetry then
Break;
Inc(nRetries);
end;
try
//fRBReport.DataPipeline.Close;
except
end;
finally
Result := bValid;
end;
end;
function TWebModule1.ExportReportExecute:Boolean;
var bValid:Boolean;
begin
try
bValid := False;
if fReportOutputType='PDF' then
begin
fRBReport.AllowPrintToFile := True;
fRBReport.ShowCancelDialog := False;
fRBReport.ShowPrintDialog := False;
fRBReport.TextFileName := fReportWorkName;
fRBReport.DeviceType := 'PDFFile';
fRBReport.Print;
end;
bValid := CheckOutputFileAfterExecute;
finally
Result := bValid;
end;
end;
function TWebModule1.CheckOutputFileAfterExecute:Boolean;
var cExt:String;
begin
Result := False;
try
cExt := ExtractFileExt(fReportOutputName);
if cExt='' then
begin
cExt := ExtractFileExt(fReportWorkName);
fReportOutputName := ChangeFileExt(fReportOutputName,cExt);
end;
if fReportWorkName=fReportOutputName then
Exit;
if not FileExists(fReportWorkName) then
Exit;
if FileExists(fReportOutputName) then
Exit;
try
if not FileExists(fReportOutputName) then
CopyFile(PChar(fReportWorkName),PChar(fReportOutputName),True);
SysUtils.DeleteFile(fReportWorkName);
except
end;
finally
Result := FileExists(fReportOutputName);
end;
end;
function TWebModule1.LoadReport(Sender: TObject):Boolean;
var slReport:TStrings;
sMessage:String;
stStream:TStream;
bValid:Boolean;
begin
bValid := False;
try
try
slReport := TStringList.Create;
slReport.LoadFromFile(fReportFullName);
slReport.Text :=
StringReplace(slReport.Text,'daODBCExpress','daNDB',[rfReplaceAll,
rfIgnoreCase]);
stStream := TStringStream.Create('');
slReport.SaveToStream(stStream);
if Assigned(fRBReport) then
FreeAndNil(fRBReport);
fRBReport := TppReport.Create(self);
fRBReport.Template.FileName := '';
fRBReport.Template.LoadFromStream(stStream);
bValid := True;
except
sMessage := 'Load Report Error:
'+Exception(ExceptObject).Message;
AddError(Sender,sMessage);
bValid := False;
end;
finally
slReport.Free;
stStream.Free;
Result := bValid;
end;
end;
function TWebModule1.SetWhere(Sender:TObject):Boolean;
var bValid:Boolean;
slFields:TStrings;
x,y:integer;
slSQL:TStrings;
oSQL: TdaSQL;
oDataView: TdaQueryDataview;
sMessage:String;
begin
bValid := False;
try
try
slSQL := TStringList.Create;
slFields := TStringList.Create;
oSQL := GetSQLObject(fRBReport);
oSQL.DatabaseName := fAsaSession.LoginDatabase;
fRBReport.FreeAutoSearchFields;
for x := 0 to oSQL.AvailableFieldCount-1 do
slFields.Add(oSQL.AvailableFields[x].FieldName);
//Create new criteria for remaining fields
for x := 0 to fSQLWhere.Count-1 do
begin
{determine if fieldname is in query}
y := slFields.IndexOf(fSQLWhere.Names[x]);
{if field is in query, then add criteria}
if (y <> -1) then
begin
fRBReport.CreateAutoSearchCriteria(
fRBReport.DataPipeLine.Name,
fSQLWhere.Names[x],
soEqual,
fSQLWhere.Values[fSQLWhere.Names[x]],
True);
end
else
AddError(Nil,'SQLWhere: Field '+fSQLWhere[x]+' not
defined');
end;
fRBReport.ShowAutoSearchDialog := False;
slSQL.Text := oSQL.SQLText.Text;
oDataview := GetFirstDataview(fRBReport);
oDataView.Active := True;
bValid := oDataView.Active and (fErrorCount=0);
except
bValid := False;
sMessage := 'Init SQLWhere: '+Exception(ExceptObject).Message;
AddError(Sender,sMessage);
end;
finally
slSQL.Free;
slFields.Free;
Result := bValid;
end;
end;
function TWebModule1.GetFirstDataview(aReport: TppReport):
TdaQueryDataview;
var
lDataModule: TdaDataModule;
lDataView: TdaDataView;
begin
Result := nil;
{get the datamodule}
lDataModule := daGetDataModule(aReport);
if (lDataModule <> nil) then
begin
lDataView := lDataModule.DataViews[0];
if (lDataView <> nil) and (lDataView is TdaQueryDataView) then
Result := TdaQueryDataView(lDataview);
end;
end;
function TWebModule1.GetSQLObject(aReport: TppReport): TdaSQL;
var
lDataView: TdaDataView;
begin
Result := nil;
lDataView := GetFirstDataview(aReport);
if (lDataView <> nil) and
(lDataView is TdaQueryDataView) then
begin
Result := TdaQueryDataView(lDataView).SQL;
end;
end;
procedure TWebModule1.AddError(Sender:TObject; ErrorMessage:String);
begin
fErrorList.Append(ErrorMessage);
Inc(fErrorCount);
end;
function TWebModule1.RunDefinedProcess(ProcessString:String):Boolean;
var bValid:Boolean;
sWork:String;
begin
bValid := True;
try
if ProcessString='' then
Exit;
//ProcessString := ReplaceTags(ProcessString);
with fQWork do
begin
Close;
SQL.Clear;
if CompareText(Copy(ProcessString,1,4),'CALL')=0 then
begin
sWork := 'E';
end
else
if CompareText(Copy(ProcessString,1,6),'SELECT')=0 then
begin
sWork := 'S';
end
else
begin
SQL.Add('CALL');
sWork := 'E';
AddError(Nil,'PreProcess Error: '+ProcessString);
end;
SQL.Add(ProcessString);
if sWork='E' then
begin
try
ExecSQL;
bValid := True;
except
bValid := False;
AddError(Nil,'PreProcess Error:
'+Exception(ExceptObject).Message);
end;
if not bValid then
Exit;
end
else
begin
try
Open;
bValid := True;
except
bValid := False;
AddError(Nil,'Init SQLWhere:
'+Exception(ExceptObject).Message);
end;
if not bValid then
Exit;
end;
end;
bValid := True;
finally
fQWork.Close;
Result := bValid;
end;
end;
procedure TWebModule1.GetIniName;
var sResult:String;
begin
SetLength(sResult, MAX_PATH+1); // Add 1 for the null character
GetModuleFileName(hInstance, PChar(sResult), MAX_PATH+1);
SetLength(sResult, Length(PChar(sResult)));
fModulePath := ExtractFilePath(sResult);
fIniFileName := ChangeFileExt(sResult,'.INI');
end;
end.
This discussion has been closed.
Comments
nothing weird, depends on the used units and forms (and the included report
templates).
I don't know if the following will help you ...
when creating components with an 'Owner'. the 'Owner' itself is responsible
for destroying the owned components.
Either pass 'nil' and free them or pass an 'Owner' and don't free them.
jm2c,
Chris Ueberall;
Thanks for taking the time to respond.
On Mon, 5 Aug 2002 11:47:12 -0500, "Mike Leftwich"
Thanks for your response.
On Mon, 5 Aug 2002 13:17:15 +0200, "Chris Ueberall [TeamDM]"
I studied this news group for quite a while regarding the multi
threading aspects of RB and found the articles that you mentioned
invaluable. I tried the mutex approach. The problem that I had was
that if a user fired off a report which took a long time to complete
or failed to complete, the blocked (mutexed) thread stopped all other
reports from being processed. Our application is online realtime where
results of requests that users have made are returned in PDF format.
The reports are quite small and a typical result may be 20K. However,
some reports, though infrequent, could take a fair while to process.
For this reason I can send lengthy or NonTreadSafe reports through one
queue (CGI) and ThreadSafe reports through a second queue (ISAPI).
I will keep you posted.
Peter Brooks
On Tue, 6 Aug 2002 09:06:09 -0500, "Mike Leftwich"