⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 unit513.~pas

📁 Delphi6分布式开发例程12 )
💻 ~PAS
字号:
🔍 
unit Unit513;

interface

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

type
    TWebModule1 = class(TWebModule)
    CustomerList: TPageProducer;
    Table1: TTable;
    Table1CustNo: TFloatField;
    Table1Company: TStringField;
    Table1Addr1: TStringField;
    Table1Addr2: TStringField;
    Table1City: TStringField;
    Table1State: TStringField;
    Table1Zip: TStringField;
    Table1Country: TStringField;
    Table1Phone: TStringField;
    Table1FAX: TStringField;
    Table1TaxRate: TFloatField;
    Table1Contact: TStringField;
    Table1LastInvoiceDate: TDateTimeField;
    Query1: TQuery;
    CustomerOrders: TDataSetTableProducer;
    Session1: TSession;
    procedure CustomerListHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure WebModule1WebActionItem1Action(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure WebModule1QueryOrderActionAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure WebModule1Create(Sender: TObject);
  private
    ScriptName:String;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  WebModule1: TWebModule1;

implementation

{$R *.DFM}

procedure TWebModule1.CustomerListHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
var Temp:String;
begin
     if CompareText(TagString,'CUSTLIST')=0 then begin
        Temp:='<FORM METHOD="GET" ACTION="'+ScriptName+'/runquery">';
        Temp:=Temp+'select custNo：<P>';
        Temp:=Temp+'select CustList：<SELECT NAME="CustNo">';
        Table1.First;
        while not Table1.EOF do begin
              Temp:=Temp+'<OPTION VALUE="'+Table1CustNo.AsString+'">'+Table1Company.AsString;
              Table1.Next;
        end;
        Temp:=Temp+'</Select>'
     end;
     ReplaceText:=Temp;
end;

procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
     Response.Content:=CustomerList.Content;
end;

procedure TWebModule1.WebModule1QueryOrderActionAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var temp:String;
begin
     Query1.Close;
     Query1.SQL.Clear;
     Query1.SQL.Add('select * from Orders');
     temp:='"'+Request.QueryFields.Values['CustNo']+'"';
     Query1.SQL.Add('where CustNo = '+temp);
     Query1.Prepare;
     Query1.Open;
     CustomerOrders.Header.Clear;
     CustomerOrders.Header.Add('<HTML>');
     CustomerOrders.Header.Add('<H2>CustNo：'+Table1CustNo.AsString+'</H2><HR>');
     CustomerOrders.Footer.Clear;
     if Query1.RecordCount=0 then begin
        CustomerOrders.Footer.Add('<P>Sorry, your order not found<P>');
        CustomerOrders.Footer.Add('back and resigne it<P>')
     end;
     CustomerOrders.Footer.Add('</HTML>');
     Response.Content:=CustomerOrders.Content;
end;

procedure TWebModule1.WebModule1Create(Sender: TObject);
var
  FN: array[0..MAX_PATH- 1] of char;
begin
  Table1.Open;
  SetString(ScriptName, FN, GetModuleFileName(hInstance, FN, SizeOf(FN)));
  ScriptName := ExtractFileName(ScriptName);
end;

end.

⌨️ 快捷键说明

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