[VBS] Mengenkripsi FIle Script VBS Dengan VBS Obfuscator

Fungsinya adalah mengenkripsi file script vbs, jadi jika sobat punya script vbs dan sobat tidak ingin ada orang yang mengetahui algoritma script nya, sobat bisa menggunakan script ini untuk menenkripsi script sobat.Berikut adalah pseudo code nya:

1. Baca file dan byte file satu persatu.
2. Ubah satu persatu byte tersebut ke karakter ASCII.
3. Kurangkan 1 jika ASCII berjenis ganjil atau Tambahkan 1 jika ASCII berjenis genap.
4. Jika hasil dari ASCII berkode 34 (") ubah ke karakter ASCII 253 (ý).
5. Jika hasil dari ASCII berkode 10 (
) ubah ke karakter ASCII 251 (û).
6. Masukan ke variabel buffer untuk disimpan dan hapus variabel yang
    menampung karakter terbatas untuk mengumpulkan variabel lagi.
7. Tulis file yang berisi karakter pada variabel buffer.
8. Lakukan perintah No.1 hingga panjang byte pada file.
9. Tulis sisa karakter pada variabel yang tidak dibuffer.
10. Tulis skrip dekriptor untuk obfuscated code-nya.
11. Selesai.

Sobat bebas menggunakannya entah untuk menenkripsi script worm sobat atau sebagainya. Tertarik? code listening script nya ada dibawah.

'Created and Coded by RizonBarns
'Original Source code, http://www.indo-code.com/
'License: Open Source
'MyHomepage, http://inzerno56.blogspot.com/ or http://system56.blogspot.com/
'Copyright (C) 2004-2010 Wirko Program. License Open Source.

Option Explicit

Call Main
Sub Main()
 Dim FSO, CD
 Set FSO = CreateObject("Scripting.FileSystemObject")
 Set CD = CreateObject("UserAccounts.CommonDialog")
 With CD
  .Filter = "VBScript File (*.vbs)|*.vbs|All Files (*.*)|*.*"
  .ShowOpen
 End With
 If (FSO.FileExists(CD.FileName) = True) Then
  Obfuscate CD.FileName
 End If
End Sub

Function Obfuscate(File)
 Dim FSO, OTF, BackUpFile, ReadFile, CTF, x, Ac, Ch, Jn, Buff
 Set FSO = CreateObject("Scripting.FileSystemObject")
 If (FSO.FileExists(File) = True) Then
  BackUpFile = Mid(File, 1, InStr(File, ".")) & "tmp"
  Set OTF = FSO.OpenTextFile(File)
  ReadFile = OTF.ReadAll
  Set CTF = FSO.CreateTextFile(BackUpFile)
  CTF.WriteLine "Option Explicit" & vbCrLf
  CTF.Write "Execute StrDecrypt(" & Chr(34)
  For x = 1 To Len(ReadFile)
   Ac = Asc(Mid(ReadFile, x, 1))
   Select Case Ac Mod 2
    Case 0:
     Ac = (Ac + 1)
     Ch = Chr(Ac)
    Case 1:
     Ac = (Ac - 1)
     If (Ac = 34) Then
      Ac = 253
     ElseIf (Ac = 10) Then
      Ac = 251
     End If
     Ch = Chr(Ac)
   End Select
   Jn = Jn & Ch
   If (Len(Jn) = 20) Then
    Buff = Jn
    CTF.Write Buff
    Jn = ""
   End If
  Next
  CTF.Write Jn
  CTF.WriteLine Chr(34) & ")" & vbCrLf
  CTF.WriteLine "Function StrDecrypt(Code2Decrypt)"
  CTF.WriteLine String(1, 9) & "Dim x, Ac, Ch, Jn, Buff"
  CTF.WriteLine String(1, 9) & "For x = 1 To Len(Code2Decrypt)"
  CTF.WriteLine String(2, 9) & "Ac = Asc(Mid(Code2Decrypt, x, 1))"
  CTF.WriteLine String(2, 9) & "Select Case Ac Mod 2"
  CTF.WriteLine String(3, 9) & "Case 0:"
  CTF.WriteLine String(4, 9) & "Ac = Ac + 1"
  CTF.WriteLine String(4, 9) & "Ch = Chr(Ac)"
  CTF.WriteLine String(3, 9) & "Case 1:"
  CTF.WriteLine String(4, 9) & "Ac = Ac - 1"
  CTF.WriteLine String(4, 9) & "If (Ac = 253) Then"
  CTF.WriteLine String(5, 9) & "Ac = 34"
  CTF.WriteLine String(4, 9) & "ElseIf (Ac = 251) Then"
  CTF.WriteLine String(5, 9) & "Ac = 10"
  CTF.WriteLine String(4, 9) & "End If"
  CTF.WriteLine String(4, 9) & "Ch = Chr(Ac)"
  CTF.WriteLine String(2, 9) & "End Select"
  CTF.WriteLine String(2, 9) & "Jn = Jn & Ch"
  CTF.WriteLine String(2, 9) & "If (Len(Jn) = 20) Then"
  CTF.WriteLine String(3, 9) & "Buff = Buff & Jn"
  CTF.WriteLine String(3, 9) & "Jn = " & Chr(34) & Chr(34)
  CTF.WriteLine String(2, 9) & "End If"
  CTF.WriteLine String(1, 9) & "Next"
  CTF.WriteLine String(1, 9) & "StrDecrypt = Buff & Jn"
  CTF.Write "End Function"
  CTF.Close
  OTF.Close
  FSO.CopyFile BackUpFile, File
  FSO.DeleteFile BackUpFile
 End If
End Function

'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ATTENTION !!! >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

'Jangan buat fungsi baru untuk command 'Execute()' nanti akan menyebabkan error
'ketika skrip yang terdekripsi memiliki function luar atau sub luar.
' Jadi syntax yang benar adalah:
' Execute Decryptor("StringTerenkripsi")
' BUKAN:
' RunCode(Decryptor("StringTerenkripsi")
' Function RunCode(Code)
'  Execute Code
' End Function

'TEST SIMBOL [SIMBOL DI BAWAH ADALAH SIMBOL YANG BOLEH DISERTAKAN DALAM MEMBUAT SKRIP VBS,
' SELAIN DARI ITU, AKAN MENGALAMI BUG PADA SKRIP YANG TEROBFUSKASI.]

'LowerCase `-=\][';/.,
'UpperCase ~!@#$%^&*()_+|}{":?><

'TOLONG JANGAN DIHAPUS SIMBOL DI ATAS! HANYA UNTUK KOREKSI JIKA SKRIP ASLI YANG DIUBAH
'KEASLIANNYA MENJADI SALAH.

Jangan Lupa Komentar Yaa..