Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How can create a report and display contents on the screen at the same time.

Status
Not open for further replies.
farseer3178

farseer3178

Technical User
Aug 6, 2013
1
US
I have this script to get permissions on a folder or drive, and writes it to a specified location as requested by the script.
Now, what my manager is asking is to have the file display while is being written, and then notify that it has completed.
IS there any way to do that?

Const TIMEOUT = 8
Set objShell = WScript.CreateObject("WScript.Shell")

objShell.Popup "This script will gather permissions information", TIMEOUT
objShell.Popup "Please be aware that you need ADMIN rights to get permissions on a folder.", TIMEOUT

objShell.Popup "Please be patient while it completes, Thank you!", TIMEOUT


Const ForReading = 1, ForWriting = 2, ForAppending = 8

Const FullAccessMask = 2032127, ModifyAccessMask = 1245631, WriteAccessMask = 118009
Const ROAccessMask = 1179817

On Error Resume Next

strComputer = "."
sOutputFile = InputBox("Please Enter the Outputfile", "Output File")

sParentFolder = InputBox("Please Enter folder to gather information on", "Parent Folder")


Set fso = CreateObject("Scripting.FileSystemObject")
Set fsOut = fso_OpenTextFile(sOutputFile, ForAppending, True)
fsOut.Writeline "Folder,User Name,Permission"
fsOut.Close

Call OutputFolderInfo(sParentFolder, sOutputFile)

Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\cimv2")
Set aSubfolder_1 = objWMIService.ExecQuery("ASSOCIATORS OF {Win32_Directory.Name='" & _
sParentFolder & "'}" _
& "WHERE AssocClass = Win32_Subdirectory " & "ResultRole = PartComponent")

For Each sSubfolder1 In aSubfolder_1
Call OutputFolderInfo(sSubfolder1.Name, sOutputFile)
Set aSubfolder_2 = objWMIService.ExecQuery("ASSOCIATORS OF {Win32_Directory.Name='" & _
sSubfolder1.Name & "'}" _
& "WHERE AssocClass = Win32_Subdirectory " & "ResultRole = PartComponent")
For Each sSubfolder2 In aSubfolder_2
Call OutputFolderInfo(sSubfolder2.Name, sOutputFile)
Set aSubfolder_3 = objWMIService.ExecQuery("ASSOCIATORS OF {Win32_Directory.Name='" & _
sSubfolder2.Name & "'}" _
& "WHERE AssocClass = Win32_Subdirectory " & "ResultRole = PartComponent")
Next
Next


Public Sub OutputFolderInfo(FolderName , sOutfile)

Const FullAccessMask = 2032127, ModifyAccessMask = 1245631, WriteAccessMask = 1180095
Const ROAccessMask = 1179817
Const ForReading = 1, ForWriting = 2, ForAppending = 8
strComputer = "."

'Build the path to the folder because it requites 2 backslashes
folderpath = Replace(FolderName, "\", "\\")

objectpath = "winmgmts:Win32_LogicalFileSecuritySetting.path='" & folderpath & "'"

'Get the security set for the object
Set wmiFileSecSetting = GetObject(objectpath)

'verify that the get was successful
RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)
'If Err <> 0 Then
'MsgBox ("GetSecurityDescriptor failed" & vbCrLf & Err.Number & vbCrLf & Err.Description)
'End
'End If


Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\cimv2")
Set colFolders = objWMIService.ExecQuery("SELECT * FROM Win32_Directory WHERE Name ='" & _
folderpath & "'")
For Each objFolder In colFolders

' Retrieve the DACL array of Win32_ACE objects.
DACL = wmiSecurityDescriptor.DACL

Set fso = CreateObject("Scripting.FileSystemObject")
Set fsOut = fso_OpenTextFile(sOutfile, ForAppending, True)


For Each wmiAce In DACL
' Get Win32_Trustee object from ACE
Set Trustee = wmiAce.Trustee
fsOut.Write objFolder.Name & "," & Trustee.Domain & "\" & Trustee.Name & ","
FoundAccessMask = False
CustomAccessMask = Flase
While Not FoundAccessMask And Not CustomAccessMask
If wmiAce.AccessMask = FullAccessMask Then
AccessType = "Full Control"
FoundAccessMask = True
End If
If wmiAce.AccessMask = ModifyAccessMask Then
AccessType = "Modify"
FoundAccessMask = True
End If
If wmiAce.AccessMask = WriteAccessMask Then
AccessType = "Read/Write Control"
FoundAccessMask = True
End If
If wmiAce.AccessMask = ROAccessMask Then
AccessType = "Read Only"
FoundAccessMask = True
Else
CustomAccessMask = True
End If
Wend

If FoundAccessMask Then
fsOut.Writeline AccessType
Else
fsOut.Writeline "Custom"
End If

Next

Set fsOut = Nothing
Set fso = Nothing

Next

Set fsOut = Nothing
Set fso = Nothing

end sub
 
Sort by date Sort by votes
Hi [2thumbsup]
You can do it like this approach with HTML Application HTA:
ScanFolders.hta

Code: 
<html>
<head>
<title>Scan Folders and SubFolders © Hackoo Crackoo 2013</title>
<HTA:APPLICATION 
ID="Scan Folders and SubFolders © Hackoo Crackoo 2013" 
APPLICATIONNAME="Scan Folders and SubFolders © Hackoo Crackoo 2013"
SCROLL="yes"
SINGLEINSTANCE="yes"
WINDOWSTATE="Maximize"
icon="Explorer.exe"
>
</head>
<center><body text=white bgcolor=#1234568 TOPMARGIN="1" LEFTMARGIN="1" RIGHTMARGIN="1">
<input type="Button" value="Scan" style="width: 180px" style="font-weight: bold; value="Scan" onclick="Scan()">
<center><span id="Data"></span></center>
<center><span id="Sig"></span></center>
<META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
<SCRIPT LANGUAGE="VBScript">
Const ForReading = 1, ForWriting = 2, ForAppending = 8

Const FullAccessMask = 2032127, ModifyAccessMask = 1245631, WriteAccessMask = 118009
Const ROAccessMask = 1179817

On Error Resume Next
Set Ws = CreateObject("Wscript.Shell")
strComputer = "."
sOutputFile = "c:\outputfile.txt"

sParentFolder = InputBox("Please Enter folder to gather information on", "Parent Folder")

Set fso = CreateObject("Scripting.FileSystemObject")
Set fsOut = fso.OpenTextFile(sOutputFile,ForWriting,True)
fsOut.Writeline "Folder,User Name,Permission"
fsOut.Close

Sub Scan()
Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = sParentFolder

Set objFolder = objFSO.GetFolder(objStartFolder)
Data.InnerHTML = "<br><br><br><br><br><br><br><br><b><font color='red' size='5'>Scanning Folder : <br>" & qq(objFolder.Path) & "</font></b>"
f_sleep(1)
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\cimv2")
Set aSubfolder_1 = objWMIService.ExecQuery("ASSOCIATORS OF {Win32_Directory.Name='" & _
sParentFolder & "'}" _
& "WHERE AssocClass = Win32_Subdirectory " & "ResultRole = PartComponent")

For Each sSubfolder1 In aSubfolder_1
Call OutputFolderInfo(sSubfolder1.Name, sOutputFile)
Set aSubfolder_2 = objWMIService.ExecQuery("ASSOCIATORS OF {Win32_Directory.Name='" & _
sSubfolder1.Name & "'}" _
& "WHERE AssocClass = Win32_Subdirectory " & "ResultRole = PartComponent")
For Each sSubfolder2 In aSubfolder_2
Call OutputFolderInfo(sSubfolder2.Name, sOutputFile)
Set aSubfolder_3 = objWMIService.ExecQuery("ASSOCIATORS OF {Win32_Directory.Name='" & _
sSubfolder2.Name & "'}" _
& "WHERE AssocClass = Win32_Subdirectory " & "ResultRole = PartComponent")
Next
Next
'Set colFiles = objFolder.Files
'For Each objFile in colFiles
'    Data.InnerHTML = "<br><br><br><br><br><br><br><br><b><font color='DarkOrange' size='5'>Scanning Files : <br>" & qq(objFile.Path) & "</font></b>"
'	f_sleep(0.001)
'Next
ShowSubfolders objFSO.GetFolder(objStartFolder)
MsgBox "Le Scan est Termine !",64,"Le Scan est Termine !"
ws.run sOutputFile
Self.close
End Sub


Sub ShowSubFolders(Folder)
Dim objFSO,objFolder,colFiles
Set objFSO = CreateObject("Scripting.FileSystemObject")
    For Each Subfolder in Folder.SubFolders
        Data.InnerHTML = "<br><br><br><br><br><br><br><br><b><font color='red' size='5'>Scanning Folder : <br>"& qq(Subfolder.Path) & "</font></b>"
        f_sleep(1)
        Call OutputFolderInfo(sParentFolder, sOutputFile)
        Set objFolder = objFSO.GetFolder(Subfolder.Path)
        Set colFiles = objFolder.Files
        For Each objFile in colFiles
           Data.InnerHTML = "<br><br><br><br><br><br><br><br><b><font color='DarkOrange' size='5'>Scanning Files : "&vbCr& qq(objFile.Path) & "</font></b>"
		   f_sleep(0.001)
		   
        Next
        ShowSubFolders Subfolder
    Next
End Sub

Function qq(strIn)
    qq = Chr(34) & strIn & Chr(34)
End Function

Sub f_Sleep(seconds) 
Set objWS = CreateObject("WScript.Shell")
cmd = "%COMSPEC% /c ping -n " & seconds & " 127.0.0.1>nul"
objWS.Run cmd,0,1 
End Sub


Sub OutputFolderInfo(FolderName,sOutfile)
Const FullAccessMask = 2032127, ModifyAccessMask = 1245631, WriteAccessMask = 1180095
Const ROAccessMask = 1179817
Const ForReading = 1, ForWriting = 2, ForAppending = 8
strComputer = "."

'Build the path to the folder because it requites 2 backslashes
folderpath = Replace(FolderName, "\", "\\")

objectpath = "winmgmts:Win32_LogicalFileSecuritySetting.path='" & folderpath & "'"

'Get the security set for the object
Set wmiFileSecSetting = GetObject(objectpath)

'verify that the get was successful
RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)
'If Err <> 0 Then
'MsgBox ("GetSecurityDescriptor failed" & vbCrLf & Err.Number & vbCrLf & Err.Description)
'End
'End If


Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\cimv2")
Set colFolders = objWMIService.ExecQuery("SELECT * FROM Win32_Directory WHERE Name ='" & _
folderpath & "'")
For Each objFolder In colFolders

' Retrieve the DACL array of Win32_ACE objects.
DACL = wmiSecurityDescriptor.DACL

Set fso = CreateObject("Scripting.FileSystemObject")
Set fsOut = fso.OpenTextFile(sOutfile, ForAppending, True)


For Each wmiAce In DACL
' Get Win32_Trustee object from ACE
Set Trustee = wmiAce.Trustee
fsOut.Write objFolder.Name & "," & Trustee.Domain & "\" & Trustee.Name & ","
FoundAccessMask = False
CustomAccessMask = Flase
While Not FoundAccessMask And Not CustomAccessMask
If wmiAce.AccessMask = FullAccessMask Then
AccessType = "Full Control"
FoundAccessMask = True
End If
If wmiAce.AccessMask = ModifyAccessMask Then
AccessType = "Modify"
FoundAccessMask = True
End If
If wmiAce.AccessMask = WriteAccessMask Then
AccessType = "Read/Write Control"
FoundAccessMask = True
End If
If wmiAce.AccessMask = ROAccessMask Then
AccessType = "Read Only"
FoundAccessMask = True
Else
CustomAccessMask = True
End If
Wend

If FoundAccessMask Then
fsOut.Writeline AccessType
Else
fsOut.Writeline "Custom"
End If

Next

Set fsOut = Nothing
Set fso = Nothing

Next

Set fsOut = Nothing
Set fso = Nothing
end sub 
</script>
</body>
</html>

 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Alexvb6
  • Question
Deprecation of VBScript + Classic ASP: How to Ask Microsoft to cancel their planned craziness
Replies
0
Views
75
Alexvb6
Alexvb6
lunter
  • Locked
  • Question
How to create vbArray+vbByte (8209) in *.vbs stript
Replies
0
Views
158
lunter
lunter
B
  • Locked
  • Question
MsgBox on alternate days
Replies
5
Views
451
strongm
strongm
Don Child
  • Locked
  • Question
Oracle connection works while debugging in VBSEdit, but not when run from the command line. 1
Replies
2
Views
170
Don Child
Don Child
EdScripts
  • Locked
  • Question
Using a Variable in the Run Method - I would sure like to be able to do this !
Replies
0
Views
134
EdScripts
EdScripts

Part and Inventory Search

Sponsor

Back
Top