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>


猜你喜欢
- XML被设计用来描述数据,其焦点是数据的内容。HTML被设计用来显示数据,其焦点是数据的外观。  
- 内置函数Built-in Functionsabs()dict()help()min()setattr()all()dir()hex()ne
- 1、 引言小 * 丝:鱼哥,新年快乐!小鱼:无事不登三宝殿,有啥事,你直说吧…小 * 丝:别说的这么直接,这大过年的&
- mysql 8.0.11 winx64安装教程记录如下,分享给大家1.进入地址: 下载mysql-8.0.11-winx642.解
- 1.Python虚拟环境创建首先我们为什么要创建虚拟环境呢?因为不同的项目所依赖的环境不一样,他们需要不同的第三方库等等。为了避免冲突,所以
- 先介绍一下jsSmarty Project:简要说明:利用JavaScript?在客户端完成SmartyPhp的工作,加速模板开发。主要是利
- 本文是对pandas官方网站上《10Minutes to pandas》的一个简单的翻译,原文在这里。这篇文章是对pandas的一个简单的介
- 概述在进行网站爬取数据的时候,会发现很多网站都进行了反爬虫的处理,如JS加密,Ajax加密,反Debug等方法,通过请求获取数据和页面展示的
- 前言本文主要讲述的是在使用uniapp中如何引入iconfont图标,以及两种常用的位置。位置一:App下原生导航栏的按钮使用字体图标。位置
- 从09年初接手淘宝手机网站前端开发的工作至今,转眼已是一年。一步步看着手机淘宝从最初的beta版本到今天的样子,感慨良多。手机网站开发,有着
- 运行以下代码: Dim com As ADODB.Command Dim rst
- 本文实例讲述了Python数据类型之String字符串。分享给大家供大家参考,具体如下:String(字符串)1、概述字符串是以单引号或双引
- yagmail 实现发邮件yagmail 可以更简单的来实现自动发邮件功能。1、安装pip install yagmail2、简单举例imp
- 如下所示:<!DOCTYPE html><html lang="en"><head>
- 本文实例讲述了python判断字符串是否纯数字的方法。分享给大家供大家参考。具体如下:判断的代码如下,通过异常判断不能区分前面带正负号的区别
- anaconda中安装的python环境中没有pip3在使用anaconda配置的python环境时,发现在python环境中并没有安装pi
- 什么是主键?主键是表中唯一标识该表中每个元组(行)的列。主键对表实施完整性约束。表中只允许使用一个主键。主键不接受任何重复值和空值。表中的主
- 使用APPLY运算符可以为实现查询操作的外部表表达式返回的每个行调用表值函数。 表值函数作为右输入,外部表表达式作为左输入。 通过对右输入求
- 本文实例为大家分享了简单的Python登录验证,供大家参考,具体内容如下编写登录接口要求:1、输入用户名密码2、认证成功后显示欢迎信息3、输
- 于是写测试程序。。。不行 下载最新的ODBC。。。还是不行 通过sql plus查询。。。咦?竟然也查不到。。。 于是,折腾。。。折腾。。。