command

WAPmo手机网站管理平台是一款创建与管理维护WAP网站的的软件产品

Private clsDB, strTableName, strCacheName
Private objItem, objTemp
Private strCommandType
Private strColumn, strWhere, strSort

Private Sub Class_Initialize()
    Set clsDB = Nothing
    Set objItem = Server.CreateObject(PROGID_HASH)
    Set objTemp = Server.CreateObject(PROGID_HASH)
    strColumn = "*"
End Sub

Private Sub Class_Terminate()
    Set objTemp = Nothing
    Set objItem = Nothing
    Set clsDB = Nothing
End Sub

Public Property Let Implement(clsImpl)
    Set clsDB = clsImpl
End Property

Public Property Let Table(ByVal strValue)
    Dim rs, strSQL, strName
    Dim arr, ptr
    strTableName = strValue
    strCacheName = "Table." & strTableName
    If IsEmpty(GetCache(strCacheName)) Then
        strSQL = clsDB.GetLimitSQL(1, "*", strTableName, "0=1", "", "")
        Set rs = clsDB.Exec2(strSQL)
        For Each ptr In rs.Fields
            strName = LCase(ptr.Name)
            Select Case ptr.Type
            Case adTinyInt, adSmallInt, adInteger, adUnsignedTinyInt, adUnsignedSmallInt, adUnsignedInt, adSingle
                objItem(strName) = Array(strName, ptr.Type, ptr.DefinedSize, 0)
            Case adDouble, adCurrency, adDecimal, adNumeric, adBigInt, adUnsignedBigInt
                objItem(strName) = Array(strName, ptr.Type, ptr.DefinedSize, CDbl(0))
            Case Else
                objItem(strName) = Array(strName, ptr.Type, ptr.DefinedSize, Empty)
            End Select
        Next
        rs.Close
        Set rs = Nothing
        setCache strCacheName, objItem.Items
    Else
        arr = GetCache(strCacheName)
        For Each ptr In arr
            objItem(ptr(0)) = ptr
        Next
    End If
End Property

Public Property Get Table()
    Table = strTableName
End Property

Public Property Let CommandType(ByVal strValue)
    strCommandType = strValue
End Property

Public Property Let Column(ByVal strValue)
    strColumn = strValue
End Property

Public Property Let Where(ByVal strValue)
    strWhere = strValue
End Property

Public Property Let Sort(ByVal strValue)
    strSort = strValue
End Property

Public Sub Add(ByVal strKey, ByVal vtValue)
    Dim arr
    Dim strName
    strName = LCase(strKey)
    arr = objItem(strName)
    If Not IsArray(arr) Then
        Err.Raise vbObjectError + 1, "Command.Add", "Missing field: " & strKey
    End If
    Select Case arr(1)
    Case adTinyInt, adSmallInt, adInteger, adUnsignedTinyInt, adUnsignedSmallInt, adUnsignedInt, adSingle
        arr(3) = atol(vtValue)
    Case adDouble, adCurrency, adDecimal, adNumeric, adBigInt, adUnsignedBigInt
        arr(3) = atof(vtValue)
    Case Else
        arr(3) = atos(vtValue)
    End Select
    objTemp(strName) = arr
End Sub

Public Function Exec()
    Dim rs, strSQL
    Dim ret
    Select Case strCommandType
    Case "SELECT"
        strSQL = clsDB.GetLimitSQL(1, strColumn, strTableName, strWhere, "", strSort)
        Set rs = clsDB.Exec2(strSQL)
        ret = CBool(Not rs.EOF)
        If ret Then
            Me.Source = rs
        End If
        rs.Close
        Set rs = Nothing
    Case "INSERT"
        ret = clsDB.Exec(GetInsertText())
    Case "UPDATE"
        ret = clsDB.Exec(GetUpdateText())
    Case Else
        Err.Raise vbObjectError + 1, "Command.Exec", "Missing command type: " & strCommandType
    End Select
    strCommandType = Empty
    strColumn = "*"
    strWhere = Empty
    strSort = Empty
    Exec = ret
End Function

Public Property Let Source(rs)
    Dim arr, ptr
    Dim strName
    For Each ptr In rs.Fields
        strName = LCase(ptr.Name)
        arr = objItem(strName)
        If IsArray(arr) Then
            Select Case arr(1)
            Case adTinyInt, adSmallInt, adInteger, adUnsignedTinyInt, adUnsignedSmallInt, adUnsignedInt, adSingle
                arr(3) = atol(ptr.Value)
            Case adDouble, adCurrency, adDecimal, adNumeric, adBigInt, adUnsignedBigInt
                arr(3) = atof(ptr.Value)
            Case Else
                arr(3) = atos(ptr.Value)
            End Select
            objItem(strName) = arr
        End If
    Next
End Property

Public Default Property Get Item(ByVal strKey)
    Dim arr
    arr = objItem(LCase(strKey))
    If IsArray(arr) Then
        Item = arr(3)
    End If
End Property

Public Property Let Item(ByVal strKey, vtValue)
    Dim arr
    Dim strName
    strName = LCase(strKey)
    arr = objItem(strName)
    If IsArray(arr) Then
        Select Case arr(1)
        Case adTinyInt, adSmallInt, adInteger, adUnsignedTinyInt, adUnsignedSmallInt, adUnsignedInt, adSingle
            arr(3) = atol(vtValue)
        Case adDouble, adCurrency, adDecimal, adNumeric, adBigInt, adUnsignedBigInt
            arr(3) = atof(vtValue)
        Case Else
            arr(3) = atos(vtValue)
        End Select
        objItem(strName) = arr
    End If
End Property

Public Property Get Keys()
    Keys = objItem.Keys
End Property

Public Property Get Items()
    Items = objItem.Items
End Property

Public Sub Clear()
    Dim arr, ptr
    arr = GetCache(strCacheName)
    For Each ptr In arr
        objItem(ptr(0)) = ptr
    Next
End Sub

Public Function GetInsertText()
    Dim ret, tmp
    Dim arr, ptr, i
    ret = "INSERT INTO $(Table) ($(Column)) VALUES ($(Value))"
    ret = Replace(ret, "$(Table)", strTableName)
    ret = Replace(ret, "$(Column)", Join(objTemp.Keys, ","))
    arr = objTemp.Items
    ReDim tmp(UBound(arr))
    For i = 0 To UBound(arr)
        ptr = arr(i)
        Select Case ptr(1)
        Case adTinyInt, adSmallInt, adInteger, adUnsignedTinyInt, adUnsignedSmallInt, adUnsignedInt, adSingle
            tmp(i) = ptr(3)
        Case adDouble, adCurrency, adDecimal, adNumeric, adBigInt, adUnsignedBigInt
            tmp(i) = ptr(3)
        Case Else
            tmp(i) = "'" & ADOString(ptr) & "'"
        End Select
    Next
    ret = Replace(ret, "$(Value)", Join(tmp, ","))
    GetInsertText = ret
    objTemp.RemoveAll
End Function

Public Function GetUpdateText()
    Dim ret, tmp
    Dim key, arr, ptr, i
    ret = "UPDATE $(Table) SET $(Update) WHERE $(Where)"
    ret = Replace(ret, "$(Table)", strTableName)
    ret = Replace(ret, "$(Where)", strWhere)
    key = objTemp.Keys
    arr = objTemp.Items
    ReDim tmp(UBound(arr))
    For i = 0 To UBound(arr)
        ptr = arr(i)
        Select Case ptr(1)
        Case adTinyInt, adSmallInt, adInteger, adUnsignedTinyInt, adUnsignedSmallInt, adUnsignedInt, adSingle
            tmp(i) = key(i) & "=" & ptr(3)
        Case adDouble, adCurrency, adDecimal, adNumeric, adBigInt, adUnsignedBigInt
            tmp(i) = key(i) & "=" & ptr(3)
        Case Else
            tmp(i) = key(i) & "=" & "'" & ADOString(ptr) & "'"
        End Select
    Next
    ret = Replace(ret, "$(Update)", Join(tmp, ","))
    GetUpdateText = ret
    objTemp.RemoveAll
End Function

Private Function ADOString(arr)
    Dim ret
    Select Case arr(1)
    Case adChar, adVarChar
        ret = LeftC(arr(3), arr(2))
    Case adWChar, adVarWChar
        ret = Left(arr(3), arr(2))
    Case Else
        ret = arr(3)
    End Select
    ADOString = SafeString(ret)
End Function