KODA VBSCRİPT OLARAK ULAŞMAK İÇİN TIKLA
' Bilgisayarların USB portları ile Disket/CD kapatılması için yazılmıştır.
‘Bu bölümde aşağıda kullanıcılacak parametreler tanımlanmıştır.
Dim WshShell, RegKey, value, result, currentPC
Dim USBAcikSayisi
Dim CDAcikSayisi
Dim FLPAcikSayisi
' PC eklendikce aşağıdaki sayılar degistirilecek.Usb Cd ve Flp serisine birer
tanımlama ‘yapıldı.
‘Aşağıda Pclerin eklendiği bölümde sayılar değiştikce bu kısımda sayıların
değerleri ‘değiştirilmelidir.
USBAcikSayisi = 3
Dim USBAciklar(3)
CDAcikSayisi = 3
Dim CDAciklar(3)
FLPAcikSayisi =4
Dim FLPAciklar(4)
arrayDoldur
Set WshNet = WScript.CreateObject("WScript.Network")
currentPC = UCase(WshNet.ComputerName)
'MsgBox currentPC
' *********************
' USB islemleri
result = isUSBExist()
if result then
'msgbox "USB AÇ"
USB_Ac
else
'msgbox "USB KAPAT"
USB_Kapat
end if
'***********************
' CD islemleri
result = isCDExist()
if result then
'msgbox "CD Aç"
CD_Ac
else
'msgbox "CD Kapat"
CD_Kapat
end if
'**********************
' FLOPPY islemleri
result = isFLPExist()
if result then
'msgbox "FLOPPY Aç"
FLOPPY_Ac
else
'msgbox "FLOPPY Kapat"
FLOPPY_Kapat
end if
'**********
function isUSBExist()
Dim i, pc, found
found = False
i = 0
Do While (i < USBAcikSayisi) and (found <> True)
pc = UCase(USBAciklar(i))
if currentPC = pc then
found = True
end if
i = i + 1
Loop
if found then
isUSBExist = True
else
isUSBExist = False
end if
end function
'**********
function isCDExist()
Dim i, pc, found
found = False
i = 0
Do While (i < CDAcikSayisi) and (found <> True)
pc = UCase(CDAciklar(i))
if currentPC = pc then
found = True
end if
i = i + 1
Loop
if found then
isCDExist = True
else
isCDExist = False
end if
end function
'**********
function isFLPExist()
Dim i, pc, found
found = False
i = 0
Do While (i < FLPAcikSayisi) and (found <> True)
pc = UCase(FLPAciklar(i))
if currentPC = pc then
found = True
end if
i = i + 1
Loop
if found then
isFLPExist = True
else
isFLPExist = False
end if
end function
'*********************************************
‘Bu kısım Usb tanıma ve yazmaya karşı koruma modununda kaldırılmasını sağlar
sub USB_Ac()
Set WshShell = WScript.CreateObject("WScript.Shell")
RegKey = "HKLM\SYSTEM\CurrentControlSet\Services\USBSTOR\Start"
on error resume next
value = WshShell.RegRead(RegKey)
if err then
'msgBox "KEY YOK"
else
'msgBox "KEY " & value
WshShell.RegWrite RegKey, 3, "REG_DWORD"
end if
RegkeyXP = "HKLM\SYSTEM\CurrentControlSet\Control\StorageDevicePolicies\WriteProtect"
value = WshShell.RegRead(RegKeyXP)
if err then
'msgBox "KEY YOK"
else
'msgBox "KEY " & value
WshShell.RegWrite RegKeyXP, 0, "REG_DWORD"
end if
end sub
'*********************************************
‘Bu kısımda gerekli regisry degerini değiştirerek Açık olan Usb portlarını
kapatır.
sub USB_Kapat()
Set WshShell = WScript.CreateObject("WScript.Shell")
RegKey = "HKLM\SYSTEM\CurrentControlSet\Services\USBSTOR\Start"
on error resume next
value = WshShell.RegRead(RegKey)
if err then
'msgBox "KEY YOK"
WshShell.RegWrite RegKey, 4, "REG_DWORD"
else
'msgBox "KEY " & value
WshShell.RegWrite RegKey, 4, "REG_DWORD"
end if
end sub
'*********************************************
‘Cd nin olarak device tanınmasını için ve cd kullanımı saglamak için gerekli
registry ayarını ‘yapar.
sub CD_Ac()
Set WshShell = WScript.CreateObject("WScript.Shell")
RegKey = "HKLM\SYSTEM\CurrentControlSet\Services\Cdrom\Start"
on error resume next
value = WshShell.RegRead(RegKey)
if err then
'msgBox "KEY YOK"
else
'msgBox "KEY " & value
WshShell.RegWrite RegKey, 1, "REG_DWORD"
end if
end sub
'*********************************************
‘Cd nin device olarak tanınmamasını ve cd kullanımı yasaklamak için gerekli
registry ayarını ‘yapar.
sub CD_Kapat()
Set WshShell = WScript.CreateObject("WScript.Shell")
RegKey = "HKLM\SYSTEM\CurrentControlSet\Services\Cdrom\Start"
on error resume next
value = WshShell.RegRead(RegKey)
if err then
'msgBox "KEY YOK"
WshShell.RegWrite RegKey, 4, "REG_DWORD"
else
'msgBox "KEY " & value
WshShell.RegWrite RegKey, 4, "REG_DWORD"
end if
end sub
'*********************************************
‘Floppy nin device olarak tanınmasını ve kullanımı saglamak için gerekli
registry ayarını ‘yapar.
sub FLOPPY_Ac()
Set WshShell = WScript.CreateObject("WScript.Shell")
RegKey = "HKLM\SYSTEM\CurrentControlSet\Services\Flpydisk\Start"
on error resume next
value = WshShell.RegRead(RegKey)
if err then
'msgBox "KEY YOK"
else
'msgBox "KEY " & value
WshShell.RegWrite RegKey, 3, "REG_DWORD"
end if
RegkeyXP = "HKLM\SYSTEM\CurrentControlSet\Control\StorageDevicePolicies\WriteProtect"
value = WshShell.RegRead(RegKeyXP)
if err then
'msgBox "KEY YOK"
else
'msgBox "KEY " & value
WshShell.RegWrite RegKeyXP, 0, "REG_DWORD"
end if
end sub
'*********************************************
‘Floppy nin device olarak tanınmamasını ve kullanılmamasını saglamak için
gerekli registry ayarını ‘yapar.
sub FLOPPY_Kapat()
Set WshShell = WScript.CreateObject("WScript.Shell")
RegKey = "HKLM\SYSTEM\CurrentControlSet\Services\Flpydisk\Start"
on error resume next
value = WshShell.RegRead(RegKey)
if err then
'msgBox "KEY YOK"
WshShell.RegWrite RegKey, 4, "REG_DWORD"
else
'msgBox "KEY " & value
WshShell.RegWrite RegKey, 4, "REG_DWORD"
end if
end sub
'**********************************************
‘Bu Bölümde yukarda işleme girecek bilgisayarların isimlerinin girildigi
bölümdür.Ayrıca yanına açıklamada girilebilir.Örnegin Başkanın bilgisayarını adı
sistemde “PCTEST001” ‘olarak tanımlanmış ise bu bilgisayar kullanıcı logon
oldugu andan itibaren bu script çalışır ve ‘usb,cdrom ve floppy açılır.
sub arrayDoldur()
' USB Açık olacak bilgisayarlar
USBAciklar(1) = "PCTEST001" 'Başkan
USBAciklar(2) = "PCTEST001" 'Müdür
USBAciklar(3) = "PCTEST001" 'Amir
' CD açık olacak bilgisayarlar
CDAciklar(1) = "PCTEST001" 'Başkan
CDAciklar(2) = "PCTEST002" 'Müdür
CDAciklar(3) = "PCTEST003" 'Amir
'Disket açık olacak bilgisayarlar
FLPAciklar(1) = "PCTEST001" 'Başkan
FLPAciklar(2) = "PCTEST002" 'Müdür
FLPAciklar(3) = "PCTEST003" 'Amir
FLPAciklar(4) = "PCTEST004" ‘Osman YILDIZ
end sub