Membuat Sistem Keamanan Dengan VB6.0

Kali ini saya akan memposting bagaimana cara membuat sistem keamanan sederhana, cara kerjanya cukup simple, yaitu memprotect pengopyan data ke flashdisk, program ini saya buat karena pengalaman pribadi, coz temen-temen saya sering mengambil data-data tanpa sepengetahuan saya, #hehe jadi curhat...

cara ini saya dapat dari mbah google, dengan mengedit registry, tapi saya ingin mengembangkan menjadi satu buah aplikasi, jadi tanpa mengedit-edit registry lagi.

pertama-tama buat aplikasi seperti gambar di bawah ini

sesudah itu copy program di bawah ini

'----------------------------------------------------------------------------------------------------------
Private lReg As Long
Private KeyHandle As Long
Private lResult As Long
Private lValueType As Long
Private lDataBufSize As Long

Private Const ERROR_SUCCESS = 0&
Private Const REG_DWORD = 4
Const KEY_READ = ((&H20000 Or &H1 Or &H8 Or &H10) And (Not &H100000))

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Public Enum MainKey
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
End Enum

Private Function GetDwordValue(ByVal hKey As MainKey, ByVal sPath As String, ByVal sValueName As String) As Long
Dim lBuff As Long
lReg = RegOpenKey(hKey, sPath, KeyHandle)
lDataBufSize = 4
lResult = RegQueryValueEx(KeyHandle, sValueName, 0&, lValueType, lBuff, lDataBufSize)
If lResult = ERROR_SUCCESS Then
If lValueType = REG_DWORD Then
GetDwordValue = lBuff
End If
End If
lReg = RegCloseKey(KeyHandle)
End Function

Public Function SetDwordValue(ByVal hKey As MainKey, ByVal sPath As String, ByVal sValueName As String, ByVal lData As Long) As Long
lReg = RegCreateKey(hKey, sPath, KeyHandle)
lResult = RegSetValueEx(KeyHandle, sValueName, 0&, REG_DWORD, lData, 4)
lReg = RegCloseKey(KeyHandle)
End Function

Private Sub Command1_Click()
Dim lData, Pass As String
lData = GetDwordValue(HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\StorageDevicePolicies", "WriteProtect")

If lData = 1 Then
SetDwordValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\StorageDevicePolicies", "WriteProtect", "0"
Command1.Caption = "Enable"
Label1.Caption = "Status : Not Protected"
Else
SetDwordValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\StorageDevicePolicies", "WriteProtect", "1"
Command1.Caption = "Disable"
Label1.Caption = "Status : Protected"
End If
End Sub

Private Sub Form_Load()

Dim lData, Pass As String
lData = GetDwordValue(HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\StorageDevicePolicies", "WriteProtect")

If lData = 1 Then
Label1.Caption = "Status : Protected"
Command1.Caption = "Disable"
Else
Label1.Caption = "Status : Not Protected"
Command1.Caption = "Enable"
End If

End Sub
'----------------------------------------------------------------------------------------------------------

jika programnya berjalan (Protected) dan ada data yang ingin di copy ke flashdisk maka akan muncul pesan error seperti gambar di bawah ini

moga bermanfaat bagi agan-agan yang ingin mencobanya,
moga berhasil mencobanya..

*..sesama blogger harus saling menghargai..*