home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Demos / Midas / InternetExpress / InetXCenter / inetxcenterprod.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  38KB  |  1,367 lines
  1. {
  2.   InternetExpress sample application component.
  3.  
  4.   TInetXCenterProducer is a custom TMidasPageProducer that implements
  5.   standard behavior for pages in the INetXCenter sample application.
  6.  
  7.   Creating a custom producer has benefits:
  8.  
  9.   1) Can create customized, common appearance for web pages.  Easy
  10.   to change appearance of all web pages.
  11.   2) Formatted page can be viewed at design time.
  12.   3) Can share code across applications.
  13.  
  14. }
  15. unit InetXCenterProd;
  16.  
  17. interface
  18.  
  19. uses  Classes, MidItems, MidProd, WebComp, HTTPApp, DB, SysUtils;
  20.  
  21. procedure Register;
  22.  
  23. type
  24.   TPageCategory = (catExample);
  25. const
  26.   PageExampleCategories = [catExample];
  27. type
  28.   IComponentsInfo = interface;
  29.   TPageCategories = set of TPageCategory;
  30.   TTopicPage = (topNone, topHome, topComponents, topExamples,
  31.     topComponentsFilter, topXML, topJavaScript, topAboutComponents);
  32.  
  33.   TPageLayout = (plStandard, plDescription);
  34.   TInetXCenterProducer = class(TCustomMidasPageProducer)
  35.   private
  36.     FPageCategories: TPageCategories;
  37.     FTopicPage: TTopicPage;
  38.     FPageLayout: TPageLayout;
  39.     FDescription: TStrings;
  40.     FDescriptionFile: TFileName;
  41.     FTitle: string;
  42.     FCaption: string;
  43.     FLinkName: string;
  44.     FComponentsInfoIntf: IComponentsInfo;
  45.     FComponentsInfo: TDataSet;
  46.     FClassNames: TStrings;
  47.     FInstructions: TStrings;
  48.     procedure SetDescription(const Value: TStrings);
  49.     procedure FindComponents;
  50.     function GetLinkName: string;
  51.     function GetCaption: string;
  52.     function GetTitle: string;
  53.     function GetTitleElement: string;
  54.     function GetComponentsInfo: IComponentsInfo;
  55.     procedure SetComponentsInfo(const Value: TDataSet);
  56.     procedure SetCaption(const Value: string);
  57.     procedure SetTitle(const Value: string);
  58.     procedure SetLinkName(const Value: string);
  59.     function GetSelectClassName: string;
  60.     function FormatGlobalLinks(Topics: array of TTopicPage): string;
  61.     function GetGlobalLinks: string;
  62.     procedure AddTopicLinks(ALinks: TStrings);
  63.     procedure GetExampleProducers(AList: TList);
  64.     function GetSelectExample: string;
  65.     function DefaultTitle: string;
  66.     procedure SetInstructions(const Value: TStrings);
  67.   protected
  68.     function GetDefaultTemplate: string; override;
  69.     procedure DoTagEvent(Tag: TTag; const TagString: string;
  70.       TagParams: TStrings; var ReplaceText: string); override;
  71.     function CreatePageElements: TMidasPageElements; override;
  72.   public
  73.     constructor Create(AOwner: TComponent); override;
  74.     destructor Destroy; override;
  75.     function GetHREF: string;
  76.     function GetTopicName: string;
  77.     function GetBanner: string;
  78.     function GetDescription(ALinks: TStrings): string;
  79.     function GetUsesComponents(ALinks: TStrings): string;
  80.     procedure GetClassNames;
  81.     function GetComponentDetails(ALinks: TStrings): string;
  82.     function GetComponentSummary(ALinks: TStrings): string;
  83.     function GetComponentsList(ALinks: TStrings): string;
  84.     function GetExamplesList(ALinks: TStrings): string;
  85.     function GetExampleSummary(AProducers: TList; ALinks: TStrings): string;
  86.     function GetExampleDetails(AProducers: TList; ALinks: TStrings): string;
  87.     function GetDumpRequest: string;
  88.     function FindTopicPage(
  89.       ATopic: TTopicPage): TInetXCenterProducer;
  90.     function IsExample: Boolean;
  91.     property ClassNames: TStrings read FClassNames;
  92.     property ComponentsInfoIntf: IComponentsInfo read GetComponentsInfo;
  93.   published
  94.     property IncludePathURL;
  95.     property OnBeforeGetXMLData;
  96.     property OnAfterGetXMLData;
  97.     property OnBeforeGetContent;
  98.     property OnAfterGetContent;
  99.     property Styles;
  100.     property StylesFile;
  101.     property WebPageItems;
  102.     property EnableXMLIslands;
  103.     property LinkName: string read GetLinkName write SetLinkName;
  104.     property HREF: string read GetHREF;
  105.     property TopicPage: TTopicPage read FTopicPage write FTopicPage;
  106.     property PageCategories: TPageCategories read FPageCategories write FPageCategories;
  107.     property Description: TStrings read FDescription write SetDescription;
  108.     property Title: string read GetTitle write SetTitle;
  109.     property Caption: string read GetCaption write SetCaption;
  110.     property ComponentsInfo: TDataSet read FComponentsInfo write SetComponentsInfo;
  111.     property DescriptionFile: TFileName read FDescriptionFile write FDescriptionFile;
  112.     property PageLayout: TPageLayout read FPageLayout write FPageLayout;
  113.     property Instructions: TStrings read FInstructions write SetInstructions;
  114.   end;
  115.  
  116.   IComponentsInfo = interface
  117.   ['{D9792F5D-34BD-11D3-B016-00C04FB16EC3}']
  118.     procedure Reset;
  119.     function Next: Boolean;
  120.     function ClassName: string;
  121.     function ShortDescription: string;
  122.     function Description: string;
  123.     function Eof: Boolean;
  124.     function Usage: string;
  125.     function Package: string;
  126.     function GetType: string;
  127.     function Example: string;
  128.     procedure SetFilter(PackageFilter, UsageFilter, TypeFilter: string);
  129.     procedure ClearFilter;
  130.     function FieldByName(FieldName: string): TField;
  131.     procedure LocateClassName(AClassName: string);
  132.     function GetFilter: string;
  133.   end;
  134.  
  135.   TComponentsInfo = class(TInterfacedObject, IComponentsInfo)
  136.   private
  137.     FDataSet: TDataSet;
  138.     FReset: Boolean;
  139.   protected
  140.     procedure Reset;
  141.     function Next: Boolean;
  142.     function ClassName: string;
  143.     function Description: string;
  144.     function ShortDescription: string;
  145.     function Usage: string;
  146.     function Eof: Boolean;
  147.     function Package: string;
  148.     function GetType: string;
  149.     function Example: string;
  150.     procedure SetFilter(PackageFilter, UsageFilter, TypeFilter: string);
  151.     function FieldByName(FieldName: string): TField;
  152.     procedure LocateClassName(AClassName: string);
  153.     procedure ClearFilter;
  154.     function GetFilter: string;
  155.   public
  156.     constructor Create(ADataSet: TDataSet);
  157.   end;
  158.  
  159. implementation
  160.  
  161. uses Windows, dbclient;
  162.  
  163. const
  164.   sBannerFile = 'inetxbanner.jpg';
  165.   BannerWidth = 436;
  166.   BannerHeight = 73;
  167.  
  168. resourcestring
  169.  
  170.   sTitle = 'InternetExpress %s';
  171.   sTitleExample = 'InternetExpress %s Example';
  172.   sBanner = 'InternetExpress Center';
  173.  
  174.   sComponentTable =
  175.   '<table width="100%%">'#13#10 +
  176.   '<tr>'#13#10 +
  177.     '<th align="left"><b><A Name=%0:s>%0:s<A></b>'#13#10 +
  178.     '</th>'#13#10 +
  179.   '</tr>'#13#10 +
  180.   '<tr>'#13#10 +
  181.     '<td valign="top"><p style="margin-left: 20">%1:s</td>'#13#10 +
  182.   '</tr>'#13#10 +
  183.   '%2:s'#13#10 +
  184.   '%3:s'#13#10 +
  185. '</table>';
  186.  
  187. sPrimaryExampleTitle = 'Primary Example:';
  188. sOtherExamplesTitle = 'Other Examples:';
  189. sExamplesTitle = 'Examples:';
  190. sComponentExamples =
  191.   '<tr>'#13#10 +
  192.     '<td><p style="margin-left: 20">%0:s</td>'#13#10 +
  193.     '<td valign="top"></td>'#13#10 +
  194.   '</tr>'#13#10 +
  195.   '<tr>'#13#10 +
  196.     '<td><p style="margin-left: 40">%1:s'#13#10 +
  197.      '</td>'#13#10 +
  198.   '</tr>';
  199.  
  200.   sExampleTable =
  201.   '<table width="100%%">'#13#10 +
  202.   '<tr>'#13#10 +
  203.     '<th align="left"><b><A HREF=%1:s Name=%0:s>%0:s</A>'#13#10 +
  204.     '</th>'#13#10 +
  205.   '</tr>'#13#10 +
  206.   '<tr>'#13#10 +
  207.     '<td valign="top"><p style="margin-left: 20">%2:s</td>'#13#10 +
  208.   '</tr>'#13#10 +
  209.   '<tr>'#13#10 +
  210.     '<td><p style="margin-left: 20">Components used by this example:</td>'#13#10 +
  211.     '<td valign="top"></td>'#13#10 +
  212.   '</tr>'#13#10 +
  213.   '<tr>'#13#10 +
  214.     '<td><p style="margin-left: 40">%3:s'#13#10 +
  215.      '</td>'#13#10 +
  216.   '</tr>'#13#10 +
  217. '</table>';
  218.  
  219.   sUsesComponentsAnchorTitle = 'Page Components';
  220.   sUsesComponentsAnchor = 'UsesComponents';
  221.   sUsesComponents =
  222.   '<hr><table width="100%%">'#13#10 +
  223.   '<tr>'#13#10 +
  224.     '<td><p style="margin-left: 0"><b><A Name=%1:s>%0:s</A></b><br>The following components were used to generate this page:</td>'#13#10 +
  225.     '<td valign="top"></td>'#13#10 +
  226.   '</tr>'#13#10 +
  227.   '<tr>'#13#10 +
  228.     '<td><p style="margin-left: 20">%2:s'#13#10 +
  229.      '</td>'#13#10 +
  230.   '</tr>'#13#10 +
  231. '</table>';
  232.  
  233.   sDescriptionAnchor = 'Description';
  234.   sDescriptionAnchorTitle = 'Page Description';
  235.   sDescription =
  236.   '<hr><table width="100%%">'#13#10 +
  237.   '<tr>'#13#10 +
  238.     '<td><p style="margin-left: 0"><b><A Name=%0:s>Page Description:</A></b></td>'#13#10 +
  239.     '<td valign="top"></td>'#13#10 +
  240.   '</tr>'#13#10 +
  241.   '<tr>'#13#10 +
  242.     '<td><p style="margin-left: 20">%1:s'#13#10 +
  243.      '</td>'#13#10 +
  244.   '</tr>'#13#10 +
  245. '</table>';
  246.  
  247.  
  248. type
  249.  
  250.   TCustomPageElements = class(TMidasPageElements)
  251.   protected
  252.     Banner: string;
  253.     LocalLinks: TStrings;
  254.     List: string;
  255.     Description: string;
  256.     UsesComponents: string;
  257.     GlobalLinks: string;
  258.     Caption: string;
  259.     Instructions: string;
  260.     function FormatLocalLinks: string;
  261.   public
  262.     function BodyContent: string; override;
  263.     constructor Create;
  264.     destructor Destroy; override;
  265.   end;
  266.  
  267.   TDescriptionPageElements = class(TCustomPageElements)
  268.   protected
  269.     function BodyContent: string; override;
  270.   end;
  271.  
  272. const
  273.  
  274.   sBannerTag = 'BANNER';
  275.   sTitleTag = 'TITLE';
  276.   sLinksTag = 'LINKS';
  277.   sDescriptionTag = 'DESCRIPTION';
  278.   sUsesComponentsTag = 'USESCOMPONENTS';
  279.   sComponentsListTag = 'COMPONENTSLIST';
  280.   sExamplesListTag = 'EXAMPLESLIST';
  281.   sDumpRequestTag = 'DUMPREQUEST';
  282.   sComponentDetailsTag = 'COMPONENTDETAILS';
  283.  
  284.  
  285.  
  286. function ModulePath: string;
  287. var
  288.   ModuleName: array[0..255] of Char;
  289. begin
  290.   GetModuleFileName(hinstance, ModuleName, sizeof(ModuleName));
  291.   Result := ExtractFilePath(ModuleName);
  292. end;
  293.  
  294. function QualifyFileName(var AFileName: string): Boolean;
  295. begin
  296.   if (AFileName <> '') and (ExtractFilePath(AFileName) = '') then
  297.   begin
  298.     Result := True;
  299.     AFileName := ModulePath + AFileName;
  300.   end
  301.   else
  302.     Result := False;
  303. end;
  304.  
  305. procedure Register;
  306. begin
  307.   RegisterComponents('InternetExpress', [  { do not localize }
  308.     TInetXCenterProducer
  309.   ]);
  310.   RegisterNonActiveX([TInetXCenterProducer], axrIncludeDescendants);
  311. end;
  312.  
  313. { TInetXCenterProducer }
  314.  
  315. function TInetXCenterProducer.GetDefaultTemplate: string;
  316. begin
  317.   Result :=
  318.     '<HTML>'#13#10 +
  319.     '<HEAD>'#13#10 +
  320.     '<#TITLE>'#13#10 +
  321.     '</HEAD>'#13#10 +
  322.     '<BODY>'#13#10 +
  323.     '<#BODYELEMENTS>'#13#10 +
  324.     '</BODY>'#13#10 +
  325.     '</HTML>'#13#10;
  326.  
  327. end;
  328.  
  329. procedure TInetXCenterProducer.DoTagEvent(Tag: TTag; const TagString: string;
  330.   TagParams: TStrings; var ReplaceText: string);
  331. begin
  332.   if (Tag = tgCustom) and (CompareText(TagString, sBannerTag) = 0) then
  333.   begin
  334.     ReplaceText := TCustomPageElements(PageElements).Banner;
  335.     Exit;
  336.   end
  337.   else if (Tag = tgCustom) and (CompareText(TagString, sTitleTag) = 0) then
  338.   begin
  339.     ReplaceText := GetTitleElement;
  340.     Exit;
  341.   end
  342.   else if (Tag = tgCustom) and (CompareText(TagString, sLinksTag) = 0) then
  343.   begin
  344.     ReplaceText := TCustomPageElements(PageElements).FormatLocalLinks;
  345.     Exit;
  346.   end
  347.   else if (Tag = tgCustom) and (CompareText(TagString, sDescriptionTag) = 0) then
  348.   begin
  349.     ReplaceText := TCustomPageElements(PageElements).Description;
  350.     Exit;
  351.   end
  352.   else if (Tag = tgCustom) and (CompareText(TagString, sComponentsListTag) = 0) then
  353.   begin
  354.     ReplaceText := TCustomPageElements(PageElements).List;
  355.     Exit;
  356.   end
  357.   else if (Tag = tgCustom) and (CompareText(TagString, sExamplesListTag) = 0) then
  358.   begin
  359.     ReplaceText := TCustomPageElements(PageElements).List;
  360.     Exit;
  361.   end
  362.   else if (Tag = tgCustom) and (CompareText(TagString, sDumpRequestTag) = 0) then
  363.   begin
  364.     ReplaceText := GetDumpRequest;
  365.     Exit;
  366.   end
  367.   else if (Tag = tgCustom) and (CompareText(TagString, sUsesComponentsTag) = 0) then
  368.   begin
  369.     ReplaceText := TCustomPageElements(PageElements).UsesComponents;
  370.     Exit;
  371.   end;
  372.   inherited DoTagEvent(Tag, TagString, TagParams, ReplaceText);
  373. end;
  374.  
  375.  
  376. function TInetXCenterProducer.GetBanner: string;
  377. var
  378.   Path: string;
  379. begin
  380.   Path := '';
  381.   //Result := Format(sBanner, [Caption]);
  382.   if Assigned(Dispatcher) and Assigned(Dispatcher.Request) then
  383.     if Dispatcher.Request.PathInfo <> '' then
  384.       Path := PathInfoToRelativePath(Dispatcher.Request.PathInfo);
  385.  
  386.   Result := Format('<P><IMG SRC="%0:s%1:s" ALT="%2:s" WIDTH="%3:d" HEIGHT="%4:d"></P>',
  387.     [Path, sBannerFile, sBanner,
  388.      BannerWidth, BannerHeight]);
  389.  
  390. end;
  391.  
  392. function TInetXCenterProducer.FormatGlobalLinks(Topics: array of TTopicPage): string;
  393.   procedure Add(var Result: string; const Value: string);
  394.   begin
  395.     if Result <> '' then
  396.       Result := Result + '</BR>';
  397.     Result := Result + Value;
  398.   end;
  399.  
  400. var
  401.   I: Integer;
  402.   Producer: TInetXCenterProducer;
  403. begin
  404.   Result := '';
  405.   for I := Low(Topics) to High(Topics) do
  406.   begin
  407.     Producer := FindTopicPage(Topics[I]);
  408.     if Assigned(Producer) then
  409.     begin
  410.       Add(Result, Format('<A HREF="%0:s">%1:s</A>'#13#10,
  411.           [Producer.HRef, Producer.LinkName]));
  412.     end;
  413.   end;
  414.   Result := Format('%s', [Result]);
  415. end;
  416.  
  417. function TInetXCenterProducer.GetGlobalLinks: string;
  418. begin
  419.   Result := FormatGlobalLinks([topHome, topComponents, topExamples,
  420.     topJavaScript, topXML, topAboutComponents]);
  421. end;
  422.  
  423. function TInetXCenterProducer.GetTopicName: string;
  424. begin
  425.   Result := 'Topic ' + Name;
  426. end;
  427.  
  428. function TInetXCenterProducer.GetHREF: string;
  429. begin
  430.   if Assigned(Dispatcher) and Assigned(Dispatcher.Request) then
  431.   begin
  432.     // Assume name is path
  433.     Result := Format('%0:s/%1:s',
  434.       [Dispatcher.Request.ScriptName, Name]);
  435.   end
  436.   else
  437.     Result := '';
  438. end;
  439.  
  440. constructor TInetXCenterProducer.Create(AOwner: TComponent);
  441. begin
  442.   inherited;
  443.   FDescription := TStringList.Create;
  444.   FInstructions := TStringList.Create;
  445.   FClassNames := TStringList.Create;
  446. end;
  447.  
  448. destructor TInetXCenterProducer.Destroy;
  449. begin
  450.   inherited;
  451.   FDescription.Free;
  452.   FInstructions.Free;
  453.   FClassNames.Free;
  454. end;
  455.  
  456. procedure TInetXCenterProducer.SetDescription(
  457.   const Value: TStrings);
  458. begin
  459.   FDescription.Assign(Value);
  460. end;
  461.  
  462. resourcestring
  463.   sFileError = 'Could not access file %s';
  464.  
  465. function TInetXCenterProducer.GetDescription(ALinks: TStrings): string;
  466. var
  467.   S: string;
  468.   FileStream: TFileStream;
  469.   FileName: string;
  470. begin
  471.   if DescriptionFile <> '' then
  472.   begin
  473.     FileName := DescriptionFile;
  474.     if not (csDesigning in ComponentState) then
  475.        QualifyFileName(FileName);
  476.     try
  477.       FileStream := TFileStream.Create(FileName, fmOpenRead + fmShareDenyWrite);
  478.       try
  479.         with TStringStream.Create('') do
  480.           try
  481.             CopyFrom(FileStream, 0);
  482.             S := DataString;
  483.           finally
  484.             Free;
  485.           end;
  486.       finally
  487.         FileStream.Free;
  488.       end
  489.     except
  490.       S := Format(sFileError, [FileName]);
  491.     end;
  492.   end
  493.   else
  494.     S := Description.Text;
  495.  
  496.   case PageLayout of
  497.     plStandard:
  498.       if Length(S) > 0 then
  499.       begin
  500.         ALinks.Add(Format('%s=%s', [sDescriptionAnchorTitle, sDescriptionAnchor]));
  501.         Result := Format(sDescription,
  502.          [sDescriptionAnchor, S])
  503.       end
  504.       else
  505.         Result := '';
  506.   else
  507.     Result := S;
  508.   end;
  509. end;
  510.  
  511. function ComponentLink(ComponentListProducer: TInetXCenterProducer;
  512.   AClassName: string): string;
  513. var
  514.   HRef: string;
  515. begin
  516.   if Assigned(ComponentListProducer) then
  517.     HRef := ComponentListProducer.HRef;
  518.   Result := Format('<A HREF="%0:s?ClassName=%1:s">%1:s</A>'#13#10,
  519.     [HRef, AClassName]);
  520. end;
  521.  
  522. function TInetXCenterProducer.GetUsesComponents(ALinks: TStrings): string;
  523. var
  524.   ComponentsPage: TInetXCenterProducer;
  525.  
  526.   procedure AddComponent(var Result: string);
  527.   begin
  528.     if Result <> '' then Result := Result + ', ';
  529.     Result := Result + ComponentLink(ComponentsPage, ComponentsInfoIntf.ClassName);
  530.   end;
  531. var
  532.   Components: string;
  533. begin
  534.   Result := '';
  535.   if not Assigned(ComponentsInfoIntf) then Exit;
  536.   ComponentsPage := FindTopicPage(topComponents);
  537.   GetClassNames;
  538.   ComponentsInfoIntf.ClearFilter;
  539.   ComponentsInfoIntf.Reset;
  540.   while ComponentsInfoIntf.Next do
  541.   begin
  542.     if ClassNames.IndexOf(ComponentsInfoIntf.ClassName) <> -1 then
  543.       AddComponent(Components);
  544.   end;
  545.   if Components <> '' then
  546.   begin
  547.     ALinks.Add(Format('%s=%s', [sUsesComponentsAnchorTitle, sUsesComponentsAnchor]));
  548.     Result := Format(sUsesComponents, [sUsesComponentsAnchorTitle, sUsesComponentsAnchor, Components]);
  549.   end;
  550. end;
  551.  
  552. procedure TInetXCenterProducer.FindComponents;
  553.  
  554.   procedure AddComponent(AComponent: TComponent);
  555.   begin
  556.     if ClassNames.IndexOf(AComponent.ClassName) = -1 then
  557.       ClassNames.Add(AComponent.ClassName);
  558.   end;
  559.  
  560.   procedure TraverseSubComponents(AContainer: TComponent);
  561.   var
  562.     WebComponentContainer: IWebComponentContainer;
  563.     I: Integer;
  564.     ScriptComponent: IScriptComponent;
  565.     SubComponents: TObject;
  566.     Component: TComponent;
  567.   begin
  568.     if AContainer.GetInterface(IScriptComponent, ScriptComponent) then
  569.     begin
  570.       SubComponents := ScriptComponent.SubComponents;
  571.       if Assigned(SubComponents) and SubComponents.GetInterface(IWebComponentContainer, WebComponentContainer) then
  572.       begin
  573.         for I := 0 to WebComponentContainer.ComponentCount - 1 do
  574.         begin
  575.           Component := WebComponentContainer.Components[I];
  576.           AddComponent(Component);
  577.           if Component.GetInterface(IScriptComponent, ScriptComponent) then
  578.             TraverseSubComponents(Component);
  579.         end;
  580.       end;
  581.     end;
  582.   end;
  583. var
  584.   I: Integer;
  585. begin
  586.   //AddComponent(Self);
  587.   if (ClassNames.Count = 0) or
  588.     (csDesigning in ComponentState) then
  589.   begin
  590.     ClassNames.Clear;
  591.     for I := 0 to Self.WebPageItems.Count - 1 do
  592.     begin
  593.       AddComponent(WebPageItems.WebComponents[I]);
  594.       TraverseSubComponents(WebPageItems.WebComponents[I]);
  595.     end;
  596.   end;
  597. end;
  598.  
  599. procedure TInetXCenterProducer.GetClassNames;
  600. begin
  601.   FindComponents;
  602. end;
  603.  
  604. function TInetXCenterProducer.FindTopicPage(ATopic: TTopicPage): TInetXCenterProducer;
  605. var
  606.   I: Integer;
  607. begin
  608.   for I := 0 to Owner.ComponentCount - 1 do
  609.   begin
  610.     if (Owner.Components[I] is TInetXCenterProducer) then
  611.     begin
  612.       Result := TInetXCenterProducer(Owner.Components[I]);
  613.       if Result.TopicPage = ATopic then
  614.         Exit;
  615.     end;
  616.   end;
  617.   Result := nil;
  618. end;
  619.  
  620. function ExampleLink(ExampleListProducer, ExampleProducer: TInetXCenterProducer): string;
  621. begin
  622. (*  This code causes jump to example description
  623. var
  624.   HRef: string;
  625.   if Assigned(ExampleListProducer) then
  626.     HRef := ExampleListProducer.HRef;
  627.   Result := Format('<A HREF="%0:s?Example=%1:s">%1:s</A>'#13#10,
  628.     [HRef, ExampleProducer.LinkName]);
  629. *)
  630.   // Run example
  631.   Result := Format('<A HREF="%0:s">%1:s</A>'#13#10,
  632.     [ExampleProducer.HRef, ExampleProducer.LinkName]);
  633.  
  634.  
  635. end;
  636.  
  637. function TInetXCenterProducer.GetSelectClassName: string;
  638. begin
  639.   Result := '';
  640.   if Assigned(Dispatcher) and Assigned(Dispatcher.Request) then
  641.     with Dispatcher.Request do
  642.     begin
  643.       Result := QueryFields.Values['ClassName'];
  644.       if (Result <> '') and (Copy(Result, 1,1) <> 'T') then
  645.         Result := 'T' + Result;
  646.     end;
  647. end;
  648.  
  649. function TInetXCenterProducer.GetComponentDetails(ALinks: TStrings): string;
  650. var
  651.   SelectClassName: string;
  652.  
  653.   function AddComponent(PrimaryExample, OtherExamples: string): string;
  654.   begin
  655.     if PrimaryExample <> '' then
  656.       PrimaryExample := Format(sComponentExamples,
  657.         [sPrimaryExampleTitle, PrimaryExample]);
  658.     if OtherExamples <> '' then
  659.       if PrimaryExample <> '' then
  660.         OtherExamples := Format(sComponentExamples,
  661.           [sOtherExamplesTitle, OtherExamples])
  662.       else
  663.         OtherExamples := Format(sComponentExamples,
  664.           [sExamplesTitle, OtherExamples]);
  665.      Result := Format(sComponentTable,
  666.     [ComponentsInfoIntf.ClassName,
  667.      ComponentsInfoIntf.Description, PrimaryExample, OtherExamples]);
  668.   end;
  669.  
  670.   function IncludeComponent: Boolean;
  671.   begin
  672.     Result := (SelectClassName = '') or
  673.       (ComponentsInfoIntf.ClassName = SelectClassName);
  674.   end;
  675. var
  676.   Producer, ExamplesList: TInetXCenterProducer;
  677.   I: Integer;
  678.   PrimaryExample, OtherExamples: String;
  679.   Component: TComponent;
  680.   Producers: TList;
  681. begin
  682.   Result := '';
  683.   if not Assigned(ComponentsInfoIntf) then Exit;
  684.  
  685.   ExamplesList := FindTopicPage(topExamples);
  686.   Producers := TList.Create;
  687.   try
  688.     for I := 0 to Owner.ComponentCount - 1 do
  689.     begin
  690.       if (Owner.Components[I] is TInetXCenterProducer) then
  691.       begin
  692.         Producer := TInetXCenterProducer(Owner.Components[I]);
  693.         if Producer.IsExample then
  694.         begin
  695.           Producer.GetClassNames;
  696.           Producers.Add(Producer);
  697.         end;
  698.       end;
  699.     end;
  700.  
  701.     SelectClassName := GetSelectClassName;
  702.     ComponentsInfoIntf.Reset;
  703.     while ComponentsInfoIntf.Next do
  704.     begin
  705.       if SelectClassName <> '' then
  706.         ComponentsInfoIntf.LocateClassName(SelectClassName);
  707.       PrimaryExample := '';
  708.       if ComponentsInfoIntf.Example <> '' then
  709.       begin
  710.         Component := Owner.FindComponent(ComponentsInfoIntf.Example);
  711.         if Assigned(Component) and (Component is TInetXCenterProducer) then
  712.         begin
  713.           Producers.Remove(Component);
  714.           PrimaryExample := ExampleLink(ExamplesList, TInetXCenterProducer(Component));
  715.         end;
  716.       end;
  717.       OtherExamples := '';
  718.       for I := 0 to Producers.Count - 1 do
  719.       begin
  720.         Producer := TInetXCenterProducer(Producers[I]);
  721.         if Producer.ClassNames.IndexOf(ComponentsInfoIntf.ClassName) <> -1 then
  722.         begin
  723.           if OtherExamples <> '' then
  724.             OtherExamples := OtherExamples + ', ';
  725.           OtherExamples := OtherExamples + ExampleLink(ExamplesList, Producer);
  726.         end;
  727.       end;
  728.       Result := Result + AddComponent(PrimaryExample, OtherExamples);
  729.       if SelectClassName <> '' then
  730.         Break;
  731.     end;
  732.   finally
  733.     Producers.Free;
  734.   end;
  735. end;
  736.  
  737. function TInetXCenterProducer.GetExamplesList(ALinks: TStrings): string;
  738. var
  739.   List: TList;
  740. begin
  741.   List := TList.Create;
  742.   try
  743.     GetExampleProducers(List);
  744.     if GetSelectExample = '' then
  745.       Result := { GetExampleSummary(List, ALinks) + } GetExampleDetails(List, ALinks)
  746.     else
  747.       Result := GetExampleDetails(List, ALinks);
  748.   finally
  749.     List.Free;
  750.   end;
  751. end;
  752.  
  753. function TInetXCenterProducer.GetSelectExample: string;
  754. begin
  755.   Result := '';
  756.   if Assigned(Dispatcher) and Assigned(Dispatcher.Request) then
  757.     with Dispatcher.Request do
  758.       Result := QueryFields.Values['Example'];
  759. end;
  760.  
  761. function CompareExampleProducer(Item1, Item2: Pointer): Integer;
  762. begin
  763.   Result := CompareText(TInetXCenterProducer(Item1).LinkName,
  764.     TInetXCenterProducer(Item2).LinkName);
  765. end;
  766.  
  767. procedure TInetXCenterProducer.GetExampleProducers(AList: TList);
  768. var
  769.   SelectName: string;
  770.  
  771.   function IncludeExample(Producer: TInetXCenterProducer): Boolean;
  772.   begin
  773.     Result := (SelectName = '') or
  774.       (Producer.LinkName = SelectName);
  775.   end;
  776. var
  777.   Producer: TInetXCenterProducer;
  778.   I: Integer;
  779. begin
  780.   SelectName := GetSelectExample;
  781.  
  782.   for I := 0 to Owner.ComponentCount - 1 do
  783.   begin
  784.     if (Owner.Components[I] is TInetXCenterProducer) then
  785.     begin
  786.       Producer := TInetXCenterProducer(Owner.Components[I]);
  787.       if Producer.IsExample then
  788.         if IncludeExample(Producer) then
  789.           AList.Add(Producer);
  790.     end;
  791.   end;
  792.   AList.Sort(CompareExampleProducer);
  793. end;
  794. function TInetXCenterProducer.GetExampleDetails(AProducers: TList; ALinks: TStrings): string;
  795. var
  796.   ComponentsPage: TInetXCenterProducer;
  797.   SelectName: string;
  798.  
  799.   function AddExample(Producer: TInetXCenterProducer; Components: string): string;
  800.   var
  801.     Description: string;
  802.   begin
  803.     Description := Producer.Description.Text;
  804.     if Description = '' then
  805.       Description := ' ';
  806.     Result := Format(sExampleTable,
  807.      [Producer.LinkName, Producer.HRef,
  808.      Description, Components]);
  809.   end;
  810.  
  811.   procedure AddComponent(var Result: string);
  812.   begin
  813.     if Result <> '' then Result := Result + ', ';
  814.       Result := Result + ComponentLink(ComponentsPage, ComponentsInfoIntf.ClassName);
  815.   end;
  816.  
  817. var
  818.   Producer: TInetXCenterProducer;
  819.   I: Integer;
  820.   Components: String;
  821. begin
  822.   if Assigned(Dispatcher) and Assigned(Dispatcher.Request) then
  823.     with Dispatcher.Request do
  824.       SelectName := QueryFields.Values['Example'];
  825.  
  826.   ComponentsPage := FindTopicPage(topComponents);
  827.   for I := 0 to AProducers.Count - 1 do
  828.   begin
  829.     Producer := TInetXCenterProducer(AProducers[I]);
  830.     Components := '';
  831.     if Assigned(ComponentsInfoIntf) then
  832.     begin
  833.       Producer.GetClassNames;
  834.       ComponentsInfoIntf.Reset;
  835.       while ComponentsInfoIntf.Next do
  836.         if Producer.ClassNames.IndexOf(ComponentsInfoIntf.ClassName) <> -1 then
  837.           AddComponent(Components);
  838.     end;
  839.     Result := Result + AddExample(Producer, Components);
  840.   end;
  841. end;
  842.  
  843. procedure TInetXCenterProducer.AddTopicLinks(ALinks: TStrings);
  844.  
  845.   procedure Add(Producer: TInetXCenterProducer);
  846.   begin
  847.     if Assigned(Producer) then
  848.       ALinks.AddObject('', Producer);
  849.   end;
  850. begin
  851.   case TopicPage of
  852.     topComponents:
  853.       Add(FindTopicPage(topComponentsFilter));
  854.   end;
  855. end;
  856.  
  857. function TInetXCenterProducer.CreatePageElements: TMidasPageElements;
  858. var
  859.   Elements: TCustomPageElements;
  860. begin
  861.   case PageLayout of
  862.     plDescription:     Elements := TDescriptionPageElements.Create;
  863.   else
  864.     Elements := TCustomPageElements.Create;
  865.   end;
  866.  
  867.   AddTopicLinks(Elements.LocalLinks);
  868.   Elements.Description := GetDescription(Elements.LocalLinks);
  869.   case TopicPage of
  870.     topComponents,
  871.     topComponentsFilter: Elements.List := GetComponentsList(Elements.LocalLinks);
  872.     topExamples: Elements.List := GetExamplesList(Elements.LocalLinks);
  873.   end;
  874.   Elements.UsesComponents := GetUsesComponents(Elements.LocalLinks);
  875.   Elements.Banner := GetBanner;
  876.   Elements.GlobalLinks := GetGlobalLinks;
  877.   Elements.Caption := Caption;
  878.   Elements.Instructions := Instructions.Text;
  879.   Result := Elements;
  880. end;
  881.  
  882. function TInetXCenterProducer.GetCaption: string;
  883. begin
  884.   Result := '';
  885.   case TopicPage of
  886.     topComponents:
  887.       Result := GetSelectClassName;
  888.     topExamples:
  889.       Result := GetSelectExample;
  890.   end;
  891.   if Result = '' then
  892.     Result := FCaption;
  893.   if Result = '' then
  894.     Result := Name;
  895. end;
  896.  
  897. function TInetXCenterProducer.GetTitle: string;
  898. begin
  899.   if FTitle = '' then
  900.     Result := DefaultTitle
  901.   else
  902.     Result := FTitle;
  903. end;
  904.  
  905. function TInetXCenterProducer.DefaultTitle: string;
  906. var
  907.   F: string;
  908. begin
  909.   if IsExample then
  910.     F := sTitleExample
  911.   else
  912.     F := sTitle;
  913.   if FCaption <> '' then
  914.     Result := Format(F, [FCaption])
  915.   else
  916.     Result := Format(F, [Name])
  917. end;
  918.  
  919. function TInetXCenterProducer.GetTitleElement: string;
  920. begin
  921.   Result := Format('<TITLE>%s</TITLE>', [Title]);
  922. end;
  923.  
  924. function TInetXCenterProducer.GetDumpRequest: string;
  925.  
  926.   function AddRow(const Name: string; Value: string): string;
  927.   begin
  928.     if Trim(Value) = '' then
  929.       Value := ' ';
  930.     Result := Format('<tr><td>%s</td><td>%s</td></tr>', [Name, Value]);
  931.   end;
  932.  
  933.   function FormatStrings(Value: TStrings): string;
  934.   var
  935.     I: Integer;
  936.   begin
  937.     Result := '';
  938.     if Value.Count > 0 then
  939.     begin
  940.       for I := 0 to Value.Count - 1 do
  941.         Result := Result + AddRow(Value.Names[I], Value.Values[Value.Names[I]]);
  942.       Result := Format('<table border=1 >%s</table>', [Result]);
  943.     end;
  944.   end;
  945.  
  946.   function FormatString(const Value: string): string;
  947.   begin
  948.     Result := '';
  949.     if Value <> '' then
  950.     begin
  951.       Result := Format('%s'#13#10, [Value]);
  952.     end;
  953.   end;
  954.  
  955. begin
  956.   if Assigned(Dispatcher) and Assigned(Dispatcher.Request) then
  957.   with Dispatcher do
  958.   begin
  959.     Result := Result + AddRow('ContentFields',
  960.       FormatStrings(Request.ContentFields));
  961.     Result := Result + AddRow('QueryFields',
  962.       FormatStrings(Request.QueryFields));
  963.     Result := Result + AddRow('Query',
  964.       FormatString(Request.Query));
  965.     Result := Result + AddRow('PathInfo',
  966.       FormatString(Request.PathInfo));
  967.     Result := Result + AddRow('ScriptName',
  968.       FormatString(Request.ScriptName));
  969.     Result := Result + AddRow('Referer',
  970.       FormatString(Request.Referer));
  971.     Result := Result + AddRow('UserAgent',
  972.       FormatString(Request.UserAgent));
  973.     Result := Format(
  974.       '<table border="1" width="100%%">'#13#10 +
  975.       '<tr>'#13#10 +
  976.       '<th align="center" colspan=2>Request Fields</td>'#13#10 +
  977.       '</tr>'#13#10 +
  978.       '%s' +
  979.       '</table>'#13#10, [Result]);
  980.   end;
  981. end;
  982.  
  983. function TInetXCenterProducer.IsExample: Boolean;
  984. begin
  985.   Result := PageExampleCategories * PageCategories <> [];
  986.  
  987. end;
  988.  
  989. function TInetXCenterProducer.GetComponentsInfo: IComponentsInfo;
  990. begin
  991.   if not Assigned(FComponentsInfoIntf) and
  992.     Assigned(FComponentsInfo) then
  993.     FComponentsInfoIntf := TComponentsInfo.Create(FComponentsInfo);
  994.   Result := FComponentsInfoIntf;
  995. end;
  996.  
  997. procedure TInetXCenterProducer.SetComponentsInfo(
  998.   const Value: TDataSet);
  999. begin
  1000.   FComponentsInfo := Value;
  1001.   FComponentsInfoIntf := nil;
  1002. end;
  1003.  
  1004. procedure TInetXCenterProducer.SetCaption(const Value: string);
  1005. begin
  1006.   if Value = Name then
  1007.     FCaption := ''
  1008.   else
  1009.     FCaption := Value;
  1010. end;
  1011.  
  1012. procedure TInetXCenterProducer.SetTitle(const Value: string);
  1013. begin
  1014.   if Value = DefaultTitle then
  1015.     FTitle := ''
  1016.   else
  1017.     FTitle := Value;
  1018. end;
  1019.  
  1020. function TInetXCenterProducer.GetLinkName: string;
  1021. begin
  1022.   if FLinkName = '' then
  1023.     if FCaption <> '' then
  1024.       Result := FCaption
  1025.     else
  1026.       Result := Name
  1027.   else
  1028.     Result := FLinkName;
  1029. end;
  1030.  
  1031. procedure TInetXCenterProducer.SetLinkName(const Value: string);
  1032. begin
  1033.   if (Value = FCaption) or (Value = Name) then
  1034.     FLinkName := ''
  1035.   else
  1036.     FLinkName := Value;
  1037. end;
  1038. //{$DEFINE DEBUG}
  1039. function TInetXCenterProducer.GetComponentsList(ALinks: TStrings): string;
  1040. begin
  1041.   if GetSelectClassName = '' then
  1042.     Result := GetComponentSummary(ALinks) + GetComponentDetails(ALinks)
  1043.   else
  1044.     Result := GetComponentDetails(ALinks);
  1045. {$IFDEF DEBUG}
  1046.   Result := Format('<p><b>ComponentsInfoIntf.Filter=%s<p>',
  1047.       [ComponentsInfoIntf.GetFilter]) + Result;
  1048. {$ENDIF}
  1049. end;
  1050. resourcestring
  1051.   sComponentSummary =
  1052. '<tr><th align="left">%0:s</th></tr>'#13#10 +
  1053. '<tr><td valign="top"><p style="margin-left: 20">%1:s</td></tr>';
  1054.   sFormGroup = 'Forms';
  1055.   sGroupGroup = 'Groups';
  1056.   sInputGroup = 'Inputs';
  1057.   sButtonGroup = 'Buttons';
  1058.   sSpecialGroup = 'Special';
  1059.   sUnknownGroup = 'Other';
  1060.  
  1061. function TInetXCenterProducer.GetComponentSummary(ALinks: TStrings): string;
  1062. type
  1063.   TGroup = (gpForm, gpGroup, gpInput, gpButton, gpSpecial, gpUnknown);
  1064. const
  1065.   GroupKeys: array[TGroup] of string =
  1066.     ('Form', 'Group', 'Input', 'Button', 'Special', '');
  1067. var
  1068.   Groups: array[TGroup] of string;
  1069.  
  1070.   procedure AddComponent;
  1071.   var
  1072.     G: TGroup;
  1073.   begin
  1074.     for G := Low(TGroup) to High(TGroup) do
  1075.       if CompareText(GroupKeys[G], ComponentsInfoIntf.GetType) = 0 then
  1076.       begin
  1077.         if Groups[G] <> '' then Groups[G] := Groups[G] + ', ';
  1078.         Groups[G] := Groups[G] + Format('<A HREF=#%0:s>%0:s</A>',
  1079.           [ComponentsInfoIntf.ClassName]);
  1080.         break;
  1081.       end;
  1082.   end;
  1083. var
  1084.   G: TGroup;
  1085.   Title: string;
  1086. begin
  1087.   Result := '';
  1088.   if not Assigned(ComponentsInfoIntf) then Exit;
  1089.  
  1090.   ComponentsInfoIntf.Reset;
  1091.   while ComponentsInfoIntf.Next do
  1092.   begin
  1093.     AddComponent;
  1094.   end;
  1095.   Result := '';
  1096.   for G := Low(Groups) to High(Groups) do
  1097.   begin
  1098.     if Groups[G] <> '' then
  1099.     begin
  1100.       case G of
  1101.         gpForm: Title := sFormGroup;
  1102.         gpGroup: Title := sGroupGroup;
  1103.         gpButton: Title := sButtonGroup;
  1104.         gpSpecial: Title := sSpecialGroup;
  1105.         gpUnknown: Title := sUnknownGroup;
  1106.         gpInput: Title := sInputGroup;
  1107.       else
  1108.         Assert(False, 'Unknown group');
  1109.       end;
  1110.       Result := Result + Format(sComponentSummary, [Title,
  1111.         Groups[G]]);
  1112.     end;
  1113.   end;
  1114.   if Result <> '' then
  1115.     Result := Format('<table width="100%%">%s</table><hr>', [Result]);
  1116. end;
  1117.  
  1118. function TInetXCenterProducer.GetExampleSummary(AProducers: TList;
  1119.   ALinks: TStrings): string;
  1120. var
  1121.   Producer: TInetXCenterProducer;
  1122.  
  1123.   procedure AddExample(var Result: string);
  1124.   begin
  1125.     if Result <> '' then Result := Result + ', ';
  1126.     Result := Result + Format('<A HREF=#%0:s>%0:s</A>',
  1127.     [Producer.LinkName]);
  1128.   end;
  1129. var
  1130.   I: Integer;
  1131. begin
  1132.   Result := '';
  1133.   for I := 0 to AProducers.Count - 1 do
  1134.   begin
  1135.     Producer := AProducers[I];
  1136.     AddExample(Result);
  1137.   end;
  1138. end;
  1139.  
  1140. procedure TInetXCenterProducer.SetInstructions(const Value: TStrings);
  1141. begin
  1142.   FInstructions.Assign(Value);
  1143. end;
  1144.  
  1145. { TDescriptionPageElements }
  1146.  
  1147. function TDescriptionPageElements.BodyContent: string;
  1148. begin
  1149.   Result := inherited BodyContent;
  1150. end;
  1151.  
  1152. { TCustomPageElements }
  1153.  
  1154. resourcestring
  1155.   sStandardPageLayout =
  1156. '<Table >'#13#10  +
  1157. '<TR><TD VALIGN="CENTER" ALIGN="LEFT" WIDTH="%0:d">%1:s</TD><TD VALIGN="TOP" >%2:s</TD></TR>'#13#10 +
  1158. '<TR><TD VALIGN="TOP" ALIGN="LEFT" WIDTH="%0:d">%3:s</TD><TD VALIGN="TOP" >%4:s</TD></TR></TABLE>';
  1159.  
  1160. function TCustomPageElements.BodyContent: string;
  1161. begin
  1162.   Result :=
  1163.       IncludesContent +
  1164.       StylesContent +
  1165.       WarningsContent +
  1166.       Format(sStandardPageLayout,
  1167.      [{Width} 140,
  1168.       {Page Caption}Format('<p><b><i>%s</p>',[ Caption]),
  1169.       {Page Banner} Banner,
  1170.       {Links}Format('<p>%s</p><p>%s</p>', [GlobalLinks, FormatLocalLinks]),
  1171.       { Body }
  1172.       '<br>'+
  1173.       Instructions +
  1174.       FormsContent +
  1175.       List +   // Custom
  1176.       Description +  // Custom
  1177.       UsesComponents   // Custom
  1178.       ]) +
  1179.       ScriptContent;
  1180. end;
  1181.  
  1182. constructor TCustomPageElements.Create;
  1183. begin
  1184.   inherited;
  1185.   LocalLinks := TStringList.Create;
  1186. end;
  1187.  
  1188. destructor TCustomPageElements.Destroy;
  1189. begin
  1190.   inherited;
  1191.   LocalLinks.Free;
  1192.  
  1193. end;
  1194.  
  1195. function TCustomPageElements.FormatLocalLinks: string;
  1196.   procedure Add(HRef, LinkName: string);
  1197.   var
  1198.     Link: string;
  1199.   begin
  1200.     Link := Format('<A HREF="%0:s">%1:s</A>'#13#10,
  1201.           [HRef, LinkName]);
  1202.     if Result <> '' then
  1203.       Result := Result + '</BR>';
  1204.     Result := Result + Link;
  1205.   end;
  1206. var
  1207.   I: Integer;
  1208. begin
  1209.   Result := '';
  1210.   for I := 0 to LocalLinks.Count - 1 do
  1211.   begin
  1212.     if Assigned(LocalLinks.Objects[I]) then
  1213.       with LocalLinks.Objects[I] as TInetXCenterProducer do
  1214.         Add(HREF, LinkName)
  1215.     else
  1216.       if LocalLinks.Values[LocalLinks.Names[I]] <> '' then
  1217.         Add('#'+LocalLinks.Values[LocalLinks.Names[I]], LocalLinks.Names[I])
  1218.       else
  1219.         Add('#'+LocalLinks[I], LocalLinks[I]);
  1220.   end;
  1221. end;
  1222.  
  1223. { TComponentsInfo }
  1224.  
  1225. function TComponentsInfo.ClassName: string;
  1226. begin
  1227.   Result := FDataSet.FieldByName('ClassName').AsString;
  1228. end;
  1229.  
  1230. constructor TComponentsInfo.Create(ADataSet: TDataSet);
  1231. var
  1232.   F: string;
  1233. begin
  1234.   inherited Create;
  1235.   FDataSet := ADataSet;
  1236.   if not (csDesigning in ADataSet.ComponentState) then
  1237.   begin
  1238.     if ADataSet is TClientDataSet then
  1239.       with TClientDataSet(ADataSet) do
  1240.       begin
  1241.         F := FileName;
  1242.         if QualifyFileName(F) then
  1243.         begin
  1244.           ADataSet.Active := False;
  1245.           FileName := F;
  1246.         end;
  1247.       end;
  1248.   end;
  1249.   Reset;
  1250. end;
  1251.  
  1252. procedure TComponentsInfo.Reset;
  1253. begin
  1254.   FDataSet.Active := True;
  1255.   FDataSet.First;
  1256.   FReset := True;
  1257. end;
  1258.  
  1259. function TComponentsInfo.Next: Boolean;
  1260. begin
  1261.   if (not FReset) and (not Eof) then
  1262.     FDataSet.Next;
  1263.   FReset := False;
  1264.   Result := not Eof;
  1265. end;
  1266.  
  1267. function TComponentsInfo.Eof: Boolean;
  1268. begin
  1269.   Result := FDataSet.Eof;
  1270. end;
  1271.  
  1272. function TComponentsInfo.ShortDescription: string;
  1273. begin
  1274.   Result := FDataSet.FieldByName('ShortDescription').AsString;
  1275. end;
  1276.  
  1277. function TComponentsInfo.Usage: string;
  1278. begin
  1279.   Result := FDataSet.FieldByName('Usage').AsString;
  1280. end;
  1281.  
  1282. function TComponentsInfo.Description: string;
  1283. begin
  1284.   Result := FDataSet.FieldByName('Description').AsString;
  1285.   if Trim(Result) = '' then
  1286.     Result := FDataSet.FieldByName('ShortDescription').AsString;
  1287. end;
  1288.  
  1289. function TComponentsInfo.FieldByName(FieldName: string): TField;
  1290. begin
  1291.   Result := FDataSet.FieldByName(FieldName);
  1292. end;
  1293.  
  1294. function TComponentsInfo.GetType: string;
  1295. begin
  1296.     Result := FDataSet.FieldByName('Type').AsString;
  1297. end;
  1298.  
  1299. function TComponentsInfo.Package: string;
  1300. begin
  1301.     Result := FDataSet.FieldByName('Package').AsString;
  1302.  
  1303. end;
  1304.  
  1305. procedure TComponentsInfo.SetFilter(PackageFilter, UsageFilter, TypeFilter: string);
  1306.   procedure AddFilter(var S: string; Value: string);
  1307.   begin
  1308.     if S <> '' then
  1309.       S := S + ' and ';
  1310.     S := S + Value;
  1311.   end;
  1312.  
  1313.   function CreateFilter: string;
  1314.   begin
  1315.     Result := '';
  1316.     if PackageFilter <> 'All' then
  1317.       if PackageFilter = 'Custom' then
  1318.         AddFilter(Result,
  1319.           '(Package <> ''Standard'') and (Usage <> '''')')
  1320.       else
  1321.         AddFilter(Result,
  1322.           Format('Package = ''%s''', [PackageFilter]));
  1323.     if UsageFilter <> 'All' then
  1324.     begin
  1325.       if (UsageFilter = 'XMLData') or (UsageFilter = 'Query') then
  1326.         AddFilter(Result,
  1327.           Format('(Usage = ''%s'' or Usage = ''Layout'')', [UsageFilter]))
  1328.       else
  1329.         AddFilter(Result,
  1330.           Format('Usage = ''%s''', [UsageFilter]));
  1331.     end;
  1332.     if TypeFilter <> 'All' then
  1333.       AddFilter(Result,
  1334.         Format('Type = ''%s''', [TypeFilter]));
  1335.   end;
  1336. begin
  1337.   FDataSet.Filter := CreateFilter;
  1338.   FDataSet.Filtered := True;
  1339. end;
  1340.  
  1341. function TComponentsInfo.Example: string;
  1342. begin
  1343.   Result := FDataSet.FieldByName('Example').AsString;
  1344. end;
  1345.  
  1346. procedure TComponentsInfo.LocateClassName(AClassName: string);
  1347. begin
  1348.   FDataSet.Locate('ClassName', AClassName, []);
  1349. end;
  1350.  
  1351. procedure TComponentsInfo.ClearFilter;
  1352. begin
  1353.   FDataSet.Filtered := False;
  1354.   FDataSet.Filter := '';
  1355. end;
  1356.  
  1357. function TComponentsInfo.GetFilter: string;
  1358. begin
  1359.   Result := FDataSet.Filter;
  1360. end;
  1361.  
  1362. initialization
  1363. finalization
  1364.   UnRegisterWebComponents([
  1365.     TInetXCenterProducer]);
  1366. end.
  1367.