FreeBasic

Данный пример показывает как можно создать простую базу данных (.mdb  Microsoft Access) заполнить ее, а затем считать ее данные. Доступ к базе данных осуществляется при помощи ODBC API. Сразу после запуска примера, создается база данных из трех записей в трех столбцах (имя, фамилия, телефон). Вся таблица выводится сразу. Далее программа просит ввести вас любое имя и при правильно введенном имени из имеющихся, выводит информацию об этом имени. Если ничего не вводить, а просто нажать клавишу "ENTER", то программа завершится.

Платформа: Windows
Компилятор: протестировано на версии 1.02.1

#INCLUDE "windows.bi"
#INCLUDE Once "win/sql.bi"
#INCLUDE Once "win/sqlext.bi"
#INCLUDE Once "win/odbcinst.bi"
#INCLIB "ODBCCP32"

Dim Shared As SQLHANDLE Ptr hEnv,hConn,hStmt

Function ODBC_CONNECT(sPath As String) As BOOL
    
    Dim As SQLRETURN h
    Dim As ZString*1024 sConnectString = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & sPath,sConn
    Dim As Integer iStrLen

    h = SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, @hEnv)
    If h = SQL_SUCCESS Or h = SQL_SUCCESS_WITH_INFO Then
        h = SQLSetEnvAttr(hEnv,SQL_ATTR_ODBC_VERSION, Cast(Any Ptr,SQL_OV_ODBC3),0)
        If h = SQL_SUCCESS Or h = SQL_SUCCESS_WITH_INFO Then
            h = SQLAllocHandle(SQL_HANDLE_DBC, hEnv, @hConn)
            If h = SQL_SUCCESS Or h = SQL_SUCCESS_WITH_INFO Then
                SQLDriverConnect(hConn, 0, @sConnectString, Sizeof(sConnectString), @sConn, Sizeof(sConn),Cast(Any Ptr,@iStrLen), SQL_DRIVER_COMPLETE)
                If h = SQL_SUCCESS Or h = SQL_SUCCESS_WITH_INFO Then
                    Return TRUE
                Else
                    SQLFreeHandle(SQL_HANDLE_DBC, hConn)
                    SQLFreeHandle(SQL_HANDLE_ENV, hEnv)
                    MessageBox(0, "Connection failed", "ODBC", MB_OK+MB_ICONERROR)
                Endif
            Else
                SQLFreeHandle(SQL_HANDLE_ENV, hEnv)
                MessageBox(0, "Handle allocation failed", "ODBC", MB_OK+MB_ICONERROR)
            Endif
        Else
            SQLFreeHandle(SQL_HANDLE_ENV, hEnv)
            MessageBox(0, "Cannot set ODBC version", "ODBC", MB_OK+MB_ICONERROR)
        Endif
    Else
        MessageBox(0, "Environment handle allocation failed", "ODBC", MB_OK+MB_ICONERROR)
    Endif
    
End Function

Sub ODBC_DISCONNECT()
    
    SQLDisconnect(hConn)
    SQLFreeHandle(SQL_HANDLE_DBC, hConn)
    SQLFreeHandle(SQL_HANDLE_ENV, hEnv)
    
End Sub


Sub CREATE_DATABASE()
    
    Dim As ZString*200 szCreateTable= "CREATE TABLE Persons (FirstName varchar,LastName varchar,Phone varchar)"
    Dim As SQLRETURN h
    
    If SQLConfigDataSource(NULL,ODBC_ADD_DSN,"Microsoft Access Driver (*.mdb)","CREATE_DB=test.mdb General") Then
        ODBC_CONNECT(Exepath & "\test.mdb")
        SQLAllocHandle(SQL_HANDLE_STMT,hConn,@hStmt)
        If h = SQL_SUCCESS Or h = SQL_SUCCESS_WITH_INFO Then
            SQLExecDirect(hStmt,@szCreateTable,Len(szCreateTable))
            SQLSetStmtAttr(hStmt,SQL_ATTR_CONCURRENCY,Cast(SQLPOINTER,SQL_CONCUR_ROWVER),0)
            SQLSetStmtAttr(hStmt,SQL_ATTR_CURSOR_TYPE,Cast(SQLPOINTER,SQL_CURSOR_KEYSET_DRIVEN),0)
            Dim As ZString*100 szInsert = "INSERT INTO Persons (FirstName,LastName,Phone) VALUES('Jose','Black','73-29-39')"
            SQLExecDirect(hStmt,@szInsert,Len(szInsert))
            szInsert = "INSERT INTO Persons (FirstName,LastName,Phone) VALUES('Luis','Nurth','54-63-73')"
            SQLExecDirect(hStmt,@szInsert,Len(szInsert))
            szInsert = "INSERT INTO Persons (FirstName,LastName,Phone) VALUES('Monika','Loppes','11-69-22')"
            SQLExecDirect(hStmt,@szInsert,Len(szInsert))
        Endif
        SQLFreeHandle(SQL_HANDLE_STMT,hStmt)
        ODBC_DISCONNECT()
    Endif
    
End Sub

Sub GetData()
    
    Dim As SQLRETURN h
    Dim As Integer sGetLenght
    Dim As ZString*26 sName,sSurName,sNumberTelephone

    SQLBindCol(hStmt,1,SQL_C_CHAR, @sName, Sizeof(sName),@sGetLenght)
    SQLBindCol(hStmt,2,SQL_C_CHAR, @sSurName, Sizeof(sSurName),@sGetLenght)
    SQLBindCol(hStmt,3,SQL_C_CHAR, @sNumberTelephone, Sizeof(sNumberTelephone),@sGetLenght)

    While TRUE
        h = SQLFetch(hStmt)
        If h = SQL_SUCCESS Or h = SQL_SUCCESS_WITH_INFO Then
            Print sName,sSurName,sNumberTelephone
        Else
            Exit While
        Endif
    Wend
    
End Sub

Sub SelectAll()
    
    Dim As SQLRETURN h
    Dim As ZString*50 SQLStatement = "select * from Persons"

    h = SQLAllocHandle(SQL_HANDLE_STMT, hConn, @hStmt)
    If h = SQL_SUCCESS Or h = SQL_SUCCESS_WITH_INFO Then
        h = SQLExecDirect(hStmt, @SQLStatement, Sizeof(SQLStatement))
        If h = SQL_SUCCESS Or h = SQL_SUCCESS_WITH_INFO Then
            GetData()
        Else
            MessageBox(0,"Execution SQL failed", "ODBC", MB_OK+MB_ICONERROR)
        Endif
        SQLCloseCursor(hStmt)
        SQLFreeHandle(SQL_HANDLE_STMT, hStmt)
    Else
        MessageBox(0,"Handle allocation failed","ODBC", MB_OK+MB_ICONERROR)
    Endif
    
End Sub

Sub SelectOne(sName As String)
    
    Dim As SQLRETURN h
    Dim As Integer iStrLen
    Dim As ZString*1024 sConn
    
    h = SQLAllocHandle(SQL_HANDLE_STMT, hConn, @hStmt)
    If h = SQL_SUCCESS Or h = SQL_SUCCESS_WITH_INFO Then
        sConn = "select * from Persons where FirstName=?"
        SQLBindParameter(hStmt, 1, SQL_PARAM_INPUT, SQL_C_CHAR, SQL_CHAR,25,0, Strptr(sName),25,@iStrLen)
        SQLPrepare(hStmt, @sConn, Sizeof( sConn))
        iStrLen = Len(sName)
        SQLExecute(hStmt)
        GetData()
        SQLCloseCursor(hStmt)
    Else
        MessageBox(0,"Handle allocation failed","ODBC" , MB_OK+MB_ICONERROR)
    Endif
    SQLFreeHandle(SQL_HANDLE_STMT, hStmt)
    
End Sub

'-----------------------------------------TEST---------------------------------------------------
CREATE_DATABASE()

If ODBC_CONNECT(Exepath & "\test.mdb")<>0 Then
    ? "--------------------------------------------------------------------"
    ? "Name","SurName","Telephone"
    ? "--------------------------------------------------------------------"
    SelectAll()
    Dim As String sName 
    Do
        ?
        Input "Input Name: ", sName
        ?
        If Len(sName) Then
            SelectOne(sName)
        Endif
    Loop Until sName = ""
Endif
ODBC_DISCONNECT()