<% class clsFUNC public function ADMINWINDOW(strHREF, strWidth, strHeight) ADMINWINDOW = "OpenWin = window.open(""" & strHREF & """, ""myWin"", ""toolbar=no,menubar=no,location=no,scrollbars=yes,resizable=yes,width=800,height=500"");"&_ "OpenWin.resizeTo("& strWidth &","& strHeight &");"&_ "OpenWin.moveTo(screen.width/2-"& strWidth/2 &",screen.height/2-"& strHeight/2 &");" ' "document.location.reload();"&_ ' "OpenWin.onunload=""window.opener.location.reload()"";" ' ADMINWINDOW = "window.showModalDialog(""" & strHREF & ""","""",""dialogHeight:"& strHeight &"px;dialogWidth:"&strWidth&"px;center:yes"")" ' ADMINWINDOW = "window.showModelessDialog(""" & strHREF & ""","""",""dialogHeight:"& strHeight &"px;dialogWidth:"&strWidth&"px;center:yes"")" end function ' ################################# public Function ShortEvenHeader(dtHeader, intLEN) ShortEvenHeader = dtHeader IF clng(intLEN)<>-1 then If len(DtHeader) => intLEN then ShortEvenHeader = left(dtHeader,instr(intLEN,dtHeader," ")) & " ... " end if End Function ' ################################# public Function SQLEncode(dtText) SQLEncode=dtText if dtText<>"" then SQLEncode=Replace(SQLEncode, "'", "''") SQLEncode=Replace(SQLEncode, """", """) end if End Function ' ################################# public Function SQLDecode(dtText) SQLDecode=dtText End Function ' ################################# public Function Paging(intPager, RS, TotalRows, strADDQRY) if NOT (RS.BOF or RS.EOF) then ' this public Function will generate paging navigation for specified record set ' intPager - no of records per page ' RS - recordset ' TotalRows - returns No of records in set ' strADDQRY - additional querystring dim intPAGENO dim i dim MaxPage dim MinPage dim ShowStart dim ShowEnd, TotalPages, strDEFAULTSRC intPAGENO = request("Page") IF intPAGENO = "" Then intPAGENO=1 TotalRows = RS.RecordCount RS.PageSize = intPager RS.CacheSize = intPager TotalPages=RS.PageCount RS.AbsolutePage = intPAGENO Paging = "" dim qryItem dim strQRYOUT for each qryItem in request.querystring() if qryItem<>"Page" AND qryItem<>"SText" then strQRYOUT = strQRYOUT & "&" & qryItem & "=" & request.querystring(qryItem) end if next strQRYOUT = strQRYOUT & strADDQRY if TotalPages>1 then If intPAGENO > 1 then Paging = "<< " end if MaxPage = TotalPages MinPage = 1 ShowStart = False ShowEnd = False if intPAGENO>5 then MinPage = intPAGENO-5 if intPAGENO>6 and TotalPages>9 then ShowStart = True end if if TotalPages>10 then if MinPage+10<= TotalPages then MaxPage=MinPage+10 ShowEnd = True else MinPage=TotalPages-10 MaxPage=TotalPages end if if ShowStart then Paging = Paging & "1 ... " end if for i = MinPage to MaxPage if cint(intPAGENO) = i then Paging = Paging & "" & i & " " else Paging = Paging & "" & i & " " end if next if TotalPages>10 then if ShowEnd then Paging = Paging & " ... " & TotalPages & " " end if If cint(intPAGENO) < TotalPages then ' Pokud nejsme na poslední stránce, zobrazíme šipku vpřed Paging = Paging & ">> " end if end if end if if Paging="" then Paging="1" end function ' ################################# public Function TabCreator(Direction, TabClass, CellClass, OverClass, LinkClass, Fields, Targets) dim sH dim intCell dim intPos select case Direction case "VERTICAL" sH = sH & "" & VbCrLf for intPos=0 to ubound(Fields) sH = sH & "" & VbCrLf sH = sH & " " & VbCrLf sH = sH & "" & VbCrLf next sH = sH & "

" sH = sH & " " sH = sH & Fields(intPos) sH = sH & " " sH = sH & "

" & VbCrLf case ELSE sH = sH & "" & VbCrLf sH = sH & "" & VbCrLf for intPos=0 to ubound(Fields) sH = sH & " " & VbCrLf next sH = sH & "" & VbCrLf sH = sH & "

" sH = sH & " " sH = sH & Fields(intPos) sH = sH & " " sH = sH & "

" & VbCrLf end select TabCreator= sH end function ' ################################# public Function BOXCreator(strHEADER, strBODY, Theme, imgHEADER, strWidth) dim sH ' sH = "" & VbCrLf sH = sH & "" & VbCrLf if strHEADER<>"" then strHEADER = replace(strHEADER, "Theme", theme) sH = sH & "" & VbCrLf sH = sH & " " & VbCrLf sH = sH & " " & VbCrLf sH = sH & " " & VbCrLf sH = sH & "" & VbCrLf end if if strBODY<>"" then strBODY = replace(strBODY, "Theme", theme) sH = sH & "" & VbCrLf sH = sH & " " & VbCrLf sH = sH & "" & VbCrLf end if sH = sH & "

" & VbCrLf sH = sH & "" & VbCrLf sH = sH & "	" & VbCrLf sH = sH & strHEADER & VbCrLf sH = sH & "	" & VbCrLf sH = sH & "" & VbCrLf sH = sH & "
" & VbCrLf sH = sH & strBODY & VbCrLf sH = sH & "

" & VbCrLf BOXCreator= sH end function ' ################################# public function TrueFalse(dtstrSQl, strTRUE) dim TrueFalseH TrueFalseH = dtstrSQl TrueFalseH = replace(TrueFalseH,"false","0") TrueFalseH = replace(TrueFalseH,"False","0") TrueFalseH = replace(TrueFalseH,"true", strTRUE) TrueFalseH = replace(TrueFalseH,"True", strTRUE) TrueFalse = TrueFalseH End Function ' ################################# public Function DateView(dtVMonth) dim dtTyp dim strMonth : strMonth = Month(dtVMonth) dim strDay : strDay = Day(dtVMonth) if strMonth<10 then strMonth = "0" & strMonth if strDay<10 then strDay = "0" & strDay if session("DateFormat")="2" then DateView = strMonth & session("DateDelimiter") & strDay & session("DateDelimiter") & year(dtVMonth) else DateView = strDay & session("DateDelimiter") & strMonth & session("DateDelimiter") & year(dtVMonth) end if end Function ' ################################# public Function QryDate(dtVMonth) QryDate = FormatDateTime(dtVMonth,VbGeneralDate) end Function ' ################################# public Function VDate(dtVMonth) dim dtTyp dtTyp = session("Vdate") select case dtTyp case "1" VDate = "'" & formatdatetime(dtVMonth, vbShortdate) & " 00:00:00'" VDate = "'" & day(dtVMonth) & "/" & Month(dtVMonth) & "/" & Year(dtVMonth) & " 00:00:00'" case "2" VDate = "'" & Month(dtVMonth) & "/" & day(dtVMonth) & "/" & Year(dtVMonth) & " " & formatdatetime(now(),vbLongTime) & "'" VDate = "'" & Month(dtVMonth) & "/" & day(dtVMonth) & "/" & Year(dtVMonth) & " 00:00:00'" case "3" VDate = "#" & Month(dtVMonth) & "/" & day(dtVMonth) & "/"& Year(dtVMonth) & "#" case "5" VDate = "'" & day(dtVMonth) & "-" & Month(dtVMonth) & "-" & Year(dtVMonth) & " 00:00:00'" end select end Function ' ################################# public sub Refresh(strSRC) response.wtite ("") end sub ' ################################# public sub OpenCONN dim UseAppObj UseAppObj = false if UseAppObj then if IsObject(application("My_conn_CAL")) then set my_conn= application("My_conn_CAL") else application.lock Set application("My_conn_CAL") = Server.CreateObject ("ADODB.Connection") application("My_conn_CAL").ConnectionTimeout = 360 application("My_conn_CAL").CommandTimeout = 30 application("My_conn_CAL").Open strConnect application.Unlock set my_conn= application("My_conn_CAL") end if else Set my_conn = Server.CreateObject ("ADODB.Connection") my_conn.ConnectionTimeout = 360 my_conn.CommandTimeout = 30 my_conn.Open strConnect end if end sub ' ################################# public sub CloseCONN dim UseAppObj UseAppObj = false if UseAppObj then set my_conn=nothing else my_conn.close set my_conn=nothing end if end sub ' ################################# public function AlternateRow() dim sH if session("WCAL_ALTERNATEROW")="#FFFFFF" then session("WCAL_ALTERNATEROW")="#e1e1e1" else session("WCAL_ALTERNATEROW")="#FFFFFF" end if AlternateRow = session("WCAL_ALTERNATEROW") end function ' ################################## public function ShowMessage2(strMessage) dim sH sH = sH & "" & VbCrLf ShowMessage2 = sH end function ' ################################## public function ShowMessage(strMessage) dim sH sH = sH & "" & VbCrLf ShowMessage = sH end function ' ################################## public function replaceTOJAVASCRIPT(strTEXT) dim sH sH=strTEXT sH=replace(sH,"\","\\") sH=replace(sH,"'","\'") sH=replace(sH,vbcrlf,"\n") ' sH=replace(sH,"
","\n") sH=replace(sH,"/","\/") sH=replace(sH,chr(34),"\"&chr(34)) sH=replace(sH,""","\"&chr(34)) ' sH=replace(sH,"","") replaceTOJAVASCRIPT = sH end function public function replaceTOJAVASCRIPT2(strTEXT) dim sH sH=strTEXT sH=replace(sH,"\","\\") sH=replace(sH,"'","\'") sH=replace(sH,vbcrlf,";;") ' sH=replace(sH,"
","\n") sH=replace(sH,"/","\/") sH=replace(sH,chr(34),"\"&chr(34)) ' sH=replace(sH,"","") replaceTOJAVASCRIPT2 = sH end function end class sub rw(stext) response.write stext end sub sub rwe(stext) response.write stext response.end end sub sub rwc(stext) response.write "" end sub %>