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