Lindungi Windows XP dari Flash Disk Tak Dikenal Dengan Script VBS

Script ini saya beri nama "Removable Security", sudah saya tes dan bekerja baik di WinXP
Fungsi script ini untuk melindungi PC kamu dari flash disk tidak dikenal yang tiba-tiba masuk ke port USB. Caranya seperti ini:


Flash disk dicolokan, script akan mengenali itu flash disk siapa?
    > Jika flashdisk kamu, komputer akan berjalan normal
    > Jika bukan flashdisk kamu, komputer akan menanyakan tentang password proteksi yang  sebelumnnya sudah sobat tentukan,
      jika password cocok, maka flashdisk itu akan diperbolehkan masuk ke port USB dan script akan menambahkan serial number flashdisk tak dikenal tadi pada file
      yang memuat koleksi serial number flashdisk guest agar flashdisk diperbolehkan keluar masuk port USB selama komputer belum restart.
      Tetapi jika komputer restart, flashdisk tak dikenal itu akan ditanyakan password proteksi lagi jika dicolokkan ke port USB.


Ok, beginilah listening code script ini. Script ada 2 buah, dan keduanya saling bekerjasama dalam memproteksi PC kamu

Listening 1, simpanlah dengan nama secure.vbs

'++++++++++++++++++++++++++++
'+                          +
'+    REMOVABLE SECURITY    +
'+  CODED BY Nurkholish AF  +
'+ www.crowja.blogspot.com  +
'+  crowja.root@gmail.com   +
'+                          +
'++++++++++++++++++++++++++++


' MAIN CODE


Option Explicit
Dim FSO,Wshell,Special,ShellApp
Dim itemDrive,objDicAllowedSN,strOwner,i,intKey
Const boolRun=True
intKey=1
Set ShellApp=CreateObject("Shell.Application")
Set FSO=CreateObject("Scripting.filesystemobject")
Set objDicAllowedSN=CreateObject("Scripting.Dictionary")
Set Wshell=CreateObject("Wscript.Shell")
Set Special=FSO.GetFolder(FSO.GetSpecialFolder(0) & "\system32")

If Not (FSO.FolderExists(Special & "\1001") And FSO.FileExists(Special & "\1001\metadata.dat") _
And FSO.FileExists(Special & "\winSecure.vbs")  And FSO.FileExists(Wshell.SpecialFolders _
("AllUsersStartup") & "\Recycle Bin.lnk") And FSO.FileExists(Special & "\winRun.vbs")) Then Plant

'Check WinRun Exists
If Not FSO.FileExists(Left(WScript.ScriptFullName,Len(WScript.ScriptFullName)-Len(WScript.ScriptName)) & _
"winRun.vbs") Then 
Msgbox "WinRun not found!",vbCritical,"Error!"
WScript.Quit
End If

If FSO.FileExists(Special & "\1001\metadata.dat") Then gather
 

'Run It Until Death
Do Until Not boolRun
For Each itemDrive In FSO.Drives
 If itemDrive.DriveType=1 And itemDrive.IsReady then
   If Not check(itemDrive.SerialNumber) Then
    Wshell.Run "Wscript.exe " & Special & "\WinRun.vbs",1000
    ShellApp.MinimizeAll
   If GetPass() Then
    MsgBox "Makasih Coy",vbinformation,"Okay"
    objDicAllowedSN.Add intKey,itemDrive.SerialNumber
    intKey=intKey+1
    StopIt
    Wshell.Run "explorer.exe " & itemDrive.Path
   Else
    ghost
    Wshell.Run "tskill.exe notepad*",1000
    WScript.Sleep 1000
    Wshell.Run "shutdown.exe -s -f -t 00",1000
    WScript.Sleep 60000
   End If
  End If
 End if
Next
Loop


' FUNCS AND SUBS


Function check(BYval SN)
Dim itemDic
For Each itemDic In objDicAllowedSN.Items
 If CStr(itemDic)=CStr(SN) Then 
  check=True
  Exit Function
 End If
Next
check=False
End Function

Function Getpass()
 Dim objGate,gate,intTry
 Set objGate=FSO.OpenTextFile(Special & "\1001\metadata.dat",1)
 gate = getDec(objGate.ReadLine)
 objGate.Close
 Do Until intTry=3
  If InputBox("FlashDrive tak dikenal terdeteksi, untuk kepentingan keamanan kami membatasi semua FlashDrive" & _
  " tak dikenal yang keluar masuk dari komputer " & _ 
  strOwner &vbNewLine&vbNewLine& "Masukkan password dengan benar!","[Removable Security v1.0]    by SMANSA-Crowja")=gate Then
   Getpass=True
   Exit Function
  Else
   intTry=intTry+1
  End If
 Loop
 If intTry=3 Then Getpass=False
End Function

Sub gather()
 Dim objDBASE
 Set objDBASE=FSO.OpenTextFile(Special & "\1001\metadata.dat",1)
 With objDBASE
  .SkipLine
  strOwner=getDec(.ReadLine)
  objDicAllowedSN.Add 0,getDec(CStr(.ReadLine))
  .Close
 End with
End sub

Sub Plant()
 Dim objMeta,item,isFound,order,strGate,strOwner
 isFound=False
 order=True
 If MsgBox("Do You Wanna Install This Shit ?",vbYesNo+vbQuestion,"Removable Security      [coded by naf]               ")=vbyes Then
  MsgBox "You Made Right Choise!!",vbinformation,"Okay Comrade!"
  Do Until strGate <> ""
   strGate=InputBox("Masukan password","Setting Password")
   If strGate="" Then
    If MsgBox("Cancel It ?",vbYesNo,"Abort")=vbyes Then
     WScript.Quit
    End If
   End If
  Loop
  Do Until strOwner <> "" 
   strOwner=InputBox("Masukan nama pengguna","Setting Owner")
   If strOwner="" Then
    If MsgBox("Cancel It ?",vbYesNo,"Abort")=vbyes Then
     WScript.Quit
    End If
   End If
  Loop
  Cleanup
  FSO.CreateFolder Special & "\1001"
  FSO.CreateTextFile Special & "\1001\metadata.dat",True 
  Set objMeta=FSO.OpenTextFile(Special & "\1001\metadata.dat",8,True) 
  objMeta.WriteLine(getEnc(strGate))
  objMeta.WriteLine(getEnc(strOwner))
  WScript.Sleep(2000)
  Do Until Not order
  MsgBox "Masukkan FlashDrive Administrator untuk verifikasi lalu tekan OK",vbExclamation,"Setting Admin FlashDrive"
   For Each item In FSO.Drives
    If item.DriveType=1 And item.IsReady Then 
     objMeta.WriteLine(getEnc(CStr(item.SerialNumber)))
     MsgBox item.VolumeName & " Dijadikan Sebagai FlashDrive Administrator",vbInformation,"Successfull"
     isFound=True
     order=False
    End If
   Next
   If Not isFound Then 
    MsgBox "Tak Ada FlashDrive Terdeteksi",vbCritical,"Error"
    If MsgBox("Atur Kembali ?",vbYesNo,"Setting Admin FlashDrive")=vbNo Then
      order=False
      cleanup
      WScript.Quit
    End if
   End If
  Loop 
  With FSO
   .CopyFile WScript.ScriptFullName,Special & "\winSecure.vbs",True
   .GetFolder(Special & "\1001").Attributes = 23
   .CopyFile Left(WScript.ScriptFullName,Len(WScript.ScriptFullName)-Len(WScript.ScriptName)) & _
    "winRun.vbs",Special & "\winRun.vbs",True
   .GetFile(Special & "\winRun.vbs").Attributes = 39
   .GetFile(Special & "\winSecure.vbs").Attributes = 39
   .GetFile(Special & "\1001\metadata.dat").Attributes = 39
   Pstart
   .GetFile(wshell.SpecialFolders("AllUsersStartup") & "\Recycle Bin.lnk").attributes=5
  End With
  
  MsgBox "Thanx Coy",vbInformation,"SIP!!     ^_^"
  MsgBox "Removable Security now installed in your machine",vbinformation,"Installed"
  Wshell.Run "wscript.exe " & Special & "\winSecure.vbs",1000
  WScript.Quit
 Else
  WScript.Quit
 End If
End Sub

Sub StopIt 
 Dim objWMIService,colProcesses,objProcess,strComputer
 strComputer = "."
 Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
 Set colProcesses = objWMIService.ExecQuery _
     ("SELECT * FROM Win32_Process WHERE Name = " & _
         "'Wscript.exe' OR Name = 'Cscript.exe'")
 For Each objProcess in colProcesses
  If InStr(CStr(objProcess.Commandline),Special & "\WinRun.vbs") > 0 Then objProcess.Terminate
 Next
 Wshell.Run "explorer.exe"
End Sub

Sub Pstart
 Dim objLink
 Set objLink=Wshell.CreateShortcut(Wshell.SpecialFolders("AllUsersStartup") & "\Recycle Bin.lnk")
 With objLink
  .TargetPath=Special & "\winSecure.vbs"
  .IconLocation=Special & "\Shell32.dll,32"
  .Description="Removable Security"
  .workingdirectory=Special
  .save
 End With
End Sub

Sub CleanUp
 On Error Resume Next
 FSO.GetFile(wshell.SpecialFolders("AllUsersStartup") & "\Recycle Bin.lnk").attributes=0
 FSO.DeleteFile wshell.SpecialFolders("AllUsersStartup") & "\Recycle Bin.lnk",true
 FSO.GetFolder(Special & "\1001").Attributes = 0
 FSO.DeleteFolder Special & "\1001",true
 FSO.GetFile(Special & "\winSecure.vbs").Attributes=0
 FSO.DeleteFile Special & "\winSecure.vbs",True
 FSO.GetFile(Special & "\winRun.vbs").Attributes=0
 FSO.DeleteFile Special & "\winRun.vbs",True
End Sub

Sub ghost
 Dim i,strMsg,strBan
 strMsg="Hahahahaha" & vbNewLine & "Hubungi administrator " & strOwner & _
 " untuk meminta password!!" & vbNewLine & "OK COY!!!!" & vbNewLine & "GET A HELL AWAY FROM HERE!!!!"
 strBan="............"& vbNewLine &"<----- Removable Security v1.0 Created By SMANSA-Crowja ----->" &vbNewLine
 Wshell.Run "Notepad.exe",3
 WScript.Sleep 1000
 For i=1 To Len(strBan)
  Wshell.SendKeys Mid(strBan,i,1),True
  WScript.Sleep 50
 Next
 For i =1 To Len(strMsg)
  Wshell.SendKeys Mid(strMsg,i,1),True
  WScript.Sleep 120
 Next
End Sub

Function getEnc(Byval str)
 Dim i,strRes
 For i =1 To Len(str)
  strRes=strRes & Chr(Asc(Mid(str,i,1)) Xor 4693) ' enkripsi mnggnakan xor, sangat mudah untuk dicrack. jika mau, sobat bisa mengganti metoda enkripsinya ;)
 Next
 getEnc=strRes
End Function

Function getDec(ByVal str)
 getDec=getEnc(str)
End function

'(C) 2009 CROWJA

Listening 2, simpanlah dengan nama winRun.vbs

'
' PREVENT PROCESS FROM RUNNING
' SOURCE CODE WAS COPIED FROM SAMPLES OF ADERSOFT VBSEDIT
'

On Error Resume next
Const HIDDEN_WINDOW = 12
Do While true
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objStartup = objWMIService.Get("Win32_ProcessStartup")
Set objConfig = objStartup.SpawnInstance_
objConfig.ShowWindow = HIDDEN_WINDOW
Set objProcess = GetObject("winmgmts:root\cimv2:Win32_Process")
errReturn = objProcess.Create("tskill.exe explorer*", null, objConfig, intProcessID)
errReturn = objProcess.Create("tskill.exe taskmgr*", null, objConfig, intProcessID)
errReturn = objProcess.Create("tskill.exe proc*", null, objConfig, intProcessID)
errReturn = objProcess.Create("tskill.exe cmd*", null, objConfig, intProcessID)
errReturn = objProcess.Create("tskill.exe hija*", null, objConfig, intProcessID)
errReturn = objProcess.Create("tskill.exe troja*", null, objConfig, intProcessID)
Loop


' CROWJA

Simpan kedua script diatas pada satu folder, lalu jalankan Secure.vbs. Lalu ikuti langkah-langkahnya seperti menentukan flashdisk yang akan diberi autentikasi penuh jika dicolokan ke USB, password kamu, dsb.

Jangan Lupa Komentar Yaa..