Deprecated: Array and string offset access syntax with curly braces is deprecated in /homepages/21/d38531796/htdocs/jose/smfforum/Sources/Subs.php on line 3825 Print Page - SqlDemo - Example App Connects To Microsoft Databases Using ODBC Class
Theo's Forum
IT-Consultant: Frederick J. Harris => ODBC Database Access => Topic started by: Frederick J. Harris on September 13, 2009, 08:39:28 PM
Title: SqlDemo - Example App Connects To Microsoft Databases Using ODBC Class
Post by: Frederick J. Harris on September 13, 2009, 08:39:28 PM
Below is a PowerBASIC translation of a C++ app I did to accustom myself to Microsoft's new VC9 C++ compiler. The PowerBASIC program comes in around 63K with PowerBASIC includes and 69K using Jose's includes. The PowerBASIC and C++ programs are about 99% identical (maybe even more). They are not exact line for line translations, but very close. I've attached the zip file containing the PowerBASIC code & executable to this post. The app creates a small main form with just four buttons on it. Clicking the 1st button opens an output screen where are displayed the ODBC Drivers on your computer. The second button displays the contents of the included Book1.xls Excel file. Put that file in the same directory with the program. My original intent was to see if I could use ODBC to create a 'Database' and 'Table' within an Excel workbook the same way you can use ODBC to create Microsoft Access or Sql Server databases, but I found it didn't seem to work. At least I couldn't get it to work. The ODBC error messages I was getting weren't very encouraging, so I didn't persue the matter further. So about all I was able to do with Excel was read the data out of a pre-existing workbook. About the only real utility I can see for this, that is, using ODBC to connect to Excel, is if you have a situation where a user doesn't have Excel installed on their computer, but nontheless has a need to access data in Excel spreadsheets. I do believe the stock Excel ODBC drivers installed with every Windows installation would allow for this. Using COM to access data in Excel spreadsheets is very easy too, but requires that the user's machine have Excel installed.
The third button creates a Microsoft Access database named 'TestData' in whatever directory the program is run from, and adds a table then inserts a few records then retrieves that data. Various data is displayed in an output screen. The fourth button does the same with Sql Server Express or MSDE. You'll want to read my somewhat voluminous comments in the code probably. To use the old MSDE you need to change a couple lines of code. Its explained in the code remarks. After this post I'll list the code.
Title: Re: SqlDemo - Example App Connects To Microsoft Databases Using ODBC Class
Post by: Frederick J. Harris on September 13, 2009, 08:43:06 PM
'This version of SqlDemo uses the PowerBASIC includes; not the ones Jose supplies here on his forum. The reason I used 'the PowerBAIC includes instead of Jose's is because the program does not use any COM functionality; therefore, the compiled 'Exe will be smaller by about 6K. To compile it though you'll need to obtain SqlTypes.inc, Sql32.inc, and Sqlext32.inc from 'the PowerBASIC Downloads Section of its website. If you want to use Jose's excellent includes there's no problem; all you 'need to do is replace the three includes just mentioned above with Jose's "Sql.inc" and "SqlExt.inc". Using those the 'program compiles for me to around 69K as compared to around 63K for the PowerBASIC includes.
'Program ues ODBC Api to 1) Query Registry for installed ODBC Database Drivers. These are displayed in a CreateWindowEx() 'Output Screen Regestered as frmOutput. This screen is scrollable and cleans up after itself in terms of the memory it 'needs to display and allow scrolling of its lines of text; 2) Dumps an Excel WorkSheet (Sheet1) that you'll have to create 'yourself. To correctly create the data that this program will try to dump for you you'll need to either have Excel installed 'on your computer to create the simple data yourself, or you'll need to obtain Book1.xls from me (which I'll gladly provide) 'if I have your email. Altenately, various distributions of this code in zip files and such may have the file included with 'it. If you need to create the data yourself, and you have Excel, paste this data into cell A1 of a blank Sheet1 in a Workbook 'named Book1.xls... ' 'IdFloat_PointDate_FieldText_Field '13.1415911/15/1952My Birthday '21.234566/30/1969Walk On Moon? '315.12341/1/2006Some String '40.543214/1/2006April Fools Day! ' 'Perhaps paste the data into Notepad first to remove the remark characters, and paste the unremarked data into A1 using a 'right click; ' '3) The program further, using the third command button, creates an Access database named 'TestData' in whatever folder you 'are running the program from. After creating the database it creates a table named Table1 and inserts the above described 'four records into it. Then it outputs to another invovation of the output screen the four inserted records and the four 'dumped records as well as other diagnostic information. You can click any of these buttons as many times as you want; 'each click creates a new independent output screen, and additional records are added to the pre-existing database; 4) The 'last button creates an Sql Server Database if you have either Sql Server Express or MSDE installed on your computer. The 'code as shipped sets up a connection string for Sql Server Express. The necessary SERVER attribute for MSDE is a little 'different, and you should look near the top of SqlServerThread() for a few lines you need to comment out and one line you 'need to uncomment for the program to work with MSDE (MSDE is just the database engine for Sql Server 2000, I believe). #Compile Exe #Dim All 'One pretty important point I want to make if you want this program to function for you is #Register None 'that you can't just run the executable produced from this code just anywhere on your computer. #Include "Win32Api.inc" 'I learned this sad truth in my development work on this code. What I had intended to do was #include "Sqltypes.inc" 'call ShellGetSpecialFolderPath() to obtain the path to your 'My Documents' folder, and create #include "Sql32.inc" 'the Access and/or Sql Server databases in a subfolder I would create under that folder named #include "Sqlext32.inc" 'My Documents/SqlDemo. If an equate 'MyDebug' is defined (see SqlDemo.inc) an output.txt debug #Include "CSql.inc" 'log file could also be written to that location. However, unfortunately, it plain doesn't #Include "SqlDemo.inc" 'work - at least in terms of databases. Windows it turns out is rather picky as to where it #Include "frmOutput.Inc" 'will create databases on your computer, and one of the places it won't create databases is...
Function fnWndProc_OnCreate(Wea As WndEventArgs) As Long '...anywhere in or under your 'My Documents folder. I found Local pCreateStruct As CREATESTRUCT Ptr 'same to be true with C:\Program Files, except in Sql Server's Local szClassName As Asciiz*16 '...MSSQL\Data subdirectory - which is kind of a 'default' Local szTxt() As Asciiz*48 'location for *.mdf Sql Server files. So my recommendation Local wc As WndClassEx 'in terms of where to run SqlDemo.exe from is anywhere else Local hCtl As Dword 'on the C drive (or any other drive you have partitioned off 'of it, except Documents And Settings or Program Files and pCreateStruct=Wea.lParam 'I'd also avoid C:\Windows (that goes without saying, I think!). Wea.hInst=@pCreateStruct.hInstance 'Personally, I always create a C:\Code directory on all my #If %Def(%MyDebug) 'computers, and I put subdirectories there for all my different fp=Freefile 'programming languages. Anything like that would be fine. Open Curdir$ & "\Output.txt" For Output As #fp Print #fp, "Entering fnWndProc_OnCreate()" #EndIf
Redim szTxt(3) As Asciiz*48 'Set up the four buttons on the main form. szTxt(0)="Display ODBC Drivers On Your Computer" szTxt(1)="Read Excel Spreadsheet With ODBC" szTxt(2)="Create, Load And Dump MS Access Database" szTxt(3)="Create, Load And Dump Sql Server Express" hCtl=CreateWindow("button",szTxt(0),%WS_CHILD Or %WS_VISIBLE,30,20,325,30,Wea.hWnd,%IDC_SQL_DRIVERS,Wea.hInst,Byval 0) hCtl=CreateWindow("button",szTxt(1),%WS_CHILD Or %WS_VISIBLE,30,60,325,30,Wea.hWnd,%IDC_EXCEL,Wea.hInst, Byval 0) hCtl=CreateWindow("button",szTxt(2),%WS_CHILD Or %WS_VISIBLE,30,100,325,30,Wea.hWnd,%IDC_MS_ACCESS,Wea.hInst,Byval 0) hCtl=CreateWindow("button",szTxt(3),%WS_CHILD Or %WS_VISIBLE,30,140,325,30,Wea.hWnd,%IDC_SQL_SERVER_EXPRESS,Wea.hInst,Byval 0) Erase szTxt()
szClassName="frmOutput" : 'frmOutput is our Output Screen 'This blob of code wc.lpszClassName=Varptr(szClassName) : wc.lpfnWndProc=Codeptr(frmOutput) 'just left Registers wc.cbSize=Sizeof (wc) : wc.style=%CS_DBLCLKS 'the Output Screen - wc.hIcon=LoadIcon(%NULL, Byval %IDI_APPLICATION) : wc.hInstance=Wea.hInst 'frmOutput. Once a wc.hIconSm=%NULL : wc.hCursor=LoadCursor(%NULL, Byval %IDC_ARROW) 'Window Class is wc.hbrBackground=GetStockObject(%WHITE_BRUSH) : wc.cbWndExtra=16 'Registered with Windows, wc.lpszMenuName=%NULL : wc.cbClsExtra=0 'you can create instances Call RegisterClassEx(wc) 'of it with CreateWindow(). #If %Def(%MyDebug) Print #fp, "Leaving fnWndProc_OnCreate()" : Print #fp, #EndIf
fnWndProc_OnCreate=0 End Function
Sub btnSqlDrivers_OnClick(Wea As WndEventArgs) 'This procedure repeatedly calls SqlDrivers() in a loop until it Local iLen,iLen1,iLen2 As Integer 'iterates through all your Registry installed ODBC drivers. It Local szDriverAttr As Asciiz*256 'dumps the Driver name and Driver Attribute - Value pairs to the Local iLine,iLnCt,iCount As Long 'Output Screen. That happens kind of indirectly though through Local ptrPtrBuffer As Dword Ptr 'quite a bit of confusing logic. You'll see two While loops below. Local szDriverDes As Asciiz*64 'What the 1st While loop does is blow through the drivers to get Local szCaption As Asciiz*40 'a count (iCount) of them. They are packaged rather awkwardly. Local ptrByte As Byte Ptr 'When you call SqlDrivers the szDriverDes string is easy. It will Local strArr() As String 'contain a string such as "Microsoft Sql Server Driver". However, Local hEnvr As Dword 'the szDriverAtrr string will contain attributr-value pairs delimited Local hWnd As Dword 'by Nulls. If you try to print it out or read its length the output Register i As Long 'will end at the 1st null encountered. That's why you'll see me...
MousePtr 11 : iLnCt=1 'run through the buffer with a byte ptr substituting comma delimiters... If SQLAllocHandle(%SQL_HANDLE_ENV,%SQL_NULL_HANDLE,hEnvr)<>%SQL_ERROR Then Call SQLSetEnvAttr(hEnvr,%SQL_ATTR_ODBC_VERSION,Byval %SQL_OV_ODBC3,%SQL_IS_INTEGER) While SQLDrivers(hEnvr,%SQL_FETCH_NEXT,szDriverDes,64,iLen1,szDriverAttr,256,iLen2)<>%SQL_NO_DATA iLnCt=iLnCt+2 Decr iLen2 '...for nulls. Then I use PowerBASIC's neat ParseCount/Parse combo ptrByte=VarPtr(szDriverAttr) 'to find out the number of attribute/value pairs I'll need to display. For i=0 To iLen2 'That number, plus a space in between them and the driver name will If @ptrByte[i]=0 Then 'give me the count of the number of lines I'll need in the output screen @ptrByte[i]=44 'for displaying data for that specific driver. After I have that count End If 'accumulated in iLnCt (integer - Line Count, i.e., iLnCt) for all the Next i 'drivers in the Registry I CreateWindow() the frmOutput Window whose @ptrByte[iLen2]=0 '.cbWndExtra bytes have space for four 32 bit numbers. In the 1st iCount=ParseCount(szDriverAttr) 'four bytes, i.e., bytes 0 - 3, I store the line count from above with iLnCt=iLnCt+iCount+2 'SetWindowLong(). In the 2nd four bytes I store a pointer to a memory Loop 'allocation (ptrPtrBuffer) where I allocate room for a 32 bit szCaption="ODBC Database Drivers On Your System" 'pointer for each of the lines I'll need for displaying the data. hWnd=CreateWindowEx(0,"frmOutput",szCaption,%WS_OVERLAPPEDWINDOW Or %WS_VSCROLL,700,150,350,475,%HWND_DESKTOP,0,GetModuleHandle(""),Byval %NULL) ptrPtrBuffer=GlobalAlloc(%GPTR,(iLnCt*4)) 'Just left you see the bytes required for this buffer that will hold Asciiz Call SetWindowLong(hWnd,0,iLnCt) 'pointers will be iLnCt * 4 bytes. Having allocated this buffer to hold Call SetWindowLong(hWnd,4,ptrPtrBuffer) 'my line pointers I next run through the drivers again with the While loop... While SQLDrivers(hEnvr,%SQL_FETCH_NEXT,szDriverDes,64,iLen1,szDriverAttr,256,iLen2)<>%SQL_NO_DATA @ptrPtrBuffer[iLine]=GlobalAlloc(%GPTR,Len(szDriverDes)+1) If @ptrPtrBuffer[iLine] Then '...but this time I actually do more than count the attribute/value pairs - I Poke$ Asciiz, @ptrPtrBuffer[iLine], szDriverDes iLine=iLine+2 'Parse them into the dynamically allocated Redim'ed array strArr(). The next Decr iLen2 'step once each driver's attributes are in strArr() is to loop through strArr() ptrByte=VarPtr(szDriverAttr) 'extracting the strings and allocating seperate memory to hold each one. The For i=0 To iLen2 'base address of this allocation must then be stored in successive four byte If @ptrByte[i]=0 Then 'slots in the pointer to pointer buffer - ptrPtrBuffer. Then the characters in @ptrByte[i]=44 'each strArr() string need to be copied to the memory allocated for the line and End If 'now pointed to by the ptrPtrBuffer[i] pointer. Don't worry - it won't get any Next i 'worse than this! You can see that in the CopyMemory() call below. Poke$ is @ptrByte[iLen2]=0 'designed for this sort of thing in Basics, but Poke$ wasn't working when I wrote ReDim strArr(ParseCount(szDriverAttr)-1) Parse szDriverAttr,strArr() 'the code and CopyMemory() was, so we ended up with CopyMemory() for better or for For i=0 To UBound(strArr,1) 'worse. Its nice when memory is zeroed out too. That's what FillMemory() does. iLen=Len(strArr(i)) @ptrPtrBuffer[iLine]=GlobalAlloc(%GPTR,iLen+1) 'Finally, all the way at the bottom of this Sub you see a If @ptrPtrBuffer[iLine] Then 'call to ShowWindow(). The hWnd is the frmOutput class FillMemory(@ptrPtrBuffer[iLine],iLen+1,0) 'window CreateWindow()'ed in between the two While loops. CopyMemory(@ptrPtrBuffer[iLine],Strptr(strArr(i)),iLen) 'Don't forget that CreateWindow() didn't make the window Incr iLine 'visible. It did create the internal window construction End If 'apparatus, however. Now the ShowWindow() call will force Next i 'a WM_SIZE and WM_PAINT message in the output window, and Erase strArr() 'the message handlers for these messages will extract the pointers stored in the iLine=iLine+2 'Window's .cbWndExtra bytes described in detail above, and the text asciiz strings End If 'will be displayed in TextOut() calls in frmOutput_OnPaint(). Note that to Loop 'prevent memory leaks all this allocated memory needs to be returned to the operating Call SQLFreeHandle(%SQL_HANDLE_ENV,hEnvr) 'System, and that is done in the WM_CLOSE processing. If the user (you) leaves any End If 'of these output windows open and clicks the [X] on the Main Form, the WM_CLOSE Call ShowWindow(hWnd,%SW_SHOWNORMAL) 'processing won't be instigated by the WM_CLOSE from the frmOutput Window. To MousePtr 1 'prevent this memory from leaking, the Main Window's WM_CLOSE processing does End Sub 'iterative FindWindow() calls on any outstanding output windows to release the memory.
Function GetExcelRecordCount(Sql As ISql, iLine As Long) As Long 'In dealing with databases through the low level Local iRecCt, iJunk As Long 'ODBC Api there really isn't any kind of record Local szQuery As Asciiz*64 'count function that works for all data sources; Local hStmt As Dword 'however, the Structured Query Language that is
#If %Def(%MyDebug) 'so central a concept in ODBC has a 'Count' keyword Print #fp, " Entering GetExcelRecordCount() As Long" 'used in SELECT Statements that serves the purpose #EndIf 'very well. It is convenient to wrap it in a function szQuery="SELECT Count(*) As RecordCount From [Sheet1$];" 'as I've done here. #If %Def(%MyDebug) Print #fp, " szQuery = " szQuery #EndIf Call SQLAllocHandle(%SQL_HANDLE_STMT,Sql.hConn,hStmt) Call SQLBindCol(hStmt,1,%SQL_C_ULONG,iRecCt,0,iJunk) If SQLExecDirect(hStmt,szQuery,%SQL_NTS)<>%SQL_SUCCESS Then iRecCt=-1 Else Call SQLFetch(hStmt) SQLCloseCursor(hStmt) End If Call SQLFreeHandle(%SQL_HANDLE_STMT,hStmt) #If %Def(%MyDebug) Print #fp, " Leaving GetExcelRecordCount() As Long" #EndIf
Function=iRecCt End Function
Function blnDumpExcelData(Byref Sql As ISql, Byval ptrLines As Dword Ptr, Byref iLine As Long, Byval hWnd As Dword) As Long Local szQuery As Asciiz*128, szDate As Asciiz*16, szString As Asciiz*64, szBuffer As Asciiz*128 Local strFld1 As String*4, strFld2 As String*8, strFld3 As String*16 Local ts As tagTIMESTAMP_STRUCT Local iId,iJnk As Long Local dblNum As Double Local hStmt As Dword
#If %Def(%MyDebug) Print #fp, " Entering blnDumpExcelData()" #EndIf szQuery="SELECT Id, Float_Point, Date_Field, Text_Field FROM [Sheet1$];" Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szQuery)) Incr iLine 'The most difficult part about extracting data from tables Call SQLAllocHandle(%SQL_HANDLE_STMT,Sql.hConn,hStmt) 'with ODBC are all the SQLBindCol() calls you need to make. Call SQLBindCol(hStmt,1,%SQL_C_ULONG,iId,0,iJnk) 'For every field you wish to extract from a table you are Call SQLBindCol(hStmt,2,%SQL_C_DOUBLE,dblNum,0,iJnk) 'going to need an SQLBindCol() call. What this does is Call SQLBindCol(hStmt,3,%SQL_C_TYPE_DATE,ts,0,iJnk) 'link the address of a variable in your program with the ODBC Call SQLBindCol(hStmt,4,%SQL_C_CHAR,szString,64,iJnk) 'code machinery so that as you loop through the retrieved If SQLExecDirect(hStmt,szQuery,%SQL_NTS)=%SQL_SUCCESS Then 'dataset, the field data is placed in the proper variables. szBuffer="iId Double Date String" 'The last parameter I named Junk (iJnk) because I didn't use Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szBuffer)) 'it in this program is where ODBC places the number of bytes szBuffer="====================================================" 'it placed in your bound column variable. For example, column Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szBuffer)) 'two is a double, so an '8' will end up there every time it Do While(SQLFetch(hStmt)<>%SQL_NO_DATA) 'reads a non NULL value out of the database field 'Float_Point. szDate=Trim$(Str$(ts.month))+"/"+Trim$(Str$(ts.day))+"/"+Trim$(Str$(ts.year)) #If %Def(%MyDebug) Print #fp, " " iId, dblNum, szDate, szString #EndIf LSet strFld1=Str$(iId) : RSet strFld2=Format$(dblNum,"#0.0###") : RSet strFld3=szDate szBuffer=strFld1 & " " & strFld2 & strFld3 & " " & szString Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szBuffer)) Loop 'Its important to know that if a null field is read, a zero Call SQLCloseCursor(hStmt) 'will show up in the last parameter for that field. This Call SQLFreeHandle(%SQL_HANDLE_STMT,hStmt) 'gets very important when transferring data from one database blnDumpExcelData=%TRUE 'to another as this field will let you know if anything was Else 'put into your bound column. blnDumpExcelData=%FALSE End If #If %Def(%MyDebug) Print #fp, " Leaving blnDumpExcelData()" : Print #fp, #EndIf End Function
Sub btnExcel_OnClick(Wea As WndEventArgs) Local iRecCt,iLine,iScreenLinesNeeded,iReturn As Long Local szCaption As Asciiz*48,szLn As Asciiz*128 Local hIns,hOutput As Dword Local ptrLines As Dword Ptr Local strCnStr As String Local Sql As ISql
#If %Def(%MyDebug) Print #fp, "Entering btnExcel_OnClick()" #EndIf MousePtr 11 hIns=GetModuleHandle("") szCaption="Data Dump Of Excel Spreadsheet With ODBC" hOutput=CreateWindow("frmOutput",szCaption,%WS_OVERLAPPEDWINDOW,200,500,725,275,0,0,hIns,Byval 0) Let Sql=Class "CSql" Sql.strDriver = "Microsoft Excel Driver (*.xls)" Sql.strDBQ = CurDir$ & "\Book1.xls" Sql.ODBCConnect() strCnStr=Sql.strConnectionString If Sql.blnConnected=%TRUE Then #If %Def(%MyDebug) Print #fp, " strCnStr = " strCnStr Print #fp, " Sql.blnConnected = %TRUE" #EndIf iRecCt=GetExcelRecordCount(Sql,iLine) #If %Def(%MyDebug) Print #fp, " iRecCt = " iRecCt #EndIf iScreenLinesNeeded=iScreenLinesNeeded+iRecCt+10 ptrLines=GlobalAlloc(%GPTR,iScreenLinesNeeded*Sizeof(ptrLines)) If ptrLines Then Call SetWindowLong(hOutput,0,iScreenLinesNeeded) Call SetWindowLong(hOutput,4,ptrLines) szLn=CurDir$ Prnt(Wea.hWnd,Sql,ptrLines,iLine,Varptr(szLn)) szLn=strCnStr Prnt(Wea.hWnd,Sql,ptrLines,iLine,Varptr(szLn)) szLn="ODBC Connection Succeeded!" Prnt(Wea.hWnd,Sql,ptrLines,iLine,Varptr(szLn)) If blnDumpExcelData(Sql,ptrLines,iLine,Wea.hWnd) Then #If %Def(%MyDebug) Print #fp, " blnDumpExcelData() Succeeded!" #EndIf Else #If %Def(%MyDebug) Print #fp, " blnDumpExcelData() Failed!" #EndIf End If Else iReturn=MsgBox("Memory Allocation Error!",%MB_ICONERROR,"Must Abort!") End If Sql.ODBCDisconnect() Else szLn="Sql.blnConnected=%FALSE" : Prnt(Wea.hWnd,Sql,ptrLines,iLine,Varptr(szLn)) szLn="Sql.iNativeErrCode = " & Str$(Sql.iNativeErrCode) : Prnt(Wea.hWnd,Sql,ptrLines,iLine,Varptr(szLn)) szLn="Sql.strErrCode = " & Sql.strErrCode : Prnt(Wea.hWnd,Sql,ptrLines,iLine,Varptr(szLn)) szLn="Sql.strErrMsg = " & Sql.strErrMsg : Prnt(Wea.hWnd,Sql,ptrLines,iLine,Varptr(szLn)) End If Call ShowWindow(hOutput,%SW_SHOWNORMAL) #If %Def(%MyDebug) Print #fp, "Leaving btnExcel_OnClick()" : Print #fp, #EndIf MousePtr 1 End Sub
Function iInstallerError() As Dword Local pErr As Dword Local szMsg As Asciiz*512 Local cbReturned As Word Local wErrNum As Word
wErrNum=1 While SQLInstallerError(wErrNum,pErr,szMsg,512,cbReturned)<>%SQL_NO_DATA Incr wErrNum Wend
Function=pErr End Function 'continued next post
Title: Re: SqlDemo - Example App Connects To Microsoft Databases Using ODBC Class
Post by: Frederick J. Harris on September 13, 2009, 08:48:40 PM
Function iCreateMdb(strDBName As String) As Long Local strCreate As String
#If %Def(%MyDebug) Print #fp, " Entering iCreateMdb()" #EndIf strCreate="CREATE_DB=" & strDBName If SQLConfigDataSource(0,%ODBC_ADD_DSN,"Microsoft Access Driver (*.mdb)",Byval Strptr(strCreate)) Then Function=%TRUE Else Function=iInstallerError() End If #If %Def(%MyDebug) Print #fp, " Leaving iCreateMdb()" #EndIf End Function
Function blnMakeAccessTable(Sql As ISql) As Long Local szQuery As Asciiz*128 Local hStmt As Dword
szQuery= _ 'These four types are all you really need. "CREATE TABLE Table1 " & _ 'Doubles will work for currency. "(" & _ "Id LONG, " & _ 'Note that all interactions with the "Float_Point DOUBLE, " & _ 'underlying database are through Sql "Date_Field DATETIME, " & _ 'statements "Text_Field CHAR(30)" & _ ");" Call SQLAllocHandle(%SQL_HANDLE_STMT,sql.hConn,hStmt) If SQLExecDirect(hStmt,szQuery,%SQL_NTS)=0 Then Call SQLFreeHandle(%SQL_HANDLE_STMT,hStmt) blnMakeAccessTable=%TRUE Else blnMakeAccessTable=%FALSE End If End Function
Function GetRecordCount(Sql As ISql) As Long Local szQuery As Asciiz*64 Local iRecCt,iJnk As Long Local hStmt As Dword
szQuery="SELECT Count(*) As RecordCount From Table1;" Call SQLAllocHandle(%SQL_HANDLE_STMT,sql.hConn,hStmt) Call SQLBindCol(hStmt,1,%SQL_C_ULONG,iRecCt,0,iJnk) If SQLExecDirect(hStmt,szQuery,%SQL_NTS)=%SQL_SUCCESS Then Call SQLFetch(hStmt) Call SQLCloseCursor(hStmt) Call SQLFreeHandle(%SQL_HANDLE_STMT,hStmt) Function=iRecCt Else Call SQLFreeHandle(%SQL_HANDLE_STMT,hStmt) #If %Def(%MyDebug) Print #fp, " Sql.iNativeErrCode = " Sql.iNativeErrCode Print #fp, " Sql.strErrMsg = " Sql.strErrMsg Print #fp, " Sql.strErrCode = " Sql.strErrCode #EndIf Function=-1 End If End Function
Sub ParseDate(strDate As String,strFormat As String,strDelimiter As String,ts As tagTIMESTAMP_STRUCT) Local strDt As String Register i As Long
strDt=strDate Select Case As Const$ UCase$(strFormat) 'If your program has dates in formats such as Case "MDY" '11/15/1952, 11-15-1952, 15.11.1952, 1952,11,15, For i=1 To Len(strDt) 'then these strings need to be parsed to tease If Mid$(strDt,i,1)=strDelimiter Then 'out the day, month and year numbers for transfer ts.month=Val(Left$(strDt,i-1)) 'to an ODBC tagTIMESTAMP_STRUCT. This structure strDt=Right$(strDt,Len(strDt)-i) 'is defined in SqlTypes.inc like so... Exit For ' End If ' TYPE tagTIMESTAMP_STRUCT Next i ' year AS INTEGER '2 bytes For i=1 To Len(strDt) ' month AS WORD '2 bytes If Mid$(strDt,i,1)=strDelimiter Then ' day AS WORD '2 bytes ts.day=Val(Left$(strDt,i-1)) ' hour AS WORD '2 bytes ts.year=Val(Right$(strDt,4)) ' minute AS WORD '2 bytes Exit For ' second AS WORD '2 bytes End If ' fraction AS DWORD '4 bytes Next i ' END TYPE '16 bytes total Case "DMY" ' For i=1 To Len(strDt) 'ParseDate() takes four parameters as follows... If Mid$(strDt,i,1)=strDelimiter Then ' ts.day=Val(Left$(strDt,i-1)) ' strDt=Right$(strDt,Len(strDt)-i) 'Sub ParseDate Exit For '( End If ' strDate As String, 'e.g., "11/15/1952" Next i ' strFormat As String, 'e.g., "mdy" For i=1 To Len(strDt) ' strDelimiter As String, 'e.g., "\", "-", "." If Mid$(strDt,i,1)=strDelimiter Then ' ts As tagTIMESTAMP_STRUCT ts.month=Val(Left$(strDt,i-1)) ') ts.year=Val(Right$(strDt,4)) ' Exit For ' End If 'Example - Call ParseDate("11/15/1952","mdy","/",ts) Next i Case "YMD" For i=1 To Len(strDt) If Mid$(strDt,i,1)=strDelimiter Then ts.year=Val(Left$(strDt,i-1)) strDt=Right$(strDt,Len(strDt)-i) Exit For End If Next i For i=1 To Len(strDt) If Mid$(strDt,i,1)=strDelimiter Then ts.month=Val(Left$(strDt,i-1)) ts.day=Val(Right$(strDt,2)) Exit For End If Next i End Select End Sub
Function blnInsert(Sql As ISql, Byval ptrLines As Dword Ptr, iLine As Long, Byval hWnd As Dword, Byval iCtRecs As Long) As Long Local strFld1 As String*4, strFld2 As String*8, strFld3 As String*16, strFld4 As String*20 Local iId,iJnk,iStr,iReturn As Long Local ts As tagTIMESTAMP_STRUCT Local szString As Asciiz*32 Local strDates() As String Local szLine As Asciiz*128 Local dblNums() As Double Local strStrs() As String Local dblNum As Double Local hStmt As Dword Register i As Long
#If %Def(%MyDebug) Print #fp, "Entering blnInsert()" #EndIf Redim dblNums(3) As Double : dblNums(0)=3.14159 : dblNums(1)=1.23456 : dblNums(2)=15.1234 : dblNums(3)=0.54321 Redim strDts(3) As String : strDts(0)="11/15/1952" : strDts(1)="6/30/1969" : strDts(2)="1/1/2006" : strDts(3)="4/1/2006" Redim strStrs(3) As String : strStrs(0)="My Birthday" : strStrs(1)="Walk On Moon?" : strStrs(2)="Some String" : strStrs(3)="April Fools Day!" If SQLAllocHandle(%SQL_HANDLE_STMT,sql.hConn,hStmt)=%SQL_SUCCESS Then 'Allocate statement handle szLine="INSERT INTO Table1 (Id,Float_Point,Date_Field,Text_Field) VALUES(?,?,?,?)" Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szLine)) Incr iLine iStr=%SQL_NTS If SQLPrepare(hStmt,szLine,%SQL_NTS)=%SQL_SUCCESS Then SQLBindParameter(hStmt,1,%SQL_PARAM_INPUT,%SQL_C_LONG,%SQL_INTEGER,0,0,iId,0,iJnk) SQLBindParameter(hStmt,2,%SQL_PARAM_INPUT,%SQL_C_DOUBLE,%SQL_DOUBLE,0,0,dblNum,0,iJnk) SQLBindParameter(hStmt,3,%SQL_PARAM_INPUT,%SQL_C_TYPE_DATE,%SQL_TYPE_TIMESTAMP,16,0,ts,0,iJnk) SQLBindParameter(hStmt,4,%SQL_PARAM_INPUT,%SQL_C_CHAR,%SQL_CHAR,31,0,szString,32,iStr) szLine=" SQLExecute(hStmt)" Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szLine)) szLine=" iId Double Date String 0=SQL_SUCCESS " Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szLine)) szLine="========================================================================" Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szLine)) For i=0 To 3 iId=i+iCtRecs+1 : dblNum=dblNums(i) Call ParseDate(strDts(i),"mdy","/",ts) szString=strStrs(i) iReturn=SQLExecute(hStmt) If iReturn<>%SQL_SUCCESS Then Sql.ODBCGetDiagRec(hStmt) szLine="Sql.strErrCode = " & Sql.strErrCode Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szLine)) szLine="Sql.strErrMsg = " & Sql.strErrMsg Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szLine)) szLine="Sql.iNativeErrCode = " & Str$(Sql.iNativeErrCode) Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szLine)) SQLFreeHandle(%SQL_HANDLE_STMT,hStmt) Function=%FALSE Exit Function Else LSet strFld1=Str$(iId) : RSet strFld2=Format$(dblNum,"#0.0###") : RSet strFld3=strDts(i) : LSet strFld4=szString szLine=strFld1 & " " & strFld2 & strFld3 & " " & strFld4 & Str$(iReturn) Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szLine)) End If Next i SQLFreeHandle(%SQL_HANDLE_STMT,hStmt) blnInsert=%TRUE Else blnInsert=%FALSE End If Else blnInsert=%FALSE End If #If %Def(%MyDebug) Print #fp, " Leaving blnInsert()" #EndIf End Function
Function blnDumpData(Sql As ISql, Byval ptrLines As Dword Ptr, iLine As Long, Byval hWnd As Dword, Byval iCtRecs As Long) As Long Local strFld1 As String*4, strFld2 As String*8, strFld3 As String*16, strFld4 As String*20 Local szQuery As Asciiz*64, szLine As Asciiz*80, szString As Asciiz*32 Local ts As tagTIMESTAMP_STRUCT Local strDate As String Local dblNum As Double Local iId,iJnk As Long Local hStmt As Dword #Register None
If SQLAllocHandle(%SQL_HANDLE_STMT,Sql.hConn,hStmt)=0 Then Incr iLine szQuery="SELECT Id, Float_Point, Date_Field, Text_Field FROM Table1;" Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szQuery)) Incr iLine Call SQLBindCol(hStmt,1,%SQL_C_ULONG,iId,0,iJnk) Call SQLBindCol(hStmt,2,%SQL_C_DOUBLE,dblNum,0,iJnk) Call SQLBindCol(hStmt,3,%SQL_C_TYPE_DATE,ts,0,iJnk) Call SQLBindCol(hStmt,4,%SQL_C_CHAR,szString,30,iJnk) szLine=" SQLExecute(hStmt)" Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szLine)) szLine=" iId Double Date String 0=SQL_SUCCESS " Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szLine)) szLine="========================================================================" Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szLine)) If SQLExecDirect(hStmt,szQuery,%SQL_NTS)=%SQL_SUCCESS Then Do While SQLFetch(hStmt)<>%SQL_NO_DATA strDate=Trim$(Str$(ts.month))+"/"+Trim$(Str$(ts.day))+"/"+Trim$(Str$(ts.year)) LSet strFld1=Str$(iId) : RSet strFld2=Format$(dblNum,"#0.0###") : RSet strFld3=strDate : LSet strFld4=Left$(szString,16) szLine=strFld1 & " " & strFld2 & strFld3 & " " & strFld4 & " 0" Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szLine)) Loop Call SQLCloseCursor(hStmt) Call SQLFreeHandle(%SQL_HANDLE_STMT,hStmt) blnDumpData=%TRUE Else Sql.ODBCGetDiagRec(hStmt) szLine="SQLExecDirect() In blnDumpData() Failed!" : Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szLine)) szLine="Sql.strErrCode = " & Sql.strErrCode : Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szLine)) szLine="Sql.strErrMsg = " & Sql.strErrMsg : Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szLine)) szLine="Sql.iNativeErrCode = " & Str$(Sql.iNativeErrCode) : Prnt(hWnd,Sql,ptrLines,iLine,Varptr(szLine)) blnDumpData=%FALSE End If Else blnDumpData=%FALSE End If End Function
Function AccessThread(Byval pVoid As Dword) As Dword Local iDatabaseReturn,iRecCt,iScreenLinesNeeded,iLine,iReturn As Long Local hOutput,hMainWnd As Dword Local cs As CRITICAL_SECTION Local ptrLines As Dword Ptr Local szLn As Asciiz*128 Local Sql As ISql
#If %Def(%MyDebug) Print #fp, " Entering AccessThread()" #EndIf hOutput=FindWindowEx(0,0,"frmOutput","Data Dump Of Access Database With ODBC") hMainWnd=FindWindowEx(0,0,"SqlDemo","ODBC Demo") If hOutput Then Let Sql=Class "CSql" Sql.strDriver="Microsoft Access Driver (*.mdb)" Sql.strDBQ=CurDir$+"\TestData.mdb" iDatabaseReturn=iCreateMdb(Sql.strDBQ) #If %Def(%MyDebug) Print #fp, " iDatabaseReturn = " iDatabaseReturn #EndIf Sql.ODBCConnect() If Sql.blnConnected Then Select Case As Long iDatabaseReturn Case 1 If blnMakeAccessTable(Sql) Then iRecCt=GetRecordCount(Sql) #If %Def(%MyDebug) Print #fp, " iRecCt = " iRecCt #EndIf iScreenLinesNeeded=iScreenLinesNeeded+iRecCt+25 ptrLines=GlobalAlloc(%GPTR,iScreenLinesNeeded*Sizeof(ptrLines)) If ptrLines Then Call SetWindowLong(hOutput,0,iScreenLinesNeeded) Call SetWindowLong(hOutput,4,ptrLines) szLn=CurDir$ Prnt(hMainWnd,Sql,ptrLines,iLine,Varptr(szLn)) szLn=Sql.strConnectionString Prnt(hMainWnd,Sql,ptrLines,iLine,Varptr(szLn)) szLn="ODBC Connection Succeeded!" Prnt(hMainWnd,Sql,ptrLines,iLine,Varptr(szLn)) szLn="TestData.mdb Successfully Created As Well As Table1 In TestData." Prnt(hMainWnd,Sql,ptrLines,iLine,Varptr(szLn)) If blnInsert(Sql,ptrLines,iLine,hMainWnd,iRecCt) Then If blnDumpData(Sql,ptrLines,iLine,hMainWnd,iRecCt) Then iReturn=%TRUE Else iReturn=%FALSE End If Else iReturn=%FALSE End If Else iReturn=%FALSE End If Else iReturn=%FALSE End If Case 11 iRecCt=GetRecordCount(Sql) #If %Def(%MyDebug) Print #fp, " iRecCt = " iRecCt #EndIf iScreenLinesNeeded=iScreenLinesNeeded+iRecCt+25 ptrLines=GlobalAlloc(%GPTR,iScreenLinesNeeded*Sizeof(ptrLines)) If ptrLines Then Call SetWindowLong(hOutput,0,iScreenLinesNeeded) Call SetWindowLong(hOutput,4,ptrLines) szLn=CurDir$ Prnt(hMainWnd,Sql,ptrLines,iLine,Varptr(szLn)) szLn=Sql.strConnectionString Prnt(hMainWnd,Sql,ptrLines,iLine,Varptr(szLn)) szLn="ODBC Connection Succeeded!" Prnt(hMainWnd,Sql,ptrLines,iLine,Varptr(szLn)) szLn="TestData.mdb Already Existed And Contained" & Str$(iRecCt) & " Records." Prnt(hMainWnd,Sql,ptrLines,iLine,Varptr(szLn)) If blnInsert(Sql,ptrLines,iLine,hMainWnd,iRecCt) Then If blnDumpData(Sql,ptrLines,iLine,hMainWnd,iRecCt) Then iReturn=%TRUE Else iReturn=%FALSE End If Else iReturn=%FALSE End If Else iReturn=%FALSE End If Case Else iReturn=%FALSE End Select Sql.ODBCDisconnect() End If End If #If %Def(%MyDebug) Print #fp, " Leaving AccessThread()" #EndIf
Function=iReturn End Function
Sub btnAccess_OnClick(Wea As WndEventArgs) Local hOutput,hIns,hThread,hWait,iReturn As Dword Local szTxt As Asciiz*48
#If %Def(%MyDebug) Print #fp, "Entering btnAccess_OnClick()" #EndIf MousePtr 11 Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_MS_ACCESS),%FALSE) hIns=GetModuleHandle("") szTxt="Data Dump Of Access Database With ODBC" hOutput=CreateWindow("frmOutput",szTxt,%WS_OVERLAPPEDWINDOW,200,500,725,275,0,0,hIns,Byval 0) Thread Create AccessThread(0) To hThread hWait=WaitForSingleObject(hThread,%INFINITE) Thread Status hThread To iReturn #If %Def(%MyDebug) Print #fp, " iReturn = " iReturn #EndIf Thread Close hThread To iReturn #If %Def(%MyDebug) Print #fp, " hThread = " hThread #EndIf Call ShowWindow(hOutput,%SW_SHOWNORMAL) MousePtr 1 Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_MS_ACCESS),%TRUE) #If %Def(%MyDebug) Print #fp, "Leaving btnAccess_OnClick()" : Print #fp #EndIf End Sub
Function iCreateSqlServer(Sql As ISql, strDBName As String) As Long Local szBuffer As Asciiz*512 Local strBuffer As String Local dwBuffer As Dword Local iReturn As Long Local hStmt As Dword
dwBuffer=512 Call GetCurrentDirectory(dwBuffer,szBuffer) 'For this demo I'm creating an SQL Server strBuffer= _ 'database in whatever directory you decide "CREATE DATABASE " & strDBName & " " & _ 'to run this program from. SQL Server "ON " & _ 'databases in the latest versions of SQL "(" & _ 'Server show up as part of the regular "NAME=" & Chr$(39) & strDBName & Chr$(39) & "," & _ "FILENAME=" & Chr$(39) & szBuffer & "\" & strDBName & ".mdf" & Chr$(39) & "," & _ "SIZE=10," & _ "MAXSIZE=50," & _ 'file system and are comprised of a *.mdf "FILEGROWTH=5" & _ 'file (the main database file) and a *.ldf ") LOG ON " & _ 'file (the database log). These files need "(" & _ 'not be under the SQL Server installation "NAME=" & Chr$(39) & strDBName & "Log" & Chr$(39) & "," & _ "FILENAME=" & Chr$(39) & szBuffer & "\" & strDBName & ".ldf" & Chr$(39) & "," & _ "SIZE=5," & _ "MAXSIZE=25," & _ 'directory, but can be anywhere you wish "FILEGROWTH=5MB" & _ 'to place them. ");" If SQLAllocHandle(%SQL_HANDLE_STMT,Sql.hConn,hStmt)=%SQL_SUCCESS Then iReturn=SQLExecDirect(hStmt,ByVal StrPtr(strBuffer),%SQL_NTS) If iReturn=%SQL_SUCCESS Or iReturn=%SQL_SUCCESS_WITH_INFO Then iCreateSqlServer=1 Else Sql.ODBCGetDiagRec(hStmt) #If %Def(%MyDebug) Print #fp, "SQLExecDirect() In blnCreateSqlServer() Failed!" Print #fp, "Sql.strErrCode = " Sql.strErrCode Print #fp, "Sql.strErrMsg = " Sql.strErrMsg Print #fp, "Sql.iNativeErrCode = " Sql.iNativeErrCode #EndIf iCreateSqlServer=Sql.iNativeErrCode End If Call SQLFreeHandle(%SQL_HANDLE_STMT,hStmt) Else iCreateSqlServer=%FALSE End If End Function
Function blnCreateTable(Sql As ISql, strTableName As String) As Long Local szQuery As Asciiz*256 Local hStmt As Dword
szQuery= _ "CREATE TABLE " & strTableName & " " & _ "(" & _ "Id int NOT NULL, " & _ 'Note that all interactions with the "Float_Point float NULL, " & _ 'underlying database are through Sql "Date_Field smalldatetime NULL, " & _ 'statements "Text_Field nvarchar(32) NULL" & _ ");" Call SQLAllocHandle(%SQL_HANDLE_STMT,sql.hConn,hStmt) If SQLExecDirect(hStmt,szQuery,%SQL_NTS)=%SQL_ERROR Then #If %Def(%MyDebug) Print #fp, "Table Creation Failure!" Sql.ODBCGetDiagRec(hStmt) Print #fp, "Sql.strErrCode = " Sql.strErrCode Print #fp, "Sql.strErrMsg = " Sql.strErrMsg Print #fp, "Sql.iNativeErrCode = " Sql.iNativeErrCode #EndIf blnCreateTable=%FALSE Else Call SQLFreeHandle(%SQL_HANDLE_STMT,hStmt) blnCreateTable=%TRUE End If End Function
Function SqlServerThread(Byval pVoid As Dword) As Dword Local iDatabaseReturn,iRecCt,iScreenLinesNeeded,iLine,iReturn As Long Local szLn As Asciiz*128, lpBuffer As Asciiz*512 Local hOutput,hMainWnd,nSize As Dword Local ptrLines As Dword Ptr Local Sql As ISql
#If %Def(%MyDebug) Print #fp, " Entering SqlServerThread()" #EndIf hOutput=FindWindowEx(0,0,"frmOutput","Data Dump Of Sql Server With ODBC") hMainWnd=FindWindowEx(0,0,"SqlDemo","ODBC Demo") If hOutput Then Let Sql=Class "CSql" Sql.strDriver="SQL Server"
'For SQL Server Express nSize=512 Call GetComputerName(lpBuffer,nSize) Sql.strServer=lpBuffer+"\SQLEXPRESS" 'End Sql Server Express
'''MSDE 'If you don't have Sql Server Express installed but rather Microsoft's MSDE, 'Sql.strServer="localhost" 'then simply set Sql.strServer to "localhost" and comment out the three '''End MSDE 'lines above. MSDE is the database engine for Sql Server 2000, I believe.
Sql.ODBCConnect() If Sql.blnConnected Then #If %Def(%MyDebug) Print #fp, " Sql.blnConnected=%TRUE #EndIf iReturn=iCreateSqlServer(Sql,"TestData") Select Case As Long iReturn Case 1 #If %Def(%MyDebug) Print #fp, " Successfully Created SQL Server Database TestData" #EndIf Sql.ODBCDisconnect() iScreenLinesNeeded=25 Call SetWindowLong(hOutput,0,iScreenLinesNeeded) ptrLines=GlobalAlloc(%GPTR,iScreenLinesNeeded*Sizeof(ptrLines)) If ptrLines Then Call SetWindowLong(hOutput,4,ptrLines) szLn="Sql.strDriver = " & Sql.strDriver Prnt(hMainWnd,Sql,ptrLines,iLine,Varptr(szLn)) szLn="Sql.strServer = " & Sql.strServer Prnt(hMainWnd,Sql,ptrLines,iLine,Varptr(szLn)) szLn="Sql.strConnectionString = " & Sql.strConnectionString Prnt(hMainWnd,Sql,ptrLines,iLine,Varptr(szLn)) szLn="Current Directory = " & CurDir$ Prnt(hMainWnd,Sql,ptrLines,iLine,Varptr(szLn)) Sql.strDBQ=CurDir$ & "\TestData.mdf" Sql.strDatabase = "TestData" Sql.ODBCConnect() If Sql.blnConnected Then iReturn=blnCreateTable(Sql,"Table1") If iReturn=%SQL_SUCCESS Or iReturn=%SQL_SUCCESS_WITH_INFO Then #If %Def(%MyDebug) Print #fp, " Successfully Created SQL Server Database Table Table1 In TestData." #EndIf If blnInsert(Sql,ptrLines,iLine,hMainWnd,iRecCt) Then #If %Def(%MyDebug) Print #fp, " blnInsert() Succeeded!" #EndIf Else #If %Def(%MyDebug) Print #fp, " blnInsert() Failed!" #EndIf End If If blnDumpData(Sql,ptrLines,iLine,hMainWnd,iRecCt) Then #If %Def(%MyDebug) Print #fp, " blnDumpData() Succeeded!" #EndIf Else #If %Def(%MyDebug) Print #fp, " blnDumpData() Failed!" #EndIf End If Else #If %Def(%MyDebug) Print #fp, " Failed To Create Table1 In TestData." #EndIf Call GlobalFree(ptrLines) Call SetWindowLong(hOutput,4,0) Function=%FALSE End If Sql.ODBCDisconnect() Else #If %Def(%MyDebug) Print #fp, " Could Not Reconnect To Sql Server. Must Abort." #EndIf Call GlobalFree(ptrLines) Call SetWindowLong(hOutput,4,0) Function=%FALSE End If Else #If %Def(%MyDebug) Print #fp, " Could Not Allocate Memory For ptrLines. Must Abort." #EndIf iReturn=%FALSE End If Case 1801 'If the Sql Server database 'TestData' already exists, you'll get a Native Error Code of 1801 returned #If %Def(%MyDebug) Print #fp, " The Database 'TestData' Apparently Already Exists." #EndIf Sql.ODBCDisconnect() Sql.strDatabase = "TestData" Sql.strDBQ=CurDir$ + "\TestData.mdf" Sql.ODBCConnect() If Sql.blnConnected Then iRecCt=GetRecordCount(Sql) #If %Def(%MyDebug) Print #fp, " iRecCt = " iRecCt #EndIf If iRecCt<>-1 Then iScreenLinesNeeded=25+iRecCt Call SetWindowLong(hOutput,0,iScreenLinesNeeded) ptrLines=GlobalAlloc(%GPTR,iScreenLinesNeeded*Sizeof(ptrLines)) 'Print #fp, "ptrLines = " ptrLines If ptrLines Then Call SetWindowLong(hOutput,4,ptrLines) szLn="Failed To Create SQL Server Database!" Prnt(hMainWnd,Sql,ptrLines,iLine,Varptr(szLn)) szLn="Failed To Create SQL Server Database!" Prnt(hMainWnd,Sql,ptrLines,iLine,Varptr(szLn)) szLn="TestData Already Exists In Sql Server!" Prnt(hMainWnd,Sql,ptrLines,iLine,Varptr(szLn)) szLn="Sql.strDriver = " & Sql.strDriver Prnt(hMainWnd,Sql,ptrLines,iLine,Varptr(szLn)) szLn="Sql.strServer = " & Sql.strServer Prnt(hMainWnd,Sql,ptrLines,iLine,Varptr(szLn)) szLn="Sql.strConnectionString = " & Sql.strConnectionString Prnt(hMainWnd,Sql,ptrLines,iLine,Varptr(szLn)) If blnInsert(Sql,ptrLines,iLine,hMainWnd,iRecCt) Then #If %Def(%MyDebug) Print #fp, " blnInsert() Succeeded!" #EndIf Else #If %Def(%MyDebug) Print #fp, " blnInsert() Failed!" #EndIf End If If blnDumpData(Sql,ptrLines,iLine,hMainWnd,iRecCt) Then #If %Def(%MyDebug) Print #fp, " blnDumpData() Succeeded!" #EndIf Else #If %Def(%MyDebug) Print #fp, " blnDumpData() Failed!" #EndIf End If Else #If %Def(%MyDebug) Print #fp, " ptrLines = 0 So Memory Didn't Allocate!" #EndIf End If Else #If %Def(%MyDebug) Print #fp, " Couldn't Get Record Count! Must Abort!" #EndIf iReturn=%FALSE End If Sql.ODBCDisconnect() Else #If %Def(%MyDebug) Print #fp, " Could Not Reconnect To Sql Server. Must Abort." #EndIf iReturn=%FALSE End If Case 5133 #If %Def(%MyDebug) Print #fp, " Failure In Creation Of Sql Server Database TestData." Print #fp, " It May Be You Are Trying To Run This Program From Some Print #fp, " Directory Where SQL Server Won't Create Databases. #EndIf Sql.ODBCDisconnect() iReturn=%FALSE Case Else #If %Def(%MyDebug) Print #fp, " Some Unknown Error Occurred For Which This Application" Print #fp, " Has No Response." #EndIf Sql.ODBCDisconnect() iReturn=%FALSE End Select Else #If %Def(%MyDebug) Print #fp, " Sql.blnConnected=%FALSE. Could Not Connect To Sql Server. #EndIf iReturn=%FALSE End If Else #If %Def(%MyDebug) Print #fp, " Could Not Obtain A Handle To The Output Screen - frmOutput." #EndIf iReturn=%FALSE End If #If %Def(%MyDebug) Print #fp, " Leaving SqlServerThread()" #EndIf
Function=iReturn End Function
Sub btnSqlServerExpress_OnClick(Wea As WndEventArgs) Local hOutput,hIns,hThread,hWait,iReturn As Dword Local szTxt As Asciiz*48
#If %Def(%MyDebug) Print #fp, "Entering btnSqlServerExpress_OnClick()" #EndIf MousePtr 11 Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_SQL_SERVER_EXPRESS),%FALSE) hIns=GetModuleHandle("") szTxt="Data Dump Of Sql Server With ODBC" hOutput=CreateWindow("frmOutput",szTxt,%WS_OVERLAPPEDWINDOW,200,500,725,275,0,0,hIns,Byval 0) Thread Create SqlServerThread(0) To hThread hWait=WaitForSingleObject(hThread,%INFINITE) Thread Status hThread To iReturn #If %Def(%MyDebug) Print #fp, " iReturn = " iReturn #EndIf Thread Close hThread To iReturn #If %Def(%MyDebug) Print #fp, " hThread = " hThread #EndIf Call ShowWindow(hOutput,%SW_SHOW) MousePtr 1 Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_SQL_SERVER_EXPRESS),%TRUE) #If %Def(%MyDebug) Print #fp, "Leaving btnSqlServerExpress_OnClick()" : Print #fp #EndIf End Sub
Function fnWndProc_OnCommand(Wea As WndEventArgs) As Long Select Case As Long Lowrd(Wea.wParam) Case %IDC_SQL_DRIVERS Call btnSqlDrivers_OnClick(Wea) Case %IDC_EXCEL Call btnExcel_OnClick(Wea) Case %IDC_MS_ACCESS Call btnAccess_OnClick(Wea) Case %IDC_SQL_SERVER_EXPRESS Call btnSqlServerExpress_OnClick(Wea) End Select
fnWndProc_OnCommand=0 End Function
Function fnWndProc_OnClose(wea As WndEventArgs) As Long Local hOutput As Dword
Do 'Search And Destroy Mission For Any Sql Drivers Windows Hanging Around hOutput=FindWindowEx(0,0,"frmOutput","ODBC Database Drivers On Your System") If hOutput Then Call SendMessage(hOutput,%WM_CLOSE,0,0) Else Exit Do End If Loop
Do 'Search And Destroy Mission For Any Excel Output Windows Hanging Around hOutput=FindWindowEx(0,0,"frmOutput","Data Dump Of Excel Spreadsheet With ODBC") If hOutput Then Call SendMessage(hOutput,%WM_CLOSE,0,0) Else Exit Do End If Loop
Do 'Search And Destroy Mission For Any Access Output Windows Hanging Around hOutput=FindWindowEx(0,0,"frmOutput","Data Dump Of Access Database With ODBC") If hOutput Then Call SendMessage(hOutput,%WM_CLOSE,0,0) Else Exit Do End If Loop
Do 'Search And Destroy Mission For Any Sql Server Output Windows Hanging Around hOutput=FindWindowEx(0,0,"frmOutput","Data Dump Of Sql Server With ODBC") If hOutput Then Call SendMessage(hOutput,%WM_CLOSE,0,0) Else Exit Do End If Loop Call PostQuitMessage(0)
fnWndProc_OnClose=0 End Function
Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long Local Wea As WndEventArgs Register iReturn As Long Register i As Long
For i=0 To 2 If wMsg=MsgHdlr(i).wMessage Then Wea.hWnd=hWnd : Wea.wParam=wParam : Wea.lParam=lParam Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(Wea) To iReturn fnWndProc=iReturn Exit Function End If Next i
fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam) End Function
Sub AttachMessageHandlers() 'Associate Windows Message With Message Handlers Redim frmOutputHdlr(4) As MessageHandler ReDim MsgHdlr(2) As MessageHandler
Function WinMain(ByVal hIns As Long, ByVal hPrevIns As Long, ByVal lpCmdLn As Asciiz Ptr, ByVal iShowWnd As Long) As Long Local szAppName As Asciiz*16 Local wc As WndClassEx Local Msg As tagMsg Local hWnd As Dword
Type WndEventArgs wParam As Long lParam As Long hWnd As Dword hInst As Dword End Type
Type MessageHandler wMessage As Long dwFnPtr As Dword End Type
Global MsgHdlr() As MessageHandler Global frmOutputHdlr() As MessageHandler Declare Function FnPtr(wea As WndEventArgs) As Long
'The following two function declares are from ODBCCP32.h (Installer Dll) Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" Alias "SQLConfigDataSource" _ ( _ ByVal hParnt As Dword, _ ByVal iReqst As Word, _ szDriver As Asciiz, _ szAttr As Asciiz _ ) As Integer
Declare Function SQLInstallerError Lib "ODBCCP32.DLL" Alias "SQLInstallerError" _ ( _ ByVal iErr As Word, _ ByRef pErrCode As Dword, _ ByRef szErrMsg As Asciiz, _ ByVal cbMsgBuffer As Word, _ ByRef cbRet As Word _ ) As Integer
#If %Def(%MyDebug) Global fp As Long #EndIf
Sub ErrorMemFree(Byval pLns As Dword Ptr, Byval iNum As Dword) Register i As Long 'If there are any memory allocation errors For i=0 To iNum 'anywhere along the way, this little thingy If @pLns[i] Then 'unravels all the allocations done up to the GlobalFree(@pLns[i]) 'point where the 1st allocation error occurred. End If Next i GlobalFree(pLns) End Sub
Sub Prnt(Byval hWnd As Dword, Byref Sql As ISql, Byval ptrLines As Dword Ptr, Byref iLine As Long, Byval pszStr As Asciiz Ptr) Local iLen As Long 'This procedure is somewhat central to the app and is used many times. Its a 'wrapper to encapsulate the process of allocating memory for a line of text to iLen=Len(@pszStr) 'be eventually output to the output screen. A pointer to the line of text is @ptrLines[iLine]=GlobalAlloc(%GPTR,iLen+1) 'passed into the Sub in the last parameter - pszStr. An allocation is made for If @ptrLines[iLine] Then 'enough memory to hold the string plus a null terminator. Then the characters CopyMemory(@ptrLines[iLine],pszStr,iLen) 'are copied to the address of the allocated memory. ptrLines is a memory Incr iLine 'buffer allocated elsewhere that holds all the line pointers allocated here when Else 'a line of text is passed in. ptrLines is stored in the .cbWndExtra bytes of MessageBox(hWnd,"Memory Allocation Error!","Not Good!",%MB_ICONERROR) 'the frmOutput Screen (@offset 4). If a memory Call ErrorMemFree(ptrLines,iLine) 'allocation fails, ErrorMemFree() unravels all the memory allocations made up Sql.ODBCDisconnect() 'to the point of the failure. End If End Sub
Title: Re: SqlDemo - Example App Connects To Microsoft Databases Using ODBC Class
Post by: Frederick J. Harris on September 13, 2009, 08:52:53 PM
'Here is my class wrapper of some ODBC Api connection apparatus. Its one of the include files of SqlDemo.
Class CSql Instance m_strConnectionString As String 'This class wraps a small portion of the ODBC Api. Its useful Instance m_strDatabase As String 'particularly for easing connecting to ODBC Data Sources, i.e., Instance m_strDriver As String 'Relational Databases. However, I don't personally have experience Instance m_strServer As String 'with very many. The only ones I've ever worked with or connected Instance m_strDBQ As String 'to are Microsoft Access and Microsoft Sql Server. The process of Instance m_szCnStrOut As Asciiz*512 'connecting to ODBC databases involves something termed a Connection Instance iBytes As Integer 'String. These tend to be somewhat long and ugly concatenations of Instance swStrLen As Integer 'KEYWORD=VALUE pairs delimited by semicolons. For example, one of Instance m_hEnvr As Dword 'the important keywords is DRIVER. For connecting to Sql Server you Instance m_hConn As Dword 'would have then this - "DRIVER=Sql Server;". Another important Instance m_iNativeErrPtr As Long 'keyword is 'SERVER'. In the case of Microsoft's free Sql Server Instance m_iTextLenPtr As Integer 'Express, to connect it wants the name of your computer (the one I'm Instance m_szErrCode As Asciiz*8 'writing this on is 'CODEWARRIOR') followed with a slash and Instance m_szErrMsg As Asciiz*512 'SQLEXPRESS, i.e., SERVER=CODEWARRIOR\SQLEXPRESS. The resulting Instance m_blnConnected As Long 'connection string would then look something like this...
Interface ISql : Inherit IUnknown '"DRIVER=Sql Server;SERVER=CODEWARRIOR\SQLEXPRESS" Property Get strDatabase() As String Property=m_strDatabase 'This sort of construction lends itself to easy automation by just End Property 'including String members of a Class for the various Keywords, and Property Set strDatabase(Byval strName As String) 'then just having some kind of MakeConnectionString() function in m_strDatabase=strName 'the class to concatenate the necessary keyword/value pairs together End Property 'to build up the Connection String. You can see that below in my 'MakeConnectionString() function which is just called from Property Get strDriver() As String 'ODBCConnect(). In order to connect to a specific DRIVER/SERVER Property=m_strDriver 'then all you need do is instantiate an instance of this class and End Property 'interface in your program, set a few necessary keyword/attribute Property Set strDriver(Byval strName As String) 'pairs, and call ODBCConnect(). For example, to connect to a local m_strDriver=strName 'Sql Server Express installed on your workstation, but not to any End Property 'specific DATABASE maintained by that Sql Server, you could do this...
Property Get strServer() As String 'Local strComputerName As String Property=m_strServer 'Local Sql As ISql End Property Property Set strServer(Byval strName As String) 'Let Sql=Class "CSql" m_strServer=strName 'Sql.strDriver="Sql Server" End Property 'Host Name To strComputerName 'Sql.strServer=strComputerName & "\SQLEXPRESS" Property Get hConn() As Dword 'Call ODBCConnect() Property=m_hConn 'If Sql.blnConnected = %TRUE Then End Property ' .... ' .... do your stuff! Property Get strDBQ() As String ' ... Property=m_strDBQ ' Call ODBCDisconnect() End Property 'Else 'Oh No! Failure! Why???? Property Set strDBQ(Byval strName As String) ' Print "Sql.strErrMsg = " Sql.strErrMsg m_strDBQ=strName ' Print "Sql.iNativeErrCode = " Sql.iNativeErrCode End Property 'End If ' Property Get strConnectionString() As String 'However, my MakeConnectionString() function is limited by my Property=m_strConnectionString 'limited knowledge of databases to connect to, which as I have End Property Property Set strConnectionString(Byval strName As String) m_strConnectionString=strName End Property 'said, are only a few Microsoft products. If you have some other 'database you want to connect to, such as MySql, for example, and Property Get blnConnected() As Long 'you want to use my class here, you'll have to build the connection Property=m_blnConnected 'string yourself and then call ODBCConnect(). If you look down at End Property 'my MakeConnectionString() function, you'll see it first checks to Property Set blnConnected(Byval iConnected As Long) m_blnConnected=iConnected End Property 'see if m_strConnectionString is "" before setting any of the other 'attribute-value pairs. So, if you have a connection string for Property Get strErrCode() As String 'some database that already works for you, just do as I've done Property=m_szErrCode 'above in terms of declaring the variables, and set the End Property 'm_strConnectionString property directly using the class accessor 'property function, i.e., Property Get strErrMsg() As String Property=m_szErrMsg 'Sql.strConnectionString="DRIVER=SQL Server;SERVER=CODEWARRIOR\SQLEXPRESS;UID=;WSID=CODEWARRIOR;Trusted_Connection=Yes" End Property 'Call ODBCConnect()
Property Get iNativeErrCode() As Long 'If you have a database you want to connect to and don't have a Property=m_iNativeErrPtr 'connection string, then you'll need to find one. Go on the internet End Property 'and do a search for 'Connection Strings'. There are lots of web 'sites where good folks have posted connection strings for various Method MakeConnectionString() 'data sources/databases. Once you've got it working, perhaps you'll If m_strConnectionString="" Then 'want to break it down into piecies as I've done and modify the code Select Case m_strDriver 'just below. If you get one working I'd be real happy if you would Case "SQL Server" 'let me know about it so I could perhaps add it to my code here. If m_strDBQ="" Then m_strConnectionString= _ "DRIVER=" & m_strDriver & ";" & _ "SERVER=" & m_strServer & ";" Else m_strConnectionString= _ "DRIVER=" & m_strDriver & ";" & _ "SERVER=" & m_strServer & ";" & _ "DATABASE=" & m_strDatabase & ";" & _ "DBQ=" & m_strDBQ & ";" End If Case "Microsoft Access Driver (*.mdb)" m_strConnectionString= _ "DRIVER=" & m_strDriver & ";" & _ "DBQ=" & m_strDBQ & ";" Case "Microsoft Excel Driver (*.xls)" m_strConnectionString= _ "DRIVER=" & m_strDriver & ";" & _ "DBQ=" & m_strDBQ & ";" End Select End If End Method
Method ODBCConnect() Local szCnIn As Asciiz*512, szCnOut As Asciiz*512 Local iRet As Long
Me.MakeConnectionString() Call SQLAllocHandle(%SQL_HANDLE_ENV,%SQL_NULL_HANDLE,m_hEnvr) Call SQLSetEnvAttr(m_hEnvr,%SQL_ATTR_ODBC_VERSION,ByVal %SQL_OV_ODBC3,%SQL_IS_INTEGER) Call SQLAllocHandle(%SQL_HANDLE_DBC,m_hEnvr,m_hConn) szCnIn=m_strConnectionString iRet=SQLDriverConnect(m_hConn,0,szCnIn,Len(szCnIn),szCnOut,512,iBytes,%SQL_DRIVER_NOPROMPT) If iRet=0 Or iRet=1 Then m_blnConnected=%TRUE Else m_blnConnected=%FALSE Call SQLGetDiagRec(%SQL_HANDLE_DBC,m_hConn,1,m_szErrCode,m_iNativeErrPtr,m_szErrMsg,512,m_iTextLenPtr) End If End Method
Method ODBCGetDiagRec(Byval hStmt As Dword) Call SQLGetDiagRec(%SQL_HANDLE_STMT,hStmt,1,m_szErrCode,m_iNativeErrPtr,m_szErrMsg,512,m_iTextLenPtr) End Method
Method ODBCDisconnect() If Me.blnConnected=%TRUE Then Call SQLDisconnect(m_hConn) 'Disconnect From Data Source Call SQLFreeHandle(%SQL_HANDLE_DBC,m_hConn) 'Free Connection Handle Call SQLFreeHandle(%SQL_HANDLE_ENV,m_hEnvr) 'Free Environment Handle End If End Method End Interface End Class