Ochrana aplikace ve VB

Způsoby jak chránit svojí aplikaci:

1. Hardwarový klíč
Program testuje přítomnost klíče, který bývá zpravidla zasunut v portech počítače.

2. Softwarová ochrana
Program testuje registraci a někdy i instalační prostředí (název počítače, operační systém, velikost disku atd.)

My se podíváme blíže na druhý způsob ochrany tj. na ochranu softwarovou.

Na co se musíme zaměřit, co vše hlídat, jak to udělat.
Nejprve je nutné zvážit, zda se nám vyplatí vytvářet nějakou super geniální ochranu. Z vlastní zkušenosti vím, že i sebedokonalejší ochrana bude jednou nabourána. Nač tedy vyvíjet supergeniální monstrum, když náklady na jeho vývoj přesáhnou ztráty způsobené nelegálním kopírováním.

Jednoduchá ochrana je ochrana sériovým číslem kombinovaná se součtem bytů programu. Sice nezabrání kopírování programu a předání sériového čísla, ale ne každý je ochoten kopírovat své vlastní (draze koupené) programy ostatním. Jak tedy naprogramovat ve VB takovou ochranu?

1. Založte nový projekt a Novou třídu. (Class)
2. Přidejte Form1
3. Na form1 vložte 2x label, 2x textbox a 2x command

Vložte následující kód a můžete experimentovat.

Form1

Option Explicit

Private Sub Command1_Click()
  Dim oVer As New Class1
  With oVer
    .Company = Text2.Text
    .CustName = Text1.Text
  MsgBox .GetSerial
  End With
End Sub

Private Sub Command2_Click()
  Dim oVer As New Class1
  With oVer
    .Company = Text2.Text
    .CustName = Text1.Text
    .SerialNumber = InputBox("Zadej ser. cis.")
    If .VerifySN Then
      MsgBox "Správné SÈ"
    Else
      MsgBox "Špatné SÈ"
    End If
  End With
End Sub

Private Sub Form_Load()
   Command1.Caption = "Ukaž"
   Command2.Caption = "Ovìø"
   
   Label1.Caption = "Jméno"
   Label2.Caption = "Firma nebo Mìsto"
   Label1.AutoSize = True
   Label2.AutoSize = True
   Text1.Text = "Franta Ocásek"
   Text2.Text = "Zlámaná lhota"

   Label1.Move 10, 10
   Text1.Move 10, Label1.Top + Label1.Height

   Label2.Move 10, Text1.Top + Text1.Height + 50
   Text2.Move 10, Label2.Top + Label2.Height
   
   Command1.Move 10, Text2.Top + Text2.Height + 90, 1000, 350
   Command2.Move 30 + Command1.Left + Command1.Width, _
      Text2.Top + Text2.Height + 90, 1000, 350
End Sub

Option Explicit
Private m_CustName As String
Private m_Company As String
Private m_SerialNumber As String
'

Public Property Get CustName() As String
  CustName = m_CustName
End Property
Public Property Get Company() As String
  Company = m_Company
End Property
Public Property Get SerialNumber() As String
  SerialNumber = m_SerialNumber
End Property

Public Property Let CustName(ByVal sData As String)
  m_CustName = sData
End Property
Public Property Let Company(ByVal sData As String)
  m_Company = sData
End Property
Public Property Let SerialNumber(ByVal sData As String)
  m_SerialNumber = sData
End Property


Public Function VerifySN() As Boolean
  If GetSerial = SerialNumber Then
    VerifySN = True
  Else
    VerifySN = False
  End If
End Function

Public Function CreateSN() As Boolean
  CreateSN = GetSerial
End Function

Public Function GetSerial() As String
  Dim i
  Dim lTmp
  Dim sTmp
  Dim sSC
  Dim lSumAll
  'Algoritmus tvorby Sériového èísla
  'pro jednoduchost použijeme jen 5 znakové s.č.
  
  'prvni znak
  'zprumerovany soucet vsech pismen jmena a firmy
  For i = 1 To Len(m_CustName)
    lTmp = lTmp + Asc(UCase(Mid(m_CustName, i, 1)))
  Next i
  For i = 1 To Len(m_Company)
    lTmp = lTmp + Asc(UCase(Mid(m_Company, i, 1)))
  Next i
  lSumAll = lTmp 'Uschovat pro 3 cislo
  lTmp = lTmp  (Len(m_CustName) + Len(m_Company))
  sTmp = UCase(Chr(lTmp))
  sSC = sTmp
  
  'druhy znak
  'prumer prvniho jmena a firmy
  lTmp = Asc(UCase(Mid(m_CustName, 1, 1)))
  lTmp = lTmp + Asc(UCase(Mid(m_Company, 1, 1)))
  lTmp = lTmp  2
  sTmp = UCase(Chr(lTmp))
  sSC = sSC & sTmp
  
  'Treti znak
  'Konecna hodnota souctu cisel ze jmena a firmy
  
  Do While Len(CStr(lSumAll)) > 1
   lTmp = 0
   For i = 1 To Len(CStr(lSumAll))
    lTmp = lTmp + CLng(Mid(CStr(lSumAll), i, 1))
   Next i
   lSumAll = lTmp
  Loop
  sTmp = CStr(lTmp)
  sSC = sSC & sTmp
  
  'Ctvrty znak
  'Verze aplikace  (major*minor*revision)
  '/ 2 dokud neni <10
  
  lTmp = (App.Major + 1) * (App.Minor + 2) * _
     (App.Revision + 3)
  Do While lTmp > 10
    lTmp = lTmp  2
  Loop
  sTmp = CStr(lTmp)
  sSC = sSC & sTmp

  'paty znak
  'Neco vymyslete sami
  sSC = sSC & "R"


GetSerial = sSC

End Function