全文检索引擎[asp版]
search.asp：
<%
set DM=server.CreateObject("DeepMap.HLL")
pnn=0: wdd="": pnn=Request("pn") : wdd=Trim(Request("wd"))
If pn < 1 OR pn > 50 Then
pn = 1
End If
response.write getPB(pnn, wdd)
Function getPB(pnn, wdd)
Dim vx(3000) : RS="" : RR="" : vn=0 : pn=int(pnn): wd=wdd
RS = DM.getmAA(wd, (pn - 1) * 10 + 9 + 50, 1)
vn = int(getT(RS, "TC")) : uz = Split(getT(RS, "TD"), "-")
For j = 0 To UBound(uz)
vx(j + 1) = uz(j)
Next
ss1 = "<html><head><meta http-equiv=Content-Type content='text/html;charset=gb2312'><style> BODY {FONT-SIZE: 100%; FONT-FAMILY: arial,sans-serif} A:link {COLOR: #0000cc; TEXT-DECORATION: underline} </style><title>全文搜索引擎" & urldecode(wd) & "</title></head>"
ss1 = ss1 & "<table cellpadding=0 cellspacing=0 border=0><tr><td align=left><a href=index.htm><img src=logo.gif width=148 height=65 border=0></a></td><td align=left><table border=0 cellpadding=0 cellspacing=0 align=left><tr><td colspan= 2 width=0><strong><font size=4px color=#C60A00> Powered By Karma</font></strong></td></tr>"
ss1 = ss1 & "<form name=f action=search.asp method='GET'><tr><td nowrap=nowrap valign=top> <input type=hidden name=pn value=1><input type=text name=wd id=kw size=40 maxlength=38 value='" & urldecode(wd) & "'></td><td style=padding-left:4px; valign=top><input type=submit value='搜索一下'></td></tr></form><tr><td></td></tr></table></td></tr></table>"
ss1 = ss1 & "<table width='100%' border='0' align='center' cellpadding='0' cellspacing='0' style='background-color:#E8F3FF;height:20px;margin-bottom:20px;font-size:12px'><tr><td nowrap> </td><td align='left' nowrap> <a style=COLOR:#0000cc href=index.htm>返回首页</a></td><td align='right' nowrap>" & getT(RS, "TB") & " </td></tr></table>"
if pn >(vn - 1) \ 10 + 1 Then
pn=(vn - 1) \ 10 + 1
end If
ss2 = ""
For i = pn * 10 - 9 To pn * 10
ss9 = ""
If i <= vn Then
RR = DM.getmFF( vx(i) & "_title_txt_url_time" )
Rtitle = DM.getmEE(getT(RR, "title"), wd, 0)
Rtxt = getT(RR, "txt")
if instr(1, Rtxt, "[[txt]]")>0 then
Rtxt=mid(Rtxt, instr(1, Rtxt, "[[txt]]")+7)
end if
Rtxt = DM.getmEE(Rtxt, wd, 1)
Rurl = getT(RR, "URL"): Rtime = getT(RR, "Time")
ss9 ="<table border=0 cellpadding=0 cellspacing=0 width=60% ><tr><td style=line-height:120%;font-size:100%;width:32em;padding-left:15px;word-break:break-all;word-wrap:break-word;>"
ss9 = ss9 & "<a href=" & Rurl & " target='_blank'>" & Rtitle & "<br></a>"
ss9 = ss9 & "<font size=-1>" & Rtxt & "<br>"
ss9 = ss9 & "<font color=#008000>" & Left(Rurl, 40) & "...[" & vx(i) & "] " & Rtime & "    </font></font><br><br></td></tr></table>"
End If
ss2 = ss2 & ss9 & vbCrLf
Next
If vn > (pn - 1) * 10 + 50 Or vn > 500 Then
vin = 500
Else
vin = vn
End If
For j = -4 To 4
k = (pn - 1) * 10 + j * 10
If vin > k And k > -1 Then
If j = 0 Then
S = "<a style=TEXT-DECORATION:none;font-weight:bold;COLOR:#a90a00 href=search.asp?pn=" & pn + j & "&wd=" & server.urlencode(wd) & ">" & pn + j & "</a>" & " "
Else
S = "<a style=font-weight:bold;COLOR:#000 href=search.asp?pn=" & pn + j & "&wd=" & server.urlencode(wd) & ">" & pn + j & "</a>" & " "
End If
ds = ds + S
End If
Next
k = pn * 10 - 20
If vin > k And k > -1 Then
ds ="<a style=COLOR:#0000cc href=search.asp?pn=" & pn - 1 & "&wd=" & server.urlencode(wd) & ">上一页</a>" & " " & ds
End If
k = pn * 10
If vin > k And k > -1 Then
ds = ds & "<a style=COLOR:#0000cc href=search.asp?pn=" & pn + 1 & "&wd=" & server.urlencode(wd) & ">下一页</a>" & " "
End If
ss3 = " " & ds
ss3 = ss3 & "<br><br><br><div style='clear:both;line-height:30px;background:#E8F3FF;text-align:center;font-size:13px'><span>此内容系搜索引擎根据您的指令自动搜索的结果，不代表本网站赞成被搜索网站的内容或立场</span></div>"
If vn = 0 Then
ss2 = "未找到相关结果，建议将关键词用空格分开。"
End If
getPB = ss1 & ss2 & ss3
End Function
Function getT(ks, kk)
ks = LCase(ks): kk = LCase(kk)
ki = InStr(1, ks, kk & "={{{")
If ki > 0 Then
ki = InStr(ki, ks, "{") + 3: kj = InStr(ki, ks, "}}}"): getT = Mid(ks, ki, kj - ki): Exit Function
End If
ki = InStr(1, ks, kk & "={")
If ki > 0 Then
ki = InStr(ki, ks, "{") + 1: kj = InStr(ki, ks, "}"): getT = Mid(ks, ki, kj - ki)
End If
End Function
Function urldecode(encodestr)
newstr = "": havechar = False: lastchar = ""
For i = 1 To Len(encodestr)
char_c = Mid(encodestr, i, 1)
If char_c = "+" Then
newstr = newstr & " "
ElseIf char_c = "%" Then
next_1_c = Mid(encodestr, i + 1, 2): next_1_num = CInt("&H" & next_1_c)
If havechar Then
havechar = False: newstr = newstr & Chr(CInt("&H" & lastchar & next_1_c))
Else
If Abs(next_1_num) <= 127 Then
newstr = newstr & Chr(next_1_num)
Else
havechar = True: lastchar = next_1_c
End If
End If
i = i + 2
Else
newstr = newstr & char_c
End If
Next
urldecode = newstr
End Function
%>
index.asp：
<%
Response.Buffer = True
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1
Response.Expires = 0
Response.CacheControl = "no-cache"
%>
<html>
<head>
<STYLE>BODY {
FONT-SIZE: 9pt; FONT-FAMILY: 宋体
}
TD {
FONT-SIZE: 9pt; FONT-FAMILY: 宋体
}
DIV {
FONT-SIZE: 9pt; FONT-FAMILY: 宋体
}
INPUT {
FONT-SIZE: 9pt; FONT-FAMILY: 宋体
}
BUTTON {
FONT-SIZE: 9pt; FONT-FAMILY: 宋体
}
.use1 INPUT {
BORDER-RIGHT: #d0d0d0 1px solid; BORDER-TOP: #d0d0d0 1px solid; BACKGROUND: #ffffff; BORDER-LEFT: #d0d0d0 1px solid; COLOR: #000000; PADDING-TOP: 1px; BORDER-BOTTOM: #d0d0d0 1px solid
}
.use1 TEXTAREA {
BORDER-RIGHT: #d0d0d0 1px solid; BORDER-TOP: #d0d0d0 1px solid; BACKGROUND: #ffffff; BORDER-LEFT: #d0d0d0 1px solid; COLOR: #000000; PADDING-TOP: 1px; BORDER-BOTTOM: #d0d0d0 1px solid
}
TABLE {
BORDER-COLLAPSE: collapse
}
</STYLE>
<STYLE>A {
TEXT-DECORATION: none
}
</STYLE>
<title>搜索上传系统登陆</title>
<link href="css/css.css" rel="stylesheet" type="text/css"/>
<link rel="stylesheet" href="style.CSS">
<script language=javascript>
function CheckForm()
{
if(document.Login.UserName.value=="")
{
alert("用户不能为空！");
document.Login.UserName.focus();
return false;
}
if(document.Login.Password.value == "")
{
alert("密码不能为空！");
document.Login.Password.focus();
return false;
}
}
</script>
</head>
<body topmargin="100" bgcolor="#D2E4FC">
<table width="100%" border="0" cellspacing="0" cellpadding="0" align="center" height="100%">
<tr>
<td>
<table width="264" border="1" cellspacing="0" style="border-collapse: collapse" class="border" align="center" bgcolor="#D2E4FC" bordercolor="green">
<form method="post" action="chkadmin.asp" onSubmit="return CheckForm();" name="Login">
<tr>
<td valign="middle" width="258" height="21">
<p align="center">搜索上传系统登陆</td>
</tr>
<tr align="center">
<td align="center" height="140" width="258">
<table width="241" border="0" cellspacing="5" cellpadding="0" align="center">
<tr>
<td align="right" width="64">账号：</td>
<td width="162">
<input name="UserName" type="text" id="UserName2" size="21" maxlength="20" style="border-width:1px; border-color:rgb(0,104,255); border-style:solid;">
</td>
</tr>
<tr>
<td align="right" width="64">密码：</td>
<td width="162">
<input name="Password" type="password" size="21" maxlength="20" style="border-width:1px; border-color:rgb(0,104,255); border-style:solid;">
</td>
</tr>
<tr align="center">
<td colspan="2" width="231">
<input type="submit" name="Submit" value=" 确认 ">
<input name="reset" type="reset" id="reset" value=" 清除 ">
</td>
</tr>
</table>
</td>
</tr>
</form>
</table>
<div align="center"> </div>
<p align="center"> </p>
<div align="right"> </div>
</td>
</tr>
</table>
</body>
</html>
chkadmin.asp：
<%
Response.Buffer = True
Response.ExpiresAbsolute = Now() - 1
Response.Expires = 0
Response.CacheControl = "no-cache"
Response.AddHeader "Pragma", "No-Cache"
Dim username,password
username=replace(trim(Request.Form("username")),"'","")
password=replace(trim(Request.Form("password")),"'","")
Set Conn=server.createobject("adodb.connection")
Set Rs=Server.CreateObject("adodb.recordset")
Conn.Open "Driver={SQL Server};Server=(Local);UID=sa;PWD=123;"&"database=db_search;"
Rs.Open "select * from tab_admin where username='"&username&"' and password='"&password&"'",Conn,3,3
If Not Rs.eof Then
'Rs("LastLoginIP")=Request.ServerVariables("REMOTE_ADDR")
'Rs("LastLoginTime")=now()
'Rs("LoginTimes")=rs("LoginTimes")+1
'Rs.update
'response.write ("<script>alert('成功登陆！')</script>")
session("username")=username
response.redirect "index.htm"
response.end
Else
response.write "<script>alert('账号或密码错误！');history.back();</script>"
response.end
End If
Rs.Close
Conn.Close
Set rs=Nothing
Set Conn = Nothing
%>
upinfo.asp：
<%
Response.Buffer = True
Response.Expires = 0
Response.CacheControl = "no-cache"
Response.AddHeader "Pragma", "No-Cache"
Set Conn=server.createobject("adodb.connection")
Set Rs=Server.CreateObject("adodb.recordset")
Conn.Open "Driver={SQL Server};Server=(Local);UID=sa;PWD=123;"&"database=db_search;"
Rs.Open "select * from tab_upload",Conn,3,3
%>
<html>
<head>
<link href="css/css.css" rel="stylesheet" type="text/css"/>
<title>文件信息上载</title>
<script type="text/javascript">
function enable()
{
var value = document.getElementById ('DocStyle');
if (value.value == "任务文件")
{
document.getElementById("TaskNumber").disabled=false;
}
else
{
document.getElementById("TaskNumber").disabled=true;
}
}
function check()
{
var value = document.getElementById('fn');
var key = document.getElementById('file');
var txt = document.getElementById('txt');
if(value.value == "")
{
alert("文件名不可以为空！");
return false;
}
if(key.value == "")
{
alert("请上传文件！");
return false;
}
if(txt.value == "")
{
alert("请填写文件摘要信息！");
return false;
}
}
function postvalue()
{
var key = document.getElementById ('selectarea');
var value = document.getElementById ('DocAuthor');
value.value = key.value;
}
function def()
{
var key = document.getElementById ('selectarea');
var value = document.getElementById ('DocAuthor');
//value.value = key.options[key.selectedIndex].text;
value.value = key.options[key.selectedIndex].value;
}
</script>
</head>
<body background="images/bg.jpg" onload='def();'>
<form action="SaveInfo.asp" method="POST">
文件名称：
<input type="text" name="fn" id="fn" style='width:200px'/>
<br />
文件类型：
<select name="DocStyle" id="DocStyle" style='width:200px' onchange="enable();">
<%
rs.movefirst
Do while not rs.eof
response.Write("<option value=""" & rs("DocStyle") & """>" & rs("DocStyle") & "</option>")
rs.movenext
Loop
%>
</select>
<br />
任务代号：
<select name="TaskNumber" id="TaskNumber" disabled="true" style='width:200px'>
<%
rs.movefirst
Do while not rs.eof
response.Write("<option value=""" & rs("TaskNumber") & """>" & rs("TaskNumber") & "</option>")
rs.movenext
Loop
%>
</select>
<br />
文件年份：
<select name="DocTime" style='width:200px'>
<%
rs.movefirst
Do while not rs.eof
response.Write("<option value=""" & rs("DocTime") & """>" & rs("DocTime") & "</option>")
rs.movenext
Loop
%>
</select>
<br />
所属工号：
<select name="JobNumber" style='width:200px'>
<%
rs.movefirst
Do while not rs.eof
response.Write("<option value=""" & rs("JobNumber") & """>" & rs("JobNumber") & "</option>")
rs.movenext
Loop
%>
</select>
<br />
编制单位：
<select name="DocComp" style='width:200px'>
<%
rs.movefirst
Do while not rs.eof
response.Write("<option value=""" & rs("DocComp") & """>" & rs("DocComp") & "</option>")
rs.movenext
Loop
%>
</select>
<br />
所属专业：
<select name="DocMajor" style='width:200px'>
<%
rs.movefirst
Do while not rs.eof
response.Write("<option value=""" & rs("DocMajor") & """>" & rs("DocMajor") & "</option>")
rs.movenext
Loop
%>
</select>
<br />
文件作者：
<select name="selectarea" id="selectarea" style='width:200px' onchange="postvalue();">
<%
rs.movefirst
Do while not rs.eof
response.Write("<option value=""" & rs("DocAuthor") & """>" & rs("DocAuthor") & "</option>")
rs.movenext
Loop
%>
</select>
<input type='text' name="DocAuthor" id="DocAuthor" style='width:183px;position:absolute;left:87px;'>
<br />
文件权限：
<select name="DocAuthity" style='width:200px'>
<%
rs.movefirst
Do while not rs.eof
response.Write("<option value=""" & rs("DocAuthity") & """>" & rs("DocAuthity") & "</option>")
rs.movenext
Loop
%>
</select>
<br />
文件摘要：
<br />
输入文件信息摘要(80字)
<br />
<textarea name='DocSummary' rows='10' cols='80' id="txt" onpropertychange='if(value.length>80) value=value.substr(0,80)'>
</textarea>
<br /><br />
文件上传：
<input type="file" name="file" id="file" size="42" style='width:200px'>
<br /><br />
<input type="submit" value="提交" onclick="return check();"/>
<input type='reset' name='res' value='清除' />
</form>
</body>
</html>
saveinfo.asp：
<%
Response.Buffer = True
Response.Expires = 0
Response.CacheControl = "no-cache"
Response.AddHeader "Pragma", "No-Cache"
Dim DocStyle,DocTime,DocComp,DocMajor,DocAuthor,DocSummary,DocAuthity,JobNumber
Dim file,filename,houzui
fn = Request.Form("fn")
DocStyle = Request.Form("DocStyle")
DocTime = Request.Form("DocTime")
DocComp = Request.Form("DocComp")
DocMajor = Request.Form("DocMajor")
DocAuthor = Request.Form("DocAuthor")
DocSummary = Request.Form("DocSummary")
DocAuthity = Request.Form("DocAuthity")
JobNumber = Request.Form("JobNumber")
file = Request.Form("file")
'把文件信息写入数据库
Set conn = Server.CreateObject("ADODB.Connection")
conn.open "Driver={SQL Server};Server=(Local);UID=sa;PWD=123;"&"database=db_search;"
set rs=server.CreateObject("adodb.recordset")
rs.open "select * from tab_file_info",conn,3,3
if file="" then
response.write"<script>alert('请选择要上传的文件！');window.location.href='upinfo.asp';</script>"
else
houzui=mid(file,InStrRev(file, "."))
if houzui=".pdf" or houzui=".doc" or houzui=".docx" or houzui=".bmp" or houzui=".jpg" or houzui=".tif" or houzui=".tiff" then '允许上传的文件类型
fn = fn & houzui
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = 1
objStream.Open
objStream.LoadFromFile file
objStream.SaveToFile "D:\xss\" & fn,2
objStream.Close
'========================================
response.write"<script>alert('文件上传成功！');</script>"
else
response.write"<script>alert('不允许上传" & houzui & "格式文件！');window.location.href='upinfo.asp';</script>"
end if
end if
rs.addnew
rs("DocName") =fn
rs("DocStyle") =DocStyle
rs("DocTime") =DocTime
rs("DocComp") =DocComp
rs("DocMajor") =DocMajor
rs("DocAuthor") =DocAuthor
rs("DocSummary")=DocSummary
rs("DocAuthity")=DocAuthity
rs("JobNumber") =JobNumber
rs("DocPath") = "D:\xss\" & fn
rs.update
rs.Close
set rs=nothing
conn.Close
set conn=Nothing
%>
<html>
<head>
<link href="css/css.css" rel="stylesheet" type="text/css"/>
<title>保存文件页面</title>
</head>
<body>
<a href='upinfo.asp'>继续上传</a>
<BR /><BR />
<a href='index.htm'>全文搜索</a>
</body>
</html>
css：
*{
margin:0px auto;
padding:5px;
}
body{
background:#fff url("../images/bg.jpg") 0 0 repeat-x;
min-width:960px;
font-family: Arial;
font-size:14px;
}
image：
![全文检索引擎[asp版]_第1张图片](http://img.e-com-net.com/image/product/78979d7819b04ae3b538884d887364a3.jpg)