<% ' Generic Database - Function Library ' Notice: (c) 2001 Eli Robillard, All Rights Reserved. ' E-Mail: genericdb@rogers.com ' URL: http://www.genericdb.com/ ' GenericFunctions.asp Contents: ' function gdbAutokey(z) ' function gdbAutokey8 ' function gdbAutokey16 ' function gdbDisplay(strPre, strVar, strSuf) ' sub gdbGetOptionTags (pConn, pTbl, fldVal, fldDisplay, fldWhere, fldOrderBy) ' function gdbIsDark (inCol) ' sub gdbNoCache() ' function gdbiif(test,tval,fval) ' GenericCommon.asp Contents: ' function gdbBuildLink(invar) ' function gdbSterilizeText (inVal) ' function gdbVerifyActiveSession(strFile,strMessage) function gdbAutokey(z) ' (c) 2001 Eli Robillard, Use subject to terms of the GNU Lesser Public License ' Returns a random z-character string, defaults to 16-char dim newVal, x, y if z & "x" = "x" then z=16 Randomize Timer newVal="" for x = 1 to z y = Int(36 * Rnd + 1) newVal = newVal & Mid("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",y,1) next gdbAutokey = newVal end function function gdbAutokey8 ' (c) 2001 Eli Robillard, Use subject to terms of the GNU Lesser Public License ' Returns a random 8-character string ' 36^8 = 2,821,109,907,456 unique values dim newVal, x, y Randomize Timer newVal="" for x = 1 to 8 y = Int(36 * Rnd + 1) newVal = newVal & Mid("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",y,1) next gdbAutokey8 = newVal end function function gdbAutokey16 ' (c) 2001 Eli Robillard, Use subject to terms of the GNU Lesser Public License ' Returns a random 16-character string ' 36^16 = 7,958,661,109,946,400,884,391,936 unique values dim newVal, x, y Randomize Timer newVal="" for x = 1 to 16 y = Int(36 * Rnd + 1) newVal = newVal & Mid("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",y,1) next gdbAutokey16 = newVal end function function gdbDisplay(strPre, strVar, strSuf) ' (c) 2001 Eli Robillard, Use subject to terms of the GNU Lesser Public License ' Display three items concatenated. I use it to build links (open tag, variable, close tag). ' If the middle variable is blank, it doesn't display anything. if Trim(strVar) & "x" <> "x" then Response.write strPre & strVar, strSuf end if end function sub gdbGetOptionTags (pConn, pTbl, fldVal, fldDisplay, fldWhere, fldOrderBy) ' (c) 2001 Eli Robillard, Use subject to terms of the GNU Lesser Public License ' Generate the option tags for a combo box from a table dim strsql, conn, rs, numrows, numcols, x, dispcol ' Build query if fldVal = fldDisplay then strsql = "SELECT " & fldVal & " FROM " & pTbl dispcol = 0 else strsql = "SELECT " & fldVal & "," & fldDisplay & " FROM " & pTbl dispcol = 1 end if if fldWhere & "x" <> "x" then strsql = strsql & " WHERE " & fldWhere if fldOrderBy & "x" <> "x" then strsql = strsql & " ORDER BY " & fldOrderBy response.write strsql ' Run query set conn = Server.CreateObject("ADODB.Connection") conn.Open pConn set rs = conn.Execute(strsql) if NOT rs.EOF then arrTags = rs.GetRows numcols=ubound(arrTags,1) numrows=ubound(arrTags,2) else numcols=-1 numrows=-1 end if ' Close dataset rs.Close set rs = Nothing conn.Close set conn = Nothing if numrows > -1 then for x = 0 to numrows %> <%=arrTags(dispcol,x)%> <% next end if end sub function gdbIsDark (inCol) ' (c) 2001 Eli Robillard, Use subject to terms of the GNU Lesser Public License ' Takes a hex #RRGGBB colour and decides whether it is light or dark dim x gdbIsDark = false if left(inCol,1) = "#" then for x = 2 to 6 step 2 if mid(inCol,x,2) <= "88" then gdbIsDark = true next end if end function sub gdbNoCache() ' Prevent caching Response.Buffer = True Response.ExpiresAbsolute = Now() - 1 Response.AddHeader "cache-control", "must-revalidate" Response.AddHeader "cache-control", "private" Response.AddHeader "pragma", "no-cache" end sub function gdbShade(inval) ' (c) 2001 Eli Robillard, Use subject to terms of the GNU Lesser Public License ' Takes a hex colour (like "#66AAFF") and returns a shade darker ("#5599EE") dim x, y inval = Replace(inval,"#","") inval = UCase(inval) gdbShade = "" for x = 1 to len(inval) y = mid(inval,x,1) if ((y < ":") and (y > "0")) OR ((y>"A") AND (y<"G")) then gdbShade = gdbShade & chr(asc(mid(inval,x,1))-1) if y = "A" then gdbShade = gdbShade & "9" next end function function iif(test,tval,fval) ' Squeek's iif() if test=true then iif=tval else iif=fval end if end function '----- ' GenericCommon.asp Functions '----- function gdbBuildLink(invar) ' Build URL from dbLink or dbLinkField setting ' if dbLink, then display: Anchor tag and Link text (and don't close the anchor) ' if dbLinkField, then return: Anchor tag, No Link text (and don't close the anchor) dim arrLink, y, strURL, bDisplayValue, curVal gdbBuildLink = "" bDisplayValue = true if left(UCase(invar),11) = "DBLINKFIELD" then bDisplayValue = false arrLink = Split(Session(invar), ",") arrLink(0) = Trim(UCase(arrLink(0))) strURL = "" select case arrLink(0) case "TBL" strURL = "" case "URL" if right(arrLink(1),1) = "&" then strURL = "3 then strURL = strURL & "&" if (arrLink(y+1) & "x" = "x") then ' Default parameter name is ID ("file.asp?ID=12345") strURL = strURL & "ID" & ((y-1)/2) & "=" elseif UCase(arrLink(y+1)) = "NULL" then ' NULL forces no parameter name ("file.asp?12345") else strURL = strURL & arrLink(y+1) & "=" end if curVal = xrs(arrLink(y)) ' The parameter strURL = strURL & curVal if curVal & "x" = "x" then curVal = "EMPTY" next strURL = strURL & quote & " target=" & QUOTE & arrLink(0) & QUOTE & ">" ' Open target in a new window case "VIEW" strURL = "" end select if bDisplayValue and CurVal <> "EMPTY" then response.write strURL & arrLink(2) else gdbBuildLink = strURL end if if curVal = "EMPTY" then gdbBuildLink = "EMPTY" end function sub gdbVerifyActiveSession(strFile,strMessage) ' Check for an active session if Session("dbConn") & "x" = "x" then Response.Clear Response.Redirect "GenericError.asp?PG=" & strFile & "&MSG=" & strMessage end if end sub sub gdbResetVars(intFieldCount) if intFieldCount= 0 then ' Open Recordset and get the field count set xConn = Server.CreateObject("ADODB.Connection") xConn.Open strConn strsql = "SELECT * FROM [" & strTable & "]" Select Case strType Case "UDF" strsql = "SELECT * FROM " & strTable Case "SQL" strsql = "SELECT * FROM " & strTable End Select set xrs = Server.CreateObject("ADODB.Recordset") xrs.Open strsql, xConn intFieldCount = xrs.Fields.Count xrs.Close Set xrs = Nothing xConn.Close Set xConn = Nothing ' Reset session vars for each strName in Session.Contents strUName = UCase(strName) ' clear db* vars, don't clear dbPreviousWhere or dbLastRs (we still need these unless exiting GDB) if (left(strUName,2) = "DB") AND (strUName <> "DBPREVIOUSWHERE") AND (strUName <> "DBLASTRS") AND (left(strUName,7) <> "DBLEVEL") then if IsArray(Session(strName)) then for iLoop = LBound(Session(strName)) to UBound(Session(strName)) Session(strName)(iLoop) = Null next else Session.Contents(strName) = Null end if end if next else ' Reset the number of fields indicated in the parameter for each strName in Session.Contents strUName = UCase(strName) ' clear db* vars, don't clear dbPreviousWhere or dbLastRs (we still need these unless exiting GDB) if (left(strUName,2) = "DB") AND (strUName <> "DBPREVIOUSWHERE") AND (strUName <> "DBLASTRS") AND (left(strUName,7) <> "DBLEVEL") then if IsArray(Session(strName)) then for iLoop = 1 to intFieldCount Session(strName)(iLoop) = Null next else Session.Contents(strName) = Null end if end if next end if end sub function gdbSterilizeText (inVal, Degree) dim curVal curVal = inVal if Degree < 1 then ' 2001-12-21 EZR curVal = Replace(curVal,"<","<") curVal = Replace(curVal,">",">") curVal = Replace(curVal,chr(34),""") end if if Degree < 2 then ' 2001-12-21 EZR curVal = Replace(curVal,"!--#","!--#") ' Prevent includes curVal = Replace(curVal,"") gdbSterilizeText = curVal end function %>