как работать с Firebird

[BBR]

Господа подскажите как можно работать с сервером Firebird с CLARION 6
если точнее: как послать команду на сервер (например SELECT), а потом получить результат.
Через драйвер ODBS пока не лежит душа, да и не получается пока.
Заранее благодарен.

[Andrew Art]

Только как прототип - развлечение на досуге.

Код: Выделить всё

    program

DWORD       EQUATE(ULONG)
HANDLE      EQUATE(UNSIGNED)
WORD        EQUATE(SIGNED)
LPCSTR      EQUATE(CSTRING)

   MAP
   module('ODBC32.lib')

! proc - все равно как вызывать - процедура \ функция
! ВСе прототипы из MS SDK ODBC

        SQLAllocHandle(SHORT, LONG, *LONG), SHORT, RAW, PASCAL, NAME('SQLAllocHandle'),proc,DLL(1)
        SQLSetEnvAttr(LONG, LONG, LONG , LONG), SHORT, RAW, PASCAL, NAME('SQLSetEnvAttr'),proc,DLL(1)
        SQLConnect(LONG, *CSTRING, SHORT, *CSTRING, SHORT, *CSTRING, SHORT), SHORT, RAW, PASCAL, NAME('SQLCONNECT'),proc,DLL(1)
        SQLEXECDirect(LONG, *CSTRING, LONG), SHORT, RAW, PASCAL, NAME('SQLEXECDIRECT'),proc,DLL(1)
        SQLPrepare(LONG, *CSTRING, LONG), SHORT, RAW, PASCAL, NAME('SQLPREPARE'), proc, DLL(1)
        SQLBindParameter(LONG,USHORT,SHORT, SHORT, SHORT, ULONG, SHORT, *?, LONG, *? ),SHORT,RAW,PASCAL,NAME('SQLBindParameter'),proc,DLL(1)
        SQLExecute(LONG), SHORT ,RAW, PASCAL, NAME('SQLEXECUTE'), PROC, DLL(1)
        SQLBindCol(LONG, USHORT, SHORT, LONG, LONG ,LONG),SHORT,RAW,PASCAL,NAME('SQLBINDCOL'),proc,DLL(1)
        SQLNumResultCols(LONG, *SHORT), SHORT, RAW, PASCAL, NAME('SQLNUMRESULTCOLS'),proc,DLL(1)
        SQLFetch(LONG), SHORT, RAW, PASCAL, NAME('SQLFETCH'),proc,DLL(1)
        SQLColAttribute(LONG, USHORT, USHORT, LONG, SHORT, *SHORT, *LONG), SHORT, RAW, PASCAL, NAME('SQLCOLATTRIBUTE'),proc,DLL(1)
        SQLDescribeCol(LONG, USHORT, *CSTRING, SHORT, *SHORT, *SHORT, *ULONG, *SHORT, *SHORT), SHORT, RAW, PASCAL, NAME('SQLDESCRIBECOL'),proc,DLL(1)
        SQLColAttributes(LONG, USHORT, USHORT, LONG, SHORT, *SHORT, *LONG), SHORT, RAW, PASCAL, NAME('SQLCOLATTRIBUTES'),proc,DLL(1)
        SQLCloseCursor(LONG),SHORT, RAW, PASCAL, NAME('SQLCloseCursor'),proc,DLL(1)
        SQLFreeHandle(SHORT, LONG),SHORT, RAW, PASCAL, NAME('SQLFreeHandle'),proc,DLL(1)
        SQLDisconnect(LONG),SHORT,RAW,PASCAL,NAME('SQLDISCONNECT'),proc,DLL(1)

        end
! и еще
        SelectFB(string, string , string, *string , *string ), long  !URL POST Data Server Data
   end
 

dsn   string(32)
uid   string(32)
pwd   string(32)
req   string(255)
rez   string(528000)



Window WINDOW('Firebird ODBC Access'),AT(,,395,264),FONT('MS Sans Serif',8,,FONT:regular),CENTER,GRAY
       TEXT,AT(12,7,373,187),USE(rez),BOXED,HVSCROLL
       BUTTON('Lookup'),AT(269,214,33,14),USE(?lookup)
       BUTTON('Exit'),AT(311,214,33,14),USE(?OkButton),LEFT,DEFAULT
       ENTRY(@s32),AT(11,215,191,10),USE(dsn)
       ENTRY(@s32),AT(11,228,191,10),USE(uid)
       ENTRY(@s100),AT(11,202,191,10),USE(pwd)
       ENTRY(@s100),AT(12,242,376,10),USE(req)
     END

      code
!
!     this code is only executed if linked as an .exe
!
      dsn = 'FireBird'
      uid = 'SYSDBA'
      pwd = 'masterkey'
      req = 'select * from Country'
      open (window)
      accept
!        if event() = event:openwindow then
!           rtn# = postadata(serv,pexe,bff,text1)
!           if rtn# <> 0 then message('It didnt work - ' & rtn#,'Error',icon:exclamation).
!           end

        if accepted() = ?okbutton then break.
        if accepted() = ?lookup then
           clear(rez)
           rtn# = SelectFB(dsn,uid,pwd,req,rez)
           if rtn# <> 0 then
                             message('It didnt work - ' & rtn#,'Error',icon:exclamation)
                        end
           display()
           end


      end ! accept loop

!----------------------------------------------------------------------------------------
SelectFB Procedure(string pstdsn, string pstuid, string pstpwd, *string pstreq, *string pstrez)
!----------------------------------------------------------------------------------------

      Include('ODBC_EQU.INC')

ZERO     DWORD
henv     handle
hdbc     handle
hstmt    handle
s0       long
s1       long
s2       long
doplong  long
buffpointer long
bufflen    long
FldBindType short
buff     cstring(255),DIM(30)
szuser   cstring(32)
szpass   cstring(32)
szdsn    cstring(32)
serchs   cstring(255)
qcols    short
      code

    henv = 0

!  Alloc env handle
    if SQLAllocHandle(SQL_HANDLE_ENV, 0, henv) <> 0   then

    message('AllocHandle on ENV failed.')
                                                              else                                ! 1

!    message('AllocHandle on ENV OK.')
    SQLSetEnvAttr(henv, SQL_ATTR_ODBC_VERSION, SQL_OV_ODBC3, SQL_IS_INTEGER)

    hdbc = 0

    if SQLAllocHandle(SQL_HANDLE_DBC, henv, hdbc) <> 0 then

        message('AllocHandle on DBC failed.')
                                                              else                                 ! 2

!       message('AllocHandle on DBC OK.')
       szDsn   = clip(pstdsn)
       szuser  = clip(pstuid)
       szPass  = clip(pstpwd)

    if SQLConnect(hdbc,szDsn, len(szdsn), szuser, len(szUser), szPass, len(szPass)) <> 0 then

        message('Connect to ODBC failed.')
                                                                                         else      ! 3
!       message('Connect to ODBC OK.')
!   Get a statement handle
    if SQLAllocHandle(SQL_HANDLE_STMT, hdbc, hstmt) <>  0 then

        message('AllocHandle on STMT failed.')

                                                           else                                    ! 4

!        message('AllocHandle on STMT OK.')

!  Подготавливаем запрос, обратите внимание на знаки "?" вместо значений.
   serchs = clip(pstreq)

   s0 = SQLPrepare(hstmt, serchs, len(serchs))
   if s0 <> 0 then
   message('SQLPrepare on STMT failed.')
              end

! Связываем 1-й и 2-й параметры с переменными.
!   SQLBindParameter(hstmt, 1, SQL_PARAM_INPUT, SQL_C_FLOAT, SQL_REAL, 7, 0, Price, 0, &PriceInd);

!   SQLBindParameter(hstmt, 2, SQL_PARAM_INPUT, SQL_C_ULONG, SQL_INTEGER, 10, 0, PartID, 0, PartIDInd);

!   Запрос готов.
!   Инициализируем связанные переменные значениями и выполняем запрос.
!   while (GetPrice(&PartID, &Price))
!
    s0 = SQLExecute(hstmt)

    if s0 <> 0 then
     message('SQLExecute on STMT failed.')
              end

    s0 = SQLNumResultCols( hstmt, QCols )

    if s0 <> 0 then
     message('SQLNumResultCols on STMT failed.')
               end
    
    if Qcols > 30 then qcols = 30 .

    loop s2 = 1 to Qcols

    bufflen = 255
    s0 = SQLBindCol( hstmt, s2, SQL_C_CHAR , Address(buff[s2]), BuffLen, doplong )
    if s0 <> 0 then
     message('SQLBindCol on STMT failed.')
               end
    end

!    if s0 <> 0 then
!     message('SQLBindCol on STMT failed.')
!               end
    loop
     s0 = SQLFetch(hstmt)
!    if s0 <> 0 then
!     message('SQLFetch on STMT failed.')
!              end

    if s0 = SQL_NO_DATA then break .

    loop s1 = 1 to qcols
    pstrez = clip(pstrez) &  clip(buff[s1]) & '|'
    end
    pstrez = clip(pstrez) &  '<13><10>'
    end

    if hstmt <> 0 then SQLFreeHandle(SQL_HANDLE_STMT, hstmt) .

    if hdbc  <> 0 then SQLDisconnect(hdbc);  SQLFreeHandle(SQL_HANDLE_DBC, hdbc) .

    if henv  <> 0 then SQLFreeHandle(SQL_HANDLE_ENV, henv) .

                                                                                                        end
                                                                                                        end
                                                                                                        end
                                                                                                        end
                                                                                                        
 
      return(0)

[BBR]

Спасибо буду пробовать. Буду очень благодарен если у ВАС найдется рабочий примерчик
(желательно с app)

[Andrew Art]

Программа действующая.

Установить ODBC firebird. Создать DSN ODBC для Firebird. Создать библиотеку ODBC32.LIB из Windows ODBC32.DLL. ODBC_EQU.INC найдете в Клаше.

Создать проект с этим исходником и оттранслировать как EXE и посмотреть. После этого в проекте, ничего в исходнике не меняя, создать DLL и пользовать из Вашей программы процедуру SelectFB из созданного DLL. В проекте Вашей программы дайте ссылку на библиотеку.

Надо учесть, запрос сопровождается открытием и завершением сеанса, но для технологии клиент-сервер приемлемо. Чтобы использовать словари Клаши, используйте файлы только как справочники полей. Результаты запросов направляйте в очереди. Не забудьте использовать ограничители для результата отчета (строки с 1 по 100 и тп). Естественно, области обмена для Select следует увеличить. Я использую строки длиной 64 000 и 528 000.

В завершении должен сказать, что в MAV все сделано в полном объеме и с соответствующим сервисом.

[BBR]

А существуют ли похожие на MAV библиотеки других производителей?

[Andrew Art]

PS

Inside the Global MAP
module('Имя.LIB') - имя того DLL , который получится из данного исходника.

"Не увеличивайте количества сущностей"
Используйте прямые продукты - четче понимается и отлаживается.
Поэтому я не использую MAV - только API ODBC (а не NATIVE API Firebird, хотя и это не трудно)

[BBR]

Андрей, а можно глупый вопрос: как с DLL сделать LIB

[Andrew Art]

В Кларе есть пример LIBMAKER.
В Bin-е есть такой Libmaker.EXE.
Запустить на требуемый DLL и получить библиотеку.
Библиотеку пришить к Проекту с исходным модулем.
В дальнейшем, после получения собственного DLL из исходника, она не будет нужна .

[Игорь Столяров]

Как интересно ...
А есть ли такой же пример кода вызова через ODBC хранимой процедуры ?
С параметрами передаваемыми как по значению, так и по адреcу и получением результата ?
Заранее спасибо !

[Andrew Art]

"Нельзя объять необъятного" или "Если у тебя есть фонтан - заткни его", однако:
Задача - распределенная обработка
Клиент - клаша (64k более посылаем на сервер)
Сервер - WEB сервер
Вызываемый процесс сервера Клаша или PHP и тп - что-то делает на сервере, возможно с TPSами, и посылает ответ клиенту(500k)
Клиент красиво (в собственном стиле) оформляет результат и тд и тп
Что-то большее чем AJAX и несравненно меньшее, чем Browser, однако все в Ваших руках и просто.
Кол-во клиентов не лицензируется и не ограничивается - только мощность сервера.
Не нужен неторопливый SQL
HTTP POST method

WinInet для Клаши

Решение, в том же стиле:

Код: Выделить всё

    program

DWORD       EQUATE(ULONG)
HANDLE      EQUATE(UNSIGNED)
WORD        EQUATE(SIGNED)
LPCSTR      EQUATE(CSTRING)

   MAP
   module('wininet.lib')   ! Найди и сделай сам
        InternetOpen(*lpcstr,dword,*lpcstr,dword,dword),handle,pascal,raw,NAME('InternetOpenA'),dll(1)
        InternetOpenURL(handle,*lpcstr,dword,dword,dword,dword),handle,pascal,raw,name('InternetOpenURLA'),dll(1)
        InternetReadFile(handle,*lpcstr,dword,*dword),handle,pascal,raw,name('InternetReadFile'),dll(1)
        InternetCloseHandle(handle),pascal,raw,name('InternetCloseHandle'),dll(1)
        InternetConnect(handle,*lpcstr,dword,*lpcstr,*lpcstr,dword,dword,dword),handle,pascal,raw,NAME('InternetConnectA'),dll(1)
        HttpOpenRequest(handle,*lpcstr,*lpcstr,*lpcstr,*lpcstr,dword,dword,dword),handle,pascal,raw,name('HttpOpenRequestA'),dll(1)
        HttpSendRequest(handle,*lpcstr,dword,*lpcstr,dword),handle,pascal,raw,name('HttpSendRequestA'),dll(1)
        end
! и еще единственная процедура - необременительно 
   Postadata(string pstserv, string pstexe, *string pstarea, *string pTextBuf), long  !URL POST Data Server Data
   end


serv   string(250)                  ! Сервер http://www.nechto.com
pexe   string(250)                 ! CGI or PHP   nechto.exe
bff    string(64000)                ! Post data in structure &p1=123&p2=rtr...&pn=4
text1  string(528000)            ! In data - maybe %20 and so on. Clearing need.

Window WINDOW('Fetch a Web Page'),AT(,,395,241),FONT('MS Sans Serif',8,,FONT:regular),CENTER,GRAY
       TEXT,AT(12,7,373,187),USE(Text1),BOXED,HVSCROLL
       BUTTON('Lookup'),AT(269,214,33,14),USE(?lookup)
       BUTTON('Exit'),AT(311,214,33,14),USE(?OkButton),LEFT,DEFAULT
       ENTRY(@s100),AT(11,215,191,10),USE(pexe)
       ENTRY(@s100),AT(11,228,191,10),USE(bff)
       ENTRY(@s100),AT(11,202,191,10),USE(serv)
     END

      code
      
!     this code is only executed if linked as an .exe
      serv = 'localhost'
      pexe = 'shell.exe?L'
      bff = '&a=2222&b=1111'
      open (window)
      accept
!        if event() = event:openwindow then
!           rtn# = postadata(serv,pexe,bff,text1)
!           if rtn# <> 0 then message('It didnt work - ' & rtn#,'Error',icon:exclamation).
!           end

        if accepted() = ?okbutton then break.
        if accepted() = ?lookup then
           clear(text1)
           rtn# = postadata(serv,pexe,bff,text1)
           if rtn# <> 0 then
                             message('It didnt work - ' & rtn#,'Error',icon:exclamation)
                        else
                             message('Ok - ' & rtn#,'Error',icon:exclamation)
                        end
           display()
           end


      end ! accept loop

!----------------------------------------------------------------------------------------
PostaData Procedure(string pstserv, string pstexe, *string pstarea, *string pTextBuf)
!----------------------------------------------------------------------------------------
! InternetOpen              Сессия
!  InternetConnect           Коннект 
!    HttpOpenRequest          Запрос
!      HttpSendRequest         Послать
!      InternetReadFile        Получить 
!    InternetCloseHandle      Закрыть запрос
!  InternetCloseHandle       Закрыть коннект
! InternetCloseHandle       Закрыть сессию
!----------------------------------------------------------------------------------------

UserAgent    cstring('Mozilla/4.0 (compatible; MSIE 6.0b; Windows NT 5.0; .NET CLR 1.0.2914)')
ProxyName    CSTRING(1000)
OpenType     dword

bufferlen    equate(528001)
HTTPbuffer   cstring(bufferlen)
Headerlen    Dword
Headerbuf    cstring(250),AUTO    ! Content-Type: application/x-www-form-urlencoded
Postlen      Dword
postbuf      cstring(64000),AUTO   ! name=Andrew+Art&userid=hithere&other=P%26Q

bytesread    dword

! Open Flags
INTERNET_OPEN_TYPE_PRECONFIG    EQUATE(0)   !- use registry configuration
INTERNET_OPEN_TYPE_DIRECT       EQUATE(1)   !- direct to net
INTERNET_OPEN_TYPE_PROXY        EQUATE(3)   !- via named proxy

!OpenURL dwFlags
INTERNET_FLAG_NO_CACHE_WRITE    EQUATE(04000000H)     ! Does not add the returned entity to the cache.
INTERNET_FLAG_RELOAD            equate(80000000H)     ! Forces a download of the requested file, object,
                                                      ! or directory listing from the origin server, not from the cache.
INTERNET_FLAG_PRAGMA_NOCACHE    equate(00000100H)     ! Forces the request to be resolved by the origin server,
                                                      ! even if a cached copy exists on the proxy.
NoCaching                       equate(84000100H)     ! all of the above
INTERNET_DEFAULT_HTTP_PORT      equate(00000050H)            ! Номер TCP/IP порта к которому мы собираемся подсоединиться
INTERNET_SERVICE_HTTP           equate(00000003H)     ! Тип сервиса - FTP, HTTP или Gopher

ZERO         DWORD

hsession     handle
hconnect     handle
hrequest     Handle
hReadFile    handle
hsend        handle
dwFlags      dword 
dwContext    dword

postserv     cstring(250),AUTO
postexe      cstring(250),AUTO
pTextBufLen  long
Pageptr      long
ReturnCode   long
usid         cstring(20)
psw          cstring(20)
postv        cstring(20)
acc          dword
version      cstring(20)
reff         cstring(20)
s0           long
      code
      postv = 'POST'
      Headerbuf   = 'Content-Type: application/x-www-form-urlencoded' & '<0>'
      headerlen   = len(Headerbuf)
      postserv    = clip(pstserv) & '<0>'
      postexe     = clip(pstexe)  & '<0>'
!      loop s0 = 1 to 8000
!      if pstarea[s0] = ' ' then break .
!      postbuf[s0] = pstarea[s0]
!      end
!       postbuf[s0]  = '<0>'
       postbuf = CLIP(PSTAREA) & '<0>'
       postlen     = len(postbuf)
      pTextBufLen = len(pTextBuf)
      OpenType = INTERNET_OPEN_TYPE_PRECONFIG
      ReturnCode = 0
      version = 'HTTP/1.1<0>'
      reff = 'http://s775/rocom.exe<0>'
      usid = 'anonymous<0>'
      psw = '<0>'
      hsession = InternetOpen(UserAgent,OpenType,ProxyName,zero,zero)
      if hsession = 0 then
          ReturnCode = 1 !* Error * Internet Open error
          else
          dwFlags = NoCaching
          hconnect = InternetConnect(hsession,postserv,INTERNET_DEFAULT_HTTP_PORT, usid, psw, INTERNET_SERVICE_HTTP, dwFlags, dwContext)
          if hconnect = 0 then
             ReturnCode = 2 !* Error * Internet Connect error
             else
            hrequest = HttpOpenRequest(hConnect, postv, postexe, version, reff, 0, dwFlags, dwContext);
            if hrequest = 0 then
             ReturnCode = 3 !* Error * Internet Request error
             else
             hsend = HttpSendRequest(hRequest, headerbuf, headerlen, postbuf, postlen)
             if hsend = false then
             ReturnCode = 4 !* Error * Internet send error
                              else
             Pageptr = 1
             loop
                 hReadFile = InternetReadFile(hRequest,HTTPbuffer,bufferlen-1,bytesread)
                 if hReadFile = true and bytesread = 0 then break.
                 if bytesread > 0 then
                    if Pageptr + bytesread > pTextBuflen then
                        Returncode = 5   ! * Error * Buffer size exceeded
                        break
                        end

                    pTextBuf = pTextBuf[1:Pageptr] & HTTPbuffer[1:bytesread]   ! + first byte always _
                    Pageptr += bytesread

                    end
                 end
                              end
             end
         end
      end
      internetclosehandle(hrequest) 
      internetclosehandle(hconnect)
      internetclosehandle(hsession)
      return(ReturnCode)

[StillZero]

... респект!

зы
оформляй плиз код в тэги code

[BBR]

Спасибо Андрей все получилось, но возник еще один вопрос:
как установить соединение не заполняяя DSN ODBC, а эти
данные указывать с приложения?

[Andrew Art]

Изучите Native FireBird API и замените вызовы в Исходнике - логика таже.

Но ODBC тем и хорош, что позволяет использовать этот исходник с любым SQL. Так что смиритесь.
Единственный недостаток ОDBC - слабая поддержка механизмов управления транзакциями, но до этого надо еще добраться.

Для тех кто пытается использовать WinInet - исходник чистки входного буфера GP string(528000):

Код: Выделить всё

           sp = len(clip(GP))
           s0 = Instring('=',gp,1,1)                    ! символ = используется как разделитель полей 
           gp[1:(sp)] = clip(gp[(s0+1):(sp)])
           sp = len(clip(GP))
           loop s0 = 1 to sp
                   strv = gp[s0]
                   if strv = '%' then
               gp[s0] = CHR( |
               Instring(gp[s0+1],'0123456789ABCDEF',1,1)*16 + |
               Instring(gp[s0+2],'0123456789ABCDEF',1,1) - 17 )
               gp[(s0+1):(sp)] = clip(gp[(s0+3):(sp)])
                                 end
                   if strv = '<10>' then
               gp[(s0):sp] = clip(gp[(s0+1):sp])
                                    end
                   if strv = '<13>' then
               gp[(s0):sp] = clip(gp[(s0+1):sp])
                                    end
           end

[Дед Пахом]

Код: Выделить всё

sp = len(clip(GP))
s0 = Instring('=',gp,1,1) ! символ = используется как разделитель полей 
gp[1:(sp)] = clip(gp[(s0+1):(sp)])
sp = len(clip(GP))
loop s0 = 1 to sp
strv = gp[s0]
if strv = '%' then
gp[s0] = CHR( |
Instring(gp[s0+1],'0123456789ABCDEF',1,1)*16 + |
Instring(gp[s0+2],'0123456789ABCDEF',1,1) - 17 )
gp[(s0+1):(sp)] = clip(gp[(s0+3):(sp)])
end
if strv = '<10>' then
gp[(s0):sp] = clip(gp[(s0+1):sp])
end
if strv = '<13>' then
gp[(s0):sp] = clip(gp[(s0+1):sp])
end
end

на самом деле так не намного лучше, разве что цвет другой

[StillZero]

а ну ка я

Код: Выделить всё

if strv = '<13>'
   gp[(s0):sp] = clip(gp[(s0+1):sp])
end