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.
'SqlDemo.bas
'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...
'
'Id Float_Point Date_Field Text_Field
'1 3.14159 11/15/1952 My Birthday
'2 1.23456 6/30/1969 Walk On Moon?
'3 15.1234 1/1/2006 Some String
'4 0.54321 4/1/2006 April 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
'SqlDemo.bas continued
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
MsgHdlr(0).wMessage=%WM_CREATE : MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnCreate)
MsgHdlr(1).wMessage=%WM_COMMAND : MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnCommand)
MsgHdlr(2).wMessage=%WM_CLOSE : MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnClose)
frmOutputHdlr(0).wMessage=%WM_CREATE : frmOutputHdlr(0).dwFnPtr=CodePtr(frmOutput_OnCreate)
frmOutputHdlr(1).wMessage=%WM_PAINT : frmOutputHdlr(1).dwFnPtr=CodePtr(frmOutput_OnPaint)
frmOutputHdlr(2).wMessage=%WM_SIZE : frmOutputHdlr(2).dwFnPtr=CodePtr(frmOutput_OnSize)
frmOutputHdlr(3).wMessage=%WM_VSCROLL : frmOutputHdlr(3).dwFnPtr=CodePtr(frmOutput_OnVScroll)
frmOutputHdlr(4).wMessage=%WM_CLOSE : frmOutputHdlr(4).dwFnPtr=CodePtr(frmOutput_OnClose)
End Sub
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
Call AttachMessageHandlers() : szAppName="SqlDemo"
wc.lpszClassName=VarPtr(szAppName) : wc.lpfnWndProc=CodePtr(fnWndProc)
wc.cbSize=SizeOf(wc) : wc.style=%CS_HREDRAW Or %CS_VREDRAW
wc.cbClsExtra=0 : wc.cbWndExtra=0
wc.hInstance=hIns : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW) : wc.hbrBackground=%COLOR_BTNFACE+1
wc.lpszMenuName=%NULL
Call RegisterClassEx(wc)
hWnd=CreateWindow(szAppName,"ODBC Demo",%WS_OVERLAPPEDWINDOW,200,100,400,225,0,0,hIns,ByVal 0)
Call ShowWindow(hWnd,iShowWnd)
While GetMessage(Msg,%NULL,0,0)
TranslateMessage Msg
DispatchMessage Msg
Wend
Function=msg.wParam
End Function
'Here is the main include file for SqlDemo, that is SqlDemo.inc
'SqlDemo.inc
'%MyDebug = %TRUE 'unremark this to get lots of debug output
'SQLConfigDataSource request flags
%ODBC_ADD_DSN = 1
%ODBC_CONFIG_DSN = 2
%ODBC_REMOVE_DSN = 3
%ODBC_ADD_SYS_DSN = 4
%ODBC_CONFIG_SYS_DSN = 5
%ODBC_REMOVE_SYS_DSN = 6
'SQLInstallerError code
%ODBC_ERROR_GENERAL_ERR = 1
%ODBC_ERROR_INVALID_BUFF_LEN = 2
%ODBC_ERROR_INVALID_HWND = 3
%ODBC_ERROR_INVALID_STR = 4
%ODBC_ERROR_INVALID_REQUEST_TYPE = 5
%ODBC_ERROR_COMPONENT_NOT_FOUND = 6
%ODBC_ERROR_INVALID_NAME = 7
%ODBC_ERROR_INVALID_KEYWORD_VALUE = 8
%ODBC_ERROR_INVALID_DSN = 9
%ODBC_ERROR_INVALID_INF = 10
%ODBC_ERROR_REQUEST_FAILED = 11 'you'll get this if db already exists
%ODBC_ERROR_INVALID_PATH = 12
%ODBC_ERROR_LOAD_LIB_FAILED = 13
%ODBC_ERROR_INVALID_PARAM_SEQUENCE = 14
%ODBC_ERROR_INVALID_LOG_FILE = 15
%ODBC_ERROR_USER_CANCELED = 16
%ODBC_ERROR_USAGE_UPDATE_FAILED = 17
%ODBC_ERROR_CREATE_DSN_FAILED = 18
%ODBC_ERROR_WRITING_SYSINFO_FAILED = 19
%ODBC_ERROR_REMOVE_DSN_FAILED = 20
%ODBC_ERROR_OUT_OF_MEM = 21
%ODBC_ERROR_OUTPUT_STRING_TRUNCATED = 22
'Button Controls in SqlDemo.bas
%IDC_SQL_DRIVERS = 2000
%IDC_EXCEL = 2005
%IDC_MS_ACCESS = 2010
%IDC_SQL_SERVER_EXPRESS = 2015
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
'Here is my class wrapper of some ODBC Api connection apparatus. Its one of the include files of SqlDemo.
'CSql.inc
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