بانک اسکریپت پرشین نـتـورک

[kamelot]

rundll32.exe :
store user names and passwords(user accounts advance)

rundll32.exe keymgr.dll KRShowKeyMgr

[kamelot]

اینم چند موردی از کاربرد fsutil امیدوارم به دردتون بخوره:


تعیین quota واسه یه کاربر خاص با محدودیت x بایت و هشدار در y :

FSUTIL QUOTA MODIFY C: Y X DOMAIN\USER

اطلاعات راجع به drive NTFS :

FSUTIL FSINFO NTFSINFO C:

اطلاعات راجع به فضای volume ها:

FSUTIL VOLUME DISKFREE C:

[kamelot]

cacls c:\sharedfolder /T /C /G user1:R

با دستور CACLS میتوانید به user ها permission اعمال کنید
دستور بالا در پوشه sharedfolder به user1 دسترسی read اعمال میکند با سوییچ D/ میتوانید deny را اعمال کنید
موفق باشید

[kamelot]

mstsc.exe /v:192.168.1.1 /f

[kamelot]

TASKKILL /PID 1234 /T /F

با این دستور میتوانید اجرای یه process رو terminate کنید

PID:Process IDentifier*
/T:terminates child proccesses too
/F:forcefully terminate

[patris1]

این اسکریپت برای ساختن یوزر و دایرکتوری Profile و Home برای آن User ها میباشد.اطلاعات یوزر در فایل user.txt است.

به طور مثال دومین mafia.org است، نام دومین کنترلر DC1 است. درایو U مپ میشود . قبل از اجرای اسکریپت یک دایرکتوری به نام Data در سرور درست کنید و درون آن ۲ دایرکتوری به نامهای profile و home درست کرده و به everyone اجازیه دسترسی Full بدهید و یک OU به نام Test.
اول data.cmd را اجرا کنید و سپس CreateUser.vbs .

فکر کنم به این میگن اسکریپت اگر اشتباه نکنم!!

user.txt

logonname1,Firstname1,Lastname1,Password1
logonname2,Firstname2,Lastname2,Password2
logonname3,Firstname3,Lastname3,Password3
logonname4,Firstname4,Lastname4,Password4
logonname5,Firstname5,Lastname5,Password5
logonname6,Firstname6,Lastname6,Password6
logonname7,Firstname7,Lastname7,Password7
logonname8,Firstname8,Lastname8,Password8
logonname9,Firstname9,Lastname9,Password9

data.cmd

md \\DC1\data\home\%1
echo J | cacls \\DC1\data\home\%1 /C /E /G Administrators:F
echo J | cacls \\DC1\data\home\%1 /C /E /G Mafia.org\%1:F
echo J | cacls \\DC1\data\home\%1 /C /E /R User
md \\DC1\data\profile\%1
echo J | cacls \\DC1\data\profile\%1 /C /E /G Administrators:F
echo J | cacls \\DC1\data\profile\%1 /C /E /G Mafia.org\%1:F
echo J | cacls \\DC1\data\profile\%1 /C /E /R User

CreateUser.vbs

Dim fso, f, Zeile, Feld
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile ("user.txt",1,0)

Do while not f.AtEndOfLine
Zeile = f.readLine
Feld = split(Zeile,",")
User = Feld(0)
Firstname = Feld(1)
Lastname = Feld(2)
Password = Feld(3)
Call CreateUser(User,Firstname,Lastname,Password)
Loop
f.Close
Wscript.Quit(0)

Sub CreateUser(User,Firstname,Lastname,Password)
Dim ouo, b
Set ouo = GetObject("LDAP://OU=Test,DC=mafia,DC=org")
Set b = ouo.Create("user", "CN=" & Firstname & " " & Lastname)
Dim WshShell, ret
Set WshShell = WScript.CreateObject("WScript.Shell")
b.Put "sAMAccountName", User
b.Put "displayName", Firstname & " " & Lastname
b.Put "givenName", Firstname
b.Put "sn", Lastname
b.Put "userAccountControl", 66082
b.Put "pwdLastSet", 0
b.Put "userPrincipalName", User & "@mafia.org"
b.Put "profilePath", "\\DC1\data$\profile\" & User
b.Put "scriptPath", "login.bat"
b.Put "homeDirectory", "\\DC1\data$\home\" & User
b.Put "homeDrive", "U:"
b.SetInfo
b.SetPassword Password
b.AccountDisabled = False
b.SetInfo
WScript.Sleep(1000)
ret = WshShell.Run ("verz.cmd " & User,0,1)
End Sub

[kamelot]

Option Explicit
Dim objWMIService, objItem, colItems, strComputer

strComputer = "."

Set objWMIService = GetObject("winmgmts:\\" _
& strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk")

For Each objItem in colItems
Wscript.Echo _
"SystemName: " & objItem.SystemName & vbCr & _
"===============================" & vbCr & _
"Drive: " & vbTab & objItem.Name & vbCr & _
"DeviceID: " & objItem.DeviceID & vbCr & _
"VolumeName: " & objItem.VolumeName & vbCr & _
"DriveType: " & objItem.DriveType & vbCr & _
"Description: " & objItem.Description & vbCr & _
"FileSystem: " & objItem.FileSystem & vbCr & _
"FreeSpace: "& vbTab & objItem.FreeSpace & vbCr & _
"Size: " & vbTab & vbTab & objItem.Size & vbCr & _
""
Next
WScript.Quit

آره پاتریس جان به همون میگن..اگه جسارتی شده عذر میخوام

[Hakimi]

Delete Old computer accounts from AD

rem Delete Old computer accounts from AD
Dim OutPutFile
Dim FileSystem

Set FileSystem = WScript.CreateObject("Scripting.FileSystemObject")
Set OutPutFile = FileSystem.CreateTextFile("bad_comp_names.txt", True)

On Error Resume Next

DomainString=Inputbox("Enter the domain name","Check Active Computers","DomainName")

if DomainString="" then
wscript.echo "No domain specified or script cancelled."
wscript.quit
end if

numDays=InputBox("What is the number of days to use as a cutoff for" & _
"Active Computer Accounts?","Check Active Computers","XX")

if numDays="" then
wscript.echo "No cutoff date specified or script cancelled."
wscript.quit
end if

Set DomainObj = GetObject("WinNT://"&DomainString)

if err.number<>0 then
wscript.echo "Error connecting to " & DomainString
wscript.quit
end if

DomainObj.Filter = Array("computer")
Wscript.echo "Computer Accounts in " & DomainString & " older than " & numDays & " days"
For each Computer in DomainObj
    Set Account = GetObject("WinNT://" & DomainString & "/" & Computer.Name & "$")
    RefreshTime = FormatNumber((Account.get("PasswordAge"))/86400,0)
    If CInt(RefreshTime) >= CInt(numDays) Then
        'wscript.echo "**DELETE** " & Computer.Name & " Password Age is " & RefreshTime & " days."
        OutPutFile.WriteLine Computer.Name
        'Call DomainObj.Delete("Computer", Computer.Name)
    End If
Next


OutPutFile.Close
Set FileSystem = Nothing
Set oContainer = Nothing
set DomainObj=Nothing
set Shell=Nothing
Wscript.quit

[Hakimi]

Export Active Directory Users to Excel File

برای داشتن لیست همه کاربران موجود در Active Directory در یک فایل Excel، این اسکریپت را (در یک فایل .vbs قرار دهید) روی سیستمی که عضو دامین است و Excel هم روی آن نصب است اجرا کنید و نتیجه را مشاهده کنید.

' Get Active Directory User Lists
Dim ObjWb 
Dim ObjExcel 
Dim x, zz 
Set objRoot = GetObject("LDAP://RootDSE") 
strDNC = objRoot.Get("DefaultNamingContext") 
Set objDomain = GetObject("LDAP://" & strDNC) ' Bind to the top of the Domain using LDAP using ROotDSE 
Call ExcelSetup("Sheet1") ' Sub to make Excel Document 
x = 1 
Call enummembers(objDomain) 
Sub enumMembers(objDomain) 
On Error Resume Next 
Dim Secondary(20) ' Variable to store the Array of 2ndary email alias's 
For Each objMember In objDomain ' go through the collection 

If ObjMember.Class = "user" Then ' if not User object, move on. 
x = x +1 ' counter used to increment the cells in Excel 

  objwb.Cells(x, 1).Value = objMember.Class 
  ' I set AD properties to variables so if needed you could do Null checks or add if/then's to this code 
  ' this was done so the script could be modified easier. 
SamAccountName = ObjMember.samAccountName 
Cn = ObjMember.CN 
FirstName = objMember.GivenName 
LastName = objMember.sn 
initials = objMember.initials 
Descrip = objMember.description 
Office = objMember.physicalDeliveryOfficeName 
Telephone = objMember.telephonenumber 
EmailAddr = objMember.mail 
WebPage = objMember.wwwHomePage 
Addr1 = objMember.streetAddress 
City = objMember.l 
State = objMember.st 
ZipCode = objMember.postalCode 
Title = ObjMember.Title 
Department = objMember.Department 
Company = objMember.Company 
Manager = ObjMember.Manager 
Profile = objMember.profilePath 
LoginScript = objMember.scriptpath 
HomeDirectory = ObjMember.HomeDirectory 
HomeDrive = ObjMember.homeDrive 
AdsPath = Objmember.Adspath 
LastLogin = objMember.LastLogin 

zz = 1 ' Counter for array of 2ndary email addresses 
For each email in ObjMember.proxyAddresses 
   If Left (email,5) = "SMTP:" Then 
Primary = Mid (email,6) ' if SMTP is all caps, then it's the Primary 
   ElseIf Left (email,5) = "smtp:" Then 
      Secondary(zz) = Mid (email,6) ' load the list of 2ndary SMTP emails into Array. 
      zz = zz + 1 
   End If 
Next 
' Write the values to Excel, using the X counter to increment the rows. 

objwb.Cells(x, 2).Value = SamAccountName 
objwb.Cells(x, 3).Value = CN 
objwb.Cells(x, 4).Value = FirstName 
objwb.Cells(x, 5).Value = LastName 
objwb.Cells(x, 6).Value = Initials 
objwb.Cells(x, 7).Value = Descrip 
objwb.Cells(x, 8).Value = Office 
objwb.Cells(x, 9).Value = Telephone 
objwb.Cells(x, 10).Value = EmailAddr
objwb.Cells(x, 11).Value = WebPage 
objwb.Cells(x, 12).Value = Addr1 
objwb.Cells(x, 13).Value = City 
objwb.Cells(x, 14).Value = State 
objwb.Cells(x, 15).Value = ZipCode 
objwb.Cells(x, 16).Value = Title 
objwb.Cells(x, 17).Value = Department 
objwb.Cells(x, 18).Value = Company 
objwb.Cells(x, 19).Value = Manager 
objwb.Cells(x, 20).Value = Profile 
objwb.Cells(x, 21).Value = LoginScript 
objwb.Cells(x, 22).Value = HomeDirectory 
objwb.Cells(x, 23).Value = HomeDrive 
objwb.Cells(x, 24).Value = Adspath 
objwb.Cells(x, 25).Value = LastLogin 
objwb.Cells(x,26).Value = Primary 

' Write out the Array for the 2ndary email addresses. 
For ll = 1 To 20 
objwb.Cells(x,26+ll).Value = Secondary(ll) 
Next 
' Blank out Variables in case the next object doesn't have a value for the property 
SamAccountName = "-" 
Cn = "-" 
FirstName = "-" 
LastName = "-" 
initials = "-" 
Descrip = "-" 
Office = "-" 
Telephone = "-" 
EmailAddr = "-" 
WebPage = "-" 
Addr1 = "-" 
City = "-" 
State = "-" 
ZipCode = "-" 
Title = "-" 
Department = "-" 
Company = "-" 
Manager = "-" 
Profile = "-" 
LoginScript = "-" 
HomeDirectory = "-" 
HomeDrive = "-" 
Primary = "-" 
For ll = 1 To 20 
Secondary(ll) = "" 
Next 
  End If 
  
  ' If the AD enumeration runs into an OU object, call the Sub again to itinerate 
  
  If objMember.Class = "organizationalUnit" or OBjMember.Class = "container" Then 
      enumMembers (objMember) 
  End If 
Next 
End Sub 
Sub ExcelSetup(shtName) ' This sub creates an Excel worksheet and adds Column heads to the 1st row 
Set objExcel = CreateObject("Excel.Application") 
Set objwb = objExcel.Workbooks.Add 
Set objwb = objExcel.ActiveWorkbook.Worksheets(shtName) 
Objwb.Name = "Active Directory Users" ' name the sheet 
objwb.Activate 
objExcel.Visible = True 
objwb.Cells(1, 2).Value = "SamAccountName" 
objwb.Cells(1, 3).Value = "CN" 
objwb.Cells(1, 4).Value = "FirstName" 
objwb.Cells(1, 5).Value = "LastName" 
objwb.Cells(1, 6).Value = "Initials" 
objwb.Cells(1, 7).Value = "Descrip" 
objwb.Cells(1, 8).Value = "Office" 
objwb.Cells(1, 9).Value = "Telephone" 
objwb.Cells(1, 10).Value = "Email" 
objwb.Cells(1, 11).Value = "WebPage" 
objwb.Cells(1, 12).Value = "Addr1" 
objwb.Cells(1, 13).Value = "City" 
objwb.Cells(1, 14).Value = "State" 
objwb.Cells(1, 15).Value = "ZipCode" 
objwb.Cells(1, 16).Value = "Title" 
objwb.Cells(1, 17).Value = "Department" 
objwb.Cells(1, 18).Value = "Company" 
objwb.Cells(1, 19).Value = "Manager" 
objwb.Cells(1, 20).Value = "Profile" 
objwb.Cells(1, 21).Value = "LoginScript" 
objwb.Cells(1, 22).Value = "HomeDirectory" 
objwb.Cells(1, 23).Value = "HomeDrive" 
objwb.Cells(1, 24).Value = "Adspath" 
objwb.Cells(1, 25).Value = "LastLogin" 
objwb.Cells(1, 26).Value = "Primary SMTP" 
End Sub 
MsgBox "Done" ' show that script is complete 

[patris1]

بعد از دیدن پیغام Enter the computer name to be removed ، اسم Domain Controller خود را بنویسید و سپس Ok کنید.

Remove Active Directory Domain Controller Metadata

REM    ==========================================================
REM                GUI Metadata Cleanup Utility
REM             Written By Clay Perrine
REM                          Version 2.5
REM    ==========================================================
REM     This tool is furnished "AS IS". NO warranty is expressed or Implied.

on error resume next
dim objRoot,oDC,sPath,outval,oDCSelect,objConfiguration,objContainer,errval,ODCPath,ckdcPath,myObj,comparename

rem =======This gets the name of the computer that the script is run on ======

Set sh = CreateObject("WScript.Shell")
key= "HKEY_LOCAL_MACHINE"
computerName = sh.RegRead(key & "\SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName\ComputerName")

rem === Get the default naming context of the domain====

set objRoot=GetObject("LDAP://RootDSE")
sPath = "LDAP://OU=Domain Controllers," & objRoot.Get("defaultNamingContext")

rem === Get the list of domain controllers====

Set objConfiguration = GetObject(sPath)
For Each objContainer in objConfiguration
    outval = outval & vbtab &  objContainer.Name & VBCRLF
Next
outval = Replace(outval, "CN=", "")

rem ==Retrieve the name of the broken DC from the user and verify it's not this DC.===

oDCSelect= InputBox (outval," Enter the computer name to be removed","")
comparename = UCase(oDCSelect)

if comparename = computerName then
    msgbox "The Domain Controller you entered is the machine that is running this script." & vbcrlf & _
        "You cannot clean up the metadata for the machine that is running the script!",,"Metadata Cleanup Utility Error."
    wscript.quit
End If

sPath = "LDAP://OU=Domain Controllers," & objRoot.Get("defaultNamingContext")
Set objConfiguration = GetObject(sPath)

For Each objContainer in objConfiguration
    Err.Clear
    ckdcPath = "LDAP://" & "CN=" & oDCSelect & ",OU=Domain Controllers," & objRoot.Get("defaultNamingContext")
    set myObj=GetObject(ckdcPath)
    If err.number <>0 Then
        errval= 1
    End If
Next

If errval = 1 then
    msgbox "The Domain Controller you entered was not found in the Active Directory",,"Metadata Cleanup Utility Error."
    wscript.quit
End If

abort = msgbox ("You are about to remove all metadata for the server " & oDCSelect & "! Are you sure?",4404,"WARNING!!")
if abort <> 6 then
    msgbox "Metadata Cleanup Aborted.",,"Metadata Cleanup Utility Error."
    wscript.quit
end if

oDCSelect = "CN=" & oDCSelect
ODCPath ="LDAP://" & oDCselect & ",OU=Domain Controllers," & objRoot.Get("defaultNamingContext")
sSitelist = "LDAP://CN=Sites,CN=Configuration," & objRoot.Get("defaultNamingContext")
Set objConfiguration = GetObject(sSitelist)
For Each objContainer in objConfiguration
    Err.Clear
    sitePath = "LDAP://" & oDCSelect & ",CN=Servers," &  objContainer.Name & ",CN=Sites,CN=Configuration," & _
        objRoot.Get("defaultNamingContext")
    set myObj=GetObject(sitePath)
    If err.number = 0 Then
        siteval = sitePath
    End If    
Next

sFRSSysvolList = "LDAP://CN=Domain System Volume (SYSVOL share),CN=File Replication Service,CN=System," & _
    objRoot.Get("defaultNamingContext")
Set objConfiguration = GetObject(sFRSSysvolList)

For Each objContainer in objConfiguration
    Err.Clear
    SYSVOLPath = "LDAP://" & oDCSelect & ",CN=Domain System Volume (SYSVOL share),CN=File Replication Service,CN=System," & _
        objRoot.Get("defaultNamingContext")
    set myObj=GetObject(SYSVOLPath)
    If err.number = 0 Then
        SYSVOLval = SYSVOLPath
    End If
Next

SiteList = Replace(sSitelist, "LDAP://", "")
VarSitelist = "LDAP://CN=Sites,CN=Configuration," & objRoot.Get("defaultNamingContext")
Set SiteConfiguration = GetObject(VarSitelist)

For Each SiteContainer in SiteConfiguration
    Sitevar = SiteContainer.Name
    VarPath ="LDAP://OU=Domain Controllers," & objRoot.Get("defaultNamingContext")
    Set DCConfiguration = GetObject(VarPath)
    For Each DomContainer in DCConfiguration
        DCVar = DomContainer.Name
        strFromServer = ""
        NTDSPATH =  DCVar & ",CN=Servers," & SiteVar & "," & SiteList
        GuidPath = "LDAP://CN=NTDS Settings,"& NTDSPATH 
        Set objCheck = GetObject(NTDSPATH)
        For Each CheckContainer in objCheck
rem ====check for valid site paths =======================
            ldapntdspath = "LDAP://" & NTDSPATH
            Err.Clear
            set exists=GetObject(ldapntdspath)
            If err.number = 0 Then
                Set oGuidGet = GetObject(GuidPath)
                For Each objContainer in oGuidGet
                    oGuid = objContainer.Name
                    oGuidPath = "LDAP://" & oGuid & ",CN=NTDS Settings," & NTDSPATH  
                    Set objSitelink = GetObject(oGuidPath)
                    objSiteLink.GetInfo
                    strFromServer = objSiteLink.Get("fromServer")
                    ispresent = Instr(1,strFromServer,oDCSelect,1)

                    if ispresent <> 0 then
                        Set objReplLinkVal = GetObject(oGuidPath)
                        objReplLinkVal.DeleteObject(0)
                    end if
                next

                sitedelval = "CN=" & comparename & ",CN=Servers," & SiteVar & "," & SiteList
                if sitedelval = ntdspath then
                    Set objguidpath = GetObject(guidpath)
                    objguidpath.DeleteObject(0)
                    Set objntdspath = GetObject(ldapntdspath)
                    objntdspath.DeleteObject(0)
                end if
            End If
        next
    next
next
Set AccountObject = GetObject(ckdcPath)
temp=Accountobject.Get ("userAccountControl")
AccountObject.Put "userAccountControl", "4096"
AccountObject.SetInfo
Set objFRSSysvol = GetObject(SYSVOLval)
objFRSSysvol.DeleteObject(0)
Set objComputer = GetObject(ckdcPath)
objComputer.DeleteObject(0)
Set objConfig = GetObject(siteval)
objConfig.DeleteObject(0)
oDCSelect = Replace(oDCSelect, "CN=", "")
msgval = "Metadata Cleanup Completed for " & oDCSelect
msgbox  msgval,,"Notice."
wscript.quit

[mahyar49]

سلام
بابت تاخیر عذر خواهی می کنم و از دوستانی که اسکریپت گذاشتن تشکر می کنم
----------------------------

اسکریپت کپی کردن یک یا چند فایل روی دسکتاپ یوزر...

من می خوام یک فایل تکست یا یه عکس یا... روی دسکتاپ 200 تا یوزر بذارم
میام فایل رو توی یه درایو Share کپی می کنم و اسکریپتش رو ست می کنم تا کاربر لاگین کرد اتوماتیک فایل کپی بشه...

برای اینکار متن زیر رو کپی و در یک فایل bat ذخیره کنید.

 
copy \\server\e\test.rar "%userprofile%\desktop"

بجای server اسم کامپیوتر...
بجای e درایوی که فایل رو کپی کردید
و بجای test.rar نام فایل و پسوند فایلی را که می خواهید کپی بشه

چندتا فایل همزمان هم میشه و باید یه خط دیگه بنویسید...

[hamid khan]

با سلام
جهت شرکت در این بانک بنده هم به نوبه خود سعی کردم نمونه ای ارسال کنم
امیدوارم که برای دوستان کارگر افتد :

1-از این اسکریپت برای ایجاد کاربر جدید در Active Directory استفاده میشود .
بجای عبارت Hamid نام کاربر خود را بنویسید .

 
VBScript
Set objOU = GetObject("ldap://OU=management,dc=fabrikam,dc=com")
Set objUser = objOU.Create("User", "cn=MyerKen")
objUser.Put "sAMAccountName", "Hamid"
objUser.SetInfo

2-از این اسکریپت برای ایجاد کاربر جدید (به همراه تخصیص گروه کاربری و واحد سازمانی)در Active Directory استفاده میشود .

 
VBScript
Set objDomain = GetObject("ldap://dc=fabrikam,dc=com")
Set objOU = objDomain.Create("organizationalUnit", "ou=Management")
objOU.SetInfo
Set objOU = GetObject("ldap://OU=Management,dc=fabrikam,dc=com")
Set objUser = objOU.Create("User", "cn= AckermanPilar")
objUser.Put "sAMAccountName", "AckermanPila"
objUser.SetInfo
Set objOU = GetObject("ldap://OU=Management,dc=fabrikam,dc=com")
Set objGroup = objOU.Create("Group", "cn=atl-users")
objGroup.Put "sAMAccountName", "atl-users"
objGroup.SetInfo
objGroup.Add objUser.ADSPath

3-از این اسکریپت برای حذف یک کاربر از Active Directory استفاده میشود .
بجای عبارت Hamid نام کاربر خود را بنویسید .

 
 VBScript
Set objOU = GetObject("ldap://ou=hr,dc=fabrikam,dc=com")
objOU.Delete "user", "cn=Hamid"

[hamid khan]

با سلام مجدد
این هم برای تکمیل گروه فوق :

1- برای تعیین کلمه عبور برای یک کاربر در Active Directory از اسکریپت زیر استفاده میکنیم :

 
VBScript
Set objUser = GetObject _
    ("ldap://cn=MyerKen,ou=management,dc=fabrikam,dc=com")
objUser.SetPassword "MyPassword"
"

2- برای تغییر کلمه عبور یک کاربر در Active Directory از اسکریپت زیر استفاده میکنیم :

 
VBScript
Set objUser = GetObject _
    ("ldap://cn=myerken,ou=management,dc=fabrikam,dc=com")
objUser.ChangePassword "Password1", "Password2"

[patris1]

پاک کردن فولدرهای خالی در درایو C

' =============================================================================

' This script deletes all empty folders in the C: drive

' By Walter Touceda

' =============================================================================

On Error Resume Next

Set objFSO = CreateObject("Scripting.FileSystemObject")

i = 0

' *** Ask for full path

Do While i = 0

    strAnswer = InputBox _

        ("Please enter the path to delete ONLY empty folders (e.g.: C:\temp or \\RemotePC\c$\temp)","Delete Empty Folders")

    If strAnswer = "" Then

        MsgBox "You must enter a path. Press OK to finish"

 Wscript.quit

    Else

 If objFSO.FolderExists(strAnswer) Then

         Exit Do

 Else

  MsgBox "This folder does not exist: " & strAnswer

 End If

    End If

Loop



' *** Double check that this is the right path

intAnswer = Msgbox("Do you want to delete ONLY empty folders in " & strAnswer & " ?", _

        vbYesNo, "Delete ONLY Empty Folders")

If intAnswer = vbYes Then

    ' *** Run the Script

Else

    Wscript.quit

End If

Dim arrFolders()

FindSubfolders FSO.GetFolder(strAnswer)

Sub FindSubfolders(Folder)

    For Each Subfolder in Folder.SubFolders

 If SubFolder.Size = 0 Then

  ' *** Expand array as necesary and add paths to delete

  Redim Preserve arrFolders(i)

  arrFolders(i) = SubFolder.Path

  i = i + 1

' Show Empty Folder?

' Wscript.Echo "This folder is empty: " & SubFolder.Path

 End If

 Wscript.StdOut.Write(".")

        FindSubfolders Subfolder

    Next

End Sub

' *** Last chance before deleting folders

x=i

If x = 0 then

 MsgBox "No EMPTY folders found"

Else

 intAnswer = Msgbox("Do you REALLY want to delete " & x & " EMPTY folders?", _

         vbYesNo, "Delete ONLY Empty Folders")

 If intAnswer = vbYes Then

     ' Run the Script

  For i = 0 to x

          Wscript.Echo "Deleting Empty Folder: " & arrFolders(i)

   FSO.DeleteFolder(arrFolders(i))

  Next

 Else

     Wscript.quit

 End If

End If

' *** Clean memory and quit

Set FSO = Nothing

Set i =  Nothing

Set x = Nothing

Set intAnswer = Nothing

Set arrFolders() = Nothing

Wscript.Quit

[mmj]

با تشکر از عزیزانی که تا کنون اسکریپت های خود را قرار داده اند.

اضافه کردن یک برنامه به قسمت Exception در فایروال ویندوز

Set oFirewall = CreateObject("HNetCfg.FwMgr")
Set oPolicy = oFirewall.LocalPolicy.CurrentProfile
Set oApplication = CreateObject("HNetCfg.FwAuthorizedApplication")
oApplication.Name = "Notepad"
oApplication.IPVersion = 2
oApplication.ProcessImageFileName = "c:\winnt\system32\notepad.exe"
oApplication.RemoteAddresses = "*"
oApplication.Scope = 0
oApplication.Enabled = True
Set cApplications = oPolicy.AuthorizedApplications
cApplications.Add(oApplication)