mainp.pas

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

            s:=s+' </tr>';
            next;
           end;
        end;
         SQl.Clear;
         SQL.Add('select ID from (');
         SQL.Add('select rownum AS NUM,A.* from ');
         SQL.Add('(select ID from  JSTL ');
         SQL.Add('where sj=0 and BZ=''T'' and ishead=''F'' ');
         SQL.Add('order by GXSJ DESC');
         SQL.Add(') A ');
         SQL.Add(' ) B');
         SQL.Add('where B.num>'+inttostr(start));
         Open;
         wz:=0;
         while ((WZ<showcount) and (not eof)) do
             begin
              sjid:=fieldbyname('ID').asstring;
              zcx.sql.Clear;
              zcx.SQL.Add('SELECT  ID,NAME,TITLE,TYPE,INDATE,DJ,LEVEL,ISLOCK  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;
              while not zcx.Eof do
                   begin
                     blanks:='';
                     news:='';
                     img:=getimg(zcx.fieldbyname('type').asinteger);
                     refs:='<a href="/delphi/showtl?ID='+zcx.fieldbyname('ID').asstring+'">';
                     for i:=1 to (zcx.fieldbyname('level').AsInteger-1) do
                         blanks:=blanks+'<img src="/image/blank.gif" width=15 height=15>';

                     if zcx.fieldbyname('level').AsInteger=1 then
                         s:=s+' <tr bgColor="#d6e3ff">'
                      else
                         s:=s+' <tr bgcolor="#FEFDED">';
                      news:='';
                      if zcx.FieldByName('ISLOCK').asstring='T' then
                       blanks:=blanks+'<font color=red>【锁定】</font>';
                      s:=s+gridtdhead+zcx.FieldByName('id').asstring+gridtdend;
                      s:=s+gridtdhead+blanks+img+refs+zcx.FieldByName('title').asstring+'</a>'+news+gridtdend;
                      if  (((sname=zcx.FieldByName('name').asstring) or isadmin) and (zcx.fieldbyname('level').AsInteger=1))then
                          begin
                          s:=s+gridtdhead+'<a href="/delphi/showuser?name='+zcx.FieldByName('name').asstring+'">'+zcx.FieldByName('name').asstring+'</a>'
                          +'<a href="/delphi/delmytj?id='+zcx.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='+zcx.FieldByName('name').asstring+'">'+zcx.FieldByName('name').asstring+'</a>'+gridtdend;
                      s:=s+gridtdhead+zcx.FieldByName('dj').asstring+gridtdend;
                      s:=s+gridtdheadnowrap+zcx.FieldByName('indate').asstring+gridtdend;
                      s:=s+' </tr>';
                      zcx.Next;
                   end; //zcx  while
            wz:=wz+1;
            next;
          end;// cx while
     end; //cx
     ReplaceText:=s;
     exit;//exit;
   end;
   with cx do
        begin
          SQl.Clear;
          SQL.Add('select count(*) as num from JSTL where SJ=0 and BZ=''T''');
          Open;
          tlcount:=fields[0].AsInteger;
        end;

     lt:=tlcount mod showcount;
     ys:= tlcount div showcount;
     if lt<>0 then
          ys:=ys+1;
     if strtoint(no)>ys then no:='1';


    if tagstring='pref' then
      begin
         if (strtoint(no) -1)>0 then
           ReplaceText:='<A href="/delphi/jstl?no='+inttostr(strtoint(no)-1)+'">'
         else
            ReplaceText:=''
      end;
    if tagstring='nref' then
      begin
        if strtoint(no)<ys then
           ReplaceText:='<A href="/delphi/jstl?no='+inttostr(strtoint(no)+1)+'">'
         else
            ReplaceText:=''
      end;
    if tagstring='lastref' then
      begin
         ReplaceText:='<A href="/delphi/jstl?no='+inttostr(ys)+'">'
      end;


  if tagstring='ys' then
    begin
     s:='';
     if tlcount>600 then
         tlcount:=600;
     lt:=tlcount mod showcount;
     ys:=tlcount div showcount;
     if lt<>0 then
       ys:=ys+1;
     for i:=1 to ys do
        begin
         if i<>(start div showcount+1) then
             s:=s+'<a href="/delphi/jstl?no='+inttostr(i)+'"><font class="pt9">['+inttostr(i)+']</font></a>'
           else
             s:=s+'<font color=red><b> '+inttostr(i)+'</b></font>';
        ReplaceText:=s;
     end;
    end;
end;

procedure Twm.lypageHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
const
   showcount=20;
var
  no:string;
  start:integer;
  tlcount:integer;
  lt,ys:integer;
  wz,i:integer;
  s,blanks,refs:string;
  sjid,img:string;
  allid,lastid,news:string;
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:='';
     with cx do
       begin
         SQL.Clear;
         SQL.Add('select max(Id) as num from LBLY');
         Open;
         allid:=fieldbyname('num').asstring;
         lastid:=getcookie('lastlbid');
         if lastid='' then lastid:='1';
         setcookie('lastlbid',allid,date+10000);

         SQl.Clear;
         SQL.Add('select ID from (');
         SQL.Add('select rownum AS NUM,A.* from ');
         SQL.Add('(select ID from  LBLY ');
         SQL.Add('where sj=0 and BZ=''T''');
         SQL.Add('order by GXSJ DESC');
         SQL.Add(') A ');
         SQL.Add(' ) B');
         SQL.Add('where B.num>'+inttostr(start));
         Open;
         wz:=0;
         while ((WZ<showcount) and (not eof)) do
             begin
              sjid:=fieldbyname('ID').asstring;
              zcx.sql.Clear;
              zcx.SQL.Add('SELECT  ID,NAME,TITLE,TYPE,INDATE,DJ,LEVEL FROM LBLY');
              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;
              while not zcx.Eof do
                   begin
                     blanks:='';
                     img:=getimg(zcx.fieldbyname('type').asinteger);
                     refs:='<a href="/delphi/showly?ID='+zcx.fieldbyname('ID').asstring+'">';
                     for i:=1 to (zcx.fieldbyname('level').AsInteger-1) do
                         blanks:=blanks+'<img src="/image/blank.gif" width=15 height=15>';

                     if zcx.fieldbyname('level').AsInteger=1 then
                         s:=s+' <tr bgColor="#d6e3ff">'
                      else
                         s:=s+' <tr bgcolor="#FEFDED">';
                      news:='';
                      if zcx.fieldbyname('id').asinteger>strtoint(lastid) then
                          news:='<img src="/image/new.gif">';
                      s:=s+gridtdhead+zcx.FieldByName('id').asstring+gridtdend;
                      s:=s+gridtdhead+blanks+img+refs+zcx.FieldByName('title').asstring+'</a>'+news+gridtdend;
                      s:=s+gridtdhead+'<a href=/delphi/showuser?name='+zcx.FieldByName('name').asstring+'>'+zcx.FieldByName('name').asstring+'</a>'+gridtdend;
                      s:=s+gridtdhead+zcx.FieldByName('dj').asstring+gridtdend;
                      s:=s+gridtdheadnowrap+zcx.FieldByName('indate').asstring+gridtdend;
                      s:=s+' </tr>';
                      zcx.Next;
                   end; //zcx  while
            wz:=wz+1;
            next;
          end;// cx while
     end; //cx
     ReplaceText:=s;
   end;
   with cx do
        begin
          SQl.Clear;
          SQL.Add('select count(*) as num from LBLY where SJ=0 and BZ=''T''');
          Open;
          tlcount:=fields[0].AsInteger;
        end;


         lt:=tlcount mod showcount;
         ys:= tlcount div showcount;
         if lt<>0 then
            ys:=ys+1;
         if strtoint(no)>ys then no:='1';


    if tagstring='pref' then
      begin
         if (strtoint(no) -1)>0 then
           ReplaceText:='<A href="/delphi/ly?no='+inttostr(strtoint(no)-1)+'">'
         else
            ReplaceText:=''
      end;
    if tagstring='nref' then
      begin
        if strtoint(no)<ys then
           ReplaceText:='<A href="/delphi/ly?no='+inttostr(strtoint(no)+1)+'">'
         else
            ReplaceText:=''
      end;
    if tagstring='lastref' then
      begin
         ReplaceText:='<A href="/delphi/ly?no='+inttostr(ys)+'">'
      end;

   if tagstring='ys' then
    begin
     s:='';
     if tlcount>400 then
         tlcount:=400;
     lt:=tlcount mod showcount;
     ys:=tlcount div showcount;
     if lt<>0 then
       ys:=ys+1;
     for i:=1 to ys do
        begin
         if i<>(start div showcount+1) then
             s:=s+'<a href="/delphi/ly?no='+inttostr(i)+'"><font class="pt9">['+inttostr(i)+']</font></a>'
           else
             s:=s+'<font color=red><b> '+inttostr(i)+'</b></font>';
        ReplaceText:=s;
     end;
    end;
end;

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

procedure Twm.fwtjpageHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
var
   stype:string;
begin
      stype:=request.QueryFields.Values['type'];
      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;

      if tagstring='fwtj' then
       begin

          if stype='' then
             ReplaceText:='day'
          else
            ReplaceText:=stype;
       end;

end;



procedure Twm.wmshowjstlAction(Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
var
   id,islock,faid,s:string;
   ts:Tstringlist;
//   f: textfile;
begin
  id:=request.QueryFields.Values['ID'];
  if id='' then
    begin
      response.SendRedirect('/delphi/showmsg?msg=没有你要的帖子!');
      exit;
    end;
  with cx do
   begin
    SQL.Clear;
    SQL.Add('select ID from JSTL');
    SQL.Add('where BZ=''T'' and ID=:id');
   params[0].AsString:=id;
    Open;
    if IsEmpty then
      begin
        response.SendRedirect('/delphi/showmsg?msg=没有你要的帖子!');
        exit;
      end;
    faid:=getfaid(id,'JSTL');
    SQL.Clear;
    SQL.Add('select islock from JSTL');
    SQL.Add('where  ID='+faID);
    Open;

    islock:=fieldbyname('islock').asstring;
    SQL.Clear;
    SQL.Add('Update JSTL set DJ=DJ+1 where  ID=:id');
    params[0].AsString:=id;
    ExecSQL;

    if  not FileExists(jstlpath+ID+'.html') then
     begin
      try
       ts:=tstringlist.Create;
       s:=showtlpage.Content;
       ts.Text:=s ;
       ts.SaveToFile(jstlpath+ID+'.html');
       ts.Free;
      except
        response.SendRedirect('/delphi/showmsg?msg=建立临时文件错误!');
        exit;
        end;
     end;
     if islock<>'T' then
          begin
                ts:=tstringlist.Create;
                ts.LoadFromFile(jstlpath+ID+'.html');
                s:=ts.Text;
                ts.Free;
                //jthtml.HTMLFile:=jstlpath+ID+'.html';
                //s:=jthtml.Content;
                jthtml.HTMLFile:=pathname+'/input.html';
                s:=s+jthtml.Content;
                Response.content:=title.Content+s+foot.Content;
             end
             else
               begin
                ts:=tstringlist.Create;
                ts.LoadFromFile(jstlpath+ID+'.html');
                s:=ts.Text;
                ts.Free;
               //  jthtml.HTMLFile:=jstlpath+ID+'.html';
               //  s:=jthtml.Content;
                 Response.content:=title.Content+s+'</form>'+foot.Content;
               end;
            exit;
       end;

end;

function Twm.getfaid(id, t: string): string;
var
  fid:string;
begin
   fid:=id;
   with cx do
     begin
      while True do
       begin
       SQL.Clear;
       SQl.Add('select ID,SJ from '+t+' where id='+fid);
       Open;
       if fieldbyname('SJ').asinteger=0 then
           begin
             result:=fieldbyname('ID').asstring;
             exit;
           end;
       fid:=fieldbyname('SJ').asstring;
      end;
  end;
end;

procedure Twm.showtlpageHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
var
  id,faid:string;
  blanks,img,refs:string;
  s:string;
  i:integer;
  ip:string;
begin
  id:=request.QueryFields.Values['ID'];
  if tagstring='id' then
   begin
      ReplaceText:=id;
   end;