📄 unit1.pas

📁 Java实例入门
💻 PAS
字号:
unit Unit1;

{Note: This code requires a BDE alias called GBData that points to
the data in the GBDATA subdirectory}

interface

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

type
  TWebModule1 = class(TWebModule)
    GBTable: TTable;
    PageProducer1: TPageProducer;
    PageProducer2: TPageProducer;
    Session1: TSession;
    procedure WebModule1Actions0Action(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure WebModule1Actions1Action(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  private
    { Private declarations }
    procedure DoGuestBookEntries(Page: TStrings; Comments: String; Name: String; eMail: String;
                                           WhereFrom: String; When: TDateTime; FirstTime: Boolean);
  public
    { Public declarations }
  end;

var
  WebModule1: TWebModule1;  

implementation

{$R *.DFM}

uses WebUtils;

procedure TWebModule1.WebModule1Actions0Action(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
   MyPage: TStringList;
   ParamsList: TParamsList;
begin
     begin
          ParamsList := TParamsList.Create;
          try try
            ParamsList.AddParameters(Request.ContentFields);
            GBTable.Open;
            GBTable.Append;
            GBTable.FieldByName('Name').Value := ParamsList['fullnameText'];
            GBTable.FieldByName('EMail').Value := ParamsList['emailText'];
            GBTable.FieldByName('WhereFrom').Value := ParamsList['wherefromText'];
            GBTable.FieldByName('Comments').Value := ParamsList['commentsTextArea'];
            GBTable.FieldByName('FirstTime').Value := (CompareStr(ParamsList['firstVisitCheck'], 'on') = 0);
            GBTable.FieldByName('DateTime').Value := Now;
            GBTable.Post;
          except
               Response.Content := 'An Error occurred in processing your data.';
               Handled := True;
          end;
          finally
            ParamsList.Free;
            GBTable.Close;
          end;
     end;
     
  MyPage := TStringList.Create;
  ParamsList := TParamsList.Create;
     try
       with MyPage do
       begin
         Add('<HTML>');
         Add('<HEAD><TITLE>Guest Book Demo Page</TITLE></HEAD>');
         Add('<BODY>');
         Add('<H2>Delphi 3.0 Guest Book Demo</H2><HR>');

         ParamsList.AddParameters(Request.ContentFields);
         Add('<H3>Hello <FONT COLOR="RED">'+ ParamsList['fullnameText'] +'</FONT> from '+ParamsList['wherefromText']+'!</H3><P>');
         Add('Thanks for visiting my homepage and making an entry into my Guestbook.<P>');
         Add('If we need to e-mail you, we will use this address -- <B>'+ParamsList['emailText']+'</B>');
         Add('<HR></BODY>');
         Add('</HTML>');
       end;
      PageProducer1.HtmlDoc := MyPage;
     finally
       MyPage.Free;
       ParamsList.Free;
     end;

     Response.Content := PageProducer1.Content;
     Handled := True;
end;

procedure TWebModule1.DoGuestBookEntries(Page: TStrings; Comments: String; Name: String; eMail: String;
                                           WhereFrom: String; When: TDateTime; FirstTime: Boolean);
begin
      Page.Add('<B>' + Comments +'</B><BR>');
      Page.Add(Name + '  (<A HREF="mailto:' + eMail + '">'+ email +'</A>)<BR>');
      Page.Add(WhereFrom + '<BR>');
      Page.Add(FormatDateTime('dd mmmm yyyy hh:mm:ss', When));
      if FirstTime then
      begin
        Page.Add('<FONT COLOR="RED">(First Time)</FONT><BR>');
      end;
      Page.Add('<HR>');
end;


procedure TWebModule1.WebModule1Actions1Action(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  Page: TStringList;
begin
  Page := TStringList.Create;
  try
         Page.Add('<HTML>');
         Page.Add('<HEAD><TITLE>Guest Book Entries</TITLE></HEAD>');
         Page.Add('<BODY>');
         Page.Add('<H2>Delphi 3.0 Internet Tools Guest Book Demo</H2><HR>');
         Page.Add('<B><FONT COLOR="BLUE">These are the entries to my Guest Book:</FONT></B><HR>');

           try
             GBTable.Open;
             while not GBTable.EOF do
             begin
               DoGuestBookEntries(Page,
                                  GBTable.FieldByName('Comments').AsString,
                                  GBTable.FieldByName('Name').AsString,
                                  GBTable.FieldByName('email').AsString,
                                  GBTable.FieldByName('WhereFrom').AsString,
                                  GBTable.FieldByName('DateTime').AsDateTime,
                                  GBTable.FieldByName('FirstTime').AsBoolean
                                  );
               GBTable.Next;
             end;
           finally
             GBTable.Close;
           end;
         Page.Add('<HR></BODY>');
         Page.Add('</HTML>');
    PageProducer2.HtmlDoc := Page;
  finally
    Page.Free;
  end;
  Response.Content := PageProducer2.Content;
  Handled := True;
end;


end.
⌨️ 快捷键说明

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