Attribute VB_Name = "NoScan"
Option Explicit
 
Private Declare Function SQLError Lib "odbc32.dll" (ByVal henv&, ByVal hdbc&, ByVal hstmt&, ByVal szSqlState$, pfNativeError&, ByVal szErrorMsg$, ByVal cbErrorMsgMax%, pcbErrorMsg%) As Integer
Private Declare Function SQLAllocConnect Lib "odbc32.dll" (ByVal henv&, phdbc&) As Integer
Private Declare Function SQLAllocEnv Lib "odbc32.dll" (phenv&) As Integer
Private Declare Function SQLAllocStmt Lib "odbc32.dll" (ByVal hdbc&, phstmt&) As Integer
Private Declare Function SQLConnect Lib "odbc32.dll" (ByVal hdbc&, ByVal szDSN$, ByVal cbDSN%, ByVal szUID$, ByVal cbUID%, ByVal szAuthStr$, ByVal cbAuthStr%) As Integer
Private Declare Function SQLSetConnectOption Lib "odbc32.dll" (ByVal hdbc&, ByVal fOption%, ByVal vParam As Any) As Integer
Private Declare Function SQLExecDirect Lib "odbc32.dll" (ByVal hstmt&, ByVal szSqlStr$, ByVal cbSqlStr&) As Integer
Private Declare Function SQLFreeStmt Lib "odbc32.dll" (ByVal hstmt&, ByVal fOption%) As Integer
Private Declare Function SQLDisconnect Lib "odbc32.dll" (ByVal hdbc&) As Integer
Private Declare Function SQLFreeConnect Lib "odbc32.dll" (ByVal hdbc&) As Integer
Private Declare Function SQLFreeEnv Lib "odbc32.dll" (ByVal henv&) As Integer
 
Private Function getNativeError(Errorhenv As Long, Errorhdbc As Long, Errorhstmt As Long) As Long
Const SQL_MAX_MESSAGE_LENGTH As Long = 512
Const ErrorStrLen = SQL_MAX_MESSAGE_LENGTH - 1
Dim StateStr As String * 5
Dim NativeError As Long
Dim ErrorStr As String * ErrorStrLen
Dim TotErrorLen As Integer
SQLError Errorhenv, Errorhdbc, Errorhstmt, StateStr, NativeError, ErrorStr, ErrorStrLen, TotErrorLen
getNativeError = NativeError
End Function
' This subroutine can be called with 5 parameters´
' datasourcename
' username
' password
' sql text to be executed
' ret a returncode  that returns 0 = OK or native error
' What the routine does is it connects to the datasource
' sets a connect option of SQLSetConnectOption(hdbc, SQL_NOSCAN, SQL_NOSCAN_ON)
' executes the sql text
' disconnects
'
' The connect option prevents mimer from modifying the sql statement before giving it to the sqlcompiler.
' If you don't set this option the sqltext will be modified so that whitespace (space tab crlf) will
' be replaced with one space

'that is
' create procedure bproc()
' begin
'     set X=Y;
' End
' will be altered to
' create procedure bproc() begin set X=Y; End
'

Public Sub compilenoscan(DSN As String, usr As String, pwd As String, sqls As String, ret As Long)
  Const SQL_NTS As Long = -3
  Const SQL_NOSCAN As Long = 2
  Const SQL_NOSCAN_ON As Long = 1
  Const SQL_NULL_HENV As Long = 0
  Const SQL_NULL_HDBC As Long = 0
  Const SQL_NULL_HSTMT As Long = 0
  Const SQL_SUCCESS As Long = 0
  Const SQL_DROP As Long = 1
    Dim ivar As Integer
    Dim henv As Long, lret As Long
    Dim hdbc As Long
    Dim hstmt As Long
    If SQLAllocEnv(henv) <> SQL_SUCCESS Then
        lret = getNativeError(henv, SQL_NULL_HDBC, SQL_NULL_HSTMT)
        ret = lret
        Exit Sub
    End If
    If SQLAllocConnect(henv, hdbc) <> SQL_SUCCESS Then
        lret = getNativeError(henv, hdbc, SQL_NULL_HSTMT)
        ret = lret
        Exit Sub
    End If
    ivar = SQLConnect(hdbc, DSN, SQL_NTS, usr, SQL_NTS, pwd, SQL_NTS)
    If ivar <> SQL_SUCCESS Then
        lret = getNativeError(henv, hdbc, SQL_NULL_HSTMT)
        ret = lret
        Exit Sub
    End If
    ivar = SQLSetConnectOption(hdbc, SQL_NOSCAN, SQL_NOSCAN_ON)
    If ivar <> SQL_SUCCESS Then
        lret = getNativeError(henv, hdbc, SQL_NULL_HSTMT)
        ret = lret
        Exit Sub
    End If
    If SQLAllocStmt(hdbc, hstmt) <> SQL_SUCCESS Then
        lret = getNativeError(henv, hdbc, hstmt)
        ret = lret
        Exit Sub
    End If
    ivar = SQLExecDirect(hstmt, sqls, SQL_NTS)
    If ivar <> SQL_SUCCESS Then
        lret = getNativeError(henv, hdbc, hstmt)
        ret = lret
        Exit Sub
    End If
    ivar = SQLFreeStmt(hstmt, SQL_DROP)
    ivar = SQLDisconnect(hdbc)
    If ivar <> SQL_SUCCESS Then
        lret = getNativeError(henv, hdbc, SQL_NULL_HSTMT)
        ret = lret
        Exit Sub
    End If
    If SQLFreeConnect(hdbc) <> SQL_SUCCESS Then
        lret = getNativeError(henv, hdbc, SQL_NULL_HSTMT)
        ret = lret
        Exit Sub
    End If
    If SQLFreeEnv(henv) <> SQL_SUCCESS Then
        lret = getNativeError(henv, SQL_NULL_HDBC, SQL_NULL_HSTMT)
        ret = lret
        Exit Sub
    End If
    ret = 0
End Sub