Portable application!! Need your suggestion

[ash07]

Dear all
I am developing an application in VB & Access .I am trying to secure application by adding user control,trace modules,database password.
(just today i saw how to make a folder inaccesible+ not to allow delete.)
1)I would like to know how do i secure my application..
am i missing any other way...

2)but apart from folder,db security.. I am thinking to make my application in portable in external drive(CD,USB Etc) as this is small application.

3)http://tech-moron.blogspot.com/2006/11/portable-applications.html
http://answers.yahoo.com/question/index?qid=20070630115328AAynKCL

when I searched on web I found these links.. I need suggestions in similar thing but with VB application!!

Please suggest me.. give me hint/link if you've already done similiar thing.
Thanks in advance

[AndreRet]

Are you using VBA or VB6?

[ash07]

Are you using VBA or VB6?

Hi andre
I am using VB6.0 and ms access 2003 as backend for reporting services crystal report 8.5
Im thinking to upgrade to latest version of VB but that will be later.

[AndreRet]

I would like to know how do i secure my application..

The best way using VB6 is to start playing with registry key entries which is way too advanced to discuss here. I have attached a sample to get the user to register your app. It works fine and most bugs has been corrected, but still, use at your own peril. Playing around with the registry is extremely dangerous and can void your system inoperable, hence the advance level of coding..:)

Credit goes to the original writer, John P. Cunningham. I have just copied and pasted what I needed into my own applications.

I am thinking to make my application in portable in external drive(CD,USB Etc) as this is small application.

Yes it is possible IF all the VB6 runtime files and any other dependency files is installed on the user's desktop. If it is just for you, go for it. Users will not appreciate it as much though. I would personally suggest that you install your application on the users desktop, that will ensure consistent running without errors because run files is missing or misplaced. Temp folders gets created in the app path. If this is on a removable drive, you might get errors or loose data. Your application will also run much slower than normal, which might get your user upset.

[ash07]

thanks for your quick reply

The best way using VB6 is to start playing with registry key entries which is way too advanced to discuss here. I have attached a sample to get the user to register your app. It works fine and most bugs has been corrected, but still, use at your own peril. Playing around with the registry is extremely dangerous and can void your system inoperable, hence the advance level of coding..:)[/I]

Yeah It is dangerous.. thank you for the sample will check it and if any questions continues ... will get back to u..!

Yes it is possible IF all the VB6 runtime files and any other dependency files is installed on the user's desktop. If it is just for you, go for it. Users will not appreciate it as much though. I would personally suggest that you install your application on the users desktop, that will ensure consistent running without errors because run files is missing or misplaced. Temp folders gets created in the app path. If this is on a removable drive, you might get errors or loose data. Your application will also run much slower than normal, which might get your user upset.

Yeah I understand bt my user want the application on portable drive... as they have fear .. that anyone could copy application and stole the data do u have any suggestion on such issues?.. Im confused about it.. But today I registered OCx and dll and It starts working through portable drive...any words/suggestions appriciated on this.....

[ash07]

OMG....When i TRied To extract this file.. I get an error "The archive is either in unknown or damaged

[AndreRet]

As I have mentioned above, when compiling your app, make sure that all runtime and dependency files is included. When you run the setup.exe application, change the installation folder to the removable drive. Setup will automatically copy all the run time files to the users pc, the application exe will be installed on the rem. drive.

If you want the database on the drive as well, make sure that the installation folder refers to the rem. drive. Also ensure that the application connect code to the database is coded to refer to the rem. drive. Remember that your rem. drive might show on your pc as the say D:/ drive whilst the users is say f:/ drive. This might create errors on the connection if not coded correctly, which I am not going into here.;)

[AndreRet]

I have re-zipped the app and attached it below.

[ash07]

I have re-zipped the app and attached it below.

Sorry but same error again... :(

[AndreRet]

Are you using winzip to open the file? I've opened it twice , works fine.:)

[ash07]

I tried to extract by winzip...bt it says now different error "cant open file; it doesnt appear to be valid archive"

[ash07]

Are you using winzip to open the file? I've opened it twice , works fine.:)

I tried to open it using winzip bt now it is showing another error
cant not open file; it does not appear to be a valid archive.. if you downloaded this file try downloading the file again"

which i did... but still same error

[AndreRet]

Here's the code. Just add the controls as needed -

frmCheckRegistration

Option Explicit

'**NB!-You must remember to run the Registry********
'**Add-In prior to running this program, if you*****
'**don't, a registry key setting will not be found**
'***************************************************
Dim MainKey As String
Dim SubKey As String
Dim AuthorName As String
Dim RegKeyCheck As String
Dim RegValue1 As String
Dim RegValue2 As String
Dim RegValue3 As String
'Dim checkit As Boolean 'dimension globally in the modWinRegistry Module
Dim checkitAgain As Boolean
Dim PrgmSet As String
Dim InstDate As String
Dim ExpDate As String
Dim DateCheck As String
Dim RetVal As String



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
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002

Const REG_SZ = 1

Public Sub SaveSettingString(hKey As Long, strPath As String, strValue As String, strData As String)
Dim RKey As Long
Dim Result As Long

    Result = RegCreateKey(hKey, strPath, RKey)
    Result = RegSetValueEx(RKey, strValue, 0, REG_SZ, ByVal strData, Len(strData))
    Result = RegCloseKey(RKey)

End Sub



Private Sub cmdRegisterLater_Click()
    frmTestApp.Show
    Unload Me
End Sub

Private Sub cmdRegisterNow_Click()
    frmProductRegistration.Show
    Unload Me
End Sub

Public Sub KeyCurrentUser()
'******************************************************************************************
'Check Registry HKEY_CURRENT_USER for the Application's Program Setting
RegValue1 = "PrgmSet" & _
    GetSettingString(HKEY_CURRENT_USER, MainKey & "\" & SubKey & "\", "PrgmSet")
'******************************************************************************************
'******************************************************************************************

'Check to see if the PrgmSet code is set
Text1 = " PrgmSet = " & RegValue1
If Mid(RegValue1, 8, 3) = "" Then
    'program is not registered
    Text1 = "Program is Not Registered as of:  " & Date
Else 'program is registered
    Text1 = "Program is Registered, Continue"
    frmTestApp.Show
    Unload Me
    Exit Sub
End If

'******************************************************************************************
'******************************************************************************************
'We got here because the PrgmSet was not set, i.e., PrgmSet="" so our program
'is not Registered. 'Check Registry to see if the Application is setup for a
'shareware 30 trial.
    RegValue2 = "Expiration Date" & _
    GetSettingString(HKEY_CURRENT_USER, MainKey & "\" & SubKey & "\", "Expiration Date" & "")
'******************************************************************************************
'Application is NOT setup for a shareware 30 day trial
If Len(RegValue2) < 16 Then
    'so show the registration form
    frmProductRegistration.Show
    Unload Me
    Exit Sub
   
Else
'Strip the first 16 Characters i.e.,"Expiration Date" off RegValue2
'!NB-Use the Mid Function only to do this, as the Left or Right Function
'can leave trailing alpha characters in the difference in dates,
'i.e., 11/22/01 & 1/2/01, notice the date format varies between 6 and 8 characters

    ExpDate = Mid(RegValue2, 16, 8)
    'Coerce Installation Date String to "Date" Data Type
    ExpDate = CDate(ExpDate)
    
    Text2 = "Expiration Date is:  " & ExpDate
'****************************************************************************************
'****************************************************************************************

'Get the Programs Installation Date
RegValue3 = "Installation Date" & _
    GetSettingString(HKEY_CURRENT_USER, MainKey & "\" & SubKey & "\", "Installation Date")
   
'Strip the first 18 characters away from the "Installation Date" String
'!NB-Use the Mid Function only to do this, as the Left or Right Function
'can leave trailing alpha characters in the difference in dates,
'i.e., 11/22/01 & 1/2/01, notice the date format varies between 6 and 8 characters

    InstDate = Mid(RegValue3, 18, 8)
    'Coerce Installation Date String to "Date" Data Type
    InstDate = CDate(InstDate)
    
    Text3 = "Install Date:  " & InstDate
    
'****************************************************************************************
'****************************************************************************************

   'Get the difference in number of days since install and now
   DateCheck = DateDiff("d", InstDate, ExpDate)
   
   Text4 = DateCheck & " Days left"
   
    If DateCheck > 30 Or DateCheck < 1 Then
        Me.Hide
        'VB-6 Message Box Generator Add-In
        'By: John P. Cunningham
        RetVal = MsgBox("The 30 Trial has expired, do you wish to Register now?", 4, "Register Software")
        
        Select Case RetVal

            Case 6     'Yes
                frmProductRegistration.Show
            Case 7     'No
                End
        End Select
        
    Else
'*************************************************************************************

End If
   End If

End Sub
Public Sub KeyLocalMachine()
'******************************************************************************************
'Check Registry HKEY_CURRENT_USER for the Application's Program Setting
RegValue1 = "PrgmSet" & _
    GetSettingString(HKEY_LOCAL_MACHINE, MainKey & "\" & SubKey & "\", "PrgmSet")
'******************************************************************************************
'******************************************************************************************

'Check to see if the PrgmSet code is set
Text1 = " PrgmSet = " & RegValue1
If Mid(RegValue1, 8, 3) = "" Then

    'program is not registered
    Text1 = "Program is Not Registered as of:   " & Date
    
Else 'program is registered
    Text1 = "Program is Registered, Continue"
    frmTestApp.Show
    Unload Me
    Exit Sub
    
End If

'******************************************************************************************
'******************************************************************************************
'We got here because the PrgmSet was not set, i.e., PrgmSet="" so our program
'is not Registered. 'Check Registry to see if the Application is setup for a
'shareware 30 trial.
    RegValue2 = "Expiration Date" & _
    GetSettingString(HKEY_LOCAL_MACHINE, MainKey & "\" & SubKey & "\", "Expiration Date" & "")
'******************************************************************************************
'Application is NOT setup for a shareware 30 day trial
If Len(RegValue2) < 16 Then
    'so show the registration form
    frmProductRegistration.Show
    Unload Me
    Exit Sub
   
Else
'Strip the first 16 Characters i.e.,"Expiration Date" off RegValue2
'!NB-Use the Mid Function only to do this, as the Left or Right Function
'can leave trailing alpha characters in the difference in dates,
'i.e., 11/22/01 & 1/2/01, notice the date format varies between 6 and 8 characters

    ExpDate = Mid(RegValue2, 16, 8)
    'Coerce Installation Date String to "Date" Data Type
    ExpDate = CDate(ExpDate)
    
    Text2 = "Expiration Date is:  " & ExpDate
'****************************************************************************************
'****************************************************************************************

'Get the Programs Installation Date
RegValue3 = "Installation Date" & _
    GetSettingString(HKEY_LOCAL_MACHINE, MainKey & "\" & SubKey & "\", "Installation Date")
   
'Strip the first 18 characters away from the "Installation Date" String
'!NB-Use the Mid Function only to do this, as the Left or Right Function
'can leave trailing alpha characters in the difference in dates,
'i.e., 11/22/01 & 1/2/01, notice the date format varies between 6 and 8 characters

    InstDate = Mid(RegValue3, 18, 8)
    'Coerce Installation Date String to "Date" Data Type
    InstDate = CDate(InstDate)
    
    Text3 = "Install Date:  " & InstDate
    
'****************************************************************************************
'****************************************************************************************

   'Get the difference in number of days since install and now
   DateCheck = DateDiff("d", InstDate, ExpDate)
   
   Text4 = DateCheck & " Days left"
   
    If DateCheck > 30 Or DateCheck < 1 Then
        Me.Hide
        'VB-6 Message Box Generator Add-In
        'By: John P. Cunningham
        RetVal = MsgBox("The 30 Trial has expired, do you wish to Register now?", 4, "Register Software")
        
        Select Case RetVal

            Case 6     'Yes
                frmProductRegistration.Show
            Case 7     'No
                End
        End Select
        
    Else
'*************************************************************************************

End If
   End If

End Sub

Private Sub Form_Activate()
'First check the Windows Registry to see under which Key the Entries were made
'******************************************************************************************
'******************************************************************************************
'Check HKEY_CURRENT_USER
RegKeyCheck = _
GetSettingString(HKEY_CURRENT_USER, MainKey & "\" & SubKey & "\", "Program By:")

If RegKeyCheck = "" Then    'No value found
    
    checkit = False
Else
    checkit = True
    KeyCurrentUser
End If

'******************************************************************************************
'Next Check HKEY_LOCAL_MACHINE
RegKeyCheck = _
GetSettingString(HKEY_LOCAL_MACHINE, MainKey & "\" & SubKey & "\", "Program By:")

If RegKeyCheck = "" Then 'No value found
    
    checkitAgain = False
Else
    checkitAgain = True
    KeyLocalMachine
End If

If checkit = False And checkitAgain = False Then
    Me.Hide
    'VB-6 Message Box Generator Add-In
    'By: John P. Cunningham
    RetVal = MsgBox("You must use the Registry Add-In to set a value" & vbCrLf & "in either ''HKEY_CURRENT_USER'' or" & vbCrLf & "''HKEY_LOCAL_MACHINE''", 64, "                        Registry Check")
    End
End If
    
End Sub

Private Sub Form_Load()
'******************************************************************************************
'******************************************************************************************
'Here is where you would set the MainKey & SubKey for your application

MainKey = "Registersoft"
SubKey = "Reg Check"
AuthorName = "Andre"

    SaveSettingString HKEY_CURRENT_USER, MainKey & "\" & SubKey & "\", "Program By:", AuthorName
    SaveSettingString HKEY_CURRENT_USER, MainKey & "\" & SubKey & "\", "User Name:", ""
    SaveSettingString HKEY_CURRENT_USER, MainKey & "\" & SubKey & "\", "PrgmSet", ""
    SaveSettingString HKEY_CURRENT_USER, MainKey & "\" & SubKey & "\", "Registration Number", ""
    SaveSettingString HKEY_CURRENT_USER, MainKey & "\" & SubKey & "\", "Installation Date", Date
    SaveSettingString HKEY_CURRENT_USER, MainKey & "\" & SubKey & "\", "Expiration Date", "12/03/2006"

    
'******************************************************************************************
'******************************************************************************************

    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
'******************************************************************************************
'******************************************************************************************

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload Me
End Sub

frmProductRegistration

Option Explicit

'*******************************************************************************************************************************************************************************************************************************************************
'NB! - Look at the Form Load Event, This is where you would set values for
'      your applications "Main Key" and it's "SubKey", in addition, ll of the
'      Text Box values for this demo are set there.  You should Delete or
'      Remark out all of the present values.
'*******************************************************************************************************************************************************************************************************************************************************
'The Following API and it's Constant is used to Open Windows Notepad with the
'contents of this Registration Form included
'*******************************************************************************************************************************************************************************************************************************************************
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWMAXIMIZED = 1
'*******************************************************************************************************************************************************************************************************************************************************
Dim txtIndex As Single    'Index value for the Text Box Array
Dim bb As String          'String Value of the last character in the MEdit Box-Telephone Number
Dim cc As String          'String Value of the last character in the MEdit Box-Registration Number
Dim MainKey As String     'Name of Main Key to save in the Windows Registry
Dim SubKey As String      'Name of SubMain Key to save in the Windows Registry
Dim EncText As String     'Used to Encrypt the PgrmSet Value in the Registry
Dim DecText As String     'Used to Decrypt the PgrmSet Value in the Registry
Dim RetVal As Integer     'Used in the Message Box Routines

Private Sub cmdRegister_Click()

'Check to see that all the Text Boxes are filled in
For txtIndex = 1 To 8
    If txtIndex = 3 And Text1(3) = "" Then Text1(3) = "-"
        If Text1(txtIndex) = "" Then
            'VB-6 Message Box Generator Add-In
            'By: John P. Cunningham
            RetVal = MsgBox("All items must be filled in", 48, SubKey & " Product Registration")
            Exit Sub
        End If

Next
'*****************************************************************************

'Check to see that the telephone number is filled in
'Must use Mid Function, can't use Right Function because the
'MaskedEdit Control will put the last Mask Character, an underscore
'into the value bb but the Right Function will not!
bb = Mid(meboxTelephone, 12, 12) 'looking for the last
                                 'character in the field
 If bb = "_" Then
    MsgBox ("The Telephone Number MUST be completly filled in"), 0, SubKey & (" Product Registration")
    meboxTelephone.SetFocus
    Exit Sub
End If
'*****************************************************************************
'Check to see that the Registration Number is filled in
'Must use Mid Function, can't use Right Function because the
'MaskedEdit Control will put the last Mask Character, an underscore
'into the value bb but the Right Function will not!
cc = Mid(txtRegistrationNumber, 11, 11) 'looking for the last
                                        'character in the field
 If cc = "_" Then
    MsgBox ("The Registration Number MUST be completly filled in"), 0, SubKey & (" Product Registration")
    txtRegistrationNumber.SetFocus
    Exit Sub
End If
'*****************************************************************************
'Because the Application is going to be Registered we can -
'delete the Expiration Date Settings from the Windows Registry
If checkit Then 'HKEY_CURRENT_USER was set

    DelSetting HKEY_CURRENT_USER, MainKey & "\" & SubKey & "\", "Expiration Date"
    
Else 'HKEY_LOCAL_MACHINE was set

    DelSetting HKEY_LOCAL_MACHINE, MainKey & "\" & SubKey & "\", "Expiration Date"
    
End If
'*****************************************************************************
'Here we Encrypt the Application's Registration Number, which is then used
'to make the PrgmSet Value
Dim TextIn As String
Dim StringEncrypt As String
Dim stringDecrypt As String

TextIn = txtRegistrationNumber
'*****************************************************************************
'Here we make a simple encryption of the Registration Number by calling
'the simple Encrypt Subroutine - you can use your own method instead
StringEncrypt = Encrypt(TextIn, EncText)
'The following Text Box is not visible - Unremark the next line to test
'txtEncryptedRegNo.Visible=True
txtEncryptedRegNo = "Encrypted Registration Number = " & EncText
'*******************************************************************************
'Check to see which Key was set
If checkit Then 'HKEY_CURRENT_USER was set

    SaveSettingString HKEY_CURRENT_USER, MainKey & "\" & SubKey & "\", _
        "Registration Number", txtRegistrationNumber
    
    SaveSettingString HKEY_CURRENT_USER, MainKey & "\" & SubKey & "\", _
        "User Name", Text1(0)
'*******************************************************************************
'Save the PrgmSet value encrypted
    SaveSettingString HKEY_CURRENT_USER, MainKey & "\" & SubKey & "\", _
        "PrgmSet", EncText
'*******************************************************************************
Else  'HKEY_LOCAL_MACHINE was set

     SaveSettingString HKEY_LOCAL_MACHINE, MainKey & "\" & SubKey & "\", _
        "Registration Number", txtRegistrationNumber
    
    SaveSettingString HKEY_LOCAL_MACHINE, MainKey & "\" & SubKey & "\", _
        "User Name", Text1(0)
'*******************************************************************************
'Save the PrgmSet value encrypted
    SaveSettingString HKEY_LOCAL_MACHINE, MainKey & "\" & SubKey & "\", _
        "PrgmSet", EncText
'*******************************************************************************

End If
'*******************************************************************************
'Here we Decrypt the value of the PrgmSet - this is just for development
'purposes
stringDecrypt = Decrypt(EncText, DecText)
'The following TextBox is not visible - UnRemark the next line to test
txtDecrypted.Visible = True
txtDecrypted = "DecryptedRegNumber = " & DecText

'*******************************************************************************
'Use the "Kill Statement" here so that the file does not get added to each time
'that you run your tests
Kill App.Path + "\" & SubKey & "Registration.txt"
'*******************************************************************************
'The following code creates a file to save our registration information
 
    ' The actual steps we must do in order to save the this info
    ' 1) Determine the filename of the datafile to create (or replace)
    ' 2) Determine location in which to save the data file
    ' 3) Obtain a file handle with which to refer to the data file
    ' 4) Open the datafile
    ' 5) Write the information to the data file
    ' 6) Close the data file.
'*******************************************************************************
    ' Step 1) Determine the filename of the datafile to create (or replace)
    Dim FileName As String
    FileName = SubKey & "Registration.txt"
'*******************************************************************************
    ' Step 2) Determine location in which to save the data file
    ' We will use the program's path to save the file
    Dim PathName As String
    PathName = App.Path + "\"
'*******************************************************************************
    ' Step 3) Obtain a file handle with which to refer to the data file
    Dim FileNum As Integer
    FileNum = FreeFile
'*******************************************************************************
    ' Step 4) Open the file -  write/append it
    ' 4/17/1998 by JPC
    
    Open PathName & FileName For Append As #FileNum
    
    ' Step 5) Write the information to the file
'*******************************************************************************
 
         Print #FileNum, "             " & SubKey & " Registration"
         Print #FileNum, "          ====================================="
         Print #FileNum, ""
         Print #FileNum, ""
         Print #FileNum, "     This File has been saved as: " & SubKey & "Registration.txt"
         Print #FileNum, "     In the program's directory. It has also been printed to "
         Print #FileNum, "     your printer. "
         Print #FileNum, ""
         Print #FileNum, "     Please send this information to:"
         Print #FileNum, ""
         Print #FileNum, "                     Your Company, Inc."
         Print #FileNum, "                     126 Any Street"
         Print #FileNum, "                     Any Town, Any State"
         Print #FileNum, "                     USA 12345 "
         Print #FileNum, ""
         Print #FileNum, "   Attn: Sales Mgr."
         Print #FileNum, ""
         Print #FileNum, "     Or attach it to an email and email to:  "
         Print #FileNum, ""
         Print #FileNum, "                     [e-mail]"
         Print #FileNum, ""
         Print #FileNum, "     Or Fax to:      401-222-1234 -  Attn: Sales Manager"
         Print #FileNum, "===================================================================="
         Print #FileNum, ""
         Print #FileNum, ""
         Print #FileNum, "                  Date:            " & Date
         Print #FileNum, ""
         Print #FileNum, "                  Name:            " & Text1(0).Text
         Print #FileNum, "                  Company Name:    " & Text1(1).Text
         Print #FileNum, "                  Street:          " & Text1(2).Text
         Print #FileNum, "                  Address2:        " & Text1(3).Text
         Print #FileNum, "                  City:            " & Text1(4).Text
         Print #FileNum, "                  Province/State:  " & Text1(5).Text
         Print #FileNum, "                  Country:         " & Text1(6).Text
         Print #FileNum, "                  Postal/Zip Code: " & Text1(8).Text
         Print #FileNum, "                  Email:           " & Text1(7).Text
         Print #FileNum, "                  Telephone:       " & meboxTelephone
         Print #FileNum, "  "
         Print #FileNum, "                  Serial Number:   " & txtRegistrationNumber.Text
     
'****************************************************************************************************************************
    ' Step 6) Close the data file.
    Close #FileNum
'****************************************************************************************************************************
'Show the file in Notepad, the default for "*.txt" files
ShellExecute Me.hWnd, vbNullString, App.Path & "\" & "MyApplicationRegistration.txt", vbNullString, "C:\", SW_SHOWMAXIMIZED
'****************************************************************************************************************************

'****************************************************************************************************************************
'              Send the contents of the File to the Printer
'*******************************************************************************
         Printer.Print
         Printer.Print
         Printer.Print
         Printer.Print
         Printer.Print , "                " & SubKey & " Registration"
         Printer.Print , "          ========================================="
         Printer.Print , ""
         Printer.Print , ""
         Printer.Print , "     This File has been saved as: " & SubKey & "Registration.txt"
         Printer.Print , "     In the program's directory.  "
         Printer.Print , ""
         Printer.Print , ""
         Printer.Print , "     Please send this information send to:"
         Printer.Print , ""
         Printer.Print , "                     Your Company, Inc."
         Printer.Print , "                     126 Any Street"
         Printer.Print , "                     Any Town, Any State "
         Printer.Print , "                     USA 00000 "
         Printer.Print , ""
         Printer.Print , "    Attn:  Sales Mgr."
         Printer.Print , ""
         Printer.Print , "     Or attach it to an email and email to:  "
         Printer.Print , ""
         Printer.Print , "                     [e-mail]"
         Printer.Print , ""
         Printer.Print , "     Or Fax to:      401-222-1234 -  Attn: Sales Manager"
         Printer.Print , ""
         Printer.Print , "===================================================================="
         Printer.Print , ""
         Printer.Print , ""
         Printer.Print , "                  Date:            " & Date
         Printer.Print , ""
         Printer.Print , "  Name:            " & "                " & Text1(0).Text
         Printer.Print , "  Company Name:    " & "         " & Text1(1).Text
         Printer.Print , "  Street:          " & "                 " & Text1(2).Text
         Printer.Print , "  Address2:        " & "                " & Text1(3).Text
         Printer.Print , "  City:            " & "                   " & Text1(4).Text
         Printer.Print , "  Province/State:  " & "             " & Text1(5).Text
         Printer.Print , "  Country:         " & "                 " & Text1(6).Text
         Printer.Print , "  Postal/Zip Code: " & "            " & Text1(8).Text
         Printer.Print , "  Email:           " & "                  " & Text1(7).Text
         Printer.Print , "  Telephone:       " & "               " & meboxTelephone
         Printer.Print , ""
         Printer.Print , "  Registration Number:   " & txtRegistrationNumber.Text
         
      Printer.EndDoc

'**********************************************************
'**Your Application's opening Form replaces the one below**
frmTestApp.Show
'**********************************************************
Unload Me

End Sub


Private Sub Command1_Click()

 Shell "C:\Windows\Regedit.exe", vbNormalNoFocus
 
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)

'Set the Form's KeyPreview to True.
If KeyAscii = vbKeyReturn Then
    KeyAscii = 0
    SendKeys "{TAB}"
End If

End Sub

Private Sub Form_Load()
'*********************************************************
'Delete  or Remark the Text Box values below
'*********************************************************
Text1(0) = "John Cunningham"
Text1(1) = "AAMyCompany"
Text1(2) = "123 Any Street"
'Text1(3) = "P.O. Box 111"
Text1(4) = "Any Town"
Text1(5) = "Any State"
Text1(6) = "USA"
Text1(7) = "[e-mail]"
Text1(8) = "12345"
meboxTelephone = "401-222-1234"
txtRegistrationNumber = "314-1A34O78"      'X1X -XAXXOXX

'*********************************************************
'*********************************************************
'Set the Value of the MainKey and SubKey
MainKey = "Registersoft"
SubKey = "Reg Check"
'*********************************************************
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
'*********************************************************
'Use the Application's Name for this Form's Caption
Me.Caption = Space(45) & SubKey & " Product Registration "
'*********************************************************

End Sub

Private Sub meboxTelephone_GotFocus()
'pre-select (highlite) text upon entry into the Telephone Number Mask

With meboxTelephone
    .SelStart = 0
    .SelLength = Len(meboxTelephone)
End With

End Sub

Private Sub meboxTelephone_KeyPress(KeyAscii As Integer)
    'Allow numbers only in Masked Edit Box
    If InStr("0123456789-.", Chr(KeyAscii)) = 0 And _
        KeyAscii <> vbKeyBack Then KeyAscii = 0
End Sub

Private Sub Text1_GotFocus(txtIndex As Integer)
'pre-select (highlite) text upon entry into each textbox

For txtIndex = 0 To 8
    Text1(txtIndex).SelStart = 0
    Text1(txtIndex).SelLength = Len(Text1(txtIndex))
Next

End Sub

Private Sub Text1_KeyPress(txtIndex As Integer, KeyAscii As Integer)

If txtIndex = 6 Then Exit Sub
If txtIndex = 7 Then Exit Sub
On Local Error Resume Next
   If KeyAscii > 95 And KeyAscii < 123 Then
'Capitalize the first character
        If Text1(txtIndex).SelStart = 0 Then
            KeyAscii = KeyAscii - 32
    'if more than one word capitalize
    ElseIf Mid$(Text1(txtIndex).Text, Text1(txtIndex).SelStart, 1) < "!" Then
        KeyAscii = KeyAscii - 32
         End If
    End If
  '************************

If KeyAscii = 13 Then
    KeyAscii = 0
    SendKeys "{TAB}"
End If

End Sub

Private Sub Text1_LostFocus(txtIndex As Integer)

If txtIndex = 5 And Text1(5) = "" Then
    Text1(6) = ""
    Text1(6) = "USA"
End If

End Sub
Public Function Encrypt(TextIn As String, EncText As String)

    Dim Letter As String
    Dim i As Integer
    For i = 1 To Len(TextIn)
        Letter = Mid$(TextIn, i, 1)
        Mid$(TextIn, i, 1) = Chr(Asc(Letter) + 1)
    Next i
EncText = TextIn

End Function

Public Function Decrypt(ByVal EncText As String, DecText As String)

Dim Letter As String
Dim i As Integer
    For i = 1 To Len(EncText)
        Letter = Mid$(EncText, i, 1)
        Mid$(EncText, i, 1) = Chr(Asc(Letter) - 1)
    Next i
    DecText = EncText
    
End Function

Private Sub txtRegistrationNumber_GotFocus()
'pre-select (highlite) text upon entry into the Registration Number Mask

With txtRegistrationNumber
    .SelStart = 0
    .SelLength = Len(txtRegistrationNumber)
End With
End Sub

frmTestApp

Option Explicit
'***************************************************

Private Sub cmdExit_Click()
     UnloadAllForms
End Sub

Private Sub Form_Load()
Dim MainKey As String
Dim SubKey As String
Dim Decode As String
Dim Decode1 As String
Dim Decode2 As String
Dim Decode3 As String
Dim CheckValue As String
Dim RetVal As Integer

Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
'For development/testing purposes change this Form's height to:
'Me.Height = 4260
Me.Height = 2160

MainKey = "Software\AAMyCompany"
SubKey = "MyApplication"


If frmCheckRegistration.cmdRegisterLater Then
    lblDaysLeft.Visible = True
    lblDaysLeft = " Program Not Registered - Only " & frmCheckRegistration.Text4
Else
'***********************************************************************
'Here is where you check to see if the Registration Number/PrgmSet value
'is valid.  The present program has it's Registration Number's value set
'to accept 11 characters.  Since the PgrmSet value is just an encrypted
'version of the Registration Number, it also has 11 characters.
'If we wanted valid Registration Numbers to have specific characters in
'in specific loactions, we would assign and check them here. Suppose
'that in positons 2, 6 and 9 the characters "1", "A" and ' "O" must be
'present, then the Registration Number would be:  "X1X-XAXXOXX"
'and the PrgmSet encrypted value would be:  "Y2Y.YBYYPYY"
'***********************************************************************
If checkit Then 'Get the appropriate Key
    Decode = _
    GetSettingString(HKEY_CURRENT_USER, MainKey & "\" & SubKey & "\", "PrgmSet")
Else
    Decode = _
    GetSettingString(HKEY_LOCAL_MACHINE, MainKey & "\" & SubKey & "\", "PrgmSet")

End If

Decode1 = Mid(Decode, 2, 1)
Decode2 = Mid(Decode, 6, 1)
Decode3 = Mid(Decode, 9, 1)
CheckValue = Decode1 & Decode2 & Decode3
Text1 = Decode
Text2 = Decode1
Text3 = Decode2
Text4 = Decode3
Text5 = CheckValue

    If CheckValue <> "2BP" Then
        'VB-6 Message Box Generator Add-In
        'By: John P. Cunningham
       ' RetVal = MsgBox("Incorrect Registration Number!", 16, "          Program Registration")
       ' UnloadAllForms
        
    End If
    
End If


End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
UnloadAllForms
End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload Me
End Sub

In a module, the following -

modWinRegistry

Option Explicit
'***************************************************

Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public 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

Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002

Public Const ERROR_SUCCESS = 0&
Public Const REG_SZ = 1

'******************************************************************
'** The following Global Declaration is used to check which      **
'** Registry Root Key has been selected, i.e., HKEY_CURRENT_USER **
'** or HKEY_LOCAL_MACHINE                                        **
'******************************************************************
Global checkit As Boolean

Public Sub SaveSettingString(hKey As Long, strPath As String, strValue As String, strData As String)
Dim RKey As Long
Dim Result As Long

    Result = RegCreateKey(hKey, strPath, RKey)
    Result = RegSetValueEx(RKey, strValue, 0, REG_SZ, ByVal strData, Len(strData))
    Result = RegCloseKey(RKey)
    
End Sub

Public Sub DeleteValue(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String)

Dim RKey As Long
Dim Result As Long

    Result = RegOpenKey(hKey, strPath, RKey)
    Result = RegDeleteValue(RKey, strValue)
    Result = RegCloseKey(RKey)

End Sub

Public Function DeleteKey(ByVal hKey As Long, ByVal strKey As String)
Dim r As Long

    r = RegDeleteKey(hKey, strKey)
    
End Function

Public Function GetSettingString(hKey As Long, strPath As String, strValue As String, Optional Default As String) As String
Dim hCurKey As Long
Dim lValueType As Long
Dim strBuffer As String
Dim lDataBufferSize As Long
Dim intZeroPos As Integer
Dim lRegResult As Long

' Set up default value
If Not IsEmpty(Default) Then
  GetSettingString = Default
Else
  GetSettingString = ""
End If

' Open the key and get length of string
lRegResult = RegOpenKey(hKey, strPath, hCurKey)
lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, ByVal 0&, lDataBufferSize)

If lRegResult = ERROR_SUCCESS Then

  If lValueType = REG_SZ Then
    ' initialise string buffer and retrieve string
    strBuffer = String(lDataBufferSize, " ")
    lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, ByVal strBuffer, lDataBufferSize)
    
    ' format string
    intZeroPos = InStr(strBuffer, Chr$(0))
    If intZeroPos > 0 Then
      GetSettingString = Left$(strBuffer, intZeroPos - 1)
    Else
      GetSettingString = strBuffer
    End If

  End If

Else
  ' there is a problem
End If

lRegResult = RegCloseKey(hCurKey)
End Function
Sub DelSetting(hKey As Long, strPath As String, strValue As String)
    Dim Ret As Variant
    'NB! Create a new key-must recreate the key with no actual setting
    RegCreateKey hKey, strPath, Ret
    'Delete the key's value
    RegDeleteValue Ret, strValue
    'close the key
    RegCloseKey Ret
End Sub
Public Sub UnloadAllForms()
Dim Form As Form
   For Each Form In Forms
      Unload Form
      Set Form = Nothing
   Next Form
End Sub

a Bit more work, enjoy.:)

[ash07]

I m done with that.. will check /test code..asap
thanks for ur efforts

[AndreRet]

It was a pleasure. The code is about the best security you can get, so I believe that this question is now completed.:)

As I said, enjoy, it is really a strong way of protecting your application from piracy.

Please mark this thread as solved, thanks.

[ash07]

Hi AndreRet
Please check your msg I've sent you a query on the same.
Thanks in advance

[AndreRet]

Ash, I have read your PM. As my post stated, this is quite advanced, but it works wonders. I unfortunately do not have the time available to go through an entire tutorial. Just search Google with "Registry Keys in vb6" as key words. There are tons of tutorials that will explain it much better than I could do it. You will however have to get some basic knowledge about this, it can render your system inoperable...:)

[ash07]

Ok.. AndreRet,
Thanks for your words...

Ash, I have read your PM. As my post stated, this is quite advanced, but it works wonders. I unfortunately do not have the time available to go through an entire tutorial. Just search Google with "Registry Keys in vb6" as key words. There are tons of tutorials that will explain it much better than I could do it. You will however have to get some basic knowledge about this, it can render your system inoperable...:)

[AndreRet]

It was a pleasure.:) Happy coding. Trust me, once you get the knack of the code I supplied, You can achieve tons more with API's.;)