' ########################################################################################
' Microsoft Windows
' File: oledb32.inc
' Copyright (c) 2011 Jos? Roca
' Portions Copyright (c) Microsoft Corporation.
' All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
#IF NOT %DEF(PBX_OLEDB32_PBI)
#DEFINE PBX_OLEDB32_PBI
%EQUATE `OLEDB32_INC = 1
#INCLUDE ONCE "Legacy/COM/oledb.inc"
#INCLUDE ONCE "Legacy/COM/oledberr.inc"
#INCLUDE ONCE "Legacy/UI/cmdtree.inc"
#INCLUDE ONCE "Legacy/COM/oledbdep.inc"
#INCLUDE ONCE "Legacy/System/msdasc.inc" ' // MS OLE DB Service Component
#INCLUDE ONCE "Legacy/UI/msdaguid.inc" ' // ODBC provider include files
#INCLUDE ONCE "Legacy/Data/msdasql.inc"
#INCLUDE ONCE "Legacy/COM/jetoledb.inc" ' // MS JET provider files
#INCLUDE ONCE "Legacy/COM/MsJetOleDb.inc"
#INCLUDE ONCE "Legacy/COM/sqloledb.inc" ' // MS OLE DB Provider for SQL Server
' ========================================================================================
' Helper function to retrieve detailed contextual error information.
' Return values: S_OK (Success), S_FALSE (no error object to return).
' ========================================================================================
FUNCTION OleDbGetErrorInfo ( BYREF bstrDescription AS WSTRING ' Textual description of the error
 , OPTIONAL BYREF bstrSource AS WSTRING ' ProgID for the class or application that returned the error
 , OPTIONAL BYREF pguid AS GUID ' GUID for the interface that defined the error
 , OPTIONAL BYREF bstrHelpFile AS WSTRING ' Path of the Help file that describes the error
 , OPTIONAL BYREF dwHelpContext AS DWORD ' Help context identifier for the error
 ) AS LONG
 LOCAL hr AS LONG
 LOCAL pIErrorInfo AS IErrorInfo
 hr = GetErrorInfo(0, pIErrorInfo)
 IF hr THEN FUNCTION = hr : EXIT FUNCTION
 ' GetErrorInfo can succeed and return a null pointer in pIErrorInfo,
 ' so test the returned pointer to make sure it is valid.
 IF ISFALSE ISOBJECT(pIErrorInfo) THEN FUNCTION = %S_FALSE : EXIT FUNCTION
 IF VARPTR(bstrDescription) THEN
 pIErrorInfo.GetDescription(bstrDescription)
 END IF
 IF VARPTR(pguid) THEN
 pIErrorInfo.GetGUID(pguid)
 END IF
 IF VARPTR(bstrSource) THEN
 pIErrorInfo.GetSource(bstrSource)
 END IF
 IF VARPTR(bstrHelpFile) THEN
 pIErrorInfo.GetHelpFile(bstrHelpFile)
 END IF
 IF VARPTR(dwHelpContext) THEN
 pIErrorInfo.GetHelpContext(dwHelpContext)
 END IF
 pIErrorInfo = NOTHING
END FUNCTION
' ========================================================================================
' ========================================================================================
' Displays error information.
' ========================================================================================
SUB OleDbShowErrorInfo (BYVAL nErrorCode AS LONG)
 LOCAL bstrMsg AS WSTRING
 LOCAL bstrErrorDescription AS WSTRING
 LOCAL ErrorGuid AS GUID
 LOCAL bstrErrorSource AS WSTRING
 LOCAL bstrHelpFile AS WSTRING
 LOCAL dwHelpContext AS DWORD
 IF nErrorCode = 0 THEN EXIT SUB
 IF OleDbGetErrorInfo(bstrErrorDescription, bstrErrorSource, ErrorGuid, bstrHelpFile, dwHelpContext) = %S_OK THEN
 bstrMsg = "Error code: &H" & HEX$(nErrorCode) & " [" & FORMAT$(nErrorCode) & "]" & $CRLF
 IF LEN(bstrErrorDescription) THEN bstrMsg = bstrMsg & "Description: " & bstrErrorDescription & $CRLF
 IF ErrorGuid <> $IID_NULL THEN bstrMsg = bstrMsg & "GUID: " & GUIDTXT$(ErrorGuid) & $CRLF
 IF LEN(bstrErrorSource) THEN bstrMsg = bstrMsg & "Source: " & bstrErrorSource
 IF LEN(bstrHelpFile) THEN bstrMsg = bstrMsg & $CRLF & "Help file: " & bstrHelpFile
 IF dwHelpContext THEN bstrMsg = bstrMsg & $CRLF & "Help context: " & FORMAT$(dwHelpContext)
 ELSE
 bstrMsg = "Error code: " & FORMAT$(nErrorCode) & " [&H" & HEX$(nErrorCode, 8) & "] " & OBJRESULT$(nErrorCode)
 END IF
 IF LEN(bstrMsg) = 0 THEN bstrMsg = "Error code: &H" & HEX$(nErrorCode) & " [" & FORMAT$(nErrorCode) & "]"
 #IF %DEF(%PB_CC32)
 STDOUT bstrMsg
 #ELSE
 MSGBOX bstrMsg, &H00001000& ' %MB_SYSTEMMODAL
 #ENDIF
END SUB
' ========================================================================================
#ENDIF
