Option explicit
'==========================================================================
' NAME: SiteSearch.vbs
'
' AUTHOR: tatuk
' DATE : 1/8/2005
'
' COMMENT:
'Precompiled MS Access database is used
'to store list of files. If is designed to store file path.
'If you do file uploading/moving by your own, you also need a program To
'build your database offline after you made some changings (for example,
'once a day).
'
'Thanks to CodSpirit and IceMan dudes!
'==========================================================================
'
'Where's your database?
Const DB = "C:\DB.mdb"
'How many results should we have ? Recommanded = 10
Const MaxResults = 15
'Should we log new files uploads ?
Const LogFiles = True
'Should we log new dirs created ?
Const LogDirs = True
'Should we check if file is a dupe when uploaded/created ?
Const CheckFiles = True
'Should we only notice the user that what he uploaded/create is a dupe ?
'Otherwise the file will be prohibited.
Const NoticeOnly = False
'Should we send notices / confirmations to client ?
Const NotificationMode = True
'Files excluded from logging:
' *[*.* *.nfo *.sfv *.message file_id.diz
' sample. CD1 CD2 *nolog* *.acl
' *.R01-*.R99 *.000-*.099 *.part00.rar-*.part99.rar *.m3u *.mp3
' "System Volume Information" RECYCLER
Dim ExcludeReg : ExcludeReg = Array( "\[",_
"\.nfo$", "\.sfv$", "\.message$", "^file_id\.diz$",_
"^Sample$", "^CD.{1,2}$", "nolog", "\.acl$",_
"\.R\d\d$", "\.0\d\d$", "\.part\d\d\.rar$",_
"^System Volume Information$", "^RECYCLER$",_
"\.mp3$", "\.m3u$", "\jpg$" "\jpeg$" )
'Access example
Dim sCon : sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & DB & "';"
'Mysql example
'Dim sCon : sCon = "Driver={MySQL ODBC 3.51 Driver};"&_
' "Server=localhost;Port=3306;Option=131072;Stmt=;Database=G6_logs;"&_
' "Uid=G6;Pwd=;"
Dim fso : Set fso = CreateObject("Scripting.fileSystemObject")
Dim vbCrLf : vbCrLf = Chr(13) & Chr(10)
Sub OnSiteSearch(args)
Dim co, i, comm, rs, TotRes, search, msg, Total
Set co = CreateObject("ADODB.Connection")
co.open sCon
If co.State <> 1 Then
If NotificationMode Then
client.send 200, "[Search] Failed to open data connection"
End If
Set co = Nothing
Exit Sub
End If
args = NoDblQuotes( args )
Dim sName, sNames, j, s1
Dim re : Set re = New RegExp
re.pattern = "([^\\/:\?\""<>\|]*?)(\*|\s|$)"
re.IgnoreCase = True
re.Global = True
Set sNames = re.Execute(args)
j=0
For Each sName in sNames
Dim re1 : Set re1 = New RegExp
re1.pattern = "(.*?)\*|\s|$"
re1.IgnoreCase = True
s1 = RE.replace( sName.value, "$1" )
If j=0 Then
search = s1
j=1
else
search = search & "%"" and File like ""%" & s1
End if
Next
Set rs = co.execute("Select count(*) from uploads")
Total = rs.fields(0).value
Set rs = co.execute("Select count(*) from uploads where File like ""%" & search & "%""" )
TotRes = rs.fields(0).value
If TotRes = 0 Then
Msg = "[Search] : no entry found matching """ & args & """" & VbCrLf
Elseif TotRes <= MaxResults Then
Msg = "[Search] : " & TotRes & " entries found matching """ & args & """" & VbCrLf
Else
Msg = "[Search] : " & TotRes & " entries found matching """ & args & """, listing the last " & MaxResults & vbCrLf
End If
Msg = msg & "+" & String(70, "-") & "+" & vbCrLf
If TotRes > 0 Then
comm = "Select File from uploads where File like ""%" & search & "%"""
Set rs = co.execute(comm)
i = 0
Do until rs.eof Or i > MaxResults
i = i + 1
Msg = msg & rs.fields(0) & vbCrLf
rs.MoveNext
Loop
End If
Msg = msg & "+" & String(70, "-") & "+" & vbCrLf
Msg = msg & "Total number of files stored in database: " & Total & vbCrLf
client.send 200, Msg & "End of search"
co.Close
Set co = Nothing
Set RE = Nothing
Set rs = Nothing
End Sub
Sub OnFileUploaded ()
If Not LogFiles or ToSkip( fso.getFileName(Client.FileName) ) Then Exit Sub
Dim RecCount, comm
dim Co : Set Co = CreateObject("ADODB.Connection")
Co.open sCon
If co.State <> 1 Then
If NotificationMode Then
client.send 200, "[Search] Failed to open data connection"
End If
Set co = Nothing
Exit Sub
End If
comm = "Insert into uploads (File, CheckFile)" &_
" values(""" & Client.FileName & """, False)"
co.Execute comm, RecCount
If RecCount = 0 and NotificationMode Then
Client.post "[Search] Failed to log file uploaded"
ElseIf RecCount > 0 and NotificationMode Then
Client.post "[Search] Uploaded file successfuly logged"
End If
co.close
Set co = Nothing
End Sub
Sub HookStore( FileName, FileNameReal )
If not CheckFiles Then Exit Sub
Dim comm, rs, WhereFile
Dim Co : Set Co = CreateObject("ADODB.Connection")
Co.open sCon
If co.State <> 1 Then
If NotificationMode Then
client.send 200, "[Search] Failed to open data connection"
End If
Set co = Nothing
Exit Sub
End If
comm = "Select File from uploads where File like ""%" & NoDblQuotes(fso.getFileName(FileName)) & "%"""
Set rs = co.Execute (comm)
If rs.eof and NotificationMode Then
Client.post "[Search] File dies not exists, go on ...."
ElseIf Not rs.eof Then
WhereFile = rs.fields("File")
comm = "Select * from uploads where File=""" & FileName & """"
Set rs = co.Execute (comm)
if Not rs.EOF Then 'file exists in the same folder (resuming?)
if NotificationMode Then
Client.post "[Search] Warning: File already exists! Resuming will take place..."
end If
Hook.Result = 0
Else
If NoticeOnly Then
Client.post "[Search] Warning: File already exists! [ " & WhereFile & " ]"
Hook.Result = 0
else
Client.post "[Search] Denied: File already exists! [ " & WhereFile & " ]"
Hook.Result = 1 'denied
End if
end If
End If
co.close
Set co = Nothing
Set rs = Nothing
End Sub
Sub OnDirCreated()
Dim sList
sList = Right(Client.FileName, Len(Client.FileName) - InStrRev(Client.FileName, "/", -1, 1))
If Not LogDirs or ToSkip( sList ) Then Exit Sub
Dim RecCount, comm
dim Co : Set Co = CreateObject("ADODB.Connection")
Co.open ConnectionString
If co.State <> 1 Then
If NotificationMode Then
client.send 200, "[Search] Failed to open data connection"
End If
Set co = Nothing
Exit Sub
End If
comm = "Insert into uploads (File, CheckFile)" &_
" values(""" & Client.FileName & "/"", False)"
co.Execute comm, RecCount
If RecCount = 0 and NotificationMode Then
Client.post "[Search] Failed to log dir created"
ElseIf RecCount > 0 and NotificationMode Then
Client.post "[Search] Created dir successfuly logged"
End If
co.close
Set co = Nothing
End Sub
Function NoDblQuotes(Arg) 'by CodSpirit
Dim x : x = 0
NoDblQuotes = Arg
Do
x = InStr(NoDblQuotes, """")
If x > 0 Then
NoDblQuotes = Left(NoDblQuotes, x-1) & "''" & Right(NoDblQuotes, Len(NoDblQuotes)-x-1)
End If
Loop Until x = 0
End Function
Function ToSkip( FileName ) 'by CodSpirit
Dim i, rExp
Set rExp = New RegExp
rExp.IgnoreCase = True
For i = LBound(ExcludeReg) to UBound(ExcludeReg)
rExp.Pattern = ExcludeReg(i)
If rExp.Test(FileName) Then
ToSkip = True
rExp = nothing
Exit Function
End If
Next
ToSkip = False
End Function