SqlDemo - Example App Connects To Microsoft Databases Using ODBC Class

[Frederick J. Harris]

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.

[Frederick J. Harris]

'SqlDemo.bas

Code: [Select]

'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


[Frederick J. Harris]

'SqlDemo.bas continued

Code: [Select]

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


[Frederick J. Harris]

'Here is the main include file for SqlDemo, that is SqlDemo.inc

Code: [Select]

'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


[Frederick J. Harris]

'Here is my class wrapper of some ODBC Api connection apparatus.  Its one of the include files of SqlDemo.

Code: [Select]

'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