{{Copyright(c)2016 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
dickmaley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to dickmaley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
unit ads_WebRBuilderGen;
(*UnitIndex Master Index Implementation Section Download UnitsDescription: ads_WebRBuilderGen.pas This unit contains the following routines.
PopulateRequest TadsRBuilderWebServer.CreateForm TadsRBuilderWebServer.MakeHtmlCombo TadsRBuilderWebServer.MakeHTMLPage TadsRBuilderWebServer.MakeHTMLPageGetHead TadsRBuilderWebServer.MakeHTMLPageGetOneBody TadsRBuilderWebServer.MakeHTMLPageNav TadsRBuilderWebServer.MakeRBuilderDeviceTypeHtmlCombo TadsRBuilderWebServer.MakeRBuilderReportHtmlCombo TadsRBuilderWebServer.PrintReportDetail TadsRBuilderWebServer.PrintReportForm TadsRBuilderWebServer.RBuilderDeviceTypeToContentType TadsRBuilderWebServer.RBuilderDeviceTypeToFileExtension TadsRBuilderWebServer.RequestSaveToFile WebImageRequest
*)
interface
Uses
SysUtils,
Classes,
dmUtil,
TXtraDev,
TXComp,
httpapp
;
type
TadsRBuilderWebServer = class(TObject)
private
public
{ Public declarations }
Page : String;
Success : Boolean;
RequestValues : TStringList;
RBDeviceType : String;
MimeContentType: String;
function CreateForm(aLevel: Integer): TdmCustomForm;
Procedure PrintReportForm(
ReportForm : TdmCustomForm;
Device_Type: String;
OutFile : String;
ImgQual : String);
Procedure PrintReportDetail(
ReportNum : Integer;
Device_Type: String;
OutFile : String;
ImgQual : String
);
Constructor Create(Request: TWebRequest;ReportForm: TdmCustomForm);OverLoad;
Constructor Create(Request: TWebRequest);OverLoad;
Constructor Create;OverLoad;
destructor Destroy; Override;
Function MakeHtmlCombo(ID:String;HideList,DisplayList:TStringList): String;
Function MakeRBuilderDeviceTypeHtmlCombo: String;
Function MakeRBuilderReportHtmlCombo: String;
Function RBuilderDeviceTypeToContentType(DeviceType: String): String;
Function RBuilderDeviceTypeToFileExtension(DeviceType: String): String;
Procedure MakeHTMLPage(OutFile: String);
procedure MakeHTMLPageGetOneBody(var Page : TStringList);
Function MakeHTMLPageNav(PageNum,PageMax : Integer): String;
procedure RequestSaveToFile(FileName: String);
Function MakeHTMLPageGetHead(Page : String): String;
end;
Function PopulateRequest(Request: TWebRequest): String;
Procedure WebImageRequest(Request :TWebRequest;var Response : TWebResponse);
implementation
uses
ads_Exception,
ads_File,
ads_Strg,
Graphics
;
Var
UnitName : String = 'ads_WebRBuilderGen';
ProcName : String = 'Unknown';
ClName : String = 'TadsRBuilderWebServer';
//Unit Description UnitIndex Master Indexfunction TadsRBuilderWebServer.CreateForm(aLevel: Integer): TdmCustomForm; begin Result := nil; ProcName := 'CreateForm'; ProcName := Self.ClassName+'.'+ProcName; Try Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
Procedure TadsRBuilderWebServer.PrintReportForm(
ReportForm : TdmCustomForm;
Device_Type: String;
OutFile : String;
ImgQual : String);
var
lForm : TdmCustomForm;
lstErrors : TStringlist;
boError : Boolean;
sgLabel : String;
sgIs : String;
sgShouldBe: String;
sgSpaces : String;
ExtraOpts : TExtraOptions;
sgNext : String;
sgPrior : String;
inImgQual : Integer;
begin
ProcName := 'PrintReportForm';
ProcName := Self.ClassName+'.'+ProcName; Try
RBDeviceType := Device_Type;
MimeContentType:= RBuilderDeviceTypeToContentType(RBDeviceType);
Page := '';
Success := False;
boError := False;
lForm := ReportForm;
If lForm = nil Then Exit;
sgNext := 'Next>>';
sgPrior := '<<Back';
ExtraOpts := TExtraOptions.Create(lForm);
Try
lForm.DisplayFormModal := False;
lForm.DisplayForm := False;
With lForm.Report Do
Begin
AllowPrintToArchive := False;
AllowPrintToFile := True;
DeviceType := Device_Type;
ModalCancelDialog := False;
ModalPreview := False;
SavePrinterSetup := False;
ShowCancelDialog := False;
ShowPrintDialog := False;
TextFileName := OutFile;
If AllowPrintToArchive Then boError := True;
If Not AllowPrintToFile Then boError := True;
If DeviceType <> Device_Type Then boError := True;
If ModalCancelDialog Then boError := True;
If ModalPreview Then boError := True;
If SavePrinterSetup Then boError := True;
If ShowCancelDialog Then boError := True;
If ShowPrintDialog Then boError := True;
If TextFileName <> OutFile Then boError := True;
If boError Then
Begin
lstErrors := TStringList.Create();
Try
lstErrors.Clear;
sgSpaces := ' ';
sgLabel := 'Property';
sgIs := 'ValueIs';
sgShouldBe:= 'ShouldBe';
sgLabel := sgLabel +sgSpaces;
sgIs := sgIs +sgSpaces;
sgShouldBe:= sgShouldBe+sgSpaces;
sgLabel := Copy(sgLabel ,1,20);
sgIs := Copy(sgIs ,1,20);
sgShouldBe:= Copy(sgShouldBe,1,70);
lstErrors.Add(sgLabel+sgIs+sgShouldBe);
sgLabel := 'AllowPrintToArchive';
If AllowPrintToArchive Then sgIs := 'True' Else sgIs := 'False';
sgShouldBe:= 'False';
sgIs := 'ValueIs';
sgShouldBe:= 'ShouldBe';
sgLabel := sgLabel +sgSpaces;
sgIs := sgIs +sgSpaces;
sgShouldBe:= sgShouldBe+sgSpaces;
sgLabel := Copy(sgLabel ,1,20);
sgIs := Copy(sgIs ,1,20);
sgShouldBe:= Copy(sgShouldBe,1,70);
lstErrors.Add(sgLabel+sgIs+sgShouldBe);
sgLabel := 'AllowPrintToFile';
If AllowPrintToFile Then sgIs := 'True' Else sgIs := 'False';
sgShouldBe:= 'True';
sgIs := 'ValueIs';
sgShouldBe:= 'ShouldBe';
sgLabel := sgLabel +sgSpaces;
sgIs := sgIs +sgSpaces;
sgShouldBe:= sgShouldBe+sgSpaces;
sgLabel := Copy(sgLabel ,1,20);
sgIs := Copy(sgIs ,1,20);
sgShouldBe:= Copy(sgShouldBe,1,70);
lstErrors.Add(sgLabel+sgIs+sgShouldBe);
sgLabel := 'DeviceType';
sgIs := DeviceType;
sgShouldBe:= Device_Type;
sgIs := 'ValueIs';
sgShouldBe:= 'ShouldBe';
sgLabel := sgLabel +sgSpaces;
sgIs := sgIs +sgSpaces;
sgShouldBe:= sgShouldBe+sgSpaces;
sgLabel := Copy(sgLabel ,1,20);
sgIs := Copy(sgIs ,1,20);
sgShouldBe:= Copy(sgShouldBe,1,70);
lstErrors.Add(sgLabel+sgIs+sgShouldBe);
sgLabel := 'ModalCancelDialog';
If ModalCancelDialog Then sgIs := 'True' Else sgIs := 'False';
sgShouldBe:= 'False';
sgIs := 'ValueIs';
sgShouldBe:= 'ShouldBe';
sgLabel := sgLabel +sgSpaces;
sgIs := sgIs +sgSpaces;
sgShouldBe:= sgShouldBe+sgSpaces;
sgLabel := Copy(sgLabel ,1,20);
sgIs := Copy(sgIs ,1,20);
sgShouldBe:= Copy(sgShouldBe,1,70);
lstErrors.Add(sgLabel+sgIs+sgShouldBe);
sgLabel := 'ModalPreview';
If ModalPreview Then sgIs := 'True' Else sgIs := 'False';
sgShouldBe:= 'False';
sgIs := 'ValueIs';
sgShouldBe:= 'ShouldBe';
sgLabel := sgLabel +sgSpaces;
sgIs := sgIs +sgSpaces;
sgShouldBe:= sgShouldBe+sgSpaces;
sgLabel := Copy(sgLabel ,1,20);
sgIs := Copy(sgIs ,1,20);
sgShouldBe:= Copy(sgShouldBe,1,70);
lstErrors.Add(sgLabel+sgIs+sgShouldBe);
sgLabel := 'SavePrinterSetup';
If SavePrinterSetup Then sgIs := 'True' Else sgIs := 'False';
sgShouldBe:= 'False';
sgIs := 'ValueIs';
sgShouldBe:= 'ShouldBe';
sgLabel := sgLabel +sgSpaces;
sgIs := sgIs +sgSpaces;
sgShouldBe:= sgShouldBe+sgSpaces;
sgLabel := Copy(sgLabel ,1,20);
sgIs := Copy(sgIs ,1,20);
sgShouldBe:= Copy(sgShouldBe,1,70);
lstErrors.Add(sgLabel+sgIs+sgShouldBe);
sgLabel := 'ShowCancelDialog';
If ShowCancelDialog Then sgIs := 'True' Else sgIs := 'False';
sgShouldBe:= 'False';
sgIs := 'ValueIs';
sgShouldBe:= 'ShouldBe';
sgLabel := sgLabel +sgSpaces;
sgIs := sgIs +sgSpaces;
sgShouldBe:= sgShouldBe+sgSpaces;
sgLabel := Copy(sgLabel ,1,20);
sgIs := Copy(sgIs ,1,20);
sgShouldBe:= Copy(sgShouldBe,1,70);
lstErrors.Add(sgLabel+sgIs+sgShouldBe);
sgLabel := 'ShowPrintDialog';
If ShowPrintDialog Then sgIs := 'True' Else sgIs := 'False';
sgShouldBe:= 'False';
sgIs := 'ValueIs';
sgShouldBe:= 'ShouldBe';
sgLabel := sgLabel +sgSpaces;
sgIs := sgIs +sgSpaces;
sgShouldBe:= sgShouldBe+sgSpaces;
sgLabel := Copy(sgLabel ,1,20);
sgIs := Copy(sgIs ,1,20);
sgShouldBe:= Copy(sgShouldBe,1,70);
lstErrors.Add(sgLabel+sgIs+sgShouldBe);
sgLabel := 'TextFileName';
sgIs := TextFileName;
sgShouldBe:= OutFile;
sgIs := 'ValueIs';
sgShouldBe:= 'ShouldBe';
sgLabel := sgLabel +sgSpaces;
sgIs := sgIs +sgSpaces;
sgShouldBe:= sgShouldBe+sgSpaces;
sgLabel := Copy(sgLabel ,1,20);
sgIs := Copy(sgIs ,1,20);
sgShouldBe:= Copy(sgShouldBe,1,70);
lstErrors.Add(sgLabel+sgIs+sgShouldBe);
lstErrors.SaveToFile('Errors.txt');
Finally
lstErrors.Free;
End
End;
ExtraOpts.CSS2.BackLink := '';
ExtraOpts.CSS2.ForwardLink := '';
ExtraOpts.CSS2.UseTextFileName := True;
ExtraOpts.CSS2.Visible := True;
ExtraOpts.CSS2.ZoomableImages := False;
ExtraOpts.Excel.Visible := True;
ExtraOpts.Graphic.UseTextFileName := True;
ExtraOpts.Graphic.Visible := True;
//TPixelFormat =
// (pfDevice, pf1bit, pf4bit, pf8bit, pf15bit,
// pf16bit, pf24bit, pf32bit, pfCustom);
ExtraOpts.Graphic.PixelFormat := pf1bit;
Try
inImgQual := StrToInt(ImgQual);
Case inImgQual Of
1 : ExtraOpts.Graphic.PixelFormat := pf1bit;
4 : ExtraOpts.Graphic.PixelFormat := pf4bit;
8 : ExtraOpts.Graphic.PixelFormat := pf8bit;
16 : ExtraOpts.Graphic.PixelFormat := pf16bit;
24 : ExtraOpts.Graphic.PixelFormat := pf24bit;
32 : ExtraOpts.Graphic.PixelFormat := pf32bit;
End;
Except
ExtraOpts.Graphic.PixelFormat := pf1bit;
End;
If UpperCase(ExtractFileExt(OutFile))='.TIF' Then
ExtraOpts.Graphic.PixelFormat := pf4bit;
ExtraOpts.HTML.BackLink := sgPrior;
ExtraOpts.HTML.ForwardLink := sgNext;
ExtraOpts.HTML.UseTextFileName := True;
ExtraOpts.HTML.Visible := True;
ExtraOpts.HTML.ZoomableImages := False;
ExtraOpts.Lotus.Visible := True;
ExtraOpts.PDF.Author := 'Richard Maley';
ExtraOpts.PDF.CompressImages := True;
ExtraOpts.PDF.Creator := 'Richard Maley';
ExtraOpts.PDF.ScaleImages := True;
ExtraOpts.PDF.Visible := True;
ExtraOpts.RTF.Visible := True;
Print;
//If (UpperCase(Device_Type)='HTMLFILE') Then
// MakeHtmlPage(OutFile);
End;
Success := True;
Finally
ExtraOpts.Free;
//lForm.Free;
End;
//TimeTest_ads.Stop;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
Procedure TadsRBuilderWebServer.PrintReportDetail(
ReportNum : Integer;
Device_Type: String;
OutFile : String;
ImgQual : String
);
var
lForm : TdmCustomForm;
begin
ProcName := 'PrintReportDetail';
ProcName := Self.ClassName+'.'+ProcName; Try
lForm := CreateForm(ReportNum);
If lForm = nil Then Exit;
PrintReportForm(
lForm , //ReportForm : TdmCustomForm;
Device_Type, //Device_Type: String;
OutFile , //OutFile : String);
ImgQual );//ImgQual : String;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Constructor TadsRBuilderWebServer.Create(Request: TWebRequest;ReportForm: TdmCustomForm);
Var
OutFile : String;
sgNum : String;
sgExt : String;
sgDevTyp : String;
ReportNum : Integer;
DeviceType: String;
ImgQual : String;
begin
ProcName := 'Create';
ProcName := Self.ClassName+'.'+ProcName; Try
RequestValues := TStringList.Create();
RequestValues.SetText(PChar(PopulateRequest(Request)));
sgNum := '15';
ReportNum := 15;
DeviceType:= 'HTMLFile';
If RequestValues.Values['Request.ContentFields.Item.num'] <> '' Then
Begin
sgNum := RequestValues.Values['Request.ContentFields.Item.num'];
ReportNum := StrToInt(sgNum);
End;
ImgQual := '1';
If RequestValues.Values['Request.ContentFields.Item.ImageQuality'] <> '' Then
Begin
ImgQual := RequestValues.Values['Request.ContentFields.Item.ImageQuality'];
End;
If RequestValues.Values['Request.ContentFields.Item.DeviceType'] <> '' Then
DeviceType := RequestValues.Values['Request.ContentFields.Item.DeviceType'];
Page := '';
sgDevTyp:= UpperCase(DeviceType);
sgExt := RBuilderDeviceTypeToFileExtension(DeviceType);
sgNum := FormatFloat('#.0000000000000',now());
sgNum := StringReplace(sgNum,'.','',[rfReplaceAll]);
OutFile := ParamStr(0);
OutFile := Copy(OutFile,1,Length(OutFile)-4)+sgNum+sgExt;
RBDeviceType := DeviceType;
MimeContentType:= RBuilderDeviceTypeToContentType(RBDeviceType);
PrintReportDetail(ReportNum,DeviceType,OutFile,ImgQual);
If Success Then
Begin
If FileExists(OutFile) Then Page := FileToStr(OutFile);
End;
If FileExists(OutFile) Then DeleteFile(OutFile);
//TimeTest_ads.Stop;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
constructor TadsRBuilderWebServer.Create(Request: TWebRequest);
Var
OutFile : String;
sgNum : String;
sgExt : String;
sgDevTyp : String;
ReportNum : Integer;
DeviceType: String;
ImgQual : String;
begin
ProcName := 'Create';
ProcName := Self.ClassName+'.'+ProcName; Try
ImgQual := '1';
RequestValues := TStringList.Create();
RequestValues.SetText(PChar(PopulateRequest(Request)));
sgNum := '15';
ReportNum := 15;
DeviceType:= 'HTMLFile';
If RequestValues.Values['Request.ContentFields.Item.num'] <> '' Then
Begin
sgNum := RequestValues.Values['Request.ContentFields.Item.num'];
ReportNum := StrToInt(sgNum);
End;
If RequestValues.Values['Request.ContentFields.Item.ImageQuality'] <> '' Then
Begin
ImgQual := RequestValues.Values['Request.ContentFields.Item.ImageQuality'];
End;
If RequestValues.Values['Request.ContentFields.Item.DeviceType'] <> '' Then
DeviceType := RequestValues.Values['Request.ContentFields.Item.DeviceType'];
Page := '';
sgDevTyp:= UpperCase(DeviceType);
sgExt := RBuilderDeviceTypeToFileExtension(DeviceType);
sgNum := FormatFloat('#.0000000000000',now());
sgNum := StringReplace(sgNum,'.','',[rfReplaceAll]);
OutFile := ParamStr(0);
OutFile := Copy(OutFile,1,Length(OutFile)-4)+sgNum+sgExt;
RBDeviceType := DeviceType;
MimeContentType:= RBuilderDeviceTypeToContentType(RBDeviceType);
PrintReportDetail(ReportNum,DeviceType,OutFile,ImgQual);
If Success Then
Begin
If FileExists(OutFile) Then Page := FileToStr(OutFile);
End;
If FileExists(OutFile) Then DeleteFile(OutFile);
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
constructor TadsRBuilderWebServer.Create;
begin
ProcName := 'Create2';
ProcName := Self.ClassName+'.'+ProcName; Try
RequestValues := TStringList.Create();
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
//Unit Description UnitIndex Master Index
Function TadsRBuilderWebServer.MakeHtmlCombo(
ID : String;
HideList : TStringList;
DisplayList : TStringList): String;
Var
inCounter : Integer;
lst : TStringList;
sgIndent : String;
begin
Result := '';
ProcName := 'MakeHtmlCombo';
ProcName := Self.ClassName+'.'+ProcName; Try
//TimeTest_ads.Start(ProcName);
If HideList .Count = 0 Then Exit;
If DisplayList.Count = 0 Then Exit;
If DisplayList.Count <> HideList.Count Then Exit;
lst := TStringList.Create();
Try
sgIndent := ' ';
lst.Clear;
lst.Add('');
Result := lst.Text;
Finally
lst.Free;
End;
//TimeTest_ads.Stop;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
//Unit Description UnitIndex Master Index
function TadsRBuilderWebServer.MakeRBuilderReportHtmlCombo: String;
Var
HideList : TStringList;
DisplayList : TStringList;
begin
ProcName := 'MakeRBuilderReportHtmlCombo';
ProcName := Self.ClassName+'.'+ProcName; Try
//TimeTest_ads.Start(ProcName);
HideList := TStringList.Create();
DisplayList := TStringList.Create();
Try
HideList .Clear;
DisplayList.Clear;
HideList .Add('11');
DisplayList.Add('Report Builder Report 0011');
HideList .Add('12');
DisplayList.Add('Report Builder Report 0012');
HideList .Add('13');
DisplayList.Add('Report Builder Report 0013');
HideList .Add('14');
DisplayList.Add('Report Builder Report 0014');
HideList .Add('15');
DisplayList.Add('Report Builder Report 0015');
HideList .Add('16');
DisplayList.Add('Report Builder Report 0016');
HideList .Add('17');
DisplayList.Add('Report Builder Report 0017');
HideList .Add('18');
DisplayList.Add('Report Builder Report 0018');
HideList .Add('21');
DisplayList.Add('Report Builder Report 0021');
HideList .Add('22');
DisplayList.Add('Report Builder Report 0022');
HideList .Add('23');
DisplayList.Add('Report Builder Report 0023');
HideList .Add('24');
DisplayList.Add('Report Builder Report 0024');
HideList .Add('25');
DisplayList.Add('Report Builder Report 0025');
HideList .Add('26');
DisplayList.Add('Report Builder Report 0026');
HideList .Add('27');
DisplayList.Add('Report Builder Report 0027');
HideList .Add('28');
DisplayList.Add('Report Builder Report 0028');
HideList .Add('29');
DisplayList.Add('Report Builder Report 0029');
HideList .Add('31');
DisplayList.Add('Report Builder Report 0031');
HideList .Add('32');
DisplayList.Add('Report Builder Report 0032');
HideList .Add('33');
DisplayList.Add('Report Builder Report 0033');
HideList .Add('41');
DisplayList.Add('Report Builder Report 0041');
HideList .Add('42');
DisplayList.Add('Report Builder Report 0042');
HideList .Add('51');
DisplayList.Add('Report Builder Report 0051');
HideList .Add('52');
DisplayList.Add('Report Builder Report 0052');
HideList .Add('61');
DisplayList.Add('Report Builder Report 0061');
HideList .Add('62');
DisplayList.Add('Report Builder Report 0062');
HideList .Add('63');
DisplayList.Add('Report Builder Report 0063');
HideList .Add('64');
DisplayList.Add('Report Builder Report 0064');
HideList .Add('71');
DisplayList.Add('Report Builder Report 0071');
HideList .Add('72');
DisplayList.Add('Report Builder Report 0072');
HideList .Add('73');
DisplayList.Add('Report Builder Report 0073');
HideList .Add('81');
DisplayList.Add('Report Builder Report 0081');
HideList .Add('82');
DisplayList.Add('Report Builder Report 0082');
HideList .Add('83');
DisplayList.Add('Report Builder Report 0083');
HideList .Add('84');
DisplayList.Add('Report Builder Report 0084');
HideList .Add('85');
DisplayList.Add('Report Builder Report 0085');
HideList .Add('91');
DisplayList.Add('Report Builder Report 0091');
HideList .Add('101');
DisplayList.Add('Report Builder Report 0101');
HideList .Add('102');
DisplayList.Add('Report Builder Report 0102');
HideList .Add('103');
DisplayList.Add('Report Builder Report 0103');
HideList .Add('104');
DisplayList.Add('Report Builder Report 0104');
HideList .Add('105');
DisplayList.Add('Report Builder Report 0105');
HideList .Add('106');
DisplayList.Add('Report Builder Report 0106');
HideList .Add('107');
DisplayList.Add('Report Builder Report 0107');
HideList .Add('111');
DisplayList.Add('Report Builder Report 0111');
HideList .Add('112');
DisplayList.Add('Report Builder Report 0112');
HideList .Add('113');
DisplayList.Add('Report Builder Report 0113');
HideList .Add('114');
DisplayList.Add('Report Builder Report 0114');
HideList .Add('115');
DisplayList.Add('Report Builder Report 0115');
HideList .Add('116');
DisplayList.Add('Report Builder Report 0116');
HideList .Add('121');
DisplayList.Add('Report Builder Report 0121');
HideList .Add('122');
DisplayList.Add('Report Builder Report 0122');
HideList .Add('123');
DisplayList.Add('Report Builder Report 0123');
HideList .Add('124');
DisplayList.Add('Report Builder Report 0124');
HideList .Add('131');
DisplayList.Add('Report Builder Report 0131');
HideList .Add('132');
DisplayList.Add('Report Builder Report 0132');
HideList .Add('133');
DisplayList.Add('Report Builder Report 0133');
HideList .Add('134');
DisplayList.Add('Report Builder Report 0134');
HideList .Add('135');
DisplayList.Add('Report Builder Report 0135');
HideList .Add('136');
DisplayList.Add('Report Builder Report 0136');
HideList .Add('137');
DisplayList.Add('Report Builder Report 0137');
HideList .Add('138');
DisplayList.Add('Report Builder Report 0138');
HideList .Add('139');
DisplayList.Add('Report Builder Report 0139');
HideList .Add('141');
DisplayList.Add('Report Builder Report 0141');
HideList .Add('142');
DisplayList.Add('Report Builder Report 0142');
HideList .Add('143');
DisplayList.Add('Report Builder Report 0143');
HideList .Add('144');
DisplayList.Add('Report Builder Report 0144');
HideList .Add('145');
DisplayList.Add('Report Builder Report 0145');
HideList .Add('146');
DisplayList.Add('Report Builder Report 0146');
HideList .Add('147');
DisplayList.Add('Report Builder Report 0147');
HideList .Add('148');
DisplayList.Add('Report Builder Report 0148');
HideList .Add('151');
DisplayList.Add('Report Builder Report 0151');
HideList .Add('152');
DisplayList.Add('Report Builder Report 0152');
HideList .Add('153');
DisplayList.Add('Report Builder Report 0153');
HideList .Add('154');
DisplayList.Add('Report Builder Report 0154');
Result :=
MakeHtmlCombo(
'num' , //ID : String;
HideList , //HideList : TStringList;
DisplayList);//DisplayList : TStringList): String;
Finally
HideList .Free;
DisplayList.Free;
End;
//TimeTest_ads.Stop;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
//Unit Description UnitIndex Master Index
Function TadsRBuilderWebServer.RBuilderDeviceTypeToFileExtension(DeviceType: String): String;
Var
lstDTypes : TStringList;
lstCTypes : TStringList;
sgDType : String;
inIndex : Integer;
Begin
Result := '';
ProcName := 'RBuilderDeviceTypeToFileExtension'; Try
//TimeTest_ads.Start(ProcName);
lstDTypes := TStringList.Create();
lstCTypes := TStringList.Create();
Try
(*
*)
lstDTypes.Add('EXCELFILE'); lstCTypes.Add('.xls');
lstDTypes.Add('GRAPHICFILE'); lstCTypes.Add('.jpg');
lstDTypes.Add('GRAPHICFILE_BMP'); lstCTypes.Add('.bmp');
lstDTypes.Add('GRAPHICFILE_JPEG'); lstCTypes.Add('.jpeg');
lstDTypes.Add('GRAPHICFILE_JPG'); lstCTypes.Add('.jpg');
lstDTypes.Add('GRAPHICFILE_TIF'); lstCTypes.Add('.tif');
lstDTypes.Add('HTML_ADSFILE'); lstCTypes.Add('.htm');
lstDTypes.Add('HTMLFILE'); lstCTypes.Add('.htm');
lstDTypes.Add('HTMLLAYERFILE'); lstCTypes.Add('.htm');
lstDTypes.Add('LOTUSFILE'); lstCTypes.Add('.wk1');
lstDTypes.Add('PDFFILE'); lstCTypes.Add('.pdf');
lstDTypes.Add('QUATTROFILE'); lstCTypes.Add('.wq1');
lstDTypes.Add('REPORTTEXTFILE'); lstCTypes.Add('.txt');
lstDTypes.Add('RTFFILE'); lstCTypes.Add('.rtf');
lstDTypes.Add('TEXTFILEARCHIVEFILE'); lstCTypes.Add('.arc');
sgDType := UpperCase(DeviceType);
inIndex := lstDTypes.IndexOf(sgDType);
If inIndex = -1 Then Exit;
Result := lstCTypes[inIndex];
Finally
lstDTypes.Free;
lstCTypes.Free;
End;
//TimeTest_ads.Stop;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
Function TadsRBuilderWebServer.RBuilderDeviceTypeToContentType(DeviceType: String): String;
Var
lstDTypes : TStringList;
lstCTypes : TStringList;
sgDType : String;
inIndex : Integer;
Begin
Result := 'text/html';
ProcName := 'RBuilderDeviceTypeToContentType'; Try
lstDTypes := TStringList.Create();
lstCTypes := TStringList.Create();
Try
lstDTypes.Add('EXCELFILE'); lstCTypes.Add('application/x-msexcel');
lstDTypes.Add('GRAPHICFILE'); lstCTypes.Add('image/jpeg');
lstDTypes.Add('GRAPHICFILE_BMP'); lstCTypes.Add('image/x-ms-bmp');
lstDTypes.Add('GRAPHICFILE_JPEG'); lstCTypes.Add('image/jpeg');
lstDTypes.Add('GRAPHICFILE_JPG'); lstCTypes.Add('image/jpeg');
lstDTypes.Add('GRAPHICFILE_TIF'); lstCTypes.Add('image/tiff');
lstDTypes.Add('HTML_ADSFILE'); lstCTypes.Add('text/html');
lstDTypes.Add('HTMLDIVFILE'); lstCTypes.Add('text/html');
lstDTypes.Add('HTMLFILE'); lstCTypes.Add('text/html');
lstDTypes.Add('HTMLLAYERFILE'); lstCTypes.Add('text/html');
lstDTypes.Add('LOTUSFILE'); lstCTypes.Add('application/x-wingz');
lstDTypes.Add('PDFFILE'); lstCTypes.Add('application/pdf');
lstDTypes.Add('QUATTROFILE'); lstCTypes.Add('text/plain');
lstDTypes.Add('REPORTTEXTFILE'); lstCTypes.Add('text/plain');
lstDTypes.Add('RTFFILE'); lstCTypes.Add('application/msword');
lstDTypes.Add('TEXTFILEARCHIVEFILE'); lstCTypes.Add('text/plain');
sgDType := UpperCase(DeviceType);
inIndex := lstDTypes.IndexOf(sgDType);
If inIndex = -1 Then Exit;
Result := lstCTypes[inIndex];
Finally
lstDTypes.Free;
lstCTypes.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
Function TadsRBuilderWebServer.MakeRBuilderDeviceTypeHtmlCombo: String;
Var
HideList : TStringList;
DisplayList : TStringList;
begin
ProcName := 'MakeRBuilderDeviceTypeHtmlCombo';
ProcName := Self.ClassName+'.'+ProcName; Try
//TimeTest_ads.Start(ProcName);
HideList := TStringList.Create();
DisplayList := TStringList.Create();
Try
HideList .Clear;
DisplayList.Clear;
HideList.Add('ExcelFile'); DisplayList.Add('Excel Spreadsheet');
HideList.Add('GraphicFile'); DisplayList.Add('Tif Image');
HideList.Add('HTMLFILE'); DisplayList.Add('WebPage');
HideList.Add('HTMLDIVFILE'); DisplayList.Add('WebPage with DIV');
HideList.Add('HTMLLayerFile'); DisplayList.Add('Html Layer File');
HideList.Add('LotusFile'); DisplayList.Add('Lotus Spreadsheet');
HideList.Add('PDFFile'); DisplayList.Add('Adobe PDF document');
HideList.Add('QuattroFile'); DisplayList.Add('Quattro Spreadsheet');
HideList.Add('ReportTextFile'); DisplayList.Add('Report Text File');
HideList.Add('RTFFile'); DisplayList.Add('RTF File');
Result :=
MakeHtmlCombo(
'DeviceType', //ID : String;
HideList , //HideList : TStringList;
DisplayList );//DisplayList : TStringList): String;
Finally
HideList .Free;
DisplayList.Free;
End;
//TimeTest_ads.Stop;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
//Unit Description UnitIndex Master Index
procedure TadsRBuilderWebServer.MakeHTMLPage(OutFile: String);
Var
Path : String;
FileName : String;
inPos : Integer;
Files : TStringList;
page : TStringList;
pages : TStringList;
inCounter: Integer;
Contents : TStringList;
Head : TStringList;
sgBody : String;
sgNav : String;
sgPage : String;
FilesMax : Integer;
SvrName : String;
sgHead : String;
begin
ProcName := 'MakeHTMLPage';
ProcName := Self.ClassName+'.'+ProcName; Try
//TimeTest_ads.Start(ProcName);
Path := ExtractFileDir(OutFile);
If Path = '' Then Path := ExtractFileDir(ParamStr(0));
If (Copy(Path,Length(Path),1) <> '\') And (Path <> '') Then
Path := Path + '\';
FileName := ExtractFileName(OutFile);
inPos := Pos('.',FileName);
If inPos <> 0 Then FileName := Copy(FileName,1,inPos-1);
Files := TStringList.Create();
page := TStringList.Create();
pages := TStringList.Create();
Contents := TStringList.Create();
Head := TStringList.Create();
Try
Files .Clear;
page .Clear;
pages .Clear;
Contents.Clear;
Head .Clear;
If FileExists(Path+FileName+'.htm') Then DeleteFile(Path+FileName+'.htm');
FilesInDirDetail(
Files, //FileList : TStrings;
Path, //Directory : String;
FileName+'*.htm', //Mask : String;
False, //Intersection: Boolean;
False, //IsReadOnly : Boolean;
False, //IsHidden : Boolean;
False, //IsSystem : Boolean;
False, //IsVolumeID : Boolean;
False, //IsDirectory : Boolean;
False, //IsArchive : Boolean;
True, //IsNormal : Boolean;
False); //InclDotFiles: Boolean): Boolean;
If Files.Count = 0 Then
Begin
Files.Add('Empty');
Files.SaveToFile(Path+FileName+'.htm');
Exit;
End;
sgBody := '';
FilesMax := Files.Count;
sgHead := 'Unknown ';
For inCounter := 0 To FilesMax - 1 Do
Begin
page .Clear;
Contents.Clear;
sgPage := Files[inCounter];
page.LoadFromFile(Path+sgPage);
If inCounter=0 Then sgHead := MakeHTMLPageGetHead(Page.Text);
MakeHTMLPageGetOneBody(Page);
sgNav := MakeHTMLPageNav(inCounter+1,FilesMax);
sgBody := sgBody + sgNav + page.Text;
If FileExists(Path+sgPage) Then DeleteFile(Path+sgPage);
End;
SvrName := ExtractFileName(ParamStr(0));
//SvrName := Copy(SvrName,1,Length(SvrName)-4);
SvrName := Proper(SvrName);
sgBody :=
StringReplace(sgBody,
';
sgBody :=
StringReplace(sgBody,
'<img src=',
'<img src='+'../reports/rpt/',
[rfReplaceall,rfIgnoreCase]);
sgBody :=
StringReplace(sgBody,
'sjgkjusrg',
'<img src=)
'+#13+sgBody+''+#13+'';
Pages.SetText(PChar(sgBody));
Pages.SaveToFile(Path+FileName+'.htm');
Finally
Files .Free;
page .Free;
pages .Free;
Contents.Free;
Head .Free;
End;
//TimeTest_ads.Stop;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
//Unit Description UnitIndex Master Index
Function PopulateRequest(Request: TWebRequest): String;
Var
lst : TStringList;
sgTemp : String;
sgTemp2 : String;
inCounter : Integer;
begin
Result := '';
ProcName := 'PopulateRequest'; Try
//TimeTest_ads.Start(ProcName);
lst := TStringList.Create();
Try
sgTemp := '';
sgTemp2 := '';
lst.Clear;
//Request.Accept
sgTemp := sgTemp+'Request.Accept='+Request.Accept+#13;
//Request.Authorization
sgTemp := sgTemp+'Request.Authorization='+Request.Authorization+#13;
//Request.CacheControl
sgTemp := sgTemp+'Request.CacheControl='+Request.CacheControl+#13;
//Request.Connection
sgTemp := sgTemp+'Request.Connection='+Request.Connection+#13;
//Request.Content
lst.Clear;
lst.SetText(PChar(Request.content));
For inCounter := 0 To lst.Count - 1 Do
Begin
lst[inCounter] := 'Request.Content['+IntToStr(inCounter)+']="'+lst[inCounter]+'"';
End;
lst.Add('Request.Content.Count='+IntToStr(lst.Count));
sgTemp := sgTemp+lst.Text;
lst.Clear;
lst.SetText(PChar(Request.content));
For inCounter := 0 To lst.Count - 1 Do
Begin
lst[inCounter] := 'Request.Content.Item.'+lst[inCounter];
End;
sgTemp := sgTemp+lst.Text;
//Request.ContentEncoding
sgTemp := sgTemp+'Request.ContentEncoding='+Request.ContentEncoding+#13;
//Request.ContentFields
lst.Clear;
Request.ExtractContentFields(lst);
sgTemp2 := lst.Text;
For inCounter := 0 To lst.Count - 1 Do
Begin
lst[inCounter] := 'Request.ContentFields['+IntToStr(inCounter)+']="'+lst[inCounter]+'"';
End;
lst.Add('Request.ContentFields.Count='+IntToStr(lst.Count));
sgTemp := sgTemp+lst.Text;
lst.Clear;
lst.SetText(Pchar(sgTemp2));
For inCounter := 0 To lst.Count - 1 Do
Begin
lst[inCounter] := 'Request.ContentFields.Item.'+lst[inCounter];
End;
sgTemp := sgTemp+lst.Text;
//Request.ContentLength
sgTemp := sgTemp+'Request.ContentLength='+IntToStr(Request.ContentLength)+#13;
//Request.ContentType
sgTemp := sgTemp+'Request.ContentType='+Request.ContentType+#13;
//Request.ContentVersion
sgTemp := sgTemp+'Request.ContentVersion='+Request.ContentVersion+#13;
//Request.Cookie
lst.Clear;
Request.ExtractCookieFields(lst);
sgTemp2 := lst.Text;
For inCounter := 0 To lst.Count - 1 Do
Begin
lst[inCounter] := 'Request.Cookie['+IntToStr(inCounter)+']="'+lst[inCounter]+'"';
End;
lst.Add('Request.Cookie.Count='+IntToStr(lst.Count));
sgTemp := sgTemp+lst.Text;
lst.Clear;
lst.SetText(PChar(sgTemp2));
For inCounter := 0 To lst.Count - 1 Do
Begin
lst[inCounter] := 'Request.Cookie.Item.'+lst[inCounter];
End;
sgTemp := sgTemp+lst.Text;
//Request.CookieFields
lst.Clear;
Request.ExtractCookieFields(lst);
sgTemp2 := lst.Text;
For inCounter := 0 To lst.Count - 1 Do
Begin
lst[inCounter] := 'Request.CookieFields['+IntToStr(inCounter)+']="'+lst[inCounter]+'"';
End;
lst.Add('Request.CookieFields.Count='+IntToStr(lst.Count));
sgTemp := sgTemp+lst.Text;
lst.Clear;
lst.SetText(PChar(sgTemp2));
For inCounter := 0 To lst.Count - 1 Do
Begin
lst[inCounter] := 'Request.CookieFields.Item.'+lst[inCounter];
End;
sgTemp := sgTemp+lst.Text;
//Request.Date
sgTemp := sgTemp+'Request.Date='+FormatDateTime('mm/dd/yyyy hh:nn:ss',Request.Date)+#13;
//Request.DerivedFrom
sgTemp := sgTemp+'Request.DerivedFrom='+Request.DerivedFrom+#13;
//Request.Expires
sgTemp := sgTemp+'Request.Expires='+FormatDateTime('mm/dd/yyyy hh:nn:ss',Request.Expires)+#13;
//Request.From
sgTemp := sgTemp+'Request.From='+Request.From+#13;
//Request.Host
sgTemp := sgTemp+'Request.Host='+Request.Host+#13;
//Request.IfModifiedSince
sgTemp := sgTemp+'Request.IfModifiedSince='+FormatDateTime('mm/dd/yyyy hh:nn:ss',Request.IfModifiedSince)+#13;
//Request.Method
sgTemp := sgTemp+'Request.Method='+Request.Method+#13;
//Request.MethodType
sgTemp := sgTemp+'Request.MethodType='+'?'+#13;
//Request.PathInfo
sgTemp := sgTemp+'Request.PathInfo='+Request.PathInfo+#13;
//Request.PathTranslated
sgTemp := sgTemp+'Request.PathTranslated='+Request.PathTranslated+#13;
//Request.ProtocolVersion
sgTemp := sgTemp+'Request.ProtocolVersion='+Request.ProtocolVersion+#13;
//Request.Query
lst.Clear;
Request.ExtractQueryFields(lst);
sgTemp2 := lst.Text;
For inCounter := 0 To lst.Count - 1 Do
Begin
lst[inCounter] := 'Request.Query['+IntToStr(inCounter)+']="'+lst[inCounter]+'"';
End;
lst.Add('Request.Query.Count='+IntToStr(lst.Count));
sgTemp := sgTemp+lst.Text;
lst.Clear;
lst.SetText(PChar(sgTemp2));
For inCounter := 0 To lst.Count - 1 Do
Begin
lst[inCounter] := 'Request.Query.Item.'+lst[inCounter];
End;
sgTemp := sgTemp+lst.Text;
//Request.QueryFields
lst.Clear;
Request.ExtractQueryFields(lst);
sgTemp2 := lst.Text;
For inCounter := 0 To lst.Count - 1 Do
Begin
lst[inCounter] := 'Request.QueryFields['+IntToStr(inCounter)+']="'+lst[inCounter]+'"';
End;
lst.Add('Request.QueryFields.Count='+IntToStr(lst.Count));
sgTemp := sgTemp+lst.Text;
lst.Clear;
lst.SetText(PChar(sgTemp2));
For inCounter := 0 To lst.Count - 1 Do
Begin
lst[inCounter] := 'Request.QueryFields.Item.'+lst[inCounter];
End;
sgTemp := sgTemp+lst.Text;
//Request.Referer
sgTemp := sgTemp+'Request.Referer='+Request.Referer+#13;
//Request.RemoteAddr
sgTemp := sgTemp+'Request.RemoteAddr='+Request.RemoteAddr+#13;
//Request.RemoteHost
sgTemp := sgTemp+'Request.RemoteHost='+Request.RemoteHost+#13;
//Request.ScriptName
sgTemp := sgTemp+'Request.ScriptName='+Request.ScriptName+#13;
//Request.ServerPort
sgTemp := sgTemp+'Request.ServerPort='+IntToStr(Request.ServerPort)+#13;
//Request.Title
sgTemp := sgTemp+'Request.Title='+Request.Title+#13;
//Request.URL
sgTemp := sgTemp+'Request.URL='+Request.URL+#13;
//Request.UserAgent
sgTemp := sgTemp+'Request.UserAgent='+Request.UserAgent+#13;
Result := sgTemp;
Finally
lst.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
destructor TadsRBuilderWebServer.Destroy;
begin
ProcName := 'Destroy';
ProcName := Self.ClassName+'.'+ProcName; Try
RequestValues.Free;
inherited;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
//Unit Description UnitIndex Master Indexprocedure TadsRBuilderWebServer.RequestSaveToFile(FileName: String); begin ProcName := 'RequestSaveToFile'; ProcName := Self.ClassName+'.'+ProcName; Try RequestValues.SaveToFile(FileName); Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
Procedure WebImageRequest(
Request: TWebRequest;var Response : TWebResponse);
Var
sgSrc : String;
sgExt : String;
lst : TStringList;
Content_Type : String;
begin
ProcName := 'WebImageRequest'; Try
//TimeTest_ads.Start(ProcName);
lst := TStringList.Create();
Try
Content_Type := '';
Response.ContentType := '';
Response.Content := '';
lst.SetText(PChar(PopulateRequest(Request)));
If UpperCase(lst.Values['Request.Method'])='GET' Then
Begin
sgSrc := lst.Values['Request.QueryFields.Item.src'];
End
Else
Begin
sgSrc := lst.Values['Request.ContentFields.Item.src'];
End;
If sgSrc = '' Then Exit;
sgSrc := StringReplace(sgSrc,'"','',[rfReplaceall]);
sgSrc := ExtractFileName(sgSrc);
If Not FileExists(sgSrc) Then Exit;
Content_Type := '';
sgExt := ExtractFileExt(sgSrc);
sgExt := UpperCase(sgExt);
If sgExt = '.JPG' Then Content_Type := 'image/jpeg';
If sgExt = '.JPEG' Then Content_Type := 'image/jpeg';
If sgExt = '.JPE' Then Content_Type := 'image/jpeg';
If sgExt = '.GIF' Then Content_Type := 'image/gif';
If sgExt = '.XBM' Then Content_Type := 'image/x-xbitmap';
If sgExt = '.XPM' Then Content_Type := 'image/x-xpixmap';
If sgExt = '.PNG' Then Content_Type := 'image/x-png';
If sgExt = '.IEF' Then Content_Type := 'image/ief';
If sgExt = '.TIF' Then Content_Type := 'image/tiff';
If sgExt = '.TIFF' Then Content_Type := 'image/tiff';
If sgExt = '.RGB' Then Content_Type := 'image/rgb';
Response.ContentType := Content_Type;
Response.Content := FileToStr(sgSrc);
Finally
lst.Free;
//TimeTest_ads.Stop;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
//Unit Description UnitIndex Master Index
procedure TadsRBuilderWebServer.MakeHTMLPageGetOneBody(var Page : TStringList);
Var
BeforeString : String; //The substring prior to the match
MatchWithTags : String; //The match string including tags
MatchWithoutTags : String; //the match string without the tags
AfterString : String; //The substring after the match with tags
inPos : Integer;
boSuccess : Boolean;
sgInput : String;
begin
ProcName := 'MakeHTMLPageGetOneBody';
ProcName := Self.ClassName+'.'+ProcName; Try
//TimeTest_ads.Start(ProcName);
sgInput := Page.Text;
boSuccess :=
String_Grep_Detail(
sgInput , //Source : String; //The input string
'Unit Description UnitIndex Master Index
Function TadsRBuilderWebServer.MakeHTMLPageNav(PageNum,PageMax : Integer): String;
Var
sgNav : String;
sgPageNumUp : String;
sgPageNumDn : String;
sgPageNum : String;
sgPageMax : String;
begin
Result := '';
ProcName := 'MakeHTMLPageNav';
ProcName := Self.ClassName+'.'+ProcName; Try
//TimeTest_ads.Start(ProcName);
sgPageNumUp := IntToStr(PageNum+1);
sgPageNumDn := IntToStr(PageNum-1);
sgPageNum := IntToStr(PageNum);
sgPageMax := IntToStr(PageMax);
If PageNum = 1 Then
Begin
If PageMax > 1 Then
Begin
sgNav :=
''+#13+
''+#13+
''+#13+
' Unit Description UnitIndex Master Index
Function TadsRBuilderWebServer.MakeHTMLPageGetHead(Page : String): String;
Var
BeforeString : String; //The substring prior to the match
MatchWithTags : String; //The match string including tags
MatchWithoutTags : String; //the match string without the tags
AfterString : String; //The substring after the match with tags
boSuccess : Boolean;
begin
Result := 'Unknown ';
ProcName := 'MakeHTMLPageGetHead';
ProcName := Self.ClassName+'.'+ProcName; Try
//TimeTest_ads.Start(ProcName);
boSuccess :=
String_Grep_Detail(
Page , //Source : String; //The input string
'' , //EndTag : String; //The end tag
'' , //Containing : String; //A match must contain this string
BeforeString , //Var BeforeString : String; //The substring prior to the match
MatchWithTags , //Var MatchWithTags : String; //The match string including tags
MatchWithoutTags, //Var MatchWithoutTags : String; //the match string without the tags
AfterString , //Var AfterString : String; //The substring after the match with tags
False , //CaseSensitiveTags : Boolean; //True if tags are casesensitive
False //CaseSensitiveContaining : Boolean //True if Containing string is casesensitive
);//): Boolean; //True if a match was found
If boSuccess Then Result := MatchWithTags;
//TimeTest_ads.Stop;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
end.
//