mainp.pas

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

  if tagstring='title' then
   begin
    with cx do
      begin
        SQL.Clear;
        SQL.Add('select title from JSTL where ID=:id');
        params[0].AsString:=id;
        Open;
        ReplaceText:=fields[0].asstring;
      end;
   end;
  if tagstring='username' then
   begin
    with cx do
      begin
        SQL.Clear;
        SQL.Add('select name from JSTL where ID=:id');
        params[0].AsString:=id;
        Open;
        ReplaceText:=fields[0].asstring;
      end;
   end;
   if tagstring='note' then
   begin
    with cx do
      begin
        SQL.Clear;
        SQL.Add('select NOTE from JSTL where ID=:id');
        params[0].AsString:=id;
        Open;
        ReplaceText:=txt2html(fields[0].asstring);
        close;
      end;
   end;
   if tagstring='iploc' then
     begin
       with cx do
         begin
            SQL.Clear;
            SQL.Add('select ip from JSTL where ID=:id');
            params[0].AsString:=id;
            Open;
            ip:=fields[0].AsString;
            if ip<>'' then
              begin
                  SQL.Clear;
                  SQL.Add('select * from ip地址 t');
                  SQl.Add('where :ip>=ipnum1 and :ip<=ipnum2');
                  Params[0].AsFloat:=encodeip(ip);
                  Open;
                   ReplaceText:=fieldbyname('loc').AsString;
             end;
         end;
     end;



   if tagstring='tltree' then
     begin
       s:='';
       faid:=getfaid(id,'JSTL');
       with cx do
         begin
             sql.Clear;
             SQL.Add('SELECT  ID,NAME,TITLE,TYPE,INDATE,DJ,LEVEL FROM JSTL');
             SQL.Add('START WITH id='+faid);
             SQL.Add('CONNECT BY PRIOR ID=SJ');
             SQL.Add('ORDER SIBLINGS BY indate desc');
             Open;
              while not Eof do
                   begin
                     blanks:='';
                     img:=getimg(fieldbyname('type').asinteger);
                     refs:='<a href="/delphi/showtl?ID='+fieldbyname('ID').asstring+'">';
                     for i:=1 to (fieldbyname('level').AsInteger-1) do
                       blanks:=blanks+'<img src="/image/blank.gif" width=15 height=15>';
                      s:=s+' <tr >';
                      s:=s+gridtdhead+blanks+img+refs+FieldByName('title').asstring+'</a>'+gridtdend;
                      s:=s+gridtdhead+'<a href="/delphi/showuser?name='+FieldByName('name').asstring+'">作者:'+FieldByName('name').asstring+'</a>'+gridtdend;
                      //s:=s+gridtdhead+FieldByName('dj').asstring+gridtdend;
                      s:=s+gridtdheadnowrap+'发表时间:'+FieldByName('indate').asstring+gridtdend;
                      s:=s+' </tr>';
                       Next;
                   end;
            end;
          ReplaceText:=s;
     end;
end;

procedure Twm.wmtlpostAction(Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
var
  title,cname,comments,note:string;
  num:integer;
  sjid,faid:string;
begin
   sjid:=request.QueryFields.Values['id'];
   title:=request.ContentFields.Values['subject'];
   cname:=getsession('delphiuser');// request.ContentFields.Values['name'];
  // cpass:=request.ContentFields.Values['pass'];
   comments:=request.ContentFields.Values['comments'];
   if title='' then
      begin
            response.SendRedirect('/delphi/showmsg?msg=没有输入主题!');
            exit;
       end;
   if comments=''   then
        title:=title+'(无内容)'
     else
       title:=title+'('+inttostr(length(comments))+'字节)';

    if cname='' then
      begin
            response.SendRedirect('/delphi/showmsg?msg=请你先登陆！');
            exit;
       end;
   with cx do
     begin
      if sjid<>'0' then  //非新发贴子
        begin
            SQL.Clear;
            SQL.Add('select id from JSTL where ID='+sjid);
            Open;
            if IsEmpty then
            begin
                  response.SendRedirect('/delphi/showmsg?msg=没有你要的帖子!');
                  exit;
             end;
         end;
      SQL.Clear;
      SQL.add('select NOTE from YHK where NAME='''+cname+'''');
      OPen;
      note:=fields[0].AsString;
      SQL.Clear;
      SQL.Add('select max(ID) as NUM from jstl');
      Open;
      if IsEmpty then
          num:=1
       else
          num:=fields[0].asinteger;
      end;

     with sqlc do
      begin
       SQL.Clear;
       SQl.Add('INSERT INTO JSTL (ID ,NAME ,TITLE ,TYPE ,INDATE,SJ,BZ,GXSJ,DJ,NOTE ,ISLOCK,ISHEAD,IP)');
       SQL.Add('VALUES (:p0,:p1,:p2,:p3,sysdate,:p4,''T'',sysdate,0, :note,''F'',''F'',:IP)');
       Params[0].Asinteger:=num+1;
       Params[1].Asstring:=cname;
       Params[2].Asstring:=title;
       Params[3].asstring:=request.ContentFields.Values['MessageType'];
       Params[4].asstring:=sjid;
       Params[5].ParamType:=ptinput;
       Params[5].AsMemo:=comments+'<hr>'+note;
       Params[6].Asstring:=request.RemoteAddr;
       ExecSQL;
       if sjid<>'0' then
         begin
          faid:=getfaid(sjid,'JSTL');
          SQL.Clear;
          SQL.Add('select ishead from JSTL where ID='+faid);
          open;
          if fields[0].asstring<>'T' then
           begin
              SQL.Clear;
              SQL.Add('update JSTL set gxsj=sysdate where ID='+faid);
              ExecSQL;
           end;
           sql.Clear;
           SQL.Add('SELECT  ID FROM JSTL');
           SQL.Add('START WITH id='+faid);
           SQL.Add('CONNECT BY PRIOR ID=SJ');
           SQL.Add('ORDER SIBLINGS BY indate desc');
           Open;
            while not Eof do
               begin
                     porctlpage(fieldbyname('id').asstring);
                     Next;
               end;
           end;
       end;
     protlindex;
    response.SendRedirect('/delphi/jstl');
end;

procedure Twm.newtlpageHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
begin
  if TagString='id' then
     ReplaceText:='0';
end;

procedure Twm.wmnewtlAction(Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
begin
  Response.content:=title.Content+newtlpage.Content+foot.Content;
end;



procedure Twm.wmuserregAction(Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
begin
   Response.content:=title.Content+userregpage.Content+foot.Content;
end;

procedure Twm.wmnewuserAction(Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
var
   sname,pass1,pass2,email,homepage,from,note:string;
   num:integer;
begin
   sname:=request.ContentFields.Values['name'];
   pass1:=request.ContentFields.Values['pass1'];
   pass2:=request.ContentFields.Values['pass2'];
   email:=request.ContentFields.Values['email'];
   homepage:=request.ContentFields.Values['homepage'];
   from:=request.ContentFields.Values['from'];
   note:=request.ContentFields.Values['note'];
   if ((pass1='') or (pass2='')) then
     begin
       response.SendRedirect('/delphi/showmsg?msg=请输入密码!');
       exit;
     end;
   if pass1<>pass2 then
     begin
        response.SendRedirect('/delphi/showmsg?msg=密码不一致!');
        exit;
     end;
   if sname='' then
     begin
       response.SendRedirect('/delphi/showmsg?msg=没有输入用户名!');
       exit;
     end;
   if length(sname)<6 then
     begin
       response.SendRedirect('/delphi/showmsg?msg=用户名不得小于6个字符!');
       exit;
     end;
    if length(sname)>20 then
      begin
        response.SendRedirect('/delphi/showmsg?msg=用户名太长!');
       exit;
      end;
    if length(pass1)>20 then
      begin
        response.SendRedirect('/delphi/showmsg?msg=密码太长!');
       exit;
      end;
      if length(email)>50 then
      begin
        response.SendRedirect('/delphi/showmsg?msg=密码太长!');
       exit;
      end;

      if length(homepage)>100 then
      begin
        response.SendRedirect('/delphi/showmsg?msg=主页太长!');
       exit;
      end;
      if length(from)>200 then
      begin
        response.SendRedirect('/delphi/showmsg?msg=住址太长!');
       exit;
      end;

       if length(note)>1000 then
      begin
        response.SendRedirect('/delphi/showmsg?msg=签名太长!');
       exit;
      end;
    with cx do
     begin
       SQL.Clear;
       SQl.Add('select count(*) as num from yhk');
       SQL.Add('where upper(name)='''+UpperCase(sname)+'''');
       Open;
       if fields[0].AsInteger<>0 then
         begin
           response.SendRedirect('/delphi/showmsg?msg=该名称已经有人注册!');
           exit;
         end;
        SQL.Clear;
        SQL.Add('select max(ID) from  YHK');
        OPen;
        if IsEmpty then
         num:=1
        else
         num:=fields[0].AsInteger+1;
       end;
      with sqlc do
       begin
        SQL.Clear;
        SQL.Add('INSERT INTO YHK (ID ,NAME ,PASSWORD,EMAIL ,HOMEPAGE ,ADR,INDATE,BZ,NOTE )' );
        SQL.Add('VALUES ( :p0,:p1,:p2,:p3,:p4,:p5,sysdate,''T'',:p6)');
        Params[0].AsInteger:=num;
        Params[1].AsString:=sname;
        Params[2].AsString:=pass1;
        Params[3].AsString:=email;
        Params[4].AsString:=homepage;
        Params[5].AsString:=from;
        Params[6].AsString:=note;
        ExecSQL;
        response.SendRedirect('/delphi/showmsg?msg=恭喜你,注册成功!');
      end;
end;

procedure Twm.wmdownloadAction(Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
var
  wz,num,sname:string;

begin
  num:=request.QueryFields.Values['num'];
  if num='' then
    begin
      response.SendRedirect('/delphi/showmsg?msg=没有你要的文件!');
      exit;
    end;
  with cx do
   begin
      SQL.Clear;
      SQL.Add('select loc,name from soft where num='+num);
      Open;
      if IsEmpty then
        begin
          response.SendRedirect('/delphi/showmsg?msg=没有你要的文件!');
          exit;
        end;
       wz:=fields[0].asstring;
       sname:=fields[1].asstring;
    end;
    with sqlc do
     begin
       SQL.Clear;
       SQL.Add('update soft set dnum=dnum+1 where num='+num);
       ExecSQL;
       response.Content:='<a href="'+softpath+wz+'">'+sname+'</a>';
    end;
end;

procedure Twm.wmdownloadbookAction(Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
var
  wz,num:string;

begin
  num:=request.QueryFields.Values['num'];
  if num='' then
    begin
      response.SendRedirect('/delphi/showmsg?msg=没有你要的文件!');
      exit;
    end;
  with cx do
   begin
      SQL.Clear;
      SQL.Add('select loc from book where num='+num);
      Open;
      if IsEmpty then
        begin
          response.SendRedirect('/delphi/showmsg?msg=没有你要的文件!');
          exit;
        end;
       wz:=fields[0].asstring;
    end;
    with sqlc do
     begin
       SQL.Clear;
       SQL.Add('update book set dnum=dnum+1 where num='+num);
       ExecSQL;
       response.Content:='<a href="'+bookpath+wz+'">下载</a>';
    end;

end;



procedure Twm.wmsoftplAction(Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
var
  id:string;
  
begin
  id:=request.QueryFields.Values['id'];
  if id='' then
    begin
      response.SendRedirect('/delphi/showmsg?msg=无效ID!');
      exit;
    end;
   with cx do
    begin
       SQL.Clear;
       SQL.Add('select NAME from SOFT where NUM='+ID);
       Open;
       if isempty then
        begin
          response.SendRedirect('/delphi/showmsg?msg=无效ID!');
          exit;
        end;
      end;
    response.Content:=title.Content+softpl.Content+foot.Content;

end;

procedure Twm.softplHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
const
   showcount=10;
var
  s,spage:string;
  id:string;
  softname:string;
  page,i:integer;
begin
  id:=request.QueryFields.Values['id'];
 if tagstrin