出错了
  错误编号："&Numb&"
  错误描述："&Des&"

  去百度搜索错误问题

"& VbCrLf Select Case FeedA Case "1" LinkFeedURL=LinkFeedURL&""& VbCrLf Case "2" LinkFeedURL=LinkFeedURL&""& VbCrLf Case "4" LinkFeedURL=LinkFeedURL&""& VbCrLf Case "8" LinkFeedURL=LinkFeedURL&""& VbCrLf Case "11" LinkFeedURL=LinkFeedURL&""& VbCrLf Case "13" LinkFeedURL=LinkFeedURL&""& VbCrLf End Select End Function Function GetAttr(Byval Arr,Byval ID,Byval Seat) Dim K GetAttr="" IF IsArray(Arr) Then For K=0 To Ubound(Arr,2) IF Cint(ID)=Cint(Arr(0,K)) Then GetAttr=Arr(Seat,K):Exit Function End IF Next End IF IF IsNul(GetAttr) Then GetAttr=Arr(Seat,0) End Function Sub Echo(Str) Response.Write(Str):Response.Flush() End Sub Sub Put(Str) Echo Str:Response.End() End Sub Sub Fetch() WebAll=SafeRequest("WebAll","auto") ClassAll=SafeRequest("ClassAll","auto") Sel=SafeRequest("Sel","auto") Page=SafeRequest("Page","auto") ClassID=SafeRequest("ClassID","auto") IF IsNul(WebAll) Then WebAll=False IF IsNul(ClassAll) Then ClassAll=False IF IsNul(Sel) Then Sel=False IF Not IsNum(Page) Then Page=1 IF Not IsNum(ClassID) Then:ClassID=0:End IF End Sub Sub SpanGo() Echo "
暂停"&CD_StopTime&"秒后继续生成" End Sub Sub setStartTime() Dim StartTime StartTime=timer() Session("StartTime")=StartTime End Sub Sub GetRunTime() Dim EndTime,StartTime StartTime=Session("StartTime") EndTime=timer() Echo FormatNumber((EndTime-StartTime),3) End Sub Function GetHttpPage(HttpUrl,bm) If IsNull(HttpUrl)=True Or HttpUrl="$False$" Then GetHttpPage="$False$" Exit Function End If Dim Http Set Http=server.createobject("MSXML2.XMLHTTP") Http.open "GET",HttpUrl,False Http.Send() If Http.Readystate<>4 then Set Http=Nothing GetHttpPage="$False$" Exit function End if GetHTTPPage=bytesToBSTR(Http.responseBody,bm) 'GetHTTPPage=bytesToBSTR(Http.responseBody,"gb2312") Set Http=Nothing If Err.number<>0 then Err.Clear End If End Function Function BytesToBstr(Body,Cset) Dim Objstream Set Objstream = Server.CreateObject("adodb.stream") objstream.Type = 1 objstream.Mode =3 objstream.Open objstream.Write body objstream.Position = 0 objstream.Type = 2 objstream.Charset = Cset BytesToBstr = objstream.ReadText objstream.Close set objstream = nothing End Function Function GetBody(ConStr,StartStr,OverStr,IncluL,IncluR) If ConStr="$False$" or ConStr="" or IsNull(ConStr)=True Or StartStr="" or IsNull(StartStr)=True Or OverStr="" or IsNull(OverStr)=True Then GetBody="$False$" Exit Function End If Dim ConStrTemp Dim Start,Over ConStrTemp=Lcase(ConStr) StartStr=Lcase(StartStr) OverStr=Lcase(OverStr) Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare) If Start<=0 then GetBody="$False$" Exit Function Else If IncluL=False Then Start=Start+LenB(StartStr) End If End If Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare) If Over<=0 Or Over<=Start then GetBody="$False$" Exit Function Else If IncluR=True Then Over=Over+LenB(OverStr) End If End If GetBody=MidB(ConStr,Start,Over-Start) End Function Class CmsDj_Com_Cache Public ReloadTime,CD_CacheMark Private CacheValue Private Sub Class_Initialize() ReloadTime = CD_Cachetime CD_CacheMark = CD_CacheMark End Sub Public Function GetCache(MyCacheName) IF IsNull(MyCacheName) OR MyCacheName = "" Then GetCache = "" Else IF CheckCache(MyCacheName) = True Then GetCache = "" Else CacheValue = Application(CD_CacheMark & MyCacheName) IF Not IsArray(CacheValue) Then GetCache = "" Else GetCache = CacheValue(0) End IF End IF End IF End Function Public Sub SetCache(MyCacheName, CacheValue) Dim CacheData IF IsNull(MyCacheName) OR MyCacheName = "" Then Err.Raise vbObjectErrOR + 1, "缓存错误", "请检查缓存名是否正确!!!" Else CacheData = Application(CD_CacheMark & MyCacheName) IF Not IsArray(CacheData) Then ReDim CacheData(2) CacheData(0) = CacheValue CacheData(1) = Now() Application.Lock Application(CD_CacheMark & MyCacheName) = CacheData Application.UnLock End IF End Sub Public Function CheckCache(MyCacheName) CheckCache = True CacheValue = Application(CD_CacheMark & MyCacheName) IF Not IsArray(CacheValue) Then Exit Function IF Not IsDate(CacheValue(1)) Then Exit Function IF DateDiff("s", CDate(CacheValue(1)), Now()) < 60 * Reloadtime Then CheckCache = False End IF End Function Public Sub DelCache(MyCacheName) Application.Lock Application(CD_CacheMark & MyCacheName) = Empty Application.unLock End Sub Public Sub ReMoveAll() Application.Lock() Application.Contents.ReMoveAll() Application.UnLock() End Sub Public Sub ShowCache() Dim I Echo "缓存对象列表：
" For Each I In Application.Contents Echo I&"
" Next End Sub End Class Dim Cache Set Cache=New CmsDj_Com_Cache Class CmsDj_Com_Fso Private objFSO,fileFSO Private bInit Public bMapPath Public FSO_str Private Sub Class_Initialize bInit=False bMapPath=True FSO_str="Scripting.FileSystemObject" End Sub Private Sub Class_terminate() IF(bInit) Then Set objFSO=Nothing bInit=False End IF End Sub Public Function CreateObj() IF bInit=True Then exit function:End IF IF Err Then err.clear:End IF Set objFSO = Server.CreateObject(FSO_str) IF err Then err.clear bInit=False Set objFSO=Nothing Else bInit=True End IF CreateObj = bInit End Function Public Function CreateFolder(fldr) on error resume next Dim fsoa, f Set fsoa = CreateObject("Scripting.FileSystemObject") Set f = fsoa.CreateFolder(Server.MapPath(fldr)) CreateFolder = f.Path Set f=nothing Set fsoa=nothing End Function Public Function CheckDir(dir_str) IF bInit=False Then CreateObj():End IF IF Err Then err.clear:End IF IF bMapPath Then dir_str = Server.MapPath(dir_str):End IF IF objFSO.FolderExists(dir_str) Then CheckDir=True Else CheckDir=False End IF End Function Public Function DeleteDir(dir_str) IF bInit=False Then CreateObj():End IF IF Err Then err.clear:End IF On Error Resume Next IF bMapPath Then dir_str=Server.MapPath(dir_str):End IF IF objFSO.FolderExists(dir_str) Then objFSO.DeleteFolder(dir_str) End IF IF err Then DeleteDir=False Else DeleteDir=True End IF End Function Public Function CreateDir(dir_str) Dim dirArr,dir,dirOld,i,dirweb,ReadGo ReadGo=0 IF bInit=False Then CreateObj():End IF IF Err Then err.clear:End IF IF bMapPath Then dir_str = Server.MapPath(dir_str):End IF dirArr = split(dir_str,"\") dirOld="" dirweb=Server.MapPath(InstallDir)&"\" For i=lBound(dirArr) To uBound(dirArr) dir = dirArr(i) dirOld=dirOld&dir IF right(dirOld,1) <>"\" Then dirOld=dirOld&"\" IF dirweb=dirOld Then ReadGo=1 End IF IF ReadGo=1 Then IF objFSO.FolderExists(dirOld)<>True Then:objFSO.CreateFolder(dirOld):End IF End IF Next IF Err Then CreateDir=False Else CreateDir=True End IF End Function Public Function MoveDir(dir_old,dir_new) Dim f,i,pos,b IF bInit=False Then CreateObj():End IF IF Err Then err.clear:End IF f=dir_old IF bMapPath Then dir_old=server.MapPath(dir_old):End IF IF bMapPath Then dir_new=server.MapPath(dir_new):End IF i=1 Do While instr(i,dir_new,"\") pos=instr(i,dir_new,"\") i=i+1 Loop b = bMapPath bMapPath=False CreateDir(left(dir_new,pos)) bMapPath=b IF CheckDir(f) Then objFSO.MoveFolder dir_old, dir_new IF Err Then MoveDir=False Else MoveDir=True End IF Else MoveDir=False End IF End Function Public Function CheckFile(file_str) IF bInit=false Then:CreateObj():End IF IF Err Then err.clear:End IF IF bMapPath Then file_str=Server.MapPath(file_str):End IF IF objFSO.FileExists(file_str) Then CheckFile=true else CheckFile=false End IF End Function Public Function DeleteFile(file_str) IF bInit=False Then CreateObj():End IF IF Err Then err.clear:End IF On Error Resume Next IF bMapPath Then file_str=Server.MapPath(file_str):End IF IF objFSO.FileExists(file_str) Then objFSO.DeleteFile(file_str) End IF IF Err Then DeleteFile=False ShowErr Err.Number,Err.Description Else DeleteFile=True End IF End Function Public Function CreateFile(file_str,bCover,html_str) Dim dir,i,b,pos IF bInit=False Then CreateObj():End IF IF Err Then err.clear:End IF bMapPath=True IF bMapPath Then file_str=Server.MapPath(file_str):End IF IF bMapPath=False Then file_str=replace(file_str,"/","\"):End IF i=1 Do While instr(i,file_str,"\") pos=instr(i,file_str,"\") i=i+1 Loop b = bMapPath bMapPath=False CreateDir(left(file_str,pos)) bMapPath=b IF objFSO.FileExists(file_str) And bCover=False Then exit Function End IF Set fileFSO=objFSO.CreateTextFile(file_str,True) fileFSO.WriteLine(html_str) fileFSO.close Set fileFSO=Nothing IF Err Then CreateFile=False Else CreateFile=True End IF End Function Public Function ReadFile(file_str) Dim b IF bInit=False Then CreateObj():End IF IF Err Then err.clear:End IF bMapPath=True IF bMapPath Then file_str=Server.MapPath(file_str):End IF b=bMapPath bMapPath=False IF CheckFile(file_str) Then On Error Resume Next Set fileFSO=objFSO.OpenTextFile(file_str,1) ReadFile = fileFSO.ReadAll Set fileFSO=Nothing IF Err Then ReadFile="" End IF Else ReadFile="" End IF End Function Public Function CopyFile(file_old,file_new) Dim f,i,pos,b IF bInit=False Then CreateObj():End IF IF Err Then err.clear:End IF f=file_old IF bMapPath Then file_old=server.MapPath(file_old):End IF IF bMapPath Then file_new=server.MapPath(file_new):End IF i=1 Do While instr(i,file_new,"\") pos=instr(i,file_new,"\") i=i+1 Loop b = bMapPath bMapPath=False CreateDir(left(file_new,pos)) bMapPath=b IF CheckFile(f) Then objFSO.CopyFile file_old, file_new IF Err Then CopyFile=False Else CopyFile=True End IF Else CopyFile=False End IF End Function Function GetFolderList(Byval cDir) Dim i,objFolder,objSubFolders,filePath,objSubFolder IF bInit=False Then CreateObj():End IF IF Err Then err.clear:End IF i = 0 ReDim folderList(0) filePath = server.mapPath(cDir) Set objFolder=objFSO.GetFolder(filePath) Set objSubFolders=objFolder.Subfolders For each objSubFolder in objSubFolders ReDim Preserve folderList(i) With objSubFolder folderList(i) = .name & ",文件夹," & .size/1000 & " KB," & .DateLastModified & "," & cDir & "/" & .name End With i = i + 1 Next Set objFolder=Nothing Set objSubFolders=Nothing getFolderList = folderList End Function Function GetFileList(Byval cDir) Dim filePath,objFolder,objFile,objFiles,i i = 0 Redim fileList(0) filePath = server.mapPath(cDir) Set objFolder=objFSO.GetFolder(filePath) Set objFiles=objFolder.Files For each objFile in objFiles ReDim Preserve fileList(i) With objFile fileList(i) = .name & "," & Lcase(Mid(.name, InStrRev(.name, ".") + 1)) & "," & .size/1000 & " KB," & .DateLastModified & "," & cDir & "/" & .name End With i = i + 1 Next Set objFiles=Nothing Set objFolder=Nothing getFileList = fileList End Function End Class Dim Fso Set Fso= New CmsDj_Com_Fso %>