<%option explicit%>
<%
ShopCheckAdmin "shopa_editdisplay.asp"
Dim RSTable
Dim ExportFileName
Dim ExportLocation
Dim ExportIdField
Dim ExportList
Dim ExportTable
Dim ExportDatabase
Dim ExcludeIdField
dim IdField
Dim quote
Dim dbc
Dim fso
Dim FileOpen
Dim Myfile
Dim RecordCount
Dim FieldCount
Dim AllRecords
dim exportdelimiter
'**************************************************************************
' Version 4.00
' Session Variables are used
' Session (table") = table to open
' Session ("db")= database
' Session ("ExportType") = all or selected
' Session ("Exportlist") list of records
' Session ("ExportFileName") = filename
' Session ("ExportLocation")= location of filename
'**************************************************************************
dim rc
GetSessionVariables ' see what we must do
EditOpenDatabase dbc, ExportDatabase, ExportTable ' open database
rc=0
If ExportFilename<>"" then
OpenRealFile rc
end if
If rc=0 then
If AllRecords<>"" then
ExportAllRecords
else
ExportSelectedRecords
end if
end if
ExportTrailer
ShopCloseDatabase dbc
'
Sub GetSessionVariables
ExportFileName=GetSess("ExportFilename")
ExportIdField=ucase(Getsess("ExportIdField"))
ExportList=GetSess("ExportList")
ExportTable=GetSess("Table")
ExportDatabase=GetSess("db")
ExportLocation=GetSess("ExportLocation")
AllRecords=GetSess("AllRecords")
Sql=GetSess("SqlQuery") ' get sql used
Fileopen=""
RecordCount=0
IDField=GetSess("Idfield")
ExcludeIdField="Yes"
Quote= chr(34)
exportdelimiter=Getsess("exportdelimiter")
if exportdelimiter="" then
exportdelimiter=","
end if
end Sub
'************************************************************
Sub ExportHeader
Dim msg
dim fldName
Fieldcount=0
For each fldName in rsTable.Fields
if FieldCount=0 and ExportIdField="NO" then
else
if msg="" then
msg= msg & quote & fldName.Name & quote
else
msg=msg & exportdelimiter & quote & fldName.Name & quote
end if
end if
Fieldcount=Fieldcount+1
next
WriteLine msg
end sub
'
'
Sub WriteLine (msg)
If ExportFilename<>"" then
MyFile.writeline msg
else
Response.write msg & "
"
end if
RecordCount=RecordCount+1
end sub
'
Sub OpenRealFile (rc)
on error resume next
dim filename, drive, lastchar
dim whichfile
filename = ExportFilename
Drive=instr(filename,":")
if drive=0 then
If Exportlocation <>"" then
lastchar=right(exportlocation,1)
if lastchar="/" or lastchar="\" then
filename = ExportLocation & Exportfilename
else
filename = ExportLocation & "\" & Exportfilename
end if
else
filename = ExportFilename
end if
whichfile=server.mappath(filename)
else
whichfile=filename
end if
response.write LangExport01 & "" & whichfile & "
"
Set fso = CreateObject("Scripting.FileSystemObject")
Set Myfile = fso.OpenTextFile(whichfile, 2, True)
if err.number> 0 then
response.write "" & LangExportOpen & "
" & err.description & ""
rc=4
else
rc =0
end if
end sub
'******************************************
Sub ExportAllRecords
SQL=GetSess("Sqlquery")
Set rsTable = Server.CreateObject("ADODB.Recordset")
rsTable.Open SQL, dbc, adOpenForwardOnly,adLockReadOnly
ExportHeader ' write field names
While Not rsTable.EOF
FormatRecord
rsTable.MoveNext
Wend
end sub
'
Sub FormatRecord
dim whatever
dim fieldvalue
Dim Msg
Fieldcount=0
msg=""
for each whatever in rsTable.fields
fieldvalue=whatever.value
if isnull(fieldvalue) then
Fieldvalue=""
end if
if Fieldcount=0 and ExportIdField="NO" then
else
If msg<>"" then
msg=msg & exportdelimiter & quote & fieldvalue & quote
else
msg = quote & fieldvalue & quote
end if
end if
fieldcount=Fieldcount+1
next
WriteLine msg
end sub
Sub ExportRecord (recordnum)
WriteLine "One record " & recordnum
end sub
'
Sub ExportTrailer
Response.write "
" & LangExportRecords & recordcount
If Fileopen<>"" then
Myfile.close
Set fso=nothing
else
Response.write "