Привязка скрипта к одному компьютеру (железу)

Private Function Encode(ByVal strString As String) As String
  Dim tempstr2 As String
  Dim PArray() As String
  Dim VArray() As String

  KolS = Len(strString)
  If KolS Mod 2 = 1 Then
    ReDim PArray((KolS - 1) / 2)
    ReDim VArray((KolS - 1) / 2)
    PSim = Mid(strString, ((KolS - 1) / 2) + 1, 1)
    For I = 1 To (KolS - 1) / 2
      PArray(I) = Mid(strString, I, 1)
      VArray(I) = Mid(strString, I + ((KolS - 1) / 2) + 1, 1)
      tempstr2 = tempstr2 & PArray(I) & VArray(I)
    Next
    tempstr2 = tempstr2 & PSim
  Else
    ReDim PArray(KolS / 2)
    ReDim VArray(KolS / 2)
    For I = 1 To KolS / 2
      PArray(I) = Mid(strString, I, 1)
      VArray(I) = Mid(strString, I + KolS / 2, 1)
      tempstr2 = tempstr2 & PArray(I) & VArray(I)
    Next
  End If
  Encode = tempstr2
End Function

Private Function Decode(ByVal strString As String) As String
  Dim strHexDecode As String, tempstr1 As String

  Dim PArray() As String
  Dim VArray() As String
  Dim n As Integer
  Dim Mst As String

  KolS = Len(strString)
  ReDim PArray(KolS)
  ReDim VArray(KolS)

  If KolS Mod 2 = 1 Then
    Mst = Left(strString, KolS - 1)
  Else
    Mst = strString
  End If
  n = 1
  For I = 1 To Len(Mst) / 2
    PArray(I) = Mid(Mst, n, 1)
    VArray(I) = Mid(Mst, n + 1, 1)
    n = n + 2
    tempstr1 = tempstr1 & PArray(I)
  Next
  If KolS Mod 2 = 1 Then
    tempstr1 = tempstr1 & Right(strString, 1)
  End If
  For q = 1 To Len(Mst) / 2
    tempstr1 = tempstr1 & VArray(q)
  Next

  Decode = tempstr1

End Function

Private Function EncodeHX(ByVal strString As String) As String

  For index = 1 To Len(strString)
    EncodeHX = EncodeHX & Hex(Asc(Mid(strString, index, 1)))
  Next

End Function

Private Function DecodeHX(ByVal strString As String) As String
  
   On Error GoTo DecodeHX_Error

  For index = 1 To Len(strString) Step 2
    DecodeHX = DecodeHX & Chr(CLng("&H" & Mid(strString, index, 2)))
  Next

   On Error GoTo 0
   Exit Function

DecodeHX_Error:

  DecodeHX = ""

End Function

Public Function GetClientSerial() As String
    Dim pWMI As Object, pDisks As Object, pDisk As Object
     
    Set pWMI = GetObject("winmgmts:\\")
    Set pDisks = pWMI.ExecQuery("Select * from Win32_DiskDrive Where BytesPerSector Is Not Null", , 48)
    
    For Each pDisk In pDisks
        Dim SN As String: SN = pDisk.Model & pDisk.SerialNumber
    Next
    Dim clientsn As String, generetedSN As String
    GetClientSerial = Encode(Encode(SN))

End Function
 
Public Function CheckSerial(ByVal SN As String) As Boolean
    Dim pWMI As Object, pDisks As Object, pDisk As Object
    Set pWMI = GetObject("winmgmts:\\")
    SN = Decode(Decode(DecodeHX(Decode(Decode(SN)))))
    Set pDisks = pWMI.ExecQuery("Select * from Win32_DiskDrive Where BytesPerSector Is Not Null", , 48)
    CheckSerial = False
    For Each pDisk In pDisks
        If SN = pDisk.Model & pDisk.SerialNumber Then
          CheckSerial = True: Exit For
        End If
    Next
End Function