<% Option Explicit %>
<%
'----------------------------------------------
' 2007.08.30 4.01 Klick på lag i tabell = visa samtliga matcher för detta laget
' 2008.01.23 4.24 Tooltip med ursprungligt lagnamn
' 2009.02.10 5.03 Check om besökare får registrera resultat.
' 2009.04.14 5.13 Læsa HTML
' Logik enligt:
' 1. Læs in post från tblLoadBal_HTMLSaved
' 2. Om Træff =>
' a. Læs in senaste øverføring från tblLastUpdate
' b. Om tblLoadBal_HTMLSaved.TS > tblLastUpdate.LastUpdate => bUseHTML=true
' 3. bUseHTML=true
' a. Læs in HTML-fil
' 4. bUseHTML=false
' a. Hæmta in real data och skicka ut
' b. Spara HTML-fil
' c. Skapa/Uppdatera tblLoadBal_HTMLSaved med aktuell TS
' 2009.05.17 5.17 Mobiltelefon bild med länk prenumerera på denna matchen
' 2009.07.24 5.20 Hantering es, wo, ef med olika språk
' 2009.08.06 5.18a Förbättring av 5.13
' 2009.09.02 5.30 Helt ny menyhantering. Beroende på
' gbUseMenu530 så sker olika saker.
' 2009.12.15 5.41 Undvik specialtecken t.ex. & i länkar
'----------------------------------------------
'----------------------------------------------
' Parametrar:
' TurnNr
' Lang_Current
' DAG | PLAN | LAG
'----------------------------------------------
Dim Conn, Result 'as Object
Dim strSQL 'as String
dim strKnr
dim bOK
dim sDocTot, bFel
Dim sDocFirst, sDocDynamic, sDocEnd
Dim sDD
dim sKlass, sKlassNamn, sGrp
dim i, i2
dim sGrpNamn
dim sLink_Grp, sLink_SS
dim sLinkLag, sShowLag
dim sAction
dim sDatum, sDatumWD, sPlan
dim sTmp
dim iAntArena,sTemplate 'Ver 2.25
dim sArena, sRes 'Ver 2.25
dim sLag, sClass 'Ver 4.01
'Ver 5.18a dim bUseHTML, sHTML 'Ver 5.13
dim sFlatFunc, sFlatParms, sDomain, sHTML_Name, lRecIDHTML 'Ver 5.13
dim sTS_HTML, sTS_LU, bAction4HTML
'Ver 5.18a
dim bUseHTML, aHTML(400), iAntHTML
dim iAntGgr, lTotSize
const cMAX_LEN_SEGMENT = 10240
Function Return_Mobile_LinkCUPGAME(lMatchnr, sTid, iSpelad, iHLRes)
'--------------------------------------------------------
'Ver 5.17
' Syfte: Returnerar mobillänk om denna matchen är prenumererbar
' samt alltid klockslag
'
' Parameters:
'--------------------------------------------------------
dim sOut
if gbPreviewActive=true then 'Ej tillåtet i preview-läge
Return_Mobile_LinkCUPGAME=sTid
exit function
end if
if gbSMS_Active=false then 'Ingen turnering med SMS utskick
Return_Mobile_LinkCUPGAME=sTid
exit function
end if
if iSpelad=1 and iHLRes <> -1 then 'Redan spelad
Return_Mobile_LinkCUPGAME=sTid
exit function
end if
'Ospelad match - tillför mobiltelefon länk + ikon
sOut=sTid & " "
sOut=sOut & "![]()
"
Return_Mobile_LinkCUPGAME=sOut
end function
Function ValidateChars(sVal)
'--------------------------------------------------------
'Ver 5.13
' Syfte: Byter ut otillåtna tecken till _:
'
'--------------------------------------------------------
dim sValid, i, sOut, sUC
sValid="ABCDEFGHIJKLMNOPQRSTUVWXYZ_-0123456789"
sUC=ucase(sVal)
for i=1 to len(sUC)
if instr(sValid,mid(sUC,i,1))=0 then 'invalid
sOut=sOut & "_"
else
sOut=sOut & mid(sUC,i,1)
end if
next
ValidateChars=sOut
end function
Function CheckIfUseHTML
'--------------------------------------------------------
'Ver 5.13
' Syfte: Kontrollerar om det finns en html-fil att anvænda,
' i så fall returnera TRUE
'--------------------------------------------------------
if gbPreviewActive=true or bAction4HTML=false then 'Preview ær alltid 'live'
CheckIfUseHTML=false
exit function
end if
if gsWebDomain="" then
gsWebDomain=GetCust_WebDomainFromTurnnr(glTurnNr) 'Ver 5.50 Hämta in turneringens webdomän
end if
Set Conn = Open_DB(gsWebDomain) 'Ver 5.50
strSQL = "Select * from tblLoadBal_HTMLSaved WHERE TurnNr=" & glTurnNr & " AND Func=" & dbfnutt(sFlatFunc)
strSQL = strSQL & " AND Parms=" & dbfnutt(sFlatParms) & " AND domain=" & dbfnutt(sDomain)
' ErrorInfo strSQL & "
"
Set Result = Conn.Execute(strSQL)
if Result.EOF=true then 'Ingen htmlfil
lRecIDHTML=-1
else
lRecIDHTML=Result("RecId")
sTS_HTML=Result("TS")
sHTML_Name =Result("HTML_Name")
end if
Result.close
if lRecIDHTML > -1 then
strSQL = "Select * from tblLastUpdate WHERE TurnNr=" & glTurnNr
' ErrorInfo strSQL & "
"
Set Result = Conn.Execute(strSQL)
if Result.EOF=true then 'Inget exporterat än
sTS_LU="2099-12-31"
else
sTS_LU=Result("LastUpdate")
end if
Result.close
end if
Close_DB Conn
if lRecIDHTML > -1 AND sTS_LU <= sTS_HTML then
CheckIfUseHTML=true
else
CheckIfUseHTML=false
end if
end function
Sub Fix_HTML_Vars
'--------------------------------------------------------
'Ver 5.13
' Syfte: Bygger upp namn till HTML-fil och parameter enligt føljande:
'
' tblLoadBal_HTMLSaved
'
' RecID 123
' Turnnr 987
' Func generic
' Parms DAG2009-04-14DEN PLAN7SVE ARENABollsydENG
' domain www.cumap.net
' HTML_Name 987_generic_DAG2009-04-14DEN.htm 987_generic_PLAN7SVE.htm
' TS 2009-04-14 12:23:97
'
'--------------------------------------------------------
sFlatFunc="generic" 'Ver 5.13
sHTML_Name=glTurnNr & "_generic_"
if sAction="PLAN" then
sFlatParms="PLAN" & sPlan & gsLang_Curr
end if
if sAction="DAG" then
sFlatParms="DAG" & sDatum & gsLang_Curr
end if
if sAction="ARENA" then
sFlatParms="ARENA" & sArena & gsLang_Curr
end if
sHTML_Name=sHTML_Name & ValidateChars(sFlatParms) & ".htm"
sDomain=Request.ServerVariables("SERVER_NAME")
end sub
Function Write_File(sTemplate) 'Ver 5.18a
'Function Write_File(sTemplate, sDoc)
'--------------------------------------------------------
'Ver 5.13
'Purpose: Skriver en fil och
' returnerar TRUE om allt OK
' Parm:
' sTemplate: HTML/ASP-fil inkl sökväg som ska skrivas
' sDoc: HTML-innehåll
'--------------------------------------------------------
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f, ff, x, p, fname
dim sPath
dim sDoc, i
'Ver 5.18a-start Slå samman samtliga block
sDoc=""
for i=1 to iAntHTML
sDoc=sDoc & aHTML(i)
next
if glTurnNr=857 then
errorinfo "++ Antal loopar=" & iAntGgr & ", iAntHTML=" & iAntHTML & " fillen=" & len(sDoc)
end if
'Ver 5.18a-slut
Set fso = CreateObject("Scripting.FileSystemObject")
' sPath=SetPath(fso, "/cuponweb") 'Ver 4.00
Set f = fso.OpenTextFile("../" & sTemplate, ForWriting, true) 'Ver 4.00
' Set f = fso.OpenTextFile( sTemplate, ForWriting, true) 'Ver 4.00
f.WriteLine(sDoc)
f.Close
Write_File = true
' response.write sDoc
End Function
Sub Update_HTML_File
'--------------------------------------------------------
'Ver 5.13
'Purpose: Uppdaterar databas med info om ny html-fil
'--------------------------------------------------------
dim sSQL, sTS
'Ver 5.18a Call Write_File("html_tmp/" & sHTML_Name, sHTML) 'Ver 5.13 Skriv HTML-fil
Call Write_File("html_tmp/" & sHTML_Name) ''Ver 5.18a Skriv HTML-fil
sTS=strGetDate(0) & " " & strGetTime(true)
if lRecIDHTML = -1 then
sSQL="INSERT INTO tblLoadBal_HTMLSaved(Turnnr,Func,Parms,Domain,HTML_Name,TS) VALUES("
sSQL=sSQL & glTurnNr & ", " & dbfnutt(sFlatFunc) & ", " & dbfnutt(sFlatParms) & ", " & dbfnutt(sDomain)
sSQL=sSQL & ", " & dbfnutt(sHTML_Name) & ", " & dbfnutt(sTS) & ")"
' errorinfo sSQL
Conn.Execute sSQL
else
sSQL="UPDATE tblLoadBal_HTMLSaved SET TS=" & dbfnutt(sTS)
sSQL=sSQL & " WHERE RecID=" & lRecIDHTML
' errorinfo sSQL
Conn.Execute sSQL
end if
end sub
Sub Add2HTML(sOut)
'--------------------------------------------------------
'Ver 5.18a
' Syfte: Lagra till aHTML()
'
' Parameters:
'--------------------------------------------------------
if len(aHTML(iAntHTML)) > cMAX_LEN_SEGMENT then 'Starta ny omgång
iAntHTML=iAntHTML+1
aHTML(iAntHTML)=""
end if
aHTML(iAntHTML)=aHTML(iAntHTML) + sOut
iAntGgr=iAntGgr+1
end sub
Function Return_Register_Icon(sKlass, lMatchnr, sDat, sTid)
'--------------------------------------------------------
'Ver 5.03
' Syfte: Om det är tillåtet för besökare att registrerar resultat,
' skapas länk + ikon att klicka på
'
' Parameters:
'--------------------------------------------------------
dim sNow, sEnd
dim sChk, sOut
if gbExtern4Result=false then
Return_Register_Icon=""
exit function
end if
'Verifiera tidpunkt
sNow = strGetTS("n",-5) 'Ge fem minuter efter slut
sEnd=sDat & " " & sTid
if sNow < sEnd then 'Ej tid ännu
Return_Register_Icon=""
exit function
end if
'Matchen spelad, men inget resultat. Lägg ut ikon.
sChk="am9er388tyw37" & glTurnNr & "47vx50t6iie0" & lMatchnr & "40wfzppq"
sOut=" ![]()
"
Return_Register_Icon=sOut
end function
Sub Get_Session_Local
'--------------------------------------------------------
' Syfte: Hämtar in lokala sessionvariabler
'
' Parameters:
'--------------------------------------------------------
glTurnNr = session("Turnnr")
gsLang_Curr = session("Lang_Current")
end sub
'ulf shit
Dim starttime
starttime = Timer
call Fetch_QStrings 'Hämta in query-strängar, lägg i session
myDebug gsQ
sPlan=Request.Querystring("PLAN")
sDatum=Request.Querystring("DAG")
sArena=Request.Querystring("ARENA") 'Ver 2.25
sLag=Request.Querystring("LAG") 'Ver 4.01
sClass=Request.Querystring("class") 'Ver 4.01
bAction4HTML=false
if sPlan <> "" then
sAction="PLAN"
bAction4HTML=true
end if
if sDatum <> "" then
sAction="DAG"
sDatumWD = myWDay(sDatum,true)
bAction4HTML=true
end if
if sArena <> "" then 'Ver 2.25
sAction="ARENA"
bAction4HTML=true
end if
if sLag <> "" then 'Ver 4.01
sAction="LAG"
end if
Call Fix_HTML_Vars 'Ver 5.13
bUseHTML=CheckIfUseHTML 'Ver 5.13
iAntGgr=0 'Ver 5.18a
iAntHTML=1 'Ver 5.18a
call Get_Session_Local 'Hämta in lokala variabler
'Ver 5.13
bFel=false
if bUseHTML=true then
if Read_HTML_Template("../html_tmp/" & sHTML_Name, sDocTot) = false then 'Ver 4.21
ErrorInfo sDocTot
bFel=true
else
sDocTot=Replace(sDocTot," ","