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>

标签:pdf,创建,asp
0
投稿

猜你喜欢

  • Python if else条件语句形式详解

    2021-09-21 06:48:24
  • 详解JS如何判断对象上是否存在某个属性

    2024-04-16 09:49:28
  • python中函数默认值使用注意点详解

    2021-01-26 12:36:44
  • 基于Golang 高并发问题的解决方案

    2024-02-20 16:49:01
  • 实现页面中按钮刷新的N种方法

    2007-02-03 11:06:00
  • python开发一个解析protobuf文件的简单编译器

    2021-08-11 12:01:22
  • Python调用C++程序的方法详解

    2023-12-10 12:53:06
  • vue实现购物车加减

    2023-07-02 17:10:04
  • 解决Keyerror ''acc'' KeyError: ''val_acc''问题

    2022-09-05 11:28:12
  • pytorch tensor计算三通道均值方式

    2022-06-26 00:02:41
  • Python实现合并excel表格的方法分析

    2022-04-24 21:30:22
  • Python查询IP地址归属完整代码

    2022-10-18 16:39:07
  • Vue子组件监听父组件值的变化

    2023-07-02 16:56:00
  • Javascript实现动态菜单添加的实例代码

    2024-04-22 22:23:25
  • 如何创建一个对索引服务器进行查询的ASP页面?

    2009-11-14 20:54:00
  • python音频处理用到的操作的示例代码

    2021-05-11 22:05:19
  • Python跳出多重循环的方法示例

    2022-12-18 16:28:26
  • PyTorch模型保存与加载实例详解

    2022-02-24 20:08:56
  • 标准的、语义的、Unobtrusive的页签tab切换

    2007-11-03 13:58:00
  • 文字链接,怎么办?

    2008-08-04 13:18:00
  • asp之家 网络编程 m.aspxhome.com