PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Database commands with ADO

https://www.purebasic.fr/english/viewtopic.php?t=33235

Page 1 of 1

Database commands with ADO

Posted: Sun Jul 13, 2008 4:35 pm
by byo
Hi, guys.

I was looking for an alternative to ODBC and have managed to create some useful code to work with databases using ADO. Tested with SQL Server so far. The commands are pretty much similar to Purebasic native ones for easy porting and you'll require the wonderful pureDispHelper by ts-soft for this to work.

Hope this is useful to someone else. :wink:


adoConnection.pbi

Code: Select all

; +===================================================================+
; |                                                                   |
; |           ADO DATABASE CONNECTION 1.0 FOR PUREBASIC 4.20          |
; |                                                                   |
; |   + Made by Andre Guerreiro Neto (byo) - 2008                     |
; |   + Requires the pbDispHelper by ts-soft                          |
; |                                                                   |
; |   You can use this code in whatever way you want, just don't      |
; |   claim it as your own and give credit where due. Thanks to       |
; |   PB team, pdwyer, tinman, Rook, netmaestro and all the helpful   |
; |   guys from the forum. Use this at your own risk.                 |                
; +===================================================================+

XIncludeFile "adoconstants.pbi"

;dhToggleExceptions(#True)

ProcedureDLL.l adoOpenDatabase(driver.s, provider.s, server.s, database.s, user.s, password.s, timeout.l=15)
	Shared recordSet.l, conString.s
	Protected adoCon.l = 0
	
	conString = "Provider=" + provider + ";Server=" + server + ";Initial Catalog=" + database + ";User Id=" + user + ";Password=" + password + ";"
	
	adoCon = dhCreateObject("ADODB.Connection")
	
	If adoCon
		dhPutValue(adoCon, ".ConnectionTimeout = %d", timeout)
		If dhCallMethod(adoCon, ".Open(%T)", @conString) = #S_OK
			ProcedureReturn adoCon
		EndIf
	EndIf
	ProcedureReturn 0
EndProcedure

ProcedureDLL.l adoDatabaseQuery(adoCon.l, query.s)
	Shared recordSet.l

	If adoCon
		recordSet = dhCreateObject("ADODB.RecordSet")
		
		If recordSet
			dhPutValue(recordSet, ".CursorLocation = %d", 3)
			dhPutValue(recordSet, ".CursorType = %d", 3)
			dhPutValue(recordSet, ".LockType = %d", 4)
			
			If dhCallMethod(recordSet, "Open(%T, %o)", @query, adoCon) = #S_OK
				ProcedureReturn #True
			EndIf
		EndIf
	EndIf
	
	ProcedureReturn #False
EndProcedure

ProcedureDLL.l adoDatabaseUpdate(adoCon.l, query.s)
	If adoCon		
		If dhCallMethod(adoCon, "Execute(%T)", @query) = #S_OK
			ProcedureReturn #True
		EndIf
	EndIf
	
	ProcedureReturn #False
EndProcedure

ProcedureDLL.l adoIsData(adoCon.l)
	Shared recordSet.l
	
	If adoCon And recordSet
		dhGetValue("%b", @eof, recordSet, ".EOF")
		dhGetValue("%b", @bof, recordSet, ".BOF")
		
		If Not eof And Not bof
			ProcedureReturn #True
		EndIf
	EndIf
	
	ProcedureReturn #False	
EndProcedure

ProcedureDLL adoFirstDatabaseRow(adoCon.l)
	Shared recordSet.l
	
	If adoCon And recordSet
		dhCallMethod(recordSet, ".MoveFirst")
	EndIf
EndProcedure

ProcedureDLL.l adoPreviousDatabaseRow(adoCon.l)
	Shared recordSet.l
	Protected bof.l
	
	If adoCon And recordSet
		dhGetValue("%b", @eof, recordSet, ".BOF")
		
		If Not bof		
			If dhCallMethod(recordSet, ".MovePrevious") = #S_OK
				ProcedureReturn #True
			EndIf
		EndIf
	EndIf
	ProcedureReturn #False
EndProcedure

ProcedureDLL.l adoNextDatabaseRow(adoCon.l)
	Shared recordSet.l, eof.l
	
	If adoCon And recordSet
		dhGetValue("%b", @eof, recordSet, ".EOF")
		
		If Not eof
			If dhCallMethod(recordSet, ".MoveNext") = #S_OK
				dhGetValue("%b", @eof, recordSet, ".EOF")
				If Not eof
					ProcedureReturn #True
				EndIf
			EndIf
		EndIf
	EndIf
	ProcedureReturn #False
EndProcedure

ProcedureDLL adoLastDatabaseRow(adoCon.l)
	Shared recordSet.l
	
	If adoCon And recordSet
		dhCallMethod(recordSet, ".MoveLast")
	EndIf
EndProcedure

ProcedureDLL.s adoGetDatabaseString(adoCon.l, column.l)
	Shared recordSet.l
	Protected eof.l, bof.l, iResult.l, sResult.s
	
	If adoCon And recordSet
		If adoIsData(adoCon)
			If dhGetValue("%T", @iResult, recordSet, ".Fields(%d).Value", column) = #S_OK
				If iResult
					sResult = PeekS(iResult)
					dhFreeString(iResult)
					ProcedureReturn sResult
				EndIf
			EndIf
		EndIf
	EndIf
	
	ProcedureReturn #NULL$
EndProcedure

ProcedureDLL.d adoGetDatabaseDouble(adoCon.l, column.l)
	Shared recordSet.l
	Protected eof.l, bof.l, dResult.d
	
	If adoCon And recordSet
		If adoIsData(adoCon)
			If dhGetValue("%e", @dResult, recordSet, ".Fields(%d).Value", column) = #S_OK
				If dResult
					ProcedureReturn dResult
				EndIf
			EndIf
		EndIf
	EndIf
	
	ProcedureReturn 0
EndProcedure

ProcedureDLL.f adoGetDatabaseFloat(adoCon.l, column.l)
	Shared recordSet.l
	Protected eof.l, bof.l, fResult.f
	
	If adoCon And recordSet
		If adoIsData(adoCon)
			If dhGetValue("%r", @fResult, recordSet, ".Fields(%d).Value", column) = #S_OK
				If fResult
					ProcedureReturn fResult
				EndIf
			EndIf
		EndIf
	EndIf
	
	ProcedureReturn 0
EndProcedure

ProcedureDLL.l adoGetDatabaseLong(adoCon.l, column.l)
	Shared recordSet.l
	Protected eof.l, bof.l, iResult.l
	
	If adoCon And recordSet
		If adoIsData(adoCon)
			If dhGetValue("%d", @iResult, recordSet, ".Fields(%d).Value", column) = #S_OK
				If iResult
					ProcedureReturn iResult
				EndIf
			EndIf
		EndIf
	EndIf
	
	ProcedureReturn 0
EndProcedure

ProcedureDLL.q adoGetDatabaseQuad(adoCon.l, column.l)
	Shared recordSet.l
	Protected eof.l, bof.l, iResult.l, qResult.l
	
	If adoCon And recordSet
		If adoIsData(adoCon)
			If dhGetValue("%p", @qResult, recordSet, ".Fields(%d).Value", column) = #S_OK
				If qResult
					ProcedureReturn qResult
				EndIf
			EndIf
		EndIf
	EndIf
	
	ProcedureReturn #Null
EndProcedure

ProcedureDLL.s adoDatabaseColumnName(adoCon.l, column.l)
	Shared recordSet.l
	Protected iResult.l, sResult.s

	If adoCon And recordSet
		If adoIsData(adoCon)
			If dhGetValue("%T", @iResult, recordSet, ".Fields(%d).Name", column) = #S_OK
				If iResult
					sResult = PeekS(iResult)
					If sResult
						ProcedureReturn sResult
					EndIf
				EndIf
			EndIf
		EndIf
	EndIf
	ProcedureReturn #NULL$		
EndProcedure

ProcedureDLL.s adoDatabaseColumnType(adoCon.l, column.l)
	Shared recordSet.l
	Protected iResult.l, sResult.s

	If adoCon And recordSet
		If adoIsData(adoCon)
			If dhGetValue("%d", @iResult, recordSet, ".Fields(%d).Type", column) = #S_OK
				If iResult		
					Select iResult
						Case #adEmpty				: sResult = "adEmpty"
						Case #adTinyInt				: sResult = "adTinyInt"
						Case #adSmallInt			: sResult = "adSmallInt"
						Case #adInteger				: sResult = "adInteger"
						Case #adBigInt				: sResult = "adBigInt"
						Case #adUnsignedTinyInt		: sResult = "adUnsignedTinyInt"
						Case #adUnsignedSmallInt	: sResult = "adUnsignedSmallInt"
						Case #adUnsignedInt			: sResult = "adUnsignedInt"
						Case #adUnsignedBigInt		: sResult = "adUnsignedBigInt"
						Case #adSingle				: sResult = "adSingle"
						Case #adDouble				: sResult = "adDouble"
						Case #adCurrency			: sResult = "adCurrency"
						Case #adDecimal				: sResult = "adDecimal"
						Case #adNumeric				: sResult = "adNumeric"
						Case #adBoolean				: sResult = "adBoolean"
						Case #adError				: sResult = "adError"
						Case #adUserDefined			: sResult = "adUserDefined"
						Case #adVariant				: sResult = "adVariant"
						Case #adIDispatch			: sResult = "adIDispatch"
						Case #adIUnknown			: sResult = "adIUnknown"
						Case #adGUID				: sResult = "adGUID"
						Case #adDate				: sResult = "adDate"
						Case #adDBDate				: sResult = "adDBDate"
						Case #adDBTime				: sResult = "adDBTime"
						Case #adDBTimeStamp			: sResult = "adDBTimeStamp"
						Case #adBSTR				: sResult = "adBSTR"
						Case #adChar				: sResult = "adChar"
						Case #adVarChar				: sResult = "adVarChar"
						Case #adLongVarChar			: sResult = "adLongVarChar"
						Case #adWChar				: sResult = "adWChar"
						Case #adVarWChar			: sResult = "adVarWChar"
						Case #adLongVarWChar		: sResult = "adLongVarWChar"
						Case #adBinary				: sResult = "adBinary"
						Case #adVarBinary			: sResult = "adVarBinary"
						Case #adLongVarBinary		: sResult = "adLongVarBinary"
					EndSelect			
					ProcedureReturn sResult
				EndIf
			EndIf
		EndIf
	EndIf
	ProcedureReturn #NULL$		
EndProcedure

ProcedureDLL.l adoCountRecords(adoCon.l)
	Shared recordSet.l
	Protected eof.l, iResult.l = 0
	
	If adoCon And recordSet
		dhGetValue("%d", @iResult, recordSet, ".RecordCount")
	EndIf
	ProcedureReturn iResult
EndProcedure

ProcedureDLL adoCloseDatabase(adoCon.l)
	Shared recordSet.l
	
	If recordSet
		dhCallMethod(recordSet, ".Close")
		dhReleaseObject(recordSet)
	EndIf
	If adoCon
		dhCallMethod(adoCon, ".Close")
		dhReleaseObject(adoCon)
	EndIf
EndProcedure

ProcedureDLL.s adoDatabaseError(adoCon.l)
	Shared recordSet.l, errorCount.l
	Protected sResult.s, iResult.l = 0		

	If adoCon
		If dhGetValue("%d", @errorCount, adoCon, ".Errors.Count") = #S_OK
			If errorCount
				For i = 0 To errorCount-1
					If dhGetValue("%T", @iResult, adoCon, ".Errors(%d).Description", i) = #S_OK
						If iResult
							sResult = PeekS(iResult)
							dhFreeString(iResult)
							ProcedureReturn sResult
						EndIf
					EndIf 
				Next
			EndIf
		EndIf
	EndIf
	
	ProcedureReturn #NULL$
EndProcedure

ProcedureDLL adoSetConnectionTimeOut(adoCon.l, seconds.l)
	Shared conString.s

	If adoCon
		dhCallMethod(adoCon, ".Close")
		dhPutValue(adoCon, ".ConnectionTimeOut = %d", seconds)
		dhCallMethod(adoCon, ".Open(%T)", @conString)
	EndIf
EndProcedure

ProcedureDLL.s adoGetVersion(adoCon.l)
	Protected iResult.l, sResult.s

	If adoCon
		dhGetValue("%T", @iResult, adoCon, ".Version")
		If iResult
			sResult = PeekS(iResult)
			dhFreeString(iResult)
			ProcedureReturn sResult
		EndIf
	EndIf
	ProcedureReturn #NULL$
EndProcedure
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited