mainp.pas

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

            s:=s+gridline2;
          s:=s+gridtdhead+'<a href="/delphi/soft?type='+fieldbyname('type').asstring+'">'+fieldbyname('type').asstring+'</a>' +gridtdend;
          s:=s+' </tr>';
          next;
          wz:=wz+1;
          end;
       s:=s+' </table>';
     end;
  result:=s;
end;

function Twm.showpage(allnum, showcount, no:integer;stype:string): string;
var
   lt:integer;
   ys:integer;
   i,start:integer;
   s:string;
begin
   start:=(no-1)*showcount;
   lt:=allnum mod showcount;
   ys:= allnum div showcount;
   if lt<>0 then
     ys:=ys+1;
   s:='';
   for i:=1 to ys do
    begin
     if i<>(start div showcount+1) then
         s:=s+' <a href="/delphi'+request.Pathinfo+'?no='+inttostr(i)+stype+'">['+inttostr(i)+']</a>'
       else
         s:=s+' <font color=red><b>'+inttostr(i)+'</b></font>';
    end;
    result:=s;
end;

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

function Twm.showbooktype(showcount, no: integer; where: string): string;
var
  s:string;
  wz:integer;
begin
   with cx do
     begin
      SQL.Clear;
      SQl.Add(' select distinct type   from book');
      SQL.add(where);
      Open;
     s:=gridhead+gridheadline;
     s:=s+gridtdhead+'资料类别'+gridtdend;
     s:=s+' </tr>';
     wz:=0;
    while ((wz<showcount) and  (not eof)) do
      begin
      if (wz mod 2)=0 then
        s:=s+gridline
       else
        s:=s+gridline2;
      s:=s+gridtdhead+'<a href="/delphi/book?type='+fieldbyname('type').asstring+'">'+fieldbyname('type').asstring+'</a>' +gridtdend;
      s:=s+' </tr>';
      next;
      wz:=wz+1;
    end;
   s:=s+' </table>';
  end;
  result:=s;

end;

procedure Twm.bookpageHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
const
  showcount=25;
var
  no:integer;
  s:string;
  where:string;
  stype:string;
begin
  stype:=request.QueryFields.Values['type'];
  if  stype='' then
       where:=''
      else
        where:='where type='''+stype+'''';
  if request.QueryFields.Values['no']='' then
        no:=1
        else
          begin
            s:=request.QueryFields.Values['no'];
            try
              no:=strtoint(s);
            except
               no:=1;
            end;
            if no<1 then no:=1;
          end;
   if TagString='booktype' then
     begin
       ReplaceText:=showbooktype(100,0,'');
     end;
   if TagString='bookpage' then
     begin
         with cx do
           begin
             SQL.Clear;
             SQL.Add('select count(*) from BOOK');
             SQL.Add(where);
             Open;
             ReplaceText:=showpage(fields[0].asinteger,showcount,no,'&type='+stype);
         end;
     end;
   if TagString='showbook' then
      begin
       ReplaceText:=showbook(showcount,no-1,where)
      end;
end;

function Twm.showjswz(showcount, no: integer; where: string): string;
var
  s:string;
  wz:integer;
  news:string;
begin
    with cx do
     begin
      SQL.Clear;
      SQL.Add('select ID,title,LRSJ,ZZ,DJ from JSWZ ');
      SQL.Add(where);
      SQL.Add('order by LRSJ desc ');
      Open;
      moveby(showcount*no);
     s:=gridhead+gridheadline;
     s:=s+gridtdhead+'文章'+gridtdend;
     s:=s+gridtdhead+'发表日期'+gridtdend;
     s:=s+gridtdhead+'作者'+gridtdend;
     s:=s+gridtdhead+'点击'+gridtdend;
     s:=s+' </tr>';
     wz:=0;
    while ((wz<showcount) and  (not eof)) do
      begin
         news:='';
      if (now-fieldbyname('LRSJ').AsDateTime)<3 then
        news:='<img src="/image/new9.gif">';
      if (wz mod 2)=0 then
        s:=s+gridline
       else
        s:=s+gridline2;
        
      s:=s+gridtdhead+news+'<a href="/delphi/showwz?id='
          +fieldbyname('id').asstring+'"   target="_blank">'+'<font color="#0000ff">'+fieldbyname('title').asstring+'</font></a>'+gridtdend;
      s:=s+gridtdhead+fieldbyname('lrsj').asstring+gridtdend;
      s:=s+gridtdhead+fieldbyname('zz').asstring+gridtdend;
      s:=s+gridtdhead+fieldbyname('dj').asstring+gridtdend;
      s:=s+' </tr>';
      next;
      wz:=wz+1;
    end;
   s:=s+' </table>';
  end;
  result:=s;

end;

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

procedure Twm.jswzpageHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
const
  showcount=20;
var
   no:integer;
   s:string;
begin
  if request.QueryFields.Values['no']='' then
        no:=1
        else
          begin
            s:=request.QueryFields.Values['no'];
            try
              no:=strtoint(s);
            except
               no:=1;
            end;
            if no<1 then no:=1;
          end;
  if TagString='jswz' then
    begin
     ReplaceText:=showjswz(showcount,no-1,'');
    end;
   if TagString='jswzpage' then
     begin
         with cx do
           begin
             SQL.Clear;
             SQL.Add('select count(*) from JSWZ');
             //SQL.Add(where);
             Open;
             ReplaceText:=showpage(fields[0].asinteger,showcount,no,'');
         end;

     end;


end;

procedure Twm.wmlinkAction(Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
begin
  jthtml.HTMLFile:=pathname+'/link.html';
  Response.Content:=title.Content+jthtml.Content+foot.Content;
end;

procedure Twm.wmshowwzAction(Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
var
   id:string;
   wzname:string;
begin
  id:=request.QueryFields.Values['id'];
  if id='' then
     begin
       id:='1';
     end;
  if strtoint(id)<1 then
    id:='1';
  with sqlc do
    begin
      SQL.Clear;
      SQL.Add('update jSWZ set DJ=DJ+1 where ID=:id');
      params[0].AsString:=id;
      ExecSQl;
    end;
  with cx do
   begin
     SQL.Clear;
     SQL.add('select WZNAME from JSWZ where  ID=:id');
     params[0].AsString:=id;
     OPen;
    wzname:=fields[0].AsString;

   end;
  response.SendRedirect('/wz/'+wzname);
end;

procedure Twm.wmloginAction(Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
var
   suser,spass:string;
begin
  //path:=request.QueryFields.Values['wz'];
  suser:=request.ContentFields.Values['user'];
  spass:=request.ContentFields.Values['pass'];
   setsession('delphiuser','');
   with cx do
     begin
       SQL.Clear;
       SQL.Add('select * from YHK where upper(NAME)=:name');
       params[0].AsString:=UpperCase(suser);
       Open;
       if isempty then
          begin
            response.SendRedirect('/delphi/showmsg?msg=用户不存在或密码错误!');
            exit;
          end;
        if fieldbyname('PASSWORD').Asstring<>spass then
          begin
            response.SendRedirect('/delphi/showmsg?msg=用户不存在或密码错误!');
            exit;
          end;
         setsession('delphiuser',suser);

     end;
     with sqlc do
       begin
         SQL.Clear;
         sql.Add('update YHK set lasttime=sysdate  where NAME=:name');
         params[0].AsString:=suser;
         ExecSQL;
       end;
     response.SendRedirect('/delphi/jstl');
end;

procedure Twm.wmjstlAction(Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
var
 no,s:string;
 ts:Tstringlist;
begin
   { no:=request.QueryFields.Values['no'];
    if ((no='') or (no='1')) then
    begin
      if  FileExists(jstlpath+'index.html') then
         begin
              try
               ts:=tstringlist.Create;
               ts.LoadFromFile(jstlpath+'index.html');
               s:=ts.Text;
               ts.Free;
               Response.content:=title.Content+s+foot.Content;
              except
                exit;
               end;
           exit;
         end
        else
          begin
             protlindex;
             try
                ts:=tstringlist.Create;
                ts.LoadFromFile(jstlpath+'index.html');
                s:=ts.Text;
                ts.Free;
                Response.content:=title.Content+s+foot.Content;
                except
                exit;
             end;
           exit;
          end;
    end;         }
   Response.content:=title.Content+jstlpage.Content+foot.Content;
end;

procedure Twm.jstlpageHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
const
   showcount=25;
var
  no:string;
  start:integer;
  tlcount:integer;
  lt,ys:integer;
  wz,i:integer;
  s,blanks,refs:string;
  sjid,img:string;
  news,sname:string;
  isadmin:boolean;
begin
  if tagstring='zcyh' then
    begin
      with cx do
        begin
          SQl.Clear;
          SQL.Add('select count(*) from YHK');
          Open;
          ReplaceText:=fields[0].asstring;
          exit;
        end;
    end;




  no:=request.QueryFields.Values['no'];
   if no='' then
      begin
        start:=0;
        no:='1';
       end
      else
         start:=(strtoint(no)-1)*showcount;


  if tagstring='jstlmx' then
   begin
      s:='';
      sname:=getsession('delphiuser');
     with cx do
        begin
          SQL.clear;
          SQL.Add('select * from YHK where name=:name');
          Params[0].AsString:=sname;
          OPen;
          if fieldbyname('ADMIN').asstring='T' then
              isadmin:=True
            else
              isadmin:=False;
         

        if no='1' then
        begin
         SQL.Clear;
         SQL.Add('select ID,NAME,TITLE,TYPE,INDATE,DJ FROM JSTL');
         SQL.Add('where sj=0 and BZ=''T'' and ishead=''T''');
         OPen;
          while not eof do
           begin
            blanks:='<font color=red>【置顶】</font>';
            s:=s+' <tr bgcolor="#FEFDED">';
            img:=getimg(fieldbyname('type').asinteger);
            refs:='<a href="/delphi/showtl?ID='+fieldbyname('ID').asstring+'">';
            s:=s+gridtdhead+FieldByName('id').asstring+gridtdend;
            s:=s+gridtdhead+blanks+img+refs+FieldByName('title').asstring+'</a>'+news+gridtdend;


            if  ((sname=FieldByName('name').asstring) or isadmin) then
              begin
            s:=s+gridtdhead+'<a href="/delphi/showuser?name='+FieldByName('name').asstring+'">'+FieldByName('name').asstring+'</a>'
              +'<a href="/delphi/delmytj?id='+fieldbyname('ID').asstring+'"><image src="/image/del.gif" border=0 width=15 height=15></a>'+gridtdend;
              end
              else
                s:=s+gridtdhead+'<a href="/delphi/showuser?name='+FieldByName('name').asstring+'">'+FieldByName('name').asstring+'</a>'
                +gridtdend;
            sjid:=fieldbyname('ID').asstring;
            zcx.sql.Clear;
            zcx.SQL.Add('SELECT count(*)  FROM JSTL');
            zcx.SQL.Add('START WITH id='+sjid);
            zcx.SQL.Add('CONNECT BY PRIOR ID=SJ');
            zcx.SQL.Add('ORDER SIBLINGS BY indate desc');
            zcx.Open;
            s:=s+gridtdhead+FieldByName('dj').asstring+'('+zcx.fields[0].asstring+')'+gridtdend;
            s:=s+gridtdheadnowrap+FieldByName('indate').asstring+gridtdend;