functions.asp

一个虚拟主机代理系统

					if cint(id) <> smumrs("groups_id") then
						getgroupssingle = getgroupssingle & "<option value="&smumrs("groups_id")&">"&smumrs("groups_groupname")&"</option>"
					else
						getgroupssingle = getgroupssingle & "<option selected value="&smumrs("groups_id")&">"&smumrs("groups_groupname")&"</option>"
					end if

				end if

			smumrs.movenext
			loop

			getgroupssingle = getgroupssingle & "</select>"

		end if

	smumClosers(smumrs)

End Function

Function getgroupname(id)

	smumquery = "select groups_groupname from smum_groupstbl where groups_id = "& id
	smumOpenrs smumquery,"smumrs",action

		if smumrs.eof then
			getgroupname = "None"
		else
			getgroupname = smumrs("groups_groupname")
		end if

	smumClosers(smumrs)

End Function

Sub smumregroup(group,username)

	dim id, smumgrouparray, i

	smumquery = "select members_id from smum_memberstbl where members_username = '"&username&"'"
	smumOpenrs smumquery,"smumrs1",action
	
		if smumrs1.eof then
			id = 0
		else
			id = smumrs1("members_id")
		end if

	smumClosers(smumrs1)

	smumquery = "delete from smum_usergroupstbl where usergroups_userid = "&id
	smumexecutequery smumquery,action

	smumgrouparray = split(group,",")

	For i = lbound(smumgrouparray) to ubound(smumgrouparray)

		smumquery = "insert into smum_usergroupstbl (usergroups_userid,usergroups_groupid) values ("&id&","&smumgrouparray(i)&")"
		smumexecutequery smumquery,action
		
	Next

End Sub

Sub smumrengenprefrences()

	dim query,whatever,mystring

	if not Application("smumdebugmode") then on error resume next

	query = "select * from smum_preferencestbl"
	smumOpenrs query,"smumrs",action
	
		if not smumrs.eof then
			For Each whatever In smumrs.fields
				Application.Lock
				MyString = "Application("""&whatever.name&""") = smumrs("""&whatever.name&""")"
				execute(mystring)
				Application.UnLock
			Next
		end if
		
	smumClosers(smumrs)

End Sub

Function smumgetusername(id)

	dim smumquery1

	smumquery1 = "select members_username from smum_memberstbl where members_id = "&id
	smumOpenrs smumquery1,"smumrs1",action

		if smumrs1.eof then
			smumgetusername = "Invalid Username"
		else
			smumgetusername = smumrs1("members_username")
		end if

	smumClosers(smumrs1)

End Function

Function smumdisplayform(checkval,formname,displayname)

	dim mystr

	if not checkval then
		mystr = formname &" = smFixer(request.form("""&formname&"""))"
		executeglobal mystr
		mystr = (formname &"text = ""&nbsp;<img src=/smusermanager/images/greenicon.gif border=0>""")
		executeglobal mystr
	else
		mystr = formname &" = smFixer(smChecknull("""&displayname&""", request.form("""&formname&"""), chkerror))"
		executeglobal mystr
		mystr = (formname & "text = ""&nbsp;<img src=/smusermanager/images/redicon.gif border=0>""")
		executeglobal mystr
	end if

End Function

Function getuserformatlisting(id,style,typ)

	dim smumquery1,n,listingar

	smumquery1 = "select * from smum_memberstbl where members_id = " & id
	smumOpenrs smumquery1,"smumrs1",action
	
		response.write "<tr><form>"
		listingar = split(Application("smumlistingfields"),",")

		For n = 0 to ubound(listingar)
			if smumrs1(trim(listingar(n)))<> "1/1/9000" then
				response.write "<td class=colorwhite align=center><font class=textsize9>"&smumrs1(trim(listingar(n)))&"&nbsp;</font></td>"
			else
				response.write "<td class=colorwhite align=center><font class=textsize9>&nbsp;</font></td>"		
			end if
		Next

		if typ = 1 then response.write "<td class=colorwhite align=center nowrap><font class=textsize9><a href="""&smumadminpage&"?action=editmember&id="&smumrs1("members_id")&"""><img src=/smusermanager/images/edit.gif border=0 align=absmiddle alt=""Edit Member""></a> | <a href="""&smumadminpage&"?action=deletemember&id="&smumrs1("members_id")&"""><img src=/smusermanager/images/delete.gif border=0 align=absmiddle alt=""Delete Member""></a> | <a href="""&smumadminpage&"?action=sendemail&id="&smumrs1("members_id")&"&name="&smumrs1("members_username")&"&email="&smumrs1("members_email")&"""><img src=/smusermanager/images/newmail.gif border=0 align=absmiddle alt=""Send Email""></a></font></td></form>"
		
		Response.Write "</tr>"
			
	smumClosers(smumrs1)

End Function

Function getdisplayformat(typ)

	dim smumquery1,n,listingar,tempstr
		
	tempstr = "<tr><form id=form2 name=form2>"
	tempstr=tempstr& "<td class=colorwhite align=center><font class=textsize9>item0a &nbsp;</font></td>"
	listingar = split(Application("smumlistingfields"),",")

	For n = 0 to ubound(listingar)
		tempstr=tempstr& "<td class=colorwhite align=center><font class=textsize9>item"&n+1&"a &nbsp;</font></td>"
	Next

	if typ = 1 then tempstr=tempstr&"<td class=colorwhite align=center nowrap><font class=textsize9><a href="""&smumadminpage&"?action=editmember&id=item0a""><img src=/smusermanager/images/edit.gif border=0 align=absmiddle alt=""Edit Member""></a> | <a href="""&smumadminpage&"?action=deletemember&id=item0a""><img src=/smusermanager/images/delete.gif border=0 align=absmiddle alt=""Delete Member""></a> | <a href="""&smumadminpage&"?action=sendemail&id=item0a""><img src=/smusermanager/images/newmail.gif border=0 align=absmiddle alt=""Send Email""></a></font></td></form>"

	tempstr=tempstr& "</tr>"
	getdisplayformat = tempstr

End Function

Function getheaderformat(id,istart)

	dim listingar,headerdataa,i,todo,keyword,sfield,field,accesslevel,group
	
	todo = request("todo")
	keyword = request("keyword")
	sfield = Request("sfield")
	field = Request("field")
	accesslevel = request("members_accesslevel")
	group = request("group")
		
	listingar = split(Application("smumlistingfields"),",")
	headerdataa = "<tr>"
	headerdataa = headerdataa & "<td class=colorformfields align=center nowrap>&nbsp;"
	headerdataa = headerdataa & "<a href="""&smumadminpage&"?action="&action&"&keyword="&keyword&"&sfield="&sfield&"&members_accesslevel="&accesslevel&"&group="&group&"&todo="&todo&"&id="&id&"&start="&istart&"&field=members_id&order=asc""><img src=/smusermanager/images/asc.gif border=0 align=absmiddle alt=""By Ascending Order""></a>"
	headerdataa = headerdataa & "<a href="""&smumadminpage&"?action="&action&"&keyword="&keyword&"&sfield="&sfield&"&members_accesslevel="&accesslevel&"&group="&group&"&todo="&todo&"&id="&id&"&start="&istart&"&field=members_id&order=desc""><img src=/smusermanager/images/desc.gif border=0 align=absmiddle alt=""By Descending Order""></a>&nbsp;"
	headerdataa = headerdataa & "<font class=textsize9><b>id</b></font>&nbsp;&nbsp;"
	headerdataa = headerdataa & "</td>"
	
	for i = 0 to ubound(listingar)
		headerdataa = headerdataa & "<td class=colorformfields align=center nowrap>&nbsp;"
		headerdataa = headerdataa & "<a href="""&smumadminpage&"?action="&action&"&keyword="&keyword&"&sfield="&sfield&"&members_accesslevel="&accesslevel&"&group="&group&"&todo="&todo&"&id="&id&"&start="&istart&"&field="&trim(listingar(i))&"&order=asc""><img src=/smusermanager/images/asc.gif border=0 align=absmiddle alt=""By Ascending Order""></a>"
		headerdataa = headerdataa & "<a href="""&smumadminpage&"?action="&action&"&keyword="&keyword&"&sfield="&sfield&"&members_accesslevel="&accesslevel&"&group="&group&"&todo="&todo&"&id="&id&"&start="&istart&"&field="&trim(listingar(i))&"&order=desc""><img src=/smusermanager/images/desc.gif border=0 align=absmiddle alt=""By Descending Order""></a>&nbsp;"
		headerdataa = headerdataa & "<font class=textsize9><b>"&replace(trim(listingar(i)),"members_","")&"</b></font>&nbsp;&nbsp;"
		headerdataa = headerdataa & "</td>"
	next
	headerdataa = headerdataa & "<td class=colorformfields align=center nowrap><font class=textsize9><b>Options</b></font></td>"

	getheaderformat = headerdataa								

End Function

Function getqueryformat()

	dim listingar,i,smumquery
	
	listingar = split(Application("smumlistingfields"),",")
	smumquery = "select members_id,"

	for i = 0 to ubound(listingar)
		
		if i <> ubound(listingar) then 
			smumquery = smumquery & listingar(i)&" , "
		else
			smumquery = smumquery & listingar(i)
		end if

	next
	smumquery = smumquery&" from smum_memberstbl"		

	getqueryformat = smumquery

End Function

Function smumgetfieldname(fieldnumber)

	dim fieldsar
	fieldsar = split(application("smumadditionalfields"),"|")
	smumgetfieldname = fieldsar(fieldnumber-1)

End Function

Function smumsendreminders()

	dim recordsexist, usersar, i, subject, content, result

	if smumdatabasetype = "MS SQL" then
		smumquery = "select members_expirydate,members_email,members_Firstname from smum_memberstbl where DATEDIFF(day,members_expirydate,members_date) ="& Application("smumexpirytrigger")
	else
		smumquery = "select members_expirydate,members_email,members_Firstname from smum_memberstbl where DATEDIFF('D',members_expirydate,members_date) ="& Application("smumexpirytrigger")
	end if
	
	smumOpenrs smumquery,"smumrs",action
	
		if smumrs.eof then
			recordsexist = false
		else
			recordsexist = true
			usersar = smumrs.getrows	
		end if
		
	smumClosers(smumrs)
	
	if recordsexist then
	
		for i = 0 to ubound(usersar,2)
			subject = "Expiry Reminder"
			content = replace(Application("smummemberexpired"), "$#name#$", usersar(2,i)) 
			result = sendmail(Application("smumadminemail"), usersar(1,i), Application("smumadminname"), usersar(2,i), Application("smummailserver"), subject, content, Application("smummailcomponent"))		
		next    
	
	end if
	
	Application.Lock
	Application("reminderdate")=Date
	Application.UnLock
	
End Function

Function checkip(id)

	dim ipdata,j,jdata,smumiparr
	checkip = true

	if Application("smumipsecurity") = 1 then
								
		smumquery1 = "select distinct(userlogs_ipaddress) from smum_userlogstbl where userlogs_userid = "& id
		smumOpenrs smumquery1,"smumrs1",action	

			if smumrs1.eof then
			else
										
				ipdata = ""	

				smumipar = smumrs1.getrows
			
				For j = 0 to ubound(smumipar,2)
					jdata = left(smumipar(0,j),(instrrev(smumipar(0,j),".")-1))
					jdata = left(jdata,(instrrev(jdata,".")-1))
					if instr(ipdata,jdata&"|") = 0 then ipdata = ipdata & jdata & "|"
				Next

				If ipdata <> "" then 
					smumiparr = split(ipdata,"|") 
					ipaddress = ubound(smumiparr)
				else
					ipaddress = 0
				end if
									
			end if
										

		smumClosers(smumrs1)

		If cint(Application("smummaxips")) <= cint(ipaddress) then checkip = false

	elseif Application("smumipsecurity") = 2 then

		dim smumquery1,smumipar,ipaddress
		smumquery1 = "select distinct(userlogs_ipaddress) from smum_userlogstbl where userlogs_userid = "& id
		smumOpenrs smumquery1,"smumrs1",action
		
			if smumrs1.eof then
			else
		
				smumipar = smumrs1.getrows
				ipaddress = (ubound(smumipar,2)+1)
		
				If cint(Application("smummaxips")) <= cint(ipaddress) then checkip = false
		
			end if
		
		smumClosers(smumrs1)
		
	end if

End Function						

Function smumexecutequery(query,filename)
	smumdataconn.execute(query)
End Function

Function smumOpenrs(query,recordset,filename)

	dim MyString 
	MyString = "set "&recordset&" = smumdataconn.execute(query)"
	execute(MyString)

End Function

Function smumClosers(recordset)

	recordset.close
	set recordset = nothing
	
End Function



%>