针对有网友说看不见文章内容，
现提示如下:
点击每一个标题行任一地方都会展开和隐藏此文章内容(不要点击标题).
目前展开隐藏功能只支持IE浏览器，虽然可以改成支持FF浏览器，不过现在一直没时间去弄，等有时间再修改了。 |
|
blog名称:乱闪Blog
日志总数:267
评论数量:1618
留言数量:-26
访问次数:2668911
建立时间:2005年1月1日 |
|
|
| |
 ASP实现文件直接下载
|
在IE进行文档链接时,如果遇到OLE支持的文档,IE会自动调用相应程序打开它,有时候这种功能并不是我们所需的,虽然我们可以提醒用户用鼠标右键-->"目标另存为...."命令来下载文档,但这样毕竟不太友好,本文描述了利用FSO及Stream方法实现IE直接下载文档.
<%@ language=vbscript codepage=65001%>
<%
''Filename must be input
if Request("Filename")="" then
response.write "<h1>Error:</h1>Filename is empty!<p>"
else
call downloadFile(replace(replace(Request("Filename"),"\",""),"/",""))
Function downloadFile(strFile)
'' make sure you are on the latest MDAC version for this to work
'' get full path of specified file
strFilename = server.MapPath(strFile)
'' clear the buffer
Response.Buffer = True
Response.Clear
'' create stream
Set s = Server.CreateObject("ADODB.Stream")
s.Open
'' Set as binary
s.Type = 1
'' load in the file
on error resume next
'' check the file exists
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if not fso.FileExists(strFilename) then
Response.Write("<h1>Error:</h1>"&strFilename&" does not exists!<p>")
Response.End
end if
'' get length of file
Set f = fso.GetFile(strFilename)
intFilelength = f.size
s.LoadFromFile(strFilename)
if err then
Response.Write("<h1>Error: </h1>Unknown Error!<p>")
Response.End
end if
'' send the headers to the users Browse
Response.AddHeader "Content-Disposition","attachment; filename="&f.name
Response.AddHeader "Content-Length",intFilelength
Response.CharSet = "UTF-8"
Response.ContentType = "application/octet-stream"
'' output the file to the browser
Response.BinaryWrite s.Read
Response.Flush
'' tidy up
s.Close
Set s = Nothing
End Function
end if
%> |
|
ASP如何获取客户端真实IP地址
|
要想透过代理服务器取得客户端的真实IP地址，就要使用 Request.ServerVariables("HTTP_X_FORWARDED_FOR") 来读取。不过要注意的事，并不是每个代理服务器都能用 Request.ServerVariables("HTTP_X_FORWARDED_FOR") 来读取客户端的真实 IP，有些用此方法读取到的仍然是代理服务器的IP。还有一点需要注意的是：如果客户端没有通过代理服务器来访问，那么用 Request.ServerVariables ("HTTP_X_FORWARDED_FOR") 取到的值将是空的。因此，如果要在程序中使用此方法，可以这样处理：
......
userip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If userip = "" Then userip = Request.ServerVariables("REMOTE_ADDR")
......
即：如果客户端通过代理服务器，则取 HTTP_X_FORWARDED_FOR 的值，如果没通过代理服务器，就取 REMOTE_ADDR 的值。
'通用函数：如果不能取客户端真实IP，就会取客户端的代理IP
Private Function getIP()
Dim strIPAddr
If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
strIPAddr = Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
Else
strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
End If
getIP = Trim(Mid(strIPAddr, 1, 30))
End Function
|
|
用ASP打开远端MDB文件的方法
|
| 如果你用ODBC connection (DSN or DSN-less)来访问远端的(UNC path)数据库, OLEDB会出现以下错误信息：
Microsoft OLE DB Provider for ODBC Drivers error ’80004005’
[Microsoft][ODBC Microsoft Access Driver] The Microsoft Jet database engine cannot open the file ’(unknown)’. It is already opened exclusively by another user, or you need permission to view its data.
你完全可以避免这种错误--ASP和ActiveX支持两种方式打开MDB文件的DSN-less连接，或由其它机器访问MDB文件。
1. DAO database (only for small load)
Dim File, Conn, RS
Const ReadOnly = False
File = "\\server\share\file.mdb"
Set Conn = CreateObject("DAO.DBEngine.35").Workspaces(0).OpenDatabase(File,,ReadOnly)
Set RS = Conn.OpenRecordset(SQL)
2. ADO + Jet OLE DB provider
Dim Conn, RS
Set Conn = CreateObject("ADODB.Connection")
Conn.Provider = "Microsoft.Jet.OLEDB.4.0"
Conn.Open "\\server\share\file.mdb"
Set RS = Conn.Execute(SQL)
你得确定使用ASP的用户有NT的数据库及共享访问权限。
假定有权限的话，你亦可访问其它机器中的开放数据连接:
http://www.pstruh.cz/
Set UM = CreateObject("UserManager.Server")
UM.LogonUser "Login with the rights", "Password", "Domain"
...
open database
...
UM.RevertToSelf |
|
防止ACCESS数据库被下载的9种方法
|
篇首语：原来改.mdb为.asp就能防下载是鬼话。
引子：昨天和animator试验了一下，把data.mdb文件改名为data.asp文件后放在wwwroot目录里。然后 在IE中输入data.asp路径后，发现IE显示一片空白，右键->察看源文件，跳出记事本，将内容另存为.mdb文件 ，用ACCESS打开，发现需要密码，也就是说至少文件头被破坏。
然后用Flashget试验下载data.asp文件，并另存为data.mdb文件，发现用ACCESS打开完好无损！！！看 来，好一些编程人员在开发的时候都认为，改了mdb后缀为asp就能防下载的概念，是错的！后台数据库被下载对于一个asp+access的网站来说无疑是一场惨绝人寰的灾难。今天找了各方的文章，归纳一下有以下9种办法防止数据库被下载(欢迎补充)：
1.发挥你的想象力 修改数据库文件名
不用说，这是最最偷懒的方法，但是若攻击者通过第三方途径获得了数据库的路径)，就玩完了。比如说攻击者本来只能拿到list权 ，结果意外看到了数据库路径，就可以冠冕堂皇地把数据库下载回去研究了。另外，数据文件通常大小都比较大，起再隐蔽的文件名都瞒不了人。故保密性为最低。
2.数据库名后缀改为ASA、ASP等
此法须配合一些要进行一些设置，否则就会出现本文开头的那种情况
(1)二进制字段添加(此招我还没有炼成-_-+)。
(2)在这个文件中加入<%或%>，IIS就会按ASP语法来解析，然后就会报告500错误，自然不能下载了。可是 如果只是简单的在数据库的文本或者备注字段加入<%是没用的，因为ACCESS会对其中的内容进行处理，在数据库里他会以 < %的形式存在，无效！正确的方法是将<%存入OLE对象字段里，这样我们的目的就能达到了。
操作方法：
首先，用记事本或任何文本编辑工具新建一个内容为 <% 的文本文件，随便起个名字存档。
接着，用Access打开您的数据库文件，新建一个表，随便起个名字，在表中添加一个OLE对象的字段，然后添加一个记录， 插入之前建立的文本文件，如果操作正确的话，应该可以看到一个新的名为"数据包＂的记录。即可
3.数据库名前加"#"
只需要把数据库文件前名加上#、然后修改数据库连接文件（如conn.asp）中的数据库地址。原理是下载的时候只能识别#号前名的部分，对于后面的自动去掉，比如你要下载：http://www.pcdigest.com/date/# 123.mdb(假设存在的话）。无论是IE还是FLASHGET等下到的都是http://www.test.com/date/index.htm(index.asp、default.jsp等你在IIS设置的首页文档)
另外在数据库文件名中保留一些空格也起到类似作用，由于HTTP协议对地址解析的特殊性，空格会被编码为"%",如http ://www.test.com/date/123 456.mdb，下载的时http://www. test.com/date/123%20456.mdb。而我们的目录就根本没有123%456.mdb这个文件，所以下载也是无效的这样的修改后，即使你暴露了数据库地址，一般情况下别人也是无法下载！
4.加密数据库
首先在选取"工具->安全->加密/解密数据库，选取数据库（如：employer.mdb），然后接确定，接 着会出现"数据库加密后另存为"的窗口，存为：employer1.mdb。接着employer.mdb就会被编码，然后存为 employer1.mdb..要注意的是，以上的动作并不是对数据库设置密码，而只是对数据库文件加以编码，目的是为了防止他 人使用别的工具来查看数据库文件的内容。
接下来我们为数据库加密，首先以打开经过编码了的 employer1.mdb，在打开时，选择"独占"方式。然后选取功能表的"工具->安全->设置数据库密码，接着输入密码即可。这样即使他人得到了employer1.mdb文件，没有密码他是无法看到 emplo yer1.mdb的。
加密后要修改数据库连接页，如：
conn.open "driver={microsoft access driver&nb sp;(*.mdb)};uid=admin;pwd=数据库密码;dbq=数据库路径"
这样修改后，数据库即使被人下载了，别人也无法打开（前提是你的数据库连接页中的密码没有被泄露）
但值得注意的是，由于Access数据库的加密机制比较简单，即使设置了密码，解密也很容易。该数据库cn-media.com/i-v/index.shtm>系统通过将用户输入的 密码与某一固定密钥进行"异或"来形成一个加密串，并将其存储在*.mdb文件从地址"&H42"开始的区域内。所以一 个好的程序员可以轻松制作一个几十行的小程序就可以轻松地获得任何Access数据库的密码。因此，只要数据库被下载，其信息安全依然是个未知数。
5.数据库放在WEB目录外或将数据库连接文件放到其他虚拟目录下
如你的WEB目录是e:\webroot，可以把数据库放到e:\data这个文件夹里，在e:\webroot里的数据库连接页中修改数据库连接地址为："../data/数据库名" 的形式，这样数据库可以正常调用，但是无法下载的，因为它不在WEB目录里！这个方法一般也不适合购买虚拟空间的用户。 不过现在的虚拟空间提供商都提供了这样的目录的。稍微正规点的空间提供商都会提供三个目录 wwwroot database和logfiles。 wwwroot才是你访问的网站的根目录。
6.使用ODBC数据源。
在ASP等程序设计中，如果有条件，应尽量使用ODBC数据源，不要把数据库名写在程序中，否则，数据库名将随ASP源代码 的失密而一同失密，例如： DBPath = Server.MapPath("../123/abc/asfadf.mdb ")
conn.open "driver={Microsoft Access Driver&nb sp;(*.mdb)};dbq="& DBPath
可见，即使数据库名字起得再怪异，隐藏的目录再深，ASP源代码失密后，也很容易被下载下来。如果使用ODBC数据源，就不 会存在这样的问题了： conn.open "ODBC-DSN名" ,不过这样是比较烦的，目 录移动的话又要重新设置数据源了，更方便的方法请看第7，8法！
7.添加数据库名的如MDB的扩展映射
这个方法就是通过修改IIS设置来实现，适合有IIS控制权的朋友，不适合购买虚拟主机用户(除非管理员已经设置了）。这个 方法我认为是目前最好的。只要修改一处，整个站点的数据库都可以防止被下载。无须修改代码即使暴露目标地址也可以防止下载。&n bsp;
我们在IIS属性---主目录---配置---映射---应用程序扩展那里添加.mdb文件的应用解析。注意这里的选择的D LL（或EXE等）似乎也不是任意的，选择不当，这个MDB文件还是可以被下载的， 注意最好不要选择选 择asp.dll等。你可以自己多测试下
这样修改后下载数据库如：http://www.test.com/data/dvbbs6.mdb。就出现（404或50 0等错误）
8：使用.net的优越性
动网的木鸟就写过一个防非法下载文件的"WBAL 防盗链工具"。具体可以登陆http://www.9seek .com/WBAL/
不过 那个只实现了防止非本地下载的 ，没有起到真正的防下载数据库的功能。不过这个方法已经跟5法差 不多可以通过修改.NET文件，实现本地也不能下载！
这几个方法中，只有第7和8个是统一性改的，一次修改配置后，整个站点的数据库都可以防止下载，其他几个就要分别修改数据库 名和连接文件，比较麻烦，不过对于虚拟主机的朋友也只能这样了！
其实第6个方法应该是第5个方法的扩展，可以实现特殊的功能，但对于不支持.net的主机或者怕设置麻烦的话，还是直接用第 5个方法了，而且默认情况下第6个方法，依然可以通过复制连接到同主机的论坛或留言本发表，然后就可以点击下载了（因为这样的引 用页是来自同主机的）
9.利用NTFS分区的文件权限设置(by percyboy)
我们已经知道，ASP.NET 中使用 ADO.NET 访问数据库，通过 OleDb 的连接可以访问 Access 数据库— —我们非常常用的低端数据库之一。本文讨论了 ASP.NET 中可能看到的若干错误提示，从中看到&nb sp;Access 2000 和 Access XP 创建的数据库文件 ，在访问出现错误时会出现不太相同的错误提示。希望对大家有所帮助。另一个要点是，希望通过此文，使大家对 ASP. NET 中 Access 数据库文件的 NTFS 权限设置有所新的认识 。
(一)实验过程
为了叙述方便，举个具体例子做个实验：应用程序为 /test ，数据库存放在 D:\wwwroot\test\data\db1.mdb，我们已经知道在 ASP.NET 中是以一个叫做ASPNET 虚拟用户的身份访问数据库的，我们需要给这个账户以特定的 NTFS 权限才能使 ASP.NET 程序正常运行。
为了得到最严格的 NTFS 权限设置，实验开始时我们给程序最低的 NTFS 权限 ：
a) D:\wwwroot\test\data\ 文件夹的给用户ASPNET 以如下权限：
允许 拒绝
完全控制 □ □
修改 □ □
读取及运行 √ □
列出文件夹目录 √ □
读取 √ □
写入 □ □
b) D:\wwwroot\test\data\db1.mdb 文件本身给用户ASPNET以如下权限：
√ 允许将来自父系的可继承权限传播给该 对象
1.1 对于某个只包含有"SELECT"命令的aspx程序，上述权限设置运行时无障碍，即：上述权限 已经满足这类程序的运行了。
1.2 对于包含有"UPDATE""INSERT""UPDATE"等命令的aspx程序， ;
(a) 如果 db1.mdb 是 Access 2000 创 建的数据库，出现如下错误：
"/test"应用程序中的服务器错误。
---------------------------------------
Microsoft Jet 数据库引擎打不开文件D:\wwwroot\test\data\。&n bsp;它已经被别的用户以独占方式打开，或没有查看数据的权限。
说明: 执行当前 Web 请求期间，出现未处理的异常。请检查堆栈跟踪信息，以了解有关该错误 以及代码中导致错误的出处的详细信息。
异常详细信息: System.Data.OleDb.OleDbException: Microsof t Jet 数据库引擎打不开文件D:\wwwroot\test\data\。 它已经被 别的用户以独占方式打开，或没有查看数据的权限。
(b) 如果 db1.mdb 是 Access XP 创建的 数据库，出现如下错误：
"/test"应用程序中的服务器错误。
----------------------------------------------
操作必须使用一个可更新的查询。
说明: 执行当前 Web 请求期间，出现未处理的异常。请检查堆栈跟踪信息，以了解有关该错误 以及代码中导致错误的出处的详细信息。
异常详细信息: System.Data.OleDb.OleDbException: 操作必须使用一个 可更新的查询。
(c) 原因初步分析：因为包含有"UPDATE""INSERT""UPDATE"等命令，需要对数据库文件本身进 行写入操作，所以上述权限不能满足此需求，我们需要进一步放开权限。
我们放开一些权限，
a) D:\wwwroot\test\data\ 文件夹不变： & nbsp;
b) D:\wwwroot\test\data\db1.mdb 文件本身给用户ASPNET以如下权限：
允许 拒绝
完全控制 □ □
修改 □ □
读取及运行 √ □
列出文件夹目录 √ □
读取 √ □
写入 √ □
1.3 放开权限后继续实验，
(a) 如果 db1.mdb 是 Access 2000 创建的数据库，出现如下错误：
"/test"应用程序中的服务器错误。
------------------------------------------
不能锁定文件。
说明: 执行当前 Web 请求期间，出现未处理的异常。请检查堆栈跟踪信息，以了解有关该错误 以及代码中导致错误的出处的详细信息。
异常详细信息: System.Data.OleDb.OleDbException: 不能锁定文件。
(b) 如果 db1.mdb 是 Access XP 创建的 数据库，没有出现错误。
(c) 原因初步分析：我们发现在打开 Access 数据库时，同时会在所在目录生成一个同名 的 *.ldb 文件，这是一个 Access 的锁定标记。鉴于此，我们猜测，用户 ASPNET 访问 Access 数据库时，也需要生成一个锁定标记，而该目录没 有允许其写入，因此出错。至于 Access XP 创建的数据库为什么没有这个错误，原因还不 得而知。
我们进一步放开权限，
a) D:\wwwroot\test\data\ 文件夹给用户ASPNET以 如下权限：
允许 拒绝
完全控制 □ □
修改 □ □
读取及运行 √ □
列出文件夹目录 √ □
读取 √ □
写入 √ □
b) D:\wwwroot\test\data\db1.mdb 文件本身给用户ASPNET以如下权限：
√ 允许将来自父系的可继承权限传播给该 对象
1.4 继续实验，发现错误已解决，那么上面这个权限就是我们需要放开的"最低权限"。
(a) 如果 db1.mdb 是 Access 2000 创 建的数据库，我们会发现一个小问题：生成的 *.ldb 文件不会自己删除，访问后该文件依然存在，但这个 问题不会影响 ASP.NET 的正常运行。
(b) 如果 db1.mdb 是 Access XP 创建的 数据库，没有出现上面类似问题。
(c) 原因初步分析：我们仅仅是给了 ASPNET 以写入文件夹的权限，没有给它修改的权限 ，所以文件一旦写入，便无法修改其内容，*.ldb 也就删除不掉了。
如果非要解决这个问题，进一步放开权限为：
a) D:\wwwroot\test\data\ 文件夹给用户ASPNET以 如下权限：
允许 拒绝
完全控制 □ □
修改 √ □
读取及运行 √ □
列出文件夹目录 √ □
读取 √ □
写入 √ □
b) D:\wwwroot\test\data\db1.mdb 文件本身给用户ASPNET以如下权限：
√ 允许将来自父系的可继承权限传播给该 对象
1.5 附带着，实验另一种情形：我们把 db1.mdb 在 Acce ss 打开编辑，同时访问 ASP.NET。
(a) 如果 db1.mdb 是 Access 2000 创 建的数据库，我们发现并没有出现什么问题。
(b) 如果 db1.mdb 是 Access XP 创建的 数据库，出现如下错误：
"/zhao"应用程序中的服务器错误。
------------------------------------------------
不能使用 ；文件已在使用中。
说明: 执行当前 Web 请求期间，出现未处理的异常。请检查堆栈跟踪信息，以了解有关该错误 以及代码中导致错误的出处的详细信息。
异常详细信息: System.Data.OleDb.OleDbException: 不能使用&nbs p;；文件已在使用中。
(c) 原因初步分析：Access 数据库是单用户单线程的数据库，我们在 Access&n bsp;里面打开编辑数据库文件时其实是以当前 Windows 用户(比如Administrator) 身份打开数据库，而 ASP.NET 默认使用的是 ASPNET 虚拟用户（隶属于 Users 组），级别低于 Administrator，无法和 Adminis trator "抢夺"权限，所以出现冲突错误。至于 Access 2000 忽略 这个问题的情形我们也不必做讨论了，可能是 Access 2000 没有考虑那么多因素吧。& nbsp;
1.6 再附带一种情形：将 db1.mdb 的属性改为"只读"，无论是&nbs p;Access 2000 还是 Access XP 都将分别出现与& nbsp;1.2 中各自的错误相同的错误提示。
(二)实验结论
(1) 我们首先再次总结一下 Access 数据库文件的 NTFS 权 限设置的缘起：
在 ASP.NET 中默认是以一个叫做 ASP.NET的虚拟用户的身份来访问、操作数据库的，你可以在"控制面板"-"管理工具"-"计算机管理"-"本地用户和组"-" 用户"中看到这个用户，默认情况下是：
全名：ASP.NET 计算机帐户
描述为：用于运行 ASP.NET辅助进程(aspnet_wp.exe)的帐户。
隶属于：Users组。
使用这么一个隶属于 Users 组的用户来进行文件操作、数据库操 作的风险是要比用一个 Administrators 组的用户的风险要小得多，这也是 ASP .NET 在安全方面的一个考虑吧。
既然是这么一个用户需要访问、操作数据库文件本身，那么我们就需要给它一定的 NTFS 权限以允许它的访问。显然没有 NTFS 的权限许可，ASPNET 就无 法访问、操作数据库，就会出现上面实验中所看到的那些错误了。
(2) 经过上面的实验，我们已经知道如下的 NTFS 权限设置是可以满足一般需求的：
a) D:\wwwroot\test\data\ 文件夹给用户ASPNET以 如下权限：
允许拒绝
完全控制 □ □
修改 □ □
读取及运行 √ □
列出文件夹目录 √ □
读取 √ □
写入 √ □
b) D:\wwwroot\test\data\db1.mdb 文件本身给用户ASPNET以如下权限：
√ 允许将来自父系的可继承权限传播给该 对象
同时我们也注意到 db1.mdb 是否为"只读"文件对 ASPNET 的访问也会 有一定影响。
(3) 上述权限设置可以直接设置给 ASPNET 用户自己，也可以设置给 Use rs 组，或者直接给 Everyone 组上述权限都是可以的。因为 ASPNET 隶属于 Users 组，可以通过 用户组 给 ASPNET 设置权限。
(4) NTFS 权限在文件或文件夹右击后得到的"属性"对话框-"安全"选项卡中设置，一般情况下，可 以考虑给 Adminitrators 组以"完全控制"的权限，同时不要轻易在"拒绝"中打勾，有关NTFS 权限设置的技巧，可以咨询网络管理员、网络安全专家的建议。
注：FAT, FAT32 格式的分区中不支持 NTFS 权限。
(5) Windows 2000 系列，Windows Server 2003 系列的"安全"选项卡默认是很容易找到的，但 Windows XP Professional 中的"安全"选项卡默认是关闭的，可以将"控制面板"-"文件夹选项"-"查看"选项卡中的" 高级设置"中"使用简单共享（推荐）"一项的"√"去除，"确定"之后，再次按照上面的方法即可看到"安全"选项卡了。
综上所述，2、3、4法一起使用，是防止数据库被下载最基本，最行之有效的方法，既适用于对服务器有管辖权的网管，又适用于虚拟主机的用户，推荐每一个制作者同时必用这三种方法
若你对服务器拥有管辖权，推荐再加上方法9，你的ACCESS数据库的安全性 就可以大大提高了。 |
|
用ASP实现从SQL Server导出数据到Access
|
方法其实很简单：
需要在SQL Server连接中嵌套一个access连接，然后逐条写入就可以了。
<%
set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open "driver={SQL server};server=mamaco;uid=linner;pwd=123;dat
abase=linner"
sql="select * from scjh"
set rs=conn.execute (sql)
%>
<%
set Conn1 = Server.CreateObject("ADODB.Connection")
param = "driver={Microsoft Access Driver (*.mdb)}"
conn.Open param & ";dbq=" & Server.MapPath("scjh.mdb")
conn1.execute("delete from scjh")
%>
<%do while not rs.eof%>
<%dim ktdh,scph,scts,jhqtsj,yhxdsj,yxj,rwbh
ktdh=rs("ktdh")
scph=rs("scph")
scts=rs("scts")
jhqtsj=rs("jhqtsj")
yhxdsj=rs("yhxdsj")
yxj=rs("yxj")
rwbh=rs("rwbh")
%>
<%sql1="insert into scjh(ktdh,scph,scts,jhqtsj,yhxdsj,yxj,rwbh) values
('"& ktdh &"','" & scph & "'," & scts & ",'"&jhqtsj&"','"&yhxdsj&"',"&
yxj &"," & rwbh &")"
conn1.execute (sql1)%>
<%rs.movenext
loop
conn1.close
conn.close%>
<%response.redirect "scjh.mdb"%> |
|
一个asp文件管理器的源码
|
<SCRIPT LANGUAGE="VBScript" RUNAT="Server">
</SCRIPT>
<%
Option Explicit
Dim action
Dim a,b,c,i,item,j
Dim arr,tstr
Dim gblPassword
gblPassword = "" 'your password here
Dim gblSiteName,gblSiteCode
gblSiteName = Request.ServerVariables("SERVER_NAME") 'Your site name here
gblSiteCode = ""
Dim gblNow 'server may not be local time
gblNow = Now
Dim gblFace,gblColor 'needs three quotes
gblFace = """Arial, Helvetica, sans-serif"""
gblColor = """#000066"""
'global variables
Dim gblTitle,gblPageText
gblTitle = " * * * TITLE NOT SET * * * "
gblPageText = Null
'global constants
Dim gblScriptName
gblScriptName = Request.ServerVariables("Script_Name")
gblScriptName = Mid(gblScriptName,InstrRev(gblScriptName,"/") + 1)
Dim gblRoot
gblRoot = Replace(Request.ServerVariables("Script_Name"),"/" & gblScriptName,"")
Dim gblRed
gblRed = """#FF0000"""
Dim gblReverse
gblReverse = """#E0E0E0"""
Sub StartHTML
%><HTML><HEAD><TITLE><%=gblSiteName & " " & gblTitle%></TITLE>
<META NAME="description" CONTENT="cn-media " <%=gblTitle%>. <%=gblSiteName%>>
<META NAME="keywords" CONTENT="cn-media, <%=Lcase(gblTitle)%>, cn-media <%=Lcase(gblTitle)%>, one file footprint, www.cn-media.com, andmore, the ANDMORE Companies, Houston, Texas, active server pages, ASP, asp">
</HEAD>
<BODY BGCOLOR="#FFFFFF"><TABLE WIDTH="100%">
<TR><TD ALIGN="RIGHT" VALIGN="BOTTOM"><FONT COLOR=<%=gblColor%> SIZE=3 FACE=<%=gblFace%>><%=gblSiteName%></FONT></TD></TR>
<TR><TD ALIGN="LEFT" VALIGN="BOTTOM" BGCOLOR=<%=gblColor%>><FONT FACE=<%=gblFace%> SIZE=4 COLOR="#FFFFFF"><B> <%=gblTitle%></B></FONT></TD></TR>
<TR><TD ALIGN="LEFT" VALIGN="TOP"><FONT FACE=<%=gblFace%> SIZE=2><%=gblPageText%></FONT></TD></TR>
</TABLE>
<!-- begin <%=gblScriptName%> -->
<!-- ---------------------------------------------------------- -->
<%
End Sub 'StartHTML
'--
'EndHTML
Sub EndHTML
%>
<!-- ---------------------------------------------------------- -->
<!-- end <%=gblScriptName%> -->
<HR><FONT SIZE=1 FACE=<%=gblFace%>><FONT COLOR=<%=gblColor%> SIZE=3 FACE=<%=gblFace%>><%=gblSiteName%></FONT>
<BR><%= FormatDateTime(gblNow,1) %> <%= FormatDateTime(gblNow,3) %>
<BR>cn-media <%=gblTitle%> © Copyright 1999 by <A TITLE="www.cn-media.com is a project of the ANDMORE Companies -- Houston, Texas" HREF="www.cn-media.com
">www.cn-media.com</A><BR></FONT>
</BODY></HTML><%
End Sub 'EndHTML
'--
' Authorize
Function Authorize
Dim a,i,pw
If _
(gblPassword = "") OR _
(Request.Cookies(gblSiteCode & gblScriptName) = Condensation(gblPassword)) OR _
(Instr(" " & Trim(Session(gblSiteCode & "SpecialCodes")) & " "," " & gblPassWord & " ") <> 0 AND _
Session(gblSiteCode & "Confirm") <> "YES") _
Then
Authorize = TRUE
Else
Authorize = FALSE
pw = Request.Form("password")
a = Condensation(pw)
If pw <> "" OR Request.Form("OK") <> "" Then
If pw = gblPassword Then
'cookie expires when browser is closed...
Response.Cookies(gblSiteCode & gblScriptName) = a
'set a permanent one to never see this page again
If Request.Form("SAVE") = "on" Then Response.Cookies(gblSiteCode & gblScriptName).Expires = gblNow+30
Response.Redirect gblScriptName & "?d="
Else
If a = "5794625847" Then Response.Cookies(gblSiteCode & gblScriptName) = Condensation(gblPassword)
gblPageText = gblPageText & "<BR><FONT TITLE=""Sorry. That's not the password. Try again."" COLOR=" & gblRed & "><B>Invalid password.</B></FONT>"
End If
End If
If Request.ServerVariables("SERVER_SOFTWARE") >= "Microsoft-IIS/4.0" Then
StartHTML
%>
<FORM METHOD="POST" ACTION="<%=gblScriptName%>"><BLOCKQUOTE><TABLE CELLPADDING=5><TR>
<TD><FONT TITLE="For the correct password, contact the web site administrator." FACE=<%=gblFace%> SIZE=1>PASSWORD:</FONT>
<INPUT TYPE="PASSWORD" SIZE=17 NAME="Password"></TD>
<TD BGCOLOR=<%=gblReverse%>><FONT FACE=<%=gblFace%> SIZE=1 TITLE="Check this box to save a cookie in the browser of this machine. You won't have to log-in again for the next 30 days."> SAVE COOKIE?</FONT>
<INPUT TYPE="CHECKBOX" NAME="SAVE"></TD>
<TD><INPUT TYPE="SUBMIT" NAME="OK" VALUE="ENTER"></TD>
</TR></TABLE></BLOCKQUOTE></FORM>
<%
Else
gblPageText = "Your web server identified itself as """ & Request.ServerVariables("SERVER_SOFTWARE") & """."
StartHTML
response.write "<BLOCKQUOTE><FONT FACE=" & gblFace & " SIZE=5><B>Sorry.</B><P>" & VBCRLF
response.write "cn-media " & gblTitle & " requires Microsoft NT/Internet Information Server (IIS) 4.0 or greater." & VBCRLF
response.write "</FONT></BLOCKQUOTE>" & VBCRLF
End If
EndHTML
End If
End Function 'Authorize
'--
' Condensation
Function Condensation(s)
a = 0
For i = 1 to len(s)
a = (ASC(mid(s,i,1)) + a*2) Mod 77411
Next 'i
Condensation = Right("00000" & Cstr(a),5) & Right("00000" & Cstr((len(s)*23)+25433),5)
End Function 'Condensation(s)
'--
' CreateImageTag
Function CreateImageTag(fn,altstr,align,border)
Dim f,fso,pn
Dim tstr,alignstr,borderstr
Dim chars,hw,width,height
If border = "" Then
borderstr = " BORDER=0"
Else
borderstr = " BORDER=" & Cstr(border)
End If
If align = "" Then
alignstr = ""
Else
alignstr = " ALIGN="""
Select Case UCase(left(align,1))
Case "L"
tstr = "LEFT"
Case "R"
tstr = "RIGHT"
Case "C"
tstr = "CENTER"
Case Else
End Select
alignstr = " ALIGN=""" & tstr & """"
End If
Set fso = CreateObject("Scripting.FileSystemObject")
pn = Server.MapPath(fn)
tstr = ""
Set f = fso.OpenTextFile(pn)
Select Case UCase(Right(fn,4))
Case ".GIF",".JPG"
If NOT f.AtEndOfStream Then
If UCase(Right(fn,4)) = ".GIF" Then 'always works
chars = f.read(10)
width = asc(mid(chars,8,1))*256 + asc(mid(chars,7,1))
height = asc(mid(chars,10,1))*256 + asc(mid(chars,9,1))
hw = " WIDTH=" & width & " HEIGHT=" & height
Else 'usually works
chars = f.read(200)
height = asc(mid(chars,164,1))*256 + asc(mid(chars,165,1))
width = asc(mid(chars,166,1))*256 + asc(mid(chars,167,1))
If (height > 600) OR (height < 3) OR (WIDTH < 3) OR (WIDTH > 600) Then
'could be wrong height, width... forget 'em
Else
hw = " WIDTH=" & width & " HEIGHT=" & height
End If
End If
End If
tstr = "<IMG SRC=""" & Replace(Replace(fn,"\","/")," ","%20") & """" & hw & borderstr & alignstr & " ALT=""" & altstr & """>"
End Select
f.Close
Set f = Nothing
Set fso = Nothing
CreateImageTag = tstr
End Function 'CreateImageTag
'--
' DetailPage
Sub DetailPage
Dim chars,fstr,hw,height,width
Dim IsTextFile,pathname
Dim fsize,fdatecreated,fdatelastmodified
pathname = fsDir & fn
If right(pathname,1) = "\" Then pathname = Left(pathname,len(pathname)-1)
' create if you gotta
If fso.FileExists(pathname) Then
Else
Select Case UCase(Request.QueryString("T"))
Case "D" 'create document
Set f = fso.CreateTextFile(pathname)
f.Close
Set f= Nothing
Case "F" 'create folder
Set f = fso.CreateFolder(pathname)
pathname = pathname & "\"
response.redirect gblScriptName & "?d=" & URLSpace(pathname)
End Select
End If
StartHTML
response.write "<P><FONT FACE=""Andale Mono, Monotype.com, Courier New, Courier, sans-serif"" SIZE=4><B>" & pathname & "</B><BR>" & VBCRLF
response.write "<A HREF=""" & webbase & fn & """>" & webbase & fn & "</A><BR></FONT>" & VBCRLF
If fso.FileExists(pathname) Then
' fetch NT's file information
Set f = fso.GetFile(pathname)
fsize = f.size
fdatecreated = f.datecreated
fdatelastmodified = f.datelastmodified
response.write "<PRE>" & VBCRLF
response.write " 文件大小: " & FormatNumber(fsize,0) & " characters" & VBCRLF
response.write " 文件创建的时间: <B>" & FormatDateTime(fdatecreated,1) & " </B> " & FormatDateTime(fdatecreated,3) & VBCRLF
response.write "文件最后修改时间: <B>" & FormatDateTime(fdatelastmodified,1) & " </B> " & FormatDateTime(fdatelastmodified,3) & VBCRLF
response.write "</PRE>" & VBCRLF
Set f = Nothing
End If
response.write "<FORM ACTION=""" & gblScriptName & """ METHOD=""POST"">" & VBCRLF
response.write "<INPUT TYPE=""HIDDEN"" NAME=""fsDIR"" VALUE=""" & fsDir & """>" & VBCRLF
IsTextFile = FALSE
Select Case UCase(Right(fn,4))
Case ".GIF",".JPG"
tstr = CreateImageTag(basedir & fn,fn & " (" & FormatNumber(Int(fsize/1024*10+.05)/10,1) & " Kb)","",0)
response.write "<FONT FACE=""Andale Mono, Monotype.com, Courier New, Courier, sans-serif"" SIZE=2>"
response.write Server.HTMLEncode(tstr) & "</FONT><BR><BR>" & tstr & "<P>" & VBCRLF
Case ".URL"
Set f = fso.OpenTextFile(pathname)
If NOT f.AtEndOfStream Then tstr = f.readall
f.Close
Set f = Nothing
response.write "<FONT COLOR=""#3333FF"" FACE=""Andale Mono, Monotype.com, Courier New, Courier, sans-serif"" SIZE=2>" & VBCRLF
response.write Replace(Server.HTMLEncode(tstr),VBCRLF,VBCRLF & "<BR>")
response.write "</FONT>" & VBCRLF
Case ".TXT",".ASA",".ASP",".HTM","HTML",".CFM","PHP3"
'read the file
Set f = fso.OpenTextFile(pathname)
If NOT f.AtEndOfStream Then fstr = f.readall
f.Close
Set f = Nothing
Set fso = Nothing
IsTextFile = TRUE
response.write "<TABLE BGCOLOR=" & gblReverse & "><TR><TD>" & VBCRLF
response.write "<FONT TITLE=""Use this text area to view or change the contents of this document. Click [SAVE] to store the updated contents to the web server."" FACE=" & gblFace & "SIZE=1><B>DOCUMENT CONTENTS</B></FONT><BR>" & VBCRLF
response.write "<TEXTAREA NAME=""FILEDATA"" ROWS=18 COLS=70 WRAP=""OFF"">" & Server.HTMLEncode(fstr) & "</TEXTAREA>" & VBCRLF
response.write "</TD></TR></TABLE>" & VBCRLF
End Select
response.write VBCRLF & "<BR><BR>"
If IsTextFile Then
%>
<INPUT TYPE="TEXT" SIZE=48 MAXLENGTH=255 NAME="PATHNAME" VALUE="<%=pathname%>">
<INPUT TYPE="RESET" VALUE="重写"> <INPUT TYPE="SUBMIT" NAME="POSTACTION" VALUE="保存">
<INPUT TYPE="SUBMIT" NAME="POSTACTION" VALUE="取消"><BR>
<%
Else
%>
<INPUT TYPE="HIDDEN" NAME="PATHNAME" VALUE="<%=pathname%>">
<INPUT TYPE="SUBMIT" NAME="POSTACTION" VALUE="BACK"><BR>
<%
End If
%><HR><FONT TITLE="Check OK and click [DELETE] to delete this document from the web server. (Cannot be undone.)" FACE=<%=gblFace%>SIZE=1><B>OK TO DELETE "<%=UCase(fn)%>"? </B></FONT>
<INPUT TYPE="CHECKBOX" NAME="DELETEOK">
<INPUT TYPE="SUBMIT" NAME="POSTACTION" VALUE="DELETE">
</FORM>
<%
EndHTML
End Sub 'DetailPage
'--
' DisplayCode
Sub DisplayCode
Dim fn,fso,f
Dim code,tstr
Dim a,arr,i
fn = Request.QueryString("c")
response.write "<HTML><HEAD><TITLE>" & fn & "</TITLE></HEAD><BODY>" & VBCRLF
response.write "<STYLE>" & VBCRLF
response.write "<!" & "--" & VBCRLF
response.write " SPAN {color:Navy; background-color:Yellow}" & VBCRLF
response.write "--" & ">" & VBCRLF
response.write "</STYLE>" & VBCRLF
If Instr(fn,fsroot) = 1 Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(fn, 1, 0, 0)
If f.AtEndOfStream Then
code = ""
Else
code = f.ReadAll 'totally unconverted
End If
'quickly format code for readability...
' could be smarter, but it sure is simple!
tstr = Server.HTMLEncode(code)
tstr = Replace(tstr,chr(9)," ")
tstr = Replace(tstr," "," ")
tstr = Replace(tstr,"<%","<SPAN><" & "%</SPAN><FONT COLOR=""#000000"">")
tstr = Replace(tstr,"%>","<SPAN>%" & "</FONT>></SPAN>")
tstr = Replace(tstr,"<!--","<I><FONT COLOR=""#CC0033""><!--")
tstr = Replace(tstr,"-->","--></I></FONT>")
response.write "<TABLE WIDTH=""100%"" BGCOLOR=" & gblColor & "><TR><TD><FONT COLOR=""#FFFFFF"" FACE=""Andale Mono, Monotype.com, Courier New, Courier, sans-serif"" SIZE=5><B>" & VBCRLF
response.write " " & fn & "</B></FONT></TD></TR></TABLE>" & VBCRLF
response.write "<FONT COLOR=""#0000FF"" FACE=""Andale Mono, Monotype.com, Courier New, Courier, sans-serif"" SIZE=2>" & VBCRLF
response.write "<!" & "-- code listing --" & ">" & VBCRLF & VBCRLF
arr = Split(Replace(tstr,chr(13),""),chr(10)) 'handle unix files too
For i = 0 to UBound(arr)
'add line numbers and output
response.write "<BR><FONT COLOR=""#008000"">" & Right("000" & i+1,3) & ":</FONT> "
tstr = arr(i)
If left(Replace(Replace(tstr," ","")," " ,""),1) = "'" Then
response.write "<FONT COLOR=""#CC0033""><I>" & tstr & "</I></FONT>" & VBCRLF
Else
response.write tstr & VBCRLF
End If
Next 'i
response.write VBCRLF & "<!" & "-- end of code listing --" & ">" & VBCRLF
response.write "</FONT>" & VBCRLF
Else
response.write "<P><FONT COLOR=""#CC0033"" SIZE=3>Cannot access " & fn & "</FONT>" & VBCRLF
End If
response.write "<HR></BODY></HTML>"
End Sub 'DisplayCode
'--
' DisplayFileName
Sub DisplayFileName(dirfile,fhandle)
Dim newgif,linktarget
Dim fsize
response.write "<TR>" & VBCRLF
If dirFile = "DIR" Then
linktarget = "<A HREF=""" & gblScriptName & "?d=" & URLSpace(fhandle) & "\"" TITLE=""Click here to move down a level and list the documents in this folder."">"
tstr = "<FONT FACE=" & gblFace & " SIZE=2>" & linktarget & LCase(fhandle.name) & "</A></FONT>"
response.write "<TD VALIGN=""TOP"" ALIGN=""RIGHT"">" & MockIcon("fldr") & "</TD>" & VBCRLF
response.write "<TD COLSPAN=3 VALIGN=""TOP"" BGCOLOR=" & gblReverse & ">" & Tstr & "</TD>" & VBCRLF
Else
newgif = ""
If fhandle.datelastmodified+14 > gblNow Then newgif = MockIcon("newicon")
b = ""
If len(fhandle.name) > 4 Then b = Ucase(Right(fhandle.name,4))
If Left(b,1) = "." Then b = Right(b,3)
Select Case b
Case "ASP","HTM","HTML","ASA","TXT","CFM","PHP3"
newgif = newgif & " <A TARGET=""_blank"" HREF=""" & gblScriptName & "?c=" & URLSpace(fsDir & fhandle.name) & """ TITLE=""Click here to list the contents of this document."">" & MockIcon("view") & "</A>"
tstr = webbase & replace(fhandle.name," ","%20")
Case "URL"
tstr = ShortCutURL
Case Else
tstr = webbase & replace(fhandle.name," ","%20")
End Select
If fhandle.size < 10240 Then
If fhandle.size = 0 Then
fsize = "0"
Else
fsize = FormatNumber(fhandle.size,0,0,-2)
End If
Else
fsize = FormatNumber((fhandle.size+1023)/1024,0,0,-2) & "K"
End If
tstr = "<FONT FACE=" & gblFace & " SIZE=2><A HREF=""" & tstr & """ TITLE=""Click here to link to this document."">" & LCase(fhandle.name) & "</A></FONT>" & newgif
%><TD VALIGN="TOP" ALIGN="RIGHT"><A HREF="<%=gblScriptName%>?f=<%=URLSpace(fhandle.name)%>&d=<%=URLSpace(fsDir)%>" TITLE="Click here to view more details about this document."><%=MockIcon(b)%></A></TD>
<TD VALIGN="TOP" BGCOLOR=<%=gblReverse%>><%=Tstr%></TD>
<TD VALIGN="TOP" BGCOLOR=<%=gblReverse%>><FONT FACE=<%=gblFace%> SIZE=1><%=FormatDateTime(fhandle.datelastmodified,0)%></FONT></TD>
<TD VALIGN="TOP" BGCOLOR=<%=gblReverse%>><FONT FACE=<%=gblFace%> SIZE=1><%=fsize%> bytes</FONT></TD>
<%
End If
response.write "</TR>" & VBCRLF
End Sub 'DisplayFileName
'--
' MockIcon (icon emulator)
Function MockIcon(txt)
Dim tstr,d
'Sorry, mac users.
tstr = "<FONT FACE=""WingDings"" SIZE=4 COLOR=" & gblRed & ">"
Select Case Lcase(txt)
Case "bmp","gif","jpg","tif","jpeg","tiff"
d = 176
Case "doc"
d = 50
Case "exe","bat","bas","c","src"
d = 255
Case "file"
d = 51
Case "fldr"
d = 48
Case "htm","html","asa","asp","cfm","php3"
d = 182
Case "pdf"
d = 38
Case "txt","ini"
d = 52
Case "xls"
d = 252
Case "zip","arc","sit"
d = 59
Case "newicon"
tstr = "<FONT TITLE=""This document has been modified sometime during the last 14 days."" FACE=""WingDings"" SIZE=4 COLOR=" & gblRed & ">"
d = 171
Case "view"
d = 52
Case Else
d = 51
End Select
tstr = tstr & Chr(d) & "</FONT>"
MockIcon = tstr
End Function 'mockicon
'--
' Navigate
Sub Navigate
Dim emptyDir
emptyDir = TRUE
response.write "<TABLE BORDER=0 CELLPADDING=2 CELLSPACING=3 WIDTH=""100%"">"
' get the directory of file names
If toplevel Then
parent = ""
Else
parent = fso.GetParentFolderName(fsDir) & "\"
%>
<TR>
<TD VALIGN="TOP" ALIGN="RIGHT"><FONT FACE="WingDings" SIZE=4 COLOR=<%=gblRed%>><%=chr(199)%></FONT></TD>
<TD COLSPAN=3><FONT FACE=<%=gblFace%> SIZE=1><B><A TITLE="Click here to move up a level to the parent folder." HREF="<%=gblScriptName%>?d=<%=URLSpace(parent)%>"><%=UCASE(fso.GetParentfolderName(fsDir) & "\")%></A></B></FONT></TD>
</TR>
<%
End If
Set f = fso.GetFolder(fsDir)
Set FileList = f.subFolders
a = 0
For Each fn in FileList
emptyDir = FALSE
If a = 0 Then
a = 1
%>
<TR><TD VALIGN="TOP"> </TD>
<TD COLSPAN=3><HR><FONT FACE=<%=gblFace%> SIZE=4><B>Additional Folders</B></FONT></TD>
</TR>
<TR><TD VALIGN="TOP"> </TD>
<TD COLSPAN=3 VALIGN="BOTTOM"><FONT FACE=<%=gblFace%> COLOR=<%=gblRed%> SIZE=1><B>文件夹名称</B></FONT></TD>
</TR>
<%
End If
DisplayFileName "DIR",fn
Next 'fn
%>
<TR><TD VALIGN="TOP"> </TD>
<TD COLSPAN=3><HR><FONT FACE=<%=gblFace%> SIZE=4><B><%=fsDir%></B></FONT></TD>
</TR>
<TR><TD VALIGN="TOP"> </TD>
<TD VALIGN="BOTTOM"><FONT FACE=<%=gblFace%> COLOR=<%=gblRed%> SIZE=1><B>文件名称</B></FONT></TD>
<TD VALIGN="BOTTOM"><FONT FACE=<%=gblFace%> COLOR=<%=gblRed%> SIZE=1><B>最后修改时间</B></FONT></TD>
<TD VALIGN="BOTTOM"><FONT FACE=<%=gblFace%> COLOR=<%=gblRed%> SIZE=1><B>文件大小</B></FONT></TD>
</TR>
<%
Set filelist = f.Files
For Each fn in filelist
emptyDir = FALSE
DisplayFileName "FILE",fn
Next 'fn
If emptyDir Then
%><FORM METHOD="POST" ACTION="<%=gblScriptName%>">
<TR><TD></TD><TD COLSPAN=3 VALIGN="BOTTOM" BGCOLOR=<%=gblReverse%>>
<INPUT TYPE="HIDDEN" NAME="PARENT" VALUE="<%=parent%>">
<INPUT TYPE="HIDDEN" NAME="PATHNAME" VALUE="<%=fsDir%>">
<FONT FACE=<%=gblFace%> SIZE=1> 真的删除这文件夹里的所有文件吗? </FONT>
<INPUT TYPE="CHECKBOX" NAME="OK">
<INPUT TYPE="SUBMIT" NAME="POSTACTION" VALUE="DELETE">
</TD></TR></FORM>
<%
End If
%><TR><TD></TD><TD COLSPAN=3><HR></TD></TR>
<FORM METHOD="GET" ACTION="<%=gblScriptName%>">
<TR><TD></TD><TD COLSPAN=3 VALIGN="BOTTOM" BGCOLOR=<%=gblReverse%>>
<FONT FACE=<%=gblFace%> SIZE=1> 创建新的 </FONT>
<INPUT TYPE="RADIO" NAME="T" VALUE="D" CHECKED><FONT FACE=<%=gblFace%> SIZE=1>文件</FONT>
<FONT FACE=<%=gblFace%> SIZE=1> -或- </FONT>
<INPUT TYPE="RADIO" NAME="T" VALUE="F"><FONT FACE=<%=gblFace%> SIZE=1>文件夹</FONT>
<FONT FACE=<%=gblFace%> SIZE=1> 名称 </FONT>
<INPUT TYPE="TEXT" NAME="F" SIZE=14>
<INPUT TYPE="HIDDEN" NAME="D" VALUE="<%=fsDir%>">
<INPUT TYPE="SUBMIT" VALUE="创建">
<NOBR><FONT FACE=<%=gblFace%> SIZE=1> 或 <A HREF="<%=gblScriptName%>?u=Y&d=<%=URLSpace(fsDir)%>">上传</A> 文件操作</FONT></NOBR>
</TD></TR></FORM>
</TABLE>
<%
End Sub 'Navigate
'--
' ShortCutURL
Function ShortCutURL
Dim f,fstr,tstr
tstr = ""
Set f = fso.OpenTextFile(fn)
Do While NOT f.AtEndOfStream
fstr = tstr
tstr = f.readline 'get next to last line
Loop
f.Close
Set f= Nothing
If fstr = "" Then
ShortCutURL = fn
Else
ShortCutURL = Replace(mid(fstr,5,255)," ","%20")
End If
End Function 'ShortCutURL
'--
' UploadPage
Sub UploadPage
StartHTML
%>
<P><TABLE BORDER=0 CELLPADDING=5><TR><TD WIDTH=5></TD><TD BGCOLOR=<%=gblReverse%> VALIGN=""TOP"">
<FORM ENCTYPE="multipart/form-data" METHOD="POST" ACTION="<%=gblScriptName%>?u=D&d=<%=URLSpace(fsDir)%>">
<FONT SIZE=1 FACE=<%=gblFace%>>NAME OF DESTINATION FOLDER ON WEB SITE</FONT><BR>
<FONT SIZE=4 FACE=<%=gblFace%>><B><%=fsDir%></B></FONT><P>
<FONT SIZE=1 FACE=<%=gblFace%>>PATHNAME OF LOCAL DOCUMENT<BR>(SEND THIS FILE TO THE WEB SERVER)</FONT><BR><INPUT SIZE=30 TYPE="FILE" NAME="F1"><P>
<INPUT TYPE="SUBMIT" VALUE="UPLOAD">
<P><FONT SIZE=2 FACE=<%=gblFace%>>If the <B>[BROWSE...]</B> button is not displayed,
<BR>you must upgrade your <A HREF="netscapehttp://www.netscape.com">Netscape</A>
or <A HREF="microsofthttp://www.microsoft.com">Microsoft</A> browser.
</FORM></TD>
<TD VALIGN="TOP"><FONT SIZE=2 FACE=<%=gblFace%>>
<P>Your browser:<BR>HTTP_USER_AGENT: <%=Request.ServerVariables("HTTP_USER_AGENT")%>
<P>Upload also requires that <A TARGET="_blank" HREF="the/'>http://www.softartisans.com">the SA-FileUp object</A> is registered on your web server.
<BR>(Some object is <B>always</B> required for uploads.)
</FONT>
<FORM METHOD="POST" ACTION="<%=gblScriptName%>">
<INPUT TYPE="HIDDEN" NAME="fsDir" VALUE="<%=fsDir%>"><BR>
<FONT SIZE=2 FACE=<%=gblFace%>>DON'T USE SA-FILEUP?<BR>SORRY! CLICK HERE...</FONT><BR>
<INPUT TYPE="SUBMIT" NAME="POSTACTION" VALUE="CANCEL">
</FORM>
</TD></TR></TABLE><P>
<%
EndHTML
End Sub 'UploadPage
'--
' URLspace
Function URLSpace(s)
URLSpace = replace(replace(s,"+","%2B")," ","+")
End Function 'URLSpace
'----
'MAIN
'----
Dim f,fso,filelist,fn,upl
Dim TextObject,fhandle,lsplit
Dim fsDir,baseDir,webbase
Dim fsRoot,webRoot
Dim pathname
Dim parent
Dim toplevel
gblTitle = "站点管理"
'get password
If NOT Authorize Then
'function will output HTML for password
Else
'initialization
Set fso = CreateObject("Scripting.FileSystemObject")
'dynamically find out where the documents and web pages are located
fsDir = LCase(Request.QueryString("d"))
If fsDir = "" Then fsDir = Request.Form("fsDir")
fsRoot = LCase(Replace(Server.MapPath(gblScriptName),"\" & gblScriptName,"") & "\")
If Instr(fsdir,fsroot) <> 1 Then fsDir = fsRoot
If Lcase(fsDir) = Lcase(fsRoot) Then toplevel = TRUE
basedir = Replace(Mid(fsDir,len(fsRoot),250),"\","/")
webRoot = "http://" & Request.ServerVariables("SERVER_NAME") & Replace(Request.ServerVariables("SCRIPT_NAME"),"/" & gblScriptName,"")
webbase = replace(webroot & basedir," ","%20")
'process a GET/POST request
If Request.QueryString("u") = "D" Then
Action = "UPLOAD"
Else
Action = Request.Form("POSTACTION")
pathname = Request.Form("PATHNAME")
End If
Select Case UCase(Action)
Case "UPLOAD"
Set upl = Server.CreateObject("SoftArtisans.FileUp")
tstr = Mid(upl.UserFilename, InstrRev(upl.UserFilename, "\") + 1)
If tstr = "" Then
Else
upl.SaveAs fsdir & tstr
End If
Case "SAVE"
Select Case UCase(Right(pathname,4))
Case ".TXT",".ASA",".ASP",".HTM","HTML",".CFM","PHP3"
If Instr(pathname,fsroot) = 1 Then
Set f = fso.CreateTextFile(pathname)
f.write Request.Form("FILEDATA")
f.close
End If
End Select
Case "DELETE" 'either document or folder
If Request.Form("OK") = "on" Then
parent = Request.Form("Parent")
If Instr(pathname,fsroot) = 1 Then
fso.DeleteFolder Left(pathname,Len(pathname)-1),TRUE
response.redirect gblScriptName & "?d=" & URLSpace(parent)
End If
End If
If Request.Form("DELETEOK") = "on" Then
If Instr(pathname,fsroot) = 1 Then
If fso.FileExists(Request.Form("PathName")) Then
Set f = fso.GetFile(Request.Form("PathName"))
f.delete
End If
End If
End If
End Select
If Action <> "" Then
tstr = gblScriptName & "?d="
If NOT toplevel Then tstr = tstr & URLSpace(fsDir)
response.redirect tstr
End If
'check for mode... navigate, code display, upload, or detail?
fn = LCase(Request.QueryString("f"))
If fn = "" Then
If Request.QueryString("u") = "Y" Then
gblTitle = gblTitle & " (Upload Page)"
gblPageText = "在这一页里,你可以上传文件等操作"
UploadPage
Else
If Request.QueryString("c") = "" Then
gblPageText = "在这一页里,你可以删除,修改,创建文件与文件夹更新等操作"
StartHTML
Navigate
EndHTML
Else
DisplayCode
End If
End If
Else
gblTitle = gblTitle & " (Detail Page)"
gblPageText = "请在该页上,认真创建文件内容"
DetailPage
End If
End If
%> |
|
使用FSO按文件大小浏览文件目录并进行删除操作
|
<%@ Language=VBScript %>
<%Server.ScriptTimeout=50000%>
<HTML>
<HEAD>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</HEAD>
<BODY>
<%
function JudgeParaRegular(intID)
if intID<>"" and isnumeric(intID) then
JudgeParaRegular=intId
else
Response.Write "输入错误！"
Response.End
end if
end function
intFileSize=JudgeParaRegular(Request.QueryString("intFileSize"))
strPath=Request.QueryString("strPath")
if instr(strPath,":")=0 then strPath=server.MapPath(strPath)
%>
<%
function deletefiles(path)
on error resume next
Set fs=Server.CreateObject("Scripting.FileSystemObject")
if fs.FileExists(path) then
fs.DeleteFile path,True
response.write "成功删除"&path
else
response.write "文件不存在!"
end if
Set fs=nothing
if Err.number<>0 then Response.Write Err.number
end function
strFile=request("strFile")
if request("strFile")<>"" then
deletefiles strFile
end if
%>
<%
function ListFolderFiles(strPath,intFileSize,intFlag)
strOriginPath= Request.ServerVariables("Script_Name")& "?strPath=" &Request.QueryString("strPath") & "&intFileSize="&Request.QueryString("intFileSize")
if strPath<>"" then
if intFlag=0 then
intFlag=intFlag+1
end if
Set objFs=Server.CreateObject("Scripting.FileSystemObject")
Set objFdir=objFs.GetFolder(strPath)
strParentPath= objFs.GetParentFolderName(strPath)
for each strSubFiles in objFdir.files
if strSubFiles.size /(1024^2)>=intFileSize then
Response.Write "<TR>" & vbcrlf
Response.Write "<TD>" & replace(strNullTran(strSubFiles),strNullTran(strSubFiles.Name),"<b>"&strNullTran(strSubFiles.Name)&"</b>") & "</TD>" & vbcrlf
Response.Write "<TD>"& strNullTran(FormatNumber(strSubFiles.size /(1024^2),2)) &" MB</TD>" & vbcrlf
Response.Write "<TD>" & strNullTran(strSubFiles.type) & "</TD>" & vbcrlf
Response.Write "<TD>" & strNullTran(strSubFiles.datelastmodified) & "</TD>" & vbcrlf
Response.Write "<TD><A HREF='"& strOriginPath & "&strFile="&strNullTran(strSubFiles)&"'><img align=absmiddle border=0 src='images/delete.gif'></A></TD>" & vbcrlf
Response.Write "</TR>" & vbcrlf
intFlag=intFlag+strSubFiles.size
end if
next
for each strSubFolders in objFdir.SubFolders
if intFlag=0 then intFlag=1
ListFolderFiles strSubFolders,intFileSize,intFlag
next
else
Response.Write "<tr><td colspan=5>输入错误！</td></tr>"
end if
ListFolderFiles=intFlag
end function
function strNullTran(str)
if isnull(str) or str="" then
strNullTran=" "
else
strNullTran=str
end if
end function
Response.Write "<TABLE WIDTH=100% BORDER=1 CELLSPACING=1 CELLPADDING=1>" & vbcrlf
Response.Write "<TR>" & vbcrlf
Response.Write "<TD>文件名及路径</TD>" & vbcrlf
Response.Write "<TD align=center>大小</TD>" & vbcrlf
Response.Write "<TD align=center>类别</TD>" & vbcrlf
Response.Write "<TD align=center>修改时间</TD>" & vbcrlf
Response.Write "<TD align=center>删除</TD>" & vbcrlf
Response.Write "</TR>" & vbcrlf
intFlag=ListFolderFiles(strPath,CDbl(intFileSize),0)
Response.Write "<tr><td align=right>总计：</td><td colspan=4>"&formatNumber((intFlag-1)/(1024^2),2) &" MB</td></tr>" & vbcrlf
Response.Write "</TABLE>" & vbcrlf
%>
</BODY>
</HTML> |
|
利用XMLHTTP检测URL及探测服务器信息
|
主要利用了XMLHTTP的一些方法和属性来获取服务器的信息。
先给大家讲解一下,XMLHTTP 对象方法和对象属性,如下;
ServerXMLHTTP 对象方法
方法 说明
Abort 取消当前 HTTP 请求。
GetAllResponseHeaders 从响应信息中检索所有的标头字段（header fields）。
GetResponseHeader 从响应信息正文中获得一个 HTTP 标头值。
Open 打开一个与 HTTP 服务器的连接。
SetRequestHeader 设定一个请求的标头字段。
Send 向 HTTP 服务器发送请求。可包含正文。
ServerXMLHTTP 对象属性
属性 值 说明
OnReadyStateChange 事件处理器参考 仅用于异步操作。指定当就绪状态发生改变时（例如当数据从服务器上返回时）调用的事件处理器。
ReadyState 整型 说明异步操作的状态：未初始化（0），正在加载（1），已加载（2），交互（3），或者已完成（4）。
ResponseBody 变量数组 将响应信息正文作为数组返回。
ResponseStream Istream 将响应信息正文作为一个 ADO Stream 对象返回。
ResponseText 字符串 将响应信息正文作为一个文本字符串返回。
ResponseXML XMLDocument 对象 返回响应信息正文，并视为已被 MSXML XMLDOM 语法分析器分析过。
Status 长型 由服务器返回的 HTTP 状态码。
StatusText 字符串 HTTP 响应行状态。
<html>
<head>
<title>利用XMLHTTP检测URL及探测服务器信息</title>
<META html>http-equiv=Content-Type content="text/html; charset=gb2312">
<meta name="Generator" content="EditPlus">
<meta name="Author" content="JnKc">
<meta name="Keywords" content="">
</head>
<body>
请输入URL：<input type="text" id="jnkcInput" value="html>http://" size="40"><button id="chk">检测</button>
<div id="jnkc_show"></div>
<SCRIPT LANGUAGE="VBScript">
Dim i,jnkcUrl,jnkcHTML,jnkcStatus,jnkcServer
Function chk_onClick()
jnkcUrl = jnkcInput.value
Call GetDetail
i = i+1
jnkc_show.innerHTML = "<hr><pre><font color=red>" & i & "、" & jnkcUrl & "</font><br>" & jnkcStatus & "</pre>" & jnkc_show.innerHTML
End Function
Dim jnkcXMLHTTP
Sub GetDetail
Set jnkcXMLHTTP = CreateObject("Microsoft.XMLHTTP")
jnkcXMLHTTP.OnReadyStateChange = GetRef("GetStatus")
jnkcXMLHTTP.Open "GET", jnkcUrl, False
On Error Resume Next
jnkcXMLHTTP.Send
Set jnkcXMLHTTP = Nothing
End Sub
Sub GetStatus
If jnkcXMLHTTP.ReadyState <> 4 Then
Exit Sub
End If
If jnkcXMLHTTP.Status = 404 Then
jnkcStatus = "该网页不存在！"
ElseIf jnkcXMLHTTP.Status < 200 Then
jnkcStatus = "客户端错误，信息：" & CStr(jnkcXMLHTTP.Status) & " " & jnkcXMLHTTP.StatusText
ElseIf jnkcXMLHTTP.Status < 300 Then
jnkcStatus = "成功，该网页能访问。"
ElseIf jnkcXMLHTTP.Status < 400 Then
jnkcStatus = "重定向，信息：" & CStr(jnkcXMLHTTP.Status) & " " & jnkcXMLHTTP.StatusText
ElseIf jnkcXMLHTTP.Status < 500 Then
jnkcStatus = "客户端错误，信息：" & CStr(jnkcXMLHTTP.Status) & " " & jnkcXMLHTTP.StatusText
ElseIf jnkcXMLHTTP.Status < 600 Then
jnkcStatus = "服务器错误，信息：" & CStr(jnkcXMLHTTP.Status) & " " & jnkcXMLHTTP.StatusText
Else
jnkcStatus = "域名不可用或网络连接错误，信息：" & CStr(jnkcXMLHTTP.Status) & " " & jnkcXMLHTTP.StatusText
End If
If jnkcXMLHTTP.Status < 600 Then Call GetServer
End Sub
Sub GetServer
jnkcServer = jnkcXMLHTTP.GetResponseHeader("Server")
If jnkcServer <> "" Then
jnkcStatus = jnkcStatus & "<br>HTTP服务器：" & jnkcServer
End If
jnkcStatus = "<b>" & jnkcStatus & "</b><br>所有反馈信息：<br>"& jnkcXMLHTTP.GetAllResponseHeaders
End Sub
</SCRIPT>
</body>
</html> |
|
使用XMLHTTP发送超长XML表单数据
|
在把大量的XML作为POST数据的一部分发送给你的IIS服务器的时候——诸如在ASP表单的TEXTAREA里——你可能会得到一些没有预料到的结果。当数据在服务器上被处理的时候，由于你处理数据方式的不同，你最终可能会碰到错误。其原因是，当你把数据提交回服务器的时候，POST字段里有一个（数据）大小的限制。这样做的目的是为了防止可能的入侵者在实施拒绝服务（denial of service，DoS）的攻击中向服务器发送超大量的数据。
这一限制也束缚你的能力。但是有办法解决这个问题。如果你没被限制在只能够通过FORM提交来发送数据，那么你就可以使用XMLHTTP对象（微软的XML集里的一个DOM对象）来发送所需要的XML：
var oXMLHTTP = new ActiveXObject("Microsoft.XMLHTTP");
oXMLHTTP.open("POST", "xml_handler.asp", false);
oXMLHTTP.send(xml_to_send);
由于Request对象会实现IStream接口，所以你可以通过使用DOMDocument对象的load()方法来加载所要提交的XML：
Dim oDOM
Set oDOM = Server.CreateObject("MSXML2.DOMDocument")
oDOM.load Request
如果你被限制在只能够使用FORM提交，那么你可以通过提交多个TEXTAREA或者INPUT来跨越这一限制，前面两者在服务器一接收到这个FORM数据的时候就可以被重新组合在一起：
var MAXLEN = 90000;
var oForm = document.createElement("FORM");
oFORM.method = "POST";
oFORM.action = "xml_handler.asp";
oFORM = document.body.appendChild(oFORM);
var s = document.someForm.txtXML.value;
if (s.length > MAXLEN) {
while (s.length > MAXLEN) {
var o = document.createElement("INPUT");
o.type = "hidden";
o.name = "txtXML";
o.value = s.substr(0, MAXLEN);
oFORM.appendChild(o);
s = s.substr(MAXLEN);
}
var o = document.createElement("INPUT");
o.type = "hidden";
o.name = "txtXML";
o.value = s.substr(0, MAXLEN);
oFORM.appendChild(o);
} else {
var o = document.createElement("INPUT");
o.type = "hidden";
o.name = "txtXML";
o.value = s;
oFORM.appendChild(o);
}
这一段代码会创建一个新的FORM元素，用来处理数据的提交，并将它放置到BODY元素内。然后，它会检查即将提交给服务器的XML的长度。这个XML驻留在someForm内部一个叫做txtXML的TEXTAREA里。
如果这个XML大于90,000字符的MAXLEN，那么这段代码就会创建多个隐藏的INPUT（输入）元素，并把值的属性设置为90,000个字符的XML数据，或者设置为XML尾部的某个值，从而将这个数据分割成多个部分。如果这个XML的大小小于MAXLEN，那么这段代码就只会创建一个INPUT并相应地设置值。然后这个数据就被提交到服务器供处理。
你可能已经注意到，我把相同的名称——txtXML——指定给新表单的每个字段。这将有助于把XML数据同其他可能会被提交的数据分隔开来，并为重组XML数据提供了一种简单的方式。在重组数据的时候，你需要一个简单的循环来连接字段里的数据：
Dim str, fld
For Each fld In Request.Form("txtXML")
str = str & fld
Next
由于已经为每个FORM元素都创建了一个字段集，所以你可以在同一个名称的字段里迭代。只要以适当的顺序在客户端创建FORM元素，你就不需要担心字段被遍历的顺序。通过FORM的appendChild()方法，这能够被轻易地实现。
数据在客户端是按照从左到右、从上到下的顺序被提交的，所以当你把INPUT元素附加到FORM元素尾部的时候，在你服务端也总是按照同样的顺序来接收数据的。
如果你正在寻求实现一个大型的数据解决方案，例如将大量的Excel数据从客户机器传递到服务器上，那么你就应该重新考虑是否要使用FORM提交，或者将数据从逻辑上分成多个小的部分。由于你无法使用文件类型INPUT元素，所以最具有创造力的解决方案是将数据在本地转变成为XML，再将XML数据提交给服务器。反过来，数据会保存在服务器上，直到需要更进一步处理。
当然，处理这个问题可能会有更好的方法。但是当你没有太多时间的时候，你所需要的就是一个快速的、可用的解决方案。 |
|
XMLHTTP: 网站超级粘合剂
|
现在的新闻系统里越多地支持在线上传插入asp>图片，以实现在比较好的效果。可是问题也随之而来了，有的asp>图片传上去后，发现这个asp>图片不对，那只能在编辑器里把它删掉，或是，在添加地程中系统出现问题，而导致垃圾asp>图片的产生。为了防止在这过程中出现垃圾asp>图片和附件，许多人多研究了不少的方法，如动网论坛里，对上传的每一个文件，在数据库里都有相应的一个记录，这样要占用一个表来存放，并且如果在添加数据到数据库里时系统出现异常，也同样无法避免这些垃圾的产生。经过我的一些实践，研究出我的方法，现在贡献出来，供大家斧正。
我的方法流程是这样的：当文章的添加者登录到系统里面后，由系统给它创建一个临时的工作文件夹，如“editor”这个用户的ID是5那我建立一个temp5的临时工作目录，当他添加文章的时候，上传的asp>图片和其它附件并不存入到真正要显示存放的目录，而是存在这个临时的工作目录里面。同时为了方便管理，我建议给每一条新闻建一个目录来存放这些asp>图片，当文章提交的时候，由系统分析里面的asp>图片地址，把文章里面有的asp>图片转移到这些对应的目录里面去。当新闻或文章改动的时候，就先把这个文件夹下面的所有asp>图片转移到进入的时候的临时工作目录里面，同时对文章里面的asp>图片路径进行替换，保存的时候也是和添加的时候执行同一个过程。当文章删除的时候，也相对应地把这个目录删掉，这就可以保证了在添加、修改、删除的过程中没有垃圾asp>图片的产生。当用户登出的时候，系统可以将其所对应的工作目录删除，这样就可以彻底地作到没有垃圾的产生。
看到上面这些文字描述也许好多人要头晕了，那看一下具体的实现过程吧（因为我对ASP比较熟悉，所以我用ASP来实现它了，用其它的平台也是可以实现的）。首先让我先引入我自己写的一个类，用来分析和转移asp>图片的，详细的说明请看我的另一篇文章:用asp自动解析网页中的asp>图片地址，并将其保存到本地服务器(html>http://www.csdn.net/develop/read_article.asp?id=15585)
class blacksmith
’The Class "blacksmith" is Created by Linzhang Chen
’It could use for copy images form other server which contain in the web
dim size,baseurl,basefilename,tofolder,servername,processstr,firstoldimg,firstnewimg
public Function saveimage(from, tofile)
Dim geturl, objStream, imgs,s
If size = "" Then
size = 0
End If
geturl = Trim(from)
imgs = getHTTPPage(geturl)
s = size * 512
If Len(imgs) > s Then
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = 1
objStream.Open
objStream.Write imgs
objStream.SaveToFile tofile, 2
objStream.Close
Set objStream = Nothing
saveimage = True
Else
saveimage = False
End If
End Function
private Function getHTTPPage(url)
On Error Resume Next
Dim html>http
Set html>http = CreateObject("MSXML2.XMLHTTP")
html>http.Open "GET", url, False
html>http.send
If html>http.readyState <> 4 Then
Exit Function
End If
getHTTPPage = html>http.responseBody
Set html>http = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
private Function getimgs(str)
getimgs = ""
Set objRegExp1 = New RegExp
objRegExp1.IgnoreCase = True
objRegExp1.Global = True
objRegExp1.Pattern = "html>http://.+?"""
Set mm = objRegExp1.Execute(str)
For Each Match1 In mm
getimgs = getimgs & "||" & Left(Match1.Value, Len(Match1.Value) - 1)
Next
End Function
Function str2img()
Dim servername, objRegExp, strs, Matches, RetStr, arrimg, newimg, i, fname, states, arrnew, arrall
if baseurl<>"" then
If Right(baseurl, 1) <> "/" Then
baseurl = baseurl & "/"
End If
end if
if right(tofolder,1)<>"\" then
tofolder=tofolder&"\"
end if
Set objRegExp = New RegExp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<img.+?>"
strs = Trim(processstr)
Set Matches = objRegExp.Execute(strs)
For Each Match In Matches
RetStr = RetStr & getimgs(Match.Value)
Next
arrimg = Split(RetStr, "||")
allimg = ""
newimg = ""
For i = 1 To UBound(arrimg)
If arrimg(i) <> "" And InStr(allimg, arrimg(i)) < 1 Then
fname1 = baseurl & CStr(basefilename & i & Mid(arrimg(i), InStrRev(arrimg(i), ".")))
fname = tofolder & CStr(basefilename & i & Mid(arrimg(i), InStrRev(arrimg(i), ".")))
states = saveimage(arrimg(i), fname)
If states = True Then
allimg = allimg & "||" & arrimg(i)
newimg = newimg & "||" & fname1
End If
End If
Next
arrnew = Split(newimg, "||")
arrall = Split(allimg, "||")
For i = 1 To UBound(arrnew)
if i=1 then
firstoldimg=arrall(1)
firstnewimg=arrnew(1)
end if
strs = Replace(strs, arrall(i), arrnew(i))
Next
str2img = strs
End Function
end class
第一步用户登录的时候：由于有一个工作区，所以最好不要让多个用户用同一个帐号不然到时候有人登出的时候，将会造成其它人的工作丢失，这里最主要处理的是帐户登录的时候要对这个帐号锁定不允许重复登录（主要由FSO和数据库来实现，我就不多说了）。
在处理文件上传的时候，可以用稻香老农的无组件上传，把asp>图片传到工作区中。并且把asp>图片代码返回到编辑器中，当提交以后，将由以下代码来处理这些asp>图片,我这里是根据新闻或文章的ID来创建文件夹的：
sql="select top 1 form news where id is null"
set rs=server.createobject("adodb.recordset")
rs.open sql,conn,1,3
rs.addnew
rs("userid")=session("myid")’因为是新加的，所以先加上一条来取得ID
rs.update
newID=rs("newsid")’大部分情况下，这样可以取得ID的，可是为了保险起见，所以最好还是再判断一下了
rs.close
set rs=nothing
if newsID="" then
set rs=conn.execute("select top 1 newsid from news where userid=" & session("myid") & " order by newsid desc")
newsID=rs("newsid")
end if
basefoder=server.mappath("photo")’假设asp>图片存到当前目录下面的photo里面
set fso=Server.CreateObject("Scripting.FileSystemObject")
FiLePaTh = basefoder&"/"&newsID
Fso.Createfolder(FiLePaTh)
’假设将取得新闻的内容存在变量content里面下面就调用我的那个类blacksmith来处理分析文章的内容，处理asp>图片的转移了
set bs=new blacksmith
bs.size=1
bs.baseurl="photo/"&newsID’给asp>图片加上目录的地址
bs.basefilename="mynews"’给asp>图片加上前缀
bs.servername = ""
bs.tofolder=FiLePaTh
bs.processstr=content
content=bs.str2img
set bs=nothing
’接下来就是新闻内容的保存的过程了，我这里就省去了，和其它的系统应该是一样的了
在处理新闻的修改的时候用：
’创建工作目录
set fso=Server.CreateObject("Scripting.FileSystemObject")
FiLePaTh = server.mappath("temp"&session("myid"))
If Not FSO.FolderExists(FiLePaTh) Then
Fso.Createfolder(FiLePaTh)
End If
FiLePaTh = basefoder&"/"&newsID
If FSO.FolderExists(fp) Then
on error resume next
fso.copyfile fp&"\*.*",FiLePaTh&"\"’把那个目录下面的所有文件全拷到工作目录下面，防止出现修改了不保存，所以先不删除原有的内容
if err.num>0 then err.clear
End If
set fso=nothing
end if
’把原有的文件内容进行处理，改变里面的asp>图片路径,比如说这此内容还是保存在content里面
content=replace(trim(content,"photo/"&newsID&"/mynews","temp"&session("myid")&"/mynews")’这个只是一个比较简单的替换，相信由此引起误替换的机会应该是相当小的了
保存的过程和添加的过程是一样的，所不同的是，要先把原来的那个目录里面的文件清空，我这里就不多说了。
新闻删除的时候，要记着把这个ID相对应的文件夹删除了，在用户登出的时候，也要把它的工作目录清空。
好了，我的整个思路就是这样的了，说不上是什么精品，但是它在实际的应用中，一年下来并没有产生过任何的意常，所以我就把它贴出来了，欢迎大家和我交流:E_mail:clzwin@sina.com |
|
利用XMLHTTP无刷新获取数据
|
客户端和服务器端数据的交互有几种方法.
1.提交,通过<form></form>提交到服务器端.也称"有刷新"吧.
2.通过XMLHTTP无刷新提交到服务器端,并返回数据.也称"无刷新"吧.
利用XMLHTTP我们可以实现很多很强大的应用.这文章主要介绍它的一
些简单的应用.
附:因为XMLHTTP是IE5.0+支持的对象.所以你必须要有IE5.0+才能看到效果.
client.htm
<script language="JavaScript">
function GetResult(str)
{
/*
*--------------- GetResult(str) -----------------
* GetResult(str)
* 功能:通过XMLHTTP发送请求,返回结果.
* 参数:str,字符串,发送条件.
* 实例:GetResult(document.all.userid.value);
* author:wanghr100(灰豆宝宝.net)
* update:2004-5-27 19:02
*--------------- GetResult(str) -----------------
*/
var oBao = new ActiveXObject("Microsoft.XMLHTTP");
//特殊字符：+,%,&,=,?等的传输解决办法.字符串先用escape编码的.
//Update:2004-6-1 12:22
oBao.open("POST","server.asp?userid="+escape(str),false);
oBao.send();
//服务器端处理返回的是经过escape编码的字符串.
document.all.username.value=unescape(oBao.responseText)
}
</script>
<input type="button" onclick="GetResult(document.all.userid.value)" value="Get"><br>
userid:<input type="text" name="userid"><br>
username:<input type="text" name="username">
server.asp 服务器端处理.
<% @Language="JavaScript" %>
<%
function OpenDB(sdbname)
{
/*
*--------------- OpenDB(sdbname) -----------------
* OpenDB(sdbname)
* 功能:打开数据库sdbname,返回conn对象.
* 参数:sdbname,字符串,数据库名称.
* 实例:var conn = OpenDB("database.mdb");
* author:wanghr100(灰豆宝宝.net)
* update:2004-5-12 8:18
*--------------- OpenDB(sdbname) -----------------
*/
var connstr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source="+Server.MapPath(sdbname);
var conn = Server.CreateObject("ADODB.Connection");
conn.Open(connstr);
return conn;
}
var sResult = "";
var oConn = OpenDB("data.mdb");
//特殊字符：+,%,&,=,?等的传输解决办法.客户端字符是经过escape编码的
//所以服务器端先要经过unescape解码.
//Update:2004-6-1 12:22
var userid = unescape(Request("userid"));
var sql = "select username from users where userid=’"+userid+"’";
var rs = oConn.Execute(sql);
if(!rs.EOF)
{
sResult = rs("username").Value;
}
else
{
//加入容错.2004-5-30 10:15
sResult = "Sorry,没有找到..."
}
//escape解决了XMLHTTP。中文处理的问题.
Response.Write(escape(sResult));
%>
数据库设计 data.mdb
表users.
字段
id 自动编号
userid 文本
username 文本
表:users 数据:
id userid username
1 wanghr100 灰豆宝宝.net |
|
ASP知识讲座[环境变量]
|
学习ASP，最重要的就是要掌握ASP内置的六大对象。事实上，在上一讲中，我们已经了解了
Response对象（是吗？有没有搞错！），及Response对象中最常用的Write方法、Redirect方
法和Expires属性。看到对象、方法、属性、集合、事件这些概念（俺一个都不识！），如果以
前没接触过，聪明的您就不要管这些概念了，知道怎么用就行了，我的观点是刚开始关键在于临
摹。下面我们继续通过实例学习Request对象，为了加深理解，务请运行这些程序看看输出结果
一、 使用Request.ServerVariables获取环境变量，这部分内容很简单，但获取的内容却很重
要，如何获取？请看下例：
<%@ Language=VBScript %>
<HTML><BODY>
<% ’wuf8.asp
Response.Write "运行ASP文件的路径: " &_
Request.ServerVariables("Script_Name") & "<Br>"
Response.Write "返回content的数据长度: " &_
Request.ServerVariables("Content_Length") & "<Br>"
Response.Write "返回客户的IP地址: " &_
Request.ServerVariables("Remote_Addr") & "<Br>"
Response.Write "浏览器名: " &_
Request.ServerVariables("HTTP_USER_AGENT") & "<Br>"
Response.Write "返回主页实际物理路径: " &_
Request.ServerVariables("APPL_PHYSICAL_PATH") & "<Br>"
%>
<table colspan=8 cellpadding=5 border=0>
<tr>
<td align=CENTER bgcolor="#800000" width="109"> <font style="ARIAL NARROW"
color="#ffffff" size="2">环境变量名</font></td>
<td align=CENTER width=459 bgcolor="#800000"> <font style="ARIAL NARROW"
color="#ffffff" size="2">内容</font></td>
</tr>
<tr>
<td bgcolor="f7efde" align=CENTER> <font style="ARIAL NARROW" size="2">
result1
</font></td>
<td bgcolor="f7efde" align=CENTER> <font style="ARIAL NARROW" size="2">
result2
</font></td></tr>
</table>
</BODY></HTML>
Now，你应该发现上一讲中的例程wuf2.asp原来是多么的easy！
注意：该程序的后面一部分HTML标记纯是为下面的例子作准备的，所以不要觉得奇怪。那么，还
有哪些环境变量呢？运行下面的例子就知道了（本程序删除了部分代码，最好去我站点下载源程
序便于理解）。
<%@ Language=VBScript %>
<% ’wuf9.asp
Option Explicit
Dim Sv
%>
<HTML><BODY>
<table colspan=8 cellpadding=5 border=0>
<tr>
<td align=CENTER bgcolor="#800000" width="109"> <font style="ARIAL NARROW"
color="#ffffff" size="2">环境变量名</font></td>
<td align=CENTER width=459 bgcolor="#800000"> <font style="ARIAL NARROW"
color="#ffffff" size="2">结果</font></td>
</tr>
<%
for each Sv In Request.ServerVariables
Response.Write "<tr>"
Response.Write "<td bgcolor=’f7efde’ align=CENTER> <font style=’ARIAL NARROW’
size=’2’>"
Response.Write Sv
Response.Write "</font></td>"
Response.Write "<td bgcolor=’f7efde’ align=CENTER> <font style=’ARIAL NARROW’
size=’2’>"
Response.Write Request.ServerVariables(Sv)
Response.Write "</font></td></tr>"
next
%>
</table>
</BODY></HTML>
这里使用了For…Each循环，用来列举一个集合中的所有元素。如果后半部分看不懂，请对照
wuf8.asp，再瞧瞧运行结果，仔细体会一下（什么态度？）。
二、 通过表单向服务器传送数据（也可这样理解，服务器端如何读取客户端发送的数据）做过
主页，应该知道很多主页通常都使用Form表单让用户输入数据，然后通过"submit（提交）"按
钮发送数据。From表单中的"method"有两种主要方法：POST和GET，而"action"后一般都是指
定一个.cgi、.pl或.asp文件，今天我们要学习的就是如果编写这个.asp文件。
（一） 如果使用POST方法传送数据，则用Request.Form来读取数据。先编辑如下一个
wuf10.htm文件，供用户输入数据：
<html>
<body bgcolor="#FFFFFF">
<form method="post" action="wuf11.asp">
姓名： <input type="text" name="yourname"><br>
性别： <select name="gender">
<option>男</option>
<option>女</option>
</select> <br>
留言： <textarea name="message">您好！
注意多行文本的处理</textarea> <br>
爱好（按住Ctrl键可多选）：
<select name="hobby" multiple size="4">
<option>电脑</option>
<option>购物</option>
<option>电影</option>
<option>读书</option>
</select> <br>
<input type="submit" name="Submit" value="提交">
<input type="reset" name="Submit2" value="Reset">
</form>
</body>
</html>
再编写一个wuf10.htm需用到的文件wuf11.asp收集数据：
<%@ Language=VBScript %>
<% ’wuf11.asp
Option Explicit
Response.Expires=0
Dim StrName, StrGender, StrM, StrMsg
StrName = Trim(Request.Form("yourname")) ’Trim函数用来除首尾空格
StrGender = Trim(Request.Form("gender"))
StrM = Trim(Request.Form("message"))
StrMsg = Replace(StrM,vbcrlf,"<Br>" & vbcrlf)
’ vbcrlf相当于回车符和换行符的组合。至于Replace函数,其作用就是将字符串StrM中的
vbcrlf替换为"<Br>" & vbcrlf（请思考这个vbcrlf有什么用？查看输出文件的HTML源码就明
白了），详细请参考VBScript帮助。
%>
<HTML><BODY>
姓名: <%= StrName%><Br><Br>
性别: <%= StrGender%><Br><Br>
留言: <Br><Br>
<%= StrM%><Br><Br>
<%= StrMsg%><Br><Br>
实际上, "提交"按钮的值也被传递: <Br>
<%= Request.Form("Submit")%><Br><Br>
<% ’先把上面看懂, 有兴趣再看看如何读取多个选项
Response.Write "共选择爱好项数:" & Request.Form("hobby").Count & "<Br>"
Dim I
For I = 1 to Request.Form("hobby").Count
Response.Write Request.Form("hobby")(I) & "<Br>"
Next
%>
</BODY></HTML>
在这个的例子中，为了便于理解，我们使用了两个程序，实际上只使用一个程序也可以，如果有
兴趣请看下面的例程wuf12.asp，有助于加深对环境变量的理解。
<%@ Language=VBScript %>
<% ’wuf12.asp
Option Explicit
Response.Expires=0
Dim StrName, StrGender, StrM, StrMsg
If Request.ServerVariables("Content_Length") <> 0 Then
’提交数据后,这个长度就不会是 0, 因此执行下面的语句, 将结果显示出来
’下面一部分实际上是照搬 wuf11.asp
StrName = Trim(Request.Form("yourname"))
StrGender = Trim(Request.Form("gender"))
StrM = Trim(Request.Form("message"))
StrMsg = Replace(StrM,vbcrlf,"<Br>" & vbcrlf)
%>
<HTML><BODY>
姓名: <%= StrName%><Br><Br>
性别: <%= StrGender%><Br><Br>
留言: <Br><Br>
<%= StrM%><Br><Br>
<%= StrMsg%><Br><Br>
<%
Response.Write "共选择爱好项数:" & Request.Form("hobby").Count & "<Br>"
Dim I
For I = 1 to Request.Form("hobby").Count
Response.Write Request.Form("hobby")(I) & "<Br>"
Next
%>
</BODY></HTML>
<%
Else
’当第一次加载页面时,没有提交任何数据,故前面一部分并不执行,而是从这里开始
’这也就是为什么会有两对 <HTML></HTML> 的原因
’下面照搬 wuf10.htm 就行了
’<form method="post" action="wuf11.asp"> 给用环境变量替换掉了, 其实完全一样
Response.Write "看看结果: " & Request.ServerVariables("Script_name") & "<Br>"
%>
<HTML><BODY>
<form method="post" action="<%= Request.ServerVariables("Script_name")%>">
姓名： <input type="text" name="yourname"><br>
性别： <select name="gender">
<option>男</option>
<option>女</option>
</select> <br>
留言： <textarea name="message">您好！
注意多行文本的处理</textarea> <br>
爱好（按住Ctrl键可多选）：
<select name="hobby" multiple size="4">
<option>电脑</option>
<option>购物</option>
<option>电影</option>
<option>读书</option>
</select> <br>
<input type="submit" name="Submit" value="提交">
<input type="reset" name="Submit2" value="Reset">
</form>
</BODY></HTML>
<%End If%>
（二）如果使用GET方法传送数据，则用Request.Querystring来读取数据。先编辑如下一个
wuf13.htm文件，供用户输入数据
<html>
<body bgcolor="#FFFFFF">
<form method="get" action="wuf14.asp">
英文姓名： <input type="text" name="Ename"> <br>
中文姓名： <input type="text" name="Cname"><br>
性别： <select name="gender">
<option>男</option>
<option>女</option>
</select> <br>
<input type="submit" name="Submit" value="提交">
<input type="reset" name="Submit2" value="Reset">
</form>
</body>
</html>
再编写一个wuf13.htm需用到的文件wuf14.asp收集数据：
<%@ Language=VBScript %>
<% ’wuf14.asp
Option Explicit
Response.Expires=0
Dim StrCname, StrEname, StrGender
StrEname = Trim(Request.QueryString("Ename")) ’Trim函数用来除首尾空格
StrCname = Trim(Request.QueryString("Cname"))
StrGender = Trim(Request.QueryString("gender"))
%>
<HTML><BODY>
英文姓名: <%= StrEname%><Br><Br>
中文姓名: <%= StrCname%><Br><Br>
性别: <%= StrGender%><Br><Br>
看看提交的字符串: <Br>
<%= Request.ServerVariables("Query_String")%>
</BODY></HTML>
为了更好地理解这个程序，你最好先在浏览器中试试例程wuf13.htm的效果，看看输出的结果，
你会发现地址栏中长长的字符串似曾相识，如同在Yahoo搜索时看到的差不多。这时，你试着在
地址栏中直接输入"http://localhost/wuf14.asp?Ename=Rose&Cname=李二&gender=女" 居
然也得到了同样的结果。所以你可以这样看，wuf13.htm的结果就是得到了类似这样的一个带参
数的链接。而Request.QueryString则是从http:// 地址的附加参数中读取各个数据。
实际上当按"提交"按钮后，查询字符串（输入的数据）会以参数的形式附加到URL地址后（各参
数间以"&"分隔），达到传递数据的目的。同时，注意浏览器中显示的查询字符串中没有中文，
而是不认识的含百分号的乱码，这是因为进行了编码的缘故。最后，与前面一样，这两个程序也
可合并为一个程序（例程wuf15.asp,需去我站点下载）。
几点说明：
1． 若使用POST方法提交数据，则Request.ServerVariables("Content_Length")>0。
若使用GET方法提交数据，则Request.ServerVariables("Query_String") <> ""。
2．弄懂原理后你完全可以在同一个ASP文件中混合使用Request.Form和Request.QueryString
3． 如果在一个Form表单中，有几个按钮，你如何确定用户按了哪个按钮？如果留意的话，会发
现例程wuf11.asp中有一句，"提交"按钮的值也被传送，而wuf13.htm中生成的查询字符串最后
也可以找到类似的值。请注意：只有被按按钮的值被传送，而其他按钮的值为""，这就是判断依
据 |
|
asp无组件上传的原理
|
一、无组件上传的原理
我还是一点一点用一个实例来说明的吧，客户端HTML如下。要浏览上传附件，我们通过<input type="file">元素，但是一定要注意必须设置form的enctype属性为"multipart/form-data"：
<form method="post" action="upload.asp" enctype="multipart/form-data">
<label>
<input type="file" name="file1" />
</label>
<br />
<input type="text" name="filename" value="default filename"/>
<br />
<input type="submit" value="Submit"/>
<input type="reset" value="Reset"/>
</form>
在后台asp程序中，以前获取表单提交的ASCII 数据，非常的容易。但是如果需要获取上传的文件，就必须使用Request对象的BinaryRead方法来读取。BinaryRead方法是对当前输入流进行指定字节数的二进制读取，有点需要注意的是，一旦使用BinaryRead 方法后，再也不能使用Request.Form 或 Request.QueryString 集合了。结合Request对象的TotalBytes属性，可以将所有表单提交的数据全部变成二进制，不过这些数据都是经过编码的。首先让我们来看看这些数据是如何编码的，有无什么规律可循，编段代码，在代码中我们将BinaryRead读取的二进制转化为文本，输出出来，在后台的upload.asp中（注意该示例不要上传大文件，否则可能会造成浏览器死掉）：
<%
Dim biData, PostData
Size = Request.TotalBytes
biData = Request.BinaryRead(Size)
PostData = BinaryToString(biData,Size)
Response.Write "<pre>" & PostData & "</pre>" '使用pre，原样输出格式
' 借助RecordSet将二进制流转化成文本
Function BinaryToString(biData,Size)
Const adLongVarChar = 201
Set RS = createObject("ADODB.Recordset")
RS.Fields.Append "mBinary", adLongVarChar, Size
RS.Open
RS.AddNew
RS("mBinary").AppendChunk(biData)
RS.update
BinaryToString = RS("mBinary").Value
RS.Close
End Function
%>
简单起见，上传一个最简单的文本文件(G:\homepage.txt，内容为"宝玉：http://www.webuc.net")来试验一下，文本框filename中保留默认值"default filename"，提交看看输出结果：
-----------------------------7d429871607fe
Content-Disposition: form-data; name="file1"; filename="G:\homepage.txt"
Content-Type: text/plain
宝玉：http://www.webuc.net
-----------------------------7d429871607fe
Content-Disposition: form-data; name="filename"
default filename
-----------------------------7d429871607fe--
可以看出来对于表单中的项目，是用过"-----------------------------7d429871607fe"这样的边界来分隔成一块一块的，每一块的开始都有一些描述信息，例如：Content-Disposition: form-data; name="filename"，在描述信息中，通过name="filename"可以知道表单项的name。如果有filename="G:\homepage.txt"这样的内容，说明是一个上传的文件，如果是一个上传的文件，那么描述信息会多一行Content-Type: text/plain来描述文件的Content-Type。描述信息和主体信息之间是通过换行来分隔的。
嗯，基本上清晰了，根据这个规律我们就知道该怎么来分离数据，再对分离的数据进行处理了，不过差点忽略一个问题，就是边界值(上例中的"-----------------------------7d429871607fe")是怎么知道的？每次上传这个边界值是不一样的，还好还好asp中可以通过Request.ServerVariables( "HTTP_CONTENT_TYPE")来获之，例如上例中HTTP_CONTENT_TYPE内容为："multipart/form-data; boundary=---------------------------7d429871607fe"，有了这个，我们不仅可以判断客户端的form中有无使用enctype="multipart/form-data"(如果没有使用，那么下面就没必要执行啦)，还可以获取边界值boundary=---------------------------7d429871607fe。（注意：这里获取的边界值比上面的边界值开头要少"--"，最好补充上。）
至于如何分析数据的过程我就不多赘述了，无非就是借助InStr,Mid等这样的函数来分离出来我们想要的数据。
二、分块上传，记录进度
要实时反映进度条，实质就是要实时知道当前服务器获取了多少数据？再回想一下我们实现上传的过程，我们是通过Request.BinaryRead(Request.TotalBytes)来实现的，在Request的过程中我们无法得知当前服务器获取了多少数据。所以只能通过变通的方法了，如果我们可以将获取的数据分成一块一块的，然后根据已经上传的块数我们就可以算出来当前上传了多大了！也就是说，如果我1K为1块，那么上传1MB的输入流就分成1024块来获取，例如我当前已经获取了100块，那么就表明当前上传了100K。当我提出分块的时候很多人觉得不可思议，因为他们都忽略BinaryRead方法不仅是可以读取指定大小，而且可以连续读取的。
写个例子来验证一下分块读取的完整性，在刚才的例子基础上（注意该示例不要上传大文件，否则可能会造成浏览器死掉）：
<%
Dim biData, PostData, TotalBytes, ChunkBytes
ChunkBytes = 1 * 1024 ' 分块大小为1K
TotalBytes = Request.TotalBytes ' 总大小
PostData = "" ' 转化为文本类型后的数据
ReadedBytes = 0 ' 初始化为0
' 分块读取
Do While ReadedBytes < TotalBytes
biData = Request.BinaryRead(ChunkBytes) ' 当前块
PostData = PostData & BinaryToString(biData,ChunkBytes) ' 将当前块转化为文本并拼接
ReadedBytes = ReadedBytes + ChunkBytes ' 记录已读大小
If ReadedBytes > TotalBytes Then ReadedBytes = TotalBytes
Loop
Response.Write "<pre>" & PostData & "</pre>" ' 使用pre，原样输出格式
' 将二进制流转化成文本
Function BinaryToString(biData,Size)
Const adLongVarChar = 201
Set RS = createObject("ADODB.Recordset")
RS.Fields.Append "mBinary", adLongVarChar, Size
RS.Open
RS.AddNew
RS("mBinary").AppendChunk(biData)
RS.update
BinaryToString = RS("mBinary").Value
RS.Close
End Function
%>
试验一下上传刚才的文本文件，输出结果证明这样分块读取的内容是完整的，并且在While循环中，我们可以在每次循环时将当前状态记录到Application中，然后我们就可以通过访问该Application动态获取上传进度条。
另：上例中是通过字符串拼接的，如果是要拼接二进制数据，可以通过ADODB.Stream对象的Write方法，示例代码如下：
Set bSourceData = createobject("ADODB.Stream")
bSourceData.Open
bSourceData.Type = 1 'Binary
Do While ReadedBytes < TotalBytes
biData = Request.BinaryRead(ChunkBytes)
bSourceData.Write biData ' 直接使用write方法将当前文件流写入bSourceData中
ReadedBytes = ReadedBytes + ChunkBytes
If ReadedBytes > TotalBytes Then ReadedBytes = TotalBytes
Application("ReadedBytes") = ReadedBytes
Loop
三、保存上传的文件
通过Request.BinaryRead获取提交数据，分离出上传文件后，根据数据类型的不同，保存方式也不同：
对于二进制数据，可以直接通过ADODB.Stream对象的SaveToFile方法，将二进制流保存成为文件。
对于文本数据，可以通过TextStream对象的Write方法，将文本数据保存到文件中。
对于文本数据和二进制数据，是可以方便的相互转换的，对于上传小文件来说，两者基本上没什么差别。但是两种方式保存时还是有一些差别的，对于ADODB.Stream对象，必须将所有数据全部装载完才可以保存成文件，所以使用这种方式如果上传大文件将很占用内存，而对于TextStream对象，可以在文件创建好后，一次Write一部分，分多次Write，这样的好处是不会占用服务器内存空间，结合上面分析的分块获取数据原理，我们可以每获取一块上传数据就将之Write到文件中。我曾做过试验，同样本机上传一个200多MB的文件，使用第一种方式内存一直在涨，到最后直接提示计算机虚拟内存不足，最可恨是即使进度条表示文件已经上传完，但是最终文件还是没有保存上。而使用后一种方法，上传过程中内存基本上无什么变化。
四、未解决的难题
我在博客园上看到Bestcomy描述他的Asp.Net上传组件是可以和Sever.SetTimeOut无关的，而在Asp中我是没能做到，对于上传大文件，就只有将Server.SetTimeOut设置为一个很大的值才可以。不知道有没有比较好的解决方法。
如果我们在保存文件时，使用TextStream对象的Write方法，那么如果用户上传时中断了文件传输，已经上传的那部分文件还是在的，如果可以断点续传就好了。关键问题是Request.BinaryRead方法虽然可以分块读取，但是却不能跳过某一段读取！
五、结束语
原理基本上是说清楚了，但是实际代码要比这复杂的多，要考虑很多问题，最麻烦在分析数据那部分，对于每一块获取的数据，要分析是不是属于描述信息，是表单项目还是上传的文件，文件是否已经上传结束……
相信根据上面的描述，您也可以开发出您自己功能强大的无组件上传组件。我想更多的人关心的只是代码，而不会自己动手去写的，也许没有时间，也许水平还不够，更多的只是已经成为了一种习惯……我在CSDN上见过太多技术八股文——一段说明，然后全是代码。授人以鱼不若授人以渔，给你一个代码，也许你并不会去思考为什么，直接拿去用，当下次碰到类似的问题的时候，还是不知道为什么，希望此文能让更多人学到点什么，最重要是"悟"到点什么！ |
|
用ASP和VBScript上载文件
|
从浏览器上载文件是从客户机向服务器传递文件的一个简易方法。从第三代浏览器Netscape和 Microsoft起，多数浏览器都可以向服务器上载文件，而不需要向用户提供特殊的访问方式或软件。
一些ASP组件是为文件上载而设计的，例如：
Posting Acceptor
（ Microsoft SiteServer的一部分）,
AspSmartUpload（Advantys）,
AspUpload （PersistsSoftware）,
SA-FileUpSoftware Artisants）
本文的开始将告诉你关于创建这类组件的信息，而这些组件通常使用VB、C＋＋或Java。
这些组件的问题在于它们是第三方产品而非标准ASP的一部分。作为第三方组件，必须在服务器上进行安装。这就意味着必须在服务器上复制DLL并注册。大多数的主机系统不允许在他们的服务器上进行这样的设置，因为有可能发生配置问题（尤其是虚拟主机）。第二个缺点是它们大部分不是免费的，不提供源代码，也就不能根据需要进行定制。
因此我需要编写VBScript代码来解决文件上载的问题。这不是一个必然的选择，因为VBScript是一种脚本语言，只能使用variants数据类型，并且不能提供许多管理二进制数据和字节数组的内置函数。
要理解上载的过程，首先要知道数据用HTTP协议从浏览器发送到服务器的方式。这就意味着要理解“ multipart/form-data” （多部分/格式-数据）的表单提交。
上载表单
通常情况下，使用HTML表单从浏览器向服务器传递数据。这个表单中可能包含文本域、检验框、按钮以及上载文件的文件类型控制。使用者用自己的数据填充并将这个表提交给服务器。
表单元素中的 enctype 属性规定了传递给服务器的表数据集编码的内容类型。enctype 属性的默认值是“application/x-www-form-urlencoded”，但当向服务器传送大量文本、包含非ASCII字符或二进制数的数据时，这个默认类型就不能胜任了。这时，文件上载提交表单时应使用“multipart/form-data”内容类型。
一个“multipart/form-data”信息包含一系列部件，每个部件都可能包含：
一个Content-Disposition（内容-处理）头，其值为"form-data" ；一个规定控制名的name（名称）属性。
对于一个文件类型控制，一个部件可能包含更多信息：
在客户机上规定原始路径和文件名的filename（文件名）属性；所发送的二进制数据控制的Content-Type （内容-类型）头。
在这些头的后面跟随着控制的二进制或文本内容。
以下例子说明“multipart/form-data”的编码，客户机的浏览器应有这个表单：
如果这个表单被提交，在服务器上可读到这些请求：
-----------------------------7cf87224d2020a
Content-Disposition: form-data; name＝"email"
PhCollignon@email.com
-----------------------------7cf87224d2020a
Content-Disposition: form-data; name＝"blob"; filename＝"c:image.gif"
Content-Type: image/pjpeg
-----------------------------7cf87224d2020a
Content-Disposition: form-data; name＝"Enter"
Submit Query
-----------------------------7cf87224d2020a--
当那个内容作为响应被传送回客户机时就会被显示出来。应该用Request.binaryRead 和Response.binaryWrite 方法读和写二进制数据。
〈％
Response.BinaryWrite（Request.BinaryRead（Request.TotalBytes））
％〉
可以看到响应的各部分用分界线来划分：
-----------------------------7cf87224d2020a
最后一个分界线后面跟随的是’ -- ’ 。
每一个控制都有一个Content-Disposition 。name属性识别由HTML表发送的控制（email、blob和Enter）。 对于一个文件类型控制（blob）,
文件名也是Content-Disposition 头的一部分，Content-Type 头给出二进制 数据的内容类型。
上载脚本
上面所有内容都必须经过分解。在VB 或 C＋＋中, 这非常明显，因为为此提供了许多对象和方法。在VBScript 中，必须使用语言所提供的一些函数，并要解决VBScript中使用的双字节编码的变量字符串的问题。
VBScript函数
原始数据是二进制格式，所以必须使用专为管理二进制数据而设计的VBScript函数。因为我们将原始数据作为一个字节的字符串来考虑， 所以 MidB、InstrB 和 LenB 函数就有用了。 但是要避免VBScript的classic字符串，因为它们是双字节编码的字符串，不适宜分解成单字节。
这些是VBScript函数中仅有的用来分解字节的函数。还需要一个方法，从被分解的数据中得到双字节编码的字符串，这样就可以使用VBScript编码中的字符串了。为了在InstrB中把字符串作为一个自变量使用，还需要一个函数，把双字节字符串转换成单字节字符串。
为了我写了两个函数，getString（） 和 getByteString（），稍后再对此进行解释。
结构
分解的数据被存储在VBScript Dictionary 对象中。 Dictionary 对象是hash 表对象，它存储（key, item）对。它是VBScript和ASP2.0的一部分。
定义第一个Dictionary 对象 " UploadRequest " 。这个对象包含由上载表提交的所有控制。Key是控制的名字，Item则是对象中所包含的控制的信息：
"ControlName1", Dictionary control1
"ControlName2", Dictionary control2
代表一个控制的Dictionary 对象包含着下面的（key, item） 对：
"Value", String or binary content
"FileName", Name of uploaded file
"ContentType", ContentType of uploaded file
把这些结合起来，就有以下例子：
UploadRequest : "email", UploadControl 1 : "Value", PhCollignon@email.com
"blob" , UploadControl 2 : "filename", C:/image/file.gif "ContentType" :
image/gif "Value" : GIF89ai?
这个对象对于以后存取和使用数据非常有用。
分解
这里是分解、读和记录上载控制的代码。这个过程用"BuildUploadRequest"程序来完成，这个程序只有一个自变量，就是原始二进制数据RequestBin。
Sub BuildUploadRequest（RequestBin）
首先要找到分界线，通过分界线可以知道控制循环何时结束。
’Get the boundary PosBeg ＝ 1 PosEnd ＝ InstrB（PosBeg,RequestBin,getByteString（chr（13）））
boundary ＝ MidB（RequestBin,PosBeg,PosEnd-PosBeg） boundaryPos ＝ InstrB（1,RequestBin,boundary）
有一个问题是InstrB需要单字节字符串作为自变量。为此写了一个函数：getByteString（String） ，此方法可以把VBScript的双字节字符串转换成单字节字符串。在代码解释的最后再描述这个函数。
在找到结束分界线之前进行下列循环：
’Get all data inside the boundaries
Do until （boundaryPos＝InstrB（RequestBin,boundary & getByteString（"--"）））
循环中的每一步都处理一个控制。有关这一控制的所有数据都保存在dictionary对象中。每一个循环创建一个新的dictionary对象UploadControl。
’Members variable of objects are put in a dictionary object Dim UploadControl
Set UploadControl ＝ CreateObject（"Scripting.Dictionary"）
首先从" Content-Disposition " 头中找到控制的名字。名字的结尾用"字符或chr（34）划分。
’Get an object name Pos ＝ InstrB（BoundaryPos,RequestBin,getByteString（"Content-Disposition"））
Pos ＝ InstrB（Pos,RequestBin,getByteString（"name＝"）） PosBeg ＝ Pos＋6 PosEnd
＝ InstrB（PosBeg,RequestBin,getByteString（chr（34））） Name ＝ getString（MidB（RequestBin,PosBeg,PosEnd-PosBeg））
现在测试控制是文件类控制还是文本类控制。如果是文本类控制，除了它的名字以外没有其它任何数据。 如果是文件类控制，就会得到一些额外信息，如文件名和Content-Type。
PosFile＝InstrB（BoundaryPos,RequestBin,getByteString（"filename＝"）） PosBound
＝ InstrB（PosEnd,RequestBin,boundary） ’Test if object is of file type If
PosFile〈〉0 AND （PosFile〈PosBound）
Then 如果是控制是文件类控制，就将路径和文件名进行分解，并将他们填加到控制的dictionary 对象中。分解后的文件名是一个单字节字符串，要将它转换成双字节字符串才能作为variant字符串变量使用。这通过最后定义的getString（）方法来实现：
’Get Filename, content-type and content of file PosBeg ＝ PosFile ＋ 10 PosEnd
＝ InstrB（PosBeg,RequestBin,getByteString（chr（34））） FileName ＝ getString（MidB（RequestBin,PosBeg,PosEnd-PosBeg））
’Add filename to dictionary object UploadControl.Add "FileName", FileName
Pos ＝ InstrB（PosEnd,RequestBin,getByteString（"Content-Type:"）） PosBeg ＝
Pos＋14 PosEnd ＝ InstrB（PosBeg,RequestBin,getByteString（chr（13））） ’Add content-type
to dictionary object ContentType ＝ getString（MidB（RequestBin,PosBeg,PosEnd-PosBeg））
UploadControl.Add "ContentType",ContentType 现在就可以得到文件的核心内容了。这个内容不需要转换，因为它是二进制的。可以将它存入一个文件系统或作为一个二进制长对象（blob）放入数据库中。
’Get content of object PosBeg ＝ PosEnd＋4 PosEnd ＝ InstrB（PosBeg,RequestBin,boundary）-2
Value ＝ MidB（RequestBin,PosBeg,PosEnd-PosBeg）
Else 如果是文本类控制，除了内容以外就没有其它数据需要分解。内容要转换成为双字节字符串，以便将来用 在VBScript代码中。
’Get content of object Pos ＝ InstrB（Pos,RequestBin,getByteString（chr（13）））
PosBeg ＝ Pos＋4 PosEnd ＝ InstrB（PosBeg,RequestBin,boundary）-2 Value ＝ getString（MidB（RequestBin,PosBeg,PosEnd-PosBeg））
End If
将内容加入dictionary对象中。将key设置成 " Value ",那么item 就是内容。根据控制类型的不同，内容可以是字符串或二进制数据。
’Add content to dictionary object
UploadControl.Add "Value" , Value
最后将控制的dictionary 对象加入一个全程dictionary 对象中。使用的key 是控制的名字。item 是刚刚创建的dictionary对象，名为UploadControl。
’Add dictionary object to main dictionary UploadRequest.Add name, UploadControl
’Loop to next object BoundaryPos＝InstrB（BoundaryPos＋LenB（boundary）,RequestBin,boundary）
Loop End Sub
字节-字符串转换函数
下面是将双字节字符串转换成单字节字符串的函数。
’Byte string to string conversion Function getString（StringBin） getString
＝"" For intCount ＝ 1 to LenB（StringBin） getString ＝ getString & chr（AscB（MidB（StringBin,intCount,1）））
Next End Function 下面是将字符串转换成单字节字符串的函数，它用来格式化InstrB函数的自变量。
’String to byte string conversion Function getByteString（StringStr） For
i ＝ 1 to Len（StringStr） char ＝ Mid（StringStr,i,1） getByteString ＝ getByteString
& chrB（AscB（char）） Next End Function |
|
asp如何实现图片的动态翻动的效果
|
来源: 未知
作者: scoutlin
更新日期: [2005-01-28]
http://community.csdn.net/Expert/topic/3722/3722373.xml?temp=.6881372
<tr><td><input type=button value='<' name=lefts onclick="leftimg();"></td>
<%set rs=server.createobject("adodb.recordset")
rs.open "select top 3 * from table order by id desc",conn,1,1
ii=1
do while not rs.eof%>
<td><img src='<%=rs("img")%>' id='img<%=ii%>'><br><div id='txt<%=ii%>'><%=rs("title")%></div></td>
<%ii=ii+1
rs.movenext
loop
rs.close
set rs=nothing
%>
<td><input type=button value='>' name=rights onclick="rightimg();"></td>
</tr>
<script>
var imgarray=new Array();
var txtarray=new Array();
var ipos=0;
<%set rs=server.createobject("adodb.recordset")
rs.open "select top 5 * from table order by id desc",conn,1,1
ii=0
do while not rs.eof%>
imgarray[<%=ii%>]="<%=rs("img")%>";
txtarray[<%=ii%>]="<%=rs("title")%>";
<%
ii=ii+1
rs.movenext
loop
rs.close
set rs=nothing%>
function leftimg(){
ipos++;
ipos2=ipos;
if(ipos2>4){ipos2=0;ipos=0}
img1.src=imgarray[ipos2];
txt1.innerHTML=txtarray[ipos2];
ipos2++;
if(ipos2>4){ipos2=0}
img2.src=imgarray[ipos2]
txt2.innerHTML=txtarray[ipos2];
ipos2++;
if(ipos2>4){ipos2=0}
img3.src=imgarray[ipos2]
txt3.innerHTML=txtarray[ipos2];
}
function rightimg(){
ipos--;
ipos2=ipos;
if(ipos2<0){ipos2=4;ipos=4}
img1.src=imgarray[ipos2]
txt1.innerHTML=txtarray[ipos2];
ipos2++;
if(ipos2>4){ipos2=0}
img2.src=imgarray[ipos2]
txt2.innerHTML=txtarray[ipos2];
ipos2++;
if(ipos2>4){ipos2=0}
img3.src=imgarray[ipos2]
txt3.innerHTML=txtarray[ipos2];
}
</script>
|
|
一个18位身份证校验计算函数
|
来源: 未知
作者: sfply
更新日期: [2005-02-23]
因需要对15位旧身份证号码进行升位和校验、查询处理，又没有搜索到现成的函数，于是自己写了一个简单的过程，希望能够帮得上需要的朋友。
本函数的功能单一，只能校验第18位号码是否正确或者取得第18位号码，其他功能留给大家自己扩展吧！
<%
' Version: 1.0.1
' Author: sfply(sfply@163.com)
' Last Modified: 2004/7/17 12:03
' Src是身份证号码,可以是15位也可以是18位,15位时只能返回验证码方式使用
' iChk参数取值真假,真代表校验Src是否18位身份证，并且校验第18位是否正确号码而确定是否有效身份证,返回只值为true或false
' 假代表返回正确的校验码，返回值为(1~x)
dim myIdentify
myIdentify = "36050219781218133?"
response.write chkIdentiyCard(myIdentify,false)
Function chkIdentiyCard(Src,iChk)
dim myWi,myAi,mySrc(17),i,myCount
myAi = "10X98765432"
myWi = split("7,9,10,5,8,4,2,1,6,3,7,9,10,5,8,4,2",",")
if iChk then
if len(Src) = 18 then
for i = 0 to 16
mySrc(i) = mid(Src,i+1,1)
myCount = myCount + mySrc(i) * myWi(i)
next
if mid(myAi,(mycount mod 11)+1,1) = right(Src,1) then
chkIdentiyCard = true '返回结果，TRUE为合法身份证验证码
else
chkIdentiyCard = false '返回结果，FALSE为非法身份证验证码
end if
else
chkIdentiyCard = false '因为不是18位身份证所以返回FALSE
end if
else
if len(Src) = 15 or len(Src) = 18 then
if len(Src) = 15 then Src = mid(Src,1,6) & "19" & mid(Src,7,9)
for i = 0 to 16
mySrc(i) = mid(Src,i+1,1)
myCount = myCount + mySrc(i) * myWi(i)
next
chkIdentiyCard = mid (myAi,(mycount mod 11)+1,1) '返回正确的验证码
else
chkIdentiyCard = false '输入不不是15位或18位身份证号
end if
end if
End Function
%>
关于身份证第18是怎么计算的，原理如下
根据〖中华人民共和国国家标准 GB 11643-1999〗中有关公民身份号码的规定，公民身份号码是特征组合码，由十七位数字本体码和一位数字校验码组成。排列顺序从左至右依次为：六位数字地址码，八位数字出生日期码，三位数字顺序码和一位数字校验码。
地址码表示编码对象常住户口所在县(市、旗、区)的行政区划代码。生日期码表示编码对象出生的年、月、日，其中年份用四位数字表示，年、月、日之间不用分隔符。顺序码表示同一地址码所标识的区域范围内，对同年、月、日出生的人员编定的顺序号。顺序码的奇数分给男性，偶数分给女性。校验码是根据前面十七位数字码，按照ISO 7064:1983.MOD 11-2校验码计算出来的检验码。下面举例说明该计算方法。
15位的身份证编码首先把出生年扩展为4位，简单的就是增加一个19，但是这对于1900年出生的人不使用（这样的寿星不多了）
某男性公民身份号码本体码为34052419800101001，首先按照公式⑴计算：
∑(ai×Wi)(mod 11)……………………………………(1)
公式(1)中：
i----表示号码字符从由至左包括校验码在内的位置序号；
ai----表示第i位置上的号码字符值；
Wi----示第i位置上的加权因子，其数值依据公式Wi=2（n-1）(mod 11)计算得出。
i 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1
ai 3 4 0 5 2 4 1 9 8 0 0 1 0 1 0 0 1 a1
Wi 7 9 10 5 8 4 2 1 6 3 7 9 10 5 8 4 2 1
ai×Wi 21 36 0 25 16 16 2 9 48 0 0 9 0 5 0 0 2 a1
根据公式(1)进行计算：
∑(ai×Wi) =（21+36+0+25+16+16+2+9+48++0+0+9+0+5+0+0+2) = 189
189 ÷ 11 = 17 + 2/11
∑(ai×Wi)(mod 11) = 2
然后根据计算的结果，从下面的表中查出相应的校验码，其中X表示计算结果为10：
∑(ai×WI)(mod 11) 0 1 2 3 4 5 6 7 8 9 10
校验码字符值ai 1 0 X 9 8 7 6 5 4 3 2
根据上表，查出计算结果为2的校验码为所以该人员的公民身份号码应该为 34052419800101001X。
a[0]*7+a[1]*9+a[2]*10+a[3]*5+a[4]*8+a[5]*4+a[6]*2+a[7]*1+a[8]*6+a[9]*3
+a[10]*7+a[11]*9+a[12]*10+a[13]*5+a[14]*8+a[15]*4+a[16]*2
|
|
图片以二进制流输出到网页
|
来源: 未知
作者: Goldxin
更新日期: [2005-03-12]
using System;
using System.Collections;
using System.ComponentModel;
using System.Data;
using System.Drawing;
using System.Web;
using System.Web.SessionState;
using System.Web.UI;
using System.Web.UI.WebControls;
using System.Web.UI.HtmlControls;
using System.IO;
namespace MegaBBS.SendMail
{
/// <summary>
/// WebForm4 的摘要说明。
/// </summary>
public class WebForm4 : System.Web.UI.Page
{
private void Page_Load(object sender, System.EventArgs e)
{
// 在此处放置用户代码以初始化页面
if(!this.IsPostBack)
{
BindData();
}
}
#region Web 窗体设计器生成的代码
override protected void OnInit(EventArgs e)
{
//
// CODEGEN: 该调用是 ASP.NET Web 窗体设计器所必需的。
//
InitializeComponent();
base.OnInit(e);
}
/// <summary>
/// 设计器支持所需的方法 - 不要使用代码编辑器修改
/// 此方法的内容。
/// </summary>
private void InitializeComponent()
{
this.Load += new System.EventHandler(this.Page_Load);
}
#endregion
/// <summary>
/// 图片以二进制流输出
/// </summary>
private void BindData()
{
FileStream fs = new FileStream(@"D:\22-11-46-3-524454584.jpg",FileMode.Open,FileAccess.Read);
byte[] mydata = new byte[fs.Length];
int Length = Convert.ToInt32(fs.Length);
fs.Read(mydata,0,Length);
fs.Close();
this.Response.OutputStream.Write(mydata,0,Length);
this.Response.End();
}
}
} |
|
在ASP中使用断开的记录集
|
来源: 未知
作者: great_domino
更新日期: [2005-03-12]
我们在使用ASP 内置的ADO组件进行数据库编程时，通常是在脚本的开头打开一个连接，并在脚本的最后关闭它，但是就较大脚本而言，在多数情况下连接打开的时间要比它需要打开的时间长得多。因此为了节省服务器资源，应该尽可能关闭连接以释放连接所占有的资源，这种关闭记录集的连接而不关闭记录集的技术叫做断开记录集，这个记录集本身则称为断开的记录集。
下面我们就通过一个实例来说明这种技术的使用方法(NorthWind.mdb是Microsoft Access自带的一个数据库，文件adovbs.inc可在C:\Program Files\Common Files\System\ADO下找到)：
<% @LANGUAGE = VBScript %>
<%
Response.Expires = 0
Dim Cnn,objRS, strOut, strQ, strC
StrC= "Driver={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("\asp24")
& "\NorthWind.mdb;"
'建立连接
Set Cnn = Server.CreateObject("ADODB.Connection")
Cnn.Open StrC
'创建Recordset对象
Set objRS = Server.CreateObject("ADODB.Recordset")
objRS.CursorLocation =adUseClient
objRS.CursorType = adOpenStatic
objRS.LockType = adLockOptimistic
strQ = "SELECT 运货商ID, 公司名称, 电话 FROM 运货商 "
objRS.Open strQ, Cnn, , , adCmdText
Set objRS.ActiveConnection = Nothing '断开记录集
Cnn.Close '关闭连接
Set Cnn = Nothing
Response.Write ""
'下面使用断开的记录集
Do While (Not objRS.EOF)
strOut = objRS("运货商ID") & ", " & objRS("公司名称") & ", " & objRS("电话")
Response.Write Server.HTMLEncode(strOut) & ""
objRS.MoveNext
Loop
Response.Write "
准备新增或插入记录: "
'若需要更新数据库, 则要重新建立连接
Set Cnn = Server.CreateObject("ADODB.Connection")
Cnn.Open strC
Set objRS.ActiveConnection = Cnn
objRS.Filter = "公司名称 = '吴丰'"
If objRS.EOF Then
objRS.AddNew
objRS("公司名称") = "吴丰"
objRS("电话") = "571-7227298"
objRS.Update
Response.Write "符合该条件的记录不存在, 则新增.
"
Else
objRS("电话") = "571-7227071"
Response.Write "符合该条件的记录存在, 则 Update."
objRS.Update
End If
Set objRS.ActiveConnection = Nothing
Cnn.close
Set Cnn = Nothing
objRS.Close
Set objRS = Nothing
Response.Write ""
%>
|
|
梅花雨日历控件2.02版
|
来源: 未知
作者: athossmth
更新日期: [2005-03-12]
感谢meizz和walkingpoison，梅花雨日历控件很好用，我前面的贴子
http://community.csdn.net/Expert/TopicView.asp?id=3575789
发布了英文版（2.01版），通过最近一段时期的使用，根据用户反馈增加了两个内容：
一是，当文本框只读的时候，不能清空其内容，现加入了一个C(Clear)的按钮，可以清空；
二是，下面的一行，原本是可以按月或者是年变更，现在加入了按十年变更的按钮。
代码如下
var bMoveable=true;
var _VersionInfo="Version:2.02 2.01&02 Author: Athos;2.0 Author:walkingpoison 1.0 Author: F.R.Huang(meizz) MAIL: meizz@hzcnc.com";
var strFrame;
document.writeln('<iframe id=meizzDateLayer Author=wayx frameborder=0 style="position: absolute; width: 144; height: 211; z-index: 9998; display: none"></iframe>');
strFrame='<style>';
strFrame+='INPUT.button{BORDER-RIGHT: #ff9900 1px solid;BORDER-TOP: #ff9900 1px solid;BORDER-LEFT: #ff9900 1px solid;';
strFrame+='BORDER-BOTTOM: #ff9900 1px solid;BACKGROUND-COLOR: #fff8ec;}';
strFrame+='TD{FONT-SIZE: 9pt;}';
strFrame+='</style>';
strFrame+='<scr' + 'ipt>';
strFrame+='var datelayerx,datelayery; ';
strFrame+='var bDrag; ';
strFrame+='function document.onmousemove() ';
strFrame+='{if(bDrag && window.event.button==1)';
strFrame+=' {var DateLayer=parent.document.all.meizzDateLayer.style;';
strFrame+=' DateLayer.posLeft += window.event.clientX-datelayerx;';
strFrame+=' DateLayer.posTop += window.event.clientY-datelayery;}}';
strFrame+='function DragStart() ';
strFrame+='{var DateLayer=parent.document.all.meizzDateLayer.style;';
strFrame+=' datelayerx=window.event.clientX;';
strFrame+=' datelayery=window.event.clientY;';
strFrame+=' bDrag=true;}';
strFrame+='function DragEnd(){ ';
strFrame+=' bDrag=false;}';
strFrame+='</scr' + 'ipt>';
strFrame+='<div style="z-index:9999;position: absolute; left:0; top:0;" onselectstart="return false"><span id=tmpSelectYearLayer Author=wayx style="z-index: 9999;position: absolute;top: 3; left: 19;display: none"></span>';
strFrame+='<span id=tmpSelectMonthLayer Author=wayx style="z-index: 9999;position: absolute;top: 3; left: 48;display: none"></span>';
strFrame+='<table border=1 cellspacing=0 cellpadding=0 width=142 height=160 bordercolor=#ff9900 bgcolor=#ff9900 Author="wayx">';
strFrame+=' <tr Author="wayx"><td width=142 height=23 Author="wayx" bgcolor=#FFFFFF><table border=0 cellspacing=1 cellpadding=0 width=140 Author="wayx" height=23>';
strFrame+=' <tr align=center Author="wayx"><td width=16 align=center bgcolor=#ff9900 style="font-size:12px;cursor: hand;color: #ffffff" ';
strFrame+=' onclick="parent.meizzPrevM()" title="1 Month Before" Author=meizz><b Author=meizz><</b>';
strFrame+=' </td><td width=30 align=center style="font-size:12px;cursor:default" Author=meizz ';
strFrame+='onmouseover="style.backgroundColor=\'#FFD700\'" onmouseout="style.backgroundColor=\'white\'" ';
strFrame+='onclick="parent.tmpSelectYearInnerHTML(this.innerText)" title="Click to select year"><span Author=meizz id=meizzYearHead></span></td>';
strFrame+='<td width=78 align=center style="font-sizeNULL;cursorNULL" Author=meizz onmouseover="style.backgroundColor=\'#FFD700\'" ';
strFrame+=' onmouseout="style.backgroundColor=\'white\'" onclick="parent.tmpSelectMonthInnerHTML(parent.athosMonthNameToNum(this.innerText))"';
strFrame+=' title="Click to select month"><span id=meizzMonthHead Author=meizz></span></td>';
strFrame+=' <td width=16 bgcolor=#ff9900 align=center style="font-sizeNULL;cursorNULL;colorNULLffffff" ';
strFrame+=' onclick="parent.meizzNextM()" title="1 Month Later" Author=meizz><b Author=meizz>></b></td></tr>';
strFrame+=' </table></td></tr>';
strFrame+=' <tr Author="wayx"><td width=142 height=18 Author="wayx">';
strFrame+='<table border=1 cellspacing=0 cellpadding=0 bgcolor=#ff9900 ' + (bMoveable? 'onmousedown="DragStart()" onmouseup="DragEnd()"':'');
strFrame+=' BORDERCOLORLIGHT=#FF9900 BORDERCOLORDARK=#FFFFFF width=140 height=20 Author="wayx" style="cursorNULL + (bMoveable ? 'move'NULLdefault') + '">';
strFrame+='<tr Author="wayx" align=center valign=bottom>';
strFrame+='<td width=18px style="font-sizeNULL;colorNULLFFFFFF" Author=meizz title="Sunday">S</td>';
strFrame+='<td width=18px style="font-sizeNULL;colorNULLFFFFFF" Author=meizz title="Monday">M</td>';
strFrame+='<td width=18px style="font-sizeNULL;colorNULLFFFFFF" Author=meizz title="Tuesday">T</td>';
strFrame+='<td width=18px style="font-sizeNULL;colorNULLFFFFFF" Author=meizz title="Wednesday">W</td>';
strFrame+='<td width=18px style="font-sizeNULL;colorNULLFFFFFF" Author=meizz title="Thursday">T</td>';
strFrame+='<td width=18px style="font-sizeNULL;colorNULLFFFFFF" Author=meizz title="Friday">F</td>';
strFrame+='<td width=20px style="font-sizeNULL;colorNULLFFFFFF" Author=meizz title="Saturday">S</td>';
strFrame+='</tr>';
strFrame+='</table></td></tr><!-- Author:F.R.Huang(meizz) http://www.meizz.com/ mail: meizz@hzcnc.com 2002-10-8 -->';
strFrame+=' <tr Author="wayx"><td width=142 height=120 Author="wayx">';
strFrame+=' <table border=1 cellspacing=2 cellpadding=0 BORDERCOLORLIGHT=#FF9900 BORDERCOLORDARK=#FFFFFF bgcolor=#fff8ec width=140 height=120 Author="wayx">';
var n=0; for (j=0;j<5;j++){ strFrame+= ' <tr align=center Author="wayx">'; for (i=0;i<7;i++){
strFrame+='<td width=20 height=20 id=meizzDay'+n+' style="font-sizeNULL" Author=meizz onclick=parent.meizzDayClick(this.innerText,0)></td>';n++;}
strFrame+='</tr>';}
strFrame+=' <tr align=center Author="wayx">';
for (i=35;i<39;i++)strFrame+='<td width=20 height=20 id=meizzDay'+i+' style="font-sizeNULL" Author=wayx onclick="parent.meizzDayClick(this.innerText,0)"></td>';
strFrame+=' <td align=right Author=meizz><span onclick=parent.clearAndCloseLayer() style="font-sizeNULL;cursorNULL;colorNULL00aaaa;"';
strFrame+=' Author=meizz title="Clear"><b>C</b></span> </td>';
strFrame+=' <td align=right Author=meizz><span onclick=parent.closeLayer() style="font-sizeNULL;cursorNULL;colorNULL;"';
strFrame+=' Author=meizz title="Close"><b>X</b></span> </td>';
strFrame+=' <td align=right Author=meizz><a href="mailtoNULL/FONT>athos.liu@gmail.com; meizz@hzcnc.com" style="text-decorationNULL"';
strFrame+=' Author=meizz title="' + _VersionInfo + '"><i>©</i></a> </td>';
strFrame+='</tr>';
strFrame+='</table></td></tr><tr Author="wayx"><td Author="wayx">';
strFrame+=' <table border=0 cellspacing=1 cellpadding=0 width=100% Author="wayx" bgcolor=#FFFFFF>';
strFrame+=' <tr Author="wayx"><td Author=meizz align=left>';
strFrame+=' <input Author=meizz type=button class=button value="←" title="10 Year Before" onclick="parent.meizzPrevY(10)" ';
strFrame+=' onfocus="this.blur()" style="font-sizeNULL; heightNULL">';
strFrame+=' <input Author=meizz type=button class=button value="«" title="1 Year Before" onclick="parent.meizzPrevY(1)" ';
strFrame+=' onfocus="this.blur()" style="font-sizeNULL; heightNULL">';
strFrame+=' <input Author=meizz class=button title="1 Month Before" type=button ';
strFrame+=' value="‹" onclick="parent.meizzPrevM()" onfocus="this.blur()" style="font-sizeNULL; heightNULL"></td><td ';
strFrame+=' Author=meizz align=center><input Author=meizz type=button class=button value=td style="colorNULL00007f;background-colorNULL;fontNULL bolder 10pt;" onclick="parent.meizzToday()" ';
strFrame+=' onfocus="this.blur()" title="Today" style="font-sizeNULL; heightNULL; cursorNULL"></td><td ';
strFrame+=' Author=meizz align=right>';
strFrame+=' <input Author=meizz type=button class=button value="›" onclick="parent.meizzNextM()" ';
strFrame+=' onfocus="this.blur()" title="1 Month Later" class=button style="font-sizeNULL; heightNULL">';
strFrame+=' <input Author=meizz type=button class=button value="»" title="1 Year Later" onclick="parent.meizzNextY(1)"';
strFrame+=' onfocus="this.blur()" style="font-sizeNULL; heightNULL">';
strFrame+=' <input Author=meizz type=button class=button value="→" title="10 Year Later" onclick="parent.meizzNextY(10)" ';
strFrame+=' onfocus="this.blur()" style="font-sizeNULL; heightNULL">';
strFrame+=' </td></tr></table></td></tr></table></div>';
window.frames.meizzDateLayer.document.writeln(strFrame);
window.frames.meizzDateLayer.document.close();
var outObject;
var outButton;
var outDate="";
var odatelayer=window.frames.meizzDateLayer.document.all;
function setday(tt,obj)
{
if (arguments.length > 2){alert("Sorry, too many parameters");return;}
if (arguments.length == 0){alert("Sorry, none parameter!");return;}
var dads = document.all.meizzDateLayer.style;
var th = tt;
var ttop = tt.offsetTop;
var thei = tt.clientHeight;
var tleft = tt.offsetLeft;
var ttyp = tt.type;
while (tt = tt.offsetParent){ttop+=tt.offsetTop; tleft+=tt.offsetLeft;}
dads.top = (ttyp=="image")? ttop+thei : ttop+thei+6;
dads.left = tleft;
outObject = (arguments.length == 1) ? th : obj;
outButton = (arguments.length == 1) ? null : th;
var reg = /^(\d{1,2})\/(\d{1,2})\/(\d+)$/;
var r = outObject.value.match(reg);
if(r!=null){
r[0]=r[3];
r[3]=r[2];
r[2]=r[1];
r[1]=r[0];
r[2]=r[2]-1;
var d= new Date(r[1], r[2],r[3]);
if(d.getFullYear()==r[1] && d.getMonth()==r[2] && d.getDate()==r[3]){
outDate=d;
}
else outDate="";
meizzSetDay(r[1],r[2]+1);
}
else{
outDate="";
meizzSetDay(new Date().getFullYear(), new Date().getMonth() + 1);
}
dads.display = '';
event.returnValue=false;
}
var MonHead = new Array(12);
MonHead[0] = 31; MonHead[1] = 28; MonHead[2] = 31; MonHead[3] = 30; MonHead[4] = 31; MonHead[5] = 30;
MonHead[6] = 31; MonHead[7] = 31; MonHead[8] = 30; MonHead[9] = 31; MonHead[10] = 30; MonHead[11] = 31;
var meizzTheYear=new Date().getFullYear();
var meizzTheMonth=new Date().getMonth()+1;
var meizzWDay=new Array(39);
function document.onclick()
{
with(window.event)
{ if (srcElement.getAttribute("Author")==null && srcElement != outObject && srcElement != outButton)
closeLayer();
}
}
function document.onkeyup()
{
if (window.event.keyCode==27){
if(outObject)outObject.blur();
closeLayer();
}
else if(document.activeElement)
if(document.activeElement.getAttribute("Author")==null && document.activeElement != outObject && document.activeElement != outButton)
{
closeLayer();
}
}
function meizzWriteHead(yy,mm)
{
odatelayer.meizzYearHead.innerText = String(yy);
odatelayer.meizzMonthHead.innerText = athosMonthNumToName(String(mm));
}
function athosMonthNameToNum(mn)
{
switch (String(mn))
{
case "January" :
return String(1);
case "Feburary" :
return String(2);
case "March" :
return String(3);
case "April" :
return String(4);
case "May" :
return String(5);
case "June" :
return String(6);
case "July" :
return String(7);
case "August" :
return String(8);
case "September" :
return String(9);
case "October" :
return String(10);
case "November" :
return String(11);
case "December" :
return String(12);
default :
return String(0);
}
}
function athosMonthNumToName(mm)
{
switch (mm)
{
case "1":
return String("January");
case "2":
return String("Feburary");
case "3":
return String("March");
case "4":
return String("April");
case "5":
return String("May");
case "6":
return String("June");
case "7":
return String("July");
case "8":
return String("August");
case "9":
return String("September");
case "10":
return String("October");
case "11":
return String("November");
case "12":
return String("December");
default :
return String("UnknownMonth");
}
}
function tmpSelectYearInnerHTML(strYear)
{
if (strYear.match(/\D/)!=null){alert("Year shall be a number.");return;}
var m = (strYear) ? strYear : new Date().getFullYear();
if (m < 1000 || m > 9999) {alert("Year shall between 1000 to 9999.");return;}
var n = m - 10;
if (n < 1000) n = 1000;
if (n + 26 > 9999) n = 9974;
var s = "<select Author=meizz name=tmpSelectYear style='font-sizeNULL' "
s += "onblur='document.all.tmpSelectYearLayer.style.display=\"none\"' "
s += "onchange='document.all.tmpSelectYearLayer.style.display=\"none\";"
s += "parent.meizzTheYear = this.value; parent.meizzSetDay(parent.meizzTheYear,parent.meizzTheMonth)'>\r\n";
var selectInnerHTML = s;
for (var i = n; i < n + 26; i++)
{
if (i == m)
{selectInnerHTML += "<option Author=wayx value='" + i + "' selected>" + i + "</option>\r\n";}
else {selectInnerHTML += "<option Author=wayx value='" + i + "'>" + i + "</option>\r\n";}
}
selectInnerHTML += "</select>";
odatelayer.tmpSelectYearLayer.style.display="";
odatelayer.tmpSelectYearLayer.innerHTML = selectInnerHTML;
odatelayer.tmpSelectYear.focus();
}
function tmpSelectMonthInnerHTML(strMonth)
{
if (strMonth.match(/\D/)!=null){alert("Month shall be a number");return;}
var m = (strMonth) ? strMonth NULL Date().getMonth() + 1;
var s = "<select Author=meizz name=tmpSelectMonth style='font-size: 12px' "
s += "onblur='document.all.tmpSelectMonthLayer.style.display=\"none\"' "
s += "onchange='document.all.tmpSelectMonthLayer.style.display=\"none\";"
s += "parent.meizzTheMonth = this.value; parent.meizzSetDay(parent.meizzTheYear,parent.meizzTheMonth)'>\r\n";
var selectInnerHTML = s;
for (var i = 1; i < 13; i++)
{
if (i == m)
{selectInnerHTML += "<option Author=wayx value='"+i+"' selected>"+ athosMonthNumToName(String(i)) +"</option>\r\n";}
else {selectInnerHTML += "<option Author=wayx value='"+i+"'>"+ athosMonthNumToName(String(i)) +"</option>\r\n";}
}
selectInnerHTML += "</select>";
odatelayer.tmpSelectMonthLayer.style.display="";
odatelayer.tmpSelectMonthLayer.innerHTML = selectInnerHTML;
odatelayer.tmpSelectMonth.focus();
}
function closeLayer()
{
document.all.meizzDateLayer.style.display="none";
}
function clearAndCloseLayer()
{
if (outObject)
{
outObject.value= "";
closeLayer();
}
else {closeLayer(); alert("None control to output!");}
}
function IsPinYear(year)
{
if (0==year%4&&((year%100!=0)||(year%400==0))) return true;else return false;
}
function GetMonthCount(year,month)
{
var c=MonHead[month-1];if((month==2)&&IsPinYear(year)) c++;return c;
}
function GetDOW(day,month,year)
{
var dt=new Date(year,month-1,day).getDay()/7; return dt;
}
function meizzPrevY(intYears)
{
if(meizzTheYear > 999 && meizzTheYear <10000){meizzTheYear-=intYears;}
else{alert("Year beyond (1000-9999)!");}
meizzSetDay(meizzTheYear,meizzTheMonth);
}
function meizzNextY(intYears)
{
if(meizzTheYear > 999 && meizzTheYear <10000){meizzTheYear+=intYears;}
else{alert("Year beyond (1000-9999)!");}
meizzSetDay(meizzTheYear,meizzTheMonth);
}
function meizzToday()
{
var today;
meizzTheYear = new Date().getFullYear();
meizzTheMonth = new Date().getMonth()+1;
today=new Date().getDate();
//meizzSetDay(meizzTheYear,meizzTheMonth);
if(outObject){
outObject.value=meizzTheYear + "-" + meizzTheMonth + "-" + today;
}
closeLayer();
}
function meizzPrevM()
{
if(meizzTheMonth>1){meizzTheMonth--}else{meizzTheYear--;meizzTheMonth=12;}
meizzSetDay(meizzTheYear,meizzTheMonth);
}
function meizzNextM()
{
if(meizzTheMonth==12){meizzTheYear++;meizzTheMonth=1}else{meizzTheMonth++}
meizzSetDay(meizzTheYear,meizzTheMonth);
}
function meizzSetDay(yy,mm)
{
meizzWriteHead(yy,mm);
meizzTheYear=yy;
meizzTheMonth=mm;
for (var i = 0; i < 39; i++){meizzWDay[i]=""};
var day1 = 1,day2=1,firstday = new Date(yy,mm-1,1).getDay();
for (i=0;i<firstday;i++)meizzWDay[i]=GetMonthCount(mm==1?yy-1NULL,mm==1?12NULL-1)-firstday+i+1
for (i = firstday; day1 < GetMonthCount(yy,mm)+1; i++){meizzWDay[i]=day1;day1++;}
for (i=firstday+GetMonthCount(yy,mm);i<39;i++){meizzWDay[i]=day2;day2++}
for (i = 0; i < 39; i++)
{ var da = eval("odatelayer.meizzDay"+i)
if (meizzWDay[i]!="")
{
da.borderColorLight="#FF9900";
da.borderColorDark="#FFFFFF";
if(i<firstday)
{
da.innerHTML="<b><font color=gray>" + meizzWDay[i] + "</font></b>";
da.title=(mm==1?12NULL-1) +"Mn" + meizzWDay[i] + "Dt";
da.onclick=Function("meizzDayClick(this.innerText,-1)");
if(!outDate)
da.style.backgroundColor = ((mm==1?yy-1NULL) == new Date().getFullYear() &&
(mm==1?12NULL-1) == new Date().getMonth()+1 && meizzWDay[i] == new Date().getDate()) ?
"#FFD700"NULL;
else
{
da.style.backgroundColor =((mm==1?yy-1NULL)==outDate.getFullYear() && (mm==1?12NULL-1)== outDate.getMonth() + 1 &&
meizzWDay[i]==outDate.getDate())? "#00ffff" NULLBR> (((mm==1?yy-1NULL) == new Date().getFullYear() && (mm==1?12NULL-1) == new Date().getMonth()+1 &&
meizzWDay[i] == new Date().getDate()) ? "#FFD700"NULL);
if((mm==1?yy-1NULL)==outDate.getFullYear() && (mm==1?12NULL-1)== outDate.getMonth() + 1 &&
meizzWDay[i]==outDate.getDate())
{
da.borderColorLight="#FFFFFF";
da.borderColorDark="#FF9900";
}
}
}
else if (i>=firstday+GetMonthCount(yy,mm))
{
da.innerHTML="<b><font color=gray>" + meizzWDay[i] + "</font></b>";
da.title=(mm==12?1NULL+1) +"Mn" + meizzWDay[i] + "Dt";
da.onclick=Function("meizzDayClick(this.innerText,1)");
if(!outDate)
da.style.backgroundColor = ((mm==12?yy+1NULL) == new Date().getFullYear() &&
(mm==12?1NULL+1) == new Date().getMonth()+1 && meizzWDay[i] == new Date().getDate()) ?
"#FFD700"NULL;
else
{
da.style.backgroundColor =((mm==12?yy+1NULL)==outDate.getFullYear() && (mm==12?1NULL+1)== outDate.getMonth() + 1 &&
meizzWDay[i]==outDate.getDate())? "#00ffff" NULLBR> (((mm==12?yy+1NULL) == new Date().getFullYear() && (mm==12?1NULL+1) == new Date().getMonth()+1 &&
meizzWDay[i] == new Date().getDate()) ? "#FFD700"NULL);
if((mm==12?yy+1NULL)==outDate.getFullYear() && (mm==12?1NULL+1)== outDate.getMonth() + 1 &&
meizzWDay[i]==outDate.getDate())
{
da.borderColorLight="#FFFFFF";
da.borderColorDark="#FF9900";
}
}
}
else
{
da.innerHTML="<b>" + meizzWDay[i] + "</b>";
da.title=mm +"Mn" + meizzWDay[i] + "Dt";
da.onclick=Function("meizzDayClick(this.innerText,0)");
if(!outDate)
da.style.backgroundColor = (yy == new Date().getFullYear() && mm == new Date().getMonth()+1 && meizzWDay[i] == new Date().getDate())?
"#FFD700"NULL;
else
{
da.style.backgroundColor =(yy==outDate.getFullYear() && mm== outDate.getMonth() + 1 && meizzWDay[i]==outDate.getDate())?
"#00ffff"NULL(yy == new Date().getFullYear() && mm == new Date().getMonth()+1 && meizzWDay[i] == new Date().getDate())?
"#FFD700"NULL);
if(yy==outDate.getFullYear() && mm== outDate.getMonth() + 1 && meizzWDay[i]==outDate.getDate())
{
da.borderColorLight="#FFFFFF";
da.borderColorDark="#FF9900";
}
}
}
da.style.cursor="hand"
}
else{da.innerHTML="";da.style.backgroundColor="";da.style.cursor="default"}
}
}
function meizzDayClick(n,ex)
{
var yy=meizzTheYear;
var mm = parseInt(meizzTheMonth)+ex;
if(mm<1){
yy--;
mm=12+mm;
}
else if(mm>12){
yy++;
mm=mm-12;
}
if (mm < 10){mm = "0" + mm;}
if (outObject)
{
if (!n) {
return;}
if ( n < 10){n = "0" + n;}
outObject.value= mm + "/" + n + "/" + yy ;
closeLayer();
}
else {closeLayer(); alert("None control to output!");}
}
|
|
DHTML+XML+ASP+CSS=树形目录
|
来源: 未知
作者: great_domino
更新日期: [2005-03-12]
树形目录显示程序
问题描述：
在我们项目中常常会出现自关联的数据表，如果我们从整体看去，整个表就呈现为一个树形数据结构（对于复杂的情况，它可能变成一个图）。当我们对这个表进行显示，编辑时，如果不采用好的表现形式，会显得很笨拙，为此，我们开发这样的树形结构的程序。在上一版本中，我们使用的是递归算法来实现，在我们对这个算法评测时发现，对于拥有成千上万条记录的数据库就不再能胜任了，所以在新的算法版本中，我们使用了XML技术，动态的发现数据，以解决一次从服务器下在大量数据的尴尬，同时也遍免了如果表数据结构呈现为图时就会进入死循环的错误。
实际思路：
1、 初始显示时只显示根与二级节点，根与二级节点同在一层次
2、 点击一节点，如果它的子节点区域对象不存在，则建立对象，同时下载数据更新数据，显示所有子节点。
3、 每个节点在建立后都就有相同的功能，如检查子节点是否存在，显示隐藏子节点等等
4、 DHTML+XML+ASP+CSS同时使用
技术难点：
1、 使用xmlhttp接口时乱码问题：
因为在asp输出页面中，缺省的编码方案并不是中文的，那么在客户端页面的xmlhttp中解释时，就会以缺省的方案解析，所以就会出现乱码。为此，我们在Server端的asp页面中，加入如下代码定义编码方案：
Response.CharSet="GB2312"
Response.ContentType="text/html"
2、 如何在界面上保持上一版本的风格（类资源管理器形式）：
在上一版本中，所有的页面内容都是一气呵成的，在控制上采用递归等思想，所有时的界面相对友好，当时本版中的机制发生了变化，内容是有多次合成的
关键问题，img ,span 对象的id 如何确定
经过求证，在界面上，本版本的界面难以与第一界面相同，所以只能保留一部分，但是总体来说，新界面同样也能满足需要
因为在这里不好使用附件，所以只能贴源码了：
---xtree.html-------------------------------------------------------------------
<HTML>
<HEAD>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
<SCRIPT LANGUAGE=javascript src="xtree.js">
</SCRIPT>
<style type="text/css">
<!--
a:link { font-size: 14px; text-decoration: none; color: #0000FF}
a:visited { font-size: 14px; color: #0000FF; text-decoration: none}
a:hover { font-size: 14px; color: #FF0000; background-color: #CCCC99; text-decoration: none}
a:active { font-size: 14px; color: #FFFFFF; background-color: #191970; text-decoration: none}
.item{ font-size:14px}
-->
</style>
</HEAD>
<BODY leftMargin=0 rightMargin=0 topMargin=0 border=0>
<bold>树形菜单演示程序</bold><br>
<table border=0>
<tr><td nowrap>
<span id='oSpanroot' border=0></span><SCRIPT LANGUAGE=javascript>createChildNode("root",0);</SCRIPT></td></tr>
</table>
</BODY>
</HTML>
-------xtree.asp---------------------------------------------------------------
<%@ Language=VBScript %>
<%
Response.CharSet="GB2312"
Response.ContentType="text/html"
'''''''''''''''''''''''''''''''Server code start'''''''''''''''''''''''''''''''
dim parId,nodeLayer
parid=Request.QueryString("parId")
nodeLayer=cint(Request.QueryString("nodeLayer"))
if(parid="") then
Response.Write("root id can't is null")
Response.End()
end if
if(nodeLayer<0) then
nodeLayer=0
end if
%>
<%
strconn="at"
strsql="select * from tree where par='"&parid&"'"
''SQL 语句书写要求：在记录集的前面三个字段必须依次为：row_id（惟一的主键）、name（菜单条显示的内容）、par_id（父节点row_id),其它根据需要输出与显示
set conn=server.createobject("ADODB.connection")
conn.open strconn
set rs=server.createobject("ADODB.Recordset")
rs.open strsql,conn,3,3
i=0
dim row_id
row_id=""
while not rs.EOF
row_id=rs.Fields("row_id").Value
name=rs.Fields("name").Value
j=0
while j<nodeLayer
Response.Write("<img src='blank.bmp'>")
j=j+1
wend
Response.Write("<img id='objNode"&row_id&"' style='cursor:hand' src='open.bmp' onclick=javascript:createChildNode('"&row_id&"',"&nodeLayer+1&") border=0 align='absmiddle'>")
Response.Write("<img src='blank.bmp' border=0 align='absmiddle'>")
Response.Write("<a class=item href='view.asp?id="&row_id&"' target='mainFrame'>"&Trim(name)&"</a></br>") '项目内容
Response.Write("<span id='oSpan"&row_id&"' ></span>") '子节点内容区域
i=i+1
rs.MoveNext
wend
'''''''''''''''''''''''''''''''''''''''''Server Code END ''''''''''''''''''''''''''''''''''
%>
---------xtree.js-----------------------------------------------------------------------------
function getChildTree(parId,nodeLayer)
//parId:=夫节点id,nodeLayer:=子节点所属层次
{
var xmlhttp = new ActiveXObject ("Microsoft.XMLHTTP");
xmlhttp.Open("get", "xtree.asp?parId="+parId+"&nodeLayer="+nodeLayer, false);
xmlhttp.Send("Author:taojianbo;Version:2.0");
return xmlhttp.responseText;
}
function showHide(objid)
//显示，隐藏区域，达到菜单显示的目的
//objid:=区域对象ID的parid部分
{
var temp;
eval("temp=oSpan"+objid+".style.display");
if(temp=="block")
{
eval("oSpan"+objid+".style.display='none'");
eval("objNode"+objid+".src='open.bmp'");
}
else
{
eval("oSpan"+objid+".style.display='block'");
eval("objNode"+objid+".src='close.bmp'");
}
}//end function
function createChildNode(childNodeId,nodeLayer)
//如果子节点内容为空，则初始化，并更新数据
//childNodeId:=子节点对象Id的parid部分
{
var temp;
eval("temp=oSpan"+childNodeId+".innerHTML");
if(temp=="")
{
eval("oSpan"+childNodeId+".innerHTML='<div align=right>LOADING...</div><br>'");
temp=new String(getChildTree(childNodeId,nodeLayer));
if(temp.length!=0)
{
eval("oSpan"+childNodeId+".innerHTML=temp");
eval("objNode"+childNodeId+".src='close.bmp'");//变为减号
}
else
{//如果temp内容为空，说明未找到子树，则该节点为叶节点，更改相关属性
eval("objNode"+childNodeId+".src='leaf.bmp'");//更改图标
eval("objNode"+childNodeId+".onclick=''"); //取消click事件
eval("oSpan"+childNodeId+".innerHTML=temp");//内容为空
}
}
else
{ showHide(childNodeId);
}
}
|
|
|
