I thought about ADO, and COM, but something about that doesn't sit right with me....It just seems to me like those methods are going through the same steps only with more overhead...anyways, this code works very fast, and if someone else has a quicker way to get large record sets I'd LOVE to see it! And if they don't here's a good one....
Code: Select all
; These can be put into an include file, the procs are after Main()
Declare initDataBase()
Declare.l myOpenDataBase(dbNum, dbName.s, dbUser.s, dbPass.s)
Declare.l addResultColumn(dbNum, colType.l, length = 4)
Declare.l myDataBaseQuery( dbNum, qry.s, minRecstoGet = 1)
Declare endDataBaseQuery( dbNum )
Declare myCloseDataBase( dbNum )
Declare RowsFetched( dbNum )
Declare getRowSize( dbNum )
Declare rowCol( numDb, Row, Col )
Procedure Main()
; Example Structure...
Structure customerInfo
ListID.s
wasListID.s
Address1.s
Address2.s
Address3.s
Address4.s
Phone.s
Mobile.s
Pager.s
AltPhone.s
fullName.s
ResponsibleParty.s
TimeCreated.s
EndStructure
dbNum = initDataBase()
NewList customers.customerInfo()
If dbNum > 0
If myOpenDataBase(dbNum, "someDataBase", "UserID", "Password.")
;- Use this to add result columns, specify PB data Types...They'll be converted later
addResultColumn(dbNum, #PB_Database_String, 256)
addResultColumn(dbNum, #PB_Database_String, 256)
addResultColumn(dbNum, #PB_Database_String, 256)
addResultColumn(dbNum, #PB_Database_String, 256)
addResultColumn(dbNum, #PB_Database_String, 256)
addResultColumn(dbNum, #PB_Database_String, 256)
addResultColumn(dbNum, #PB_Database_String, 256)
addResultColumn(dbNum, #PB_Database_String, 256)
addResultColumn(dbNum, #PB_Database_String, 256)
addResultColumn(dbNum, #PB_Database_String, 256)
addResultColumn(dbNum, #PB_Database_String, 256)
addResultColumn(dbNum, #PB_Database_String, 256)
addResultColumn(dbNum, #PB_Database_String, 256)
;addResultColumn(dbNum, #PB_Database_Long, 0)
;addResultColumn(dbNum, #PB_Database_Long, 0)
MessageBox_(0, "Press OK to go...", "Ready...", #MB_OK)
myMs = ElapsedMilliseconds()
qry.s = "SELECT ListID, wasListID, BillAddress_Addr1, BillAddress_Addr2, BillAddress_Addr3, BillAddress_Addr4, "
qry.s + "Phone, Mobile, Pager, AltPhone, FullName, ResponsibleParty, TimeCreated FROM Customer ORDER BY TimeCreated"
*ptr = myDataBaseQuery(dbNum, qry.s, 5000)
numRecords = RowsFetched( dbNum )
For k = 1 To numRecords
AddElement(customers())
customers()\ListID = PeekS(rowCol(dbNum, k, 1), 256) ;<- you can modify the rowCol() function to return
customers()\wasListID = PeekS(rowCol(dbNum, k, 2), 256) ; this string if you want, I didn't bother.
customers()\Address1 = PeekS(rowCol(dbNum, k, 3), 256)
customers()\Address2 = PeekS(rowCol(dbNum, k, 4), 256)
customers()\Address3 = PeekS(rowCol(dbNum, k, 5), 256)
customers()\Address4 = PeekS(rowCol(dbNum, k, 6), 256)
customers()\Phone = PeekS(rowCol(dbNum, k, 7), 256)
customers()\Mobile = PeekS(rowCol(dbNum, k, 8), 256)
customers()\Pager = PeekS(rowCol(dbNum, k, 9), 256)
customers()\AltPhone = PeekS(rowCol(dbNum, k, 10), 256)
customers()\fullName = PeekS(rowCol(dbNum, k, 11), 256)
customers()\ResponsibleParty = PeekS(rowCol(dbNum, k, 12), 256)
customers()\TimeCreated = PeekS(rowCol(dbNum, k, 13), 256)
Next
Debug Str(ElapsedMilliseconds()-myMs) + " miliseconds to complete.."
Debug Str(ListSize(customers())) + " records Loaded..."
ResetList(customers())
endDataBaseQuery(dbNum)
myCloseDataBase(dbNum)
EndIf
Else
Debug "Database NOT initialized!"
EndIf
EndProcedure
Procedure initDataBase()
Structure myDbc
hDbc.l
hStmt.l
hEnv.l
columnPtr.l
columns.l
retBufferSize.l
lastRowsFetched.l
stmtPtr.l
EndStructure
Structure dType
columnType.i
columnLength.l
EndStructure
Enumeration
#SQL_HANDLE_ENV = 1
#SQL_HANDLE_DBC = 2
#SQL_HANDLE_STMT = 3
#SQL_HANDLE_DESC = 4
#SQL_C_CHAR = 1
#SQL_C_LONG = 4
#SQL_ATTR_ODBC_VERSION = 200
#SQL_ATTR_ROW_STATUS_PTR = 25
#SQL_ATTR_ROWS_FETCHED_PTR = 26
#SQL_ATTR_ROW_ARRAY_SIZE = 27
#SQL_ATTR_ROW_BIND_TYPE = 5
#SQL_ATTR_ROW_BIND_OFFSET_PTR= 23
#SQL_OV_ODBC3 = 3
#SQL_NO_DATA = 100
#SQL_NULL_HANDLE = 0
#SQL_ERROR = (-1)
#SQL_INVALID_HANDLE = (-2)
#SQL_STILL_EXECUTING = 2
#SQL_LOGIN_TIMEOUT = 103
#SQL_NTS = (-3)
#SQL_CURSOR_FORWARD_ONLY = 0
#SQL_CURSOR_TYPE = 6
#SQL_ATTR_CURSOR_TYPE = #SQL_CURSOR_TYPE
#SQL_ROW_SUCCESS = 0
#SQL_FETCH_NEXT = 1
#SQL_FETCH_FIRST = 2
#SQL_FETCH_LAST = 3
#SQL_FETCH_PRIOR = 4
#SQL_FETCH_ABSOLUTE = 5
#SQL_FETCH_RELATIVE = 6
#SQL_CHAR = 1
#SQL_NUMERIC = 2
#SQL_DECIMAL = 3
#SQL_INTEGER = 4
#SQL_SMALLINT = 5
#SQL_FLOAT = 6
#SQL_REAL = 7
#SQL_DOUBLE = 8
#SQL_C_CHAR = #SQL_CHAR ; /* CHAR, VARCHAR, DECIMAL, NUMERIC */
#SQL_C_LONG = #SQL_INTEGER ; /* INTEGER */
#SQL_C_SHORT = #SQL_SMALLINT ; /* SMALLINT */
#SQL_C_FLOAT = #SQL_REAL ; /* REAL */
#SQL_C_DOUBLE = #SQL_DOUBLE ; /* FLOAT, DOUBLE */
#SQL_BIGINT = (-5)
#SQL_CLOSE = 0
#SQL_DROP = 1
#SQL_UNBIND = 2
EndEnumeration
*ptr = AllocateMemory(SizeOf(myDbc))
*thisDBC.myDbc = *ptr
retCode.w = SQLAllocHandle_(#SQL_HANDLE_ENV, #SQL_NULL_HANDLE, @*thisDBC\hEnv)
If (retCode <> #SQL_SUCCESS) And (retCode <> #SQL_SUCCESS_WITH_INFO)
error = 1
EndIf
retCode = SQLSetEnvAttr_(*thisDBC\hEnv, #SQL_ATTR_ODBC_VERSION, #SQL_OV_ODBC3, 0)
If (retCode <> #SQL_SUCCESS) And (retCode <> #SQL_SUCCESS_WITH_INFO) : error = 1 : EndIf
retCode = SQLAllocHandle_(#SQL_HANDLE_DBC, *thisDBC\hEnv, @*thisDBC\hDbc)
If (retCode <> #SQL_SUCCESS) And (retCode <> #SQL_SUCCESS_WITH_INFO) : error = 1 : EndIf
retCode = SQLSetConnectAttr_(*thisDBC\hDbc, #SQL_LOGIN_TIMEOUT, cnxTimeOut, 0);
If (retCode <> #SQL_SUCCESS) And (retCode <> #SQL_SUCCESS_WITH_INFO) : error = 1 : EndIf
If error = 0
ProcedureReturn *ptr
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure.l myOpenDataBase(dbNum, dbName.s, dbUser.s, dbPass.s)
retVal = 0
If dbNum > 0
*thisDBC.myDbc = dbNum
retCode.w = SQLConnect_(*thisDBC\hDbc, @dbName, Len(dbName), @dbUser, Len(dbUser), @dbPass, Len(dbPass))
If (retCode <> #SQL_ERROR)
retCode = SQLAllocHandle_(#SQL_HANDLE_STMT, *thisDBC\hDbc, @*thisDBC\hStmt);
If ((retCode = #SQL_SUCCESS) Or (retCode = #SQL_SUCCESS_WITH_INFO))
*thisDBC\columns = 0
*thisDBC\columnPtr = AllocateMemory(4)
*thisDBC\retBufferSize = 0
retVal = 1
EndIf
EndIf
EndIf
ProcedureReturn retVal
EndProcedure
Procedure getRowSize( dbNum )
retVal = 0
If dbNum > 0
*thisDBC.myDbc = dbNum
retVal = *thisDBC\retBufferSize
EndIf
ProcedureReturn retVal
EndProcedure
Procedure RowsFetched( dbNum )
retVal = 0
If dbNum > 0
*thisDBC.myDbc = dbNum
retVal = *thisDBC\lastRowsFetched
EndIf
ProcedureReturn retVal
EndProcedure
Procedure.l addResultColumn(dbNum, colType.l, length = 4)
If dbNum > 0
*thisDBC.myDbc = dbNum
*thisDBC\columnPtr = ReAllocateMemory(*thisDBC\columnPtr, (*thisDBC\retBufferSize + 8))
*fPtr = *thisDBC\columnPtr + (*thisDBC\columns * 4)
*thisDBC\columns + 2
*newPtr = AllocateMemory(SizeOf(dType))
*myColumn.dType = *newPtr
*myColumn\columnType = colType
Select *myColumn\columnType
Case #PB_Database_Long
*myColumn\columnType = #SQL_C_LONG
length = 4
Case #PB_Database_String
*myColumn\columnType = #SQL_C_CHAR
Case #PB_Database_Quad
*myColumn\columnType = #SQL_BIGINT
length = 8
Case #PB_Database_Float
*myColumn\columnType = #SQL_C_FLOAT
length = 4
EndSelect
*myColumn\columnLength = length
PokeL(*fPtr, *newPtr)
*fPtr + 4
*newPtr2 = AllocateMemory(SizeOf(dType))
*myColumn2.dType = *newPtr2
*myColumn2\columnLength = 4
*myColumn2\columnType = #SQL_C_LONG
*thisDBC\retBufferSize + length + 4
PokeL(*fPtr, *newPtr2)
EndIf
EndProcedure
Procedure rowCol( numDb, Row, Col )
retVal = -1
If numDb > 0
*thisDBC.myDbc = numDb
If ((Col <= *thisDBC\columns) And (Col > 0)) And ((Row > 0) And (Row <= *thisDBC\lastRowsFetched))
If Col > 1
Col-1
idx = 0
For k = 0 To ((Col*2)-1) ;Step 1
*myColumn.dType = PeekL(*thisDBC\columnPtr + (k*4))
;;Debug *myColumn\columnLength
;;Debug PeekL(PeekL(*thisDBC\columnPtr + (k*4))+4)
;offSet + PeekL(PeekL(*thisDBC\columnPtr + (k*4))+4) ; Faster <---But not always accurate
offSet + *myColumn\columnLength
Next
EndIf
retVal = ((((Row-1) * (*thisDBC\retBufferSize)) + offSet) + *thisDBC\stmtPtr)
EndIf
EndIf
ProcedureReturn retVal
EndProcedure
Procedure getdbError(hType, hndl)
TextLengthPtr.l
NativeErrorPtr.l
SQLState.s = Space(5) + Chr(0)
MessageText.s = Space(256) + Chr(0)
SQLGetDiagRec_( hType, hndl, 1, @SQLState$, @NativeErrorPtr, @MessageText$, 256, @TextLengthPtr)
If Trim(SQLState) <> ""
Debug MessageText
EndIf
EndProcedure
Procedure endDataBaseQuery( dbNum )
retVal = 0
If dbNum > 0
*thisDBC.myDbc = dbNum
SQLFreeHandle_(#SQL_HANDLE_STMT, *thisDBC\hStmt)
retCode.w = SQLAllocHandle_(#SQL_HANDLE_STMT, *thisDBC\hDbc, @*thisDBC\hStmt);
If ((retCode = #SQL_SUCCESS) Or (retCode = #SQL_SUCCESS_WITH_INFO))
If *thisDBC\stmtPtr > 0
FreeMemory(*thisDBC\stmtPtr)
*thisDBC\stmtPtr = 0
EndIf
If *thisDBC\retBufferSize > 0
For k = 1 To *thisDBC\columns
*ptr = PeekL(*thisDBC\columnPtr + ((k-1)*4))
;If *ptr > 0
FreeMemory(*ptr)
;EndIf
Next
EndIf
FreeMemory(*thisDBC\columnPtr)
*thisDBC\columns = 0
*thisDBC\columnPtr = AllocateMemory(4)
*thisDBC\retBufferSize = 0
*thisDBC\lastRowsFetched = 0
retVal = 1
EndIf
EndIf
ProcedureReturn retVal
EndProcedure
Procedure.l myDataBaseQuery( dbNum, qry.s, minRecstoGet = 1)
retVal = 0
retCode.w = 0
If dbNum > 0
*thisDBC.myDbc = dbNum
If (*thisDBC\retBufferSize > 0) And (*thisDBC\stmtPtr = 0)
*ptr = AllocateMemory(*thisDBC\retBufferSize * minRecstoGet)
retVal = *ptr
numRowsFetched.l
Dim rowStatus.w(minRecstoGet) ;<-- Can be useful, but I'm not using it here
retCode | SQLSetStmtAttr_(*thisDBC\hStmt, #SQL_ATTR_ROW_BIND_TYPE, *thisDBC\retBufferSize, 0)
retCode | SQLSetStmtAttr_(*thisDBC\hStmt, #SQL_ATTR_ROW_ARRAY_SIZE, minRecstoGet, 0)
retCode | SQLSetStmtAttr_(*thisDBC\hstmt, #SQL_ATTR_ROW_STATUS_PTR, @rowStatus(), 0)
retCode | SQLSetStmtAttr_(*thisDBC\hStmt, #SQL_ATTR_ROWS_FETCHED_PTR, @numRowsFetched, 0)
If (retCode <> #SQL_SUCCESS) And (retCode <> #SQL_SUCCESS_WITH_INFO) : error = 1 : EndIf
If error <> 1
pOfset = 0
Col = 1
For k = 1 To *thisDBC\columns
*myColumn.dType = PeekL(*thisDBC\columnPtr + ((k-1)*4))
retCode | SQLBindCol_(*thisDBC\hStmt, Col, *myColumn\columnType, *ptr + pOfset, (*myColumn\columnLength), *ptr+pOfset+*myColumn\columnLength)
Col + 1
k + 1
pOfset + *myColumn\columnLength + 4
Next
If (retCode <> #SQL_SUCCESS) And (retCode <> #SQL_SUCCESS_WITH_INFO)
Debug "Error binding Columns..."
FreeMemory(*ptr)
endDataBaseQuery(dbNum)
retVal = 0
error = 1
EndIf
retCode.w = SQLExecDirect_(*thisDBC\hStmt, qry, #SQL_NTS)
If retCode = #SQL_ERROR
getdbError(#SQL_HANDLE_STMT, *thisDBC\hStmt)
error = 1
FreeMemory(*ptr)
EndIf
If error <> 1
*otp = AllocateMemory(*thisDBC\retBufferSize)
*fPtr = *ptr
Repeat
retCode.w = SQLFetchScroll_(*thisDBC\hStmt, #SQL_FETCH_NEXT, 0)
If retCode <> #SQL_NO_DATA
oldNum = actFetch
actFetch + numRowsFetched
*otp = ReAllocateMemory(*otp, (*thisDBC\retBufferSize*actFetch))
MoveMemory(*ptr, *otp + (oldNum * (*thisDBC\retBufferSize)), numRowsFetched*(*thisDBC\retBufferSize) )
EndIf
Until retCode = #SQL_NO_DATA
*thisDBC\lastRowsFetched = actFetch
*thisDBC\stmtPtr = *otp
SQLCloseCursor_(*thisDBC\hStmt)
FreeMemory(*ptr)
retVal = *otp
EndIf
Else
Debug "Error setting statement attributes..."
FreeMemory(*ptr)
retVal = 0
EndIf
EndIf
EndIf
ProcedureReturn retVal
EndProcedure
Procedure myCloseDataBase( dbNum )
retVal = 0
If dbNum > 0
*thisDBC.myDbc = dbNum
SQLFreeHandle_(#SQL_HANDLE_STMT, *thisDBC\hStmt)
SQLDisconnect_(*thisDBC\hDbc)
SQLFreeHandle_(#SQL_HANDLE_DBC, *thisDBC\hDbc)
SQLFreeHandle_(#SQL_HANDLE_ENV, *thisDBC\hEnv)
FreeMemory(*thisDBC\columnPtr)
FreeMemory(dbNum)
retVal = 1
EndIf
ProcedureReturn retVal
EndProcedure