I have developed a VB COM component which is working on MTS under windows NT 4.0 server but not under win 2K under component services. Errors out on Set objDBUtil = objContxt.CreateInstance("PTSDUTIL.DataAccess"). Error is type mismatch at createinstance.
Thanks, I would really appreciate any help.
Samir.
Code as follows:
'##ModelId=38287C2001B0
Public Function fValidateLogon(sUserID As String, _
sPassWord As String, _
sIPAddress As String, _
sBrowserInfo As String) As String
Dim StrSql As String
Dim dblSessionID As Double
Dim strRetVal As String
Dim objContxt As ObjectContext
Dim objRS As ADODB.Recordset
Dim objDBUtil As PTSDUTIL.DataAccess
Dim intColcnt As Variant
Dim lngRowCnt As Variant
Dim strErrTxt As Variant
strRetVal = "0"
On Error GoTo fValidateLogon_Err
'Get the Object Context
Set objContxt = GetObjectContext
objContxt.DisableCommit
'Creating the Instance of UTIL DATA ACCESS Component.
sUserID = Trim(UCase(sUserID))
StrSql = "Select staff_id from T019_STAFF_PROFILE " & _
" where upper(STAFF_ID) = '" & sUserID & _
"' AND upper(PASSWORD) ='" & Trim(UCase(sPassWord)) & "'"
Set objDBUtil = objContxt.CreateInstance("PTSDUTIL.DataAccess")
Set objRS = objDBUtil.GetDataRS(StrSql, intColcnt, lngRowCnt, strErrTxt)
objRS.Close
Set objRS = Nothing
If strErrTxt <> "0" Then
GoTo fValidateLogon_Err
End If
If lngRowCnt > 0 Then
'Not an end of file, So there is some record in it.
StrSql = "SELECT session_id from
Set objRS = objDBUtil.GetDataRS(StrSql, intColcnt, lngRowCnt, strErrTxt)
If strErrTxt <> "0" Then
GoTo fValidateLogon_Err
End If
If lngRowCnt > 0 Then
dblSessionID = objRS!session_id
dblSessionID = dblSessionID + 1
objRS.Close
Set objRS = Nothing
' PCR : 64624 : 09/04/03 Start
If Len(sBrowserInfo) > 80 Then
sBrowserInfo = Mid(sBrowserInfo, 1, 80)
End If
' PCR : 64624 : 09/04/03 End
'Update the table
StrSql = "UPDATE set session_id = " & dblSessionID
If Not objDBUtil.ExecuteSQL(StrSql, strErrTxt) Then
GoTo fValidateLogon_Err
End If
'Insert into table
StrSql = "INSERT INTO ip_address, " & _
" first_access_datetime, last_access_datetime)" & _
" values(" & dblSessionID & ",'" & sIPAddress & _
"',sysdate,sysdate)"
If Not objDBUtil.ExecuteSQL(StrSql, strErrTxt) Then
GoTo fValidateLogon_Err
End If
'Insert into table
StrSql = "INSERT INTO staff_id, " & _
" login_datetime, logout_datetime, browser_info, remote_addr)" & _
" values( " & dblSessionID & " ,'" & sUserID & "', sysdate, NULL,'" & _
sBrowserInfo & "','" & sIPAddress & "')"
If Not objDBUtil.ExecuteSQL(StrSql, strErrTxt) Then
GoTo fValidateLogon_Err
End If
strRetVal = CStr(dblSessionID)
End If
Else
strRetVal = "-1"
End If
'objContxt.SetComplete
If strRetVal <> "-1" Then
'Insert into table
StrSql = "INSERT INTO argument_name, " & _
" argument_value) values(" & dblSessionID & _
",'userid','" & sUserID & "')"
If Not objDBUtil.ExecuteSQL(StrSql, strErrTxt) Then
GoTo fValidateLogon_Err
End If
End If
'Commit the Transactions
objContxt.EnableCommit
objContxt.SetComplete
fValidateLogon_Exit:
fValidateLogon = strRetVal
If Not objRS Is Nothing Then
If objRS.State = adStateOpen Then
objRS.Close
End If
Set objRS = Nothing
End If
If Not objDBUtil Is Nothing Then
Set objDBUtil = Nothing
End If
If Not objContxt Is Nothing Then
Set objContxt = Nothing
End If
Exit Function
fValidateLogon_Err:
strRetVal = CStr(strErrTxt)
If strRetVal = "" Then
strRetVal = " Unknown Error Occured in PTSDCHKLOGIN - fValidateLogon " & Err.Number & Err.Description & StrSql
End If
objContxt.SetAbort
GoTo fValidateLogon_Exit
End Function
Thanks, I would really appreciate any help.
Samir.
Code as follows:
'##ModelId=38287C2001B0
Public Function fValidateLogon(sUserID As String, _
sPassWord As String, _
sIPAddress As String, _
sBrowserInfo As String) As String
Dim StrSql As String
Dim dblSessionID As Double
Dim strRetVal As String
Dim objContxt As ObjectContext
Dim objRS As ADODB.Recordset
Dim objDBUtil As PTSDUTIL.DataAccess
Dim intColcnt As Variant
Dim lngRowCnt As Variant
Dim strErrTxt As Variant
strRetVal = "0"
On Error GoTo fValidateLogon_Err
'Get the Object Context
Set objContxt = GetObjectContext
objContxt.DisableCommit
'Creating the Instance of UTIL DATA ACCESS Component.
sUserID = Trim(UCase(sUserID))
StrSql = "Select staff_id from T019_STAFF_PROFILE " & _
" where upper(STAFF_ID) = '" & sUserID & _
"' AND upper(PASSWORD) ='" & Trim(UCase(sPassWord)) & "'"
Set objDBUtil = objContxt.CreateInstance("PTSDUTIL.DataAccess")
Set objRS = objDBUtil.GetDataRS(StrSql, intColcnt, lngRowCnt, strErrTxt)
objRS.Close
Set objRS = Nothing
If strErrTxt <> "0" Then
GoTo fValidateLogon_Err
End If
If lngRowCnt > 0 Then
'Not an end of file, So there is some record in it.
StrSql = "SELECT session_id from
Set objRS = objDBUtil.GetDataRS(StrSql, intColcnt, lngRowCnt, strErrTxt)
If strErrTxt <> "0" Then
GoTo fValidateLogon_Err
End If
If lngRowCnt > 0 Then
dblSessionID = objRS!session_id
dblSessionID = dblSessionID + 1
objRS.Close
Set objRS = Nothing
' PCR : 64624 : 09/04/03 Start
If Len(sBrowserInfo) > 80 Then
sBrowserInfo = Mid(sBrowserInfo, 1, 80)
End If
' PCR : 64624 : 09/04/03 End
'Update the table
StrSql = "UPDATE set session_id = " & dblSessionID
If Not objDBUtil.ExecuteSQL(StrSql, strErrTxt) Then
GoTo fValidateLogon_Err
End If
'Insert into table
StrSql = "INSERT INTO ip_address, " & _
" first_access_datetime, last_access_datetime)" & _
" values(" & dblSessionID & ",'" & sIPAddress & _
"',sysdate,sysdate)"
If Not objDBUtil.ExecuteSQL(StrSql, strErrTxt) Then
GoTo fValidateLogon_Err
End If
'Insert into table
StrSql = "INSERT INTO staff_id, " & _
" login_datetime, logout_datetime, browser_info, remote_addr)" & _
" values( " & dblSessionID & " ,'" & sUserID & "', sysdate, NULL,'" & _
sBrowserInfo & "','" & sIPAddress & "')"
If Not objDBUtil.ExecuteSQL(StrSql, strErrTxt) Then
GoTo fValidateLogon_Err
End If
strRetVal = CStr(dblSessionID)
End If
Else
strRetVal = "-1"
End If
'objContxt.SetComplete
If strRetVal <> "-1" Then
'Insert into table
StrSql = "INSERT INTO argument_name, " & _
" argument_value) values(" & dblSessionID & _
",'userid','" & sUserID & "')"
If Not objDBUtil.ExecuteSQL(StrSql, strErrTxt) Then
GoTo fValidateLogon_Err
End If
End If
'Commit the Transactions
objContxt.EnableCommit
objContxt.SetComplete
fValidateLogon_Exit:
fValidateLogon = strRetVal
If Not objRS Is Nothing Then
If objRS.State = adStateOpen Then
objRS.Close
End If
Set objRS = Nothing
End If
If Not objDBUtil Is Nothing Then
Set objDBUtil = Nothing
End If
If Not objContxt Is Nothing Then
Set objContxt = Nothing
End If
Exit Function
fValidateLogon_Err:
strRetVal = CStr(strErrTxt)
If strRetVal = "" Then
strRetVal = " Unknown Error Occured in PTSDCHKLOGIN - fValidateLogon " & Err.Number & Err.Description & StrSql
End If
objContxt.SetAbort
GoTo fValidateLogon_Exit
End Function