首页 > 编程 > ASP > 正文

用ASP创建(生成)PDF文件的代码

2024-05-04 11:07:00
字体:
来源:转载
供稿:网友

下面即是用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>

发表评论 共有条评论
用户名: 密码:
验证码: 匿名发表