<%option explicit%>
<%
'****************************************************************************
' Version 6.50 March 21, 2004
' adds new administration options
' Must be run against database configured in shop$config.asp
' VP-ASP 6.08 - Added option to not update existing entries
'*****************************************************************************
shopcheckadmin "shopa_languageadd.asp"
dim sAction
dim currentURL
Dim Serrors
Dim curTest
Dim PrevTest
Dim errorCount
Dim dbtable
Dim Dbfield
dim dbc
dim dbtype
dim testsql
dim testrs
dim rstemp
dim strfilename, strlanguage, strfilename2
dim ifs, ifile
dim strloaddb, strupdateexisting
dim command, commandcount
Dim YesNos(3), YesNoCount
dim helpfile
dim addcount, updatedcount
Yesnos(0)=replace(getlang("langcommonYes")," ","")
Yesnos(1)=replace(getlang("langCommonNo")," ","")
Dim Novalue, yesvalue
Yesvalue=yesnos(0)
novalue=yesnos(1)
Yesnocount=2
'
sAction=request("Action")
if saction="" then
saction=request("Action.x")
end if
currentURL="shopa_languageadd.asp"
AdminPageHeader
GenerateDisplayHeader getlang("LangFeatureAdd") & " " & getlang("LangLanguage")
GenerateDisplayBodyHeader
if saction="" then
DisplayForm
else
ProcessForm
If Serror="" then
ConvertLanguagefiles
end if
If serror<>"" then
displayform
end if
end if
GenerateDisplayBodyFooter
gethelp
AdminPageTrailer
Sub DisplayForm
Dim i
if serror > "" then
response.write ""
shopwriteerror sError
response.write ""
end if
response.write "")
end sub
Sub ProcessForm
dim strname
dim strvalue
Dim key
dim rc
Serror=""
strfilename=request("strfilename")
If strfilename="" then
sError=serror & Getlang("LangMenufilename") & " " & getlang("Langcustrequired") & "
"
end if
strlanguage=request("strlanguage")
If strlanguage="" then
sError=serror & Getlang("LangLanguage") & " " & getlang("Langcustrequired") & "
"
end if
strloaddb=request("strloaddb")
strupdateexisting = request("strupdateexisting")
end sub
'
Sub ConvertLanguagefiles
If strloaddb=Novalue then
Convertlanguagenodb strfilename
exit sub
end if
Convertlanguage strfilename
If serror="" then
Getsecondfilename strfilename, strfilename2
convertlanguage strfilename2
end if
if serror = "" then
response.write "
"
shopwriteheader "" & getlang("langcommonreset") & " " & getlang("langlanguage") & ""
response.write ""
end if
end sub
Sub Convertlanguage (filename)
dim rc, msg
commandcount=0
OpenInputFile Filename, ifs, ifile, rc
If rc> 0 then
Serror=Serror & " Unable to read " & strfilename
exit sub
end if
Dim morecommands
Serrors=""
addcount=0
updatedcount=0
ShopOpendatabase dbc
'DeleteRecords dbc
MoreCommands=True
Do While MoreCommands=True
GetCommand command, rc
if rc=0 then
commandcount=commandcount+1
ProcessRecord command
else
morecommands=false
end if
loop
response.write ""
shopwriteheader filename & " " & getlang("LangProductAdded") & "(" & addcount & ")" & " " & getlang("LangProductUpdated") & "(" & updatedcount & ")"
response.write ""
CloseFile ifs,ifile, rc
shopclosedatabase dbc
end sub
'
Sub Getcommand (text, rc)
dim pos
text=""
rc=0
ReadARecord Ifile, text, rc
end sub
sub ProcessRecord (record)
dim rc, words(10),wordcount, fieldname,fieldvalue,i, sql, rs, doupdate
wordcount=0
Verifyrecord record, fieldname,fieldvalue, rc
if rc>0 then exit sub
sql="select * from languages where lang=" & normfield(strlanguage) & " and keyword=" & normfield(fieldname)
set rs=dbc.execute(sql)
if rs.eof then
doupdate=""
else
doupdate="True"
end if
closerecordset rs
sql=""
If doupdate<>"" then
if lcase(strupdateexisting) = lcase(getlang("langcommonyes")) then
sql="update languages set caption=" & normfield(fieldvalue)
sql=sql & " where lang=" & normfield(strlanguage) & " and keyword=" & normfield(fieldname)
updatedcount=updatedcount+1
end if
else
sql="Insert into languages (lang, keyword, caption) values("
sql=sql & normfield(strlanguage) & "," & normfield(fieldname) & "," & normfield(fieldvalue) & ")"
addcount=addcount+1
end if
If getconfig("xdebug")="Yes" then
debugwrite sql
end if
if sql > "" then
dbc.execute(sql)
end if
end sub
Function Normfield (fieldvalue)
fieldvalue=replace(fieldvalue,"'","''")
If fieldvalue="" then
normfield="NULL"
else
normfield= "'" & fieldvalue & "'"
end if
end function
'
Sub Verifyrecord (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
If remaining>255 then
remaining=255
shopwriteerror "truncated
" & record
end if
'debugwrite "name=" & fieldname & "(" & Fieldvalue & ") pos=" & pos & " rem=" & remaining
fieldvalue=Mid(record,pos+1,remaining)
rc=0
end sub
Sub OpenInputFile (filename, fsObj, RecordObj, rc)
on error resume next
Dim whichfile
whichfile=server.mappath(filename)
set fsObj = Server.CreateObject("Scripting.FileSystemObject")
set RecordObj= fsObj.OpenTextFile(whichfile, 1, False)
If err.number > 0 then
rc=4
fsObj.close
set fsObj=nothing
else
rc=0
' debugwrite whichfile & " opened ok
"
end if
End sub
'
' close a file
Sub CloseFile (fsObj, RecordObj, rc)
set RecordObj = nothing
set fsObj = nothing
rc=0
end sub
Sub ReadARecord (RecordObj, record, rc)
if RecordObj.AtEndofStream then
rc=4
exit sub
end if
record = RecordObj.readline
rc=0
End Sub
Sub DeleteRecords (dbc)
exit sub
dim sql
sql="delete from languages where lang='" & strlanguage & "'"
dbc.execute(sql)
end sub
Sub Getsecondfilename (strfilename, strfilename2)
dim pos, remaining
pos=instr(strfilename,"_")
strfilename2=mid(strfilename,1,pos-1)
strfilename2=strfilename2 & "2"
remaining=len(strfilename)-pos+1
strfilename2=strfilename2 & mid(strfilename,pos,remaining)
'debugwrite "Filename2=" & strfilename2
end sub
Sub Convertlanguagenodb (strfilename)
ShopOpendatabase dbc
dim fieldvalue
DeleteRecords dbc
fieldvalue=Langnodbvalue
sql="Insert into languages (lang, keyword, caption) values("
sql=sql & normfield(strlanguage) & "," & normfield(strfilename) & "," & normfield(fieldvalue) & ")"
if getconfig("xdebug")="Yes" then
debugwrite sql
end if
dbc.execute(sql)
shopwriteheader "Completed." & strfilename
shopclosedatabase dbc
end sub
%>