<?xml version="1.0"?>
<component>

<registration
	description="FileArranger"
	progid="FileArranger.WSC"
	version="1.00"
	classid="{cfc0229f-d33a-47a1-b02f-397b7753538f}"
>
</registration>

<public>
	<property name="Copyright"/>
	<method name="getFileNamePrefixes">
		<parameter name="sFolder"/>
	</method>
	<method name="moveFilesByPrefixes">
		<parameter name="sFolder"/>
		<parameter name="oFileNamePrefixes"/>
	</method>
</public>

<script language="VBScript">

<![CDATA[
' ****************************************************************************
' *
' * author   fabian wleklinski (wleklinski@eworks.de)
' *   date   2003-04-20
' *    url   http://www.eworks.de/research/2003/04/FileArranger/
' *    (c)   eWorks 2003 (http://www.eworks.de)
' *
' * FileArranger provides methods for scanning a directory and finding similar
' * filenames within it. Example given the filenames "file01.jpg" and
' * "file02.jpg" will result in a prefix "file".
' *
' ****************************************************************************

'**Start Encode**

' Copyright-Information
const Copyright = "(c) 2003 eWorks (http://www.eWorks.de)"

' Returns the class of a given symbol using a numerical code. Symbol classes
' are e.g. "characters", "numbers", and so on.
'
Private Function getSymbolClass( cSymbol )
	If (IsNumeric(cSymbol)) then
		' digits
		getSymbolClass = 2
	elseIf (Asc(cSymbol) >= 65) AND (Asc(cSymbol) <= 90) then
		' big characters
		getSymbolClass = 1
	elseIf (Asc(cSymbol) >= 97) AND (Asc(cSymbol) <= 122) then
		' small characters
		getSymbolClass = 1
	elseIf (cSymbol=" ") then
		' space
		getSymbolClass = 1
	else 
		' everything else
		getSymbolClass = 3
	End If
End Function

' Returns the prefixes that have been found for the files inside of
' the folder "sFolder". A "Scripting.Dictionary"-object is being
' returned.
'
public Function getFileNamePrefixes( sFolder )

	' get an instance of the FileSystemObject-class
	Set oFSO = CreateObject( "Scripting.FileSystemObject" )
	
	' access the source-files-folder 
	Set oSourceFolder = oFSO.GetFolder( sFolder )
	
	' get all filenames inside the source-folder + duplicate them
	Set oFiles = oSourceFolder.Files
	Set oFiles2 = oSourceFolder.Files

	' create an instance of Scripting.Dicstionary for returning
	' the prefixes	
	Set oPrefixes = CreateObject("Scripting.Dictionary")

	' iterate trough all filenames inside the source-folder
	For each oFile in oFiles
		sFile = oFile.Name
		
		' is there a prefix of the current filename which has already
		' been found?
		bSkipThisFile = false
		For each sDonePrefix in oPrefixes
			If (StrComp(Left(sFile,Len(sDonePrefix)),sDonePrefix,1) = 0) then
				bSkipThisFile = true
				exit For
			End If
		Next
			
		If not bSkipThisFile then	
		
			' iSymbolClass has to be initialized with 0, that
			' means: undefined symbol class.
			iSymbolClass = 0

			' iMaxCount stores the maximum number of files that have been
			' found for a certain prefix of the current filename, and sMaxPrefix
			' stores the prefix itself.
			iMaxCount = 0
			sMaxPrefix = ""

			' iterate trough all symbols of the current filename,
			' starting with the last but one symbol.
			i = Len(sFile) - 1
			while (i >= 1)
		
				' backup symbol class of the next symbol
				iLastSymbolClass = iSymbolClass
				
				' get symbol class of the current symbol
				iSymbolClass = getSymbolClass( Mid(sFile,i,1) )
				
				' is there a symbol class of the next symbol?
				If (iLastSymbolClass > 0) then
					
					' has symbol class changed?
					If (iLastSymbolClass <> iSymbolClass) then
						
						' is the following symbol alphanumeric?
						If (iLastSymbolClass <= 2) then
		
							' copy the substring beginning with the first symbol of the
							' current filename, and ending with the current character
							' into a separate variable, and get it's length:
							sPrefix = RTrim( Left(sFile,i) )
							iPrefixLen = Len(sPrefix)
							
							' now let's see how many filenames in the source-folder do
							' begin with this prefix:
							
							iCount = 0
							
							For each oFile2 in oFiles2
								sFile2 = oFile2.Name
									
								' the same prefix?
								If (StrComp(sPrefix,Left(sFile2,iPrefixLen),1) = 0) then
									' yes! => increase number of found files
									iCount = iCount + 1
								End If
							Next
							
							' is this prefix the best one?
							If (iCount > iMaxCount) then
								' yes! => backup prefix
								iMaxCount = iCount
								sMaxPrefix = sPrefix
							End If
							
						End If				
					End If
				End If
				
				' next symbol (that means: the symbol before!)
				i = i - 1
			Wend
	
			' a prefix is only accepted if there is > 1 file with this prefix!
			If (iMaxCount > 1) then
				'store prefix!
				oPrefixes.add sMaxPrefix, sMaxPrefix
			End If
		End If
	Next
	
	' return the prefixes that has been found
	Set getFileNamePrefixes = oPrefixes
End Function

Public Sub moveFilesByPrefixes( sFolder, oFileNamePrefixes )
	' get an instance of the FileSystemObject-class
	Set oFSO = CreateObject( "Scripting.FileSystemObject" )
	
	' access the source-files-folder 
	Set oSourceFolder = oFSO.GetFolder( sFolder )
	
	' get all filenames inside the source-folder
	Set oFiles = oSourceFolder.Files

	' iterate trough all filenames inside the source-folder
	For each oFile in oFiles
		sFile = oFile.Name
		
		' is there a prefix for the current filename?
		For each sPrefix in oFileNamePrefixes
			If (StrComp(Left(sFile,Len(sPrefix)),sPrefix,1) = 0) Then
				
				' try to create the new subfolder (and ignore an already
				' existing subfolder)
					
				On Error Resume Next
				Set oNewFolder = oSourceFolder.SubFolders.Add( sPrefix )
				On Error Goto 0

				' access the new folder for the current file
				Set oNewFolder = oFSO.GetFolder( oSourceFolder.Path & _
					"\" & sPrefix )
				
				' try to move file into the new folder
				oFile.Move oNewFolder & "\" & oFile.Name
				
				exit For
			End If
		Next
	Next
End Sub
]]>
</script>
</component>
