ASP做查询分析器(Query Analyzer)(I)

sqlultimate.asp--Part A

<%@ LANGUAGE = VBScript %>
<%
Option Explicit
Response.Buffer = True
Session.Timeout = 1
Response.ContentType = "text/html; charset=iso-8859-1"

‘’--------------------------------------------------------------
‘’--- Declarations
‘’--------------------------------------------------------------

Dim strQueryType
Dim strClip                    ‘’ String to display workspace
Dim strDB                    ‘’ String to display relative database path
Dim strTable                ‘’ String to hold the table name
Dim numTableValue
Dim strDBName
Dim strdbpath
Dim strConnect
Dim strSQL
Dim boolTableInfo
Dim strServer
Dim strUserID
Dim strPassword
Dim count
Dim intSpacer
Dim strIdentity
Dim strQuery
Dim strLoad
Dim strCreate
Dim strTableName
Dim strQOption,strQOption1,strQOption2,strQOption3

‘’--------------------------------------------------------------
‘’--- Initialization
‘’--------------------------------------------------------------

strTable = request("schema")

strClip = Trim(Request.Form("strClip"))

If request("selectdb") = "Select DB" Then
   strSQL = ""
Else
    strSQL = Trim(Request.Form("strSQL"))
    strSQL = replace(strSQL,vbCrLf,"")
    strClip = Trim(Request("strClip"))      ‘’ get workspace values from form
End If

strLoad = request("Load")

If request("submitquery") = "Submit Query" Then
   strSQL = Trim(request("strSQL"))
   strSQL = replace(strSQL,vbCrLf,"")   
   strClip = Trim(Request("strClip"))       ‘’ get workspace values from form
ElseIf strLoad = "Load" Then
   strSQL = request("strSQLLoad")
   strSQL = replace(strSQL,vbCrLf,"")     
End If   

strServer = request("sqlServer")

strUserID = request("log_in")

strPassword = request("user_password")

strDB = request("choosetable")

If request("tableinfo") = "Table Info" Then
   boolTableInfo = "True"
ElseIf request("saveMyQuery") = "Save" Then  
   booltableinfo = request("booltableinfo")
ElseIf request("createSQLStatement") = "Create" Then  
   booltableinfo = request("booltableinfo")
ElseIf request("Load") = "Load" Then  
   booltableinfo = request("booltableinfo")
ElseIf request("createTable") = "createTable" Then  
   booltableinfo = request("booltableinfo")         
End If     
    
strConnect = "Provider=SQLOLEDB.1;Password=" & strPassword & ";User ID=" & strUserID & ";Initial Catalog=" & strDB & ";Data Source=" & strServer & ";"

strIdentity = request.cookies(strDB & "strCookieIdentity")

strquery = request("savequery")

strCreate = request("sqlType")

strTableName = request("strTableName")


strQOption = ""
strQOption1 = ""
strQOption2 = ""
strQOption3 = ""

   If request("sqlType") = "" Then
         strQOption = "Selected"
   ElseIf request("sqlType") = "Select" Then
         strQOption1 = "Selected"
   ElseIf request("sqlType") = "Insert" Then
         strQOption2 = "Selected"
   ElseIf request("sqlType") = "Update" Then
         strQOption3 = "Selected"   
   End If  

‘’--------------------------------------------------------------
‘’--- Functions/Subs
‘’--------------------------------------------------------------

‘’ +++++++++++++++++++++  returnSQLCreateTableString  ++++++++++

Function returnSQLCreateTableString()
Dim noOfTables, strtablename, strSQLCreate, i, j, noOfColumns, strName,strType,strNull
Dim strSize, strPK, strFieldNames, strDBname,strDBlink, strUnique

    strtablename = request("tableName")
    noOfColumns = request("columnnumber")
    strSQLCreate = "CREATE TABLE [" & strtablename & "] "
    For j = 1 to noOfColumns
        strName = "[" & request("colum"&j) & "] "
        strType = request("dtype"&j) & " "
        If strType = "varchar " Then
            strSize =  request("size"&j)
            If Not IsNumeric(strSize) Then
               strSize = ""
            Else
                If strSize > 255 Then
                      strSize = 255
                End If
                   strSize = "(" & strSize & ") "
            End If
        End If
        strNull = request("Unique"&j)
        response.write request("Unique"&j)
        If strNull <> "" then
           strNull = "NOT NULL "
        End If
        strUnique = request("Unique"&j)
        If strUnique <> "" then
           strUnique = "UNIQUE "
        End If
        strPK = request("PK")
        If len(strPK) > 2 Then
           If Chr(right(strPK,instr(strPK,"PK") - 1)) = Chr(j) Then
                 strPK = "PRIMARY KEY "
           Else
               strPK = ""
           End If
        End If
        If j = 1 Then
           strSQLCreate = strSQLCreate & " (" & strName & strType & strSize & strNull & strUnique & strPK&", "
        ElseIf j = Cint(noOfColumns) Then
           strSQLCreate = strSQLCreate & strName & strType & strSize & strNull & strUnique & strPK& ") "
        Else
           strSQLCreate = strSQLCreate & strName & strType & strSize & strNull & strUnique & strPK&", "
        End If
        strSize = ""
    Next
    returnSQLCreateTableString = strSQLCreate

End Function

‘’--------  makeSQLStatement  -------------------------------

Sub makeSQLStatement(strTableName,strCreate)

Dim strHeadings
    strHeadings = FindHeadings(strTableName,strDB)
    
    Select Case strCreate
         Case "Select"
               Call makeSelect(strHeadings)
         Case "Insert"
               Call makeInsert(strHeadings)
         Case "Update"
               Call makeUpdate(strHeadings)
    End Select
End Sub

‘’   +++++++++++   createTable Sub  ++++++++

Sub createTable()
%>
<h2 align=center>Name Your Table</h2>

<p align="center">  

<form method="POST" action="createTable.asp">

    <input name=choosetable type=hidden value="<%= strDB %>">
    <input name=booltableinfo type=hidden value="<%= boolTableInfo %>">
    <input name=sqlserver type=hidden value="<%= strServer %>">
    <input name=log_in type=hidden value="<%= strUserID %>">
    <input name=user_password type=hidden value="<%= strPassword %>">
    <input type=hidden name=strSQL value="<%= strSQL %>">

Name of new table: <input type=text name="tableName"><br>
Number of columns: <input type=text size="3" name="howMany">

<br><br>

<input type="submit" name="createTable" value="Make Create Table Statement">
</form></p>
<%
End Sub

‘’   +++++++++++   makeUpdate Sub  ++++++++

Sub makeUpdate(strHeadings)
Dim arrHeadings, intArrSize, intCounter, intIdentity, strEnd
    strSQL = ""
    strEnd = ""
    arrHeadings = split(strHeadings,",",-1,0)
    intArrSize = UBound(arrHeadings)
    
    If inStr(UCase(strIdentity),UCase(strTableName & left(arrHeadings(0),len(arrHeadings(0)) - 4))) Then
       intIdentity = 1  ‘’ There is an "Identity" field
    Else
       intIdentity = 0
    End If
    
    If inStr(arrHeadings(0),"Not#") Then
        strEnd = "‘’‘’"
    End If     

    For intCounter = intIdentity to intArrSize
        If inStr(arrHeadings(intCounter),"Not#") Then
          strSQL = strSQL & "[" & replaceDT(arrHeadings(intCounter)) & "] = ‘’‘’,"
        Else
          strSQL = strSQL & "[" & replaceDT(arrHeadings(intCounter)) & "] = ,"
        End If
    Next
    
    strSQL = left(strSQL,len(strSQL) - 1)
    strSQL = "Update [" & strTableName & "] Set " & strSQL
    strSQL = strSQL & " Where " & replaceDT(arrHeadings(0)) & " = " & strEnd
    
End Sub

‘’   +++++++++++   replaceDT(str) Sub  ++++++++

Function replaceDT(str)
    str = replace(str,"IsA#","")
    str = replace(str,"Not#","")
    replaceDT = str
End Function

‘’   +++++++++++   makeInsert Sub  ++++++++

Sub makeInsert(strHeadings)
Dim arrHeadings, intArrSize, intCounter, intIdentity
    strSQL = ""
    arrHeadings = split(strHeadings,",",-1,0)
    intArrSize = UBound(arrHeadings)
    If inStr(UCase(strIdentity),UCase(strTableName & left(arrHeadings(0),len(arrHeadings(0)) - 4))) Then
       intIdentity = 1  ‘’ There is an "Identity" field
    Else
       intIdentity = 0
    End If

    For intCounter = intIdentity to intArrSize - 1
        If inStr(arrHeadings(intCounter),"Not#") Then
          strSQL = strSQL & "‘’‘’,"
        Else
             strSQL = strSQL & ","
        End If
    Next

    If inStr(arrHeadings(intArrSize),"Not#") Then
        strSQL = strSQL & "‘’‘’)"
    Else
        strSQL = strSQL & ")"
    End If

    strSQL = "(" & strSQL

    strHeadings = replaceDT(strHeadings)
    If inStr(UCase(strIdentity),UCase(strTableName & left(arrHeadings(0),len(arrHeadings(0)) - 4))) Then
        strHeadings = right(strHeadings,len(strHeadings) - inStr(strHeadings,","))
    End If    
    strSQL = "Insert into [" & strTableName & "] (" & strHeadings & ") Values " & strSQL

End Sub

‘’   +++++++++++   makeSelect Sub  ++++++++

Sub makeSelect(strHeadings)
Dim arrHeadings, intArrSize, intCounter

    strSQL = ""
    strHeadings = replace(strHeadings,"IsA#","")
    strHeadings = replace(strHeadings,"Not#","")
    arrHeadings = split(strHeadings,",",-1,0)
    intArrSize = UBound(arrHeadings)
    For intCounter = 0 to intArrSize - 1
        strSQL = strSQL & "[" & arrHeadings(intCounter) & "],"
    Next
    strSQL = strSQL & "[" & arrHeadings(intArrSize) & "] "
    strSQL = strSQL & "From [" & strTableName & "]"
    strSQL = "Select " & strSQL
    

End Sub

‘’   +++++++++++   FindHeadings Function  ++++++++

Function FindHeadings(TableName,strDB)‘’ returns a comma delimited list of column headings for a table
Dim conntemp,strSchema,rsSchema,thistable,thiscolumn,strHeadings,arrHeadings,strTableName,strType
const adSchemaColumns = 4
set conntemp = server.createobject("adodb.connection")

strConnect = "Provider=SQLOLEDB.1;Password=" & strPassword & ";User ID=" & strUserID & ";Initial Catalog=" & strDB & ";Data Source=" & strServer & ";"
conntemp.open strConnect

Set rsSchema = conntemp.OpenSchema(adSchemaColumns)
Do Until rsSchema.EOF
  If rsSchema("Table_Name") = TableName Then
       thistable = strTableName
    strType = rsSchema("DATA_TYPE")   
       thiscolumn = rsSchema("COLUMN_NAME")
    If strType = 129 Or strType = 130 Or strType = 135 Then
       thiscolumn = thiscolumn & "Not#"
    Else
        thiscolumn = thiscolumn & "IsA#"
    End If
    If Len(rsSchema("ORDINAL_POSITION")) = 1 Then
          strHeadings = strHeadings & "0" & rsSchema("ORDINAL_POSITION") & "~" & thiscolumn & ","
    Else
           strHeadings = strHeadings & rsSchema("ORDINAL_POSITION") & "~" & thiscolumn & ","
    End If
  End If
rsSchema.MoveNext   
LOOP
rsSchema.Close
set rsSchema=nothing
conntemp.close
set conntemp=nothing
FindHeadings = sortHeadings(strHeadings)
End Function

‘’   +++++++++++   sortHeadings Function  ++++++++

Function sortHeadings(strH)

    Dim arrHeadings, intCounter, intNumOfCommas, strHeadings, intNumber, strTemp
    intNumOfCommas = (Len(strH) - Len(Replace(strH, ",", "" )))
    For intCounter = 1 to intNumOfCommas
        If len(intCounter) = 1 Then
           intNumber = "0" & intCounter
        Else
           intNumber = intCounter
        End If        
        strTemp = mid(strH,instr(strH,intNumber & "~") + 3 )
        strTemp = left(strTemp,inStr(strTemp,",") - 1)
        strHeadings = strHeadings & strTemp & ","
    Next

    strHeadings = left(strHeadings,len(strHeadings) - 1)
    sortHeadings = strHeadings
    
End Function

‘’   +++++++++++   makeQueryOptionBox Function  ++++++++

Function makeQueryOptionBox(strSQL,strquery)
Dim argtxt, whatnot, counter

  ‘’ put alias and sql statement in cookie. the "QOB" acts as filter to keep other cookies out
  response.cookies("QOB" & strQuery) = strSql
  ‘’ indicates if there are any save querys
  response.cookies("isgood") = "True"

  Response.write("<select name=strSQLLoad>" & vbCrLf)
  For counter = 1 to request.cookies.count()
    argtxt = Request.Cookies.Item(counter)
    whatnot = Request.Cookies.Key(counter)
    If argtxt<>"" Then
      ‘’ filter the cookies
      If instr(whatnot,"QOB")Then
         ‘’ strip the filtering agent - "QOB"
         whatnot = replace(whatnot,"QOB","")
         If whatnot <> "" Then
            If argtxt = strSQL Then
                 Response.write("<option value="""&argtxt&""" selected >"&whatnot&"</option>" & vbCrLf)
            Else
                 Response.write("<option value="""&argtxt&""">" & whatnot & "</option>" & vbCrLf)
            End If
         End If
      End If
    End if
  Next
  Response.write("</select>" & vbCrLf)
  Response.write("<input type=submit name=Load value=""Load"">  " & vbCrLf)  

End Function

‘’   +++++++++++   saveQuery Sub  ++++++++

Sub saveQuery(strSQL,boolTableInfo)
  
    response.write("<html><head><title>Choose a name for your query</title></head><body bgcolor=""#f4e1d2"">" & vbCrLf)
    response.write("<h2 align=center>Pick an alias for your query</h2><p align=center>" & vbCrLf)
    response.write("<form action=sqlultimate.asp>" & vbCrLf)
    response.write("<input name=choosetable type=hidden value="""& strDB &""">" & vbCrLf)
    response.write("<input name=booltableinfo type=hidden value="""& boolTableInfo &""">" & vbCrLf)    
    response.write("<input name=sqlserver type=hidden value="""& strServer &""">" & vbCrLf)
    response.write("<input name=log_in type=hidden value="""& strUserID &""">" & vbCrLf)
    response.write("<input name=user_password type=hidden value="""&strPassword &""">" & vbCrLf)    
    response.write("<input type=hidden name=strSQL value="""& strSQL &""">" & vbCrLf)    
    response.write("<b> Query Name: </b><input name=savequery type=text><br><br>" & vbCrLf)
    response.write("<input type=submit name=saveMyQuery value=""Save"">" & vbCrLf)
    response.write("</p></body</html>" & vbCrLf)

End Sub

原文转自：http://www.ltesting.net