mainp.pas

《delphi 7 web 开发及与应用》源码

unit mainp;

interface

uses
  {$IFDEF MSWINDOWS}
  Windows, Messages,
  {$ENDIF}
  SysUtils, Classes,  HTTPApp, HTTPProd, DB, MemDS, DBAccess, Ora,
  ExtCtrls, WebBroker,IniFiles,Graphics, StrUtils,TeEngine, Series,  TeeProcs, Chart,
  Controls, datecn,JPEG;

type
  Twm = class(TWebModule)
    title: TPageProducer;
    foot: TPageProducer;
    newsfont: TPageProducer;
    center: TPageProducer;
    jthtml: TPageProducer;
    datahtml: TPageProducer;
    sqlc: TOraQuery;
    softpage: TPageProducer;
    bookpage: TPageProducer;
    jswzpage: TPageProducer;
    jstlpage: TPageProducer;
    fwtjpage: TPageProducer;
    showtlpage: TPageProducer;
    newtlpage: TPageProducer;
    showlypage: TPageProducer;
    userregpage: TPageProducer;
    softpl: TPageProducer;
    cx: TOraQuery;
    zcx: TOraQuery;
    usereditpage: TPageProducer;
    OraS: TOraSQL;
    procedure WebModule1WebActionItem1Action(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure titleHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure wmshownewsAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure newsfontHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure centerHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure wmshowAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure WebModuleCreate(Sender: TObject);
    procedure datahtmlHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure wmshowmsgAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure wmsoftAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure softpageHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure wmbookAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure bookpageHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure wmjswzAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure jswzpageHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure wmlinkAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure wmshowwzAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure wmloginAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure wmjstlAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure jstlpageHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure lypageHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure wmfwtjAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure fwtjpageHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure wmshowjstlAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure showtlpageHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure wmtlpostAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure newtlpageHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure wmnewtlAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure wmuserregAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure wmnewuserAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure wmdownloadAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure wmdownloadbookAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure wmsoftplAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure softplHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure wmsoftplpostAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure wmshowuserAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure wmtlsearchAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure wmaboutAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure ora51delphiError(Sender: TObject; E: EDAError;
      var Fail: Boolean);
    procedure wmgetimgAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure wmdrawchartAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure wmusereditAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure usereditpageHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure wmusereditokAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure WebModuleBeforeDispatch(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure wmdeljstlAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure wmgototlAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure WebModuleException(Sender: TObject; E: Exception;
      var Handled: Boolean);
    procedure wmdelmytjAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure wmlogoutAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);

  private
    { Private declarations }
  public
     { Public declarations }
   

      sysuser:string;
      pathname:string;
      softpath:string;
      bookpath:string;


      bbson:boolean;
      function txt2html(ss:string):string;

      function getimg(num:integer):string;


      function getfaid(id,t:string):string;

      function newtlshow:string;
      function homelink:string;
      function newsoft:string;
      function newbook:string;
      function newjswz:string;

      function showsoft(showcount,no:integer;where:string):string;
      function showbook(showcount,no:integer;where:string):string;
      function showsofttype(showcount,no:integer;where:string):string;
      function showbooktype(showcount,no:integer;where:string):string;

      function showjswz(showcount,no:integer;where:string):string;

      function showpage(allnum,showcount,no:integer;stype:string):string;


      function showtable(T:Tdataset;showcount,no:integer):string;


      procedure setcookie(cname,cvalue:string;t:Tdatetime);
      function getcookie(cname:string):string;



      procedure counter(Request: TWebRequest);
      function showuser:string ;
      function showdate:string ;

      procedure setsession(cname,cvalue:string);
      function  getsession(cname:string):string;
      procedure porctlpage(id:string);
      procedure protlindex;

      function encodeip(ip:string):dword;
    
  end;
  
const
 chweek:array [1..7]of string[2]=('日','一','二','三','四','五','六');
 defpathname:string='d:/Apache Group/Apache2/htdocs';

 jstlpath:string='d:/Apache Group/Apache2/htdocs/JSTL/';

 defsoftpath:string='ftp://202.117.210.28/file/';
 defbookpath:string='ftp://202.117.210.28/book/';
 gridhead:string=' <table width="100%" border="0" cellspacing="1" cellpadding="1" bgColor="#609000">';
 gridheadline:string='  <tr bgcolor="#ffffcc">';
 gridline:string=' <tr bgcolor="#fefded">';
 gridline2:string=' <tr bgcolor="#d6e3ff">';
 gridtdhead:string=' <td ><font class=pt9>';
 gridtdheadnowrap:string=' <td  nowrap><font class=pt9>';
 gridtdend:string=' </font></td>';

var
  wm: Twm;

implementation

uses dmp,MsMultipartParser;

{$R *.dfm}

function Twm.encodeip(ip:string):dword;
var
   ap:array[1..4] of string;
   i,p:integer;
   o:Dword;
begin
  for i:=1 to 4 do
     ap[i]:='';


   p:=1;
  for i:=1 to length(ip)  do
    begin
      if  ip[i]<>'.' then
        ap[p]:=ap[p]+ip[i]
       else
         begin
           p:=P+1;
         end;
    end;
   o:=strtoint(ap[1]) shl 24+strtoint(ap[2]) shl 16 +strtoint(ap[3]) shl 8+strtoint(ap[4]);
   result:=o;

end;

function twm.getimg(num:integer):string;
var
   img:string;
   h,e:string;
begin
       img:='';
       h:='<img src="/image/';
       e:='" width=15 height=15>';
        case num of
            0:
             img:=h+'note.gif'+e;
            1:
             img:=h+'question.gif'+e;
            2:
             img:=h+'warning.gif'+e;
            3:
             img:=h+'feedback.gif'+e;
            4:
             img:=h+'idea.gif'+e;
            5:
             img:=h+'more.gif'+e;
            6:
             img:=h+'news.gif'+e;
            7:
             img:=h+'smile.gif'+e;
            8:
             img:=h+'sad.gif'+e;
            9:
             img:=h+'angry.gif'+e;
            10:
             img:=h+'agree.gif'+e;
            11:
             img:=h+'disagree.gif'+e;
           end;
        result:=img;
end;
procedure Twm.WebModule1WebActionItem1Action(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
    Response.content:=title.Content+ center.Content+foot.Content;
end;

procedure Twm.titleHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);

var
    s:string;
begin
        if tagstring='username' then
      begin
            s:=getsession('delphiuser');
           if s<>'' then
               ReplaceText:='当前用户:'+s+' <a href=/delphi/useredit?name='
               +s+'><font color=blue>修改资料</font></a>'+' <a href=/delphi/logout>  退出</a>' 
            else
               ReplaceText:='你还没有登陆!';
      end;

    if tagstring='date' then
       begin
         ReplaceText:=showdate;
       end;
     if tagstring='alluser' then
       begin
           ReplaceText:=showuser;
       end;
    if tagstring='curuser' then
      begin
          with cx do
           begin
             SQL.Clear;
             SQL.Add('select count(*) from fwrc');
             SQL.Add('where (sysdate-(5/60/24))<iptime');
             Open;
             ReplaceText:=fields[0].AsString;
           end;
      end;

end;


procedure Twm.wmshownewsAction(Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
var
  id,ssql:string;
begin
    id:=request.QueryFields.Values['id'];
     if id='' then
       SsQL:='select * from soft order by indate desc'
      else
        SsQL:='select * from soft  where num='+id;
     with cx do
     begin
        sql.clear;
        sql.add(ssql);
        open;
        response.Content:=newsfont.Content;
        close;
   end;
end;

procedure Twm.newsfontHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
begin
   if  TagString='datatitle' then
      ReplaceText:=cx.fieldbyname('name').asstring;
   if  TagString='dataindate' then
      ReplaceText:=cx.fieldbyname('indate').asstring;

    if  TagString='datanote' then
      ReplaceText:=txt2html(cx.fieldbyname('note').asstring);

   if  TagString='datahomepage' then
      ReplaceText:='<A href="'+cx.fieldbyname('homepage').asstring+'" target=_blank>'+cx.fieldbyname('homepage').asstring+'</a>';


end;

procedure Twm.centerHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
begin
   if tagstring='newtlshow' then
     begin
         ReplaceText:=newtlshow;
     end;
   if tagstring='homelink' then
     begin
         ReplaceText:=homelink;
     end;
   if tagstring='newsoft' then
     begin
       ReplaceText:=newsoft;
     end;
   if tagstring='newbook' then
     begin
       ReplaceText:=newbook;
     end;
    if tagstring='newjswz' then
     begin
       ReplaceText:=newjswz;
     end;
      

end;

procedure Twm.wmshowAction(Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
 var
    fname:string;
begin
  fname:=request.QueryFields.Values['type'];
  jthtml.HTMLFile:=pathname+'/'+fname+'.html';
  Response.Content:=title.Content+jthtml.Content+foot.Content;
end;

procedure Twm.WebModuleCreate(Sender: TObject);
var
   fconfig:Tinifile;
   fname:array[0..256] of char;
   path:string;
   i:integer;
begin