Chào ngày mới !: ASP

Hiển thị các bài đăng có nhãn ASP. Hiển thị tất cả bài đăng

Thứ Tư, 18 tháng 11, 2015

ASP, ReadExcelClass

<%
'###########################################################################################################################
'    Thaihn, 15-11-2015
'###########################################################################################################################
' fileName = "aaaaaa.xls"
' file = Server.MapPath(fileName)

' dim ec
' set ec = new ReadExcelClass
' set rs = ec.SetDebug(true).File(file).SetWorkSheetIndex(0).SetPageSize(10)

' for i = 1 to ec.TotalPage()
    ' for j = 1 to ec.Page(i).RowsPerPage()
        ' line = (i - 1) * ec.PageSize + j
        ' Response.Write "
("&i&","&j&")"& line  &": "& ec.Cell(j, "Contract")
    ' next
 
    ' Response.Write "
============================================================================================"
' next 
' ec.Close()
'###########################################################################################################################

class ReadExcelClass
    private objConnection
    private objCatalog
    private objRecordset
    private pFile
    private pWorkSheets()
    private pWorkSheet
    private pQuery
    private pKeys()
    private pTotalRecords
    private pPageSize
    private pPage
 

    private adOpenStatic
    private adLockOptimistic
    private adCmdText
 
    private debug
 
    function File(sFile)
        pFile = sFile
     
        ' pConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="& file &";Extended Properties=""Excel 8.0;HDR=Yes;""" ' 2007, .xlsx, can write
        pConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="& pFile &";Extended Properties=""Excel 8.0;HDR=Yes;"";" ' 2003, .xls, can write
        ' pConnection = "DRIVER={Microsoft Excel Driver (*.xls)};DriverId=790;DBQ="& pFile &";" ' read only
     
        Set objConnection = CreateObject("ADODB.Connection")
        objConnection.Open pConnection
     
        GetAllWorkSheet()
     
        set File = me
    end function
 
    function GetAllWorkSheet()
        dim i
     
        set objCatalog = Server.CreateObject("ADOX.Catalog")
        objCatalog.activeConnection = objConnection
     
        ReDim Preserve pWorkSheets( objCatalog.Tables.Count - 1 )
     
        for i = 0 to objCatalog.Tables.Count - 1
            pWorkSheets(i) = Left(objCatalog.Tables(i).Name, Len(objCatalog.Tables(i).Name) - 1)
        next
     
        set objCatalog = nothing
    end function
 
    function SetWorkSheet(sWorkSheet)
        pWorkSheet = sWorkSheet
     
        ' GetKeys()
     
        ' pQuery = "Select "& pKeys(0) &" FROM ["& pWorkSheet &"$]"
        ' objRecordset.Open pQuery, objConnection, adOpenStatic, adLockOptimistic, adCmdText
        ' pTotalRecords = objRecordset.RecordCount
        if objRecordset.State = 1 then objRecordset.Close
     
        pQuery = "Select * FROM ["& pWorkSheet &"$]"
        Trace "pQuery", pQuery
        objRecordset.Open pQuery, objConnection, adOpenStatic, adLockOptimistic, adCmdText
     
        set SetWorkSheet = me
    end function 
 
    function SetWorkSheetIndex(index)
        ' Trace "pWorkSheets("&index&")", pWorkSheets(index)
        SetWorkSheet pWorkSheets(index)
     
        set SetWorkSheetIndex = me
    end function 
 
    function GetKeys()
        dim i
     
        pQuery = "Select top 1 * FROM ["& pWorkSheet &"$]"
        objRecordset.Open pQuery, objConnection, adOpenStatic, adLockOptimistic, adCmdText
        objRecordset.Close
     
        ReDim Preserve pKeys( objRecordset.Fields.Count - 1 )
     
        for i = 0 to objRecordset.Fields.Count - 1
            pKeys(i) = objRecordset.Fields(i).Name
        next
     
        set GetKeys = me
    end function
 
    function SetPageSize(iPageSize)
        pPageSize = iPageSize
     
        set SetPageSize = me
    end function
 
    function PageSize()
        PageSize = pPageSize
    end function
 
    function Page(iPage)
        pPage = iPage     
     
        Trace "Page", iPage
     
        set Page = me
    end function
 
    function TotalPage()
        TotalPage = int(objRecordSet.RecordCount / pPageSize) + 1
        Trace "TotalPage", TotalPage
    end function
 
    function RowsPerPage()
        if pPage < TotalPage then
            RowsPerPage = pPageSize
        else
            RowsPerPage = objRecordSet.RecordCount - (pPageSize * (pPage - 1))
        end if
     
        Trace "RowsPerPage", RowsPerPage
    end function
 
    function Cell(row, col)
        dim record
     
        record = (pPage-1) * pPageSize + (row - 1)
        Trace "record", record
     
        Trace "Cell", record
        objRecordSet.Move record, 1
     
        on error resume next
            Cell = objRecordset.Fields(col)
            if err.number <> 0 then
                on error goto 0
                err.raise 1, "Cell error", "row = "& row &", col = "& col
            end if
        on error goto 0
    end function
 
    function Row(index)
        dim record
     
        record = (pPage-1) * pPageSize + (row - 1)     
        objRecordSet.Move record, 1
     
        set Row = objRecordset
    end function
 
    function RowIndex(i, j)
        RowIndex = (i - 1) * PageSize + j
    end function
 
    function GetRecords()
        set GetRecords = objRecordset
    end function
     
    function SetDebug(value)
        debug = value
        set SetDebug = me
    end function 
 
    function Trace(name, value)
        if debug then Response.Write "--> "& name &" = "& value &""
        set Trace = me
    end function
 
 
    function Close()
        set objRecordset = nothing
        ' set objCatalog = objCatalog
        objConnection.Close
        set objConnection = nothing
    end function
 
    Private Sub Class_Initialize()
        debug = false
        adOpenStatic = 3
        adLockOptimistic = 3
        adCmdText = &H0001
     
        Set objConnection = CreateObject("ADODB.Connection")
        Set objRecordSet = CreateObject("ADODB.Recordset")
    End Sub
 
    Private Sub Class_Terminate()
    End Sub
end class


'================================================================================
Function ReadExcel( myXlsFile, mySheet, my1stCell, myLastCell, blnHeader )
' http://www.robvanderwoude.com/vbstech_databases_excel.php
' Function :  ReadExcel
' Version  :  3.00
' This function reads data from an Excel sheet without using MS-Office
'
' Arguments:
' myXlsFile   [string]   The path and file name of the Excel file
' mySheet     [string]   The name of the worksheet used (e.g. "Sheet1")
' my1stCell   [string]   The index of the first cell to be read (e.g. "A1")
' myLastCell  [string]   The index of the last cell to be read (e.g. "D100")
' blnHeader   [boolean]  True if the first row in the sheet is a header
'
' Returns:
' The values read from the Excel sheet are returned in a two-dimensional
' array; the first dimension holds the columns, the second dimension holds
' the rows read from the Excel sheet.
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
    Dim arrData( ), i, j
    Dim objExcel, objRS
    Dim strHeader, strRange

    Const adOpenForwardOnly = 0
    Const adOpenKeyset      = 1
    Const adOpenDynamic     = 2
    Const adOpenStatic      = 3

    ' Define header parameter string for Excel object
    If blnHeader Then
        strHeader = "HDR=YES;"
    Else
        strHeader = "HDR=NO;"
    End If

    ' Open the object for the Excel file
    Set objExcel = CreateObject( "ADODB.Connection" )
    ' IMEX=1 includes cell content of any format; tip by Thomas Willig.
    ' Connection string updated by Marcel Niënkemper to open Excel 2007 (.xslx) files.
    objExcel.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
                  myXlsFile & ";Extended Properties=""Excel 12.0;IMEX=1;" & _
                  strHeader & """"

    ' Open a recordset object for the sheet and range
    Set objRS = CreateObject( "ADODB.Recordset" )
    strRange = mySheet & "$" & my1stCell & ":" & myLastCell
    objRS.Open "Select * from [" & strRange & "]", objExcel, adOpenStatic

    ' Read the data from the Excel sheet
    i = 0
    Do Until objRS.EOF
        ' Stop reading when an empty row is encountered in the Excel sheet
        If IsNull( objRS.Fields(0).Value ) Or Trim( objRS.Fields(0).Value ) = "" Then Exit Do
        ' Add a new row to the output array
        ReDim Preserve arrData( objRS.Fields.Count - 1, i )
        ' Copy the Excel sheet's row values to the array "row"
        ' IsNull test credits: Adriaan Westra
        For j = 0 To objRS.Fields.Count - 1
            If IsNull( objRS.Fields(j).Value ) Then
                arrData( j, i ) = ""
            Else
                arrData( j, i ) = Trim( objRS.Fields(j).Value )
            End If
        Next
        ' Move to the next row
        objRS.MoveNext
        ' Increment the array "row" number
        i = i + 1
    Loop

    ' Close the file and release the objects
    objRS.Close
    objExcel.Close
    Set objRS    = Nothing
    Set objExcel = Nothing

    ' Return the results
    ReadExcel = arrData
End Function
%>

Thứ Năm, 3 tháng 5, 2012

Why won't QueryString values work with Server.Execute / Server.Transfer?

The Server.Execute and Server.Transfer commands are fairly useful replacements for #includes. However, as many people have pointed out, if you use a QueryString value, you receive this error:

Server object error 'ASP 0235 : 80004005'
Server.Transfer Error
/.asp, line
Invalid URL form or fully-qualified absolute URL was used. Use relative URLs.

Server object error 'ASP 0231 : 80004005'
Server.Execute Error
/.asp, line
Invalid URL form or fully-qualified absolute URL was used. Use relative URLs.

Even when your URL *IS* relative (removing the QueryString value makes the page function properly).

Unfortunately, Microsoft has yet to recognize this officially as a bug. So in the meantime, you must rely on session variables or database entries to retrieve any information you would like to pass to the target page.

However, keep in mind that if you had QueryString values coming in to the calling page, you can access those without difficulty in the target page. So as an example, let's say a.asp calls b.asp, and a.asp was called with a.asp?x=1&y=2:

<%
' a.asp
Server.Execute("b.asp")
%>

<%
' b.asp
Response.Write(Request.QueryString("x"))
Response.Write("
")
Response.Write(Request.QueryString("y"))
%>

You will see the results printed in the browser, because b.asp still has access to the ServerVariables context.

If you really need to pass *new* QueryString information into b.asp and you can't change that file or change the call to a.asp to include that new information, you can make a.asp redirect to itself with the new information. A simple logic tree will ensure that you only suffer the hit when the new information is not included.

<%
' a.asp
if Request.QueryString("foo") = "" then
Response.Redirect "a.asp?foo=bar"
else
Server.Execute("b.asp")
end if
%>

<%
' b.asp
Response.Write(Request.QueryString("foo"))
%>

You could also do this using a new go-between page instead of adding logic to a.asp.

(http://classicasp.aspfaq.com/general/why-won-t-querystring-values-work-with-server-execute/server-transfer.html)

How do I make my ASP page pause or 'sleep'?

There is a free component that will help you do this; it is called WaitFor 1.0 and is available at ServerObjects Inc.

If you are using SQL Server (or have access to one), you can try out the following script (adapted from a post by Pierre W):

<%

Set conn = CreateObject("ADODB.Connection")
conn.Open ""

' indicate a number of seconds, up to 59
sleep = 10

' make sure timeout doesn't expire!
conn.commandTimeout = sleep + 5

' if you neede more than 59 seconds, you will need to adjust the SQL:
sql = "WAITFOR DELAY '00:00:" & right(clng(sleep),2) & "'"

Response.Write(now & "")
conn.Execute sql,,129
Response.Write(now & "
")

conn.close: Set conn = Nothing
%>

Some people will suggest a loop like this:

<%
Response.Buffer = true

Function WaitFor(SecDelay,ShowMsg)
timeStart = Timer()
timeEnd = timeStart + SecDelay

Msg = "Timer started at " & timeStart & "
"
Msg = Msg & "Script will continue in "

i = SecDelay
Do While timeStart < timeEnd
If i = Int(timeEnd) - Int(timeStart) Then
Msg = Msg & i
If i <> 0 Then Msg = Msg & ", "
If ShowMsg = 1 Then Response.Write Msg
%>

<% Response.Flush() %>

<%
Msg = ""
i = i - 1
End if
timeStart = Timer()
Loop
Msg = "...
Slept for " & SecDelay & " seconds (" & _
Timer() & ")"
If ShowMsg = 1 Then Response.Write Msg
End Function

Call WaitFor(20,0)
Call WaitFor(3,1)
%>

This is BAD, BAD news. If you can't immediately see why this is a problem, run it and watch task manager:

Look at the page faults, and look at the CPU usage for w3wp.exe. And this is on a dual-processor workstation; it literally pegs a single-CPU server at 99% running through that loop.

(http://classicasp.aspfaq.com/general/how-do-i-make-my-asp-page-pause-or-sleep.html)

How do I read the contents of a remote web page?

You can include static txt and HTML files from remote servers by using a component (such as AspHTTP, ASPTear 1.50, or VB's built in InetCtrls) to parse the remote URL's content.

You can also try this method out; it was tested with the MSXML objects which are installed with Windows 2000. You should make sure you have the latest versions of MSXML and XML Core Services (see MSXML Downloads). If you download the newer version, take special note of the new ProgID you should be using -- MSXML 4.0 now supports side-by-side installation, which means the ProgID below will actually use the older version.

<%
url = "http://www.espn.com/main.html"
set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlhttp.open "GET", url, false
xmlhttp.send ""
Response.write xmlhttp.responseText
set xmlhttp = nothing
%>

And here it is in JavaScript:

If you use a URL that doesn't exist, or you are behind a firewall that blocks certain web sites, or the site is behind a firewall that blocks traffic to port 80 / 443, or you are using a proxy server, or the site requires authentication, you will receive this error:

msxml4.dll (0x80072EE7)
Server name or address could not be resolved

To correct, you will have to figure out which of the issue(s) is standing in your way, and discuss workarounds with your or their network administrator(s).

Don't forget that if your remote page has relative image URLs, or style sheets, or JavaScript files, or frames, or links, it won't work perfectly when ported to your server(s). To overcome this, you'll want to add a BASE HREF tag to keep all the images coming from the correct location. For example, the above code (which gets all the text from espn.com, but is formatted weird and doesn't function 100% as intended), is modified only slightly to work correctly:

<%
url = "http://www.espn.com/main.html"

' add a BASE HREF tag
Response.write ""

set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlhttp.open "GET", url, false
xmlhttp.send ""
Response.write xmlhttp.responseText
set xmlhttp = nothing
%>

For information on increasing or decreasing the time allowed for the XMLHTTP objects to retrieve a response from a remote server, see Article #2407.

If you need to POST data you can so by adding a header that tells the receiver you're sending FORM data:

<%
url = "http://www.espn.com/main.html"
set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlhttp.open "POST", url, false
xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xmlhttp.send "x=1&y=2"
Response.write xmlhttp.responseText
set xmlhttp = nothing
%>

Another thing you may want to do, going back to the original script, is make sure the server is there! If not, you can display a message... and you can customize it to display whether the server was not found at all, or if the server was found but you got a bad response (e.g. a 404 Page Not Found). Note that if you do not need to parse the content of the remote web page, that using the HEAD method here is far more efficient than using GET or POST... since only the headers are retrieved from the remote server, not any of the content.

<%
' deliberate typo:
url = "http://www.espn.co/main.html"

set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
on error resume next
xmlhttp.open "HEAD", url, false
xmlhttp.send ""
status = xmlhttp.status
if err.number <> 0 or status <> 200 then
if status = 404 then
Response.Write "Page does not exist (404)."
elseif status >= 401 and status < 402 then
Response.Write "Access denied (401)."
elseif status >= 500 and status <= 600 then
Response.Write "500 Internal Server Error on remote site."
else
Response.write "Server is down or does not exist."
end if
else
Response.Write "Server is up and URL is available."
end if
set xmlhttp = nothing
%>

You might want to parse the results, instead of sending them straight to the client:

<%
url = "http://www.espn.com/main.html"
set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
on error resume next
xmlhttp.open "GET", url, false
xmlhttp.send ""
if err.number <> 0 then
response.write "Url not found"
else
if instr(xmlhttp.responseText,"Stanley Cup")>0 then
response.write "There's a story about the playoffs."
response.write "Go there?"
else
response.write "There is no story about the playoffs."
end if
end if
set xmlhttp = nothing
%>

You may be interested in performing an asynchronous request, e.g. hitting an ASP page that acts like a batch file that gets fired but does not need to return any results. You can simply change the third parameter of the open call to TRUE (and leave out the reference to the responseText value):

<%
url = "http://www.espn.com/main.html"
set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlhttp.open "GET", url, true
xmlhttp.send ""
set xmlhttp = nothing
%>

Finally, you may want to spoof your user agent, since the MSXML object sends something like "Mozilla/4.0 (compatible; Win32; WinHttp.WinHttpRequest.5)" -- many sites will view this as a spider or 'screen scraper', and for various reasons, might present alternate content -- here are two samples:

<%
url = "http://www.espn.com/main.html"

' this sample posts as the actual browser being used:

br = Request.ServerVariables("HTTP_USER_AGENT")
set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
on error resume next
xmlhttp.open "GET", url, false
xmlhttp.setRequestHeader "User-Agent",br
xmlhttp.send ""
if err.number <> 0 then
response.write "Url not found"
else
response.write xmlhttp.responseText
end if
set xmlhttp = nothing

' this sample posts as "My funky browser."

set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
on error resume next
xmlhttp.open "GET", url, false
xmlhttp.setRequestHeader "User-Agent","My funky browser."
xmlhttp.send ""
if err.number <> 0 then
response.write "Url not found"
else
response.write xmlhttp.responseText
end if
set xmlhttp = nothing
%>

If you encounter errors... you can use ParseError to determine the problem.

<%
set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
' ... stuff ...
on error resume next
xmlhttp.send ""
if err.number <> 0 then
response.write "Error: " & xmlhttp.parseError.URL & _
"
" & xmlhttp.parseError.Reason
response.end
end if
' ... stuff ...
%>

A common error you might receive:

msxml3.dll error '80072efd'
A connection with the server could not be established

Make sure that the URL is actually reachable. You may have spelled the domain name wrong, or the site may actually be down.

Test using a browser from that machine, or simply running a tracert / ping. Note that ping won't always return results, because many sites block all such traffic (mainly to help eliminate DOS attacks). However, ping should at least let you know the IP address, which means that the domain name was resolved correctly through DNS. Otherwise, it might be that your DNS server is preventing connection.
(http://classicasp.aspfaq.com/general/how-do-i-read-the-contents-of-a-remote-web-page.html)

Can I create an array's size dynamically?

VBScript's arrays have quite a few limitations. You may have noticed if you try this:

<%
x = 15
Dim demoArray(x)
%>

You get this error:

Microsoft VBScript compilation (0x800A0402)
Expected integer constant

To work around this, you need to declare the array without a size (or with a constant size, e.g. 0), and then re-dimension it from the variable. Here are two examples; one using a simple array, the other a multi-dimensional array:

<%
x = 15
Dim demoArray()
ReDim demoArray(x)
%>

<%
x = 15
y = 10
Dim demoArray()
ReDim demoArray(x,y)
%>

Note that if you want to increase the size of an array within a loop, and want to preserve the existing values assigned to the array, you need to use the Preserve keyword (otherwise, the array gets erased and re-created, thus destroying all your values):

<%
Dim demoArray()
for i = 1 to 5
ReDim Preserve demoArray(i)
DemoArray(i) = "test" & i
next
%>

(http://classicasp.aspfaq.com/general/can-i-create-an-array-s-size-dynamically.html)

Thứ Sáu, 16 tháng 12, 2011

ASP: Working with multiple Recordset

sSQL = "SELECT categoryId, categoryName FROM Categories WHERE categoryId > 3"

sSQL = sSQL & ";SELECT RegionId , RegionDescription FROM Region"

sSQL = sSQL & ";SELECT ShipperID, CompanyName, Phone FROM Shippers"

set oRS = Server.CreateObject("ADODB.Recordset")
oRs.Open sSQL, sConnectString

Do While Not oRs.EOF
   '......some processing here       
   oRs.MoveNext
Loop

'To set the next Recordset to the same Recordset (encouraged)
Set oRS = oRS.NextRecordset()

'To set the next Recordset to some other Recordset object, in order
'to still be able to access the contents of oRS
Set oSomeOtherRS = oRS.NextRecordset()

(http://www.4guysfromrolla.com/webtech/083101-1.shtml)

Thứ Ba, 13 tháng 12, 2011

ASP: ServerVariables

<%

for each name in Request.ServerVariables

    Response.Write name & ": " & Request.ServerVariables(name) & "<br>"

next

%>

HTTP_REFERER

(http://developer.earthskater.net/aspservervariables.asp)

Thứ Bảy, 26 tháng 11, 2011

ASP: Send mail using CDO

smtpserver = "smtp.gmail.com"

youremail = "xxx@gmail.com"

yourpassword = "xxx"

Dim ObjSendMail

Set ObjSendMail = CreateObject("CDO.Message")

Đọc thêm »

Thứ Tư, 2 tháng 11, 2011

ASP: Check Email

Function IsValidEmail(myEmail)
  dim isValidE
  dim regEx
  isValidE = True
  set regEx = New RegExp
  regEx.IgnoreCase = False
  regEx.Pattern = "^[a-zA-Z][\w\.-]*[a-zA-Z0-9]@[a-zA-Z0-9][\w\.-]*[a-zA-Z0-9]\.[a-zA-Z][a-zA-Z\.]*[a-zA-Z]$"
  isValidE = regEx.Test(myEmail)
  isValidEmail = isValidE
End Function

(http://www.codekeep.net/snippets/67a731c5-6499-4c78-a726-1dd85e4fc433.aspx)

Thứ Hai, 31 tháng 10, 2011

ASP: Validating User Input to Avoid Attacks

  If ValidateInput(MyUrl) Then   
    Response.Redirect (myURL) 
  Else 
    Response.Write("URL was invalid.") 
  End If 

  Function ValidateInput(sInput) 
    Dim reValid 
    Set reValid = New RegExp 

    reValid.Pattern = "^[\w\.:\?&=/]*$" 
    reValid.MultiLine = False 
    reValid.Global = True 

    ValidateInput = reValid.Test(sInput) 
  End Function

(http://msdn.microsoft.com/en-us/library/ms525361%28v=vs.90%29.aspx)

ASP: Removing Harmful Characters from User Input

  Response.Write("Hello, " & RemoveBadCharacters(Request.Form("UserName"))) 
  Response.Write("<BR>This is why you received an error:") 

  Function RemoveBadCharacters(strTemp) 
    Dim regEx 
    Set regEx = New RegExp 
    regEx.Pattern = "[^A-Za-z0-9_ ]" 
    regEx.Global = True 
    RemoveBadCharacters = regEx.Replace(strTemp, "") 
  End Function

(http://msdn.microsoft.com/en-us/library/ms526004%28v=VS.90%29.aspx)

Thứ Sáu, 28 tháng 10, 2011

Connection Strings

(http://www.carlprothman.net/Default.aspx?tabid=81)

ASP: Connect to MySQL

MySQL is a perfect database solution for small to medium websites. If your backend MySQL database is well optimized and properly structured it can serve thousands of visitors daily, without degrading your server performance. In this article I'll show you how to connect to MySQL database from ASP. You will have to install MySQL ODBC Driver-MyODBC 3.51 if you don't have it on your server yet. You can download it here: http://www.mysql.com/downloads/api-myodbc-3.51.html

<%
Dim sConnection, objConn , objRS

sConnection = "DRIVER={MySQL ODBC 3.51 Driver}; SERVER=localhost; DATABASE=Your_Mysql_DB; UID=mysql_username;PASSWORD=mysql_password; OPTION=3"

Set objConn = Server.CreateObject("ADODB.Connection")

objConn.Open(sConnection)

Set objRS = objConn.Execute("SELECT FirstName, LastName FROM tblUsers")

While Not objRS.EOF
Response.Write objRS.Fields("LastName") & ", " & objRS.Fields("FirstName") & "<br>"
Response.Write & " "
objRS.MoveNext
Wend

objRS.Close
Set objRS = Nothing
objConn.Close
Set objConn = Nothing
%>

(http://www.aspdev.org/asp/asp-mysql-connect/)

ASP: Eval() and Execute()

Microsoft has released 2 very useful functions with Microsoft Visual Basic Scripting Edition 5.0, namely Eval() and Execute() functions. We will compare those 2 functions and give examples of their use in this article.

The Eval() VBScript function evaluates an expression and returns the result. Consider the following line of VBScript code:

Var1 = Var2

You can interpret this statement in 2 completely different ways. The first one is "the value of Var2 is assigned to Var1” and the second one is "Var1 is compared to Var2”. The Eval() VBScript function always uses the second interpretation and returns Boolean value - True or False. For example consider the following ASP code:

<%
Var1 = 1
Var2 = 2
Response.Write(Eval("Var1 = Var2 + 1")) ' Prints False
Response.Write(Var1) ' Prints 1, even after the Eval() function execution on the previous line
Response.Write(Eval("Var1 = Var2 - 1")) ' Prints True
%>

The Execute() VBScript function uses the first interpretation we talked about earlier, which actually evaluates the expression parameter. For example the following ASP/VBScript code will print 5 in the browser:

<%
Var1 = 1
Var2 = 2
Execute("Var1 = Var2 + 3")
Response.Write (Var1) ' Prints 5
%>

(http://www.aspdev.org/asp/asp-eval-execute/)

Thứ Hai, 24 tháng 10, 2011

ASP: Write file utf8


Sub LogEvent(message, filename)
    sDate = Now()
 
 'filename
 if filename <> "" then
  filename = filename & "_" & year(sDate)&month(sDate)&day(sDate)
 else
  filename = year(sDate)&month(sDate)&day(sDate)
 end if
 filename = server.mappath(".") & "/log/" & filename
 
 'check file exists
 Set fs = CreateObject("Scripting.FileSystemObject")
 If fs.FileExists(filename) Then
  modeFile = 2
 else
  modeFile = 1
 end if
 set fs = nothing
 
 'write file
 Set objStream = server.CreateObject("ADODB.Stream")
 objStream.Open 
 objStream.CharSet = "UTF-8"
 
 if modeFile = 2 then 
  objStream.LoadFromFile filename
  objStream.ReadText
 end if
 
 objStream.WriteText(sDate & vbTab & message & vbNewLine)

 objStream.SaveToFile filename , modeFile
 objStream.Close
 set objStream = nothing
End Sub

(http://gchandra.wordpress.com/2004/08/19/creating-utf-8-files-using-asp/, http://www.w3schools.com/ado/ado_ref_stream.asp)

Thứ Hai, 13 tháng 6, 2011

Calling a .NET web service from classic ASP

function test(sHo, sTen)
 postUrl = "http://localhost/MyService.asmx/Hello"
 DataToSend="sHo=" & sHo & "&sTen=" & sTen
 
 Dim xmlhttp
 Set xmlhttp = server.Createobject("MSXML2.XMLHTTP")
 xmlhttp.Open "POST",postUrl,false
 xmlhttp.setRequestHeader "Content-Type","application/x-www-form-urlencoded"
 xmlhttp.send DataToSend
 
 Set xml = Server.CreateObject("Microsoft.XMLDOM")
 xml.async = False
 xml.load (xmlhttp.responseXML)

 if xml.parseError.errorcode <> 0 then
  Response.Write("Load xml error.")
  Response.End()
 end if
 
 test = xml.documentElement.childNodes(0).text
 
 set xmlhttp = nothing
 set xml = nothing
end function

(Nguồn: http://dev.meotom.net/2009/10/16/Goi-XML-Web-Service-tu-ASP-215)

Thứ Tư, 1 tháng 6, 2011

ASP read, write file


function GetFileContent(strFilePath)
 strContent = ""
 Set fso = Server.CreateObject("Scripting.FileSystemObject")
 
 if not fso.FileExists(strFilePath) then
  Response.Write("Error: " & strFilePath & " does not exist")
  Response.End
 end if 
 
 Set f=fso.OpenTextFile(strFilePath, 1)
 
 do while f.AtEndOfStream = false
  strContent = strContent & f.ReadLine & vbcrlf
  'strContent = strContent & "<br />"
 loop
 
 GetFileContent = strContent
 f.Close
 Set f=Nothing
 Set fs=Nothing
end function


'*******************************************************************
'
sub WriteFile(strFilePath, strContent)
 dim fs,f
 set fs=Server.CreateObject("Scripting.FileSystemObject")
 set f=fs.CreateTextFile(strFilePath, true)
 f.WriteLine(strContent)
 f.Close
 set f=nothing
 set fs=nothing
end sub

ASP Read XML

sub ReadXML(strFilePath)
 Dim xml
 Set xml = Server.CreateObject("Microsoft.XMLDOM")
 xml.async = False 'False, to show the data as soon as it begins to read it. -> speeded up.
 xml.load (strFilePath)

 Dim title, heading, paragraph, testHTML
 title = xml.documentElement.childNodes(0).text
 heading = xml.documentElement.childNodes(1).text
 paragraph = xml.documentElement.childNodes(2).text
 testHTML = xml.documentElement.childNodes(3).text

 Set xml = Nothing
end sub

ASP script download

'*******************************************************************
' http://authors.aspalliance.com/chrisg/tools/view-downloadfile.asp
' use: 
'  call DownloadFile(Server.Mappath("data/data.rar"))
'
sub DownloadFile(strFilename)
 Response.Clear
 
 ' create stream
 Set s = Server.CreateObject("ADODB.Stream")
 s.Open
 
 ' Set as binary
 s.Type = 1
 
 ' load in the file
 on error resume next
 
 ' check the file exists
 Set fso = Server.CreateObject("Scripting.FileSystemObject")
 if not fso.FileExists(strFilename) then
 Response.Write("Error: " & strFilename & " does not exist")
 Response.End
 end if
 
 ' get length of file
 Set f = fso.GetFile(strFilename)
 intFilelength = f.size
 
 s.LoadFromFile(strFilename)
 if err then
 Response.Write("Error: " & err.Description)
 Response.End
 end if
 
 ' send the headers to the users browser
 Response.AddHeader "Content-Disposition", "attachment; filename=" & f.name
 Response.AddHeader "Content-Length", intFilelength
 Response.CharSet = "UTF-8"
 Response.ContentType = "application/octet-stream"
 
 ' output the file to the browser
 Response.BinaryWrite s.Read
 Response.Flush
 
 ' tidy up
 s.Close
 Set s = Nothing

End sub