sql插入删除模板源代码

sql插入删除模板源代码

原码：
<%
Option Explicit
const field         =0
const value         =1
const table         =0
const deal         =1
const fgDeal     =":"     '表名与操作方式之间的分隔符
const fgTable     =","     '表名与表名之间的分隔符
const fgValue     ="="     '字段与表单元素名之间的分隔符
const fgField     =","     '字段与字段之间的分隔符

dim table_name     '表名及操作方式(可多个)以半角逗号(,)隔开，表名与操作方式以半角冒号":"分开
dim for_x
dim for_y
dim table_sum               '表名个数
dim fields                   '字段字符串
redim table_fields(1)     '字段列表

table_name     =request.Form("SQLtable")

'-----------------------------------------------------------------------------------
'     SQL语句处理
'-----------------------------------------------------------------------------------
Function ensql(data)
    ensql="'"&replace(request.Form(data),"'","''")&"'"
End Function

'-----------------------------------------------------------------------------------
'     根椐不同的操作方式生成不同的SQL语句。
'     参数：
'         fdeal     ：操作方式（如：update,delete,addnew等）
'         ftable     ：操作的数据表。
'         ffield     ：字段数组
'     返回：
'         操作成功，返回true
'         操作失败，返回false
'-----------------------------------------------------------------------------------
function checkdeal(byval fdeal,byval ftable,byval ffield)
    dim fields_sum
    dim ffor_x
    dim fSQL
    dim faddnewfield
    dim faddnewvalue
    dim fupdatewhere

    checkdeal=true
    fields_sum=-1

    if isArray(ffield) then
        fields_sum=ubound(ffield)
    end if
    fupdatewhere=request.Form("SQL"&ftable&"Where")
    if fupdatewhere<>"" then fupdatewhere=" where "&fupdatewhere
    select case fdeal
        case "delete"
              if fupdatewhere<>"" then
                  fSQL="delete from "&ftable&" where "
                  fSQL=fSQL&fupdatewhere
              end if
        case "update"
              if not fields_sum=-1 then
                  fSQL="update "&ftable&" set "
                  for ffor_x=0 to fields_sum
                      fSQL=fSQL&ffield(ffor_x)(field)&"="&ensql(ffield(ffor_x)(value))
                      if ffor_x=0 then fSQL=fSQL&","
                  next
                  fSQL=fSQL&fupdatewhere
              end if
        case "addnew"
              if not fields_sum=-1 then
                  fSQL="insert into "
                  for ffor_x=0 to fields_sum
                      faddnewfield=faddnewfield&ffield(ffor_x)(field)
                      faddnewvalue=faddnewvalue&ensql(ffield(ffor_x)(value))
                      if ffor_x<>fields_sum then
                            faddnewvalue=faddnewvalue&","
                            faddnewfield=faddnewfield&","
                      end if
                  next
                  fSQL=fSQL&"("&faddnewfield&")values("&faddnewvalue&")"
              end if
    end select
    if fSQL="" then
        checkdeal=false
    else
        '[-----以下是完整的SQL语句-----]
        response.Write fSQL
        '[-----以上是完整的SQL语句-----]
    end if
end function

table_name=split(table_name,fgTable)     '切分以","分隔的组合表名，生成一个数组
table_sum=ubound(table_name)
redim table_fields(table_sum)

for for_x=0 to table_sum
    table_name(for_x)=split(table_name(for_x),fgDeal)     '提取每个组合表名，将表名与操作方式分割。
    fields=request.Form("SQL"&table_name(for_x)(table))     '读取每个表的字段名列表。
    if fields<>"" then
        table_fields(for_x)=split(fields,fgField)         '切分字段名列表。
        for for_y=0 to ubound(table_fields(for_x))
              table_fields(for_x)(for_y)=split(table_fields(for_x)(for_y),fgValue)     '将字段名与表单切分。
        next
    end if
next


for for_x=0 to table_sum
    if checkdeal(table_name(for_x)(deal),table_name(for_x)(table),table_fields(for_x)) then
        response.Write "<br/>"
        response.Write "["&table_name(for_x)(table)&"] 操作成功。<br/>"
    else
        response.Write "["&table_name(for_x)(table)&"] 操作不成功。<br/>"
    end if
next
%>
///////////////////////////////////////////////////////////////
说明：
本程序只是作到了生成SQL语句，如果要正常使用的话，必须自行声明数据库链接对象。并在生成完成的SQL语句处执行SQL语句才可以。

使用例子：
以下例子中处理的表有：vip,order,card
其中：
    表vip的操作是delete删除数据。
    表order的操作是update更新数据
    表card的操作是addnew插入新数据。
说明
    表名提交格式(SQLtable)：表名：操作方式，表名：操作方式，......，表名：操作方式(以上的：和，均为半角)
    字段的hidden名为"SQL"+表的表名。
    update更新字段条件句的hidden名为"SQL"+表的表名+"Where"
    delete删除数据条件句的hidden名为"SQL"+表的表名+"Where"
    字段提交格式：字段名=表单元素名,字段名=表单元素名

<form name=form1 method=post action=auto_sql.asp>
    <input type=hidden name=SQLtable value="vip:delete,order:update,card:addnew"><!--表名及操作方式-->
    <input type=hidden name=SQLvipWhere value="name='text1' and sex='text2'"><!--vip表删除的条件式-->
    <input type=hidden name=SQLorder value="money=text3,goods=text4"><!--order表的字段名及对应的元素名-->
    <input type=hidden name=SQLorderWhere value="money='text3' and goods='text4'"><!--order表的更新条件-->
    <input type=hidden name=SQLcard value="money=text3,goods=text4"><!--card插入的字段名及对应元素名-->
<!--以下是自定义的元素名-->
    <input type=hidden name=text1 value="oyiboy">
    <input type=hidden name=text2 value="男">
    <input type=hidden name=text3 value="30">
    <input type=hidden name=text4 value="电脑">
<input type="submit" value="Submit" id="Submit2" name="Submit1">
</form>

本例子缺点：
一、无法判断值的类型，所有值都是以字符串来处理。
二、更新或删除条件比较狭窄。
三、无法进行表与表之间的添加数据。
///////////////////////////////////////////////////////////////
关注.
提示1:插入,修改,删除分开做比较好
提示2:用一个字典描述要处理的字段类型

实际上这样的模版我已经有了,正在优化中.
由于相关东西比较多,说明起来比较复杂,
以后会拿出来一起探讨的.
///////////////////////////////////////////////////////////////


Option Explicit
Private conn As ADODB.Connection
Private ScriptingContext As ScriptingContext
Private response As response
Private cmdType As Integer '操作类型
Private cmdTable As String
Private glbSqlStr1, glbSqlStr2 As String
Private glbSqlFilter As String
Private strConn As String
Private glbSqlOthers As String
Private rcount As Long
'类初始化
Private Sub Class_Initialize()
strConn = "Server=(local);Provider=Sqloledb.1;Initial Catalog=test;uid=sa;pwd="
Set conn = New ADODB.Connection
conn.CursorLocation = adUseClient
conn.Open strConn
'初始化属性
cmdType = 0
rcount = 0
End Sub
Public Property Let DataBase(ByVal dbName As String)
  conn.Close
  strConn = "Server=softsrv;Provider=Sqloledb.1;Initial Catalog=" & dbName & ";uid=Sa;pwd="
  conn.CursorLocation = adUseClient
  conn.Open strConn

End Property
'类结束
Private Sub Class_Terminate()
conn.Close
Set conn = Nothing
End Sub
'ASP页面引入
Public Sub OnStartPage(PassedScriptingContext As ScriptingContext)
Set ScriptingContext = PassedScriptingContext
Set response = ScriptingContext.response
End Sub
Public Sub onEndPage()
  Set ScriptingContext = Nothing
  Set response = Nothing
End Sub
'操作类型属性
'1：查询 2：添加 3：修改 4：删除
Public Property Let commandType(ByVal operationType As Integer)
  cmdType = operationType
  If commandType > 4 Or commandType < 1 Then
    response.Write ("属性设置错误！")
    response.End
  End If
End Property
Public Property Get commandType() As Integer
  commandType = cmdType
End Property
'操作表的属性
Public Property Let commandTable(ByVal operationTable As String)
  cmdTable = operationTable
  If InStr(cmdTable, " ") > 0 Then
    response.Write ("表名设置错误！")
    response.End
  End If

  If cmdType = 0 Then
    response.Write ("请先设置操作类型！")
    response.End
  End If
  Select Case cmdType:
    Case 1:
          glbSqlStr1 = "select "
          glbSqlStr2 = " from " & cmdTable
    Case 2:
        glbSqlStr1 = "insert into " & cmdTable & "("
    Case 3:
        glbSqlStr1 = "update " & cmdTable & " set "
    Case 4:
        glbSqlStr1 = "delete from " & cmdTable & " where "
  End Select
End Property
Public Property Get commandTable() As String
  commandTable = cmdTable
End Property
Public Property Let recordCounts(ByVal topNrecords As Long)
  rcount = topNrecords
End Property

'添加参数的方法对不同的操作类型对应自动产生SQL语句
Public Sub appendParameter(ByVal fieldName As String, Optional ByVal fieldType As Boolean, _
                  Optional ByVal newValue As Variant)
  fieldName = Trim(fieldName)
  If InStr(fieldName, "'") > 0 Or InStr(fieldName, " ") > 0 Then
    response.Write ("字段名错误！")
    response.End
    Exit Sub
  End If

  If Not (IsMissing(newValue)) Then
    newValue = Replace(newValue, "'", "''")
    newValue = Replace(newValue, "--", "- - ")
    newValue = Replace(newValue, "/*", "/ *")
  End If

  Select Case cmdType:
    Case 1:
        glbSqlStr1 = glbSqlStr1 & fieldName & ","
    Case 2:
        glbSqlStr1 = glbSqlStr1 & fieldName & ","
        If fieldType Then
          glbSqlStr2 = glbSqlStr2 & "'" & newValue & "',"
        Else
          glbSqlStr2 = glbSqlStr2 & newValue & ","
        End If
    Case 3:
        If fieldType Then
          glbSqlStr1 = glbSqlStr1 & " " & fieldName & "='" & newValue & "',"
        Else
          glbSqlStr1 = glbSqlStr1 & " " & fieldName & "=" & newValue & ","
        End If
  End Select

End Sub
///////////////////////////////////////////////////////////////
'组件
Public Sub appendFilter(ByVal fieldName As String, ByVal fieldType As Boolean, _
                ByVal filterType As String, ByVal fieldValue As Variant)

  fieldName = Trim(fieldName)
  If InStr(fieldName, "'") > 0 Or InStr(fieldName, " ") > 0 Then
    response.Write ("字段名错误！")
    response.End
    Exit Sub
  End If

  If Not (IsMissing(fieldValue)) Then
    fieldValue = Replace(fieldValue, "'", "''")
    fieldValue = Replace(fieldValue, "--", "- - ")
    fieldValue = Replace(fieldValue, "/*", "/ *")
  End If

  filterType = Trim(filterType)
  If Len(filterType) > 4 Then
    response.Write "条件错误！"
    response.End
    Exit Sub
  End If
'此处要添加错误处理
  If fieldType Then
    If Trim(filterType) <> "like" Then
      glbSqlFilter = glbSqlFilter & fieldName & " " & filterType & " '" & fieldValue & "' and "
    Else
      glbSqlFilter = glbSqlFilter & fieldName & " " & filterType & " '%" & fieldValue & "%' and "
    End If
  Else
    glbSqlFilter = glbSqlFilter & fieldName & " " & filterType & " " & fieldValue & " and "
  End If
End Sub
Public Sub appendOthers(ByVal OtherSQL As String)
  glbSqlOthers = glbSqlOthers & OtherSQL
End Sub
Public Function execute() As Variant
  Dim executeCommand As String
    glbSqlStr1 = Trim(glbSqlStr1)
    glbSqlStr2 = Trim(glbSqlStr2)
    glbSqlFilter = Trim(glbSqlFilter)

    If Len(glbSqlStr1) > 1 And Right(glbSqlStr1, 1) = "," Then
        glbSqlStr1 = Left(glbSqlStr1, Len(glbSqlStr1) - 1)
    End If
    If Len(glbSqlStr2) > 1 And Right(glbSqlStr2, 1) = "," Then
        glbSqlStr2 = Left(glbSqlStr2, Len(glbSqlStr2) - 1)
    End If
    If Len(glbSqlFilter) > 3 Then
        glbSqlFilter = Left(glbSqlFilter, Len(glbSqlFilter) - 3)
    End If
    Select Case cmdType:
        Case 1:
          If rcount > 0 Then
            glbSqlStr1 = "select top " & rcount & " " & Right(glbSqlStr1, Len(glbSqlStr1) - 6)
          End If
          If Len(glbSqlFilter) > 1 Then
            executeCommand = glbSqlStr1 & " " & glbSqlStr2 & " where " _
                        & glbSqlFilter
          Else
            executeCommand = glbSqlStr1 & " " & glbSqlStr2
          End If
        Case 2:
          executeCommand = glbSqlStr1 & ") values(" & glbSqlStr2 & ")"
        Case 3:
          executeCommand = glbSqlStr1 & " where " & glbSqlFilter
        Case 4:
          executeCommand = glbSqlStr1 & " " & glbSqlFilter
    End Select
    If glbSqlOthers <> "" Then
        executeCommand = executeCommand & glbSqlOthers
    End If
  On Error GoTo errorHD
    Select Case cmdType:
        Case 1:
          Set execute = conn.execute(executeCommand)
        Case 2:
          Dim rs As New ADODB.Recordset
          conn.execute executeCommand
          Set rs = conn.execute("select top 1 @@identity from" & cmdTable)
          execute = rs(0)
        Case 3, 4:
          conn.execute (executeCommand)
          execute = 1
    End Select
    Exit Function
errorHD:
  response.Write Err.Description
  response.Write executeCommand
  response.End
End Function
Function newid() As String
  Dim rs As New ADODB.Recordset
  Dim sqlstrs As String
  sqlstrs = "select top 1 newid() from content"
  rs.Open sqlstrs, conn, adOpenStatic
  newid = rs(0)
  Set rs = Nothing
End Function
Public Sub reset()
  glbSqlStr1 = ""
  glbSqlStr2 = ""
  glbSqlFilter = ""
  cmdTable = ""
  cmdType = 0
  glbSqlOthers = ""
End Sub

Public Function queryBySQL(strSQL) As ADODB.Recordset
  Dim rs As New ADODB.Recordset
  On Error GoTo errHandle
    Set rs = CreateObject("ADODB.Recordset")
    strSQL = Replace(strSQL, "--", "- - ")
    If InStr(1, CStr(strSQL), "/*", vbTextCompare) > 0 Then GoTo errHandle
    rs.Open strSQL, conn, adOpenStatic, adLockOptimistic
    Set queryBySQL = rs: Exit Function
errHandle:
  Set queryBySQL = Nothing
End Function
Public Function updateBySql(strSQL As Variant) As Long
  On Error GoTo errHandle
    strSQL = Replace(strSQL, "--", "- - ")
    If InStr(1, CStr(strSQL), "/*", vbTextCompare) > 0 Then: GoTo errHandle
    conn.execute strSQL
    updateBySql = 1: Exit Function
errHandle:
  updateBySql = -1
End Function

因为Execute方法不能进行多表操作,不得以最后又加了两个以SQL语句为参数的方法.特点:可以改变操作的数据库名,可以处理不同的字段类型,可以使用比较复杂的查询条件