asp如何创建一个PDF文件?
来源:asp之家 发布时间:2009-11-14 20:53:00
asp创建pdf文件代码,详见以下代码:
<%
Option Explicit
Sub CheckXlDriver()
On Error Resume Next
Dim vConnString
Dim oConn, oErr
vConnString = "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=NUL:"
' 连接NUL
Set oConn = CreateObject("ADODB.Connection")
oConn.Open vConnString
For Each oErr in oConn.Errors
' 如果Excel程序报告"文件创建失败",别担心,这表示它正在正常运行呢
If oErr.NativeError = -5036 Then
Exit Sub
End If
Next
Response.Write " MDAC 供应商或驱动程序不可用,请检查或重新安装!<br><br>"
Response.Write hex(Err.Number) & " " & Err.Description & "<br>"
For Each oErr in oConn.Errors
Response.Write hex(oErr.Number) & " " & oErr.NativeError & " " &
oErr.Description & "<br>"
Next
Response.End
End Sub
Function GetConnection(vConnString)
On Error Resume Next
Set GetConnection = Server.CreateObject("ADODB.Connection")
GetConnection.Open vConnString
If Err.Number <> 0 Then
Set GetConnection = Nothing
End If
End Function
Function OptionTag(vChoice,vTrue)
Dim vSelected
If vTrue Then
vSelected = "selected"
End If
OptionTag = "<option " & vSelected & ">" & _
Server.HtmlEncode(vChoice) & "</option>" & vbCrLf
End Function
Function IsChecked(vTrue)
If vTrue Then
IsChecked = "checked"
End If
End Function
Function BookOptions(vXlFile)
Dim vServerFolder
Dim oFs, oFolder, oFile
Dim vSelected
vServerFolder = Server.MapPath(".")
Set oFs = Server.CreateObject("Scripting.FileSystemObject")
Set oFolder = oFs.GetFolder(vServerFolder)
For Each oFile in oFolder.Files
If oFile.Type = "Microsoft Excel Worksheet" Then
vSelected = (oFile.Name = vXlFile)
BookOptions = BookOptions & _
OptionTag(oFile.Name, vSelected)
End If
Next
Set oFolder = Nothing
Set oFs = Nothing
End Function
Function NamedRangeOptions(oConn, vXlRange, vTableType)
Dim oSchemaRs
Dim vSelected
NamedRangeOptions = OptionTag(Empty, Empty)
If TypeName(oConn) = "Connection" Then
Set oSchemaRs = oConn.OpenSchema(adSchemaTables)
Do While Not oSchemaRs.EOF
If oSchemaRs("TABLE_TYPE") = vTableType Then
vSelected = (oSchemaRs("TABLE_NAME") = vXlRange)
NamedRangeOptions = NamedRangeOptions & _
OptionTag(oSchemaRs("TABLE_NAME"), vSelected)
End If
oSchemaRs.MoveNext
Loop
End If
End Function
Function DataTable(oConn, vXlRange, vXlHasHeadings)
On Error Resume Next
Const DB_E_ERRORSINCOMMAND = &H80040E14
Dim oRs, oField
Dim vThTag, vThEndTag
If vXlHasHeadings Then
vThTag = "<th>"
vThEndTag = "</th>"
Else
vThTag = "<td>"
vThEndTag = "</td>"
End If
DataTable = "<table border=1>"
If TypeName(oConn) = "Connection" Then
Set oRs = oConn.Execute("[" & vXlRange & "]")
If oConn.Errors.Count > 0 Then
For Each oConnErr in oConn.Errors
If oConnErr.Number = DB_E_ERRORSINCOMMAND Then
DataTable = DataTable & _
"<tr><td>该范围不存在:</td><th>" & vXlRange & "</th></tr>"
Else
DataTable = DataTable & _
"<tr><td>" & oConnErr.Description & "</td></tr>"
End If
Next
Else
DataTable = DataTable & "<tr>"
For Each oField in oRs.Fields
DataTable = DataTable & vThTag & oField.Name & vThEndTag
Next
DataTable = DataTable & "</tr>"
Do While Not oRs.Eof
DataTable = DataTable & "<tr>"
For Each oField in oRs.Fields
DataTable = DataTable & "<td>" & oField.Value & "</td>"
Next
DataTable = DataTable & "</tr>"
oRs.MoveNext
Loop
End If
Set oRs = Nothing
Else
DataTable = DataTable & "<tr><td>文件被另一个请求锁定,或者不允许执行!程序终止...</td></tr>"
End If
DataTable = DataTable & "</table>"
End Function
%>
' --main--
<html>
<head>
<title>Read Excel</title>
<SCRIPT LANGUAGE=javascript>
<!--
function XlBook_onchange(theForm) {
with (theForm) {
XlSheet.selectedIndex = 0;
XlSheet.disabled = true;
XlNamedRange.selectedIndex = 0;
XlNamedRange.disabled = true;
XlTypedRange.value = "A:IV";
}
}
function XlSheet_onchange(theForm) {
with (theForm) {
XlNamedRange.selectedIndex = 0;
XlTypedRange.value = XlSheet.options[XlSheet.selectedIndex].text;
}
}
function XlNamedRange_onchange(theForm) {
with (theForm) {
XlSheet.selectedIndex = 0;
XlTypedRange.value = XlNamedRange.options[XlNamedRange.selectedIndex].text;
}
}
function XlTypedRange_onchange(theForm) {
with (theForm) {
XlSheet.selectedIndex = 0;
XlNamedRange.selectedIndex = 0;
}
}
//-->
</SCRIPT>
</head>
<body>
<%
Dim vXlFile, vXlFilePath
Dim vXlRange, vXlHasHeadings
Dim vDisabled
Dim vConnString
Dim oConn, oConnErr
Const adSchemaTables = 20 ' from adovbs.inc
CheckXlDriver
' 确认它正常工作
vXlFile = Request("XlBook")
If vXlFile <> Empty Then
vXlRange = Request("XlTypedRange")
If vXlRange = Empty Then
vXlRange = "A:IV"
Else
vXlRange = Replace(vXlRange, "!", "$")
End If
vXlHasHeadings = Request("XlHasHeadings")
vXlFilePath = Server.MapPath(vXlFile)
vConnString = "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & _
vXlFilePath
' 建立连接
Set oConn = GetConnection(vConnString)
Else
vDisabled = "disabled"
End If
%>
<form name=MyForm method="POST" action="<%=Request.ServerVariables("SCRIPT_NAME")%>">
<table border="1" width="100%">
<tr>
<th>作品:</th>
<td>
<select name="XlBook" LANGUAGE=javascript onchange="return XlBook_onchange(MyForm)">
<%= BookOptions(vXlFile) %>
</select></td>
<td align="center">操作说明:</td>
<td><select <%=vDisabled%> name="XlSheet" LANGUAGE=javascript onchange="return XlSheet_onchange(MyForm)">
<%= NamedRangeOptions(oConn, vXlRange, "SYSTEM TABLE") %>
</select></td>
</tr>
<tr>
<th>范围:</th>
<td><input type="text" name="XlTypedRange" LANGUAGE=javascript onchange="return XlTypedRange_onchange(MyForm)"
value ="<%= vXlRange %>"></td>
<td align="center">指定范围:</td>
<td><select <%=vDisabled%> name="XlNamedRange" LANGUAGE=javascript onchange="return XlNamedRange_onchange(MyForm)">
<%= NamedRangeOptions(oConn, vXlRange, "TABLE") %>
</select></td>
</tr>
<tr>
<th>
<p> </th>
<td colspan="3">
<input type="checkbox" name="XlHasHeadings"
<%= IsChecked(vXlHasHeadings) %>
value="True">将第一行作为列标题显示</td>
</tr>
<tr>
<th>
<p> </th>
<td colspan=3>
<a href=<%= vXlFile %>><%= vXlFile %></a>
</td>
</tr>
</table>
<input type="submit" value="提交" name="cmdSubmit">
<input type="reset" value="重置" name="cmdReset">
</form><hr>
<%
If vXlRange <> Empty Then
Response.Write DataTable(oConn, vXlRange, vXlHasHeadings)
End If
%>
</body>
</html>
猜你喜欢
- 在使用SQL Server 的过程,中由于经常需要从多个不同地点将数据集中起来或向多个地点复制数据,所以数据的导出,导入是极为常见的操作.我
- 内容摘要:在像网站首页这样的资源比较集中的页面中,那些栏目最经常被用户点击?居左居右对广告的点击率的影响是什么?“一切用数字说话”:以上问题
- 1.连接本机数据库 A. 本机若有静态IP,oracle安装好后,就能连接本机oracle数据库。 B. 安装oracle时,本机没有静态I
- 颜色的变化跟人类的智慧一样,是无穷的,每个阶段都会有流行的色彩,有属于一个时代的颜色!WEB2.0是一个概念,它宣扬,定位了一些东西,以用户
- 在国外一博客看到的技巧,终于解决IE的这个老大难问题。我在IE的setAttribute bug也提到其解决方法,一是innerHTML,一
- 一般情况下会有几种情况需要你把数据库设为只读: 1. Insert,Update,Delete 触发器 2. Check 约束 和 Dele
- 说明:通过随机产生密码,然后将密码EMail给注册用户,你可以确认用户的EMail填写是否正确。自动产生的密码往往安全性更高,同时,你可以过
- 阅读上一章:Css布局Chapter 13 为文字指定样式我想以一章的篇幅来讨论用CSS设定文字样式的做法是个好点子.一般处理文字内容大概是
- 在良好的数据库设计基础上,能有效地使用索引是SQL Server取得高性能的基础,SQL Server采用基于代价的优化模型,它对每一个提交
- Bit-Packed Data TypesMySQL有一些存储类型使用一个值中的一些单个的比特位来紧凑的存储数据。纯技术上将,不管是底层的存
- DTD实际上可以看作一个或多个XML文件的模板,这些XML文件中的元素、元素的属性、元素的排列方式/顺序、元素能够包含的内容等,都必须符合D
- 在应用系统开发初期,由于开发数据库数据比较少,对于查询SQL语句,复杂视图的编写,刚开始不会体会出SQL语句各种写法的性能优劣,但是如果将应
- 我想做一个页面,10秒后转向其它页。想在网页中显示10秒的倒计时。谢谢了。对JS不懂 方法一:<html><h
- 很多时候,由于程序设计需要,要求在asp的include包含文件里调用动态的文件。如<!--#include file=&q
- 相比SQL Server 2000提供的FOR XML查询,SQL Server 2005版本对现有功能增强的基础上增加了不少新功能,最为吸
- 1、仅 Safari 和 Opera 识别的 Hack@media all and (min-width:&n
- 求英文字母、数字、下划线、汉字的js正则表达式英文字母或数字或下划线,英文字母数字下划线是:/^\w+$/汉字的是:/^[\u0391-\u
- 1.获取所有数据库名: SELECT Name FROM Master..SysDatabases ORDER BY Name2.获取所有表
- 设计中文网站的朋友都会有这样的体会,Dreamweaver功能虽然强大,但要按照中文的行文习惯实现每个
- staytime.asp<% If Request.QueryString("time")&n