Advertisement
Advertisement
| 03.11.2008 at 09:34AM PDT, ID: 23232337 |
|
[x]
Attachment Details
|
||
|
[x]
The Solution Rating System
|
||
With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.
Your Input Matters If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support. Thank you! |
||
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: |
Public Function DataSelect(strQuery As String, Optional params As Collection, Optional isSQLQuery As Boolean, Optional replaceAsIs As Boolean) As ADODB.Recordset
On Error GoTo Err_DS
Dim count As Integer
If IsNull(isSQLQuery) Or Not isSQLQuery Then strQuery = CodeDb.QueryDefs(strQuery).SQL
If m_adoCnn.State <> adStateOpen Then
OpenConnection g_strConnectionString
End If
Dim adoCmd As New ADODB.Command
Dim adors As New ADODB.Recordset
If Not (params Is Nothing) Then
If IsNull(replaceAsIs) Or Not replaceAsIs Then
For count = 1 To params.count
strQuery = Replace$(strQuery, params.Item(count).Name, "'" & params.Item(count).value & "'", , , vbTextCompare)
Next count
Else
For count = 1 To params.count
strQuery = Replace$(strQuery, params.Item(count).Name, params.Item(count).value, , , vbTextCompare)
Next count
End If
End If
Debug.Print strQuery
Set adoCmd.ActiveConnection = m_adoCnn
adoCmd.CommandType = adCmdText
adoCmd.CommandText = strQuery
adors.Open adoCmd, , adOpenForwardOnly, adLockReadOnly
Set adors.ActiveConnection = Nothing
Dim rs As ADODB.Recordset
Set rs = CloneRS(adors)
Set DataSelect = rs
adors.Close
Set adors = Nothing
Set adoCmd = Nothing
Exit_DS:
Exit Function
Err_DS:
HandleSecurityProblem err.Number, err.Description
MsgBox ("Error in DataSelect" & Chr(13) & "Error # " & str(err.Number) & " was generated by " & err.Source & Chr(13) & err.Description)
Set DataSelect = Null
Resume Exit_DS
End Function
'-------------------------------------------------------------------------
Public Function CloneRS(ByVal oRs As ADODB.Recordset) As ADODB.Recordset
Dim oStream As ADODB.Stream
Dim oRsClone As ADODB.Recordset
Dim str As String
Dim intIdIndex As Integer
Dim intAttrEndIndex As Integer
Dim intAttrWriteIndex As Integer
'save the recordset to the stream object
Set oStream = New ADODB.Stream
oRs.Save oStream, adPersistXML
str = oStream.ReadText
intIdIndex = InStr(1, str, "s:AttributeType name='ID'", vbTextCompare)
If (intIdIndex > 0) Then
intAttrEndIndex = InStr(intIdIndex, str, ">", vbTextCompare)
intAttrWriteIndex = InStr(intIdIndex, str, "rs:writeunknown='true'", vbTextCompare)
If ((intAttrEndIndex > intAttrWriteIndex) And (intAttrWriteIndex > intIdIndex)) Then
str = Replace$(oStream.ReadText, "rs:writeunknown='true'", "", , 1, vbTextCompare)
End If
str = Replace$(str, "s:AttributeType name='id'", "s:AttributeType name='id' rs:writeunknown='true'", , , vbTextCompare)
End If
oStream.position = 0
oStream.WriteText str
oStream.position = 0
'and now open the stream object into a new recordset
Set oRsClone = New ADODB.Recordset
oRsClone.Open oStream, , adOpenKeyset, adLockPessimistic
'return the cloned recordset
Set CloneRS = oRsClone
'release the reference
oStream.Close
Set oStream = Nothing
Set oRsClone = Nothing
End Function
|
