📄 inc_functions.asp

📁 此程序是一个个人主页创造程序,该程序无插件,无任何恶意程序.
💻 ASP
📖 第 1 页 / 共 5 页
字号:
				Monthname(Mid(fDate,5,2),0)
			case else
				ChkDate2 = Mid(fDate,5,2) & strMid & _
				Mid(fDate,7,2) & strMid & _
				Mid(fDate,1,4)
		End Select
	'end if
end function

function ChkTime(fTime)
	if fTime = "" then
		exit function
	end if

	if strTimeType = 12 then
		if cint(Mid(fTime, 9,2)) > 12 then
			ChkTime = ChkTime & " " & _
			(cint(Mid(fTime, 9,2)) -12) & ":" & _
			Mid(fTime, 11,2) & ":" & _
			Mid(fTime, 13,2) & " " & "PM"
		elseif cint(Mid(fTime, 9,2)) = 12 then
			ChkTime = ChkTime & " " & _
			cint(Mid(fTime, 9,2)) & ":" & _
			Mid(fTime, 11,2) & ":" & _
			Mid(fTime, 13,2) & " " & "PM"
		elseif cint(Mid(fTime, 9,2)) = 0 then
			ChkTime = ChkTime & " " & _
			(cint(Mid(fTime, 9,2)) +12) & ":" & _
			Mid(fTime, 11,2) & ":" & _
			Mid(fTime, 13,2) & " " & "AM"
		else
			ChkTime = ChkTime & " " & _
			Mid(fTime, 9,2) & ":" & _
			Mid(fTime, 11,2) & ":" & _
			Mid(fTime, 13,2) & " " & "AM"
		end if
		
	else
		ChkTime = ChkTime & " " & _
		Mid(fTime, 9,2) & ":" & _
		Mid(fTime, 11,2) & ":" & _
		Mid(fTime, 13,2)
	end if
end function

function ChkTimeShort(fTime)
	if fTime = "" then
		exit function
	end if

	if strTimeType = 12 then
		if cint(Mid(fTime, 9,2)) > 12 then
			ChkTimeShort = ChkTimeShort & " " & _
			(cint(Mid(fTime, 9,2)) -12) & ":" & _
			Mid(fTime, 11,2) & ":" & _
			Mid(fTime, 13,2) & " " & "PM"
		elseif cint(Mid(fTime, 9,2)) = 12 then
			ChkTimeShort = ChkTimeShort & " " & _
			cint(Mid(fTime, 9,2)) & ":" & _
			Mid(fTime, 11,2) & ":" & _
			Mid(fTime, 13,2) & " " & "PM"
		elseif cint(Mid(fTime, 9,2)) = 0 then
			ChkTimeShort = ChkTimeShort & " " & _
			(cint(Mid(fTime, 9,2)) +12) & ":" & _
			Mid(fTime, 11,2) & ":" & _
			Mid(fTime, 13,2) & " " & "AM"
		else
			ChkTimeShort = ChkTimeShort & " " & _
			Mid(fTime, 9,2) & ":" & _
			Mid(fTime, 11,2) & ":" & _
			Mid(fTime, 13,2) & " " & "AM"
		end if
		
	else
		ChkTimeShort = ChkTimeShort & " " & _
		Mid(fTime, 9,2) & ":" & _
		Mid(fTime, 11,2)
	end if
end function

function EmailField(fTestString)
	TheAt = Instr(2, fTestString, "@")
	if TheAt = 0 then
		EmailField = 0
	else
		TheDot = Instr(cint(TheAt) + 2, fTestString, ".")
		if TheDot = 0 then
			EmailField = 0
		else
			if cint(TheDot) + 1 > Len(fTestString) then
				EmailField = 0
			else
				EmailField = -1
			end if
		end if
	end if
end function

' ##### ChkIsNew() 移至 inc_functions2.asp #####

function ChkQuoteOk(fString)

	ChkQuoteOk = not(InStr(1, fString, "'", 0) > 0)

end function

function ChkUser(fName, fPassword)

	'## Forum_SQL
	strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID, " & strMemberTablePrefix & "MEMBERS.M_LEVEL, " & strMemberTablePrefix & "MEMBERS.M_NAME, " & strMemberTablePrefix & "MEMBERS.M_PASSWORD "
	strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
	strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS." & strDBNTSQLName & " = '" & fName & "' "
	if strAuthType="db" then
		strSql = strSql & " AND   " & strMemberTablePrefix & "MEMBERS.M_PASSWORD = '" & fPassword &"'"
	End IF
	strSql = strSql & " AND   " & strMemberTablePrefix & "MEMBERS.M_STATUS = " & 1

	set rsCheck = my_Conn.Execute (strSql)

	if rsCheck.BOF or rsCheck.EOF or not(ChkQuoteOk(fName)) or not(ChkQuoteOk(fPassword)) then
		ChkUser = 0
	else
		if cstr(rsCheck("MEMBER_ID")) = Request.Form("Author") then
			ChkUser = 1 '## Author
		else
			Select case cint(rsCheck("M_LEVEL"))
				case 1
					ChkUser = 2 '## Normal User
				case 2
					ChkUser = 3 '## Moderator
				case 3
					ChkUser = 4 '## Admin
				case else
					ChkUser = cint(rsCheck("M_LEVEL"))
			End Select
		end if	
	end if

	rsCheck.close
	set rsCheck = nothing

end function

function ChkUser2(fName, fPassword)

	'## Forum_SQL
	strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID, " & strMemberTablePrefix & "MEMBERS.M_LEVEL, " & strMemberTablePrefix & "MEMBERS.M_NAME, " & strMemberTablePrefix & "MEMBERS.M_PASSWORD "
	strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
	StrSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS." & strDBNTSQLName & " = '" & fName & "' "
	if strAuthType="db" then	
		strSql = strSql & " AND   " & strMemberTablePrefix & "MEMBERS.M_PASSWORD = '" & fPassword &"'"
	End If
	strSql = strSql & " AND   " & strMemberTablePrefix & "MEMBERS.M_STATUS = " & 1

	on error resume next
	set rsCheck = my_Conn.Execute (strSql)
	
	for counter = 0 to my_Conn.Errors.Count -1
		if my_Conn.Errors(counter).Number <> 0 or Err.number > 0 then
			ChkUser2 = -1
			my_Conn.Errors.Clear
		end if
	next

	if rsCheck.BOF or rsCheck.EOF or not(ChkQuoteOk(fName)) or not(ChkQuoteOk(fPassword)) or ChkUser2 = -1 then
		ChkUser2 = 0 '##  Invalid Password
	else
		if cint(rsCheck("MEMBER_ID")) = cint(Request.QueryString("Author")) then
			ChkUser2 = 1 '## Author
		else
			select case cint(rsCheck("M_LEVEL"))
				case 1
					ChkUser2 = 2 '## Normal User
				case 2
					ChkUser2 = 3 '## Moderator
				case 3
					ChkUser2 = 4 '## Admin
				case else
					ChkUser2 = cint(rsCheck("M_LEVEL"))
			end select
		end if	
	end if

	rsCheck.close	
	set rsCheck = nothing

end function

function ChkUser3(fName, fPassword, fReply)

	'## Forum_SQL
	strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID, " & strMemberTablePrefix & "MEMBERS.M_LEVEL, " & strMemberTablePrefix & "MEMBERS.M_NAME, " & strMemberTablePrefix & "MEMBERS.M_PASSWORD, " & strTablePrefix & "REPLY.R_AUTHOR "
	strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS, " & strTablePrefix & "REPLY "
	StrSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS." & strDBNTSQLName & " = '" & fName & "' "
	if strAuthType="db" then	
		strSql = strSql & " AND   " & strMemberTablePrefix & "MEMBERS.M_PASSWORD = '" & fPassword &"' "
	End If
	strSql = strSql & " AND   " & strTablePrefix & "REPLY.REPLY_ID = " & fReply
	strSql = strSql & " AND   " & strMemberTablePrefix & "MEMBERS.M_STATUS = " & 1

	set rsCheck = my_Conn.Execute (strSql)

	if rsCheck.BOF or rsCheck.EOF or not(ChkQuoteOk(fName)) or not(ChkQuoteOk(fPassword)) then
		ChkUser3 = 0 '##  Invalid Password
	else
		if cint(rsCheck("MEMBER_ID")) = cint(rsCheck("R_AUTHOR")) then
			ChkUser3 = 1 '## Author
		else
			Select case cint(rsCheck("M_LEVEL"))
				case 1
					ChkUser3 = 2 '## Normal User
				case 2
					ChkUser3 = 3 '## Moderator
				case 3
					ChkUser3 = 4 '## Admin
				case else
					ChkUser3 = cint(rsCheck("M_LEVEL"))
			End Select
		end if	
	end if

	rsCheck.close	
	set rsCheck = nothing

end function

'## 返回会员的签名信息
function GetSig(fUser_Name)

	'## Forum_SQL
	strSql = "SELECT M_SIG "
	strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "

	'#### Modify By - 2001/05/28 12:59:46 - http://www.WormCN.net ####
	if Request.Form("UserName") = "" then
		if IsNumeric(fUser_Name) then
			strSql = strSql & " WHERE MEMBER_ID = " & fUser_Name
		else
			strSql = strSql & " WHERE M_NAME = '" & fUser_Name & "'"
		end if
	else
		strSql = strSql & " WHERE M_NAME = '" & Request.Form("UserName") & "'"
	end if
	'#### Modify By - 2001/05/28 12:59:46 - http://www.WormCN.net ####

	set rsSig = my_Conn.Execute (strSql)

	if rsSig.EOF or rsSig.BOF then
		'## Do Nothing
	else
		GetSig = rsSig("M_SIG")
		If rsSig("M_SIG") <> " " Then
			GetSig = vbCrLf & "<BR><BR>------------------------------------------------------------------------------------<BR>" & GetSig
		else
			GetSig = vbCrLf & vbCrLf & GetSig
		end if
		GetSig = FormatStr2(GetSig)
		'GetSig = ChkString(GetSig, "signature")
	end if

	rsSig.close
	set rsSig = nothing

end function

function DoDropDown(fTableName, fDisplayField, fValueField, fSelectValue, fName)

	'## Forum_SQL
	strSql = "SELECT " & fDisplayField & ", " & fValueField
	strSql = strSql & " FROM " & fTableName

	rsdrop.Open strSql, my_Conn
		
	Response.Write "<Select Name='" & fName & "'>"
	if rsdrop.EOF or rsdrop.BOF then
		Response.Write "<Option>No Items Found</option>"  & vbCrLf
	else
		do until rsdrop.EOF
			if rs(fValueField) = cint(fSelectValue) then
				Response.Write "<option value='" & rsdrop(fValueField) & "' Selected>"
				Response.Write rsdrop(fDisplayField) & "</option>" & vbCrLf
			else
				Response.Write "<option value='" & rsdrop(fValueField) & "'>"
				Response.Write rsdrop(fDisplayField) & "</option>" & vbCrLf
			end if
			rsdrop.MoveNext
		loop
	end if
	Response.Write "</select>" & vbCrLf

	rsdrop.Close
	set rsdrop = nothing	

end function

sub DoULastPost(sUser_Name)

	'## Forum_SQL - Updates the M_LASTPOSTDATE in the FORUM_MEMBERS table
	strSql = "UPDATE " & strMemberTablePrefix & "MEMBERS "
	strSql = strSql & " SET M_LASTPOSTDATE = '" & DateToStr(strForumTimeAdjust) & "' "
	strSql = strSql & " WHERE " & strDBNTSQLName & " = '" & sUser_Name & "'"
	my_Conn.Execute (strSql)
	
end sub

'##############################################
'##            Ranks and Stars               ##
'##############################################

function getMember_Level(fM_TITLE, fM_LEVEL, fM_POSTS)

dim Member_Level

	Member_Level = ""
	if Trim(fM_TITLE) <> "" then
		Member_Level = fM_TITLE
	else
		select case fM_LEVEL
			case "1"
⌨️ 快捷键说明

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