<%
Const Langnodbvalue="**nodb**"
'*********************************************************
' Makes sure applicatio variables are always loaded
' VP-ASP 5.0 configuration initialization
' May 2, 2003
' Languages can remain files or be in the database
' If they are in the database, the caption has one value **nodb**
'********************************************************
'
Sub ShopInitApplication
dim dbc, csql, i, howmanyfields, rstemp
dim fieldname, fieldvalue
fieldname="Init" & "_" & xshopid
if Application(fieldname)<>"" 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   
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)
 dim tempname
 tempname=fieldname & "_" & xshopid
 GetConfig=Application(tempname)
end function  
'
Function GetLang (fieldname)
 dim tempname, tempvalue
 tempname=fieldname & "_" & xshopid
 If Getsess("languagesession")<>"" Then
    tempvalue=getsess(tempname)
    If tempvalue="" then
       tempvalue="Unknown " & fieldname
    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
%>