forum.clarionlife.net

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

SETCURSOR(CURSOR:Wait)
SQLQuery{PROP:LogonScreen}=False     ! Any SQL based table
OPEN(SQLQuery,0)
IF ERRORCODE() OR FILEERRORCODE() THEN
    Loc:ServerStatus=Level:Fatal
    ASSERT(~ERRORCODE())
    !HALT     ! If you want to stop program execution
ELSE
    CLOSE(SQLQuery)
    Loc:ServerStatus=Level:Benign
END
SETCURSOR()

RETURN(Loc:ServerStatus)

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

   ! --- GlobalMap

   Module('ODBC32')

     SQLDriverConnect(LONG        hdbc,             |
                      UNSIGNED    hwnd,             |
                      *CSTRING    szConnStrIn,      |
                      SHORT       cbConnStrIn,      |
                      *CSTRING    szConnStrOut,     |
                      SHORT       cbConnStrOutMax,  |
                      *SHORT      pcbConnStrOut,    |
                      USHORT      fDriverCompletion),SHORT,RAW,PASCAL,NAME('SQLDRIVERCONNECT'),PROC!,DLL(1)

     SQLDisconnect(LONG hdbc),SHORT,RAW,PASCAL,NAME('SQLDISCONNECT'),PROC!,DLL(1)

     SQLConnect(LONG        hdbc,                   |
                *CSTRING    ServerName_,            |
                SHORT       LenServerName_,         |
                *CSTRING    UserName_,              |
                SHORT       LenUserName_,           |
                *CSTRING    Authentication_,        |
                SHORT       LenAuthentication_),SHORT,RAW,PASCAL,NAME('SQLCONNECT'),PROC!,DLL(1)

     SQLAllocHandle(SHORT HandleType,LONG InputHandle,*LONG OutputHandle),SHORT,RAW,PASCAL,NAME('SQLAllocHandle'),PROC!,DLL(1)

     SQLSetEnvAttr(LONG EnvironmentHandle,          |
           LONG Attribute, LONG Value,              |
           LONG StringLength),SHORT,RAW,PASCAL,NAME('SQLSetEnvAttr'),PROC!,DLL(1)

     SQLFreeHandle(SHORT HandleType, LONG Handle),SHORT,RAW,PASCAL,NAME('SQLFreeHandle'),PROC!,DLL(1)
   end
   
   ! --- GLOBAL DATA (ODBC)
   
SQL_HANDLE_ENV            EQUATE(1) 
SQL_HANDLE_DBC            EQUATE(2) 
SQL_NULL_HANDLE           EQUATE(0)        
SQL_DRIVER_COMPLETE_REQUIRED    EQUATE(3) 
SQL_ERROR               EQUATE(-1) 
SQL_SUCCESS             EQUATE(0) 
SQL_SUCCESS_WITH_INFO   EQUATE(1)

SQL_ATTR_ODBC_VERSION   EQUATE(200)
SQL_OV_ODBC3            EQUATE(3)
SQL_IS_INTEGER          EQUATE(-6)
   
   ! --- Проверка подключения
   
CheckSQLConnect      PROCEDURE
Loc:RetValue         BYTE                                  !
Loc:RetCode          LONG                                  !
Loc:S1               CSTRING(255)                          !
Loc:S2               CSTRING(1025)                         !
Loc:Short            SHORT                                 !
Loc:Henv             LONG                                  !
Loc:Hdbc             LONG                                  !
Loc:Window           &WINDOW                               !

  CODE
  Loc:RetValue = False   ! Предполагаем худшее

  Loc:Henv = 0
  Loc:Hdbc = 0

  ! === Allocate environment handle
  Loc:RetCode = SQLAllocHandle(SQL_HANDLE_ENV,SQL_NULL_HANDLE,Loc:Henv)

  ! === Set the ODBC version environment attribute
  Loc:RetCode = SQLSetEnvAttr(Loc:Henv,SQL_ATTR_ODBC_VERSION,SQL_OV_ODBC3,SQL_IS_INTEGER)

  ! === Allocate connection handle
  Loc:RetCode = SQLAllocHandle(SQL_HANDLE_DBC,Loc:Henv,Loc:Hdbc)

  !Loc:S1 = 'Driver={{SQL Server};Server=90.0.0.2;Database=K_B;UID=sa;PWD=1;'

  Loc:S1 = 'Driver={{SQL Server};Server=' & Clip(Left(Setup.DBServer))   & |
           ';Database='                   & Clip(Left(Setup.DBName))     & |
           ';UID='                        & Clip(Left(Setup.DBUser))     & |
           ';PWD='                        & Clip(Left(Setup.DBPassword)) & |
           ';'

  Loc:RetCode = SQLDriverConnect(Loc:Hdbc,              |
                              Loc:Window{PROP:Handle},  |
                              Loc:S1,                   |
                              Len(Loc:S1),              |
                              Loc:S2,                   |
                              1024,                     |
                              Loc:Short,                |
                              SQL_DRIVER_COMPLETE_REQUIRED)

  ! SQL сервер жив !
  If ((Loc:RetCode = SQL_SUCCESS) Or (Loc:RetCode = SQL_SUCCESS_WITH_INFO)) then Loc:RetValue = True.

  RetCode# = SQLDisconnect(Loc:Hdbc)

  If Loc:Hdbc then Loc:RetCode = SQLFreeHandle(SQL_HANDLE_DBC,Loc:Hdbc); Loc:Hdbc = 0.
  If Loc:Henv then Loc:RetCode = SQLFreeHandle(SQL_HANDLE_ENV,Loc:Henv); Loc:Henv = 0.

  Return(Loc:RetValue)