Marco Web Center |
Home: Code Repository: Mastering Delphi 5Project BROKCGI
Project StructureBROKCGI.DPRprogram BrokCgi; {$APPTYPE CONSOLE} uses WebBroker, CGIApp, BrokWm in 'BrokWm.pas' {WebModule1: TWebModule}; {$R *.RES} begin Application.Initialize; Application.CreateForm(TWebModule1, WebModule1); Application.Run; end. BROKWM.PASunit BrokWm; interface uses Windows, Messages, SysUtils, Classes, HTTPApp, Db, DBTables, DSProd, DBWeb; type TWebModule1 = class(TWebModule) Table1: TTable; Table1EmpNo: TIntegerField; Table1LastName: TStringField; Table1FirstName: TStringField; Table1PhoneExt: TStringField; Table1HireDate: TDateTimeField; Table1Salary: TFloatField; PageHead: TPageProducer; DataSetPage: TDataSetPageProducer; PageTail: TPageProducer; procedure TimeAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); procedure DateAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); procedure MenuAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); procedure StatusAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); procedure RecordAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); procedure PageTailHTMLTag(Sender: TObject; Tag: TTag; const TagString: String; TagParams: TStrings; var ReplaceText: String); procedure WebModule1BeforeDispatch(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); procedure DataSetTableProducer1FormatCell(Sender: TObject; CellRow, CellColumn: Integer; var BgColor: THTMLBgColor; var Align: THTMLAlign; var VAlign: THTMLVAlign; var CustomAttrs, CellData: String); procedure WebModule1AfterDispatch(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); private ScriptName: string; public { Public declarations } end; var WebModule1: TWebModule1; implementation {$R *.DFM} procedure TWebModule1.TimeAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); begin Response.Content := 'Time at this site: ' + FormatDateTime('hh:mm:ss AM/PM', Now) + '<p>'; end; procedure TWebModule1.DateAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); begin Response.Content := 'Today is ' + FormatDateTime('dddd, mmmm d, yyyy', Now) + '<p>'; end; procedure TWebModule1.MenuAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); var I: Integer; begin Response.Content := '<H3>Menu</H3><ul>'#13; for I := 0 to Actions.Count - 1 do Response.Content := Response.Content + '<li> <a href="' + ScriptName + Action[I].PathInfo + '"> ' + Action[I].Name + '</a>'#13; Response.Content := Response.Content + '</ul>'; end; procedure TWebModule1.StatusAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); var I: Integer; begin Response.Content := '<H3>Status</H3>'#13 + 'Method: ' + Request.Method + '<br>'#13 + 'ProtocolVersion: ' + Request.ProtocolVersion + '<br>'#13 + 'URL: ' + Request.URL + '<br>'#13 + 'Query: ' + Request.Query + '<br>'#13 + 'PathInfo: ' + Request.PathInfo + '<br>'#13 + 'PathTranslated: ' + Request.PathTranslated + '<br>'#13 + 'Authorization: ' + Request.Authorization + '<br>'#13 + 'CacheControl: ' + Request.CacheControl + '<br>'#13 + 'Cookie: ' + Request.Cookie + '<br>'#13 + 'Date: ' + DateTimeToStr (Request.Date) + '<br>'#13 + 'Accept: ' + Request.Accept + '<br>'#13 + 'From: ' + Request.From + '<br>'#13 + 'Host: ' + Request.Host + '<br>'#13 + 'IfModifiedSince: ' + DateTimeToStr (Request.IfModifiedSince) + '<br>'#13 + 'Referer: ' + Request.Referer + '<br>'#13 + 'UserAgent: ' + Request.UserAgent + '<br>'#13 + 'ContentEncoding: ' + Request.ContentEncoding + '<br>'#13 + 'ContentType: ' + Request.ContentType + '<br>'#13 + 'ContentLength: ' + IntToStr (Request.ContentLength) + '<br>'#13 + 'ContentVersion: ' + Request.ContentVersion + '<br>'#13 + 'Content: ' + Request.Content + '<br>'#13 + 'Connection: ' + Request.Connection + '<br>'#13 + 'DerivedFrom: ' + Request.DerivedFrom + '<br>'#13 + 'Expires: ' + DateTimeToStr (Request.Expires) + '<br>'#13 + 'Title: ' + Request.Title + '<br>'#13 + 'RemoteAddr: ' + Request.RemoteAddr + '<br>'#13 + 'RemoteHost: ' + Request.RemoteHost + '<br>'#13 + 'ScriptName: ' + Request.ScriptName + '<br>'#13 + 'ServerPort: ' + IntToStr (Request.ServerPort) + '<br>'#13; // list of strings Response.Content := Response.Content + 'ContentFields:<ul>'#13; for I := 0 to Request.ContentFields.Count - 1 do Response.Content := Response.Content + '<li>' + Request.ContentFields [I]+ #13; Response.Content := Response.Content + '</ul>CookieFields:<ul>'#13; for I := 0 to Request.CookieFields.Count - 1 do Response.Content := Response.Content + '<li>' + Request.CookieFields [I] + #13; Response.Content := Response.Content + '</ul>QueryFields:<ul>'#13; for I := 0 to Request.QueryFields.Count - 1 do Response.Content := Response.Content + '<li>' + Request.QueryFields [I] + #13; end; procedure TWebModule1.RecordAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); begin // go to the requested record Table1.FindNearest ([Request.QueryFields.Values['LastName'], Request.QueryFields.Values['FirstName']]); // get the output Response.Content := DataSetPage.Content; end; procedure TWebModule1.PageTailHTMLTag(Sender: TObject; Tag: TTag; const TagString: String; TagParams: TStrings; var ReplaceText: String); begin if TagString = 'script' then ReplaceText := ScriptName; end; procedure TWebModule1.WebModule1BeforeDispatch(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); begin // code shared by all actions ScriptName := Request.ScriptName; Table1.Open; end; procedure TWebModule1.DataSetTableProducer1FormatCell(Sender: TObject; CellRow, CellColumn: Integer; var BgColor: THTMLBgColor; var Align: THTMLAlign; var VAlign: THTMLVAlign; var CustomAttrs, CellData: String); begin if (CellColumn = 0) and (CellRow <> 0) then CellData := '<a href="' + ScriptName + '/record?LastName=' + Table1['LastName'] + '&FirstName=' + Table1 ['FirstName'] + '"> ' + CellData + ' </a>'; end; procedure TWebModule1.WebModule1AfterDispatch(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); begin Response.Content := PageHead.Content + Response.Content + PageTail.Content; end; end. BROKWM.DFMobject WebModule1: TWebModule1 OldCreateOrder = True Actions = < item Name = 'WaTime' PathInfo = '/time' OnAction = TimeAction end item Name = 'WaDate' PathInfo = '/date' OnAction = DateAction end item Default = True Name = 'WaMenu' PathInfo = '/menu' OnAction = MenuAction end item Name = 'WaStatus' PathInfo = '/status' OnAction = StatusAction end item Name = 'WaTable' PathInfo = '/table' end item Name = 'WaRecord' PathInfo = '/record' Producer = DataSetPage OnAction = RecordAction end> BeforeDispatch = WebModule1BeforeDispatch AfterDispatch = WebModule1AfterDispatch Left = 278 Top = 272 Height = 392 Width = 726 object Table1: TTable DatabaseName = 'DBDEMOS' IndexName = 'ByName' TableName = 'EMPLOYEE.DB' Left = 48 Top = 24 object Table1EmpNo: TIntegerField FieldName = 'EmpNo' end object Table1LastName: TStringField FieldName = 'LastName' end object Table1FirstName: TStringField FieldName = 'FirstName' Size = 15 end object Table1PhoneExt: TStringField FieldName = 'PhoneExt' Size = 4 end object Table1HireDate: TDateTimeField FieldName = 'HireDate' end object Table1Salary: TFloatField FieldName = 'Salary' end end object PageHead: TPageProducer HTMLDoc.Strings = ( '<HTML><HEAD>' '<TITLE>WebBroker Demo</TITLE>' '</HEAD>' '<BODY>' '<H1>Web Broker Demo</H1>') Left = 110 Top = 25 end object DataSetPage: TDataSetPageProducer HTMLDoc.Strings = ( '<H3>Employee: <#LastName></H3>' '<ul>' '<li> Employee ID: <#EmpNo>' '<li> Name: <#FirstName> <#LastName>' '<li> Phone: <#PhoneExt>' '<li> Hired On: <#HireDate>' '<li> Salary: <#Salary>' '</ul>') OnHTMLTag = PageTailHTMLTag DataSet = Table1 Left = 168 Top = 80 end object PageTail: TPageProducer HTMLDoc.Strings = ( '<hr><I>Page generated by <#script></I>' '</BODY>' '</HTML>') OnHTMLTag = PageTailHTMLTag Left = 168 Top = 27 end end
|
||
© Copyright Marco Cantù, 1995-2020, All rights reserved |