Enumerate All file attributes

anyone have a script that will return the file attributes of all files
in a folder and it's subfolders?

Thanks
azeem.

BerkHolz,
Thu Jul 03 16:07:05 CDT 2003

Here is a script to read attributes from files on CD or DVD.
You might find what you need in there.

Steven BerkHolz

------------------

'********************************************************************
'*
'* Script Name:
'*
'* archive.vbs
'*
'* Created:
'*
'* 2003-02-13, Steven BerkHolz (much code used as reference)
'*
'********************************************************************

'********************************************************************
'*
'* Global Variable Definitions
'*
'********************************************************************


'Option Explicit

dim WSHShell
dim WSHNet
dim fso

dim LogFile

dim FileCount
dim ShortCutCount
dim ChangeCount

dim CRLF

dim StartTime

'********************************************************************
'*
'* START! Call the MAIN function to get things started.
'*
'********************************************************************

Main()

LogFile.Close

Function Main()


InitGlobals()

On Error Resume Next
LogFile.WriteLine "Scan conducted for: " + WSHNet.UserDomain + "\" + _
WSHNet.UserName + " on " + WSHNet.ComputerName + " at " + CStr(Time) + ",
" + CStr(Date) + CRLF
If Err.Number <> 0 then
Err.Clear
LogFile.WriteLine "Scan conducted at " + CStr(Time) + ", " + CStr(Date) +
CRLF
If Err.Number <> 0 then
ErrorHandler True, "Unable to write to LogFile " + LogFile.Name, "Main()"
else
ErrorHandler False, "Unable to access user credentials.", "Main()"
end if
end if
On Error Goto 0

dim aDrive
Dim resulttoscan
resulttoscan = InputBox("Please enter the Drive letter to scan","Drive
letter","D", 100, 100)
Dim connA
Dim DataA

Dim AchiveMediaID
'AchiveMediaID = InputBox("Please enter the Archive Media ID to be
assigned","Archive Media ID","D", 100, 100)
'LogFile.WriteLine "Media ID to be assigned is " & AchiveMediaID
set connA = CreateObject("ADODB.Connection")
set DataA = CreateObject("ADODB.RecordSet")
connA.Open("Provider=SQLOLEDB; DATA SOURCE=tg01; Integrated Security=SSPI;
Persist Security Info=False; DATABASE=ArchiveDBSQL")

SQLTextA = "Select Max(MediaID) + 1 NextMediaID FROM MediaDB"
DataA.open SQLTextA, connA, 1
AchiveMediaID = DataA("NextMediaID")
LogFile.WriteLine "AchiveMediaID = " & AchiveMediaID
Dim blah
for each aDrive in fso.Drives
if aDrive.DriveLetter = resulttoscan Then
LogFile.WriteLine "scanning " & resulttoscan & " Drive started"
Dim string1
string1 = "Ready to scan, Please wait for Media ID. Close this window to
continue."
WScript.Echo(string1)


blah = SearchFolder (aDrive.RootFolder,AchiveMediaID)
If Err.Number <> 0 then
Err.Clear
LogFile.WriteLine "Scan conducted at " + CStr(Time) + ", " + CStr(Date) +
CRLF
If Err.Number <> 0 then
ErrorHandler True, "Unable to write to LogFile " + LogFile.Name,
"Main()"
else
ErrorHandler False, " Path not found.", "Main()"
end if
end if
LogFile.WriteLine "scanning " & resulttoscan & " Drive finished"
Dim string2
string2 = "The media ID is " & AchiveMediaID
WScript.Echo(string2)

end if
next

End Function


'************************************************************************
'*
'* Function: InitGlobals
'* Parameters: None
'* Purpose: Initialize global variables
'* Precondition: Global variables declared
'* Postcondition: Global variables initialized
'*
'************************************************************************

Sub InitGlobals()

On Error Resume Next

set WSHShell = WScript.CreateObject("WScript.Shell")
Set WSHNet = WScript.CreateObject("WScript.Network")
set fso = CreateObject("Scripting.FileSystemObject")
If Err.Number <> 0 then
ErrorHandler True, "Error creating VBScript object.", "InitGlobals()"
end if

set LogFile = fso.CreateTextFile("c:\ArhiveLog_" +
join(split(FormatDateTime(Time, vbShortTime),":"), "") + ".txt", True)
If Err.Number <> 0 then
ErrorHandler True, "Error creating file.", "InitGlobals()"
end if

FileCount = 0
ShortCutCount = 0
ChangeCount = 0

CRLF = Chr(13) & Chr(10)

StartTime = Time

End Sub




'************************************************************************
'*
'* Function: SearchFolder
'* Parameters: aFolder, Folder object
'* Purpose: Searches through all files in the given Folder.
'* Calls itself on all subfolders of aFolder
'* Precondition: aFolder is an existing Folder
'* Postcondition: If aFolder contained shortcuts to old server, they will
now
'* to point to the new server. Otherwise no change.
'*
'************************************************************************

Function SearchFolder(aFolder,MediaIDName)

if aFolder.Name = "System Volume Information" then Exit Function
'^^^ Nobody has access to this dir by default, so accessing it throws an
error.

dim aFile

On Error Resume Next

Dim Data2
set conn2 = CreateObject("ADODB.Connection")

SET Data2 = CreateObject("ADODB.RecordSet")
conn2.Open("Provider=SQLOLEDB; DATA SOURCE=tg01; Integrated Security=SSPI;
Persist Security Info=False; DATABASE=ArchiveDBSQL")

SQLText2 = "Select " & _
"MediaDB.ID, MediaDB.MediaID, MediaDB.ScannedBy, MediaDB.ScannedOn, " & _
"MediaDB.FileName, MediaDB.FileType, MediaDB.FileAttrib, MediaDB.FileDateC,
MediaDB.FileDateM, MediaDB.FilePath, MediaDB.FileSize, MediaDB.FileVersion "
& _
"FROM " & _
"MediaDB " & _
"WHERE " & _
"ID > 0 ORDER BY " & _
"ID ASC"
'WScript.Echo MediaID2

'MediaID3 = Data("MediaID").value
'LogFile.WriteLine "MediaID3 = " & MediaID3

Data2.Open SQLText2, conn2, 3,3
for each aFile in aFolder.Files

If Err.Number <> 0 then
ErrorHandler False, "Error accessing folder " + aFolder, "SearchFolder("
+ aFolder + ")"
Exit Function
end If
Dim PathLen
Dim NewPathLen
Dim RightPath
Dim RightPathLen
LogFile.WriteLine "Name = " & aFile.Name
LogFile.WriteLine "Type = " & aFile.Type
LogFile.WriteLine "Attributes = " & aFile.Attributes
LogFile.WriteLine "DateCreated = " & aFile.DateCreated
LogFile.WriteLine "DateLastModified = " & aFile.DateLastModified
PathLen = Len(aFile.Path)
NewPathLen = PathLen - 2
RightPath = Right(aFile.Path, NewPathLen)
RightPathLen = Len(RightPath)
PathLen = Len(aFile.Name)
NewPathLen = RightPathLen - PathLen
LogFile.WriteLine "Path = " & Left(RightPath, NewPathLen)
LogFile.WriteLine "Size = " & aFile.Size
LogFile.WriteLine "Version = " & fso.GetFileVersion(aFile)
LogFile.WriteLine CRLF
Data2.AddNew
Data2.Fields("MediaID").Value = MediaIDName
Data2.Fields("ScannedBy").Value = WSHNet.UserName
Data2.Fields("ScannedOn").Value = CStr(Date)
Data2.Fields("FileName").Value = aFile.Name
Data2.Fields("FileType").Value = aFile.Type
Data2.Fields("FileAttrib").Value = aFile.Attributes
Data2.Fields("FileDateC").Value = aFile.DateCreated
Data2.Fields("FileDateM").Value = aFile.DateLastModified
Data2.Fields("FilePath").Value = Left(RightPath, NewPathLen)
Data2.Fields("FileSize").Value = aFile.Size
Data2.Fields("FileVersion").Value = fso.GetFileVersion(aFile)
Data2.Update


If Err.Number <> 0 then
ErrorHandler False, "Error accessing file " + aFile, "SearchFolder(" +
aFolder + ")"
end if

FileCount = FileCount + 1
Next

dim SubFolder
for each SubFolder in aFolder.SubFolders
If Err.Number <> 0 then
ErrorHandler False, "Error accessing subfolder " + SubFolder,
"SearchFolder(" + aFolder + ")"
Exit Function
end if
Dim blah2
if SubFolder.Type <> "Folder Shortcut" then
blah2 = SearchFolder (SubFolder,MediaIDName)
end if
next

On Error Goto 0

End Function




'************************************************************************
'*
'* Function: ErrorHandler
'* Parameters: Fatal, boolean
'* Description, string
'* FunctionName, string
'* Purpose: Tests the severity of the error, logs the appropriate
'* message, Displays an appropriate message if needed,
'* and exits the script if the error is fatal
'* Precondition: An error has occurred (Thus, Err object populate with
meaningful data)
'*
'************************************************************************

Function ErrorHandler(Fatal, Description, FunctionName)

dim String
String = "Fatal Error - " + CStr(DateDiff("s", StartTime, Time)) + "
seconds into the script." + CRLF + _
" In Function " + FunctionName + CRLF + _
" VBS Info:" + CRLF + _
" Description: " + Chr(9) + Err.Description + CRLF + _
" Error Number: " + Chr(9) + CStr(Err.Number) + CRLF + _
" Error Source: " + Chr(9) + Err.Source + CRLF + _
" FixLinks Info:" + CRLF + _
" Description: " + Chr(9) + Description

if CBool(Fatal) then

LogFile.WriteLine String
LogFile.Close
String = "FixLinks.vbs Error!" + CRLF + _
"An error has occurred during the execution of this script." + CRLF + _
"Errors have been printed to the Log File." + CRLF + _
"Please contact your Network Administrator for assistance."
WSHShell.Popup String, 999, "FixLinks", 16
wscript.quit 1

else

String = "Non-" + String
LogFile.WriteLine String
Err.Clear

end if

End Function








-------------------


"Bioman" <azeem.mohammed@biovail.com> wrote in message
news:ca96a5fd.0307031113.8bf901a@posting.google.com...
> anyone have a script that will return the file attributes of all files
> in a folder and it's subfolders?
>
> Thanks
> azeem.

Bill
Thu Jul 03 18:35:51 CDT 2003

Here's another that you may be able to modify:

<html>
<head>
<script language="vbscript">
Dim folderPath

Sub folderSize(folderspec)

Dim fso, f, fldr, s, sf
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(folderspec)
Set sf = f.SubFolders

set oUL1 = document.createElement("ul")
document.body.appendChild(oUL1)

set oLi = document.createElement("li")
oLi.innerText = folderspec
oUL1.appendChild(oLi)

set oUL2 = document.createElement("ul")
oUL1.appendChild(oUL2)

For Each fldr in sf

Set oLi = document.createElement("li")
oLi.innerText = fldr.name & ": " & _
formatNumber(fldr.size,0,,-2) & _
" bytes"
oLi.setAttribute "folderPath", fldr.path
oLi.onClick = getRef("clickHandler")
oUL2.appendChild(oLi)

Next

End Sub


Sub clickHandler()
msgbox window.event.srcElement.folderPath
folderSize(window.event.srcElement.folderPath)
End Sub

sub window_onload()
folderSize("C:\Documents and Settings")
end sub

</script>
</head>
<body >
</body>
</html>

"Bioman" <azeem.mohammed@biovail.com> wrote in message
news:ca96a5fd.0307031113.8bf901a@posting.google.com...
> anyone have a script that will return the file attributes of all files
> in a folder and it's subfolders?
>
> Thanks
> azeem.

Bill
Thu Jul 03 19:33:37 CDT 2003

Ok - I modified it to include the files and attributes
(couldn't resist). You have to click on the SubFolders
to get their files.

Anyone have a cleaner way of 'parsing' the bits in the
attributes property??


<html>
<head>
<script language="vbscript">
Dim folderPath

Sub folderSize(folderspec)

Dim fso, f, fldr, s, sf, oFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(folderspec)
Set sf = f.SubFolders

set oUL1 = document.createElement("ul")
document.body.appendChild(oUL1)

set oLi = document.createElement("li")
oLi.innerText = folderspec
oUL1.appendChild(oLi)

set oUL2 = document.createElement("ul")
oUL1.appendChild(oUL2)

For Each fldr in sf

Set oLi = document.createElement("li")
oLi.innerText = fldr.name & ": " & _
formatNumber(fldr.size,0,,-2) & _
" bytes"
oLi.setAttribute "folderPath", fldr.path
oLi.onClick = getRef("clickHandler")
oLi.style.cursor = "hand"
oUL2.appendChild(oLi)

set oUL3 = document.createElement("ul")
For Each oFile in fldr.files
Set oLi3 = document.createElement("li")
oLi3.innerText = oFile.Name & ": " & _
fileAttributes(oFile.Attributes)
oUL3.appendChild(oLi3)
Next
oUL3.style.cursor = "auto"
oLi.appendChild(oUL3)
Next

End Sub

Function fileAttributes(vNbr)

Dim sTxt

If vNbr And 1 Then
sTxt = sTxt & "Read-only|"
End If

If vNbr And 2 Then
sTxt = sTxt & "Hidden|"
End If

If vNbr And 4 Then
sTxt = sTxt & "System|"
End If

If vNbr And 8 Then
sTxt = sTxt & "Volume|"
End If

If vNbr And 16 Then
sTxt = sTxt & "Directory|"
End If

If vNbr And 32 Then
sTxt = sTxt & "Archive|"
End If

If vNbr And 64 Then
sTxt = sTxt & "Alias|"
End If

If vNbr And 128 Then
sTxt = sTxt & "Compressed|"
End If

fileAttributes = sTxt
End Function

Sub clickHandler()
msgbox window.event.srcElement.folderPath
folderSize(window.event.srcElement.folderPath)
End Sub

sub window_onload()
folderSize("C:\Documents and Settings")
end sub

</script>
</head>
<body >
</body>
</html>





"Bioman" <azeem.mohammed@biovail.com> wrote in message
news:ca96a5fd.0307031113.8bf901a@posting.google.com...
> anyone have a script that will return the file attributes of all files
> in a folder and it's subfolders?
>
> Thanks
> azeem.

\
Thu Jul 03 20:31:19 CDT 2003

>Anyone have a cleaner way of 'parsing' the bits in the
>attributes property??

I use this to convert a byte sized number into a string of ones and zeroes.

function bitString(X)
for b=1 to 8
bitString=X mod 2 & bitString
X=int(X/2)
next
end function

Then I can test a particular attribute with the "mid" function. For example,

If mid(bitString(attribute),7,1) then msgbox "File is hidden"
--
Dave "Crash" Dummy - A weapon of mass destruction
crash@gpick.com
http://lists.gpick.com

Steve
Fri Jul 04 05:43:40 CDT 2003

"Crash" Dummy wrote:
>> Anyone have a cleaner way of 'parsing' the bits in the
>> attributes property??
>
> I use this to convert a byte sized number into a string of ones and zeroes.
>
> function bitString(X)
> for b=1 to 8
> bitString=X mod 2 & bitString
> X=int(X/2)
> next
> end function
>
> Then I can test a particular attribute with the "mid" function. For example,
>
> If mid(bitString(attribute),7,1) then msgbox "File is hidden"

Or you could use the And operator to test it:

If attribute AND 2 Then MsgBox "File is hidden"

And Operator
http://msdn.microsoft.com/library/en-us/script56/html/vsoprand.asp

Windows Script Documentation
http://www.microsoft.com/downloads/details.aspx?FamilyId=01592C48-207D-4BE1-8A76-1C4099D7BBB9&displaylang=en

--
Steve

There is no rule more invariable than that we are paid for our suspicions by
finding what we suspect. -Henry David Thoreau

\
Fri Jul 04 07:40:33 CDT 2003

>Or you could use the And operator to test it:

Much better. I didn't know there was an AND operator in VBS, since it doesn't do
binary. Thanks!

Dave

Bill
Fri Jul 04 09:46:44 CDT 2003

I had/have 8 If statements using AND to test for the bits - each If
statement
added to a string. Seemed cumbersome.

Bill Wallace

\
Fri Jul 04 15:05:04 CDT 2003

>I had/have 8 If statements using AND to test for the bits - each If
>statement added to a string. Seemed cumbersome.

I don't know what else you can do, except put it in a loop:

textString=attribString(file.attributes)

dim attrib(8)
attrib(1)="Read-only"
attrib(2)="Hidden"
attrib(3)="System"
attrib(4)="Volume"
attrib(5)="Directory"
attrib(6)="Archive"
attrib(7)="Alias"
attrib(8)="Compressed"

function attribString(X)
if X then
for b=1 to 8
if (X mod 2) then attribString=attribString & ", " & attrib(b)
X=int(X/2)
next
attribString=mid(attribString,3)
else
attribString="Normal"
end if
end function