乱闪Blog

隱藏左欄全部展開全部合上 W3CHINA Blog首頁 管理頁面寫新日志退出

首页(267)　SQL+数据库(20)　ASP技朮(82)　Script脚本(24)　網文精選(72)　C#(2)　.NET編程(23)　Flash教程(7)　其它網頁技朮(35)　

===亂閃Blog===

针对有网友说看不见文章内容，
现提示如下:
点击每一个标题行任一地方都会展开和隐藏此文章内容(不要点击标题).
目前展开隐藏功能只支持IE浏览器，虽然可以改成支持FF浏览器，不过现在一直没时间去弄，等有时间再修改了。

鏈接

闾丘露薇的BLOG
鹤山热线(我的网站)
欢乐论坛(原创论坛)
乱闪文章系统(原创)
CSDN
MSDN 中文網站
中国XML论坛
闪盟论坛
中国鹰派联盟
凤凰论坛
Flash神魂顛倒論壇
经典论坛
鬼故事专栏

回復

回复:孙悟空大闹天宫失败的主要原因
回复:欠扁问答题44题
回复:ASP+JavaScript+数据
回复:ASP+JavaScript+数据
回复:ASP+JavaScript+数据
回复:Flash MX 认证考试(样题)
回复:ASP.NET 2.0无刷新页面新
回复:Google搜索从入门到精通v4.
回复:ASP+JavaScript+数据
回复:ASP+JavaScript+数据

留言

签写新留言

pp
生生世世生生世世事实
文章展开不了……
请教DataGrid分页的子窗口关闭时刷
能不能教些诀窍
生日快乐！
RE:RE:请问可不以让某个日志长期置顶
RE:请问可不以让某个日志长期置顶啊？
请问可不以让某个日志长期置顶啊？
RE：RE：你的Blog太棒了

信息

blog名称:乱闪Blog
日志总数:267
评论数量:1618
留言数量:-26
访问次数:2675654
建立时间:2005年1月1日

超级ASP大分页-我的类我做主

展開內容 |

阅读全文(2402) | 回复(0) | 编辑 | 精华 | 删除

将数据库的内容生成WORD文档

展開內容 |

阅读全文(4587) | 回复(4) | 编辑 | 精华 | 删除

　1。改头，就是象excel似的
Response.Buffer = TRUE
Response.ContentType = "application/vnd.ms-excel" '--excel
Response.ContentType = "application/msword" '--word
excel倒是没事，但word就是总出错。弱！ 2。微软的RTF-DOC的例子
　　它的例子倒是很成功，可根据实际需要改起来，不好弄，格式不好控制。 3。调用word.application对象
　　在客户端用这种东西Set objWordDoc = CreateObject("Word.Document")来调用word生成，但是要用户改客户端的安全级别设置，不好！格式控制起来也麻烦。我鼓捣了老半天也搞不定。

4。利用FSO生成word文档
　　不敢说原创，只能说是综合大家的东西，搞成了这个东西。本文主要介绍我的这种方法。　　下面主要介绍从数据库中取资料，然后利用FSO生成Word文档的例子，先给出部分代码，最后给出全部代码。

从数据库中读取数据的代码：
<%
'创建RecordSet对象
Set rs = Server.CreateObject("ADODB.Recordset") 'SQL语句根据实际情况调整
sql="select * from People where PeopleId=" & PeopleId 'Open RecordSet，省略了创建及打开connection对象的代码，请自行添加
rs.open sql,conn,3,3 if rs.eof and rs.bof then
    '无记录
else
    '做点事情，主要是从数据库中获取一些资源
    '赋给变量，再用FSO生成
end if
rs.Close
Set rs=Nothing
conn.Close
Set conn = Nothing
%>

用FSO创建word的代码：
<%
'下面生成文件的代码。
  Dim fso, MyFile
'创建FSO对象，有些服务器有可能不支持这个对象，那就没戏了
  Set fso = CreateObject("Scripting.FileSystemObject")
  '文件名
sFileName = "temp.doc"
'生成新文件文件放在当前目录的word/下,当前测试时必须有这个目录
  Set MyFile = fso.CreateTextFile(Server.MapPath(".")& "\word\"&sFileName, True) myString="这里是你预先排好的word文档，要填的地方都空好了，怎么弄底下告诉！"

'将MyString作为新文件的内容写入文件
　MyFile.WriteLine(myString)
　
　MyFile.Close '关闭文件
%>

文件已经生成了。注意在iis里把word目录设置为“写入”。
以下将word文档以数据流写出，不让IE自动打开，防止出错误提示。
让word文档以附件的形式打开的代码:
Dim strFilePathConst adTypeBinary = 1 strFilePath = "word/temp.doc" Set objStream = Server.CreateObject("ADODB.Stream") objStream.Open objStream.Type = adTypeBinary objStream.LoadFromFile Server.MapPath(strFilePath) 'change the path if necessary Response.ContentType = "application/octet-stream" Response.AddHeader "Content-Disposition", "attachment; filename=化工学院教职工数据采集表--"&rs("name")&".doc" '如果文件名固定，那就直接filename=文件名.doc，这个名字就是用户选“保存”时，出现的名字 Response.BinaryWrite objStream.Read Response.Flush objStream.Close Set objStream = Nothing '写完，释放对象
[Ctrl+A 全部选择然后拷贝] 发现把attachment去掉，就会用ie直接打开了。不让它直接打开！

以下为从库中取资料并生成Wrod代码：
<% Sub CreateWord(filename,content) Dim fso, MyFile '创建FSO对象，有些服务器有可能不支持这个对象，那就没戏了 Set fso = CreateObject("Scripting.FileSystemObject") '生成新文件文件放在当前目录的word/下,当前测试时必须有这个目录 Set MyFile = fso.CreateTextFile(filename, True) 　MyFile.WriteLine(content) 　　MyFile.Close '关闭文件 Set fso = Nothing End Sub '假设数据库中有如下字段: 'FileName:生成的word文件名 'content:个人资料 Set conn = CreateObject("Adodb.Connection") strConn = "Driver={Microsoft Access Driver (*.mdb)};dbq=" & Server.Mappath("你的Access库文件名") conn.Open strConn '创建RecordSet对象 Set rs = Server.CreateObject("ADODB.Recordset") 'SQL语句根据实际情况调整 sql="select * from [TableName]" 'Open RecordSet，省略了创建及打开connection对象的代码，请自行添加 rs.open sql,conn,3,3 if rs.eof and rs.bof then Response.Write("对不起数据库中还没有任何记录！") Response.End else sFilePath = "Word\" Do While Not rs.Eof sFileName = Server.Mappath(sFilePath & rs("filename")) sWordContent = rs("content") Call CreateWord(sFileName,sWordContent) rs.MoveNext Loop end if rs.Close Set rs=Nothing conn.Close Set conn = Nothing %>
[Ctrl+A 全部选择然后拷贝]

注：myString="" 里面到底是什么？
用word做一个你要的格式的文档，都排好了，
把要填的地方做好标记，比如写几个字什么的。
然后“另存为”web页面。本文所说的是文档里没有图片的情况，有的话我也不会。

到你的硬盘里找到这个web页面，打开，查看源文件，ctrl+a,ctrl+c,
在word里，ctrl+N,ctrl+v,ctrl+F，点“替换”标签，
第一步：查找内容填双引号"，替换为填两个双引号""，全部替换即可。
第二步：点“高级”，查找内容里填“特殊字符”的“段落标记”，替换为填“特殊字符”的“不间断空格”，全部替换即可。
然后ctrl+a,ctrl+c,把东西paste在myString=""的两个引号之间。
==========================================
这时.asp文件已经可以执行，不过生成的是空word文档，啥也没填，没用。
在myString后面的引号里，找你那些标记，比如姓名一栏你填的是“西瓜”，
那么现在找到“西瓜”两个字，删除，打"&rs("name")&"，
包括前后两个引号。以此类推，把所有的地方都用库中的纪录搞定。
========================================
哦，现在就行了。基本满足要求了。
注：几个小问题

1。有时保存你的word文档到web页面时，会生成”你的文件名.files"的文件夹。
那你用这个.asp文件动态生成word文档时，会提示“XXXX丢失”，不爽！
解决办法：在你保存的web页面，查看源文件，查找“你的文件名.files“，
相关的地方都删除掉。一般会有<link...>还有style里的。看着删吧。

2。这个.asp文件执行是会出现下载提示框，如果选“打开”的话，
word就会打开生成的这个文档，我发现有时是以“web视图”打开的，
有时是“页面视图”打开的。很是奇怪，仔细对比了一下，发现：
只要在你的myString里找<w:WordDocument>，在后面加上<w:View>Print</w:View>，那么就会以“页面视图”打开了。好了！附：使IE下载WORD文档
文件名:Download.asp
<%
Dim Stream
Dim Contents
Dim FileName
Dim FileExt
Const adTypeBinary = 1
FileName = Request.QueryString("FileName")
if FileName = "" Then
    Response.Write "无效文件名."
    Response.End
End if
’ 下面是不希望下载的文件
FileExt = Mid(FileName, InStrRev(FileName, ".") + 1)
Select Case UCase(FileExt)
    Case "ASP", "ASA", "ASPX", "ASAX", "MDB"
        Response.Write "受保护文件,不能下载."
        Response.End
End Select
’ 下载这个文件
Response.Clear
Response.ContentType = "application/octet-stream"
Response.AddHeader "content-disposition", "attachment; filename=" & FileName
Set Stream = server.CreateObject("ADODB.Stream")
Stream.Type = adTypeBinary
Stream.Open
Stream.LoadFromFile Server.MapPath(FileName)
While Not Stream.EOS
    Response.BinaryWrite Stream.Read(1024 * 64)
Wend
Stream.Close
Set Stream = Nothing
Response.Flush
Response.End
%>
使用：Download.asp?FileName=/Files/MY.doc
把你的DOC文件放到根目录Files下，你也可以放到其它地方了。

如：
<A HREF="Download.asp?FileName=/Files/MY.doc">点击下载WORD文档</A>

电脑与网络乱闪发表于 2005/1/28 21:18:20

随机提取N条记录

展開內容 | 阅读全文(2849) | 回复(0) | 编辑 | 精华 | 删除

用VB 6封装ASP代码, 制作DLL组件

展開內容 | 阅读全文(2939) | 回复(0) | 编辑 | 精华 | 删除

启动vb6.0，新建-->Active dll工程。单击"工程"-->引用,选择"microsoft active server pages object library"
和"microsoft activeX data objects 2.1 library"两项。将类模块的名称改为dcss.将工程的名称改为yygwy.保存工程文件yygwy.vbp和类文件dcss.cls。
在dcss.cls中写入:
Private myscriptingcontext As ScriptingContext
Private myapplication As Application
Private myrequest As Request
Private myresponse As Response
Private myserver As Server
Private mysession As Session Public Sub onstartpage(passedscriptingcontext As ScriptingContext)
Set myscriptingcontext = passedscriptingcontext
Set myapplication = myscriptingcontext.Application
Set myrequest = myscriptingcontext.Request
Set myresponse = myscriptingcontext.Response
Set myserver = myscriptingcontext.Server
Set mysession = myscriptingcontext.Session
End Sub Public Sub onendpage()
Set myscriptingcontext = Nothing
Set myapplication = Nothing
Set myrequest = Nothing
Set myresponse = Nothing
Set myserver = Nothing
Set mysession = Nothing
End Sub '以上语句是必须的。
'定义两个公有函数 Public Function rsresult(strsql As String) As Recordset
Dim mycnn As Connection
Dim myset As Recordset
Dim strconnstring As String
'strconnstring = "provider=sqloledb.1;
password=;" & "user id=sa;" & "initial catalog=vlog;" & "data source=hpe60;
connect timeout=15"
strconnstring = "driver={sql server};server=yang;uid=sa;pwd=;
database=dcss"
'mycnn.ConnectionString = strconnstring
mycnn.Open strconnstring
myset.ActiveConnection = mycnn
myset.Open strsql, mycnn, 3, adCmdText
Set rsresult = myset
End Function Public Function datasource() As Variant
datasource = "driver={sql server};server=yang;uid=sa;pwd=; database=dcss"
End Function 编译生成dcss.dll文件。注册regsvr32 路径dcss.dll。
用visual interdev打开global.asa文件.当然了，你也可以在其它文件中使用。
set    dcss=server.CreateObject("yygwy.dcss")
oconn=dcss.datasource()
application("strconn")=oconn   在其它的页面中如下调用即可：
set objConn = Server.CreateObject("ADODB.Connection")
objConn.Open application("strconn")

电脑与网络乱闪发表于 2005/1/28 21:06:19

ASP特殊字符过滤

展開內容 | 阅读全文(5050) | 回复(2) | 编辑 | 精华 | 删除

仅用xsl和asp实现分页功能

展開內容 | 阅读全文(3526) | 回复(1) | 编辑 | 精华 | 删除

使用javascript+dom+xml实现分页

展開內容 | 阅读全文(4748) | 回复(3) | 编辑 | 精华 | 删除

限制某段IP地址

展開內容 | 阅读全文(3262) | 回复(1) | 编辑 | 精华 | 删除

ASP编写完整的一个IP所在地搜索类

展開內容 | 阅读全文(2538) | 回复(1) | 编辑 | 精华 | 删除

修正了查询方法，查询的方法和追捕的一致；只是追捕会自动更正IP。
还有个函数的书写错误，也已经修正；
包括增加了一个IP地址正确性的验证函数。（只是从格式上判断）
<%
'作者：萧寒雪(S.F.)
'QQ号：410000
Server.ScriptTimeout = &HE10 '&H3C
Response.Buffer = ("S.F." = "S.F.")
Dim IpSearch
'建立对象
Set IpSearch = New clsIpSearch
' 该句建立SQL Server的IP地址库的连接，可使用默认连接，但要保证存在wry.mdb
IpSearch.ConnectionString = "DRIVER={SQL Server};SERVER=hostname:UID=sa;PWD=;DATABASE=Ip"
' 设置要查询的IP，可用默认值，这里设置的是 127.0.0.1
IpSearch.IpAddress = &H7F & "." & &H00 & "." & &H00 & "." & &H01
If Request.QueryString("IP")<>"" Then
If IpSearch.Valid_IP(Request.QueryString("IP")) Then
IpSearch.IpAddress = Trim(Request.QueryString("IP"))
End If
End If
' 取得IP 所在地，反馈值有三个，以逗号分割
' 格式为：所在国家或地区,当地上网地区,提供正确IP地址信息的用户名
Response.Write ("所在地:" & IpSearch.GetIpAddrInfo() & "<br>")
' 取出IP地址
Response.Write ("IP:" & IpSearch.IpAddress & "<br>")
' 将IP地址转换为数值
Response.Write ("IP转换为数值:" & IpSearch.CLongIP(IpSearch.IpAddress) & "<br>")
' 将IP地址转换为数值后还原成IP字符串
Response.Write ("数值还原成IP:" & IpSearch.CStringIP(IpSearch.CLongIP(IpSearch.IpAddress)) & "<br>")
Response.Write ("<hr>") '这里是测试代码
'dim a,b,c,d
'for a = 0 to 255
' for b= 0 to 255 step 20
' for c=0 to 255 step 20
' for d = 0 to 255 step 20
' IpSearch.IpAddress = a & "." & b & "." & c & "." & d
' Response.Write ("所在地:" & IpSearch.GetIpAddrInfo() & "<br>")
' Response.Write ("IP:" & IpSearch.IpAddress & "<br>")
' Response.Write ("IP转换为数值:" & IpSearch.CLongIP(IpSearch.IpAddress) & "<br>")
' Response.Write ("数值还原成IP:" & IpSearch.CStringIP(IpSearch.CLongIP(IpSearch.IpAddress)) & "<br>")
' Response.Write ("<hr>")
' next
' next
' next
'next
%>
<%
Class clsIpSearch
'##################################
'声明：本程序采用的数据为网络上著名的IP工具软件《追捕》作者“冯志宏”
'先生所精心搜集整理。
'《追捕》数据库的转换方法：
'修改wry.dll 文件后缀名称为 wry.dbf
'方法一：
' 启动Access 数据，选择打开数据库，选择打开的文件类型为“dBASE 5 (*.dbf)”
' 打开wry.dbf文件，选择《工具》菜单下的《数据库实用工具》中的《转换数据库》
' 选择《转换为 Access 97 格式(版本可选)》功能，保存文件即可成为MDB格式。
'方法二：
' 使用SQL Server提供的《导入和导出数据》向导。
' 方法简要说明：在ODBC 控制面板中设置指向wry.dbf的DSN。
' 使用《导入和导出数据》向导，选择其正确的驱动程序和要导入的库即可。
' 或者直接导入由方法一生成的MDB文件入库。
'方法三：
' 使用Access 打开wry.dbf 文件后将自动通过MDB库引用原库数据。
'
'未安装其他数据库平台，其他方法欠考虑。
'###################### 类说明 ####################################
'# IP 所在地搜索类
'# ConnectionString 为数据库连接声明，默认声明同级目录的wry.mdb
'# IpAddress 请设置为进行搜索的IP 地址，默认取当前访问者IP
'# 类建立方法
'# Dim objVal '声明一个变量
'# Set objVal = New clsIpSearch '建立类对象
'# Response.Write (objVal.IpAddress) '显示当前访问者IP
'# IP 搜索类方法列表：
'# .Valid_IP 'IP 地址正确性效验
'# 参数：IP 'IP 数值或者字符串
'# .CLongIP '将IP地址转换为长整型的数值
'# 参数：asNewIP '要转换的IP地址字符串
'# .CStringIP '将长整型的数值转换为IP
'# 参数：anNewIP '要还原为IP地址的数值
'# .GetClientIP '取访问者的IP
'# .GetIpAddrInfo '得到设置过IpAddRess属性的IP所在地
'# 属性列表（自动初始化）：
'# ConnEctionString 'ADo 访问数据库连接说明
'# IpAddress '要操作的IP地址
'# 内部错误处理：
'# 欠缺，未做，请自行补充。
'#################################
Public ConnectionString
Public IpAddress
Private DBConn '连接对象，模块级声明
'────────────────────────────────
' 类初始化
Private Sub Class_initialize()
' 这里建立的是通过“数据转换--方法一”生成的mdb 库文件
ConnectionString="DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & Server.MapPath("wry.mdb")
IpAddress = GetClientIP()
Set DBConn = OpenConnection()
End Sub
'────────────────────────────────
' 类注销
Private Sub Class_Terminate()
ConnectionString = Null
IpAddress = Null
DBConn.Close
Set DBConn = Nothing
End Sub
'────────────────────────────────
' 建立一个连接
Private Function OpenConnection()
Dim tmpConn
Set tmpConn=Server.CreateObject("ADODB.Connection")
tmpConn.Open ConnectionString
Set OpenConnection=tmpConn
Set tmpConn=nothing
End Function
'────────────────────────────────
' 执行一个SQL命令，并返回一个数据集对象
Private Function SQLExeCute(strSql)
Dim Rs
Set Rs=DBConn.ExeCute(strSQL)
Set SQLExeCute = Rs
Set Rs=nothing
End Function
'────────────────────────────────
'IP 效验
Public Function Valid_IP(ByVal IP)
Dim i
Dim dot_count
Dim test_octet
Dim byte_check
IP = Trim(IP)
' 确认IP长度
If Len(IP) < &H08 Then
Valid_IP = False
'显示错误提示
Exit Function
End If i = &H01
dot_count = &H00
For i = 1 To Len(IP)
If Mid(IP, i, &H01) = "." Then
' 增加点的记数值
' 并且设置text_octet 值为空
dot_count = dot_count + &H01
test_octet = ""
If i = Len(IP) Then
' 如果点在结尾则IP效验失败
Valid_IP = False
' 显示错误提示
Exit Function
End If
Else
test_octet = test_octet & Mid(IP, i, &H01)
' 使用错误屏蔽来检查数据段值的正确性
On Error Resume Next
' 进行强制类型转换
' 如果转换失败就可通过检查Err是否为真来确认
byte_check = CByte(test_octet)
If (Err) Then
' 强制类型转换产生错误
' 所取段值的数据不为数值
' 或所取段值的数据长度大于&HFF
' 则类型不为byte类型
' IP 地址的正确性为假
Valid_IP = False
Exit Function
End If
End If
Next ' 通过上一步的验证，现在应该要检查小点是否有3个
If dot_count <> &H03 Then
Valid_IP = False
Exit Function
End If
' 一切正常，那么该IP为正确的IP地址
Valid_IP = True
End Function
'────────────────────────────────
' 转换一个数值为IP
Public Function CStringIP(ByVal anNewIP)
Dim lsResults
Dim lnTemp
Dim lnIndex
For lnIndex = &H03 To &H00 Step -&H01
lnTemp = Int(anNewIP / (&H100 ^ lnIndex))
lsResults = lsResults & lnTemp & "."
anNewIP = anNewIP - (lnTemp * (&H100 ^ lnIndex))
Next
lsResults = Left(lsResults, Len(lsResults) - &H01)
CStringIP = lsResults
End function
'────────────────────────────────
' 转换一个IP到数值
Public Function CLongIP(ByVal asNewIP)
Dim lnResults
Dim lnIndex
Dim lnIpAry
lnIpAry = Split(asNewIP, ".", &H04)
For lnIndex = &H00 To &H03
if Not lnIndex = &H03 Then
lnIpAry(lnIndex) = lnIpAry(lnIndex) * (&H100 ^ (&H03 - lnIndex))
End if
lnResults = lnResults + lnIpAry(lnIndex)
Next
CLongIP = lnResults
End function
'────────────────────────────────
' 取Client IP
Public Function GetClientIP()
dim uIpAddr
' 本函数参考webcn.Net/AspHouse 文献<取真实的客户IP>
uIpAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If uIpAddr = "" Then uIpAddr = Request.ServerVariables("REMOTE_ADDR")
GetClientIP = uIpAddr
uIpAddr = ""
End function
'────────────────────────────────
' 读取IP所在地的信息
Public function GetIpAddrInfo()
Dim tmpIpAddr
Dim IpAddrVal
Dim ic,charSpace
Dim tmpSQL
charSpace = ""
IpAddrVal = IpAddress
If Not Valid_IP(IpAddrVal) Then
GetIpAddrInfo =NULL
Exit Function
End If
'将IP字符串劈开成数组好进行处理
tmpIpAddr = Split(IpAddrVal,".",-1,1)
For ic = &H00 To Ubound(tmpIpAddr)
'补位操作,保证每间隔满足3个字符
Select Case Len(tmpIpAddr(ic))
Case &H01 :charSpace = "00"
Case &H02 :charSpace = "0"
Case Else :charSpace = ""
End Select
tmpIpAddr(ic) = charSpace & tmpIpAddr(ic)
Next
IpAddrVal = tmpIpAddr(&H00) & "." & tmpIpAddr(&H01) & "." & tmpIpAddr(&H02) & "." & tmpIpAddr(&H03) '以下为查询，IP地址库基于《追捕》的IP数据库,感谢"冯志宏"先生的贡献
'库结构如下：
'CREATE TABLE [dbo].[wry] (
' [STARTIP] [nvarchar] (17) COLLATE Chinese_PRC_CI_AS NULL , --起始IP段
' [ENDIP] [nvarchar] (17) COLLATE Chinese_PRC_CI_AS NULL , --终止IP段
' [COUNTRY] [nvarchar] (16) COLLATE Chinese_PRC_CI_AS NULL , --国家或者地区
' [LOCAL] [nvarchar] (54) COLLATE Chinese_PRC_CI_AS NULL , --本地地址
' [THANK] [nvarchar] (23) COLLATE Chinese_PRC_CI_AS NULL --感谢修正IP地址用户姓名
') ON [PRIMARY]
'经过分析库的数据存放结构，总结出准确的查询方法，具体看下面的查询过程
tmpSQL = "select * from wry where (startIP<='" & IpAddrVal & "') and (ENDIP>='" & IpAddrVal & "') " & _
" and left(startIP," & Len(tmpIpAddr(&H00)) & ") = '" & tmpIpAddr(&H00) & "'" & _
" and left(endip," & Len(tmpIpAddr(&H00)) & ")='" & tmpIpAddr(&H00) & "'"
charSpace = GetDbIpInfo(tmpSQL)
If Len(charSpace)=&H00 Then
GetIpAddrInfo = NULL
Else
GetIpAddrInfo = charSpace
End If
charSpace = Null
tmpSQL = Null
end function
'────────────────────────────────
' 返回数据查询的字符串
Private function GetDbIpInfo(byVal sql)
Dim OpenIpSearchRs
Dim result
Set OpenIpSearchRs = SQLExeCute(sql)
If Not OpenIpSearchRs.Eof Then
result = NullToSpace(OpenIpSearchRs("COUNTRY")) & "," & NullToSpace(OpenIpSearchRs("LOCAL")) & "," &
NullToSpace(OpenIpSearchRs("THANK"))
Else
result = NULL
End If
OpenIpSearchRs.Close
Set OpenIpSearchRs=Nothing
GetDbIpInfo = result
End function
'────────────────────────────────
' 将数据库空记录转换为空字符
Private function NullToSpace(byVal rsStr)
If isNull(rsStr) Then
NullToSpace = ""
Else
NullToSpace = Trim(rsStr)
End If
End Function
End Class
%>

电脑与网络乱闪发表于 2005/1/28 20:58:09

ASP应用模板生成html文件的一种方法

展開內容 | 阅读全文(3150) | 回复(1) | 编辑 | 精华 | 删除

Cookie的构成

展開內容 | 阅读全文(3177) | 回复(2) | 编辑 | 精华 | 删除

Cookies最初设计时，是为了CGI编程。但是，我们也可以使用Javascript脚本来操纵cookies。在本文里，我们将演示如何使用Javascript脚本来操纵cookies。(如果有需求，我可能会在以后的文章里介绍如何使用Perl进行cookie管理。但是如果实在等不得，那么我现在就教你一手：仔细看看CGI.pm。在这个CGI包里有一个cookie()函数，可以用它建立cookie。但是，还是让我们先来介绍cookies的本质。

在Javascript脚本里，一个cookie 实际就是一个字符串属性。当你读取cookie的值时，就得到一个字符串，里面当前WEB页使用的所有cookies的名称和值。每个cookie除了name名称和value值这两个属性以外，还有四个属性。这些属性是： expires过期时间、 path路径、 domain域、以及 secure安全。

Expires – 过期时间。指定cookie的生命期。具体是值是过期日期。如果想让cookie的存在期限超过当前浏览器会话时间，就必须使用这个属性。当过了到期日期时，浏览器就可以删除cookie文件，没有任何影响。

Path – 路径。指定与cookie关联的WEB页。值可以是一个目录，或者是一个路径。如果/head/index.html 建立了一个cookie，那么在/head/目录里的所有页面，以及该目录下面任何子目录里的页面都可以访问这个cookie。这就是说，在/head/stories/articles 里的任何页面都可以访问/head/index.html建立的cookie。但是，如果/zdnn/ 需要访问/head/index.html设置的cookes，该怎么办？这时，我们要把cookies的path属性设置成“/”。在指定路径的时候，凡是来自同一服务器，URL里有相同路径的所有WEB页面都可以共享cookies。现在看另一个例子：如果想让 /head/filters/ 和/head/stories/共享cookies，就要把path设成“/head”。

Domain – 域。指定关联的WEB服务器或域。值是域名，比如goaler.com。这是对path路径属性的一个延伸。如果我们想让dev.mycompany.com 能够访问bbs.mycompany.com设置的cookies，该怎么办? 我们可以把domain属性设置成“mycompany.com”，并把path属性设置成“/”。FYI：不能把cookies域属性设置成与设置它的服务器的所在域不同的值。

Secure – 安全。指定cookie的值通过网络如何在用户和WEB服务器之间传递。这个属性的值或者是“secure”，或者为空。缺省情况下，该属性为空，也就是使用不安全的HTTP连接传递数据。如果一个 cookie 标记为secure，那么，它与WEB服务器之间就通过HTTPS或者其它安全协议传递数据。不过，设置了secure属性不代表其他人不能看到你机器本地保存的cookie。换句话说，把cookie设置为secure，只保证cookie与WEB服务器之间的数据传输过程加密，而保存在本地的cookie文件并不加密。如果想让本地cookie也加密，得自己加密数据。

电脑与网络乱闪发表于 2005/1/28 20:55:51

用XML+FSO+JS实现服务器端文件的选择

展開內容 | 阅读全文(3122) | 回复(1) | 编辑 | 精华 | 删除

查看服务器Application/Session变量工具

展開內容 | 阅读全文(2260) | 回复(0) | 编辑 | 精华 | 删除

用正则解析图片地址,并利用XMLHTTP组件将其保存

展開內容 | 阅读全文(2853) | 回复(1) | 编辑 | 精华 | 删除

现在基于WEB页的HTML的编辑器在新闻系统，文章系统中用得越来越广，一个网页一粘就可以保持原来的样式，同时图片也可以在这个页中保持。但是在使用过程中，如果所粘贴页中的图片被删除，就会在自己的页面上留下一个大大的“X”，影响美观。以前只好把这个图片保存下来，再重新上传到服务器上，这样实在麻烦。能不能让服务器自动去下载图片保存在服务器并且替换页面上的链接？答案是肯定的。
要实现这个功能需要经过三个步骤：
一，取得原页中的图片的地址。方法很多，可以用分割字符串，也可以用正则匹配。实践证明用正则匹配最为简单。经过分析图片的地址都保存在<img>标签中。我们可以先取得所有这个标签。过程如下：
Set objRegExp = New Regexp'设置配置对象
objRegExp.IgnoreCase = True’忽略大小写
objRegExp.Global = True’设置为全文搜索
objRegExp.Pattern = "<img.+?>"'为了确保能准确地取出图片地址所以分为两层配置：首先找到里面的<img>标签，然后再取出里面的图片地址后面的getimgs函数就是实现后一个功能的。
strs=trim(str)
Set Matches =objRegExp.Execute(strs)’开始执行配置
For Each Match in Matches
RetStr = RetStr &getimgs( Match.Value )’执行第二轮的匹配
Next 所有的图片在里面都是这样的src="http://图片的地址"，所以可以这样来取得确切的图片地址：
function getimgs(str)
getimgs=""
Set objRegExp1 = New Regexp
objRegExp1.IgnoreCase = True
objRegExp1.Global = True
objRegExp1.Pattern = "http://.+?"""’取出里面的地址
set mm=objRegExp1.Execute(str)
For Each Match1 in mm
getimgs=getimgs&"||"&left(Match1.Value,len(Match1.Value)-1)’把里面的地址串起来备用
next
end function 取得了所有的图片的地址，我们就可以进行第二步的操作了。
二，下载图片并保存在服务器上。这个又可以分为两个步骤：一个是取得图片的内容，另一个是保存在服务器上。取得图片的内容是通过下面的函数来实现的：
function getHTTPPage(url)
on error resume next
dim http
set http=server.createobject("MSXML2.XMLHTTP")‘使用xmlhttp的方法来获得图片的内容
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then
exit function
end if
getHTTPPage=Http.responseBody
set http=nothing
if err.number<>0 then err.Clear
end function
取得了图片的内容要保存，给人一种感觉是用FSO来作就可以了，但实际上不行，这样保存程序就会出错，因为FSO不支持流式的文件，所以我们要调用另一个对象：ADO.STREM。具体的过程如下：
function saveimage(from,tofile)
dim geturl,objStream,imgs
geturl=trim(from)
imgs=gethttppage(geturl)'取得图片的具休内容的过程
Set objStream = Server.CreateObject("ADODB.Stream")'建立ADODB.Stream对象，必须要ADO 2.5以上版本
objStream.Type =1'以二进制模式打开
objStream.Open
objstream.write imgs'将字符串内容写入缓冲
objstream.SaveToFile server.mappath(tofile),2'-将缓冲的内容写入文件
objstream.Close()'关闭对象
set objstream=nothing
end function
所以只要用一个循环来把刚才取得的地址中的图片全部保存下来，具体过程如下：
arrimg=split(retstr,"||")'分割字串，取得里面地址列表
allimg=""
newimg=""
for i=1 to ubound(arrimg)
if arrimg(i)<>"" and instr(allimg,arrimg(i))<1 then'看这个图片是否已经下载过
fname=baseurl&cstr(i&mid(arrimg(i),instrrev(arrimg(i),".")))
saveimage(arrimg(i),fname)‘保存地址的函数，过程见上面
allimg=allimg&"||"&arrimg(i)'把保存下来的图片的地址串回起来，以确定要替换的地址
newimg=newimg&"||"&fname'把本地的地址串回起来
end if
next
第三步就是替换原来的地址了。具体的过程就是下面了：
arrnew=split(newimg,"||")'取得原来的图片地址列表
arrall=split(allimg,"||")'取得已经保存下来的图片的地址列表
for i=1 to ubound(arrnew)'执行循环替换原来的地址
strs=replace(strs,arrall(i),arrnew(i))
next
cctv=strs
讲到这里，这个函数的基本过程就是这样了，当然可以对它进行改造就可以实现更多的功能，如：加上图片大小的限制，加上对本地机上的图片下载的限制，以免造成重复下载图片。同时也应该看到这个函数的不足之处是只能处理静态的图片文件，不能适用程序生成的图片。

电脑与网络乱闪发表于 2005/1/28 20:49:17

论坛帖子附件的防盗链实现

展開內容 | 阅读全文(3004) | 回复(0) | 编辑 | 精华 | 删除

　作者：DLL 方法一： <%
'******************************
'Write By: DLL
'NetBuilder 出品
'文件名使用URL参数/表单项传递,项名为FileName,对GIF和JPG直接输出图片流,其他文件则一律弹出下载提示框
'******************************
On Error Resume Next
Response.Buffer = True
Response.Clear
Const HidDir = "../XBB2003DFSDADA/"   '根据你的文件所在目录修改
SUB UseStream(FileName,FileNameString)
     Dim FileStream,File,FileContentType,IsAttachment
     Set FileStream = Server.CreateObject("ADODB.Stream")
     FileStream.Open
     FileStream.Type = 1
     File = server.MapPath(FileName)
     FileStream.LoadFromFile(File)
     FileContentType = GetContentType(FileName)
     If FileContentType <> "image/gif" And FileContentType <> "image/jpeg" Then
           IsAttachment = "attachment; "
     Else
           IsAttachment = ""
     End If
     Response.AddHeader "Content-Disposition", IsAttachment & "filename=" & FileNameString
     Response.AddHeader "Content-Length", FileStream.Size
     Response.Charset = "UTF-8"
     Response.ContentType = FileContentType
     Response.BinaryWrite FileStream.Read
     Response.Flush
     FileStream.Close
     Set FileStream = Nothing
End SUB
Function GetFilePath(FileName,HiddenDir)       '限制盗链的函数,当来源地址中的域名和当前文件地址的域名不同时则输出自定义错误图片NoImg.gif,您也可以设置为用Session限制
     Dim Server_v1,Server_v2
     Server_v1 = Cstr(Request.ServerVariables("HTTP_REFERER"))
     Server_v2 = Cstr(Request.ServerVariables("SERVER_NAME"))
     ’If Server_v1<>"" And Mid(Server_v1,8,Len(Server_v2)) = Server_v2 Then
           GetFilePath = HiddenDir & FileName
     ’Else
           ’GetFilePath = "NoImg.gif"
     ’End If
End Function
Function GetContentType(FlName)
     Select Case lcase(Right(flName, 4))
     Case ".asf"
           GetContentType = "video/x-ms-asf"
     Case ".avi"
           GetContentType = "video/avi"
     Case ".doc"
           GetContentType = "application/msword"
     Case ".zip"
           GetContentType = "application/zip"
     Case ".xls"
           GetContentType = "application/vnd.ms-excel"
     Case ".gif"
           GetContentType = "image/gif"
     Case ".jpg", "jpeg"
           GetContentType = "image/jpeg"
     Case ".wav"
           GetContentType = "audio/wav"
     Case ".mp3"
           GetContentType = "audio/mpeg3"
     Case ".mpg", "mpeg"
           GetContentType = "video/mpeg"
     Case ".rtf"
           GetContentType = "application/rtf"
     Case ".htm", "html"
           GetContentType = "text/html"
     Case ".txt"
           GetContentType = "text/plain"
     Case Else
           GetContentType = "application/octet-stream"
     End Select
End Function
Dim FileName,FilePath
FileName = Trim(Request("FileName"))
FilePath = GetFilePath(FileName,HidDir)
If Lcase(Right(FilePath, 4)) = ".gif" Then             '如果是GIF文件则可直接用Server.Execute输出它的二进制流.
     Response.AddHeader "Content-Disposition", "filename=" & FileName
     Response.AddHeader "Content-Length", FileStream.Size
     Response.Charset = "UTF-8"
     Response.ContentType = GetContentType(FileName)
     Server.Execute(FilePath)
     If err.Number <> 0 Then
           err.Clear
           Server.Execute("NoImg2.gif")
           Response.End()
     End If
Else    '如果不是GIF图象则使用ADODB.STREAM对象输出其二进制流
     UseStream FilePath,FileName
     If Err.Number <> 0 Then
           Err.Clear
           Server.Execute("NoImg2.gif")
     End If
End If
如果程序出错则输出自定义错误图片NoImg2.gif
%>
方法二： <%
From_url = Cstr(Request.ServerVariables("HTTP_REFERER"))
Serv_url = Cstr(Request.ServerVariables("SERVER_NAME"))
if mid(From_url,8,len(Serv_url)) <> Serv_url then
response.write "非法链接！" '防止盗链
response.end
end if
if Request.Cookies("Logined")="" then
response.redirect "/login.asp" '需要登陆！
end if
Function GetFileName(longname)'/folder1/folder2/file.asp=>file.asp
while instr(longname,"/")
  longname = right(longname,len(longname)-1)
wend
GetFileName = longname
End Function
Dim Stream
Dim Contents
Dim FileName
Dim TrueFileName
Dim FileExt
Const adTypeBinary = 1
FileName = Request.QueryString("FileName")
if FileName = "" Then
    Response.Write "无效文件名！"
    Response.End
End if
FileExt = Mid(FileName, InStrRev(FileName, ".") + 1)
Select Case UCase(FileExt)
    Case "ASP", "ASA", "ASPX", "ASAX", "MDB"
        Response.Write "非法操作！"
        Response.End
End Select
Response.Clear
if lcase(right(FileName,3))="gif" or lcase(right(FileName,3))="jpg" or lcase(right(FileName,3))="png" then
Response.ContentType = "image/*" '对图像文件不出现下载对话框
else
Response.ContentType = "application/ms-download"
end if
Response.AddHeader "content-disposition", "attachment; filename=" & GetFileName(Request.QueryString("FileName"))
Set Stream = server.CreateObject("ADODB.Stream")
Stream.Type = adTypeBinary
Stream.Open
if lcase(right(FileName,3))="pdf" then '设置pdf类型文件目录
TrueFileName = "/the_pdf_file_s/"&FileName
end if
if lcase(right(FileName,3))="doc" then '设置DOC类型文件目录
TrueFileName = "/my_D_O_C_file/"&FileName
end if
if lcase(right(FileName,3))="gif" or lcase(right(FileName,3))="jpg" or lcase(right(FileName,3))="png" then
TrueFileName = "/all_images_/"&FileName '设置图像文件目录
end if
Stream.LoadFromFile Server.MapPath(TrueFileName)
While Not Stream.EOS
    Response.BinaryWrite Stream.Read(1024 * 64)
Wend
Stream.Close
Set Stream = Nothing
Response.Flush
Response.End
%>

电脑与网络乱闪发表于 2005/1/28 20:47:01

Execute 设计防盗链

展開內容 | 阅读全文(2906) | 回复(2) | 编辑 | 精华 | 删除

ASP高亮类

展開內容 | 阅读全文(2292) | 回复(0) | 编辑 | 精华 | 删除

wyd1520    来源：动网论坛
此类高亮根据Editplus高亮来做的 Class Wyd_AspCodeHighLight
Private RegEx
Public Keyword,ObjectCommand,Strings,VBCode
Public KeyWordColor,ObjectCommandColor,StringsColor,Comment,CodeColor
  Private Sub Class_Initialize()
    Set RegEx = New RegExp
RegEx.IgnoreCase = True   ' 设置是否区分字母的大小写 True 不区分。
    RegEx.Global = True   ' 设置全程性质。
    KeyWordColor="#0000FF"
    ObjectCommandColor="#FF0000"
    StringsColor="#FF00FF"
Comment="#008000"
CodeColor="#993300"
Keyword="Set|Private|If|Then|Sub|End|Function|For|Next|Do|While|Wend|True|False|Nothing|Class" '关建字请自己添加
ObjectCommand="Left|Mid|Right|Int|Cint|Clng|String|Join|Array" '函数请自己添加
VBCode=""
  End Sub
  Private Sub Class_Terminate()
    Set RegEx = Nothing
  End Sub
  Private Function M_Replace(Str,Pattern,Color)
    RegEx.Pattern = Pattern  ' 设置模式。
    M_Replace=RegEx.Replace(Str,"<font color="&Color&">$1</font>")
  End Function
  Private Function String_Replace(Str,Pattern,Pattern1,Color,IsString)
  Dim Temp,RetStr
RegEx.Pattern =Pattern1
    Set Matches = RegEx.Execute(Str)
    For Each Match In Matches   ' 遍历 Matches 集合
       Temp=Re(Match.value)
       Str = Replace(Str,Match.value,Temp)
    Next
RegEx.Pattern = Pattern  ' 设置模式。
If IsString=1 Then
       String_Replace=RegEx.Replace(Str,"<font color="&Color&">"$1"</font>")
Else
    String_Replace=RegEx.Replace(Str,"<font color="&Color&">$1</font>")
End If
  End Function
  Private Function Re(Str)
   Dim TRegEx,Temp
   Set TRegEx = New RegExp
   TRegEx.IgnoreCase = True  ' 设置是否区分字母的大小写。
   TRegEx.Global = True   ' 设置全程性质。
   TRegEx.Pattern="<.*?>"
   Temp=TRegEx.Replace(Str,"")
   Temp=Replace(Temp,"<","")
   Temp=Replace(Temp,">","")
   Re=Temp
   Set TRegEx=Nothing
  End Function

  Public Function MakeLi()
    Dim Temp
If VBCode="" Then
    MakeLi=""
    Exit Function
End If
    VBCode=HTMLEncode(VBCode)
    Temp=M_Replace(VBCode,"\b("&Keyword&")\b",KeyWordColor)
    Temp=M_Replace(Temp,"\b("&ObjEctCommand&")\b",ObjectCommandColor)
    Temp=String_Replace(Temp,"""(.*?)""","""(.*)(<.+?>)("&KeyWord&ObjectCommand&")+(<.+?>)(.*)""",StringsColor,1)' 字符串
    Temp=String_Replace(Temp,"(('|rem).*)","'(.*)(<.+?>)("&KeyWord&ObjectCommand&")+(<.+?>)(.*)",Comment,0) '注释
    MakeLi="<FONT  COLOR="&CodeColor&">"&RepVbCrlf(Temp)&"</FONT>"
  End Function
  Public Function RepVbCrlf(fString)
     RepVbCrlf = Replace(fString, CHR(10), "<BR> ")
  End Function
  Public Function HTMLEncode(fString)
     If IsNull(fString) Or fString="" Then
     HTMLEncode=""
  Exit Function
     End If
     fString = replace(fString, ">", ">")
     fString = replace(fString, "<", "<")
     'fString = Replace(fString, CHR(32), " ")
     'fString = Replace(fString, CHR(9), " ")
     'fString = Replace(fString, CHR(34), """)
     'fString = Replace(fString, CHR(39), "'")
     'fString = Replace(fString, CHR(13), "")
     'fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
     'fString = Replace(fString, CHR(10), "<BR> ")
     HTMLEncode = fString
   End Function
End Class
例子 star=timer()
Set TT = New Wyd_AspCodeHighLight
If Request("xx")<>"" Then
  TT.VBCode=Request("xx")
  Response.write TT.MakeLi()
  REsponse.write "<br>"&FormatNumber(timer()-star,2)*1000
Else %>
<FORM METHOD=POST action="Index2.asp">
<TEXTAREA NAME="xx" ROWS="30" COLS="80">Class Lih
Private RegEx
Public Keyword,ObjectCommand,Strings,VBCode
Public KeyWordColor,ObjectCommandColor,StringsColor,Comment
  Private Sub Class_Initialize()
    Set RegEx = New RegExp
    KeyWordColor="#0000FF"
    ObjectCommandColor="#FF0000"
    StringsColor="#FF00FF"
Comment="#008000"
Keyword="If|End|For|Next|Function|Then|Do|While|Wend|Class"
VBCode=""
  End Sub
  Private Sub Class_Terminate()
    Set RegEx = Nothing
  End Sub
  Private Function M_Replace(Str,Pattern,Color)
    RegEx.IgnoreCase = False   ' 设置是否区分字母的大小写。
    RegEx.Global = True   ' 设置全程性质。
    RegEx.Pattern = Pattern  ' 设置模式。</TEXTAREA>
<INPUT TYPE="submit" value=fff>
</FORM>
<%End If%>

电脑与网络乱闪发表于 2005/1/28 20:41:09

ASP日历类

展開內容 | 阅读全文(3332) | 回复(4) | 编辑 | 精华 | 删除

作者：Xinsoft    来源：LeadBBS
类代码：
<%
Class Calendar Public Lang
Public DateVal Public PrevYLink,NextYLink
Public PrevMLink,NextMLink '' Temp Var Private pWeekdaysText '' HTML Parameters Public LinkStyleClass Public Table_class
Public Table_width
Public Table_bgColor Public Table_Title_style
Public Table_Title_bgColor
Private Table_Title_Text Public tdBgColor_Light
Public tdBgColor_Dark
Public tdBgColor_Gray '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
''      meta functions
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub Print( str )
      Response.Write str & vbCrlf
End Sub
Private Sub Echo( str )
      Response.Write str
End Sub
Private Sub EchoPara( str , val )
      If ""<>""&val Then Response.Write " " & str & "="""& val &""""
End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
''      HTML functions
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub PrintTableHead
      Echo "<table"

      EchoPara "class"      , Table_class
      EchoPara "width"      , Table_width
      EchoPara "bgColor"      , Table_bgColor

      Echo " cellSpacing=""1"" cellPadding=""1"""
      Echo " align=""center"""
      Echo " border=""0"""

      Print "><tbody>"
End Sub
Private Sub PrintTableTail
      Print ""
      Echo "</tbody></table>"
End Sub
Private Sub PrintTableTitle
Print "<tr>"
      Echo "<td"
      EchoPara "style"      , Table_Title_style
      EchoPara "bgColor"      , Table_Title_bgColor
      EchoPara "colspan"      , "7"
      Echo ">"

      Echo " <b>" & Table_Title_Text & "</b>"

      Print "</td>"
Print "</tr>"
End Sub
Private sub SetWeekdaysText_CHS()
      pWeekdaysText(0)="日"
      pWeekdaysText(1)="一"
      pWeekdaysText(2)="二"
      pWeekdaysText(3)="三"
      pWeekdaysText(4)="四"
      pWeekdaysText(5)="五"
      pWeekdaysText(6)="六"
End Sub
Private sub SetWeekdaysText_ENU()
      pWeekdaysText(0)="Su"
      pWeekdaysText(1)="M"
      pWeekdaysText(2)="Tu"
      pWeekdaysText(3)="W"
      pWeekdaysText(4)="Th"
      pWeekdaysText(5)="F"
      pWeekdaysText(6)="Sa"
End sub
Private sub SetWeekdaysText()
      Select Case Lang
            Case "CHS" : SetWeekdaysText_CHS
            Case "ENU" : SetWeekdaysText_ENU
            Case Else  : SetWeekdaysText_ENU
      End select
End Sub Private function MonthText_CHS( monthval )
      Dim Str
      If monthval<10 Then
            Str="0"&monthval
      Else
            Str=monthval
      End If
      MonthText_CHS=Str & "月"
End function
Private function MonthText_ENU( monthval )
      Select Case ""&monthval
            Case  "1" : MonthText_ENU="January"
            Case  "2" : MonthText_ENU="February"
            Case  "3" : MonthText_ENU="March"
            Case  "4" : MonthText_ENU="April"
            Case  "5" : MonthText_ENU="May"
            Case  "6" : MonthText_ENU="June"
            Case  "7" : MonthText_ENU="July"
            Case  "8" : MonthText_ENU="August"
            Case  "9" : MonthText_ENU="September"
            Case "10" : MonthText_ENU="October"
            Case "11" : MonthText_ENU="November"
            Case "12" : MonthText_ENU="December"
      End select
End Function
Private function MonthText( monthval )
      Select Case Lang
            Case "CHS" : MonthText=MonthText_CHS( monthval )
            Case Else  : MonthText=MonthText_ENU( monthval )
      End select
End Function
Private function YearText( yearval )
      Select Case Lang
            Case "CHS" : YearText=yearval & "年"
            Case Else  : YearText=yearval
      End select
End function
Private sub SetTable_Title_Text()
      Dim monthval
      monthval=Month(DateVal)

      Dim yeartext
      yeartext=Year(DateVal)
      Select Case Lang
            Case "CHS" : yeartext=yeartext&"年"
            Case Else  : yeartext=yeartext
      End Select

      Dim daytext
      daytext=Day(DateVal)
      If 10>daytext Then daytext="0" & daytext

      Select Case Lang
            Case "CHS" : Table_Title_Text=MonthText_CHS( monthval )
            Case Else  : Table_Title_Text=MonthText_ENU( monthval )
      End Select

      Select Case Lang
            Case "CHS" : Table_Title_Text=yeartext & Table_Title_Text & daytext & "日"
            Case Else  : Table_Title_Text=Table_Title_Text &" "& Day(DateVal) & " , " & yeartext
      End select
End Sub Private Sub PrintWeekdaysTR()
      Dim i
      Print "<tr>"

      For i=0 To 6
            Echo "<td"
            EchoPara "align"      , "center"
            EchoPara "valign"      , "middle"
            EchoPara "bgColor"  , tdBgColor_Dark
            Echo ">"

            Select Case Lang
                  Case "CHS" : Echo pWeekdaysText(i)
                  Case "ENU" : Echo "<b>" & pWeekdaysText(i) & "</b>"
                  Case Else  : Echo "<b>" & pWeekdaysText(i) & "</b>"
            End select

            Echo "</td>"
      Next

      Print "</tr>"
End Sub Private Sub PrintYMChooser()
      Dim M,Y
      M=Month(DateVal)
      Y=Year(DateVal)

      Print "<tr>"

      Echo "<td"
      EchoPara "align","center"
      EchoPara "valign","middle"
      EchoPara "bgColor",tdBgColor_Dark
      EchoPara "colspan","7"
      Echo ">"


      '' Year chooser
      Echo "<a"
      EchoPara "class",LinkStyleClass
      EchoPara "href",PrevYLink
      Echo ">"
      Echo "<span style=""FONT-FAMILY: webdings"">3</span></a><b>"& YearText(Y) &"</b>"
      Echo "<a"
      EchoPara "class",LinkStyleClass
      EchoPara "href",NextYLink
      Echo "</td>"
      Echo "<span style=""FONT-FAMILY: webdings"">4</span></a>"

      Echo "  "

      '' Month chooser
      Echo "<a"
      EchoPara "class",LinkStyleClass
      EchoPara "href",PrevMLink
      Echo ">"
      Echo "<span style=""FONT-FAMILY: webdings"">3</span></a><b>"& MonthText(M) &"</b>"
      Echo "<a"
      EchoPara "class",LinkStyleClass
      EchoPara "href",NextMLink
      Echo "</td>"
      Echo "<span style=""FONT-FAMILY: webdings"">4</span></a>"

      Print "</tr>"
End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
''      Date Functions
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private curY,curM,curD
Private curM_BeginDateVal,curM_EndDateVal
Private curM_DaysCount
Private curM_BeginWeekday,curM_EndWeekday
Private curM_Begin_LeftDays,curM_End_RightDays
Private curM_TDCount,curM_Lines
Private CellArray,CellX,CellY
Public ItemDate
Public ItemText
Public ItemLink
Public ItemBG Public Function Idx2D_1D( x,y )
      Idx2D_1D=CellX*y+x - curM_Begin_LeftDays

      If Idx2D_1D<0 Then Idx2D_1D=-1
      If Idx2D_1D>=curM_DaysCount Then Idx2D_1D=-2

End function Private Sub InitDatePara()
      curY=Year(DateVal)
      curM=Month(DateVal)
      curD=day(DateVal)

      curM_BeginDateVal=curY&"-"&curM&"-1"
      curM_EndDateVal=DateAdd( "m" , 1 , curM_BeginDateVal )
      curM_EndDateVal=DateAdd( "d" ,-1 , curM_EndDateVal )
      curM_DaysCount=DateDiff( "d" , curM_BeginDateVal , curM_EndDateVal  )+1
      curM_BeginWeekday =Weekday(curM_BeginDateVal , 1 )
      curM_EndWeekday   =Weekday(curM_EndDateVal   , 1 )
      curM_Begin_LeftDays =curM_BeginWeekday-1
      curM_End_RightDays  =7 - curM_EndWeekday
      curM_TDCount=curM_DaysCount + curM_Begin_LeftDays + curM_End_RightDays
      curM_Lines  =curM_TDCount/7

      CellX=7
      CellY=curM_Lines
      ReDim CellArray( CellX,CellY )

      ReDim ItemDate(curM_DaysCount)
      ReDim ItemText(curM_DaysCount)
      ReDim ItemLink(curM_DaysCount)
      ReDim ItemBG(curM_DaysCount)

      Dim i,j

      For i=0 To curM_DaysCount-1
            ItemDate(i)=curY&"-"&curM&"-"&CStr(i+1)
            ItemText(i)=CStr(i+1)
            ItemLink(i)=""
            ItemBG(i)  =tdBgColor_Light
            If curD=i+1 Then ItemBG(i)=tdBgColor_Gray
      Next

End Sub Property Let Date(g)
      DateVal=g
      InitDatePara
End Property Private Sub PrintDayTDs()
Dim i,j
Dim x
For i=0 To CellY-1
      Print "<tr>"

      For j=0 To CellX-1
      x=Idx2D_1D(j,i)
            Echo "<td"
            EchoPara "style",      "FONT-SIZE: 9px; FONT-FAMILY: sans-serif"
            EchoPara "align",      "center"
            EchoPara "valign",      "middle"
            If x>=0 Then
                  EchoPara "bgColor",      ItemBG(x)
            Else
                  EchoPara "bgColor",      "#ffffff"
            End if

            Echo ">"

            If x>=0 Then
                  If ""=""&ItemLink(x) Then
                        Echo x+1
                  Else
                        Echo "<a"
                        EchoPara "href",ItemLink(x)
                        EchoPara "class",LinkStyleClass
                        Echo ">"
                        Echo x+1
                        Echo "</a>"
                  End if
            Else
                  Echo "<img width=""0"" height=""0"" />"
            End if

            Print "</td>"

      Next

      Print "</tr>"
Next
End sub
Private Sub Class_Initialize

      Lang="CHS"
      DateVal=Now
      InitDatePara

      PrevYLink=""
      NextYLink=""
      PrevMLink=""
      NextMLink=""

      LinkStyleClass="calendar"

      Table_class="caBox"
      Table_width="180"
      Table_bgColor="#c8ccc8"

      Table_Title_style="FONT-SIZE: 9px; COLOR: #ffffff; FONT-FAMILY: sans-serif"
      Table_Title_bgColor="#d56324"

      tdBgColor_Light="#ffffff"
      tdBgColor_Dark ="#f0f0f0"
      tdBgColor_Gray ="#efefef"

      ReDim pWeekdaysText(7)
      SetWeekdaysText
End Sub
Private Sub Class_Terminate
End Sub
Public Sub Exec()
      PrintTableHead

      SetTable_Title_Text
      PrintTableTitle

      PrintWeekdaysTR
      PrintDayTDs
      PrintYMChooser

      PrintTableTail
End sub End class
%>
调用方法：

<style>
TABLE.calendar {
      FONT-SIZE: 12px; COLOR: #949494; LINE-HEIGHT: 150%; FONT-FAMILY: "Verdana", "宋体"
} A.calendar:link {
      COLOR: #545454; TEXT-DECORATION: none
}
A.calendar:visited {
      COLOR: #545454; TEXT-DECORATION: none
}
A.calendar:hover {
      COLOR: #ffffff; BACKGROUND-COLOR: #66ccff; TEXT-DECORATION: underline
}
A.calendar:active {
      COLOR: #ffffff; BACKGROUND-COLOR: #66ccff; TEXT-DECORATION: underline
}
A.cn {
      FONT-SIZE: 12px; FONT-FAMILY: Verdana,宋体
}
A.cn:link {
      COLOR: #545454; TEXT-DECORATION: none
}
A.cn:visited {
      COLOR: #545454; TEXT-DECORATION: none
}
A.cn:hover {
      COLOR: #ffffff; BACKGROUND-COLOR: #66ccff; TEXT-DECORATION: underline
}
A.cn:active {
      COLOR: #ffffff; BACKGROUND-COLOR: #66ccff; TEXT-DECORATION: underline
}
.caBox {
      FONT-SIZE: 9px; COLOR: #686868; LINE-HEIGHT: 150%; FONT-FAMILY: "Verdana", "宋体"
}
.caBox A:link {
      COLOR: #33caea; TEXT-DECORATION: none
}
.caBox A:visited {
      COLOR: #33caea; TEXT-DECORATION: none
}
.caBox A:hover {
      COLOR: #000000; TEXT-DECORATION: none
}
.caBox A:active {
      COLOR: #000000; TEXT-DECORATION: none
}
</style> <%
     Dim objCalendar,x
     Set objCalendar=New Calendar

     With objCalendar
           .Date=DateVal

           For i=0 To DateIDN-1
                 x=DateIDA(0,i)
                 x=DateID2DateD(x)-1
                 .ItemLink(x)="datrep-" & ShowDateVal_Samply(DateID2DateYMD(DateIDA(0,i))) &"-" & ImgType & ".shtml"
           Next

           .PrevYLink=PrevYLink
           .NextYLink=NextYLink
           .PrevMLink=PrevMLink
           .NextMLink=NextMLink
     End With

     objCalendar.Exec

     Set objCalendar=Nothing
%>

电脑与网络乱闪发表于 2005/1/28 20:38:47

ASP+JavaScript+数据库级联下拉菜单

展開內容 | 阅读全文(41093) | 回复(25) | 编辑 | 精华 | 删除

<%
'option explicit
dim conn,connstr,db
db="test.mdb"      '测试数据库
Set conn = Server.CreateObject("ADODB.Connection")
connstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(""&db&"")
conn.Open connstr
%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>ASP+JavaScript+数据库级联下拉菜单</title>
<style>
table{border: #00215a 1px dashed;}
td{font-size:12px;}
input,select{
     font-size:9pt;
     border-style:solid;
     border-width:1;
     cursor:default;
     color:#03326B;
     background-color:#FFFFFF;
     height:16px;
}
a:link,a:visited{color: #000000;text-decoration: none;}
a:hover {color: #ff0000;text-decoration: none;FILTER: glow(color=ffffff,strength=0) shadow(color=aaaaaa,direction:135); POSITION: relative; WIDTH: 100%;}
</style>
<script language="JavaScript">
function addbig(){
document.all.a.style.display="block";
document.all.b.style.display="none";
document.all.c.style.display="none";
}
function addsmall(){
document.all.b.style.display="block";
document.all.a.style.display="none";
document.all.c.style.display="none";
}
function viewmenu(){
document.all.a.style.display="none";
document.all.b.style.display="none";
document.all.c.style.display="block";
}
</script>
<%
'从小类表中取出数据
           set rs=server.CreateObject("adodb.recordset")
           sql="select * from small_class "
           rs.open sql,conn,1,1
%>
<script language="JavaScript">
var num;
//定义数组
var calArray=new Array();
<%
dim j
j=0
do while not rs.eof
%>
//将小类表中的所有相关记录存到数组calArray的对应元素中。
calArray[<%=j%>]=new Array("<%=rs("small_class_id")%>","<%=rs("small_class_name")%>","<%=rs("belongto_big_class")%>");
<%
j=j+1
rs.movenext
loop
rs.close
set rs=nothing
%>
//给num赋值为记录总数
num=<%=j%>
function givevalue(myvalue){
/*当选择大类列表的值不为空时首先清空小类下拉列表的所有项目。不然小类列表中的项目会叠加的。
同时也是初始化 options 的值为0 */
document.form3.small_class_select.length = 0;
//循环写出请求的大类所对应的小类。
    for (i=0;i < num; i++)
        {
            if (calArray[i][2] == myvalue)
            {
             document.form3.small_class_select.options[document.form3.small_class_select.length] = new Option(calArray[i][1], calArray[i][0],"","");
                  /*定义新的Option对象并赋值。options的索引值从0开始。new Option对象有4个属性，对应分别是：文本串、value、defaultSelect、selected。在这里只用了第一个和第二个。*/
                 }
         }
}
</script>
<script language="JavaScript">
function chk1(){
if (form1.big_class_name.value=="")
     {
     alert("请输入大类名称！");
     form1.big_class_name.focus();
     return false;
     }
}
function chk2(){
if (form2.small_class_name.value=="")
     {
     alert("请输入小类名称！");
     form2.small_class_name.focus();
     return false;
     }
} </script>
</head> <body background="background.jpg">
<%
dim rs,sql,noclass
select case request("action")
     case "addbigclass"
     addbigclass
     case "addsmallclass"
     addsmallclass
end select
%>
<div align="center"></div>
<table width="60%" border="0" align="center" cellpadding="0" cellspacing="0">
  <tr valign="middle">
    <td height="48" colspan="3">
      <div align="center"><font color="#999900"><b><font color="#FF0000">ASP</font>+<font color="#FF0000">JavaScript</font>+<font color="#FF0000">数据库</font>
        级联下拉菜单</b></font></div></td>
  </tr>
  <tr>
    <td width="22%" height="21" valign="bottom"><a href="#" onClick="addbig()">添加大类</a>
    </td>
    <td width="22%" valign="bottom"><a href="#" onClick="addsmall()">添加小类</a></td>
    <td width="56%" valign="bottom"><a href="#" onClick="viewmenu()">预览效果</a></td>
  </tr>
  <tr>
    <td height="33" colspan="3" valign="top">
      <hr align="left" width="60%" size="1" color="#999900">
    </td>
  </tr>
  <tr>
    <td colspan="3" valign="top"> <div id="a" style="display:none">
        <form name="form1" method="post" action="?action=addbigclass" onSubmit="return chk1()">
          大类名称：
          <input name="big_class_name" type="text" id="big_class_name" size="16">
          <input type="submit" name="Submit" value=" 添加 ">
        </form>
      </div>
      <div id="b" style="display:none">
        <form name="form2" method="post" action="?action=addsmallclass" onSubmit="return chk2()">
          选择大类后添加小类：
          <select name="addselect">
            <%
           set rs=server.CreateObject("adodb.recordset")
           sql="big_class"
           rs.open sql,conn,1,1
           if rs.eof or rs.bof then
           %>
            <option selected>还没有添加大类</option>
            <%
           else
           do while not rs.eof
           %>
            <option value="<%=rs("big_class_id")%>"><%=trim(rs("big_class_name"))%></option>
            <%
           rs.movenext
           loop
           end if
           rs.close
           set rs=nothing
           %>
          </select>
          小类名称：
          <input name="small_class_name" type="text" id="small_class_name" size="16">
          <input type="submit" name="Submit2" value=" 添加 ">
        </form>
      </div>
      <div id="c" style="display:block">
        <form name="form3" method="post" action="">
          <select name="big_class_select" onChange="givevalue(document.form3.big_class_select.options[document.form3.big_class_select.selectedIndex].value)">
            <%
                 dim firstid
           set rs=server.CreateObject("adodb.recordset")
           sql="select * from big_class order by big_class_id"
           rs.open sql,conn,1,1
           if rs.eof or rs.bof then
           noclass=1
           %>
            <option selected>还没有添加大类</option>
            <%
           else
           rs.movefirst
           firstid=rs("big_class_id")
           '在没有选择大类（页面刚载入）时要载入的大类。
           %>
            <option value="<%=rs("big_class_id")%>" selected><%=trim(rs("big_class_name"))%></option>
            <%
           rs.movenext
           do while not rs.eof
           %>
            <option value="<%=rs("big_class_id")%>"><%=trim(rs("big_class_name"))%></option>
            <%
           rs.movenext
           loop
           end if
           rs.close
           set rs=nothing
           %>
          </select>
          <select name="small_class_select">
            <%if noclass=1 then%>
            <option value="" selected>没有小类</option>
            <%
           else
           '在没有选择大类（页面刚载入）时要载入的小类，要跟默认的大类对应。
           set rs=server.CreateObject("adodb.recordset")
           sql="select * from small_class where belongto_big_class="&firstid
           rs.open sql,conn,1,1
           if rs.eof or rs.bof then
           %>
            <option value="" selected>没有小类</option>
            <%
           else
           do while not rs.eof
           %>
            <option value="<%=rs("small_class_id")%>"><%=trim(rs("small_class_name"))%></option>
            <%
           rs.movenext
           loop
           end if
           rs.close
           set rs=nothing
        end if
           %>
          </select>
        </form>
      </div></td>
  </tr>
</table>
<%
sub addbigclass()
           set rs=server.CreateObject("adodb.recordset")
           sql="select * from big_class where big_class_name='"&trim(request("big_class_name"))&"'"
           rs.open sql,conn,1,3
           if not(rs.eof and rs.bof) then
           response.Write("<script>alert('该大类已经存在！');</script>")
           else
           rs.addnew
           rs("big_class_name")=trim(request("big_class_name"))
           rs.update
           response.Write("<script>alert('大类添加成功！');self.location='test.asp?action=viewmenu';</script>")
           end if
           rs.close
           set rs=nothing
end sub
sub addsmallclass()
           set rs=server.CreateObject("adodb.recordset")
           sql="select * from small_class where small_class_name='"&trim(request("small_class_name"))&"' and belongto_big_class="&request("addselect")
           rs.open sql,conn,1,3
           if not(rs.eof and rs.bof) then
           response.Write("<script>alert('该小类已经存在！');</script>")
           else
           rs.addnew
           rs("belongto_big_class")=request("addselect")
           rs("small_class_name")=trim(request("small_class_name"))
           rs.update
           response.Write("<script>alert('小类添加成功！');self.location='test.asp?action=viewmenu';</script>")
           end if
           rs.close
           set rs=nothing
end sub
conn.close
set conn=nothing
%>
<table width="60%" border="0" align="center" cellpadding="0" cellspacing="0">
  <tr>
    <td width="48%"> <div align="right">Copyright © </div></td>
    <td width="1%"> </td>
    <td width="11%"><b><a href="http://cooleasy.xicp.net/">酷易在线</a></b> </td>
    <td width="40%"><a href="mailto:xljxlj279@126.com">联系站长</a></td>
  </tr>
</table>
</body>
</html>

电脑与网络乱闪发表于 2005/1/28 20:37:12

无限级分类树型菜单

展開內容 | 阅读全文(9119) | 回复(9) | 编辑 | 精华 | 删除

环境:ASP+ACCESS '//----------List表定义
'Create Table List(ID AUTOINCREMENT,ParentID long,Title Text(50),Url Text(50),Flag bit,ChildNum Long,Target Text(10))
'--------------------------
-->
<style Type=Text/Css>
body,td{font-size:13px;}
a:link { color: #442200; text-decoration: none}
a:visited { color: #444400; text-decoration: none}
a:hover { color: #442200; text-decoration: underline overline; background-color: #FFFF00}
a.link1:link { color: #FF0000; text-decoration:none}
a.link1:visited { color: #FF0000; text-decoration: none}
a.link1:hover { color: #FF0000; text-decoration: none; background-color: #eeeeee}
</Style>
 
<div align="center" id=load style="display:none;position: absolute;">
<TABLE bgcolor=ffffee width=250 Style="border:1px solid #dd8888;"><FORM METHOD=POST ACTION="" name=form1>
<tr><td align="center">添加节点</td></tr>
<TR><TD  align="center">
<INPUT TYPE="hidden" Name="ParentID">
标题:<INPUT TYPE="text" NAME="Title"><BR>
链接:<INPUT TYPE="text" NAME="Url"><BR>
目标:<INPUT TYPE="text" NAME="Target" Style="width:70px">
<SELECT NAME="" Style="width:75px" OnChange="JavaScript:Target.value=this.options[this.selectedIndex].value;">

  <option value="">Default</option>
  <option value="Right">Right</option>
  <option value="_black">_black</option>
  <option value="_Top">_Top</option>
  <option value="_parent">_parent</option>
  <option value="_self">_self</option>
</SELECT>
</td></tr><tr><td align="center">
<INPUT TYPE="submit" Name="提交" value="提交">
<INPUT TYPE="Button" onclick="JavaScript:load.style.display='none'" value="取消">
</TD>
</TR></FORM>
</TABLE>
</div>
 <%
'连接数据库
set conn=server.createobject("ADODB.Connection")
conn.open "provider=microsoft.jet.oledb.4.0;data source="&server.mappath("File.mdb") '//----------操作分支
Action=Request("Action")
Select Case Action
     Case "Add":If Request("ParentID")<>"" Then Add
     Case "Del": Del
     Case "Open":Open
     Case Else:
End Select
'//----------显示列表
           Public List
           Set Rs=Conn.Execute("Select * From [List]")
           If Not Rs.Eof Then
                 List =Rs.GetRows
                 Max=Conn.Execute("Select Count(ParentID) From List Where ParentID=0")(0)
                 Set Rs=Nothing
                 Set Conn=Nothing
                 CheckList 0,Max,""
           Else
                 Set Rs=Nothing
                 Set Conn=Nothing
           End If
           Response.Write "<a href=# onclick='JavaScript:form1.action=""List.asp?action=Add"";form1.ParentID.value=0;load.style.left=(document.body.scrollWidth-300)/2;load.style.top=(document.body.scrollHeight)/2;load.style.display="""";'>添加根</a><BR>"
'//------------显示列表函数
FuncTion CheckList(ParentID,Cs,Str1)
     Dim j
     j=0
     For i=0 To Ubound(List,2)
           If List(1,i)=ParentID Then
                       Response.write(Str1)
                       If j<Cs-1 Then Str2="├" Else Str2="└"
                       If List(5,i)>0 Then Str2="<a class=Link1 href='List.asp?action=Open&Id="&List(0,i)&"'>"&Str2&"</a>"
                       If List(5,i)>0 And List(4,i)=False Then Str2="<b>"&Str2&"</b>"
                       Response.Write(Str2)                  Response.Write "<a Href='"&List(3,i)&"' target='"&List(6,i)&"'>"&List(2,i)&"</a>　"&VBcrlf
                 '添加节点链接
                 Response.Write "<a title='添加"&List(2,i)&"的子节点' href='#' onclick='JavaScript:add("&List(0,i)&");'>添加</a>"&Vbcrlf
                 Response.Write "<a Title=""删除此节点"&VBCRLF&"此节点的子节点将向上递进一层!"" href='JavaScript:Del("&List(0,i)&");'>删除</a><BR>"
                 If List(4,i)=True Then
                       If j<Cs-1 Then CheckList List(0,i),List(5,i),Str1&"┆" Else CheckList List(0,i),List(5,i),Str1&"　"'关键所在,递归调用
                 End If
                 j=j+1
           End IF
     Next
End Function '//-----------添加函数
Function Add
     Parent=CLng(Request("ParentID"))
     Title=Replace(Request("Title"),"'","''")
     Url=Replace(Request("URL"),"'","''")
     Target=Replace(Request("Target"),"'","''")
     If Title="" Or Url="" Then
           Response.Write "至少有一个必须参数没有指定值 <a href=List.asp>返回</a>"
           Response.End
           Exit Function
     End If
     Sql="Insert Into List (ParentID,Title,Url,Target) Values ("&Parent&",'"&Title&"','"&Url&"',' "&Target&"')"
     Conn.Execute(Sql)
     If Parent<>0 Then
           Sql="Update List Set ChildNum=ChildNum+1 Where ID="&Parent
           Conn.Execute(Sql)
     End IF
End Function '//-----切换节点状态
Function Open
     Sql="Update List Set Flag=Not Flag Where ID="&Clng(Request("Id"))
     Conn.Execute(Sql)
End Function
'//-----------删除节点
Function Del
     On Error Resume Next
     Id=Clng(Request("ID"))
     ParentID=Conn.Execute("Select ParentID From List Where ID="&ID)(0)
     Num=Conn.Execute("Select Count(ID) From List Where parentID="&ID)(0)
     Conn.Execute("Update List Set ChildNum=ChildNum-1+"&Num&" Where ID="&ParentID)
     Conn.Execute("Update List Set ParentID="&ParentID&" Where ID in (Select ID From List Where ParentID="&ID&")")
     Conn.Execute("Delete From List Where ID="&ID)
     If Err.Number<>0 Then
           Response.Write "您做的操作无效,可能是该项已经删除!! <a href=List.asp>返回</a>"
           Response.End
     End If
End Function
%>
<SCRIPT LANGUAGE="JavaScript">

</SCRIPT>
--------------------------------------------------------------------------------
Create Table List(ID AUTOINCREMENT,ParentID long,Title Text(50),Url Text(50),Flag bit,ChildNum Long,Target Text(10)) 直接在查询里执行就可以得到List表!! 下面是对表的说明 Id 自动编号
ParentID 长整形
Title 文本
Url 文本
Flag 布尔
ChildNum 长整形
Target 文本,允许空符串

电脑与网络乱闪发表于 2005/1/28 20:35:46

« 1 2 3 4 5 »

站点首页 | 联系我们 | 博客注册 | 博客登陆

Sponsored By W3CHINA
W3CHINA Blog 0.8 Processed in 2.082 second(s), page refreshed 144799535 times.
《全国人大常委会关于维护互联网安全的决定》《计算机信息网络国际联网安全保护管理办法》
苏ICP备05006046号