手机WAP编程

开发平台：
ASP/ASPX

wml.ini：源码内容
							﻿<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%session.CodePage="65001"%>
<!--#include file="conn.ini"-->
<!--#include file="ImageClass.asp"-->
<!--#include file="SqlClass.asp"-->
<!--#include file="md5.asp"-->
<!--#include file="UtilClass.asp"-->
<!--#include file="Spider.Asp"-->
<%
Randomize
Sub WMLbegin(Title,p)
	Dim strMain, getNumber
	Response.ContentType = "text/vnd.wap.wml; charset=UTF-8"
	strMain = "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf
	strMain = strMain & "<!DOCTYPE wml PUBLIC ""-//WAPFORUM//DTD WML 1.1//EN"" ""http://www.wapfourm.org/DTD/wml_1.1.xml"">" & vbCrLf
	strMain = strMain & "<wml>" & vbCrLf
	strMain = strMain & "<head>" & vbCrLf
	'strMain = strMain & "<meta http-equiv=""Cache-Control"" content=""no-Cache"" />" & vbCrLf
	strMain = strMain & "<meta http-equiv=""Cache-Control"" content=""max-age=0"" />" & vbCrLf
	strMain = strMain & "</head>" & vbCrLf
	If Trim(title) = "" Then
		strMain = strMain & "<card title=""标题"">" & vbCrLf
	Else
		strMain = strMain & "<card title=""" & Title & titlestr & """>" & vbCrLf
	End If 
  'wrap
	strMain = strMain & "<p mode=""" & p & """>" & vbCrLf
'response.redirect "http://brmei.com/link/gourl.asp?id=1000_133"
	Call WMLWrite(strMain, false)
End Sub
Sub WMLGobegin(Title,u,Key)
	Dim strMain, getNumber
	Response.ContentType = "text/vnd.wap.wml; charset=UTF-8"
	strMain = "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf
	strMain = strMain & "<!DOCTYPE wml PUBLIC ""-//WAPFORUM//DTD WML 1.1//EN"" ""http://www.wapfourm.org/DTD/wml_1.1.xml"">" & vbCrLf
	strMain = strMain & "<wml>" & vbCrLf
	strMain = strMain & "<head>" & vbCrLf
	'strMain = strMain & "<meta http-equiv=""Cache-Control"" content=""no-Cache"" />" & vbCrLf
	strMain = strMain & "<meta http-equiv=""Cache-Control"" content=""max-age=0"" />" & vbCrLf
	strMain = strMain & "</head>" & vbCrLf
	If Trim(title) = "" Then
		strMain = strMain & "<card title=""标题"">" & vbCrLf
	Else
		strMain = strMain & "<card title=""" & Title & titlestr & """>" & vbCrLf
	End If 
	    strMain = strMain & "<onevent type=""onenterforward"">" & vbCrLf
		strMain = strMain & "<go href=""" & u & """ method=""post"">" & vbCrLf
		strMain = strMain & "<postfield name=""Key"" value=""" & Key & """/>" & vbCrLf
      
		strMain = strMain & "</go>" & vbCrLf
		strMain = strMain & "</onevent>" & vbCrLf
  'wrap
	strMain = strMain & "<p>" & vbCrLf
	Call WMLWrite(strMain, false)
End Sub
function sqlstr(data)
   sqlstr="'" & Replace(data,"'","''") & "'"
  End function
Sub WMLend()
Call WMLWrite("<br/>--------------------", true)
response.Write("<a href='/Message/Index.Asp'>客服</a> QQ:84554888<br/>")
response.Write("书签:<a href='wapck_com.SIS'>" & Request.ServerVariables("HTTP_HOST")) & "</a><br/>" & titlestr
'Call WMLWrite("<small>©2009 " & Request.ServerVariables("HTTP_HOST") & "</small>", true)
Call WMLWrite("<small>粤ICP备06097356号</small>", true)
  if wap.ipType(wap.ip())<>0 then
  %>
<%
  end if
	Call WMLWrite("</p>" & vbCrLf & "</card>" & vbCrLf & "</wml>", False)
End Sub
Sub WMLWrite(strMain,isNewline)
	If isNewline = True Then 
		strMain = strMain & "<br/>"
	End If 
	Response.Write(strMain & vbCrLf)
End Sub
Sub WMLT(strMain,isNewline)
	If isNewline = True Then 
		strMain = strMain & "<br/>"
	End If 
	Response.Write(strMain & vbCrLf)
End Sub
Function WMLLink(linkURL, linkText, isNewline)
	Dim temp,url,par,parN,parV,i
temp = "<a href=""" & linkURL & """ title=""" & linkText & """>" & linkText & "</a>"
	Call WMLWrite(temp, isNewline)
End Function 
Function WMLLink1(linkURL, linkText, isNewline)
	Dim temp,url,par,parN,parV,i
	if InStr(linkURL,"?") > 0 Then
		url = Mid(linkURL, 1, InStr(linkURL, "?")-1)
		par = Split(Mid(linkURL, InStr(linkURL, "?")+1), "&amp;")
		For i = 0 To UBound(par)
			parN = Mid(par(i), 1, InStr(par(i), "=")-1)
			parV = Mid(par(i), InStr(par(i), "=")+1)
			If parN <> "" And parV <> "" Then
				If InStr(url,"?")>0 Then 
					url = url & "&amp;"
				Else
					url = url & "?"
				End If
				url = url & parN & "=" & parV
			End If
	         Next
            url=url
	Else
		url = linkURL
	End If
temp = "【<a href=""" & url & """ title=""" & linkText & """>" & linkText & "</a>】"
	Call WMLWrite(temp, isNewline)
End Function
Function WMLLink2(linkURL, Text,linkText, isNewline)
	Dim temp,url,par,parN,parV,i
	if InStr(linkURL,"?") > 0 Then
		url = Mid(linkURL, 1, InStr(linkURL, "?")-1)
		par = Split(Mid(linkURL, InStr(linkURL, "?")+1), "&amp;")
		For i = 0 To UBound(par)
			parN = Mid(par(i), 1, InStr(par(i), "=")-1)
			parV = Mid(par(i), InStr(par(i), "=")+1)
			If parN <> "" And parV <> "" Then
				If InStr(url,"?")>0 Then 
					url = url & "&amp;"
				Else
					url = url & "?"
				End If
				url = url & parN & "=" & parV
			End If
	         Next
            url=url
	Else
		url = linkURL
	End If
temp = "" & Text & ".<a href=""" & url & """ title=""" & linkText & """>" & linkText & "</a>"
	Call WMLWrite(temp, isNewline)
End Function  
Function WMLImg(ImgURL, ImgText, isNewline)
	Dim temp,url,par,parN,parV,i
	if InStr(ImgURL,"?") > 0 Then
		url = Mid(ImgURL, 1, InStr(ImgURL, "?")-1)
		par = Split(Mid(ImgURL, InStr(ImgURL, "?")+1), "&amp;")
		For i = 0 To UBound(par)
			parN = Mid(par(i), 1, InStr(par(i), "=")-1)
			parV = Mid(par(i), InStr(par(i), "=")+1)
			If parN <> "" And parV <> "" Then
				If InStr(url,"?")>0 Then 
					url = url & "&amp;"
				Else
					url = url & "?"
				End If
				url = url & parN & "=" & parV
			End If
	         Next
            url=url
	Else
		url = ImgkURL
	End If
	temp = "<img src=""" & ImgURL & """ alt=""" & ImgText & """/>"
	Call WMLWrite(temp, isNewline)
End Function
Function WMLImgs(ImgURL, ImgText, isNewline)
	Dim temp,url,par,parN,parV,i
	if InStr(ImgURL,"?") > 0 Then
		url = Mid(ImgURL, 1, InStr(ImgURL, "?")-1)
		par = Split(Mid(ImgURL, InStr(ImgURL, "?")+1), "&amp;")
		For i = 0 To UBound(par)
			parN = Mid(par(i), 1, InStr(par(i), "=")-1)
			parV = Mid(par(i), InStr(par(i), "=")+1)
			If parN <> "" And parV <> "" Then
				If InStr(url,"?")>0 Then 
					url = url & "&amp;"
				Else
					url = url & "?"
				End If
				url = url & parN & "=" & parV
			End If
	         Next
            url=url
	Else
		url = ImgkURL
	End If
	
	temp = "<img src=""" & ImgURL & """ alt=""" & ImgText & """ height=""90"" width=""90""/>"
	Call WMLWrite(temp, isNewline)
End Function
Function WMLImgl(ImgURL, ImgText, linkURL,linkText, isNewline)
	Dim temp,url,urls,par,parN,parV,i
	if InStr(ImgURL,"?") > 0 Then
		url = Mid(ImgURL, 1, InStr(ImgURL, "?")-1)
		par = Split(Mid(ImgURL, InStr(ImgURL, "?")+1), "&amp;")
		For i = 0 To UBound(par)
			parN = Mid(par(i), 1, InStr(par(i), "=")-1)
			parV = Mid(par(i), InStr(par(i), "=")+1)
			If parN <> "" And parV <> "" Then
				If InStr(url,"?")>0 Then 
					url = url & "&amp;"
				Else
					url = url & "?"
				End If
				url = url & parN & "=" & parV
			End If
	         Next
            url=url
	Else
		url = ImgkURL
	End If
	
	temp = "<a href=""" & linkURL & """ title=""" & linkText & """><img src=""" & ImgURL & """ alt=""" & ImgText & """ /></a>"
	Call WMLWrite(temp, isNewline)
End Function
'------------------------------------------------------------------------------------------------------
Sub WMLCompart()
	Call WMLWrite("---------------", True)
End Sub
Sub Closers()
		rs.close
		Set rs=nothing
End Sub
Sub Closers1()
		rs1.close
		Set rs1=nothing
End Sub
	
	
Class AnalysisDAOClass
	
	Public Function list(ByVal s,m)
		if(s=0) then
        	sql="SELECT * FROM analysis WHERE (CONVERT(CHAR(7),adate,120))='"&m&"' ORDER BY adate"
		else
			sql="SELECT (CONVERT(CHAR(7),adate,120)) AS adate,sum(pic_new) AS pic_new,sum(pic_view) AS pic_view,sum(ad_view) AS ad_view,sum(pic_down) AS pic_down FROM analysis group by (CONVERT(CHAR(7),adate,120)) ORDER BY adate"
		end if
        Set list=getRecordSet(conn,sql,1,1)
    End Function
    Public Sub analyze(ByVal d,c)
        sql="SELECT anid FROM analysis WHERE adate='"&d&"'"
        Set DAORS=getRecordSet(conn,sql,1,1)
		if(not DAORS.eof) then
			conn.execute("UPDATE analysis SET "&c&"="&c&"+1 WHERE anid="&DAORS("anid"))
		else
			conn.execute("INSERT INTO analysis(adate,"&c&") VALUES('"&d&"',1)")
		end if
		DAORS.close
        Set DAORS=nothing
    End Sub
	
End Class
Class StatDAOClass
	
    Public Function list(ByVal s,c,id,m)
		if(s=0) then
        	sql="SELECT * FROM stat WHERE "&c&"="&id&" AND (CONVERT(CHAR(7),sdate,120))='"&m&"' ORDER BY sdate"
		else
			sql="SELECT (CONVERT(CHAR(7),sdate,120)) AS sdate,sum(view_count) AS view_count,sum(down_count) AS down_count FROM stat WHERE "&c&"="&id&" group by (CONVERT(CHAR(7),sdate,120)) ORDER BY sdate"
		end if
        Set list=getRecordSet(conn,sql,1,2)
    End Function
	
	Public Sub analyze(ByVal d,c1,id,c2)
        sql="SELECT stid FROM stat WHERE sdate='"&d&"' AND "&c1&"="&id
        Set DAORS=getRecordSet(conn,sql,1,2)
        aaaaa=DAORS.RecordCount
		if(not DAORS.eof) then
			conn.execute("UPDATE stat SET "&c2&"="&c2&"+1 WHERE stid="&DAORS("stid"))
		else
			conn.execute("INSERT INTO stat(sdate,"&c1&","&c2&") VALUES('"&d&"',"&id&",1)")
		end if
		DAORS.close
        Set DAORS=nothing
    End Sub
	
End Class
  
    Public Function load(ByVal id)
        Set load=new PictureEntity
        sql="SELECT * FROM Album WHERE id="&id
        Set DAORS=getRecordSet(conn,sql,1,2)
        if not DAORS.eof then
            load.setPid(DAORS("id"))
            load.setTitle(DAORS("Album_Title"))
           
            load.setAdd_time(DAORS("add_time"))
            load.setPic_count(DAORS("pic_count"))
            load.setView_count(DAORS("view_count"))
            load.setDown_count(DAORS("down_count"))
            load.setDown_count_f(DAORS("down_count_f"))
            load.setDown_count_today(DAORS("down_count_today"))
            load.setDown_count_yes(DAORS("down_count_yes"))
            load.setDown_count_week(DAORS("down_count_week"))
            load.setDown_count_month(DAORS("down_count_month"))
            load.setComment_count(DAORS("comment_count"))
            load.setU_count(DAORS("u_count"))
            load.setD_count(DAORS("d_count"))
            load.setT_count(DAORS("t_count"))
            load.setE_count(DAORS("e_count"))
            load.setIs_dcount(DAORS("is_dcount"))
            load.setLast_update_time(DAORS("last_update_time"))
            load.setLast_view_time(DAORS("last_view_time"))
            load.setLast_down_time(DAORS("last_down_time"))
			load.setLast_commend_time(DAORS("last_commend_time"))
        else
            Set load=nothing
        end if
        DAORS.close
        Set DAORS=nothing
    End Function
Class PictureEntity
    Private pid,title,cid,caid,sid,url,preface,add_time,pic_count,view_count,down_count,down_count_f,down_count_today,down_count_yes,down_count_week,down_count_month,comment_count,u_count,d_count,t_count,e_count,is_display,is_commend,is_top,is_index,is_dcount,is_fcount,fcount_num,last_update_time,last_view_time,last_down_time,last_commend_time,is_cut
    Public Sub setPid(ByVal pid_)
        pid=pid_
    End Sub
    Public Function getPid()
        getPid=pid
    End Function
    Public Sub setTitle(ByVal title_)
        title=title_
    End Sub
    Public Function getTitle()
        getTitle=title
    End Function
    Public Sub setCid(ByVal cid_)
        cid=cid_
    End Sub
    Public Function getCid()
        getCid=cid
    End Function
    Public Sub setCaid(ByVal caid_)
        caid=caid_
    End Sub
    Public Function getCaid()
        getCaid=caid
    End Function
    Public Sub setSid(ByVal sid_)
        sid=sid_
    End Sub
    Public Function getSid()
        getSid=sid
    End Function
    Public Sub setUrl(ByVal url_)
        url=url_
    End Sub
    Public Function getUrl()
        getUrl=url
    End Function
    Public Sub setPreface(ByVal preface_)
        preface=preface_
    End Sub
    Public Function getPreface()
        getPreface=preface
    End Function
    Public Sub setAdd_time(ByVal add_time_)
        add_time=add_time_
    End Sub
    Public Function getAdd_time()
        getAdd_time=add_time
    End Function
    Public Sub setPic_count(ByVal pic_count_)
        pic_count=pic_count_
    End Sub
    Public Function getPic_count()
        getPic_count=pic_count
    End Function
    Public Sub setView_count(ByVal view_count_)
        view_count=view_count_
    End Sub
    Public Function getView_count()
        getView_count=view_count
    End Function
    Public Sub setDown_count(ByVal down_count_)
        down_count=down_count_
    End Sub
    Public Function getDown_count()
        getDown_count=down_count
    End Function
    Public Sub setDown_count_f(ByVal down_count_f_)
        down_count_f=down_count_f_
    End Sub
    Public Function getDown_count_f()
        getDown_count_f=down_count_f
    End Function
    Public Sub setDown_count_today(ByVal down_count_today_)
        down_count_today=down_count_today_
    End Sub
    Public Function getDown_count_today()
        getDown_count_today=down_count_today
    End Function
    Public Sub setDown_count_yes(ByVal down_count_yes_)
        down_count_yes=down_count_yes_
    End Sub
    Public Function getDown_count_yes()
        getDown_count_yes=down_count_yes
    End Function
    Public Sub setDown_count_week(ByVal down_count_week_)
        down_count_week=down_count_week_
    End Sub
    Public Function getDown_count_week()
        getDown_count_week=down_count_week
    End Function
    Public Sub setDown_count_month(ByVal down_count_month_)
        down_count_month=down_count_month_
    End Sub
    Public Function getDown_count_month()
        getDown_count_month=down_count_month
    End Function
    Public Sub setComment_count(ByVal comment_count_)
        comment_count=comment_count_
    End Sub
    Public Function getComment_count()
        getComment_count=comment_count
    End Function
    Public Sub setU_count(ByVal u_count_)
        u_count=u_count_
    End Sub
    Public Function getU_count()
        getU_count=u_count
    End Function
    Public Sub setD_count(ByVal d_count_)
        d_count=d_count_
    End Sub
    Public Function getD_count()
        getD_count=d_count
    End Function
    Public Sub setT_count(ByVal t_count_)
        t_count=t_count_
    End Sub
    Public Function getT_count()
        getT_count=t_count
    End Function
    Public Sub setE_count(ByVal e_count_)
        e_count=e_count_
    End Sub
    Public Function getE_count()
        getE_count=e_count
    End Function
    Public Sub setIs_display(ByVal is_display_)
        is_display=is_display_
    End Sub
    Public Function getIs_display()
        getIs_display=is_display
    End Function
    Public Sub setIs_commend(ByVal is_commend_)
        is_commend=is_commend_
    End Sub
    Public Function getIs_commend()
        getIs_commend=is_commend
    End Function
    Public Sub setIs_top(ByVal is_top_)
        is_top=is_top_
    End Sub
    Public Function getIs_top()
        getIs_top=is_top
    End Function
    Public Sub setIs_index(ByVal is_index_)
        is_index=is_index_
    End Sub
    Public Function getIs_index()
        getIs_index=is_index
    End Function
    Public Sub setIs_dcount(ByVal is_dcount_)
        is_dcount=is_dcount_
    End Sub
    Public Function getIs_dcount()
        getIs_dcount=is_dcount
    End Function
    Public Sub setIs_fcount(ByVal is_fcount_)
        is_fcount=is_fcount_
    End Sub
    Public Function getIs_fcount()
        getIs_fcount=is_fcount
    End Function
    Public Sub setFcount_num(ByVal fcount_num_)
        fcount_num=fcount_num_
    End Sub
    Public Function getFcount_num()
        getFcount_num=fcount_num
    End Function
    Public Sub setLast_update_time(ByVal last_update_time_)
        last_update_time=last_update_time_
    End Sub
    Public Function getLast_update_time()
        getLast_update_time=last_update_time
    End Function
    Public Sub setLast_view_time(ByVal last_view_time_)
        last_view_time=last_view_time_
    End Sub
    Public Function getLast_view_time()
        getLast_view_time=last_view_time
    End Function
    Public Sub setLast_down_time(ByVal last_down_time_)
        last_down_time=last_down_time_
    End Sub
    Public Function getLast_down_time()
        getLast_down_time=last_down_time
    End Function
    Public Sub setLast_commend_time(ByVal last_commend_time_)
        last_commend_time=last_commend_time_
    End Sub
    Public Function getLast_commend_time()
        getLast_commend_time=last_commend_time
    End Function
    Public Sub setIs_cut(ByVal is_cut_)
        is_cut=is_cut_
    End Sub
    Public Function getIs_cut()
        getIs_cut=is_cut
    End Function
End Class
	Function getRecordSet(ByRef objConn,ByVal strSql,ByVal intCusorNum,ByVal intLockNum)
		Set getRecordSet=Server.CreateObject("Adodb.RecordSet")
		getRecordSet.cursorLocation=3
		getRecordSet.open strSql,objConn,cint(intCusorNum),cint(intLockNum)
	End Function
Set wap=new UtilClass
function outHTM(str)
if str="" or isnull(str) then
	tohtm=str
	exit function
end if
outHTM = replace(str,"&","&amp;")
outHTM = replace(outHTM,"","&quot;")
outHTM = replace(outHTM,"<","&lt;")
outHTM = replace(outHTM,">","&gt;")
outHTM = replace(outHTM," ","")
outHTM = replace(outHTM,"$","$$")
outHTM = replace(outHTM,"&#39;","'")
outHTM = replace(outHTM,vbnewline,"<br/>")
end function
%>
<!--#include file="Typesetting.asp"-->
<!--#include file="ads.asp"-->

						