basic/qa/vba_tests/ole_ObjAssignNoDflt.vb

   1 Option VBASupport 1
   2 Function doUnitTest( TestData as String) as String
   3 Rem Ensure object assignment is by reference
   4 Rem when object member is used ( as lhs )
   5 Dim origTimeout As Long
   6 Dim modifiedTimout As Long
   7 Set cn = New ADODB.Connection
   8 origTimeout = cn.CommandTimeout
   9 modifiedTimeout = origTimeout * 2
  10 cn.CommandTimeout = modifiedTimeout
  11 Dim conStr As String
  12 conStr = "Provider=MSDASQL;Driver={Microsoft Excel Driver (*.xls)};DBQ="
  13 conStr = conStr & TestData & "; ReadOnly=False;"
  14 cn.Open conStr
  15 Set objCmd = New ADODB.Command
  16 objCmd.ActiveConnection = cn
  17 If objCmd.ActiveConnection.CommandTimeout <> modifiedTimeout Then
  18     Rem if we copied the object by reference then we should have the
  19     Rem modified timeout ( because we should be just pointing as cn )
  20     doUnitTest = "FAIL expected modified timeout " & modifiedTimeout & " but got " &  objCmd.ActiveConnection.CommandTimeout
  21     Exit Function
  22 End If
  23 cn.CommandTimeout = origTimeout ' restore timeout
  24 Rem Double check objCmd.ActiveConnection is pointing to objCmd.ActiveConnection
  25 If objCmd.ActiveConnection.CommandTimeout <> origTimeout Then
  26     doUnitTest = "FAIL expected orignal timeout " & origTimeout & " but got " &  objCmd.ActiveConnection.CommandTimeout
  27     Exit Function
  28 End If
  29 doUnitTest = "OK" ' no error
  30 End Function