Source Code HDSN

Option Explicit
Public Const cRegsPath = "Software\www.vb-edan.blogspot.com\vbedan"  '' bisa disesuaikan
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = 3
Private Const CREATE_NEW = 1
Private Const INVALID_HANDLE_VALUE = -1
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const IDENTIFY_BUFFER_SIZE = 512
Private Const OUTPUT_DATA_SIZE = IDENTIFY_BUFFER_SIZE + 16

'GETVERSIONOUTPARAMS contains the data returned
'from the Get Driver Version function
Private Type GETVERSIONOUTPARAMS
   bVersion       As Byte 'Binary driver version.
   bRevision      As Byte 'Binary driver revision
   bReserved      As Byte 'Not used
   bIDEDeviceMap  As Byte 'Bit map of IDE devices
   fCapabilities  As Long 'Bit mask of driver capabilities
   dwReserved(3)  As Long 'For future use
End Type

'IDE registers
Private Type IDEREGS
   bFeaturesReg     As Byte 'Used for specifying SMART "commands"
   bSectorCountReg  As Byte 'IDE sector count register
   bSectorNumberReg As Byte 'IDE sector number register
   bCylLowReg       As Byte 'IDE low order cylinder value
   bCylHighReg      As Byte 'IDE high order cylinder value
   bDriveHeadReg    As Byte 'IDE drive/head register
   bCommandReg      As Byte 'Actual IDE command
   bReserved        As Byte 'reserved for future use - must be zero
End Type

'SENDCMDINPARAMS contains the input parameters for the
'Send Command to Drive function
Private Type SENDCMDINPARAMS
   cBufferSize     As Long     'Buffer size in bytes
   irDriveRegs     As IDEREGS  'Structure with drive register values.
   bDriveNumber    As Byte     'Physical drive number to send command to (0,1,2,3).
   bReserved(2)    As Byte     'Bytes reserved
   dwReserved(3)   As Long     'DWORDS reserved
   bBuffer()      As Byte      'Input buffer.
End Type

'Valid values for the bCommandReg member of IDEREGS.
Private Const IDE_ID_FUNCTION = &HEC            'Returns ID sector for ATA.
Private Const IDE_EXECUTE_SMART_FUNCTION = &HB0 'Performs SMART cmd.
                                                'Requires valid bFeaturesReg,
                                                'bCylLowReg, and bCylHighReg

'Cylinder register values required when issuing SMART command
Private Const SMART_CYL_LOW = &H4F
Private Const SMART_CYL_HI = &HC2

'Status returned from driver
Private Type DRIVERSTATUS
   bDriverError  As Byte          'Error code from driver, or 0 if no error
   bIDEStatus    As Byte          'Contents of IDE Error register
                                  'Only valid when bDriverError is SMART_IDE_ERROR
   bReserved(1)  As Byte
   dwReserved(1) As Long
End Type

Private Type IDSECTOR
   wGenConfig                 As Integer
   wNumCyls                   As Integer
   wReserved                  As Integer
   wNumHeads                  As Integer
   wBytesPerTrack             As Integer
   wBytesPerSector            As Integer
   wSectorsPerTrack           As Integer
   wVendorUnique(2)           As Integer
   sSerialNumber(19)          As Byte
   wBufferType                As Integer
   wBufferSize                As Integer
   wECCSize                   As Integer
   sFirmwareRev(7)            As Byte
   sModelNumber(39)           As Byte
   wMoreVendorUnique          As Integer
   wDoubleWordIO              As Integer
   wCapabilities              As Integer
   wReserved1                 As Integer
   wPIOTiming                 As Integer
   wDMATiming                 As Integer
   wBS                        As Integer
   wNumCurrentCyls            As Integer
   wNumCurrentHeads           As Integer
   wNumCurrentSectorsPerTrack As Integer
   ulCurrentSectorCapacity    As Long
   wMultSectorStuff           As Integer
   ulTotalAddressableSectors  As Long
   wSingleWordDMA             As Integer
   wMultiWordDMA              As Integer
   bReserved(127)             As Byte
End Type

'Structure returned by SMART IOCTL commands
Private Type SENDCMDOUTPARAMS
  cBufferSize   As Long         'Size of Buffer in bytes
  DRIVERSTATUS  As DRIVERSTATUS 'Driver status structure
  bBuffer()    As Byte          'Buffer of arbitrary length for data read from drive
End Type

'Vendor specific feature register defines
'for SMART "sub commands"
Private Const SMART_ENABLE_SMART_OPERATIONS = &HD8

'Status Flags Values
Public Enum STATUS_FLAGS
   PRE_FAILURE_WARRANTY = &H1
   ON_LINE_COLLECTION = &H2
   PERFORMANCE_ATTRIBUTE = &H4
   ERROR_RATE_ATTRIBUTE = &H8
   EVENT_COUNT_ATTRIBUTE = &H10
   SELF_PRESERVING_ATTRIBUTE = &H20
End Enum

'IOCTL commands
Private Const DFP_GET_VERSION = &H74080
Private Const DFP_SEND_DRIVE_COMMAND = &H7C084
Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088

Private Type ATTR_DATA
   AttrID As Byte
   AttrName As String
   AttrValue As Byte
   ThresholdValue As Byte
   WorstValue As Byte
   StatusFlags As STATUS_FLAGS
End Type

Public Type DRIVE_INFO
   bDriveType As Byte
   SerialNumber As String
   Model As String
   FirmWare As String
   Cilinders As Long
   Heads As Long
   SecPerTrack As Long
   BytesPerSector As Long
   BytesperTrack As Long
   NumAttributes As Byte
   Attributes() As ATTR_DATA
End Type

Public Enum IDE_DRIVE_NUMBER
   PRIMARY_MASTER
   PRIMARY_SLAVE
   SECONDARY_MASTER
   SECONDARY_SLAVE
   TERTIARY_MASTER
   TERTIARY_SLAVE
   QUARTIARY_MASTER
   QUARTIARY_SLAVE
End Enum

Private Declare Function CreateFile Lib "kernel32" _
   Alias "CreateFileA" _
  (ByVal lpFileName As String, _
   ByVal dwDesiredAccess As Long, _
   ByVal dwShareMode As Long, _
   lpSecurityAttributes As Any, _
   ByVal dwCreationDisposition As Long, _
   ByVal dwFlagsAndAttributes As Long, _
   ByVal hTemplateFile As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" _
  (ByVal hObject As Long) As Long

Private Declare Function DeviceIoControl Lib "kernel32" _
  (ByVal hDevice As Long, _
   ByVal dwIoControlCode As Long, _
   lpInBuffer As Any, _
   ByVal nInBufferSize As Long, _
   lpOutBuffer As Any, _
   ByVal nOutBufferSize As Long, _
   lpBytesReturned As Long, _
   lpOverlapped As Any) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (hpvDest As Any, _
   hpvSource As Any, _
   ByVal cbCopy As Long)

Private Type OSVERSIONINFO
   OSVSize As Long
   dwVerMajor As Long
   dwVerMinor As Long
   dwBuildNumber As Long
   PlatformID As Long
   szCSDVersion As String * 128
End Type

Private Declare Function GetVersionEx Lib "kernel32" _
   Alias "GetVersionExA" _
  (LpVersionInformation As OSVERSIONINFO) As Long

Private vhKey As Long
Private vKeyRoot As HKEYROOT
Private vSubKey As String
Private vNKey As Long
Private vNValue As Long

Public Enum HKEYROOT
  HKEY_CLASSES_ROOT = &H80000000
  HKEY_CURRENT_USER = &H80000001
  HKEY_LOCAL_MACHINE = &H80000002
  HKEY_USERS = &H80000003
  HKEY_PERFORMANCE_DATA = &H80000004
  HKEY_CURRENT_CONFIG = &H80000005
  HKEY_DYN_DATA = &H80000006
End Enum
Private Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Long
End Type
Public Enum VALUETYPE
  REG_SZ = 1
  REG_BINARY = 3
  REG_DWORD = 4
End Enum
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, 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         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
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         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Private Const ERROR_NO_MORE_ITEMS = 259
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_FILE_NOT_FOUND = 2
Private Const ERROR_SUCCESS = 0
Private Const ERROR_ISCLOSE = -1
Private Const ERROR_ISOPEN = -2
Private Const ERROR_UNSUPPORT_TYPE = -3
Private Const ERROR_DATA_TO_LONG = -4
Private Const ERROR_VALUE_TYPE = -5

Private Const KEY_CREATE_LINK = &H20
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY
Private Const KEY_SET_VALUE = &H2
Private Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY


Private vSecAttrib As SECURITY_ATTRIBUTES
Private vIsOpen As Boolean
Private vError As Long
Private vEnKey() As String
Private vEnValue() As String
Const MAX_IP = 5 'To make a buffer... i dont think you have more than 5 ip on your pc..


Public Function CreateKey(ByVal pzKRoot As HKEYROOT, ByVal pzSubKey As String) As Boolean
  If (vhKey = 0) Then
    vError = RegCreateKeyEx(pzKRoot, pzSubKey, 0, "", 0, KEY_READ + KEY_WRITE, vSecAttrib, vhKey, 0)
    If (vError = ERROR_SUCCESS) Then
      vKeyRoot = pzKRoot
      vSubKey = pzSubKey
    End If
  Else
    vError = ERROR_ISOPEN
  End If
  CreateKey = vError = ERROR_SUCCESS
End Function
Public Function SetValue(ByVal pzValueName As String, ByVal pzValue As Variant, Optional ByVal pzValueType As VALUETYPE = REG_SZ) As Boolean
  '---
  Dim tBuffer(2048) As Byte
  Dim tLBuffer As Long
  Dim tStrBuff As String
  Dim i As Integer
  '---
  vError = ERROR_SUCCESS
  If (vhKey = 0) Then
    vError = ERROR_ISCLOSE
  Else
    If (pzValueType = REG_SZ) Then
      tStrBuff = CStr(pzValue)
      If (Len(tStrBuff) > 2047) Then vError = ERROR_DATA_TO_LONG
    Else
      Select Case VarType(pzValue)
        Case vbInteger, vbLong, vbSingle, vbDouble, vbByte, vbBoolean:
          tStrBuff = Hex(pzValue)
          If (Len(tStrBuff) Mod 2 = 1) Then tStrBuff = "0" & tStrBuff
          If (Len(tStrBuff) < 8) Then tStrBuff = Right("00000000" & tStrBuff, 8)
          If (Len(tStrBuff) > 8) And (pzValueType = REG_DWORD) Then vError = ERROR_UNSUPPORT_TYPE
        Case vbDate:
          If (pzValueType = REG_BINARY) Then
            tStrBuff = Format(pzValue, "yyyymmddHhNnSs")
          Else
            vError = ERROR_UNSUPPORT_TYPE
          End If
        Case vbString: vError = ERROR_UNSUPPORT_TYPE
      End Select
      If ((Len(tStrBuff) \ 2) > 2047) Then vError = ERROR_DATA_TO_LONG
    End If
    '
    If (vError = ERROR_SUCCESS) Then
      If (pzValueType = REG_SZ) Then
        For i = 1 To Len(tStrBuff)
          tBuffer(i - 1) = Asc(Mid(tStrBuff, i, 1))
          tBuffer(i) = 0
        Next
        tLBuffer = Len(tStrBuff) + 1
      Else
        For i = Len(tStrBuff) - 1 To 1 Step -2
          tBuffer(3 - (i \ 2)) = Val("&H" & Mid(tStrBuff, i, 2))
        Next
        tLBuffer = Len(tStrBuff) \ 2
      End If
      vError = RegSetValueEx(vhKey, pzValueName, 0, pzValueType, tBuffer(0), tLBuffer)
    End If
  End If
  SetValue = vError = ERROR_SUCCESS
End Function

Public Function OpenKey(ByVal pzKRoot As HKEYROOT, ByVal pzSubKey As String) As Boolean
  If (vhKey = 0) Then
    vError = RegOpenKeyEx(pzKRoot, pzSubKey, 0, KEY_READ + KEY_WRITE, vhKey)
    If (vError = ERROR_SUCCESS) Then
      vKeyRoot = pzKRoot
      vSubKey = pzSubKey
    End If
  Else
    vError = ERROR_ISOPEN
  End If
  OpenKey = vError = ERROR_SUCCESS
End Function
Public Function GetValue(ByVal pzValueName As String, ByRef pzValue As Variant) As Boolean
  '---
  Dim tBuffer(2048) As Byte
  Dim tLBuffer As Long
  Dim tStrBuff As String
  Dim i As Integer
  Dim tValueType As VALUETYPE
  '---
  On Error Resume Next
  If (vhKey = 0) Then
    vError = ERROR_ISCLOSE
  Else
    tLBuffer = 2048
    vError = RegQueryValueEx(vhKey, pzValueName, 0, tValueType, tBuffer(0), tLBuffer)
    If (vError = ERROR_SUCCESS) Then
      Select Case tValueType
        Case REG_SZ:
          tStrBuff = StrConv(tBuffer, vbUnicode)
          tStrBuff = Left(tStrBuff, tLBuffer)
          Select Case VarType(pzValue)
            Case vbByte: pzValue = CByte(tStrBuff)
            Case vbInteger: pzValue = CInt(tStrBuff)
            Case vbLong: pzValue = CLng(tStrBuff)
            Case vbSingle: pzValue = CSng(tStrBuff)
            Case vbDouble: pzValue = CDbl(tStrBuff)
            Case vbBoolean: pzValue = CBool(tStrBuff)
            Case vbDate: pzValue = CDate(tStrBuff)
            Case vbString: pzValue = Left(tStrBuff, tLBuffer - 1)
            Case Else: vError = ERROR_VALUE_TYPE
          End Select
        Case REG_DWORD, REG_BINARY:
          Err.Clear
          tStrBuff = ""
          For i = 0 To tLBuffer - 1
            tStrBuff = Right("00" & Hex(tBuffer(i)), 2) & tStrBuff
          Next
          tStrBuff = Val("&H" & tStrBuff)
          Select Case VarType(pzValue)
            Case vbByte: pzValue = CByte(tStrBuff)
            Case vbInteger: pzValue = CInt(tStrBuff)
            Case vbLong: pzValue = CLng(tStrBuff)
            Case vbSingle: pzValue = CSng(tStrBuff)
            Case vbDouble: pzValue = CDbl(tStrBuff)
            Case vbBoolean: pzValue = CBool(tStrBuff)
            Case Else: vError = ERROR_VALUE_TYPE
          End Select
          If (Err.Number <> 0) Then vError = ERROR_VALUE_TYPE
        Case Else: vError = ERROR_UNSUPPORT_TYPE
      End Select
    End If
  End If
  GetValue = vError = ERROR_SUCCESS
End Function
 Function GetDriveInfo(drvNumber As IDE_DRIVE_NUMBER) As DRIVE_INFO

   Dim hDrive As Long
   Dim di As DRIVE_INFO

   hDrive = SmartOpen(drvNumber)

   If hDrive <> INVALID_HANDLE_VALUE Then

      If SmartGetVersion(hDrive) = True Then

         With di
            .bDriveType = 0
            .NumAttributes = 0
            ReDim .Attributes(0)
            .bDriveType = 1
         End With

         If SmartCheckEnabled(hDrive, drvNumber) Then

            If IdentifyDrive(hDrive, IDE_ID_FUNCTION, drvNumber, di) = True Then

               GetDriveInfo = di

            End If   'IdentifyDrive
         End If   'SmartCheckEnabled
      End If   'SmartGetVersion
   End If   'hDrive <> INVALID_HANDLE_VALUE

   CloseHandle hDrive

End Function



Function IdentifyDrive(ByVal hDrive As Long, _
                               ByVal IDCmd As Byte, _
                               ByVal drvNumber As IDE_DRIVE_NUMBER, _
                               di As DRIVE_INFO) As Boolean

  'Function: Send an IDENTIFY command to the drive
  'drvNumber = 0-3
  'IDCmd = IDE_ID_FUNCTION or IDE_ATAPI_ID
   Dim SCIP As SENDCMDINPARAMS
   Dim IDSEC As IDSECTOR
   Dim bArrOut(OUTPUT_DATA_SIZE - 1) As Byte
   Dim cbBytesReturned As Long

   With SCIP
      .cBufferSize = IDENTIFY_BUFFER_SIZE
      .bDriveNumber = CByte(drvNumber)

      With .irDriveRegs
         .bFeaturesReg = 0
         .bSectorCountReg = 1
         .bSectorNumberReg = 1
         .bCylLowReg = 0
         .bCylHighReg = 0
         .bDriveHeadReg = &HA0 'compute the drive number
         If Not IsWinNT4Plus Then
            .bDriveHeadReg = .bDriveHeadReg Or ((drvNumber And 1) * 16)
         End If
         'the command can either be IDE
         'identify or ATAPI identify.
         .bCommandReg = CByte(IDCmd)
      End With
   End With

   If DeviceIoControl(hDrive, _
                      DFP_RECEIVE_DRIVE_DATA, _
                      SCIP, _
                      Len(SCIP) - 4, _
                      bArrOut(0), _
                      OUTPUT_DATA_SIZE, _
                      cbBytesReturned, _
                      ByVal 0&) Then

      CopyMemory IDSEC, bArrOut(16), Len(IDSEC)

      di.Model = StrConv(SwapBytes(IDSEC.sModelNumber), vbUnicode)
      di.SerialNumber = StrConv(SwapBytes(IDSEC.sSerialNumber), vbUnicode)

      IdentifyDrive = True

    End If

End Function
Function SwapBytes(B() As Byte) As Byte()


   Dim bTemp As Byte
   Dim cnt As Long

   For cnt = LBound(B) To UBound(B) Step 2
      bTemp = B(cnt)
      B(cnt) = B(cnt + 1)
      B(cnt + 1) = bTemp
   Next cnt

   SwapBytes = B()

End Function
Public Function CloseKey() As Boolean
  If (vhKey = 0) Then
    vError = ERROR_ISCLOSE
  Else
    vError = RegCloseKey(vhKey)
    If (vError = ERROR_SUCCESS) Then
      vIsOpen = False
      vhKey = 0
      vKeyRoot = HKEY_CURRENT_USER
      vSubKey = ""
      ReDim vEnKey(0)
      ReDim vEnValue(0)
    End If
  End If
  CloseKey = vError = ERROR_SUCCESS
End Function

Function IsWinNT4Plus() As Boolean

  'returns True if running Windows NT4 or later
   Dim osv As OSVERSIONINFO

   osv.OSVSize = Len(osv)

   If GetVersionEx(osv) = 1 Then

      IsWinNT4Plus = (osv.PlatformID = VER_PLATFORM_WIN32_NT) And _
                     (osv.dwVerMajor >= 4)

   End If

End Function
 Function SmartGetVersion(ByVal hDrive As Long) As Boolean

   Dim cbBytesReturned As Long
   Dim GVOP As GETVERSIONOUTPARAMS

   SmartGetVersion = DeviceIoControl(hDrive, _
                                     DFP_GET_VERSION, _
                                     ByVal 0&, 0, _
                                     GVOP, _
                                     Len(GVOP), _
                                     cbBytesReturned, _
                                     ByVal 0&)

End Function
 Function SmartOpen(drvNumber As IDE_DRIVE_NUMBER) As Long
  'Open SMART to allow DeviceIoControl
  'communications and return SMART handle

   If IsWinNT4Plus() Then

      SmartOpen = CreateFile("\\.\PhysicalDrive" & CStr(drvNumber), _
                             GENERIC_READ Or GENERIC_WRITE, _
                             FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                             ByVal 0&, _
                             OPEN_EXISTING, _
                             0&, _
                             0&)

   Else

      SmartOpen = CreateFile("\\.\SMARTVSD", _
                              0&, 0&, _
                              ByVal 0&, _
                              CREATE_NEW, _
                              0&, _
                              0&)
   End If

End Function

Function SmartCheckEnabled(ByVal hDrive As Long, _
                                   drvNumber As IDE_DRIVE_NUMBER) As Boolean

  'SmartCheckEnabled - Check if SMART enable
  'FUNCTION: Send a SMART_ENABLE_SMART_OPERATIONS command to the drive
  'bDriveNum = 0-3
   Dim SCIP As SENDCMDINPARAMS
   Dim SCOP As SENDCMDOUTPARAMS
   Dim cbBytesReturned As Long

   With SCIP

      .cBufferSize = 0

      With .irDriveRegs
           .bFeaturesReg = SMART_ENABLE_SMART_OPERATIONS
           .bSectorCountReg = 1
           .bSectorNumberReg = 1
           .bCylLowReg = SMART_CYL_LOW
           .bCylHighReg = SMART_CYL_HI

           .bDriveHeadReg = &HA0
            If Not IsWinNT4Plus Then
               .bDriveHeadReg = .bDriveHeadReg Or ((drvNumber And 1) * 16)
            End If
           .bCommandReg = IDE_EXECUTE_SMART_FUNCTION

       End With

       .bDriveNumber = drvNumber

   End With

   SmartCheckEnabled = DeviceIoControl(hDrive, _
                                      DFP_SEND_DRIVE_COMMAND, _
                                      SCIP, _
                                      Len(SCIP) - 4, _
                                      SCOP, _
                                      Len(SCOP) - 4, _
                                      cbBytesReturned, _
                                      ByVal 0&)
End Function

Function Enkrip(xInput As String) As String
''INI HANYA CONTOH
''bisa disesuikan sendiri berdasarkan Enkrip generate yg anda punya
Dim Output, Inputan As String
Dim Panjang_Input As Integer
Dim i As Integer
Inputan = xInput
Panjang_Input = Len(xInput)
    For i = 1 To Panjang_Input
        Enkrip = Mid(Inputan, i, 1)
        Enkrip = Asc(Enkrip)
        Enkrip = (Enkrip + 5) - 4
        Enkrip = Chr(Enkrip)
        Output = Output & Enkrip

    Next i

 Enkrip = Output
End Function

Function Dekrip(xInput As String) As String
''INI HANYA CONTOH
''bisa disesuikan sendiri berdasarkan Dekrip generate yg anda punya

Dim Output, Inputan As String
Dim Panjang_Input, Pesan As Integer
Dim i As Integer
Inputan = xInput
Panjang_Input = Len(xInput)
    For i = 1 To Panjang_Input
        Dekrip = Mid(Inputan, i, 1)
        Dekrip = Asc(Dekrip)
        Dekrip = (Dekrip - 5) + 4
        Dekrip = Chr(Dekrip)
        Output = Output & Dekrip
    Next i
Dekrip = Output
End Function