<%option explicit%>
<%
shopcheckadmin "shopa_config.asp"
'****************************************************************************
' Copy Config 6.50
' May 17, 2003
'*****************************************************************************
const defaultitable="configuration"
const defaultotable="configuration1"
dim sAction
dim currentURL
dim fieldname,fieldvalue,fieldgroup, yesno, message
dim dbc, itable, otable, readcount
dim updatecount, newcount
Dim curTest
Dim PrevTest
Dim errorCount
'======================================
' Entry Point
'======================================
sAction=request("Action")
currentURL="shopa_copyconfig.asp"
if saction="" then
AdminpageHeader
generatedisplayheader "Copy Configuration"
generatedisplaybodyheader
DisplayForm
generatedisplaybodyfooter
AdminPageTrailer
else
adminpageheader
GetInput
generatedisplayheader "Copy Configuration"
generatedisplaybodyheader
If Serror="" then
ConvertFile
else
Displayform
end if
generatedisplaybodyfooter
AdminPageTrailer
end if
'======================================
' Subroutine ConvertDatabase
'======================================
Sub ConvertFile
WriteDiagnosticHeader
readcount=0
updatecount=0
newcount=0
Server.ScriptTimeout = 3600
setsess "diagnostic","Yes"
shopopendatabase dbc
setsess "diagnostic",""
Checkdatabaseopen dbc
CopyConfigTable
WriteDiagnosticTrailer
shopwriteheader " Sql completed. Records read=" & readcount
shopwriteheader "Updated=" & updatecount & " inserted=" & newcount
shopclosedatabase dbc
end sub
'
'
Sub Writemsg (msg)
response.write msg & " "
end sub
'======================================
' Subroutine DisplayForm
'======================================
Sub DisplayForm
if itable="" then
itable=defaultitable
end if
If otable="" then
otable=defaultotable
end if
Dim i
Dim sRowColor
response.write "")
response.write ""
end sub
'======================================
' Subroutine FormatRow
'======================================
Sub FormatRow (caption, fieldname,fieldvalue, sRowColor)
Response.Write("
" _
& caption & "
")
end sub
Sub GetInput
itable=request("itable")
if itable="" then
Serror=Serror & "Old table name is missing " & " "
end if
otable=request("otable")
if otable="" then
Serror=serror & "New table name is missing " & " "
end if
end sub
Sub WriteOutput (outrec)
oFile.writeline outrec
'response.write server.htmlencode(outrec) & " "
end sub
Sub CREATEConfigtable
command="drop table configuration"
Executecommand command
command="create table configuration (id Counter)"
Executecommand command
command="alter table configuration add column fieldname text(50) NULL"
Executecommand command
command="alter table configuration add column fieldvalue text(255) NULL"
Executecommand command
command="alter table configuration add column fieldgroup text(20) NULL"
Executecommand command
command="alter table configuration add column fieldyesno YESNO"
Executecommand command
end sub
Sub ExecuteCommand (isql)
sql=replace(isql,"configuration",filename)
dbc.execute(sql)
end sub
Sub OpenInternal (dbc)
'shopopendatabase dbc
end sub
'======================================
' Subroutine addError
'======================================
Sub addError (msg)
if curtest<>PrevTest then
Response.write "
" & curtest & "
"
else
Response.write "
"
end if
Response.write "
" & msg & "
"
errorcount=errorCount+1
PrevTest=CurTest
end sub
'======================================
' Subroutine WriteDiagnosticHeader
'======================================
Sub WriteDiagnosticHeader
Response.Write("
")
if serror > "" then
shopwriteerror sError
end if
Response.Write("
")
Response.write ("
")
End Sub
'======================================
' Subroutine WriteDiagnosticTrailer
'======================================
Sub WriteDiagnosticTrailer
Response.Write("
")
End Sub
Sub CopyConfigTable
dim rs
sql="select * from " & itable & " order by id"
set rs=dbc.execute(sql)
do while not rs.eof
readcount=readcount+1
fieldname=rs("fieldname")
fieldvalue=rs("fieldvalue")
Yesno=rs("fieldYesno")
fieldgroup=rs("fieldgroup")
message=rs("message")
if isnull(fieldvalue) then
fieldvalue=""
end if
Copyrecord
rs.movenext
loop
rs.close
set rs=nothing
end sub
Sub Copyrecord
dim findrs, findsql, update, usql
If fieldvalue="" then
fieldvalue="NULL"
else
Fieldvalue=replace(fieldvalue,"'","''")
fieldvalue="'" & fieldvalue & "'"
end if
findsql="select * from " & otable & " where fieldname='" & fieldname & "'"
set findrs=dbc.execute(findsql)
if findrs.eof then
update=false
else
update=true
end if
findrs.close
set findrs=nothing
'=================================================
'convert boolean value for SQL Server 17/10/05
'=================================================
If ucase(xdatabasetype)="SQLSERVER" then
If yesno=true then
yesno=1
Else
yesno=0
End If
End If
'=================================================
If update=true then
usql="update " & otable & " set fieldvalue=" & fieldvalue & ",fieldgroup='" & fieldgroup & "'"
usql=usql & ",fieldyesno=" & yesno & ", message='" & message & "'"
usql=usql & " where fieldname='" & fieldname & "'"
'debugwrite usql
dbc.execute(usql)
updatecount=updatecount+1
else
usql="insert into " & otable & " (fieldname,fieldvalue,fieldgroup,fieldyesno, message) values("
usql=usql & normfield(fieldname) & "," & fieldvalue & "," & normfield(fieldgroup) & "," & yesno & "," & normfield(message) & ")"
' debugwrite usql & " "
dbc.execute(usql)
newcount=newcount+1
end if
end sub
Function Normfield(fieldvalue)
'VP-ASP 6.50 - added error checking
if fieldvalue > "" then
normfield = "'" & replace(fieldvalue,"'", "''") & "'"
end if
end function
%>