<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<% Option Explicit %>
<% Response.Buffer = True %>
<%
' /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
' ///
' /// 文件名: SQLBuilderForVbs
' /// 作用: 构建一些简单的SQL语句，结合在提交表单时使用，可以较方便
' /// 程式编写者: 曾思源
' /// 说明: 简单SQL语句构建“类”,VBS版,只要保留本注释段，无论是否涉及商业，您可以任意使用，转载或引用
' /// 日期: 2005-1-8
' ///_________________________________________________________________________________________________
' /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%>
<%
On Error Resume Next
Class QuestStringBuilder
Private objFields
Private strTableName
Private strPKey
Private strPKeySort
Private strCondition
Private aContition()
Private strOperator
Private strLogic
Private blnState
'/-----初始化-----/
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
' /----字段名处理----/
Private Function ProcessField(ByVal sField)
ProcessField = "[" & sField & "]"
End Function
' /-----字段值处理-----/
Private Function ProcessValue(ByVal sValue)
Dim tmpType : tmpType = VarType(sValue)
Select Case tmpType
Case 2,3,4,5,11 ' 数字类型，布尔类型
ProcessValue = sValue
Case 8 ' 字符类型
ProcessValue = "'" & Safe(sValue) & "'"
Case Else ' 其它类型
ProcessValue = "'" & Safe(sValue) & "'"
End Select
End Function
' /-----综合处理-----/
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
' /-----小小的安全处理-----/
Private Function Safe(s)
Safe = Replace(s,"'","''")
End Function
' /-----清空上一次输入的参数，但保留TableName-----/
Public Sub Clear()
objFields.RemoveAll
'strTableName = Null
strPKey = Null
strPKeySort = Null
strCondition = Null
Erase aContition
strOperator = "="
strLogic = " AND "
blnState = False
End Sub
' /----生成查询语句----/
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
' /----生成插入语句----/
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
' /----生成更新语句----/
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
' /----生成删除语句----/
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
' /----生成取记录数语句----/
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
' /----添加处理字段及相应值----/
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
' /----添加条件字段及相应值----/
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}","'%" & Safe(sValue) & "%'")
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
'Response.Write strCondition & "<br>"
End If
End Sub
' /----指定表名或视图名----/
Public Property Let Table(ByVal s)
If VarType(s) = 8 And Len(s) > 0 Then strTableName = "[" & s & "]"
End Property
' /----设定主键----/
Public Property Let PrimaryKey(ByVal s)
If VarType(s) = 8 And Len(s) > 0 Then strPKey = "[" & s & "]"
End Property
' /----主键排序----/
Public Property Let Sort(ByVal s)
If VarType(s) = 8 And Len(s) > 0 Then strPKeySort = UCase(s)
End Property
' /----更改条件子句操作符----/
Public Property Let Operator(ByVal s)
If VarType(s) = 8 And Len(s) > 0 Then strOperator = UCase(s)
End Property
' /----更改条件子句逻辑----/
Public Property Let Logic(ByVal s)
If VarType(s) = 8 And Len(s) > 0 Then strLogic = " " & UCase(s) & " "
End Property
' /----返回返执行状态----/
Public Property Get ActionState
ActionState = blnState
End Property
End Class
' /----演视开始----/
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>"
'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
%>
演视地址：http://www.6dz.net/portfolio/SQLBuilderForVbs.asp
本文地址：http://com.8s8s.com/it/it7549.htm