用ASP构建(生成)PDF文件的代码
发布时间：2023-07-24 14:28:57 所属栏目：Asp教程 来源：
导读：下面即是用ASP创建(生成)PDF文件的代码
<%
Option Explicit
Sub CheckXlDriver()
On Error Resume Next
Dim vConnString
Dim oConn, oErr
' try to connect to file NUL:
vConn
<%
Option Explicit
Sub CheckXlDriver()
On Error Resume Next
Dim vConnString
Dim oConn, oErr
' try to connect to file NUL:
vConn
|
下面即是用ASP创建(生成)PDF文件的代码 <% Option Explicit Sub CheckXlDriver() On Error Resume Next Dim vConnString Dim oConn, oErr ' try to connect to file NUL: vConnString = "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=NUL:" Set oConn = CreateObject("ADODB.Connection") oConn.Open vConnString For Each oErr in oConn.Errors ' when the Excel driver reports "Failure creating file", ' then it must be installed and working ;-)) If oErr.NativeError = -5036 Then Exit Sub End If Next Response.Write "Provider or Driver not available. (Re-)Install MDAC. " Response.Write hex(Err.Number) & " " & Err.Description & " " For Each oErr in oConn.Errors Response.Write hex(oErr.Number) & " " & oErr.NativeError & " " & oErr.Description & " " 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 ' from OleDbVbc.inc 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>No such range :</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>File locked by another application or otherwise not accessible. Cannot continue.</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 ' make sure it is working 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") ' establish connection 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>Workbook :</th> <td> <select name="XlBook" LANGUAGE=javascript onchange="return XlBook_onchange(MyForm)"> <%= BookOptions(vXlFile) %> </select></td> <td align="center">Worksheet :</td> <td><select <%=vDisabled%> name="XlSheet" LANGUAGE=javascript onchange="return XlSheet_onchange(MyForm)"> <%= NamedRangeOptions(oConn, vXlRange, "SYSTEM TABLE") %> </select></td> </tr> <tr> <th>Range :</th> <td><input type="text" name="XlTypedRange" LANGUAGE=javascript onchange="return XlTypedRange_onchange(MyForm)" value ="<%= vXlRange %>"></td> <td align="center">Named Range :</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"> Show first row as column headings</td> </tr> <tr> <th> <p> </th> <td colspan=3> <a href=<%= vXlFile %>><%= vXlFile %></a> </td> </tr> </table> <input type="submit" value="Submit" name="cmdSubmit"> <input type="reset" value="Reset" name="cmdReset"> </form><hr> <% If vXlRange <> Empty Then Response.Write DataTable(oConn, vXlRange, vXlHasHeadings) End If %> </body> </html> （编辑：聊城站长网） 【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容! |
推荐文章
站长推荐
