<%
Const Langnodbvalue="**nodb**"
'VP-ASP 6.08b - unknown lang fix
dim   restarttrap
'*********************************************************
' Makes sure application variables are always loaded
' VP-ASP 6.0 configuration initialization
' Languages can remain files or be in the database
' If they are not in the database, the caption has one value **nodb**
' Fix for unknown lang  Changed line 15 to check for test
' April 15, 2006  getlang and getconfig now both test to see if system
' has been initialized. If not they try to do it. This
' should eliminate getlang and invalid config options
'********************************************************
'
Sub ShopInitApplication
dim dbc, csql, i, howmanyfields, rstemp
dim fieldname, fieldvalue
fieldname="Init" & "_" & xshopid
if Application(fieldname)="Yes" then exit sub 
Application(fieldname)="No"
If getsess("diagnostic")="Yes" then exit sub
LoadApplicationVariables
end sub
'
Sub LoadApplicationVariables
dim dbc,csql,rstemp   ,fieldname,fieldvalue
dim tempname
Setsess "db",xdatabase
OpenOtherDatabase dbc, xdatabase, xdblocation, xdatabasetype
If dbc.state<>adStateOpen  then
   exit sub
end if   


'VP-ASP 6.09 - check if the database has been created before initializing variables
dim dbtestrs
if ucase(xdatabasetype) = "SQLSERVER" then
	set dbtestrs = dbc.execute("select * from sysobjects where name='" & xconfigtable & "'")
	if dbtestrs.eof then
		set dbtestrs = nothing
		exit sub
	else
		set dbtestrs = nothing
	end if
elseif ucase(xdatabasetype) = "MYSQL" OR ucase(xdatabasetype) = "MYSQL351" then
	set dbtestrs = dbc.execute("show tables like '" & xconfigtable & "'")
	if dbtestrs.eof then
		set dbtestrs = nothing
		exit sub
	else
		set dbtestrs = nothing
	end if
end if

'End update


csql="select * from " & xconfigtable & " order by fieldname"
set rstemp=dbc.execute(csql)
Application.Lock
setconfig "InitTime",date() & " " & time()
do while NoT rstemp.eof
  fieldname = rstemp("fieldname")
  fieldvalue= rstemp("fieldvalue")
  If isnull(fieldvalue) then
       fieldvalue=""
  end if
  tempname=fieldname & "_" & xshopid
  Application(tempname) = fieldvalue
  rstemp.movenext
loop
fieldname="Init" & "_" & xshopid
Application(fieldname)= "Yes"
setconfig "InitTime",date() & " " & time()
Application.UnLock
rstemp.close
set rstemp=nothing
shopclosedatabase dbc
LoadLanguagevariables
End sub
'
Function GetConfig (fieldname)
'VP-ASP 6.08b - unknown lang fix
checksystemrestart
 dim tempname
 tempname=fieldname & "_" & xshopid
	if lcase(fieldname) = "xmysite" then
	
		'VP-ASP 6.50 - if xmysite is defined in shop$config.asp use that instead of value from database
		if xmysite > "" then
			Application(tempname) = xmysite
		end if
				
		if (Application(tempname) > "") AND (Application(tempname) <> " ") then
		'VP-ASP 6.09 - added / to end of xmysite
			if right(Application(tempname), 1) <> "/" then
				Application(tempname) = Application(tempname) & "/"
			end if
		end if
		
		dim SSL	
		SSL = Request.ServerVariables("HTTPS")
		If Ucase(SSL) = "ON" Then
			GetConfig=replace(Application(tempname), "http:", "https:")
		else
		 GetConfig=Application(tempname)
		end if
	
	'VP-ASP 6.50 - handle xssl the same way as xmysite
	elseif lcase(fieldname) = "xssl" then
		if xssl > "" then
			Application(tempname) = xssl
		end if
				
		if (Application(tempname) > "") AND (Application(tempname) <> " ") then
			if right(Application(tempname), 1) <> "/" then
				Application(tempname) = Application(tempname) & "/"
			end if
		end if
		
		'VP-ASP 6.5.1 - return SSL URL
		GetConfig=Application(tempname)
	else
	 GetConfig=Application(tempname)
	end if
end function  
'
'*******************************************************************
' all languages now in application variables
' either default language or session language
'*******************************************************************
Function GetLang (fieldname)
 dim tempname, tempvalue, tempnamesess
 'VP-ASP 6.08b - unknown lang fix
 dim rvalue, rc
 checksystemrestart
 tempname=fieldname & "_" & xshopid

 If Getsess("languagesession")<>"" Then
    tempnamesess=fieldname & "_" & Getsess("languagesession") & "_" & xshopid
    tempvalue=application(tempnamesess)
    If tempvalue="" then
       tempvalue=Application(tempname)
       if tempvalue="" then 
          tempvalue="Unknown " & fieldname
       end if   
    end if   
    getlang=tempvalue
    exit function
 end if   
 tempvalue=Application(tempname)
 If tempvalue="" then
    tempvalue="unknown " & fieldname
 end if   
 getlang=tempvalue
end function  

Function SetConfig (fieldname, value)
 dim tempname
 tempname=fieldname & "_" & xshopid
 Application(tempname)=value
end function   

Function Setlang (fieldname, value)
 dim tempname
 tempname=fieldname & "_" & xshopid
 Application(tempname)=value
end function   

 
Sub LoadLanguageVariables 
dim dbc,csql,rstemp   ,fieldname,fieldvalue
dim tempname, language
language=getsess("language")
if language="" then
  language=getconfig("xlanguage")
end if
if language="" then exit sub     
OpenOtherDatabase dbc, xdatabase, xdblocation, xdatabasetype
If dbc.state<>adStateOpen  then
   exit sub
end if
dim lang, filename
csql="select * from languages where lang='" & language & "'"
set rstemp=dbc.execute(csql)
If not rstemp.eof then
    fieldvalue= rstemp("caption")
    If fieldvalue=Langnodbvalue then 
      filename=rstemp("keyword") 
      closerecordset rstemp
      shopclosedatabase dbc
      LoadLanguageVariablesNodb language, filename 
      exit sub
    end if
end if        
Application.Lock
do while NoT rstemp.eof
  fieldname = rstemp("keyword")
  fieldvalue= rstemp("caption")
  If isnull(fieldvalue) then
       fieldvalue=""
  end if
  If fieldvalue<>"" Then 
    tempname=fieldname & "_" & xshopid
    Application(tempname) = fieldvalue
  end if  
  rstemp.movenext
loop
Application.UnLock
rstemp.close
set rstemp=nothing
shopclosedatabase dbc
End sub

'*************************************************************************
' we are to read language files instead of the database
' shop$language_xxxxxxx.asp and shop$language2_xxxxxxxxx.asp
'***********************************************************************
Sub   LoadLanguageVariablesNodb (language, filename) 
dim fieldnames(1000),fieldvalues(1000),fieldcount
dim strfilename, strfilename2, i
dim tempname, fieldname, fieldvalue
If filename="" then 
  strfilename="shop$language_" & language & ".asp"
  strfilename2="shop$language2_" & language & ".asp"
else
  strfilename=filename
  strfilename2=filename
  strfilename2=replace(strfilename2,"$language","$language2")
end if  
LanguageConvertFile strfilename, fieldnames,fieldvalues, fieldcount
If fieldcount=0 then exit sub
Application.Lock
for i=0 to fieldcount-1
  fieldname = fieldnames(i)
  fieldvalue= fieldvalues(i)
  If fieldvalue<>"" Then 
    tempname=fieldname & "_" & xshopid
    Application(tempname) = fieldvalue
  end if  
next
Application.UnLock
fieldcount=0
LanguageConvertfile strfilename2, fieldnames,fieldvalues, fieldcount
If fieldcount=0 then exit sub
Application.Lock
for i=0 to fieldcount-1
  fieldname = fieldnames(i)
  fieldvalue= fieldvalues(i)
  If fieldvalue<>"" Then 
    tempname=fieldname & "_" & xshopid
    Application(tempname) = fieldvalue
  end if  
next
Application.UnLock
end sub

'*************************************************************************
'read language file
'*************************************************************************
Sub LanguageConvertFile (strfilename, fieldnames,fieldvalues, fieldcount)
dim rc, whichfile, fsobj, recordobj, i, record, fieldname, fieldvalue
Dim morecommands 
fieldcount=0
on error resume next
whichfile=server.mappath(strfilename)
set fsObj = Server.CreateObject("Scripting.FileSystemObject")
set RecordObj= fsObj.OpenTextFile(whichfile, 1, False)
If err.number > 0 then
      fsObj.close
      set fsObj=nothing
      setsess "Errlanguage","Failed to find file " & strfilename
      exit sub
End if
MoreCommands=True
Do While MoreCommands=True
   if RecordObj.AtEndofStream then
       morecommands=false
    else
       record = RecordObj.readline
       LanguageVerifyrecord record, fieldname,fieldvalue, rc
       If rc=0 then 
          fieldnames(fieldcount)=fieldname
          fieldvalues(fieldcount)=fieldvalue
          fieldcount=fieldcount+1
         ' debugwrite "fieldname=" & fieldname & "fieldvalue=" & fieldvalue
       end if
    end if      
loop 
set RecordObj = nothing
set fsObj = nothing
end sub
'
Sub LanguageVerifyrecord (record, fieldname, fieldvalue, rc)
dim words(50),wordcount, values(50), valuecount, fieldtemp, remaining
dim pos, firstchar, found
rc=4
record=trim(record)
Pos=instr(record,"=")
if pos=0 then exit sub
fieldtemp=mid(record,1,pos-1)
fieldtemp=lcase(fieldtemp)
parserecord fieldtemp, words, wordcount," "
fieldname=words(0)
pos=pos+1
Found=false
Do while found=false
  firstchar=mid(record,pos,1)
  If firstchar="""" then
     found=true
  else
     pos=pos+1
  end if
loop          
remaining=len(record)-pos-1
fieldvalue=Mid(record,pos+1,remaining)
'debugwrite "name=" & fieldname & "(" & Fieldvalue & ") pos=" & pos &  " rem=" & remaining
rc=0   
end sub

'VP-ASP 6.08b - unknown lang fix
sub CheckSystemRestart
if restarttrap<>"" then exit sub
restarttrap="Yes" 
dim fieldname, fieldvalue
fieldname="Init" & "_" & xshopid
if Application(fieldname)="Yes" then exit sub 
shopinitapplication
end sub    
%>