[转载]一个ASP（VBScript）简单SQL语句构建“类”

文章作者：曾思源

原文：一个ASP（VBScript）简单SQL语句构建“类”

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<% Option Explicit %>
<% Response.Buffer = True %>
<%
&#39; /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
&#39; ///
&#39; ///  文件名: SQLBuilderForVbs
&#39; ///  作用: 构建一些简单的SQL语句，结合在提交表单时使用，可以较方便
&#39; ///  程式编写者: 曾思源
&#39; ///  说明: 简单SQL语句构建“类”,VBS版,只要保留本注释段，无论是否涉及商业，您可以任意使用，转载或引用
&#39; ///  日期: 2005-1-8
&#39; ///_________________________________________________________________________________________________
&#39; /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%>
<%
On Error Resume Next



Class QuestStringBuilder



  Private objFields
  Private strTableName
  Private strPKey
  Private strPKeySort
  Private strCondition
  Private aContition()
  Private strOperator
  Private strLogic
  Private blnState



  &#39;/-----初始化-----/



  Private Sub Class_Initialize()
  Set objFields = Server.CreateObject("Scripting.Dictionary")
  strTableName = Null
  strPKey = Null
  strPKeySort = Null
  strCondition = Null
  ReDim aContition(1)
  strOperator = "="
  strLogic = " AND "
  blnState = False
  End Sub



  Private Sub Class_Terminate()
  Set objFields = Nothing
  strTableName = Null
  strPKey = Null
  strPKeySort = Null
  strCondition = Null
  Erase aContition
  strOperator = Null
  strLogic = Null
  blnState = False
  End Sub



  &#39; /----字段名处理----/



  Private Function ProcessField(ByVal sField)
  ProcessField = "[" & sField & "]"
  End Function



  &#39; /-----字段值处理-----/



  Private Function ProcessValue(ByVal sValue)
  Dim tmpType : tmpType = VarType(sValue)
  Select Case tmpType
   Case 2,3,4,5,11 &#39; 数字类型，布尔类型
    ProcessValue = sValue
   Case 8  &#39; 字符类型
    ProcessValue = "&#39;" & Safe(sValue) & "&#39;"
   Case Else  &#39; 其它类型
    ProcessValue = "&#39;" & Safe(sValue) & "&#39;"
  End Select
  End Function



  &#39; /-----综合处理-----/



  Private Function Process(ByRef obj, ByVal strType)
  Dim Keys : Keys = obj.Keys
  Dim Items : Items = obj.Items
  Dim intCount : intCount = obj.Count
  Dim tmp()
  ReDim tmp(1)
  If intCount > 0 Then
   Dim tmpArray(), I
   ReDim tmpArray(intCount-1)
   For I=0 To intCount - 1
    tmpArray(I) = Keys(I) & "=" & Items(I)
   Next
   Select Case UCase(Trim(strType))
    Case "UPDATE"
    Process = Join(tmpArray, ", ")
    Case "SELECT"
    Process = Join(Keys, " ,")
    Case "INSERT"
    tmp(0) = Join(Keys, " ,")
    tmp(1) = Join(Items, " ,")
    Process = tmp
    Erase tmp
   End Select
   Erase tmpArray
  Else
   Select Case UCase(Trim(strType))
    Case "UPDATE"
    Process = False
    Case "SELECT"
    Process = "*"
    Case "INSERT"
    Process = tmp
   End Select
  End If
  End Function



  &#39; /-----小小的安全处理-----/



  Private Function Safe(s)
  Safe = Replace(s,"&#39;","&#39;")
  End Function



  &#39; /-----清空上一次输入的参数，但保留TableName-----/



  Public Sub Clear()
  objFields.RemoveAll
  &#39;strTableName = Null
  strPKey = Null
  strPKeySort = Null
  strCondition = Null
  Erase aContition
  strOperator = "="
  strLogic = " AND "
  blnState = False
  End Sub



  &#39; /----生成查询语句----/



  Public Function getSelect()
  Dim strSQLTemplate : strSQLTemplate = "SELECT {fields} FROM {table} {conditions} {orderby} {sort}"  
  strSQLTemplate = Replace(strSQLTemplate, "{fields}", Process(objFields, "SELECT"))
  If VarType(strTableName) = 1 Then Exit Function
  strSQLTemplate = Replace(strSQLTemplate, "{table}", strTableName)
  If VarType(strCondition) <> 1 And strCondition <> "" Then
   strSQLTemplate = Replace(strSQLTemplate, "{conditions}", " WHERE " & strCondition)
  Else
   strSQLTemplate = Replace(strSQLTemplate, "{conditions}", "")
  End If
  If VarType(strPKey) <> 1 And strPKey <> "" Then
   strSQLTemplate = Replace(strSQLTemplate, "{orderby}", " ORDER BY " & strPKey)
  Else
   strSQLTemplate = Replace(strSQLTemplate, "{orderby}", "")
  End If
  If VarType(strPKeySort) <> 1 And strPKeySort <> "" Then
   strSQLTemplate = Replace(strSQLTemplate, "{sort}", strPKeySort)
  Else
   strSQLTemplate = Replace(strSQLTemplate, "{sort}", "")
  End If
  getSelect = strSQLTemplate
  blnState = True
  End Function



  &#39; /----生成插入语句----/



  Public Function getInsert()
  Dim strSQLTemplate : strSQLTemplate = "INSERT INTO {table}({fields}) VALUES({values})"
  If VarType(strTableName) = 1 Then Exit Function
  strSQLTemplate = Replace(strSQLTemplate, "{table}", strTableName)
  Dim srtInsertContent : srtInsertContent = Process(objFields, "INSERT")
  If VarType(srtInsertContent) <> 11 Then
   strSQLTemplate = Replace(strSQLTemplate, "{fields}", srtInsertContent(0))
   strSQLTemplate = Replace(strSQLTemplate, "{values}", srtInsertContent(1))   
  Else
   Exit Function
  End If
  getInsert = strSQLTemplate
  blnState = True
  End Function



  &#39; /----生成更新语句----/
  
  Public Function getUpdate()
  Dim strSQLTemplate : strSQLTemplate = "UPDATA {table} SET {updatecontent} {conditions}"
  If VarType(strTableName) = 1 Then Exit Function
  strSQLTemplate = Replace(strSQLTemplate, "{table}", strTableName)
  If Process(objFields, "UPDATE") <> False Then
   strSQLTemplate = Replace(strSQLTemplate, "{updatecontent}", Process(objFields, "UPDATE"))
  Else
   strSQLTemplate = Replace(strSQLTemplate, "{updatecontent}", "")
  End If
  If VarType(strCondition) <> 1 And strCondition <> "" Then
   strSQLTemplate = Replace(strSQLTemplate, "{conditions}", " WHERE " & strCondition)
  Else
   strSQLTemplate = Replace(strSQLTemplate, "{conditions}", "")
  End If
  getUpdate = strSQLTemplate
  blnState = True
  End Function



  &#39; /----生成删除语句----/



  Public Function getDelete()
  Dim strSQLTemplate : strSQLTemplate = "DELETE FROM {table} {conditions}"
  If VarType(strTableName) = 1 Then Exit Function
  strSQLTemplate = Replace(strSQLTemplate, "{table}", strTableName)
  If VarType(strCondition) <> 1 And strCondition <> "" Then
   strSQLTemplate = Replace(strSQLTemplate, "{conditions}", " WHERE " & strCondition)
  Else
   strSQLTemplate = Replace(strSQLTemplate, "{conditions}", "")
  End If
  getDelete = strSQLTemplate
  blnState = True
  End Function



  &#39; /----生成取记录数语句----/



  Public Function getCount()
  Dim strSQLTemplate : strSQLTemplate = "SELECT COUNT(*) FROM {table} {conditions}"
  If VarType(strTableName) = 1 Then Exit Function
  strSQLTemplate = Replace(strSQLTemplate, "{table}", strTableName)
  If VarType(strCondition) <> 1 And strCondition <> "" Then
   strSQLTemplate = Replace(strSQLTemplate, "{conditions}", " WHERE " & strCondition)
  Else
   strSQLTemplate = Replace(strSQLTemplate, "{conditions}", "")
  End If
  getCount = strSQLTemplate
  blnState = True
  End Function



  &#39; /----添加处理字段及相应值----/



  Public Sub AddField(ByVal sField, ByVal sValue)
  If VarType(sField) = 8 And Len(sField) > 0 And  (VarType(sValue) = 8 Or VarType(sValue) <> 1) Then
   objFields.Add ProcessField(sField), ProcessValue(sValue)
  End If
  End Sub
  
  &#39; /----添加条件字段及相应值----/



  Public Sub AddCField(ByVal sField, ByVal sValue)
  If VarType(sField) = 8 And Len(sField) > 0 And  VarType(sValue) = 8 And Len(sValue) > 0 Then
   Dim strCDTemplate : strCDTemplate = "{Field}{Operator}{value}"
   strCDTemplate = Replace(strCDTemplate,"{Field}", ProcessField(sField))
   strCDTemplate = Replace(strCDTemplate,"{Operator}"," " & strOperator & " ")
   If UCase(strOperator) = "LIKE" Then
    strCDTemplate = Replace(strCDTemplate,"{value}","&#39;%" & Safe(sValue) & "%&#39;")
   Else
    strCDTemplate = Replace(strCDTemplate,"{value}",ProcessValue(sValue))
   End If
   If VarType(strCondition) = 1 Then
    ReDim aContition(0)
    aContition(0) = strCDTemplate
    strCondition = Join(aContition, strLogic)
   Else
    strCondition = aContition(0)
    ReDim aContition(1)
    aContition(0) = strCondition
    aContition(1) = strCDTemplate
    strCondition = Join(aContition, strLogic)
    aContition(0) = strCondition
   End If
   &#39;Response.Write strCondition & "<br>"
  End If
  End Sub



  &#39; /----指定表名或视图名----/



  Public Property Let Table(ByVal s)
  If VarType(s) = 8 And Len(s) > 0 Then strTableName = "[" & s & "]"
  End Property



  &#39; /----设定主键----/



  Public Property Let PrimaryKey(ByVal s)
  If VarType(s) = 8 And Len(s) > 0 Then strPKey =  "[" & s & "]"
  End Property



  &#39; /----主键排序----/



  Public Property Let Sort(ByVal s)
  If VarType(s) = 8 And Len(s) > 0 Then strPKeySort =  UCase(s)
  End Property



  &#39; /----更改条件子句操作符----/



  Public Property Let Operator(ByVal s)
  If VarType(s) = 8 And Len(s) > 0 Then strOperator =  UCase(s)
  End Property



  &#39; /----更改条件子句逻辑----/



  Public Property Let Logic(ByVal s)
  If VarType(s) = 8 And Len(s) > 0 Then strLogic =  " " & UCase(s) & " "
  End Property



  &#39; /----返回返执行状态----/



  Public Property Get ActionState
  ActionState = blnState
  End Property



End Class



&#39; /----演视开始----/



Dim sql, T1, T2



T1 = Timer()



Set sql = New QuestStringBuilder

sql.AddField "FRemark", "这是一个备注"
sql.AddField "FName", "思源"
sql.AddField "FCode", 120245
sql.Operator = "<"
sql.AddCField "FID", 1000
sql.Logic = "or"
sql.Operator = "like"
sql.AddCField "FFriend", "思源"
sql.Table = "FriendShip"
sql.PrimaryKey = "FID"
sql.Sort = "desc"



Response.Write "<pre>"
Response.Write "<font color=blue>基于ASP(VBS版)的简单SQL语句生成“类”：</font>"
Response.Write "<br>" & vbCrLf
Response.Write "查询语句：<font color=#666666>" & Sql.getSelect() & "</font>"
Response.Write "<br>" & vbCrLf
Response.Write "插入语句：<font color=#666666>" & Sql.getInsert() & "</font>"
Response.Write "<br>" & vbCrLf
Response.Write "更新语句：<font color=#666666>" & Sql.getUpdate() & "</font>"
Response.Write "<br>" & vbCrLf
Response.Write "删除语句：<font color=#666666>" &  Sql.getDelete() & "</font>"
Response.Write "<br>" & vbCrLf
Response.Write "取记录数：<font color=#666666>" &  Sql.getCount() & "</font>"



&#39;sql.Clear()



Response.Write "<br>" & vbCrLf



Response.Write "生成SQL语句是否成功：<font color=#666666>" & sql.ActionState & "</font>"

Set sql = Nothing



T2 = Timer()



Response.Write "<br>" & vbCrLf

Response.Write "程式执行时间：<font color=#666666>" & (T2 -  T2)*1000 & " 晕这个时间好像算不出来啊-_-!</font>"



Response.Write "<br>" & vbCrLf



Response.Write "程式作者：<font color=#666666>阿汉（思源）</font>"



Response.Write "</pre>"



Response.Write Err.Description
%>

演视地址：Vbs.asp">http://www.6dz.net/portfolio/SQLBuilderForVbs.asp