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

sqlultimate.asp--Part B

‘’   ++++++++++++++   FK Sub  +++++++++++++++++
SUB FK(xdbname, xuserid, xpassword )
Dim strConn,conntemp,rsSchema,PKT,PKC,FKT,FKC
Const adSchemaForeignKeys = 27
strConn =  "Provider=SQLOLEDB.1;Data Source="&strServer&";" & _
            "Initial Catalog=" & xdbname & _
            ";UID=" & xuserid & ";PWD=" & xpassword & ";"
      set conntemp = server.createobject("adodb.connection")
      response.write("<p align=center><table width=""75%"">" & vbCrLf)
      response.write("<tr bgcolor=black align=center><td colspan=2><font color=white><b>Primary Key</b></font></td><td colspan=2><font color=white><b>Foreign Key</b></font></td></tr>" & vbCrLf)
      response.write("<tr bgcolor=white align=center><td><b>PK Table</b></td><td><b>PK Field</b></td><td><b>FK Table</b></td><td><b>FK Field</b></td></tr>" & vbCrLf)
      conntemp.open strConn
      set rsSchema = conntemp.OpenSchema(adSchemaForeignKeys)
         DO UNTIL rsSchema.eof
             PKT = rsSchema.fields("PK_TABLE_NAME")
            PKC = rsSchema.fields("PK_COLUMN_NAME")
            FKT = rsSchema.fields("FK_TABLE_NAME")
            FKC = rsSchema.fields("FK_COLUMN_NAME")
            If PKT <> "" Then
               response.write("<tr align=right><td bgcolor=#c6e9f4>" &PKT & "</td><td> " &  PKC & "</td><td bgcolor=#c6e9f4> " & FKT& "</td><td> " & FKC & "</td></tr>" & vbCrLf)
            End If
         rsSchema.MoveNext
         LOOP
       response.write("</table></p>" & vbCrLf)
   rsSchema.Close
   set rsSchema=nothing
   conntemp.close
   set conntemp=nothing
END SUB

‘’   ++++++++++++++   tableDropDown Sub  +++++++++++++++++

Sub tableDropDown(xdbname, xuserid, xpassword )

dim cnn, cat, tbl

dim connectstring
On Error Resume Next
  connectstring = _
                "Provider=SQLOLEDB.1;Data Source="&strServer&";" & _
                "Initial Catalog=" & xdbname & _
                ";UID=" & xuserid & ";PWD=" & xpassword & ";"
  set cnn = server.createobject("adodb.connection")
  set cat = server.createobject("adox.catalog")
  set tbl = server.createobject("adox.table")
  
  cnn.Open connectstring
  If err.description <> "" then
       Response.write(" <b>Login Please </b>" & vbCrLf)
  End If
  cat.ActiveConnection = cnn
        Response.Write("<select name=""strTableName"">" & vbCrLf)
      For Each tbl In cat.Tables

        If tbl.Type = "TABLE" Then

            If tbl.Name = strTableName Then
                Response.Write("<option selected value="""&tbl.Name&""">"& tbl.Name  & "</option>" & vbCrLf)        
            Else
                Response.Write("<option value="""&tbl.Name&""">"& tbl.Name  & "</option>" & vbCrLf)
            End If

        End If                            
       Next
       Response.Write("</select>" & vbCrLf)

    set cat = nothing
    set tbl = nothing
    cnn.Close
    set cnn = nothing

End Sub

‘’   ++++++++++++++   executeSQL Sub  +++++++++++++++++

Sub executeSQL(strSQL)
Dim objConn, intRecordsAffected    
        strSQL = trim(strSQL)
        Response.Write(strSQL & "<br>")    
        Set objConn=Server.CreateObject("ADODB.Connection")
        objConn.ConnectionString = strConnect
        objConn.Open
        objConn.Execute strSQL, intRecordsAffected
        objConn.Close
        Set objConn = Nothing
        Response.Write("SQL Statement executed. " & intRecordsAffected & " record(s) affected.<br> " & vbcrlf)        
End Sub    


‘’   ++++++++++++   displayTableInfo Sub  +++++++++++++

sub displayTableInfo(xdbname, xuserid, xpassword )  

dim cnn, cat, tbl, fld

dim connectstring
  connectstring = _
                "Provider=SQLOLEDB.1;Data Source="&strServer&";" & _
                "Initial Catalog=" & xdbname & _
                ";UID=" & xuserid & ";PWD=" & xpassword & ";"
        
  set cnn = server.createobject("adodb.connection")
  set cat = server.createobject("adox.catalog")
  set tbl = server.createobject("adox.table")
  set fld = server.createobject("adox.column")
  
  cnn.Open connectstring
  
  cat.ActiveConnection = cnn
    
    Dim objProperty
    response.write("<br><b>Add table or field to query.</b>" & vbCrLf)

      Response.Write("<table border = 1 bgcolor=""Orange""><tr>" & vbCrLf)
      count = 1

      For Each tbl In cat.Tables

        If tbl.Type = "TABLE" Then
               Response.Write("<td valign=""top"">" & vbCrLf)
               Response.Write("<select  onClick=""addField(this.value)"" name="""&tbl.Name&""">" & vbCrLf)
            Response.Write("<option value="""&tbl.Name&""" selected>"& tbl.Name  & "</option>" & vbCrLf)
            For Each fld In tbl.columns
                If len(fld.name) < 16 Then
                   intSpacer = 16 - len(fld.name)
                Else
                    intSpacer = 2
                End If
                If inStr(UCase(strIdentity),UCase(tbl.name & fld.name)) Then
                   Response.Write("<option value="""&tbl.name&"."&fld.name&""">" &fld.name &  String(intSpacer,"=") & getType(fld.Type) & "</option>" & vbCrLf)
                Else
                    Response.Write("<option value="""&tbl.name&"."&fld.name&""">" &fld.name &  String(intSpacer,"_") & getType(fld.Type) & "</option>" & vbCrLf)
                End If
            Next
               Response.Write("</select>" & vbCrLf)
               If count Mod 3 = 0 Then
                     response.write("</td></tr><tr>" & vbCrLf)
              Else  
                response.write("</td>")                          
               End If  
               count = count + 1     
        End If                            
       Next
      Response.Write("</td></tr>" & vbCrLf)        
      Response.Write("<td colspan="& count &">" & vbCrLf)        
      Response.Write("<font color=red>Note: </font></b>""Identity"" fields are shown in the following fashion:" & vbCrLf)
      Response.Write("<tt>fieldName========dataType</tt><br>" & vbCrLf)        
      Response.Write("</td></tr></table>")
    set cat = nothing
    set tbl = nothing
    cnn.Close
    set cnn = nothing

end sub    


‘’   ++++++++++++++   displaySQL Sub  +++++++++++++++++

Sub displaySQL(strSQL,boolTableInfo)
Dim objConn, objRS, strFieldName, strFieldType, arrData, intRowCounter, intColCounter, strFieldValue
Dim intUBoundRow, intUBoundCol

On Error Resume Next

Set objConn=Server.CreateObject("ADODB.Connection")
objConn.ConnectionString = strConnect
objConn.Open
        Set objRS = objConn.Execute(strSQL)
        If objRS.EOF and objRS.BOF then
            Response.Write("No records matched or table is empty")
            objRS.Close
            Set objRS = Nothing
            objconn.Close
            Set objconn=Nothing
        ElseIf boolTableInfo <> "True" Then
            Response.Write("<b>" & strSQL & "</b><br>" & vbCrLf)
            Response.Write("<table border=""1"" bgcolor=""#f5e78d"">" & vbcrlf & _
                "<tr>" & vbcrlf)
            ‘’ Put Headings On The Table of Field Names
            For Each strFieldName in objRS.Fields
                Response.Write("<td bgcolor=""yellow"" align=""center""><b>" & strFieldName.name & "</b></td>" & vbcrlf)
            Next
            Response.Write("</tr>" & vbcrlf)
            ‘’ Now lets grab all the records and close objects
            arrData=objRS.Getrows
            objRS.Close
            Set objRS=Nothing
            objConn.Close
            Set objConn=Nothing
            
            intUBoundRow = UBound(arrData,2)
            intUBoundCol = UBound(arrData,1)
            
            For intRowCounter = 0 to intUBoundRow
                Response.Write("<tr>" & vbcrlf)
                
                For intColCounter = 0 to intUBoundCol

                    strFieldValue = arrdata(intcolcounter,introwcounter)

                    If isNull(strFieldValue) then
                        strFieldValue = "<NULL>"
                    Elseif trim(strFieldValue) = "" then
                        strFieldValue = "<BLANK>"
                    End if
                    Response.Write("<td valign=""top""><font size=2>" & strFieldValue  & "</font></td>" & vbcrlf)
                    If err.description <> "" Then
                       Response.Write("<td valign=""top""><font size=2> NA </font></td>" & vbcrlf)
                       Err.Clear
                    End If                    

                Next
                Response.Write("</tr>" & vbcrlf)
            Next
            Response.Write("</table>" & vbCrLf)
        End if
End Sub


‘’   ++++++++++++++   showdatabases Sub  +++++++++++++++++    

Sub showdatabases(strConnect)  
‘’ Thanks to Ken Shaefer for this function

    Dim objConn
    Dim objSchema
    Dim strCatalogueName
    Dim strCatalogue

‘’    Err.Clear
‘’    On Error Resume Next

    Const adSchemaCatalogs = 1
    Set objConn = Server.CreateObject("ADODB.Connection")
    objConn.Open strConnect
‘’    If Err.Description = "SQL Server does not exist or aclearcase/" target="_blank" >ccess denied." Then
‘’        Response.write(Err.Description & "<br>Log in Failed. Click Connect button to try again" & vbcrlf)
‘’    End If

    set objSchema=objConn.OpenSchema(adSchemaCatalogs)

    If not objSchema.EOF then

        Set strCatalogueName = objSchema("Catalog_Name")
        
        Response.Write("<select name=""choosetable"">" & vbCrLf)
        
        Do While Not objSchema.EOF

            If strCatalogueName <> "master" and strCatalogueName <> "model" and strCatalogueName <> "msdb" and strCatalogueName <> "tempdb" then
               If strDB = strCatalogueName Then
                     Response.Write("<option selected value=""" & strCatalogueName & """>" & strCatalogueName & "</option>" & vbCrLf)
               Else
                      Response.Write("<option value=""" & strCatalogueName & """>" & strCatalogueName & "</option>" & vbCrLf)
               End If
            End If
            objSchema.MoveNext
        Loop
        
        Response.Write("</select>" & vbCrLf)
        
        Call subADOClose(strCatalogue)
        Call subADOClose(objSchema)
        Call subADOClose(objConn)
        
    End If

End Sub

Sub subADOClose( _
    ByRef objToClose _
    )
    
    On Error Resume Next
    
    If objToClose.State = adStateOpen then
        objToClose.Close
    End if
    
    If isObject(objToClose) then
        Set objToClose = Nothing
    End if
    
End Sub ‘’ subADOClose

‘’   ++++++++++++++   showtables Sub  +++++++++++++++++    

sub showtables(xdbname, xuserid, xpassword, strDB )  
    
  dim connectstring
  dim cnn
  dim strTableName
  dim cat
  dim tbl
  dim ii
      
  connectstring = _
                "Provider=SQLOLEDB;Data Source="&strServer&";" & _
                "Initial Catalog=" & xdbname & _
                ";UID=" & xuserid & ";PWD=" & xpassword & ";"

  set cnn = server.createobject("adodb.connection")

  set cat = server.createobject("adox.catalog")

  set tbl = server.createobject("adox.table")
      
  cnn.Open connectstring

  cat.ActiveConnection = cnn
    
  ii = 0
  response.write("<select name=""schema"">" & vbCrLf)
    For Each tbl In cat.Tables
    
        If tbl.Type = "TABLE" Then
            ii = ii + 1
            strTableName = tbl.name
            If strDB = strTableName Then
            response.write strDB & " ... " & strTableName
                   response.write("<option selected value="""&strTableName&""">"&strTableName&"</option>" & vbCrLf)
            Else
                response.write("<option value="""&strTableName&""">"&strTableName&"</option>" & vbCrLf)
            End If
        End If
        
    Next
    response.write("</select>" & vbCrLf)
    set cat = nothing
    set tbl = nothing
    cnn.Close
    set cnn = nothing

end sub    
%>

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