SitePoint Sponsor

User Tag List

Results 1 to 8 of 8
  1. #1
    SitePoint Member
    Join Date
    Oct 2010
    Posts
    4
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    asp & javascript dynamic rows

    Dear All,
    I tried to use this script (it is exactly what I need, to add several rows at a time and save them into the database) http://snippets.dzone.com/posts/show/10023. However I can't make the database connection work. Can anyone help me with this, please bear in mind that I am a complete novice in this field.

    Many thanks, in advance,
    Debbie

  2. #2
    SitePoint Guru
    Join Date
    Jun 2007
    Posts
    675
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    in order to assist, you will need to post the error messages so folks can find the problem.

  3. #3
    SitePoint Member
    Join Date
    Oct 2010
    Posts
    4
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Thank you for your reply.

    So here is just a test form: http://www.pathology.ubc.ca/path_data/Merit_Form6.aspand this is an error message:
    Microsoft JET Database Engine error '80040e14'

    Syntax error in field definition.

    /path_data/afhdatabasesubs.asp, line 887




    afhdatabasesubs.asp code is (line that shows message is: conn.execute(sql), I marked it in red below)

    <%
    const xallowcookielogin="Yes" ' admin cookie login
    const xcookiedays=2
    const afhtracedatabase="No"
    '*******************************************************
    '
    ' main database open for: access, Sql Server, ODBC and MYSQL
    ' Common routines for opening any database
    ' Database types supprtedare: access, SQlserver, Mysql
    ' config_databasetpe=Access, SQL Server, Mysql
    ' config_databaselocation=ODBC, c:\abcdef or relative location

    ' These subroutines are used to read/write and otherwise related to database
    ' The subroutines are:
    ' OpenDataBase (conn)
    ' OpenAccess (conn, database, ilocation)
    ' OpenODBC (conn, database)
    ' OpenSqlServer(conn, database, strserver, struserid, strpassword)
    ' OpenMysqL conn, config_databasename, config_databaseserver, config_databaseUserid, config_databasepassword,config_databasedriver
    ' Verifydatabaseconnection (conn)
    ' CloseDatabase (conn)
    ' OpenRecordSetPaging (conn, sql, rs, pagesize, pagenumber, maxpages)
    ' CloseRecordSet (irs)
    ' PageNavigation (sql, pagenumber, maxpages, pagesize)
    ' PageNavBarNext(sql)
    ' Function Getrsitem(fieldvalue)
    ' Function GetlastRecord(conn, table, idfield )
    ' OpenRecordset (conn, rs, sql, eof)
    ' GetDataBaseTables (tables, tablecount,conn, databasetype)
    ' GetdatabaseFieldnames (Conn, dbtable, recordno, dbfieldnames, dbfieldtypes, dbfieldlengths, dbfieldvalues, dbfieldcount, idfield)
    ' readrsValues(rs, dbfieldnames, dbfieldtypes, dbfieldlengths, dbfieldvalues, dbfieldcount, idfield, recordno)
    ' Openotherdatabase conn, databasename
    ' Non database subroutines
    ' Checkadminlogin (filename)
    '*********************************************************
    Sub OpenDataBase (conn)
    dim databasetype
    dim noforce
    noforce=""
    traceopendatabase
    databasetype=lcase(config_databasetype) ' type of database
    select case databasetype
    Case "access"
    OpenAccess conn, config_databasename,config_databaselocation
    Case "sqlserver"
    OpenSqlserver conn, config_databasename, config_databaseserver, config_databaseUserid, config_databasepassword
    Case "mysql"
    OpenMysqL conn, config_databasename, config_databaseserver, config_databaseUserid, config_databasepassword,config_databasedriver
    case "odbc"
    Openodbc conn, config_databasename
    Case else
    OpenAccess conn, config_databasename,config_databaselocation
    end select
    end sub
    '*****************************************************************************************
    ' load language variables
    '****************************************************************************************
    Sub InitializeSession
    ConfigurationInit
    Languageinit
    end sub
    '******************************************************
    ' Open Access Database
    ' The location could be a relative address or a full address
    ' If the the location has : in it or a // assume a full address
    ' otherwise assume a relative address
    '**************************************************************
    Sub OpenAccess (conn, idatabase, ilocation)
    on error resume next
    dim location, pos, connstring, dbname, rellocation, database
    rellocation=True
    location=Ilocation
    If location<>"" then
    database = location & "\" & idatabase
    else
    database=idatabase
    end if
    pos=instr(database,":")
    If pos>0 then
    rellocation=false
    else
    pos=instr(database,"/")
    if pos>0 then
    rellocation=false
    end if
    end if
    If rellocation=true then
    dbname=server.mappath(database)
    else
    dbname=database
    end if
    If ucase(config_databasedriver)="ACCESS2007" then
    connstring = "Provider=Microsoft.ACE.OLEDB.12.0;persist security info=false;data source=" & dbname
    else
    connstring="provider=microsoft.jet.oledb.4.0;persist security info=false;data source=" & dbname
    end if
    Set conn = Server.CreateObject("ADODB.Connection")
    conn.open (connstring)
    Verifydatabaseconnection conn
    end sub
    '******************************************************************************
    ' ODBC connect is in form
    ' DSN=xxxx
    ' DSN=xxx;UID=uuu;pwd=ppp
    '****************************************************************************
    Sub OpenODBC (conn, database)
    on error resume next
    dim connstring
    connstring=database
    Set conn = Server.CreateObject("ADODB.Connection")
    conn.open connstring
    Verifydatabaseconnection conn
    end sub
    '****************************************************************************
    ' Open SQL Server
    ' Need userid, password, server and database name
    '*****************************************************************************
    Sub OpenSqlServer(conn, database, strserver, struserid, strpassword)
    dim connstring
    on error resume next
    Set conn = Server.CreateObject("ADODB.Connection")
    If ucase(config_databasedriver)="SQLOLEDB" then
    connstring="Provider=sqloledb;" & "Source=" & strServer & ";" & "database=" & DataBase & ";" & "UID=" & strUserid & ";" & "Password=" & strPassword & ";"
    else
    if ucase(config_databasedriver)="SQLSERVER2005" then
    connstring="DRIVER={SQL Native Client}; Server=" & strServer & "; Database=" & DataBase & "; UID=" & struserid & "; PWD=" & strPassword
    else
    connstring= "DRIVER={SQL Server}; Server=" & strServer & "; Database=" & DataBase & "; UID=" & struserid & "; PWD=" & strPassword'
    end if
    end if
    'debugwrite connstring
    Conn.Open connstring
    Verifydatabaseconnection conn
    end sub
    '
    '********************************************************************************
    ' Open MYSQL
    ' Need userid, password, location
    '********************************************************************************
    Sub OpenMYSQL(conn, database, strserver, struserid, strpassword, strdriver)
    Set conn = Server.CreateObject("ADODB.Connection")
    dim drivername
    dim connstring
    on error resume next
    Set conn = Server.CreateObject("ADODB.Connection")
    If ucase(strdriver)="MYSQL351" then
    drivername="DRIVER={MYSQL ODBC 3.51 Driver};"
    else
    drivername="DRIVER={MySQL}; "
    end if
    connstring=drivername & " Server=" & strServer & "; Database=" & DataBase & "; UID=" & strUserid & "; PWD=" & strpassword
    Conn.Open connstring
    Verifydatabaseconnection conn
    end sub
    '*********************************************************************************
    ' tables could be in another database
    ' first read afh tables record, if it has nother database name we are in same
    ' database
    '*****************************************************************************
    Sub OpenDatabasetable (conn,dbtable, tableidfield)
    dim sql, rs, newdatabase, databasename
    dim databasetype, databaselocation, databaseuserid, databasepassword, databasedriver
    dim databaseserver, rc
    newdatabase=false
    Opendatabase conn
    sql="select * from afhtables where tablename='" & dbtable & "'"
    set rs=conn.execute(sql)
    if not rs.eof then
    databasename=getrsfield(rs, "tabledatabasename")
    tableidfield=getrsfield(rs,"tableidfield")
    if databasename>"" then
    newdatabase=true
    end if
    end if
    closerecordset rs
    If newdatabase=false then
    exit sub
    end if
    'It is another database so we need to get database record
    Getdatabaseattributes conn, databasename, databasetype, databaselocation, databaseserver, databaseUserid, databasepassword,databasedriver, rc
    closedatabase conn
    If rc=0 then
    OpenOtherdatabase conn, databasename, databaselocation, databaseserver, databaseUserid, databasepassword, databasedriver, databasetype
    else
    Writeerrormessage readlang("langinvalidtable") & " " & dbtable
    end if
    end sub
    '******************************************************************************
    ' from afhdatabase table get its attributes
    ' input is conn, databasename, all others are output
    '*****************************************************************************
    Sub Getdatabaseattributes(conn, databasename, databasetype, databaselocation, databaseserver, databaseUserid, databasepassword, databasedriver, rc)
    dim sql, rs
    sql="select * from afhdatabases where databasename='" & databasename & "'"
    set rs=conn.execute(sql)
    if rs.eof then
    closerecordset rs
    rc=4
    exit sub
    end if
    databasetype=GetRsField (rs, "databasetype")
    databaselocation=GetRsField (rs, "databaselocation")
    databaseserver=GetRsField (rs, "databaseserver")
    databaseuserid=GetRsField (rs, "databaseuserid")
    databasepassword=GetRsField (rs, "databasepassword")
    databasedriver=GetRsField (rs, "databasedriver")
    rc=0
    closerecordset rs
    end sub

    '******************************************************************************
    ' See if database is really open. If not tell user
    '******************************************************************************
    Sub Verifydatabaseconnection (conn)
    dim msg, count
    count=readsess("dbcounter")
    if count="" then
    count=0
    end if
    count=count+1
    writesess "dbcount",count
    If conn.state=adStateOpen then
    exit sub
    end if
    msg="Database Open Failed" & "<br>"
    msg=conn.errors(0).description & " <br>"
    if readsess("diagnostic")="" then
    WriteErrorMessage msg
    else
    writesess "errormessage",msg
    end if
    end sub

    '*******************************************************************************
    ' close database connection and count opens for debugging
    '
    '***********************************************************************************
    Sub CloseDatabase (conn)
    dim count
    on error resume next
    count=readsess("dbcounter")
    if count="" then
    count=1
    end if
    count=count-1
    writesess "dbcount",count
    conn.close
    set conn=nothing
    traceClosedatabase
    End sub

    '*************************************************************************
    ' Open a recordset so that it can be paged through
    '*************************************************************************
    Sub OpenRecordSetPaging (conn, sql, rs, pagesize, pagenumber, maxpages)
    Set rs = Server.CreateObject("ADODB.RecordSet")
    rs.cursorlocation=aduseclient
    If lcase(config_databasetype)<>"mysql" then
    rs.cachesize=5
    end if
    rs.Open sql,conn,adOpenKeyset,adLockReadOnly, adCmdText
    if not rs.eof then
    rs.movefirst
    rs.pagesize=pagesize
    maxpages=cint(rs.pagecount)
    pagesize=cint(rs.pagesize)
    rs.absolutepage=pagenumber
    end if
    end sub

    '********************************************************************
    ' Close and clear any open recordset
    '**********************************************************************
    Sub CloseRecordSet (irs)
    irs.close
    set irs=nothing
    end sub

    '*****************************************************
    ' Paging navigation bar
    '*****************************************************
    sub PageNavigation (sql, pagenumber, maxpages, pagesize)
    dim scriptname,counterstart,pad,counterend,counter,ref,mysql
    mysql=sql
    pad=""
    scriptname=request.servervariables("script_name")
    responsewrite htmlPageNavTable & htmlPageNavRow
    responsewrite htmlPageNavColumn & htmlPageNavFont
    if (pagenumber mod 10) = 0 then
    counterstart = pagenumber - 9
    else
    counterstart = pagenumber - (pagenumber mod 10) + 1
    end if
    counterend = counterstart + 9
    if counterend > maxpages then counterend = maxpages
    if counterstart <> 1 then
    ref="<a href='" & scriptname
    ref=ref & "?page=" & 1
    ref=ref & "'>" & readlang("langFirstPage") & "</a>&nbsp;:&nbsp;"
    Response.Write ref
    ref="<a href='" & scriptname
    ref=ref & "?page=" & (counterstart - 1)
    ref=ref & "'>" & readlang("langPrevpage") & " </a>&nbsp;"
    ResponseWrite ref
    end if
    ResponseWrite "["
    for counter=counterstart to counterend
    If counter>=10 then
    pad=""
    end if
    if cstr(counter) <> pagenumber then
    ref="<a href='" & scriptname
    ref=ref & "?page=" & counter
    ref=ref & "&pagesize=" & pagesize
    ' ref=ref & "&sqlQuery=" & server.URLencode(SQL)
    ref=ref & "'>" & pad & counter & "</a>"
    else
    ref="<b>" & pad & counter & "</b>"
    end if
    responsewrite ref
    if counter <> counterend then responsewrite " "
    next
    Response.Write "]"
    if counterend <> maxpages then
    ref="&nbsp;<a href='" & scriptname
    ref=ref & "?page=" & (counterend + 1)
    ref=ref & "'>" & readlang("langNextpage") & "</a>"
    ResponseWrite ref
    ref="&nbsp;:&nbsp;<a href='" & scriptname
    ref=ref & "?page=" & maxpages
    ref=ref & "'>" & readlang("langLastpage") & "</a>"
    ResponseWrite ref
    end if
    responsewrite "<br>" & htmlPageNavFontEnd
    responsewrite htmlPageNavTableEnd
    end sub
    '
    '*****************************************************
    ' Paging navigation bar
    '*****************************************************
    Sub PageNavigationNextPrevious (sql, pagenumber, maxpages, pagesize)
    dim scriptname,counterstart,pad,counterend,counter,ref,mysql
    dim nextpage, prevpage
    mysql=sql
    writesess "sqlquery",sql
    pad=""
    scriptname=request.servervariables("script_name")
    response.write PageNavTable & PageNavRow
    response.write PageNavColumn & PageNavFont
    nextpage=pagenumber+1
    prevpage=pagenumber-1
    if prevpage>=1 then
    ref="<a href='" & scriptname
    ref=ref & "?page=" & prevpage
    ref=ref & "'>"
    ref=ref & readlang("langprevpage")
    ref=ref & "</a>&nbsp;&nbsp;"
    Response.Write ref
    end if
    If Nextpage=< maxpages then
    ref="<a href='" & scriptname
    ref=ref & "?page=" & nextpage
    ref=ref & "'>"
    ref=ref & readlang("langnextpage")
    ref=ref & "</a>&nbsp;&nbsp;"
    Response.Write ref
    end if
    response.write "<br>" & PageNavFontEnd
    response.write PageNavTableEnd
    end sub

    '*******************************************************************************
    ' Input is a record set field. if it is null, then set to null
    '******************************************************************************
    Function Getrsitem(fieldvalue)
    if isnull(fieldvalue) then
    getrsitem=""
    else
    getrsitem=fieldvalue
    end if
    end function


    Function GetlastRecord(conn, table, idfield )
    dim lrs, lsql, id
    lsql="select max("& idfield & ") from " & table
    set lrs=conn.execute(lsql)
    id=lrs(0)
    closerecordset lrs
    getlastrecord=id
    end function

    '***********************************************************************
    ' Open a record set for reading
    '**********************************************************************
    Sub OpenRecordset (conn, rs, sql, eof)
    'on error resume next
    Set rs = conn.Execute(SQL)
    if not rs.eof then
    eof=false
    else
    eof=true
    end if
    end sub

    '*********************************************************************
    ' get the names of all tables in this database and in addition
    ' get tables that are defined in the configuration
    '********************************************************************
    Sub GetDataBaseTables (tables, tablecount,conn, databasetype)
    'set array tables with names of tables in database
    dim config_mysqltables
    config_mysqltables="afhadminlog,afhformlog,afhformresults,afhtables,afhusers"
    dim table, tblName
    redim tables(255)
    Dim othertables(200),othercount,j
    If lcase(config_databasetype)="mysql" then
    converttoarray config_mysqltables, tables, tablecount,","
    else
    Set table = conn.OpenSchema (20)
    tablecount=0
    do while not table.EOF
    tblName= table("Table_Name")
    If Left(tblName,4) <> "MSys" AND Left(tblName,3) <> "sys" AND Left(tblName,4) <> "RTbl" Then
    Tables(tablecount)=tblName
    tablecount=tablecount+1
    end if
    table.MoveNext
    loop
    end if
    end sub

    '**************************************************************************
    ' Retrieves a field from record set. if it is null set to nothing
    '***************************************************************************
    Function GetRsField (rs, fieldname)
    on error resume next
    'debugwrite "field=" & fieldname
    dim fieldvalue
    fieldvalue=rs(fieldname)
    if isnull(fieldvalue) then
    fieldvalue=""
    end if
    GetRsField=fieldvalue
    end function


    function writeToFile(line, file)
    set FSO = Server.CreateObject("scripting.FileSystemObject")
    set myFile = fso.OpenTextFile(file, 8, true)
    myFile.WriteLine(line)
    myFile.Close
    end function

    Function WriteToDictionary (fieldname, fieldvalue, dictionary)
    'set dictionary = CreateObject("Scripting.Dictionary")
    dictionary.Add fieldname, fieldvalue
    end function

    '*************************************************************************
    ' first see if person has logged in. If not redirect to general
    ' Error page
    ' otherwise see if they are allowed to use the file they say they are using
    '*************************************************************************
    Function Checkadminlogin (filename)
    dim userid, scriptname, sql, rs, conn, id, menus, eofflag,rc
    dim found, tempname, pos
    If readsess("adminlogin")="" then
    responseredirect "afhadmincookielogon.asp?filename=" & filename
    if rc>0 then
    WriteErrorMessage "Please login to Administation" & " 1"
    end if
    end if
    ' are we using some other form system
    If readsess("admindatabase")<>config_databasename then
    WriteErrorMessage "Please Logon to administration " & " 2"
    end if
    ' person has logged in But are they allowed to use this menu
    if filename="" then exit function
    end function
    '*********************************************************************
    ' See if table being used is authorized
    '********************************************************************
    Function CheckTableAuthorized (table)
    Dim UserTables(100), i, tablecount, rc
    rc=4
    if readconfig("configauthorizetables")<>"Yes" then
    rc=0
    else
    UserTables=readsess("UserTables")
    if UserTables="" then
    rc=0
    else
    converttoarray usertables, usertables, tablecount, ","
    for i = 0 to tablecount-1
    if lcase(table)=lcase(Usertables(i)) then
    rc=0
    exit for
    end if
    next
    end if
    end if
    CheckTableAuthorized=rc
    end function
    '*********************************************************************************
    ' for a table or a specific record then get fieldnames and values
    ' if recno<> empty get data for a specific record
    '**********************************************************************************
    Sub GetdatabaseFieldnames (Conn, dbtable, recordno, dbfieldnames, dbfieldtypes, dbfieldlengths, dbfieldvalues, dbfieldcount, idfield)
    dim sql, rs, i, eof
    sql="Select * from " & dbtable
    If recordno<>"" then
    sql=sql & " where " & idfield & "=" & recordno
    end if
    Openrecordset conn, rs, sql, eof
    If recordno<>"" then
    if rs.eof then
    dbfieldcount=0
    closerecordset rs
    exit sub
    end if
    end if
    ReadRsvalues rs, dbfieldnames, dbfieldtypes, dbfieldlengths, dbfieldvalues, dbfieldcount, idfield, recordno
    closerecordset rs
    end sub
    Sub readrsValues(rs, dbfieldnames, dbfieldtypes, dbfieldlengths, dbfieldvalues, dbfieldcount, idfield, recordno)
    dim fieldname, fieldvalue, fieldtype, fieldlength, fieldtypenum
    dim i
    dbfieldcount=RS.fields.count
    For i = 0 to dbfieldcount-1
    fieldname=Rs(i).name
    fieldlength=rs(i).definedsize
    fieldtypenum=Rs(i).type
    If recordno<>"" then
    fieldvalue=Rs(i).value
    else
    fieldvalue=""
    end if
    If isnull(fieldvalue) then
    fieldvalue=""
    end if
    'debugwrite "fn=" & fieldname & " val=" & fieldvalue & " flen=" & fieldlength & " ftype=" & fieldtypenum
    fieldtype=Convertdatabasefieldtype(fieldtypenum)
    if i=0 then
    idfield=fieldname
    end if
    dbfieldnames(i)=fieldname
    dbfieldtypes(i)=fieldtype
    dbfieldvalues(i)=fieldvalue
    dbfieldlengths(i)=fieldlength
    next
    end sub
    '********************************************************************************
    ' convert type int SQL server type
    '********************************************************************************
    Function Convertdatabasefieldtype(fieldtypenum)
    dim fieldtype
    Select Case fieldtypenum
    Case "3","2"
    fieldtype = "Int"
    Case "200","202"
    fieldtype = "Text"
    Case "129"
    Fieldtype = "Text"
    Case "201","203"
    fieldtype = "Memo"
    Case "6"
    fieldtype = "Currency"
    Case "11"
    fieldtype = "YesNo"
    Case "5"
    Fieldtype = "Double"
    Case "4"
    Fieldtype = "Double"
    Case "7", "133","135"
    Fieldtype = "Date"
    Case "134"
    Fieldtype = "Time"
    Case Else
    Fieldtype = "Text"
    End Select
    convertdatabasefieldtype=fieldtype
    end function
    '**********************************************************************
    ' Design ed add or updated a record. If updateaction is empty then
    ' record is add otherwise it is updated.
    ' recordno and idfield are used to locate the record to be updated
    '*************************************************************************
    Sub DatabaseupdateRecord (updateaction, conn, dbtable, idfield, recordno)
    If updateaction<>"" then
    DatabaseEditRecord conn, dbtable, idfield, recordno
    else
    DatabaseAddRecord conn, dbtable, idfield, recordno
    end if
    end sub

    '***************************************************************************
    ' The record exists, so we need to update the files of a specific record
    ' generate sql and update the record
    '************************************************************
    Sub databaseEditRecord (conn, dbtable, idfield, recordno)
    dim sqltemp, updatesql, i
    if dbuseexistingvalues=false then
    GetdatabaseFieldnames Conn, dbtable, recordno, dbfieldnames, dbfieldtypes, dbfieldlengths, dbfieldvalues, dbfieldcount, idfield
    end if
    for i=1 to dbfieldcount-1
    fieldname = dbfieldnames(i)
    fieldtype= dbfieldtypes(i)
    if dbuseexistingvalues=true then
    fieldvalue=dbfieldvalues(i)
    else
    fieldvalue = requestform(fieldname) ' fieldvalue from form
    end if
    ' debugwrite "fn=" & fieldname & "ft=" & fieldtype
    createupdatesql updatesql,fieldname,fieldvalue,fieldtype
    next
    'on error resume next
    updatesql ="update " & dbtable & " " & updatesql & " where " & idfield & "=" & recordno
    'debugwrite updatesql
    conn.execute(updatesql)
    end sub
    '*************************************************************************
    ' put value in quotes if need. make sure boolen and numerics are such
    '*************************************************************************
    Sub createupdatesql (updatesql,fieldname, fieldvalue,fieldtype)
    'on error resume next
    'Debugwrite "dbs fieldname & " value=" & fieldvalue & " fieldtype=" & fieldtype
    If updatesql="" then
    updatesql="SET "
    else
    updatesql= updatesql & ","
    end if
    if fieldvalue="" then
    fieldvalue="NULL"
    else
    DatabaseNormalizeFieldvalue fieldname, fieldvalue,fieldtype
    end if
    updatesql=updatesql & fieldname & "=" & fieldvalue
    end sub

    '"********************************************************************
    ' handle text, memo, dates booleans, Yesno
    '*********************************************************************
    Sub DatabaseNormalizeFieldValue (fieldname, Fieldvalue,fieldtype)
    dim tfieldtype
    tfieldtype=lcase(fieldtype)
    'debugwrite dbs fieldname & "=" & fieldvalue & " type=" & fieldtype
    select case tfieldtype
    case "133","date","datetime"
    If isdate(fieldvalue) then
    fieldvalue=datenormalize(fieldvalue)
    end if
    case "134","time"
    fieldvalue=formatdatetime(fieldvalue,vbshorttime)
    ' debugwrite "time=" & fieldvalue
    case "currency","double","int"
    exit sub
    case "yesno"
    if isnumeric(fieldvalue) then exit sub
    If ucase(fieldvalue)="FALSE" then
    fieldvalue=0
    exit sub
    else
    fieldvalue=1
    end if
    exit sub
    Case "16" ' tinyint
    If not isnumeric(fieldvalue) then
    If Fieldvalue="Yes" then
    fieldvalue=1
    else
    fieldvalue=0
    end if
    end if
    exit sub
    end select
    fieldvalue=replace(fieldvalue,"'","''")
    fieldvalue="'" & fieldvalue & "'"
    end sub
    '
    '*****************************************************************************
    ' insert into database the record and then record back the record no
    '***************************************************************************
    Sub DatabaseAddRecord (conn, dbtable, idfield, recordno)
    dim addnames, addvalues, sql, rs, i
    addnames=""
    addvalues=""
    if dbuseexistingvalues=false then
    GetdatabaseFieldnames Conn, dbtable, recordno, dbfieldnames, dbfieldtypes, dbfieldlengths, dbfieldvalues, dbfieldcount, idfield
    end if
    for i=1 to dbfieldcount-1
    fieldname = dbfieldnames(i)
    if dbuseexistingvalues=false then
    fieldvalue = requestform(fieldname)
    else
    fieldvalue=dbfieldvalues(i)
    end if
    fieldtype=dbfieldtypes(i)
    ' debugwrite "fn=" & fieldname & " fv=" & fieldvalue
    createinsertstring addnames,addvalues,fieldname,fieldvalue, fieldtype
    next
    sql="Insert into "& dbtable & "(" & addnames & ") values(" & addvalues & ")"
    'debugwrite sql
    if Addnames<>"" then
    conn.execute(sql)
    SQL="SELECT MAX(" & idfield & ") FROM " & dbtable
    set rs=conn.execute(sql)
    recordno=rs(0)
    closerecordset rs
    end if
    'debugwrite "recordno=" & recordno
    end sub

    '**********************************************************************************
    ' add name to add name and value to addavlues
    '*********************************************************************************
    Sub Createinsertstring (addnames, addvalues,fieldname, fieldvalue, fieldtype)
    if fieldvalue="" then
    exit sub
    end if
    DatabaseNormalizeFieldValue fieldname, Fieldvalue,fieldtype
    If addnames<>"" then
    addnames=addnames & ","
    addvalues=addvalues & ","
    end if
    addnames=addnames & fieldname
    addvalues=addvalues & fieldvalue
    end sub

    '************************************************************************
    ' Put date into form yyyy-mm-dd"
    '************************************************************************
    Function DateNormalize(indate)
    Dim yyyy,mm,dd,newdate
    yyyy=datepart("yyyy",indate)
    mm= datepart("m",indate)
    If len(mm)=1 then
    mm="0" & mm
    end if
    dd=datepart("d",indate)
    if len(dd)=1 then
    dd="0" & dd
    end if
    newdate=yyyy & "-" & mm & "-" & dd
    DateNormalize=newdate
    end Function

    Sub Deletedatabaserecord (conn, idfield, recordno)
    '****************************************************************************
    ' Delete the record and return to main edit menu
    '****************************************************************************
    dim sql
    sql="delete from " & dbtable & " where " & idfield & "=" & recordno
    conn.execute(sql)
    end sub

    Sub RsmoveNext (rs)
    rs.movenext
    end sub

    Sub Droptable (conn, tablename)
    on error resume next
    dim sql
    sql = "drop table " & tablename
    conn.execute (sql)
    end sub

    '
    '*****************************************************************************
    ' insert into database the record and then record back the record no
    ' The field values are already stored in formfields and formvalues array
    '***************************************************************************
    Sub DatabaseAddRecordfromForm (conn, dbtable, idfield, recordno)
    dim addnames, addvalues, sql, rs, i, rc
    addnames=""
    addvalues=""
    GetdatabaseFieldnames Conn, dbtable, recordno, dbfieldnames, dbfieldtypes, dbfieldlengths, dbfieldvalues, dbfieldcount, idfield
    for i=1 to dbfieldcount-1
    fieldname = dbfieldnames(i)
    FindFormRecordField fieldname, fieldvalue, "",rc
    fieldtype=dbfieldtypes(i)
    ' debugwrite "fn=" & fieldname & " fv=" & fieldvalue
    createinsertstring addnames,addvalues,fieldname,fieldvalue, fieldtype
    next
    sql="Insert into "& dbtable & "(" & addnames & ") values(" & addvalues & ")"
    'debugwrite sql
    conn.execute(sql)
    SQL="SELECT MAX(" & idfield & ") FROM " & dbtable
    set rs=conn.execute(sql)
    recordno=rs(0)
    closerecordset rs
    'debugwrite "recordno=" & recordno
    end sub

    Sub databaseEditRecordFromForm (conn, dbtable, idfield, recordno)
    dim sqltemp, updatesql, i, rc
    GetdatabaseFieldnames Conn, dbtable, recordno, dbfieldnames, dbfieldtypes, dbfieldlengths, dbfieldvalues, dbfieldcount, idfield
    for i=1 to dbfieldcount-1
    fieldname = dbfieldnames(i)
    fieldtype= dbfieldtypes(i)
    FindFormRecordField fieldname, fieldvalue, "",rc
    ' fieldvalue = requestform(fieldname) ' fieldvalue from form
    ' debugwrite "fn=" & fieldname & "ft=" & fieldtype
    createupdatesql updatesql,fieldname,fieldvalue,fieldtype
    next
    on error resume next
    updatesql ="update " & dbtable & " " & updatesql & " where " & idfield & "=" & recordno
    conn.execute(updatesql)
    end sub

    '********************************************************************
    ' readconfig retrieves a configuration value
    '
    '*********************************************************************
    Function readconfigApp (fieldname)
    dim tempname
    tempname=fieldname & "_" & configapplicationname
    readconfig=Application(tempname)
    end function
    '
    '********************************************************************
    ' updateconfig sets avalue in the configuration memory
    '
    '*********************************************************************
    Function updateconfigapp (fieldname, value)
    dim tempname
    tempname=fieldname & "_" & configapplicationname
    Application(tempname)=value
    end function

    '********************************************************************
    ' updateconfig sets avalue in the configuration memory
    '
    '*********************************************************************
    Function Setlangapp (fieldname, value)
    dim tempname
    tempname=fieldname & "_" & configapplicationname
    Application(tempname)=value
    end function

    '********************************************************************
    ' Goes to another ASP file using response.redirect
    '
    '*********************************************************************
    Sub responseredirect (url)
    response.redirect url
    end sub
    '
    '*******************************************************************
    ' all languages now in application variables
    ' either default language or session language
    '*******************************************************************
    Function readlangapp (fieldname)
    dim tempname, tempvalue, tempnamesess
    tempname=fieldname & "_" & configapplicationname
    tempvalue=Application(tempname)
    If tempvalue="" then
    tempvalue="???? " & fieldname
    end if
    readlang=tempvalue
    end function

    Function Setlangapp (fieldname, value)
    dim tempname
    tempname=fieldname & "_" & configapplicationname
    Application(tempname)=value
    end function

    '***************************************************************************
    ' add field to database table
    '***************************************************************************
    sub Databaseaddfield (conn, dbtable, databasetype, fieldname, fieldtype, fieldlength)
    dim sql
    sql=""
    select case lcase(databasetype)
    case "access"
    createaccessaddsql dbtable, fieldname, fieldtype, fieldlength,sql
    case "sqlserver"
    createsqlserveraddsql dbtable, fieldname, fieldtype, fieldlength, sql
    case "mysql"
    CreateMysqlAddAql dbtable, fieldname, fieldtype, fieldlength,sql
    end select
    conn.execute(sql)
    end sub

    sub createaccessaddsql (dbtable, fieldname, fieldtype, fieldlength,sql)
    dim fieldvalue
    select case lcase(fieldtype)
    case "text"
    fieldvalue="text (" & fieldlength & ")"
    case "memo"
    fieldvalue="memo"
    case "int"
    fieldfield="long"
    case "currency"
    fieldvalue="Currency"
    case "yesno"
    fieldvalue="yesno"
    case "double","real"
    fieldvalue="double"
    case "datetime","date","time"
    fieldvalue="datetime"
    case else
    fieldvalue="text (" & fieldlength & ")"
    end select
    sql="alter table " & dbtable & " add " & fieldname & " " & fieldvalue & " NULL"
    end sub
    sub CreateSqlserverAddSql (dbtable, fieldname, fieldtype, fieldlength,sql)
    dim fieldvalue
    select case lcase(fieldtype)
    case "text"
    fieldvalue="varchar (" & fieldlength & ")"
    case "memo"
    fieldvalue="varchar (" & "2000" & ")"
    case "int"
    fieldfield="int"
    case "currency"
    fieldvalue="Money"
    case "yesno"
    fieldvalue="bit"
    case "double","real"
    fieldvalue="real"
    case "datetime","date","time"
    fieldvalue="datetime"
    case else
    fieldvalue="varchar (" & fieldlength & ")"
    end select
    sql="alter table " & dbtable & " add " & fieldname & " " & fieldvalue & " NULL"
    end sub

    sub CreateMYSQLAddAql (dbtable, fieldname, fieldtype, fieldlength,sql)
    dim fieldvalue
    select case lcase(fieldtype)
    case "text"
    fieldvalue="varchar (" & fieldlength & ")"
    case "memo"
    fieldvalue="longtext"
    case "int"
    fieldfield="int"
    case "currency"
    fieldvalue="real"
    case "yesno"
    fieldvalue="tinyint"
    case "double","real"
    fieldvalue="double"
    case "datetime","date"
    fieldvalue="date"
    case "time"
    fieldvalue="time"
    case else
    fieldvalue="varchar (" & fieldlength & ")"
    end select
    sql="alter table " & dbtable & " add " & fieldname & " " & fieldvalue & " NULL"
    end sub
    '***********************************************************************
    ' Get cookie logon data
    '**************************************************************************
    Sub CheckCookieLogon (RC)
    dim username, userpassword, hashpassword, temppass
    dim sql, rs
    RC=4
    'debugwrite "username=" & Request.Cookies("afhuserid")
    'debugwrite "userpassword=" & Request.Cookies("afhpassword")
    username = Request.Cookies("afhuserid")
    userpassword = Request.Cookies("afhpassword")
    If username="" or userpassword="" then
    exit sub
    end if
    if not isvalidtextfield(username) then
    exit sub
    end if
    if not isvalidtextfield(userpassword) then
    exit sub
    end if
    opendatabase dbc
    sql = "select * from afhusers where adminuserid='" & username & "'"
    OpenRecordset dbc, rs, sql, eof
    if eof=true then
    closerecordset rs
    closedatabase dbc
    exit sub
    end if
    temppass=rs("adminpassword")
    closerecordset rs
    'temppass=lcase(temppass)
    'hashpassword=convertmd5(temppass)
    hashpassword=temppass
    'debugwrite "hash=" & hashpassword & " cookie=" & userpassword & " db=" & temppass
    if hashpassword<>userpassword then
    closedatabase dbc
    exit sub
    end if
    writesess "adminlogin" ,username
    writesess "admindatabase",config_databasename
    UpdateLogin username, dbc
    closedatabase dbc
    SaveCookieLogin username, userpassword, xcookiedays
    rc=0
    end sub

    '****************************************************************************
    ' Update login table each time someone logs in
    '**************************************************************************
    Sub Updatelogin(userid, dbc)
    dim indate, intime
    indate=datenormalize(getcurrentdate())
    intime=time()
    useripaddy=request.servervariables("REMOTE_ADDR")
    on error resume next
    login = "insert into afhadminlog (loguserid,logtime,logdate,logaction,logipaddress) "
    login=login & " values('" & userid & "','" & inTime & "','" & inDate & "','" & "login" & "','" & useripaddy & "')"
    dbc.Execute(login)
    End Sub

    '
    '**********************************************************************
    ' save login for quick login again
    ' if days=-1 then cookie is deleted
    '**************************************************************************
    Sub SaveCookieLogin (userid, password, days)
    If xallowcookielogin<>"Yes" then exit sub
    Response.Cookies("afhuserid")=userid
    Response.Cookies("afhuserid").expires=date()+days
    Response.Cookies("afhpassword")=password
    Response.Cookies("afhpassword").expires=date()+days
    end sub
    '***********************************************************************
    ' uses parameters passed from user
    '**********************************************************************
    Sub OpenOtherdatabase (conn, databasename, databaselocation, databaseserver, databaseUserid, databasepassword, databasedriver, databasetype)
    dim temptype
    dim noforce
    noforce=""
    temptype=lcase(databasetype) ' type of database
    select case temptype
    Case "access"
    OpenAccess conn, databasename,databaselocation
    Case "sqlserver"
    OpenSqlserver conn, databasename, databaseserver, databaseUserid, databasepassword
    Case "mysql"
    OpenMysqL conn, databasename, databaseserver, databaseUserid, databasepassword,databasedriver
    case "odbc"
    Openodbc conn, databasename
    Case else
    OpenAccess conn, databasename,databaselocation
    end select
    end sub
    '***************************************************************************
    ' get information from afhtables table
    '**************************************************************************
    Sub GettableAttributes (iconn, table, tableidfield, tablestatusfield, tabledatabasename)
    dim conn, rs, sql
    tableidfield="resultid"
    tablestatusfield="resultstatus"
    tabledatabasename=""
    sql="select * from afhtables where tablename='" & table & "'"
    set rs=iconn.execute(sql)
    if not rs.eof then
    tableidfield=getrsfield(rs,"tableidfield")
    tablestatusfield=getrsfield(rs,"tablestatusfield")
    tabledatabasename=getrsfield(rs,"tabledatabasename")
    end if
    closerecordset rs
    end sub
    '*************************************************************************
    ' get all tables in afhtables table
    '**********************************************************************
    sub GetAFHDataBaseTables (tables, tablecount,iconn)
    dim sql, rs
    tablecount=0
    redim tables(255)
    sql="select * from afhtables order by tablename"
    set rs=iconn.execute(sql)
    do while not rs.eof
    tables(tablecount)=rs("tablename")
    tablecount=tablecount+1
    rs.movenext
    loop
    closerecordset rs
    end sub

    Sub TraceOpendatabase
    if afhtracedatabase<>"Yes" then exit sub
    dim counter
    counter=readsess("dbopencounter")
    if counter="" then counter=0
    counter=counter+1
    writesess "dbopencounter",counter
    response.write "OPENS=" & counter & "<br>"
    end sub

    Sub TraceClosedatabase
    if afhtracedatabase<>"Yes" then exit sub
    dim counter
    counter=readsess("dbopencounter")
    counter=counter-1
    if counter<0 then
    response.write "CLOSE NEGATIVE=" & counter & "<br>"
    counter=0
    end if
    writesess "dbopencounter",counter
    response.write "CLOSES=" & counter & "<br>"
    end sub
    %>

  4. #4
    SitePoint Guru
    Join Date
    Jun 2007
    Posts
    675
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    there are many possible sources for this type of error and it will be difficult to resolve through a forum like this one.

    you will need to start debugging the problem by verifying what values are being sent to the subroutine and then step through the code with those values to see what is failing.

    since it is a syntax error - my guess is the problem will be in this secondary subroutine "createaccessaddsql "

  5. #5
    SitePoint Member
    Join Date
    Oct 2010
    Posts
    4
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    I don't have access to any application to help me with debugging. I would like to use this code http://snippets.dzone.com/posts/show/10023 but I don't have to connect to my database with a script I posted below. Do you have any available script I can plug in with this code? I just need to be able to post a few dynamic rows at a time into a database.

    Many thanks,
    Debbie

  6. #6
    SitePoint Guru
    Join Date
    Jun 2007
    Posts
    675
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    if you need someone to write a solution for you then you will likely be better off to hire someone ...

  7. #7
    SitePoint Member
    Join Date
    Oct 2010
    Posts
    4
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Thank you

  8. #8
    SitePoint Addict
    Join Date
    Apr 2009
    Posts
    356
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)
    Insert a response.write sql just before the actual database operation (probably the line before the error line), then review the sql string to see where the error is. Then you can look back to the section of code that's creating that part of the sql string to see if you can identify the source of the problem.

    Often it's a missing input value that the code assumes is present but isn't.
    Doug G
    =====
    "If you ain't the lead dog, the view is always the same - Anon


Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •