📄 function.asp

📁 这是去年开发的中移鼎讯手机进销存系统大家
💻 ASP
📖 第 1 页 / 共 2 页
字号:
12 下一页
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<%
Option Explicit
'On Error Resume Next
Dim Conn
Dim Rs,Sql
Dim i
Dim page,IsFor
page=request.QueryString("page")
'////////////////////////////////////////
'Const SqlDatabaseName = "AmccMobileSale"
'Const SqlPassword = "tx_)9898"
'Const SqlUsername = "tx_mobile"
'Const SqlLocalName = "61.132.133.180"
Const SqlDatabaseName = "Mobile_Sale"
Const SqlPassword = "666"
Const SqlUsername = "sa"
Const SqlLocalName = "(local)"
'////////////////////////////////////////
Sub ConnectionDatabase
	Dim ConnStr
	ConnStr = "Provider = Sqloledb; User ID = " & SqlUsername & "; Password = " & SqlPassword & "; Initial Catalog = " & SqlDatabaseName & "; Data Source = " & SqlLocalName & ";"
	Set conn = Server.CreateObject("ADODB.Connection")
	conn.open ConnStr
	If Err Then
		err.Clear
		Set Conn = Nothing
		Response.Write "数据库连接出错，请检查连接字串。"
		Response.End
	End If
End Sub
'============================================================================
Sub SQL_Open(rs_n,sql_n,conn_n,a,b)
	Set rs_n=Server.CreateObject("ADODB.recordset")
	rs_n.Open sql_n,conn_n,a,b
End Sub
'============================================================================ 
Sub Rs_End(rs_n)
	rs_n.Close
	Set rs_n=Nothing
End Sub
'============================================================================
Sub CONN_End(conn_n)
	conn_n.Close
	Set conn_n=Nothing
End Sub
'============================================================================
Function Sqlbug(bug)
	bug=Trim(bug)
	bug=replace(bug," ","　")
	bug=replace(bug," or ","　ＯＲ　")
	bug=replace(bug,"'","’")
	bug=replace(bug,",","，")
	sqlbug=bug
End Function
'============================================================================
Function ChkInputStr(InputStr)
	InputStr=trim(InputStr)
	InputStr=replace(InputStr,"<","&lt;")
	InputStr=replace(InputStr,">","&gt;")
	'InputStr=InputStr(sEnd,".","。")
	'InputStr=InputStr(sEnd,"/","／")
	ChkInputStr=InputStr
End Function
'判断是否是数字==============================================================
Sub Isnum(n,nn,Opt)
	If Not Isnumeric(n) then Call msg(nn&"必须为数字",Opt,"")
End Sub
'============================================================================

Sub Msg(sEnd, n,url)
Select Case n
    Case 1
       Response.Write ("<script>alert('" & sEnd & "');")
       Response.Write ("javascript:history.back(-1)</script>")
       Response.End
    Case 2
       Response.Write ("<script>alert('" & sEnd & "');</script>")
       Response.End
    Case 3
       Response.Write ("<script>alert('" & sEnd & "');</script>")
    Case 4
        Response.Write ("<script>alert('" & sEnd & "');</script>")
        Response.Write ("<body onLoad='setTimeout(window.close(), 10)'>")
    Case 5
        If Trim(Url)<>"" Then
            Response.Write ("<script>alert('" & sEnd & "');")
            Response.Write ("window.location='" & url & "'</script>")
        Else
            s ("必须提供跳转参数")
        End If
        Response.End()
    Case Else
        s ("参数不明")
End Select
End Sub
'===========================================================================================
'通用选项表过程：
'ClassTable，表名
'iID,按ID排序
'ShowTitle所显示出来的文字 
'jID,（可选）修改时可用。selected
'isAll 是否有全部
'///////////////////////////////////以后可加=[ShowWhere参数]显示的条件 Where "&ShowWhere&"
Sub Opt_N(ClassTable,iID,ShowTitle,jID,isAll)
	Dim Rs0,Sql0
	Dim StrOpt
	StrOpt=""
	Sql0="Select * from "&ClassTable&" Order by "&iID&" asc"
	Call sql_open(Rs0,Sql0,Conn,1,1)
	If Rs0.Eof and Rs0.Bof Then
		StrOpt = "<option>请先添加</option>"
	Else
	
	if isAll=1 then
		StrOpt = "<option value=0>全部……</option>"
	end if
	
		Do while Not Rs0.Eof
			StrOpt = StrOpt & "<option value="&Rs0(0)&""
			if jID<>"" then
				if Rs0(0)=Cint(jID) then
					StrOpt = StrOpt & " selected "
				End If
			end if
			StrOpt = StrOpt & ">"&Rs0(ShowTitle)&"</option>"
		Rs0.Movenext
		Loop
	End If
	Call Rs_End(Rs0)
	Response.write StrOpt
End Sub
'下拉框列表
'ClassTable	表名
'iID		按iID排列
'ShowTitle	下拉中所显示的
'jID		当前所在
'ShowWhere	条件(id>999)
Sub Opt_M(ClassTable,iID,ShowTitle,jID,ShowWhere,isAll)
	Dim Rs0,Sql0
	Dim StrOpt
	StrOpt=""
	Sql0="Select * from "&ClassTable&"  where "&ShowWhere&" Order by "&iID&" asc"
	Call sql_open(Rs0,Sql0,Conn,1,1)
	If Rs0.Eof and Rs0.Bof Then
		StrOpt = "<option>请先添加类别</option>"
	Else
	
	if isAll=1 then
		StrOpt = "<option value=0>全部……</option>"
	end if
		
		Do while Not Rs0.Eof
			StrOpt = StrOpt & "<option value="&Rs0(0)&""
			if jID<>"" then
				if Rs0(0)=Cint(jID) then
					StrOpt = StrOpt & " selected "
				End If
			end if
			StrOpt = StrOpt & ">"&Rs0(ShowTitle)&"</option>"
		Rs0.Movenext
		Loop
	End If
	Call Rs_End(Rs0)
	Response.write StrOpt
End Sub

'随机数
Function RndNum(N)
	Randomize'初始化随机种子
	Select Case N
		Case 4
			N = clng(9999*Rnd+1)
			If N<1000 Then N=N+999 '产生4位机数
		Case 8
			N = clng(99999999*Rnd+1)
			If N<10000000 Then N=N+9999999 '产生8位随机数
	End Select
	RndNum=N
End Function
' ============================================
' 格式化时间(显示)
' 参数：n_Flag
'	1:"yyyy-mm-dd hh:mm:ss"
'	2:"yyyy-mm-dd"
'	3:"hh:mm:ss"
'	4:"yyyy年mm月dd日"
'	5:"yyyymmdd"
'   6:"mm-dd"
' ============================================
Function Format_Time(s_Time, n_Flag)
	Dim y, y1, m, d, h, mi, s
	Format_Time = ""
	If IsDate(s_Time) = False Then Exit Function
	y = cstr(year(s_Time))
	y1 = cstr(right(year(s_Time),2))
	
	m = cstr(month(s_Time))
	If len(m) = 1 Then m = "0" & m
	d = cstr(day(s_Time))
	If len(d) = 1 Then d = "0" & d
	h = cstr(hour(s_Time))
	If len(h) = 1 Then h = "0" & h
	mi = cstr(minute(s_Time))
	If len(mi) = 1 Then mi = "0" & mi
	s = cstr(second(s_Time))
	If len(s) = 1 Then s = "0" & s
	Select Case n_Flag
	Case 1
		' yyyy-mm-dd hh:mm:ss
		Format_Time = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
	Case 2
		' yyyy-mm-dd
		Format_Time = y & "-" & m & "-" & d
	Case 3
		' hh:mm:ss
		Format_Time = h & ":" & mi & ":" & s
	Case 4
		' yyyy年mm月dd日
		Format_Time = y & "年" & m & "月" & d & "日"
	Case 5
		' yyyymmdd
		Format_Time = y & m & d
	Case 6
		' mm-dd
		Format_Time = m & "-" & d
	Case 7
		'yymmddhhmmss年月日时分秒
		Format_Time = y1 & m & d & h & mi & s	
	Case 8
		' yyyy年mm月dd日hh时mm分
		Format_Time = m & "-" & d & " " & h & ":" & mi
	Case 9
		' mm月dd日
		Format_Time = m & "-" & d 
	End Select
End Function
	'处理日期为2005-06-01格式
function RequestTime(RTime)
	Dim T,MM,DD
	T = split(RTime,"-")
	If Len(T(1))=1 then
		MM = "0"&T(1)
	else
		MM = T(1)
	end if
	If Len(T(2))=1 then
		DD = "0"&T(2)
	else
		DD = T(2)
	end if
	RequestTime = trim(T(0)&"-"&MM&"-"&DD)
end function
'===============================================================
'Page_Code(Rs_n,N)	分页函数
'Rs_n	记录集Rs	
'N	每页几条记录
'===============================================================
Sub Page_Code(Rs_n,N)
	if not Isnumeric(page) then
		Call Msg("页码应为数字",1,"")
	else
		page=cint(page)
	end if
	if not rs_n.eof then
		rs_n.pagesize=n
		if page < 1 then page = 1
		if page > rs_n.pagecount then page=rs_n.pagecount
		rs_n.Absolutepage=page
	end if
End sub
'===============================================================
'分页函数(第一页|下一页|上一页|最后一页  1/1页 共 4 条记录 )
'page_code_down(Rs_n,n,font)
'Rs_n	记录集
'
Sub Page_Code_Down(Rs_n,N,Font)
	Dim TempPath,FileName
	TempPath=Split(Request.ServerVariables("PATH_INFO"),"/")
	FileName=TempPath(Ubound(TempPath))
	Response.Write "<table align=""center"" width=100%/>" &vbcrlf
	Response.Write "<tr><td>" &vbcrlf
	
	if page<>1 then
		'Response.write "<a href="&FileName&n&">第一页</a>&nbsp;<a href="&FileName&n&"&page="&page-1&">上一页</a>&nbsp;"
		Response.write "<a href="&FileName&"?page=1"&n&">第一页</a>&nbsp;<a href="&FileName&"?page="&page-1&n&">上一页</a>&nbsp;"
	else
		Response.write "第一页&nbsp;上一页&nbsp;"	
	end if

	if page<>rs_n.pagecount then
		'Response.write "<a href="&FileName&n&"&page="&page+1&">下一页</a>&nbsp;<a href="&FileName&n&"&page="&rs_n.pagecount&">最后一页</a>"
		Response.write "<a href="&FileName&"?page="&page+1&n&">下一页</a>&nbsp;<a href="&FileName&"?page="&rs_n.pagecount&n&">最后一页</a>"
	else
		Response.write "下一页&nbsp;最后一页&nbsp;"
	end if

	Response.Write "</td>" &vbcrlf
	Response.Write "<td><font color=#FF0000><b>"&page&"</b></font>/"&rs_n.pagecount&"页</td>" &vbcrlf
	Response.Write "<td>共 <font color=#FF0000><b>"&rs_n.recordcount&"</b></font> "&font&"</td>" &vbcrlf
	Response.Write "</tr>" &vbcrlf
	Response.Write "</table>" &vbcrlf
End Sub

Sub PageCode(Rs_n,N,Font)
	Dim TempPath,FileName,K
	K=1
	TempPath=Split(Request.ServerVariables("PATH_INFO"),"?")
	FileName=TempPath(Ubound(TempPath))
	For K=1 to rs_n.pagecount
		Response.write "&nbsp;<a href="&FileName&n&"?page="&k&">"
		if K=page then 
			Response.write "<font color=#FF0000><b>"&K&"</b></font>"
		else
			Response.write ""&K&""
		end if
		Response.write  "</a>"
	Next
End Sub

'时间下拉(从多少到多少)
'FromNum		开始值
'ToNum			结束值
'SelNum			选中值
Sub tTime(FromNum,ToNum,SelNum)
	Dim StrTimeOpt,Ti
	
	if FromNum="" or ToNum="" then
		StrTimeOpt = StrTimeOpt &"<option>缺少参数</option>" 
	else
		for Ti=Cstr(FromNum) to Cstr(ToNum)
			StrTimeOpt = StrTimeOpt & "<option value="&Ti&""
			if SelNum<>"" then
				if Ti=Cint(SelNum) then
					StrTimeOpt = StrTimeOpt & " selected "
				End If
			end if
			StrTimeOpt = StrTimeOpt & ">"&Ti&"</option>"
		Next
	end if
	Response.Write StrTimeOpt
End Sub
''///////////防刷新///////////
Sub ReflashPage()
	Dim SplitReflashPage,DoReflashPage,shuaxin_time,ReflashTime
	DoReflashPage=true   
	shuaxin_time=20
	ReflashTime=Now()   
	if (not isnull(session("ReflashTime"))) and cint(shuaxin_time)>0 and DoReflashPage then   
		if DateDiff("s",session("ReflashTime"),Now())<cint(shuaxin_time) then   
			response.write "请不要刷新此页"   
			response.end   
		else   
			session("ReflashTime")=Now()   
		end if   
	elseif isnull(session("ReflashTime")) and cint(shuaxin_time)>0 and DoReflashPage then   
		Session("ReflashTime")=Now()   
	end if
End Sub
'//////////////////////////////////////////////////////
'申购数Request_Num()[市、县、分销点]
'UserPower	用户组
'UserID		用户ID(如果UserID不为空则统计其个人的申购数)
'CityID		用户所在的市
'CountyID	用户县ID
'Pro_ID		产品ID
'IsNew		是否为新增
'如果UserPower是9999则统计市县的申购数（不包括其分销点）。
'如果是市级则统计
function Request_Num(UserPower,UserID,CityID,CountyID,Pro_ID,IsNew,fromTime,toTime)
	Dim b
	b=0
	'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
	csql = "Select SUM(SubOrderTotal) as b From T_SubOrder Where CityID="&Cstr(CityID)&""
	If IsNew = 1  then
		if fromTime="" or toTime="" then
			csql = csql + " and DATEPART(dd, Intime)=DATEPART(dd, GETDATE()) "
		else
			csql = csql + " and convert(varchar(10),InTime,120) between  '"&fromTime&"' and '"&toTime&"' "
		end if
	end if
	if UserPower<>"" then
		csql = csql + " and UserGPower="&Cstr(UserPower)&" "
	end if
	if CountyID<>"" then
		csql = csql + " and CountyID="&Cstr(CountyID)&" "
	end if
	if Pro_ID<>"" then
		csql = csql + " and Pro_ID="&Cstr(Pro_ID)&" "
	end if
	if UserID<>"" then
		csql = csql + " and UserID="&Cstr(UserID)&" "
	end if
	'response.write csql
	Call sql_open(crs,csql,Conn,1,1)
	b = crs("b")
	if b="" or isnull(b) then 
		b=0
	end if
	call rs_end(crs)
	Request_Num = clng(b)
end function

''进货数[市、县、分销点]
function InPro_Num(UserPower,UserID,CityID,CountyID,Pro_ID,IsNew,fromTime,toTime)
	Dim b
	b=0
	csql ="Select SUM(Pro_Num) as b from T_SubOutOrder where CityID="&Cstr(CityID)&" and "	
	if IsNew = 1 then
		if fromTime="" or toTime="" then
			csql = csql + " DATEPART(dd, Intime)=DATEPART(dd, GETDATE()) and "
		else
			csql = csql + " convert(varchar(10),InTime,120) between  '"&fromTime&"' and '"&toTime&"' and "
12 下一页
⌨️ 快捷键说明

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