Classic ASP - Draw SQL Tables

Place the following code into an include file and it will draw a table. It can display either horizontal (HTable) or vertical (VTable) and has many options as parameters. Make sure you set strconn to a valid connection i.e strConn = "Provider=MSDASQL;DSN=database;"


Const adOpenStatic = 3
Const adUseClient = 3

'///////////////////////////////////////////////////////////////
'//Function list
'///////////////////////////////////////////////////////////////
'//Draw a Vertical table
'//Function VTable(objNum,strSQL,TWidth,DisplayNames,Alignment,CellShading,Border,CellPadding,CellSpacing)
'//
'//Draw a Horizontal table
'//Function HTable(objNum,strSQL,TWidth,DisplayNames,Alignment,CellShading,Border,CellPadding,CellSpacing)
'//
'//

Function OpenDB(objNum,strConn,strSQL)

'// Create the ADO objects:
Set objConn(objNum) = Server.CreateObject("ADODB.Connection")
Set objRS(objNum) = Server.CreateObject("ADODB.Recordset")
'// Connect to the database using OLE DB:
objConn(objNum).Open strConn
'// Use a client-side cursor so we can sort later and so we can create a disconnected recordset:
objRS(objNum).CursorLocation = adUseClient
objRS(objNum).Source = strSQL
'// Use a static cursor so we can navigate freely:
objRS(objNum).CursorType = adOpenStatic
Set objRS(objNum).ActiveConnection = objConn(objNum)
'// Open the report's recordset:
objRS(objNum).Open
'// Disconnect the recordset from the connection:
Set objRS(objNum).ActiveConnection = Nothing
'// Close the connection to the database:
objConn(objNum).Close
End Function

Function HTable(objNum,strSQL,TWidth,DisplayNames,Alignment,CellShading,Border,CellPadding,CellSpacing)
if TWidth = "" then TWidth="100%"
if DisplayNames = "" then DisplayNames = "Yes"
if Alignment = "L" then Alignment = "Left"
if Alignment = "C" then Alignment = "Center"
if Alignment = "R" then Alignment = "Right"
if CellShading = "" then CellShading = "No"
if Border = "" then Border=0
if CellPadding = "" then CellPadding=0
if CellSpacing = "" then CellSpacing=0

Call OpenDB(objNum,strConn,strSQL)

If Not (objRS(objNum).BOF And objRS(objNum).EOF) Then

objRS(objNum).AbsolutePage = 1
objRS(objNum).PageSize= objRS(objNum).RecordCount
intDisplayRows = objRS(objNum).PageSize - 1
intColMax = objRS(objNum).Fields.count - 1
response.write("")
N=0

For intCol = 0 To intColMax
if Len(ObjRs(objNum).Fields(intCol).Value) > 0 then
MyName = ObjRs(objNum).Fields(intCol).Name
MyValue = ObjRs(objNum).Fields(intCol).Value

if MyValue <> "000000" then

if CellShading = "Yes" then
If (N/2)=Int(N/2) Then
response.write("")
Else
response.write("")
end if
N=N+1
else
response.write("")
end if

if DisplayNames = "Yes" then
response.write("")
response.write(ObjRs(objNum).Fields(intCol).Name)
response.write("")
end if


Select Case MyName
Case "Scheduled Date"
response.write("< align=" + Alignment + ">")
response.write(MyValue)
response.write(" (") & (WeekdayName(Weekday(MyValue))) & ")"
response.write("")
Case "AM PM"
If MyValue <> "" then
response.write("")
If MyValue="083000" Then
response.write("AM")
Else If MyValue="123000" Then
response.write("PM")
end if
end if
response.write("")
end if
Case Else
response.write("")
response.write(ObjRs(objNum).Fields(intCol).Value)
response.write("")
End Select
end if
end if
Next
response.write("")
response.write("")
else
response.write("&nb sp")
End If
ObjRS(objNum).Close
End Function

Function VTable(objNum,strSQL,TWidth,DisplayNames,Alignment,CellShading,Border,CellPadding,CellSpacing)
if TWidth = "" then TWidth="100%"
if DisplayNames = "" then DisplayNames = "Yes"
if Alignment = "L" then Alignment = "Left"
if Alignment = "C" then Alignment = "Center"
if Alignment = "R" then Alignment = "Right"
if CellShading = "" then CellShading = "No"
if Border = "" then Border=0
if CellPadding = "" then CellPadding=0
if CellSpacing = "" then CellSpacing=0

Call OpenDB(objNum,strConn,strSQL)

If Not (objRS(objNum).BOF And objRS(objNum).EOF) Then

objRS(objNum).AbsolutePage = 1
objRS(objNum).PageSize= objRS(objNum).RecordCount
intDisplayRows = objRS(objNum).PageSize - 1
intColMax = objRS(objNum).Fields.count - 1
response.write("")
N=0
if CellShading = "Yes" then
If (N/2)=Int(N/2) Then
response.write("")
Else
response.write("")
end if
N=N+1
else
response.write("")
end if


if DisplayNames = "Yes" then
For intCol = 0 To intColMax
response.write("")
response.write(ObjRs(objNum).Fields(intCol).Name)
response.write("")
next
response.write("")
else
response.write("")
end if

For intRow = 0 To intDisplayRows

if CellShading = "Yes" then
If (N/2)=Int(N/2) Then
response.write("")
Else
response.write("")
end if
N=N+1
else
response.write("")
end if

For intCol = 0 To intColMax
response.write("")
response.write(ObjRs(objNum).Fields(intCol).Value)
response.write("")
Next
response.write("")
ObjRs(ObjNum).MoveNext
Next

response.write("")
else
response.write("&nbs p")

End If
ObjRS(objNum).Close
end function


Now all you have to do is call the function and pass it some SQL and parameters and it will draw a table with the results!

Sorry for it being a bit messy but this blog isn't wide enough to display the code properly so it's a bit hard to understand. I have also had to add spaces so that the blog doesn't parse the code.

MySQL - Downloading data

So you've uploaded your binary file into the database but how do you get it? Place the following code in a function or whatever you choose:

Dim datareader As MySql.Data.MySqlClient.MySqlDataReader
Dim myConnection As New MySql.Data.MySqlClient.MySqlConnection
Dim mycommand As New MySql.Data.MySqlClient.MySqlCommand
myConnection.ConnectionString = "Server=MYSERVER;User Id=MYUSER;Password=MYPASS;Persist Security Info=True;Database=MYDATABASE"
mycommand.Connection = myConnection


mycommand.CommandText = "SELECT Document, MIMEType, FileName FROM mydb.mytable WHERE ID = 1;"
datareader = mycommand.ExecuteReader()

While datareader.Read
If datareader.Item(0).Equals(System.DBNull.Value) Then
Response.Write("")
Else
Dim FileName
Dim MIMEType
FileName = datareader.Item(2).ToString
MIMEType = datareader.Item(1).ToString
Response.Clear()
Response.AddHeader("Content-Disposition", "attachment; filename=""" & FileName & """")
Response.ContentType = MIMEType
Response.BinaryWrite(datareader.Item(0))
End If
End While

MySQL - Uploading binary data

Believe it or not, alot of people have trouble with this and it can be quite confusing but here I am again to make it easy for you all. This post will explain how to upload binary data successfully to a MySQL database and the binary data can be anything from a picture to an MP3 file.

In this example, I have a page with a FileUpload component and a button. Paste the following code into the button_click event or write a seperate function to call:

Dim myConnection As New MySql.Data.MySqlClient.MySqlConnection
myConnection.ConnectionString = "Server=MYSERVER;User Id=MYUSER;Password=MYPASS;Persist Security Info=True;Database=MYDATABASE"
myConnection.Open()
Dim mycommand As New MySql.Data.MySqlClient.MySqlCommand
mycommand.Connection = myConnection
Dim strsql
strsql = "INSERT INTO `mydb`.`mytable` (`Document` ) VALUES (?file);"
mycommand.Parameters.Add("?file", FileUpload1.FileBytes)
mycommand.CommandText = strsql
mycommand.ExecuteNonQuery()

As usual, fill out the bold text correctly. Easy huh?

ASP.NET - SQL to Excel: easy as 1, 2, 3!

Want to make some SQL generate an Excel file with formatting? easy!

What you have to understand with this example is that you must set a Session variable before calling the page. This variable (ExcelSQL) holds the SQL which will be executed when the page is called. This example is for MySQL but could easily be adapted for other database types.


Place the following code on the Page_Load event:

Dim ExcelSQL As String
ExcelSQL = Session("ExcelSQL")


If ExcelSQL <> "" Then
Dim conn As New MySql.Data.MySqlClient.MySqlConnection
Dim mycommand As New MySql.Data.MySqlClient.MySqlCommand
Dim da As New MySql.Data.MySqlClient.MySqlDataAdapter
Dim ds As New System.Data.DataSet
Dim dg As New DataGrid
Response.Clear()
Response.Charset = ""
Response.ContentType = "application/vnd.ms-excel"
Dim stringWrite As New System.IO.StringWriter
Dim htmlWrite As New System.Web.UI.HtmlTextWriter(stringWrite)

conn.ConnectionString = "Server=MYSERVER;User Id=MYUSER;Password=MYPASS;Persist Security Info=True;Database=MYDATABASE"

conn.Open()
mycommand.Connection = conn
mycommand.CommandText = ExcelSQL
da.SelectCommand = mycommand
da.Fill(ds)
dg.DataSource = ds.Tables(0)
dg.DataBind()
'//set how it should look
dg.HeaderStyle.Font.Bold = True
dg.HeaderStyle.HorizontalAlign = HorizontalAlign.Center
dg.HeaderStyle.BackColor = Drawing.Color.LightSkyBlue
'//write file
dg.RenderControl(htmlWrite)
Dim FileName
FileName = "Results.xls"
Response.AddHeader("Content-Disposition", "attachment; filename=""" & FileName & """")
Response.Write(stringWrite.ToString)
Response.End()

conn.Close()
Else
'//no data in table, do nothing
Response.Write("")
End If

Be sure to set the connection string correctly (highlighted in bold) and to set the session variable correctly by doing the following BEFORE you call the page, for example:

Session("ExcelSQL") = "SELECT * FROM MyTable WHERE ID > 0;"

ASP.NET - Totals on a GridView

So you have lots of numeric data on a GridView and you would like to show totals in the footer? Here's how:

First of all, place the following at the top of the .vb file, under the Imports ...:

Dim MyTotal(100) as Decimal

Secondly, place the following within the GridView1.RowDataBound event:

On Error Resume Next
Dim i

If e.Row.RowType = DataControlRowType.DataRow Then
For i = 0 To e.Row.Cells.Count - 1
mytotal(i) += Convert.ToDecimal(DataBinder.Eval(e.Row.DataItem, gv1.HeaderRow.Cells(i).Text))
Next
ElseIf e.Row.RowType = DataControlRowType.Footer Then
e.Row.Cells(0).Text = "Totals:"

For i = 1 To e.Row.Cells.Count - 1
If mytotal(i) <> 0 Then
' for the Footer, display the running totals
e.Row.Cells(i).Text = mytotal(i).ToString("f")
e.Row.Cells(i).HorizontalAlign = HorizontalAlign.Right
End If
Next
e.Row.Font.Bold = True
End If

But my GridView is sortable and it won't work! In this case, use the following:

On Error Resume Next
Dim i
If e.Row.RowType = DataControlRowType.DataRow Then
For i = 0 To e.Row.Cells.Count - 1
Dim lnkBtnText As String = CType(GridView1.HeaderRow.Cells(i).Controls(0), LinkButton).Text
MyTotal(i) += Convert.ToDecimal(DataBinder.Eval(e.Row.DataItem, lnkBtnText))
If MyTotal(i) = "" Then
MyTotal(i) += Convert.ToDecimal(DataBinder.Eval(e.Row.DataItem, GridView1.HeaderRow.Cells(i).Text))
End If

Next
End If

If e.Row.RowType = DataControlRowType.Footer Then
e.Row.Cells(0).Text = "Totals"
For i = 1 To e.Row.Cells.Count - 1
If MyTotal(i) <> 0 Then
' for the Footer, display the running totals
e.Row.Cells(i).Text = MyTotal(i).ToString("f")
e.Row.Cells(i).HorizontalAlign = HorizontalAlign.Right
End If
Next
e.Row.Font.Bold = True
End If
End Sub

MySQL - Double values return too many decimal places!

Ok, you may have a double value stored in a MySQL table of say "94.2348723". The problem is, this can look silly when displaying the data in a table and causes columns to be far too wide. Imagine the "94.2348723" as a price, so we would like to return "94.23" by editing the SQL statement, here's how:

Let's say the value is stored in a column "Price" like so:

ItemNo | Price
-------------------
1                94.2348723
2                83.3821974

To round the figures correctly in MySQL, use the following:

SELECT `ItemNo`, Truncate(SUM(`Price`) + 0.0051,2) AS Price

It should now be correctly rounded to 2 decimal places!

Classic ASP - File Information

Paste the following code into an include file and use the GetFileAttribute function to return the attribute of that file, simple eh?

<%
'//Attribute List
'//==============
'// Windows 2000
'// ------------
'// Name, Size, Type, Modified, Attributes,
'// Comments, Created, Accessed, Owner, Author,
'// Title, Subject, Category, Pages, Copyright,
'// CompanyName, ModuleDescription, ModuleVersion,
'// ProductName, ProductVersion, SenderName, RecipientName,
'// RecipientNumber, CSID, TSID, TransmissionTime,
'// CallerID, Routing, AudioFormat, SampleRate,
'// AudioSampleSize, AudioChannels, PlayLength,
'// FrameCount, FrameRate, VideoSampleSize,
'// VideoCompression
'//
'// Win XP/2003
'// -----------
'// Name, Size, Type, Modified, Created, Accessed
'// Attributes, Status, Owner, Author, Title, Subject
'// Category, Pages, Comments, Copyright, Artist,
'// AlbumTitle, Year, TrackNumber, Genre, Duration,
'// BitRate, Protected, CameraModel, PictureDate,
'// Dimensions, Company, Description, Version,
'// ProductName, ProductVersion


function GetFileAttribute(filename, attribute)
dim srv, attrib
attrib = "error"
srv = Request.ServerVariables("SERVER_SOFTWARE")
if instr(srv,"/5.0")>0 then
'//Windows 2000 Machine
select case attribute
case "Name"
attrib = 0
case "Size"
attrib = 1
case "Type"
attrib = 2
case "Modified"
attrib = 3
case "Attributes"
attrib = 4
case "Comments"
attrib = 5
case "Created"
attrib = 6
case "Accessed"
attrib = 7
case "Owner"
attrib = 8
case "Author"
attrib = 10
case "Title"
attrib = 11
case "Subject"
attrib = 12
case "Category"
attrib = 13
case "Pages"
attrib = 14
case "Copyright"
attrib = 15
case "CompanyName"
attrib = 16
case "ModuleDescription"
attrib = 17
case "ModuleVersion"
attrib = 18
case "ProductName"
attrib = 19
case "ProductVersion"
attrib = 20
case "SenderName"
attrib = 21
case "RecipientName"
attrib = 22
case "RecipientNumber"
attrib = 23
case "CSID"
attrib = 24
case "TSID"
attrib = 25
case "TransmissionTime"
attrib = 26
case "CallerID"
attrib = 27
case "Routing"
attrib = 28
case "AudioFormat"
attrib = 29
case "SampleRate"
attrib = 30
case "AudioSampleSize"
attrib = 31
case "AudioChannels"
attrib = 32
case "PlayLength"
attrib = 33
case "FrameCount"
attrib = 34
case "FrameRate"
attrib = 35
case "VideoSampleSize"
attrib = 36
case "VideoCompression"
attrib = 37
end select

elseif instr(srv,"/5")>0 or instr(srv,"/6")>0 then
'//Windows XP/2003
select case attribute
case "Name"
attrib = 0
case "Size"
attrib = 1
case "Type"
attrib = 2
case "Modified"
attrib = 3
case "Created"
attrib = 4
case "Accessed"
attrib = 5
case "Attributes"
attrib = 6
case "Status"
attrib = 7
case "Owner"
attrib = 8
case "Author"
attrib = 9
case "Title"
attrib = 10
case "Subject"
attrib = 11
case "Category"
attrib = 12
case "Pages"
attrib = 13
case "Comments"
attrib = 14
case "Copyright"
attrib = 15
case "Artist"
attrib = 16
case "AlbumTitle"
attrib = 17
case "Year"
attrib = 18
case "TrackNumber"
attrib = 19
case "Genre"
attrib = 20
case "Duration"
attrib = 21
case "BitRate"
attrib = 22
case "Protected"
attrib = 23
case "CameraModel"
attrib = 24
case "PictureDate"
attrib = 25
case "Dimensions"
attrib = 26
case "Company"
attrib = 30
case "Description"
attrib = 31
case "Version"
attrib = 32
case "ProductName"
attrib = 33
case "ProductVersion"
attrib = 34
end select
end if

if IsNumeric(attrib) then
sFolder = left(filename,instrRev(filename,"\"))
sFile = right(filename, len(filename)-instrRev(filename,"\"))
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.NameSpace(sFolder)
Set oFolderItem = oFolder.ParseName(sFile)
sInfo = oFolder.GetDetailsOf(oFolderItem, attrib)
If sInfo="" Then
GetFileAttribute=" "
Else
GetFileAttribute=sInfo
End If
else
GetFileAttribute=" "
end if

end function
%>

As an example, do the following:

GetFileAttribute(C:\myfile.txt, Created)

Welcome

I have been meaning to create a blog for a long time and I have finally got around to it. I will mainly be talking about Web development, programming, cars and my personal life. Hopefully you will all find something useful here and if you have any questions regarding any code posted here, please leave a comment and I shall try my best to answer.

In the programming posts I will mainly be covering VB (Visual Basic)/ASP/ASP.NET/MySQL, I may also have a few posts about Swyx (VOIP) and its SDK but this is undecided yet. I will also be covering aspects of all modern MS Windows versions relating to domains and registry etc...

I know there are probably hundreds of these about and what should make mine so special? Well in all honesty I don't know, other than the code I post here may help you or I try and help you resolve any issues. If nobody posts any comments here then I guess I will just use it as a personal reference but I hope you all start to contribute here.

Enjoy!