📄 multiwm.pas

📁 Delphi高级开发指南是开发程序的好帮手
💻 PAS
字号:
unit MultiWm;

interface

uses
  Windows, Messages, SysUtils, Classes, HTTPApp, Db, DBTables;

type
  TWebModule1 = class(TWebModule)
    Table1: TTable;
    Table1EmpNo: TIntegerField;
    Table1LastName: TStringField;
    Table1FirstName: TStringField;
    Table1PhoneExt: TStringField;
    Table1HireDate: TDateTimeField;
    Table1Salary: TFloatField;
    procedure HelloAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    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 TableAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure RecordAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  WebModule1: TWebModule1;

implementation

{$R *.DFM}

procedure TWebModule1.HelloAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content :=
    '<HTML><HEAD><TITLE>Hello Page</TITLE></HEAD><BODY>' +
    '<H1>Hello</H1>' +
    'Hello. Ciao. Salut. Hallo. Hi.<p>' +
    '<hr><I>Page generated by IsaMulti</I>' +
    '</BODY></HTML>';
end;

procedure TWebModule1.TimeAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content :=
    '<HTML><HEAD><TITLE>Time</TITLE></HEAD><BODY>'#13 +
    '<H1>Time</H1>'#13 +
    FormatDateTime(
      '"The time is" hh:mm:ss AM/PM "<p>"'#13, Now) +
    '<hr><I>Page generated by IsaMulti</I>'#13 +
    '</BODY></HTML>'#13;
end;

procedure TWebModule1.DateAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content :=
    '<HTML><HEAD><TITLE>Date</TITLE></HEAD><BODY>'#13 +
    '<H1>Date</H1>'#13 +
    FormatDateTime(
        '"Today is " dddd, mmmm d, yyyy "<p>"'#13, Now) +
    '<hr><I>Page generated by IsaMulti</I>'#13 +
    '</BODY></HTML>'#13;
end;

procedure TWebModule1.MenuAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  I: Integer;
begin
  Response.Content :=
    '<HTML><HEAD><TITLE>Multi Menu</TITLE></HEAD><BODY>'#13 +
    '<H1>Multi Menu</H1>'#13 +
    '<ul>'#13;
  for I := 0 to Actions.Count - 1 do
    Response.Content := Response.Content +
      '<li> <a href="' + Request.ScriptName +
      Action[I].PathInfo + '"> ' + Action[I].Name + '</a>'#13;
  Response.Content := Response.Content +
    '</ul><hr>'#13 +
    '<I>Page generated by IsaMulti</I>'#13 +
    '</BODY></HTML>'#13;
end;

procedure TWebModule1.StatusAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  I: Integer;
begin
  Response.Content :=
    // header
    '<HTML><HEAD><TITLE>Status</TITLE></HEAD><BODY>'#13 +
    '<H1>Status</H1>'#13 +
    // status information
    '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;
  // footer
  Response.Content := Response.Content +
    '</ul><hr>'#13 +
    '<I>Page generated by IsaMulti</I>'#13 +
    '</BODY></HTML>'#13;
end;

procedure TWebModule1.TableAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content :=
    '<HTML><HEAD><TITLE>Employee Table</TITLE></HEAD><BODY>'#13 +
    '<H1>Employee Table</H1>'#13 +
    '<table border>'#13;
  // show a summary of the entire table
  Table1.Open;
  Table1.First;
  while not Table1.EOF do
  begin
    // show names with a link
    Response.Content := Response.Content + Format (
      '<tr><td><a HREF="%s/record?%s&%s">%s %s</a></td></tr>'#13,
      [Request.ScriptName,
      Table1LastName.AsString,
      Table1FirstName.AsString,
      Table1FirstName.AsString,
      Table1LastName.AsString]);
    Table1.Next;
  end;
  // end of the table and footer
  Response.Content := Response.Content +
    '</table>'#13 +
    '<hr><I>Page generated by IsaMulti</I>'#13 +
    '</BODY></HTML>'#13;
end;

procedure TWebModule1.RecordAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  I: Integer;
begin
  if Request.QueryFields.Count = 0 then
    TableAction (Sender, Request, Response, Handled)
  else
  begin
    if Request.QueryFields.Count = 1 then
      Table1.FindNearest ([Request.QueryFields[0]])
    else
      Table1.FindNearest ([Request.QueryFields[0],
        Request.QueryFields[1]]);
    Response.Content :=
      '<HTML><HEAD><TITLE>Employee Record</TITLE></HEAD><BODY>'#13 +
      '<H1>Employee Record: ' + Request.QueryFields[0] +
      '</H1>'#13 +
      '<table border>'#13;
    for I := 1 to Table1.FieldCount - 1 do
      Response.Content := Response.Content +
        '<tr><td>' + Table1.Fields [I].FieldName +
        '</td>'#13'<td>' + Table1.Fields [I].AsString +
        '</td></tr>'#13;
    Response.Content := Response.Content +
      '</table><hr>'#13 +
      '<table border><tr>'#13 +
      // pointer to the table index
      '<td><a HREF="' + Request.ScriptName + '/table"> Index </a></td>'#13;
    // pointer to the prior record, if any
    Table1.Prior;
    if not Table1.BOF then
    begin
      Response.Content := Response.Content + Format (
        '<td><a HREF="%s/record?%s&%s"> Prior </a></td>#13',
        [Request.ScriptName,
        Table1LastName.AsString,
        Table1FirstName.AsString]);
      // get back
      Table1.Next;
    end
    else
      // empty spot
      Response.Content := Response.Content +
        '<td><i>Prior</i></td>#13';
    // pointer to the next record, if any
    Table1.Next;
    if not Table1.EOF then
      Response.Content := Response.Content + Format (
        '<td><a HREF="%s/record?%s&%s"> Next </a></td>#13',
        [Request.ScriptName,
        Table1LastName.AsString,
        Table1FirstName.AsString])
    else
      // empty spot
      Response.Content := Response.Content +
        '<td><i>Next</i></td>'#13;
    // end of the line and table + footer
    Response.Content := Response.Content +
      '</tr></table>'#13 +
      '<hr><I>Page generated by IsaMulti</I>'#13 +
      '</BODY></HTML>'#13;
  end;
end;

end.
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -