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

📄 xbqq1_function.asp

📁 欢迎使用酷航设计系统
💻 ASP
📖 第 1 页 / 共 3 页
字号:
🔍
123 
    else
    response.write Gaobei_NewsTitle
    end if
    response.write "</a>"
    response.write "</td></tr></table>"
    End Function
%>
<%
    '//广告调用
    Function xbqq_AD(AD_ID)
    set ADRS=server.createobject("adodb.recordset")
    sql="select top 1 AD_ID,AD_Title,AD_Http,AD_width,blank,AD_height,AD_Pic,AD_Note from Advertise where AD_ID="&AD_ID&""
    ADRS.open sql,conn,1,1
    Pi_c=ADRS("Ad_pic")
    If ADRS.bof Then
    Response.write"没有广告"
    Else
    %>
		<%
			IF right(Pi_c,3)="swf" THEN
		%><p align="center">
		
		<OBJECT classid="clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"
 codebase="http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,0,0"
  WIDTH="<% =ADRS("AD_width") %>" HEIGHT="<% =ADRS("AD_height")%>" id="welcome" >
 <PARAM NAME=movie VALUE="<% =Pi_c %>"> 
 <PARAM NAME=quality VALUE=high>
 <EMBED src="<% =Pi_c %>" quality=high   WIDTH="<%=AD_width%>" HEIGHT="<%=AD_height%>" NAME="welcome" ALIGN="" TYPE="application/x-shockwave-flash" PLUGINSPAGE="http://www.macromedia.com/go/getflashplayer"></EMBED>
</OBJECT>
</p>

<%else%><%
    if ADRS("AD_http")="" then
    Response.Write("<div align=center>")
    Response.Write("<img src="&ADRS("Ad_Pic")&" width="&ADRS("Ad_width")&" height="&ADRS("Ad_height")&" border=""0""><div>")
    else
    if ADRS("blank")=true then
    Response.Write("<div align=center><a target='_blank' href="&ADRS("Ad_Http")&">")
    Response.Write("<img src="&ADRS("Ad_Pic")&" width="&ADRS("Ad_width")&" height="&ADRS("Ad_height")&" border=""0""></a><div>")
    else
    Response.Write("<div align=center><a href="&ADRS("Ad_Http")&">")
    Response.Write("<img src="&ADRS("Ad_Pic")&" width="&ADRS("Ad_width")&" height="&ADRS("Ad_height")&" border=""0""></a><div>")
    end if
    end if
    end if
    End If
    End Function
%><%'=============================================以下为待处理内容%><%
    Function isInt(str)
    Dim L,I
    isInt=False
    If Trim(Str)="" Or IsNull(str) Then Exit Function
    str=CStr(Trim(str))
    L=Len(Str) 
    For I=1 To L
    If Mid(Str,I,1)>"9" Or Mid(Str,I,1)<"0" Then Exit Function
    Next 
    isInt=True
    End Function
%><%
    Function GetLen(str)
    Dim l, t, c, i
    l = Len(str)
    t = l
    For i = 1 To l
    c = Asc(Mid(str, i, 1))
    If c < 0 Then c = c + 65536
    If c > 255 Then t = t + 1
    Next
    GetLen = t
    End Function
%><%
    Function CheckStr(Str) 
    If Trim(Str)="" Or IsNull(str) Then Exit Function
    Checkstr=Replace(Trim(Str),"'","''")
    End Function
%><%
    Function LeftStr(text,length)  
    Dim t
    t=""
    Dim mt
    Dim l
    l=0
    Dim c
    For i= 1 To Len(text)
    mt=mid(text,i,1)
    c=Asc(mt)
    If c<0 Then c=c+65536
    If c > 255 Then
    l=l+2
    Else 
    l=l+1
    End If
    If l<=CLng(length) Then
    t=t&mt
    else
    exit for
    End If
    Next
    LeftStr=t
    End Function
%><%
    Function post_chk()
    dim server_v1,server_v2
    post_chk=False
    server_v1=Request.ServerVariables("HTTP_REFERER")
    server_v2=Request.ServerVariables("SERVER_NAME")
    if mid(server_v1,8,len(server_v2))=server_v2 then post_chk=True:exit function
    end Function
%>
<%
    Rem Pw_Sys 把空格换成&nbsp和把换行换成<br>
    function Pw_changstr(str)
    str=Replace(str, Chr(32), "&nbsp;")'
    str=Replace(str, vbCrLf, "<br>") '把换行换成<br>
    response.Write(""&str&"")
    end function
%>

<%

Rem Pw_Sys 日期格式转换函数

function DateTimeFormat(DateTime,Format) 
select case Format
case "1"
 DateTimeFormat=""&year(DateTime)&"年"&month(DateTime)&"月"&day(DateTime)&"日"
case "2"
 DateTimeFormat=""&month(DateTime)&"月"&day(DateTime)&"日"
case "3" 
 DateTimeFormat=""&year(DateTime)&"-"&month(DateTime)&"-"&day(DateTime)&""
case "4" 
 DateTimeFormat=""&year(DateTime)&"/"&month(DateTime)&"/"&day(DateTime)&""
case "5"
 DateTimeFormat=""&month(DateTime)&"/"&day(DateTime)&""
case "6"
 DateTimeFormat=""&year(DateTime)&"年"&month(DateTime)&"月"&day(DateTime)&"日<font color=red> "&FormatDateTime(DateTime,4)&"</font>"
case "7"
   temp="星期日,星期一,星期二,星期三,星期四,星期五,星期六"
   temp=split(temp,",") 
   DateTimeFormat=temp(Weekday(DateTime)-1)
case else
 DateTimeFormat=DateTime
end select
end function

%>

<%
Rem Pw_Sys 栏目的显示
Sub Gaobei_ShowSort()
response.write "<table width=""90%"" border=""0"" align=""center"" cellpadding=""1"" cellspacing=""1"">"& vbCrLf
Set Rs=conn.execute("select * from Sort where B_id=0 and setting order by S_order")
if Rs.eof and Rs.bof then
response.write "还没有任何栏目"
else
do while not Rs.eof
set names=rs("names")
set id=rs("id")
response.write "<tr><td colspan=""2"">"& vbCrLf
response.write "<a href=Sort.asp?SortID="&ID&">"&names&"</a>"
response.write "</td></tr><tr> "& vbCrLf
if Rs("Setting")<5  and Rs("Setting")<>3 then
Set RsClass=Conn.Execute("Select * from Sort where B_ID="& Rs("ID") &" order by S_Order")
do while not RsClass.eof
response.write "<tr><td width=""36%"" align=""right""><img src=""Images/xbqq_skin/Gaobei_ico.gif"" width=""12"" height=""11"" align=""absmiddle""></td>"& vbCrLf
response.write "<td width=""64%"">"& vbCrLf
response.write "<a href='Class.asp?ClassID="&trim(RsClass("ID"))&"'>"&trim(RsClass("Names"))&"</a>"
response.write "</td></tr><tr> "& vbCrLf
RsClass.movenext
loop
RsClass.close
set RsClass=nothing
end if 
Rs.movenext
loop  
end if  
Rs.close  
set Rs=nothing
response.write "</table>"& vbCrLf
End sub


Function NoPic(Gaobei_DisInfo)
response.write "<table width=""100"" border=""0"" align=""center"" cellpadding=""3"" cellspacing=""3""><tr> "& vbCrLf
response.write "<td><img src=""Images/xbqq_skin/ku_nopic.gif"" border=""0""></td>"& vbCrLf
response.write "</tr><tr><td height=""18"">"& vbCrLf
response.write "<div align=""center"">"&Gaobei_DisInfo&"</div></td>"& vbCrLf
response.write "</tr></table>"& vbCrLf
End Function

Function Gaobei_ShowPic(Gaobei_Pic,Gaobei_InfoID,Gaobei_Title,Gaobei_long)
response.write "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""0""><tr><td>"& vbCrLf
response.write "<TABLE width=""50"" border=0 align=center cellPadding=0 cellSpacing=0>"& vbCrLf
response.write "<TR><TD height=8><IMG height=8 src=""Images/table/bg_0ltop.gif"" width=8></TD>"& vbCrLf
response.write "<TD background=Images/table/bg_01.gif height=8></TD>"& vbCrLf
response.write "<TD height=8><IMG height=8 src=""Images/table/bg_0rtop.gif"" width=8></TD></TR>"& vbCrLf
response.write "<TR><TD width=8 background=Images/table/bg_03.gif></TD>"& vbCrLf
response.write "<TD width=""50"" height=""90"" align=""center"" bgColor=#ffffff><a href=ViewInfo.asp?id="&Gaobei_InfoID&" Title='"&Gaobei_Title&"'><img src="&Gaobei_Pic&" border=0 width="&imageswidth&" height="&imagesheight&" ></a></TD>"& vbCrLf
response.write "<TD width=8 background=Images/table/bg_04.gif></TD>"& vbCrLf
response.write "</TR><TR><TD height=8><IMG height=8 src=""Images/table/bg_0lbottom.gif"" width=8></TD>"& vbCrLf
response.write "<TD background=Images/table/bg_02.gif height=8></TD>"& vbCrLf
response.write "<TD height=8><IMG height=8 src=""Images/table/bg_0rbottom.gif"" width=8></TD>"& vbCrLf
response.write "</TR></TABLE>"& vbCrLf
response.write "</td></tr><tr><td align=center height=18>"& vbCrLf
response.write "<a href=ViewInfo.asp?id="&Gaobei_InfoID&" title='"&Gaobei_Title&"'>"
if GetLen(Gaobei_Title)>Gaobei_long then
response.write LeftStr(Gaobei_Title,Gaobei_long-2)
response.write "..."
else
response.write Gaobei_Title
end if
response.write "</a>"

response.write "</td></tr></table>"& vbCrLf
End Function

Function Gaobei_ShowTopPic(Top_num)
response.write "<TABLE cellSpacing=5 cellPadding=0 width=""100%"" align=center border=0><TBODY><TR vAlign=top>"& vbCrLf
sql="select  top "&Top_num&" * from Info where Ispic=1 and Pw_Good=True ORDER BY AddDate DESC,ID desc"
Set Rstop=conn.execute(Sql)
if Rstop.eof or Rstop.bof then
Call NoPic("无推荐图文信息")
end if
do while not Rstop.eof 
response.write "<TD height=82 align=middle>"
 Call Gaobei_ShowPic(Rstop("Pic"),Rstop(0),Rstop("Title"),120,98,18) 
response.write "</TD>"
Rstop.movenext  
loop
response.write "</TR></TBODY></TABLE>"
Rstop.close
set Rstop=nothing
End Function
Dim MyCount : MyCount="http://www.gaobei.com"
Sub Showlink(ltype,L_num)
  dim rsl,strTemp,l
  l=1
  if not ltype="" then
    ltype=1
  end if
  set rsl=conn.execute("select top "&L_num&" * from links where style="&ltype&" order by id desc")
  strTemp="<table border='0' cellspacing='0' cellpadding='0' align='center'width='100%'><tr>"
  
  do until rsl.eof
    if ltype>0 then
     strTemp=strTemp&"<td align=left height=21>&nbsp;&nbsp;<a href='"&rsl("link")&"' title='网站名称："&rsl("name")&chr(13)&"网站简介："&rsl("note")&"' target=_blank>"&rsl("name")&"</a></td>"
	else
	 strTemp=strTemp&"<td align=left height=21>&nbsp;&nbsp;<a href='"&rsl("link")&"' title='网站名称："&rsl("name")&chr(13)&"网站简介："&rsl("note")&"' target=_blank>"&rsl("name")&"</a></td>"
	end if
	 if l mod 2 =0 then
	   strTemp=strTemp&"</tr><tr>"
	 end if
  rsl.movenext
  l=l+1
  loop
  rsl.close
  set rsl=nothing
  strTemp=strTemp&"</tr></table>"
  response.write strTemp
End Sub

%>


<% '以下为原图片的format.asp里的文件。%>
<%
function cutstr(str,strlen,more,url)
if len(str)>strlen then
	 str=left(str,strlen) & "......"
end if
if (len(str)>strlen) and more then
  str=str+"&nbsp;&nbsp;&nbsp;[url="+url+"]点这里查看详情[/url]"
end if
cutstr=str
end function

function strLength(str)
       ON ERROR RESUME NEXT
       dim WINNT_CHINESE
       WINNT_CHINESE    = (len("论坛")=2)
       if WINNT_CHINESE then
          dim l,t,c
          dim i
123

⌨️ 快捷键说明

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