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

📄 ewlookup.asp

📁 AspMaker调用的自定义包
💻 ASP
字号:
<!--##session lookup_script##-->
<!--##=No_Cache##-->
<%
Dim QS, Sql, Value, LnkType, LnkCount, LnkFld, LnkDisp1, LnkDisp2
QS = Split(Request.Querystring, "&")

If IsArray(QS) Then
	If UBound(QS) >= 0 Then
		Sql = EW_GetValue("s")
		Sql = TEAdecrypt(Sql, EW_RANDOM_KEY)
		Value = EW_GetValue("q")
		Value = AdjustSql(Value)
		LnkType = EW_GetValue("lt") ' Get link type
		If LnkType = "1" Then ' auto suggest
			LnkCount = 2
			LnkFld = -1
			LnkDisp1 = 0
			LnkDisp2 = 1
		Else
			LnkCount = EW_GetValue("lc") ' Link field count
			If Not IsNumeric(LnkCount) Then
				Response.End
			ElseIf CInt(LnkCount) <= 0 Then
				Response.End
			End If
			LnkFld = 0 ' Link field default = 0
			LnkDisp1 = EW_GetValue("ld1") ' Link display field
			If Not IsNumeric(LnkDisp1) Then
				Response.End
			ElseIf CInt(LnkDisp1) < -1 Or CInt(LnkDisp1) >= CInt(LnkCount) Then
				Response.End
			End If
			LnkDisp2 = EW_GetValue("ld2") ' Link display field 2
			If Not IsNumeric(LnkDisp2) Then
				Response.End
			ElseIf CInt(LnkDisp2) < -1 Or CInt(LnkDisp2) >= CInt(LnkCount) Then
				Response.End
			End If
		End If
		If Sql <> "" Then
			If Value <> "" Then Sql = Replace(Sql, "@FILTER_VALUE", Value)
			EW_GetLookupValues(Sql)
		End If
	End If
End If

Function EW_GetValue(Key)
	Dim kv, I
	For I = 0 To UBound(QS)
		kv = Split(QS(I), "=")
		If (kv(0) = Key) Then
			EW_GetValue = EW_Decode(kv(1))
			Exit Function
		End If
	Next
	EW_GetValue = ""
End Function

Sub EW_GetLookupValues(Sql)
	' Connect to database
	Dim conn, rs, rsarr, str, i
	Set conn = Server.CreateObject("ADODB.Connection")
	conn.Open xDb_Conn_Str
	Set rs = conn.Execute(Sql)
	If Not rs.EOF Then
		rsarr = rs.GetRows
	End If
	' Close database
	rs.Close
	Set rs = Nothing
	conn.Close
	Set conn = Nothing
	
	' Output
	If IsArray(rsarr) Then
		For i = 0 To UBound(rsarr, 2)
			If UBound(rsarr, 1) = CInt(LnkCount) -1 Then
				' Process link field
				If LnkType <> "1" Then
					str = rsarr(LnkFld, i)
					str = RemoveCrLf(str)
					Response.Write str & vbCr
				End If
				' Process display field
				If CInt(LnkDisp1) >= 0 Then
					str = rsarr(LnkDisp1, i)
					str = RemoveCrLf(str)
				Else
					str = ""
				End If
				Response.Write str & vbCr
				' Process display field 2
				If CInt(LnkDisp2) >= 0 Then
					str = rsarr(LnkDisp2, i)
					str = RemoveCrLf(str)
				Else
					str = ""
				End If
				Response.Write str & vbCr
			End If
		Next
	End If
	
End Sub

Function RemoveCrLf(s)
	Dim wrkstr
	wrkstr = s
	If Len(wrkstr) > 0 Then
		wrkstr = Replace(wrkstr, vbCrLf, " ")
		wrkstr = Replace(wrkstr, vbCr, " ")
		wrkstr = Replace(wrkstr, vbLf, " ")
	End If
	RemoveCrLf = wrkstr
End Function
%>
<!--##/session##-->

⌨️ 快捷键说明

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