Feeds:
Posts
Comments

Posts Tagged ‘code’

I have come across this VB code from the below link and thought it was brilliant:

link to the original forum where the module (modFormatSQL.bas) was found


Attribute VB_Name = "modFormatSQL"
Option Explicit
'
'*  SQL "Select" statement formatter/checker
'
'*  Author:  Si_the_geek of VBForums.com
'
'
'* Example usage:
'
'Dim sSQL as String
'  sSQL = "SELECT field1 FROM table1"
'  sSQL = FormatSelect(sSQL)
'  MsgBox sSQL

Public Function FormatSelect(ByVal sInput As String, _
                             Optional ByVal bShowSpacerLines As Boolean = True, _
                             Optional ByVal lIndentSize As Integer = 10, _
                             Optional ByVal lIndentSubquerySize As Integer = 13) _
                             As String
'Format an SQL "select" statement for easier reading

'Also lists a few obvious errors if found, eg:
'  - Sections (eg: FROM, WHERE) in the wrong order;
'  - Wrong number of quotes, ie: a string/date is not closed properly;
'  - Wrong number of brackets, ie: more ( than ) , or vice versa.

'Current known omissions:
'  does not start a new line for CASE WHEN (or other DBMS specific code)

Dim sError As String

  FormatSelect = FormatSelect_Worker(sInput, _
                                     sError, _
                                     bShowSpacerLines, _
                                     lIndentSize, _
                                     lIndentSubquerySize)

  If sError <> "" Then
    MsgBox "The following problems were found:" & vbCrLf & vbCrLf & sError, vbExclamation
  End If

End Function

'* the following are helper functions for FormatSelect *

Private Function FormatSelect_Worker(ByVal sInput As String, _
                                     ByRef ret_sWarnings As String, _
                                     Optional ByVal bSpacerLines As Boolean = True, _
                                     Optional ByVal lIndentSize As Integer = 10, _
                                     Optional ByVal lIndentSubquerySize As Integer = 13) _
                                     As String
'(helper function for FormatSelect)

'Format an SQL "select" statement for easier reading (also lists a few obvious errors)

  'Create keyword list array
Dim aKeywords As Variant
  aKeywords = Array("SELECT", "FROM", "WHERE", "GROUP BY", "HAVING", "ORDER BY")

  'Setup variables
Dim sRetString As String        'Text to return
Dim sWarning As String          'Warning messages
Dim sTempWarning As String      'Potential warning messages froom sub queries
Dim sText As String             '"Clean" text to work with
Dim sIndent As String           'Space to indent 'normal' text by
Dim sIndentSub As String        'Space to indent subqueries by
Dim sTemp As String             'Temporary text
Dim aStrings() As String        'Strings within the SQL (temporarily removed, in case keywords found)
Dim bGotStrings As Boolean      'Have we got any strings?
Dim aSubQueries() As String     'Sub-queries within the SQL (temp. removed to aid formatting & simplify code)
Dim bGotSubqueries As Boolean   'Have we got any sub-queries?
Dim lCurrPos As Long            'The current position within sText
Dim lTempPos As Long            'Position of text we just searched for
Dim lTempPos2 As Long           'Position of text we just searched for
Dim lThisSectionType As Long    'The type of section (from aKeywords) we are working with
Dim lLastSectionType As Long    'The type of the previous section (to show warnings)
Dim lThisSectionStart As Long   'The start position of this section
Dim lNextSectionStart As Long   'The start position of the next section (so we stop before it)
Dim lCount As Long              'Loop counter
Dim bInQuotes As Boolean        'Are we currently inside single quotes? (for removing strings)
  sWarning = ""
  sRetString = ""
  sText = sInput
  sIndent = Space(lIndentSize)
  sIndentSub = Space(lIndentSubquerySize)

    'move all strings to array (so we dont find keywords in them)
  lCount = (Len(sText) - Len(Replace(Replace(Replace(sText, "'", ""), """", ""), "#", "")))
  ReDim aStrings(1, lCount \ 2 + 1) As String
  lCount = 0
  lCurrPos = 0
  bInQuotes = False
  lTempPos = InStr(1, sText, "'")
  lTempPos2 = InStr(1, sText, """")
  If (lTempPos = 0) Or (lTempPos2 > 0 And lTempPos2 < lTempPos) Then lTempPos = lTempPos2   lTempPos2 = InStr(1, sText, "#")   If (lTempPos = 0) Or (lTempPos2 > 0 And lTempPos2 < lTempPos) Then lTempPos = lTempPos2   Do While (lTempPos > 0)
    sTemp = Mid$(sText, lTempPos, 1)
    aStrings(0, lCount) = sTemp
    If bInQuotes And (sTemp <> "#") Then
      Do While Mid$(sText, lTempPos, 2) = String(2, sTemp)
        lTempPos = InStr(lTempPos + 2, sText, sTemp)
        If lTempPos = 0 Then Exit Do
      Loop
    End If
    If lTempPos = 0 Then Exit Do
    If bInQuotes Then
      aStrings(1, lCount) = Mid$(sText, lCurrPos, lTempPos - lCurrPos)
      sText = Left$(sText, lCurrPos - 1) & Mid$(sText, lTempPos)
      lCount = lCount + 1
      lTempPos = InStr(lCurrPos + 2, sText, "'")
      lTempPos2 = InStr(lCurrPos + 2, sText, """")
      If (lTempPos = 0) Or (lTempPos2 > 0 And lTempPos2 < lTempPos) Then lTempPos = lTempPos2       lTempPos2 = InStr(lCurrPos + 2, sText, "#")       If (lTempPos = 0) Or (lTempPos2 > 0 And lTempPos2 < lTempPos) Then lTempPos = lTempPos2
    Else
      lCurrPos = lTempPos + 1
      lTempPos = InStr(lTempPos + 1, sText, sTemp)
    End If
    bInQuotes = Not (bInQuotes)
  Loop
  If bInQuotes Then
    sWarning = sWarning _
             & "Incorrect number of quote (" & sTemp & " characters), a string/date is not closed!" _
             & vbCrLf & vbCrLf
  End If
  If lCount = 0 Then
    Erase aStrings
  Else
    ReDim Preserve aStrings(1, lCount - 1) As String
    bGotStrings = True
  End If

    'tidy input text
  sText = Trim$(Replace(Replace(sText, vbCr, " "), vbLf, " "))
  sText = Replace(sText, vbTab, " ")
  sTemp = "=<>+-/*"
  For lCount = 1 To Len(sTemp)
    sText = Replace(sText, Mid$(sTemp, lCount, 1), " " & Mid$(sTemp, lCount, 1) & " ")
  Next lCount
  sText = Replace(sText, ",", ", ")
  sText = Replace(Replace(sText, "(", " ( "), ")", " ) ")
  Do While InStr(sText, "  ")
    sText = Replace(sText, "  ", " ")
  Loop
  sText = Trim$(Replace(sText, " ,", ","))

    'move all subqueries to array (better formatting, and so we dont split on the wrong keywords)
  ReDim aSubQueries((Len(sText) - Len(Replace(sText, "( SELECT ", "", compare:=vbTextCompare))) \ 8 + 1) As String
  lCount = 0
  lCurrPos = InStr(1, sText, "( SELECT ", vbTextCompare)
  Do While (lCurrPos > 0)
    lTempPos = FindCloseBracket(sText, lCurrPos)
    sTemp = FormatSelect_Worker(Mid$(sText, lCurrPos + 1, lTempPos - lCurrPos - 1), _
                                sTempWarning, _
                                bSpacerLines, _
                                lIndentSize, _
                                lIndentSubquerySize)
    If sTempWarning <> "" Then
      sWarning = sWarning _
               & "(in sub-query: " _
               & vbCrLf _
               & "  " & Replace(sTempWarning, vbCrLf, vbCrLf & "  ") _
               & ")" _
               & vbCrLf & vbCrLf
    End If
    sTemp = vbCrLf _
          & sIndentSub _
          & Replace(sTemp, vbCrLf, vbCrLf & sIndentSub)
    aSubQueries(lCount) = sTemp
    sText = Left$(sText, lCurrPos) _
          & vbCrLf _
          & sIndentSub _
          & Mid$(sText, lTempPos)
    lCount = lCount + 1
    lCurrPos = InStr(lCurrPos + 1, sText, "( SELECT ", vbTextCompare)
  Loop
  If lCount = 0 Then
    Erase aSubQueries
  Else
    ReDim Preserve aSubQueries(lCount - 1) As String
    bGotSubqueries = True
  End If

    'count brackets to ensure a match
  lCount = (Len(sText) - Len(Replace(sText, "(", "")))
  lCount = lCount - (Len(sText) - Len(Replace(sText, ")", "")))
  Select Case Sgn(lCount)
  Case 1
    sWarning = sWarning _
             & "You have " & lCount & " more open brackets: ( than close brackets: )  This may make any subqueries be invalid!" _
             & vbCrLf & vbCrLf
  Case -1
    sWarning = sWarning _
             & "You have " & Abs(lCount) & " more close brackets: ) than open brackets: (  This may make any subqueries be invalid!" _
             & vbCrLf & vbCrLf
  End Select

    'work with text...
  lCurrPos = 1
  lThisSectionType = -1
  Do While lCurrPos < Len(sInput)       'find current section type & position     lLastSectionType = lThisSectionType     lThisSectionStart = FindFirstByArray(sText, aKeywords, lCurrPos, lThisSectionType)       'if any "incorrect" text, add it to a new line     If lThisSectionStart > lCurrPos Then
      sRetString = sRetString _
                 & Mid$(sText, lCurrPos, lThisSectionStart - lCurrPos - 1) _
                 & vbCrLf
      sWarning = sWarning _
               & "Unexpected text: " _
               & Mid$(sText, lCurrPos, lThisSectionStart - lCurrPos - 1) _
               & vbCrLf & vbCrLf
    End If
      'if reached end of text, exit!
    If lThisSectionStart >= Len(sText) Then Exit Do
      'if sections ordered wrong, add to warning
    If lLastSectionType > lThisSectionType Then
      sWarning = sWarning _
               & "Incorrect section ordering: " _
               & aKeywords(lThisSectionType) _
               & " should be before " _
               & aKeywords(lLastSectionType) _
               & vbCrLf & vbCrLf
    End If

    If bSpacerLines Then
        'add blank lines between sections
      If (lCurrPos > 1) Then
        sRetString = sRetString _
                   & vbCrLf
      End If
    End If

      'add keyword (Ucase), and spaces to indent
    If Len(aKeywords(lThisSectionType)) >= lIndentSize Then
      sRetString = sRetString & aKeywords(lThisSectionType) & " "
    Else
      sRetString = sRetString & aKeywords(lThisSectionType) & Space(Len(sIndent) - Len(aKeywords(lThisSectionType)))
    End If
    lCurrPos = lCurrPos + Len(aKeywords(lThisSectionType)) + 1
    lThisSectionStart = lThisSectionStart + Len(aKeywords(lThisSectionType)) + 1
      'find end of current section
    lNextSectionStart = FindFirstByArray(sText, aKeywords, lCurrPos)

      'work on each section...
Dim lBracketStart As Long
Dim lBracketEnd As Long
Dim aTempArray As Variant
Dim lTempIndex As Long
Dim lTempLen As Long
Dim lTempInc As Long
    Select Case aKeywords(lThisSectionType)

    Case "SELECT", "GROUP BY", "ORDER BY"
      lTempPos = lCurrPos
      Do
        Do
          lBracketStart = InStr(lTempPos, sText, "(")
          lTempPos = InStr(lTempPos, sText, ",")
          If (lBracketStart > 0) And (lBracketStart < lTempPos) And (lBracketStart < lNextSectionStart) Then
            lBracketEnd = FindCloseBracket(sText, lBracketStart)
            If lBracketEnd < lNextSectionStart Then               lTempPos = lBracketEnd - 1             Else               lBracketStart = 0             End If           Else             lBracketStart = 0           End If         Loop While (lBracketStart > 0) And (lTempPos > 0)
        If (lTempPos = 0) Or (lTempPos >= lNextSectionStart) Then lTempPos = lNextSectionStart - 1
        If (lTempPos > lCurrPos) Then
          sRetString = sRetString _
                     & Trim$(Mid$(sText, lCurrPos, lTempPos - lCurrPos + 1)) _
                     & vbCrLf
          If (lTempPos < lNextSectionStart - 1) Then
            sRetString = sRetString _
                       & sIndent
          End If
        End If
        lCurrPos = lTempPos + 1
        lTempPos = lCurrPos
      Loop While (lTempPos < lNextSectionStart) And (lCurrPos < lNextSectionStart)

    Case "FROM"
      aTempArray = Array("INNER JOIN", "LEFT OUTER JOIN", "RIGHT OUTER JOIN", _
                         "LEFT JOIN", "RIGHT JOIN", "OUTER JOIN", "OUTER", _
                         "CROSS JOIN", "JOIN")
      Do
        lTempPos = FindFirstByArray(sText, aTempArray, lCurrPos, lTempIndex)
        If (lTempPos < Len(sText)) And (lTempPos < lNextSectionStart) Then
          lTempLen = Len(aTempArray(lTempIndex))
          sRetString = sRetString _
                     & Trim$(Mid$(sText, lCurrPos, lTempPos - lCurrPos - 1)) _
                     & vbCrLf _
                     & sIndent _
                     & aTempArray(lTempIndex) _
                     & " "
          lCurrPos = lTempPos + lTempLen
        End If
      Loop While (lTempPos < Len(sText)) And (lTempPos < lNextSectionStart)
      If (lCurrPos < lNextSectionStart) Then
        sRetString = sRetString _
                   & Trim$(Mid$(sText, lCurrPos, lNextSectionStart - lCurrPos)) _
                   & vbCrLf
      End If

    Case "WHERE", "HAVING"
      aTempArray = Array("AND", "OR", "BETWEEN")
      Do
        lTempInc = 0
        Do
          lTempPos = FindFirstByArray(sText, aTempArray, lCurrPos + lTempInc, lTempIndex)
            'need to skip the 'And' in a Between clause
          If (lTempIndex = 2) Then
            lTempInc = InStr(lTempPos, sText, "AND", vbTextCompare) + 1 - lCurrPos
            If lTempInc < 0 Then lTempInc = 7
          End If
        Loop While (lTempIndex = 2)
        If (lTempPos < Len(sText)) And (lTempPos < lNextSectionStart) Then
          lTempLen = Len(aTempArray(lTempIndex))
          sRetString = sRetString _
                     & Trim$(Mid$(sText, lCurrPos, lTempPos - lCurrPos)) _
                     & vbCrLf _
                     & sIndent _
                     & aTempArray(lTempIndex) _
                     & " "
          lCurrPos = lTempPos + lTempLen
        End If
      Loop While (lTempPos < Len(sText)) And (lTempPos < lNextSectionStart)
      If (lCurrPos < lNextSectionStart) Then
        sRetString = sRetString _
                   & Trim$(Mid$(sText, lCurrPos, lNextSectionStart - lCurrPos)) _
                   & vbCrLf
      End If

    Case Else     'a section not coded for - just paste the text!
      sRetString = sRetString _
                 & sIndent _
                 & Trim$(Mid$(sText, lCurrPos, lNextSectionStart - lCurrPos)) _
                 & vbCrLf
    End Select

    lCurrPos = lNextSectionStart
  Loop

    '(main statement finished)

    're-insert the sub-queries we removed at the start
  If bGotSubqueries Then
    If bSpacerLines Then
      For lCount = 0 To UBound(aSubQueries)
        sRetString = Replace(sRetString, _
                             "(" & vbCrLf & sIndentSub & ")", _
                             "(" & vbCrLf & aSubQueries(lCount) & vbCrLf & vbCrLf & sIndentSub & ")", _
                             1, _
                             1)
      Next lCount
    Else
      For lCount = 0 To UBound(aSubQueries)
        sRetString = Replace(sRetString, _
                             "(" & vbCrLf & sIndentSub & ")", _
                             "(" & aSubQueries(lCount) & vbCrLf & sIndentSub & ")", _
                             1, _
                             1)
      Next lCount
    End If
  End If

    're-insert the strings we removed at the start
  If bGotStrings Then
    For lCount = 0 To UBound(aStrings, 2)
      sRetString = Replace(sRetString, _
                           String(2, aStrings(0, lCount)), _
                           aStrings(0, lCount) & aStrings(1, lCount) & aStrings(0, lCount), _
                           1, _
                           1)
    Next lCount
  End If

    'return any warning messages
  If sWarning <> "" Then
    ret_sWarnings = sWarning
  End If

    'return formatted text
  FormatSelect_Worker = Left$(sRetString, Len(sRetString) - Len(vbCrLf))

End Function

Private Function FindCloseBracket(sText As String, _
                                  Optional lStartPos As Long = 1) _
                                  As Long
'(helper function for FormatSelect)

'Returns the position of the closing bracket to match the opening bracket at the position 'lStartPos',
'(or length of string+1 if not found)

Dim lCurrPos As Long
Dim lOpenPos As Long
Dim lClosePos As Long
Dim lOpenCount As Long

  lOpenCount = 1
  lCurrPos = lStartPos + 1
  FindCloseBracket = Len(sText) + 1

  lOpenPos = InStr(lCurrPos, sText, "(")
  lClosePos = InStr(lCurrPos, sText, ")")
  Do While (lOpenPos > 0) Or (lClosePos > 0)
    If (lOpenPos > 0 And lOpenPos < lClosePos) Or (lClosePos = 0) Then
      lOpenCount = lOpenCount + 1
      lCurrPos = lOpenPos + 1
      lOpenPos = InStr(lCurrPos, sText, "(")
    Else
      lOpenCount = lOpenCount - 1
      If lOpenCount = 0 Then
        FindCloseBracket = lClosePos
        Exit Do
      End If
      lCurrPos = lClosePos + 1
      lClosePos = InStr(lCurrPos, sText, ")")
    End If
  Loop

End Function

Private Function FindFirstByArray(sText As String, _
                                  vArray As Variant, _
                                  Optional lStartPos As Long = 1, _
                                  Optional ByRef retArrayIndex As Long) _
                                  As Long
'(helper function for FormatSelect)

'Returns the position of first instance in the string of any array item (or length of string+1 if none found)
'nb: must be after some kind of punctuation as listed below

Const csPunctuation = " '""#()=<>[]+-/*"

Dim lFirstPos As Long
Dim lArrayIndex As Long
Dim lTempPos As Long
Dim lCount As Long
Dim bOK As Boolean

  lFirstPos = Len(sText) + 1
  lArrayIndex = 0

  For lCount = 0 To UBound(vArray)
    lTempPos = InStr(lStartPos, sText, vArray(lCount), vbTextCompare)
    Do While (lTempPos >= lStartPos)
      bOK = False    'check prev char is punctuation/start
      If (lTempPos = lStartPos) Then
        bOK = True
      Else
        If InStr(csPunctuation, Mid$(sText, lTempPos - 1, 1)) Then
          bOK = True
        End If
      End If
      If bOK Then    'check next char is punctuation/end
        If lTempPos + Len(vArray(lCount)) > Len(sText) Then Exit Do
        If InStr(csPunctuation, Mid$(sText, lTempPos + Len(vArray(lCount)), 1)) Then Exit Do
      End If
      lTempPos = InStr(lTempPos + 1, sText, vArray(lCount), vbTextCompare)
    Loop
    If (lTempPos > 0) And (lTempPos < lFirstPos) Then
      lFirstPos = lTempPos
      lArrayIndex = lCount
    End If
  Next lCount

  retArrayIndex = IIf(lFirstPos = Len(sText), -1, lArrayIndex)
  FindFirstByArray = lFirstPos

End Function

Advertisements

Read Full Post »

--Check if a table exists (and drop it if does) before creating it again
if exists(select name 
			from anydbnameOptional.dbo.sysobjects -- use TYPE to specify tables, Sps etc
			where  type = 'u' -- http://msdn.microsoft.com/en-us/library/ms177596.aspx
			and name = 'whatever') 
	drop table whatever

--Check if a database exists
if exists (select name from master..sysdatabases where name = 'DatabaseName') select 'ok'


declare @anotherWay varchar(100)
-- if select is used then the outer bracket must be used as well
 --set @anotherWay = (select DB_NAME())
set @anotherWay = DB_NAME()
print @anotherWay

Read Full Post »