الاخوة الاعزاء مدراء الشبكات

اسهاما مني في علو شأن هدا المنتدى العظيم و الذي لطالما افادنا و امدنا بالمعلومات و الاصدقاء الخيرين كذلك ... فقد أحببت مشاركة اخواني بهدا السكربت و الدي قمت بكتابته لمعالجة مشكلة لطالما عانيت معها مع المستخدمين ... تكمن وظيفة السكربت بحساب كمية الداونلللود من قبل المستخدمين و من ثم تنبيه المستخدم عن طريق الايميل ادا زادت كمية الداونللود عنده عن الحد المسموح ...اترككم مع السكربت و في حالة وجود اي استفسار فانا حاااضر


'**********
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objFolder = objFSO.GetFolder("C:\Program Files\Microsoft ISA Server\ISALogs\") ' ISA log file location

Dim strSMTP,strFROM,strRCPT,strRCPTCC,EmailBody,xArray

strSMTP = "Exchange server name"
strFROM = "Alerts_ISA@yourdomain.com"
strRCPTCC = "administrator@yourdomain.com"
'Email object Initializing
Set objEmail = CreateObject("CDO.Message")
objEmail.From = strFROM
objEmail.CC = strRCPTCC
objEmail.Configuration.Fields.Item _
("https://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item _
("https://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTP
objEmail.Configuration.Fields.Item _
("https://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

Subnet = "192.168.1" ' Your NW subnet , I used 192.168.1 incase the subnet was 255.255.255.0
emailPost_Fix = "@yourdomain.com" ' your users email post-fix
xMax = 35 ' Threshold value in MB


Set objFiles = objFolder.Files
For Each fileName In objFiles
Set file = objFSO.GetFile(fileName)
If file.DateCreated <= Date Then
lastFile = fileName
End If
Next


Set objFile = objFSO.OpenTextFile(lastFile, 1) ' 1 stands for ReadingOnly

objFile.Readline
Do Until objFile.AtEndOfStream
strcharacters = objFile.readline
xArray = split(strcharacters," ",-1) ' -1 indicates that all substrings are returned.
If Mid(Trim(xArray(0)),1,1) <> "-" AND Mid(Trim(xArray(0)),1,7) = Subnet Then ' Exclude The Active Cache
clientName = trim(xArray(1)) 'cs-username
If Trim(xArray(12)) <> "-" Then ' to exclude the sending case
cs_bytes = CLng(xArray(12)) 'sc-bytes
If objDictionary.Exists(clientName) Then
objDictionary.Item(clientName) = cStr(Clng(objDictionary.Item(clientName)) + cs_bytes)
Else
objDictionary.Add clientName,CStr(cs_bytes)
End If
End If
End If
Loop

Set file = objFSO.GetFile(lastFile)
For Each xClient in objDictionary.Keys
If Clng(objDictionary.Item(xClient))/1024/1024 > xMax then
strRCPT = Mid(xClient,11) & emailPost_Fix ' Mid(xClient,11) to remove the NETBIOS name of the domain DOMAINNAM\username ---> username
objEmail.To = strRCPT
If Mid(xClient,11) <> "administrator" AND xClient<> "anonymous" Then
EmailBody = vbCrLf
EmailBody = EmailBody & "**********************************"& vbcrlf
EmailBody = EmailBody & "* WARNING *"& vbcrlf
EmailBody = EmailBody & "**********************************"& vbcrlf
objEmail.Subject = "Internet usage overlimit, "& Date
EmailBody = EmailBody & "Dear " & Mid(xClient,11) & " , " & vbcrlf & vbCrLf
EmailBody = EmailBody & " This is an Auto Generated Message so pls. don't reply to the source address" & vbcrlf & vbcrlf
EmailBody = EmailBody & "Kindly note that your download in date " & Day(file.DateCreated) &"/"& Month(file.DateCreated) &"/"& Year(file.DateCreated) &" exceeded the limit and was " & CLng(objDictionary.Item(xClient))/1024/1024 & " MB , pls. be carefull next time to not effect the others users " & vbcrlf & vbcrlf & " Thanks for cooperation with us. " & vbcrlf & vbCrLf
EmailBody = EmailBody & vbcrlf & vbcrlf & vbcrlf & "**********************************"& vbcrlf & vbcrlf
objEmail.Textbody = EmailBody
objEmail.Configuration.Fields.Update
objEmail.Send
End If
End If
Next

Set objFSO = Nothing
Set objDictionary = Nothing
Set objEmail = Nothing
طبعا اخواني الاعزاء لتنفيده عليك بعمل scheduled task لتنفيد السكربت متلا كل يوم عند الساعة 2 صباحا " للعمل على تقرير اليوم السابق "في حالة كان الايزا يقوم بانشاء التقرير الجديدالخاص به لليوم الجديد عند الساعة 3 صباحا .... اتمنى بان الفكرة واضحة للجميع و حياكم الله في اي سؤال طبعا اللغة المستخدمة هي VBscript لفهم الكود بشكل افضل قم بنسخه من هنا ولصقه على النوتباد او الوورد لتحصل عليه منسقا