Make your own free website on Tripod.com
<% const c_CRLF = "
" const fsoTextAsAscii=0, fsoTextAsUnicode=-1, fsoTextAsDefault=-2 const fsoForReading=1, fsoForWriting=2, fsoForAppening=8 '======================================== function GetISAReport(fld,tit) const c_TitISAPref= "Array Reports
" dim i,fso,fil,result,stxt on error resume next result= False set fso= CreateObject("Scripting.FileSystemObject") if fso.FileExists(fld&"\header.htm") then ' - ISA REPORT LOOK - set fil= fso.OpenTextFile(fld&"\header.htm",fsoForReading,False,fsoTextAsUnicode) do while (fil.AtEndOfStream<> True) stxt= fil.readline i= InStr(1,stxt,c_TitISAPref,1) if i> 0 then tit= replace(mid(stxt,i+len(c_TitISAPref),24)," to ","-") result= True exit do end if loop fil.Close end if GetISAReport= result end function '--------------------------------------------- function GetPRSReport(fld,tith,lnkh,titu,lnku) const c_TitPRShPref= "ISA LOG PARSE Hosts Результаты с " const c_TitPRSuPref= "ISA LOG PARSE Users Результаты с " const c_PRSPageID= ">showpagecontrol(" dim i,fso,fo,fil,fi,result,stxt dim tithS,lnkhS,tituS,lnkuS GetPRSReport= False ' on error resume next result= False set fso= CreateObject("Scripting.FileSystemObject") ' - PARSER REPORT LOOK - set fo= fso.GetFolder(fld) for each fi in fo.files lnkhS= "" lnkuS= "" set fil= fso.OpenTextFile(fi.path,fsoForReading,False,fsoTextAsAscii) do while (fil.AtEndOfStream<> True) stxt= fil.readline i= InStr(1,stxt,c_TitPRShPref,1) if i> 0 then tithS= replace(mid(stxt,i+len(c_TitPRShPref),24)," по ","-") lnkhS= fi.name end if i= InStr(1,stxt,c_TitPRSuPref,1) if i> 0 then tituS= replace(mid(stxt,i+len(c_TitPRSuPref),24)," по ","-") lnkuS= fi.name end if i= InStr(1,stxt,c_PRSPageID,1) if i> 0 then if mid(stxt,i+len(c_PRSPageID),2)= "1," then if len(lnkhS)>0 then lnkh= lnkhS tith= tithS end if if len(lnkuS)>0 then lnku= lnkuS titu= tituS end if result= True end if exit do end if loop fil.Close if ((len(lnkh)>0) and (len(lnku)>0)) then exit for 'break end if next GetPRSReport= result end function '--------------------------------------------- function ProcessFolder(sTrg) dim fl,fo,fso,sres,fn dim tit1,lnk1,tit2,lnk2 dim bOdd,cl on error resume next sres= "" set fso= CreateObject("Scripting.FileSystemObject") set fo= fso.GetFolder(sTrg) bOdd= True for each fl in fo.subfolders tit1= "" lnk1= "" tit2= "" lnk2= "" if bOdd then cl= "#F7F7EE" else cl= "white" end if if GetISAReport(fl.path,tit1) then sres= sres & ""& tit1& "суммарный отчёт"&vbCRLF bOdd= not bOdd else if GetPRSReport(fl.path,tit1,lnk1,tit2,lnk2) then sres= sres & ""& tit1&"отчёты о посещаемых сайтах" sres= sres & " и интересах пользователей"&vbCRLF bOdd= not bOdd end if end if next ProcessFolder= sres ' ProcessFolder= right(sres,len(sres)-len(c_CRLF)) end function '======================================== %>
TST

 

<%response.write ProcessFolder(".")%>
    Real Colonel     <%response.write date%>