# VBForums CodeBank > CodeBank - Visual Basic 6 and earlier >  VB - A Program Registration Scheme

## MartinLiss

Attached is a project (actually two projects) that show one way of having the user register his copy of your program. This is the way it works:

The main application displays a registration screen with two options: "Register" and "Request Registration Key".If the user selects "Register" a new screen is shown that asks the user for his name and tells him that if he continues it will generate an e-mail message to you (via MAPI) and that you will send him the registration key by return e-mail. If he continues, the program gets his hard drive serial number and includes it in the e-mail to you.Once you receive the registration request email, you use the second project (GenKey) to generate a registration key by way of a simple algorithm that you can change based on the hard drive serial number. Just remember that the algorithm is in both projects and it must be exactly the same in both.You then send the registration key back to the user and have them enter it in the second part of the registration screen which writes the key to the registry.When they start the main program again it uses the same algorithm to see if the registration key in the Registry matches the HD serial number. If it matches the program starts (see Notes below). If it doesn't match or if there is no registry entry, the program does not start or you could arrange it so that it starts with only a few demo functions available. 

Notes:Your main form must be shown using vbModal.You will need to modify the program to change the constant named EMAIL to your e-mail address.You should change the registration key algorythm. See CalcRegKey in modProtect and Sub Main in modGenKey. The changes should be the same in both places.

----------


## Synthesize

Pretty neat, I did this a while back for an application of mine that I never got around to releasing...I really want to fix a few bugs in it and then release it to the public. It is of great help to me and my friends.

----------


## j2k

Just one small bug I found in the keygen project, which I thought I should share in case anyone is using this technique to create keys -- on my PC, the Serial Number generated was a minus number. If I put that in the keygen, an invalid procedure call error occurred.

To fix:

Change the following line:


VB Code:
strLicenseKey = CStr(Int(3456 * Sqr(lngSerialNum / 5)))

to:


VB Code:
strLicenseKey = CStr(Int(3456 * Sqr(Abs(lngSerialNum) / 5)))

This forces the number to be turned from minus figures to a positive number, and generates the correct key.

Cheers

----------


## evexa

Hey Martin,
It reads my hard drive serial number as '0' is that right?

----------


## MartinLiss

> _Originally posted by evexa_ 
> *Hey Martin,
> It reads my hard drive serial number as '0' is that right?*


 I doubt it. Check your code against mine and if you can't find anything wrong, zip up your code and I'll take a look at it.

----------


## evexa

> _Originally posted by MartinLiss_ 
> *I doubt it. Check your code against mine and if you can't find anything wrong, zip up your code and I'll take a look at it.*


Thing is I never changed your code - I just was testing it.

Maybe i need to change a setting somewhere?

----------


## MartinLiss

Then I don't know what is going on since 187 other people have downloaded it and no one that I know of has experienced your problem. I know the code works on both NT4 and XP. What is your operating system?

----------


## evexa

> _Originally posted by MartinLiss_ 
> *Then I don't know what is going on since 187 other people have downloaded it and no one that I know of has experienced your problem. I know the code works on both NT4 and XP. What is your operating system?*


XP - I must be special  :Wink: 
Maybe because of the HD - because its a laptop? Im guessing here...

----------


## evexa

Oh - another thing - I get this error :

Can't show non-modal form when modal is displayed

Probably has to do with this:

VB Code:
Public Sub Main()
     Dim frm As Form
    
    GetAppEnvironment
    
    If Not gRegClass.Registered Then
        frmRegister.Show vbModal
    Else
        frmDone.Show vbModal
    End If
    
    For Each frm In Forms
        Unload frm
        Set frm = Nothing
    Next
    
    End
 End Sub

How do I make it so that it lets me open the other forms in the project  :Big Grin: ?
Cheers xxxx

----------


## MartinLiss

I don't know what's happening on your PC. What option do you choose when you see the form that says "In order for you to be able to use the full funtionality..."?

----------


## evexa

> _Originally posted by MartinLiss_ 
> *I don't know what's happening on your PC. What option do you choose when you see the form that says "In order for you to be able to use the full funtionality..."?*


Hm - well it wont let me open that way anymore because i registered myself  :Mad:  but I dont remember choosing an option at all! =/

----------


## evexa

I made it go back to that screen - i chose to request a registration key - bad?

----------


## MartinLiss

Are you comfortable with editing the Registry? If so, let's start over. 
Run RegEditGo To _HKEY_CURRENT_USER|Software|VB and VBA Program Settings_ Find the _Protect_ folder and delete itIn the program change *Public Const EMAIL = "xxx@yyy.zzz"* to reflect your email addressRun the program and select _Register_Let me know what happens at that point.

----------


## evexa

Cool - first time editing the registry but did as asked.
Now when i click register it goes to the whole registration form this - where you enter your key etc....

WHat now?

----------


## MartinLiss

If you've modified the email address in the application like I suggested above, then

Choose the _Request Registration Key_ option.That should result in you receiveing an email containing your HD serial number.Take that serial number and run it through the GenKey application.GenKey will give you the registration key.Run the Protect application again, selecting the _Register_ optionEnter the key and you're done.

BTW, both applications contain an algorythm that starts *strLicenseKey = CStr(Int*. You'll probably want to change that in _both_ applications (the same way) so that your calculation will be different from other people who use this registration scheme.

----------


## JasonC

I think that basing any registration scheme off any one piece of hardware is a very bad idea, and extremely bad for business.

I would hate to think that I couldn't reinstall my Visual Studio because my hard drive died, or I upgraded to a larger one and needed to reinstall......

----------


## MartinLiss

> _Originally posted by JasonC_ 
> *I think that basing any registration scheme off any one piece of hardware is a very bad idea, and extremely bad for business.
> 
> I would hate to think that I couldn't reinstall my Visual Studio because my hard drive died, or I upgraded to a larger one and needed to reinstall......*


 I would call it a disadvantage rather than a bad idea. Yes, if you are going to have thousands of users then you might want to use some other scheme, but unfortunately not many of us will face that "problem". For most of us, if one of our users needs to replace their hard drive, all they need to do is to request a new registration key. I have not had to do that for anyone yet, but just in case, I keep a record of my users with names, HD serial numbers, date requested, etc.

----------


## MartinLiss

> _Originally posted by evexa_ 
> *Lol its still saying '0' is my HD number =)
> and it still says:
> cannot show non modal form when modal is diplayed.*


 Sorry then, but without your PC in front of me I can't tell what's going on.

----------


## evexa

I will work on it - but before i delve could you tell me what this piece of script does?

Public Sub Main()

    Dim frm As Form

    GetAppEnvironment

    If Not gRegClass.Registered Then
        frmRegister.Show vbModal
    Else
        frmDone.Show vbModal
    End If

    For Each frm In Forms
        Unload frm
        Set frm = Nothing
    Next

    End

End Sub


thank you xxxx

----------


## MartinLiss

VB Code:
Dim frm As Form ' Create a Form object
    
    GetAppEnvironment ' Calls the routine that finds out if the user is registered
    
    If Not gRegClass.Registered Then ' Registered is a boolean property of theCRegister class
        frmRegister.Show vbModal ' If the user is not registered then the register form is displayed
    Else
        frmDone.Show vbModal ' In this app if the user is registered then frmDone is displayed.
                             ' In your app you would probably replace frmDone with your main form
    End If
    
    For Each frm In Forms ' Loop through all the forms...
        Unload frm        ' and unload them...
        Set frm = Nothing ' and set them to Nothing
    Next
    
    End ' 99.99999% of the time not needed, but it can't hurt after you've unloaded your forms.

----------


## cgi

nice idea but you know that there's no way to  secure your prog's it will be cracked whatever you do  :Smilie:

----------


## evexa

> _Originally posted by cgi_ 
> *nice idea but you know that there's no way to  secure your prog's it will be cracked whatever you do *


There is no way to stop that?

----------


## MartinLiss

Consider this. While a thief can break a window to get into a house even though the door may be locked, he will most likely check the doors first and enter the house that is unlocked. The point is that while no security method is foolproof, it still makes sense to "lock the door".

----------


## evexa

> _Originally posted by MartinLiss_ 
> *Consider this. While a thief can break a window to get into a house even though the door may be locked, he will most likely check the doors first and enter the house that is unlocked. The point is that while no security method is foolproof, it still makes sense to "lock the door".*


Agreed.

----------


## manavo11

> _Originally posted by MartinLiss_ 
> *Consider this. While a thief can break a window to get into a house even though the door may be locked, he will most likely check the doors first and enter the house that is unlocked. The point is that while no security method is foolproof, it still makes sense to "lock the door".*


Excellent point  :Wink:

----------


## dnrodrigo

Why not use the motherboard SN?

VB Code:
'Add a reference to Microsoft WMI Scripting Library
 Private Sub Form_Load()
     Dim List
    Dim Object
    Dim WMI
     Set WMI = GetObject("WinMgmts:")
    Set List = WMI.InstancesOf("Win32_BaseBoard")
     For Each Object In List
        MsgBox Object.SerialNumber
    Next
    
    Unload Me
    
End Sub

----------


## MartinLiss

Doesn't work on my XP PC.

----------


## evexa

> _Originally posted by MartinLiss_ 
> *Doesn't work on my XP PC.*



So the code doesnt work on XP full stop?

Is there anything that is not OS specific - maybe the motherboard SN as the gentleman above suggested?

----------


## dnrodrigo

Ah yes... the problem is not OS specific; Some hardware manufacturers don't embed serial number information in their parts.

As far as _evexa's_ drive returning a 0, this is quite possible.  There are utilities such as those available from Sysinternals and PowerQuest (or even DOS's Debug) to edit or completely remove the VSN.

As an alternative, a combination of the Motherboard, Processor, BIOS, and Disk serial numbers could still be used.  The formula to manipulate the strLicenseKey would have to be changed, but that should be fairly straight forward.

For _JasonC_, simply exclude the Disk serial number so he can swap out his hard drive  :Wink: 

And for _cgi_, he's right... if someone wants something bad enough, they'll do anything to get it.  But your "locked door" analogy is right on the money... Locks were designed to keep honest people honest.

Use it if you like it... if not, at least you have stimulated our thought processes.


VB Code:
Private Sub Form_Load()
    Dim List
   Dim Msg
   Dim Object
   
   On Local Error Resume Next
   
   Set List = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_BaseBoard")
   For Each Object In List
      Msg = Msg & "Motherboard Serial Number: " & Object.SerialNumber & vbCrLf
   Next
    Set List = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_Processor")
   For Each Object In List
      Msg = Msg & "Processor Unique ID: " & Object.UniqueID & vbCrLf
   Next
    Set List = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_BIOS")
   For Each Object In List
      Msg = Msg & "BIOS Serial Number: " & Object.SerialNumber & vbCrLf
   Next
    Set List = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_LogicalDisk")
   For Each Object In List
      Msg = Msg & "Disk Serial Number: " & Object.VolumeSerialNumber & vbCrLf
   Next
    MsgBox Msg
   Unload Me
 End Sub

----------


## evexa

Its a good idea to use all those serial numbers - but- asnd this is a newbie talking... What if it wasnt able to grasp one of the numbers - or the number changes - like for example if they swap hard drives... maybe its better just to use ONE source for SNs

----------


## dnrodrigo

Here's an article on how Micro$oft does it; http://www.extremetech.com/article2/0,3973,10426,00.asp

----------


## Cosmictej

Martin, this is quite a nice piece of source. But I have a questionsfor you, ok well
Once the program is registered, will it always come up?,

----------


## MartinLiss

When you say "will it always come up", what do you mean by "it"? If you mean the registration form, then no it won't.

----------


## Cosmictej

Yea thats what I ment

----------


## Cosmictej

Ok, I need some help using this. I made the downloaded file a .exe. And I registered it, but then when I got to the happy face screen, and pressed ok it exited. Then I thought okt hats registered but when I open it again I have to register it again

----------


## MartinLiss

It's got to have something to do with the way you modified the SaveSetting and GetSetting calls in the program. There are 2 places where SaveSetting is used and 3 places where GetSetting is used. Can you show what you did in those 5 places please?

----------


## Cosmictej

I didnt do any editing! Im not to good with Vb lol

----------


## MartinLiss

Post your app in a zip file and I'll take a look at it later on today.

----------


## Cosmictej

Its too big, shall i email it to you?

----------


## Cosmictej

Or maybe I could upload the main page?

----------


## MartinLiss

We could try that, but I sent you a Private Message that you haven't opened that contains my email address.

----------


## Cosmictej

I have sent the email, like I said in the email, I am very grateful, Thanks

----------


## Cosmictej

Martin, If I update the vb files, And add more stuff, once installed on a computer where it hasnt been registered, will it still ask for the registration?

----------


## MartinLiss

> _Originally posted by Cosmictej_ 
> *Martin, If I update the vb files, And add more stuff, once installed on a computer where it hasnt been registered, will it still ask for the registration?*


No, once registered the user is always registered unless they change their hard drive.

----------


## Cosmictej

Thanks Martin for all your help

----------


## BrianS

MAC ID is a solid number to use as well.  At least that only changes if you change NIC's/Motherboards with onboard NICs.

----------


## pavan

Hey Martin

I've downloaded the files and tried to run Protect.vbp  file from the IDE. I've selected the  *Request Registration Key* option, entered my name and clicked next. It generates error at the line  
VB Code:
[COLOR=crimson]mpMessages.ResolveName[/COLOR]

The error says

Runtime Error '32026'

Not Supported


Could u pls. Help me with this

----------


## MartinLiss

I'm sorry but I have no idea why you are getting that error. Did you change _anything_ in the program? Do you have Outlook on your PC?

----------


## Cosmictej

Umm, Martin I recieved an email from someone wanting to register my program and it says this Dinger3410 472400162  but when I enter it in the gen. It dont work I didnt change any of the algo

----------


## MartinLiss

Is 472400162 the HD serial number or is it the value the you got from GenKey? You should also make sure that the alogrythm in GenKey is the same as the one in the app.

----------


## Cosmictej

Its ok, I worked it out, basically the guy who registered, the name included numbers Thanks Martin

----------


## Cosmictej

Martin, I updated my files, and now poeple who have registered, cant register and cant use the functions as it asks them to register.

----------


## MartinLiss

> _Originally posted by Cosmictej_ 
> *Martin, I updated my files, and now poeple who have registered, cant register and cant use the functions as it asks them to register.*


 I'm sorry but I don't understand what you are saying.

----------


## Cosmictej

Umm basically, I updated the files and sent them 2 people who had the older version. It doesnt ask them to register but instead when they use it where this code is
  If Not gRegClass.Registered Then
        MsgBox "You must be registered in order to use this function.", vbInformation, "Not Registered"
        Exit Sub
    End If

they cant use the program. I need it to realise this is an update.

----------


## MartinLiss

Do you have the program code set up properly? The following is the important code. (frmDone should be replaced by your normal first form). Note that Sub Main calls GetAppEnvironment and if the person is registered then gRegClass.Registered gets set to True.

Did you send them the code that included my code?


VB Code:
Public Sub Main()
     Dim frm As Form ' Create a Form object
    
    GetAppEnvironment ' Calls the routine that finds out if the user is registered
    
    If Not gRegClass.Registered Then ' Registered is a boolean property of theCRegister class
        frmRegister.Show vbModal ' If the user is not registered then the register form is displayed
    Else
        frmDone.Show vbModal ' In this app if the user is registered then frmDone is displayed.
                             ' In your app you would probably replace frmDone with your main form
    End If
    
    For Each frm In Forms ' Loop through all the forms...
        Unload frm        ' and unload them...
        Set frm = Nothing ' and set them to Nothing
    Next
    
    End ' 99.99999% of the time not needed, but it can't hurt after you've unloaded your forms.
 End Sub

VB Code:
Public Sub GetAppEnvironment()
'***************************************************************************
'Purpose: Get the application environment
'Inputs:  None
'Outputs: None
'***************************************************************************
     Dim strKey As String
    
    On Error GoTo ErrorRoutine
    
    strKey = GetSetting(App.EXEName, "Registration", "Registration Key", "123456789")
    If strKey = CalcRegKey(GetSerialNumber) Then
        gRegClass.Registered = True
        g_strRegTo = GetSetting(App.EXEName, "Registration", "User", "Registered User")
    Else
        gRegClass.Registered = False
    End If
    
ErrorRoutine:
     If Err.Number <> 0 Then
        DisplayError "GetAppEnvironment"
        End
    End If
 End Sub

----------


## Cosmictej

Mate you sorted it our for me

----------


## MartinLiss

What was the problem?

----------


## evexa

Yet another question for you Marty.

I used inno Setup to compile my setup file.
At which point I tried the disc on another machine - but the registration program didnt come up - it just went straight to the first form!
What do I need to include in the install? Any registry entries? INNO didnt seem to pick up on anything.

Cheers

Eve
xxx

----------


## MartinLiss

The setup won't affect anything; everything that's needed is in the code. Take a look at the code I posted a couple of posts up for Cosmictej where I showed what Sub Main and GetAppEnvironment should look like. Did you include that code and does your code look like that?

----------


## evexa

> _Originally posted by MartinLiss_ 
> *The setup won't affect anything; everything that's needed is in the code. Take a look at the code I posted a couple of posts up for Cosmictej where I showed what Sub Main and GetAppEnvironment should look like. Did you include that code and does your code look like that?*


Yup they are identical
I wish they werent - it would probablly make it simpler lol :wave:   :Smilie:

----------


## MartinLiss

Would you want to zip up and send me your source code?

----------


## MartinLiss

evexa, I looked at your code and the project Startup Object should be Sub Main and not Form1. The way it works is that Sub Main calls the routine that finds out if the user is registered. If the user is registered then Sub Main displays Form1 otherwise it displays frmRegister.

(My 9000th post!)

----------


## evexa

Marty your suggestion worked perfectly thank you so much!

There is however one thing * :Smilie: * 
The function includes a square root, a hard drive i tested had a negative number and obviously will not work with the sqrt.

I tried adding aline to say :

if strlicenceetc < 0 then strelicenceetc = (int(strelicenceetc * -1))

but it didnt work.

Any idea what i should do?

THank you  :Smilie:   :wave:   :Big Grin:

----------


## MartinLiss

A couple of suggestions.

You don't have to use the alogrythm that I use at all so you can make one up that doesn't use the square root, or you can use the Absolute Value function (I thinks it's Abs but I can't check it now) before taking the square root. Whatever you do however make sure that you make the algorythm the same in both places.

----------


## evexa

Cheers Marty everything works perfectly now (well except for a registration error that occurrs but i think thats due to software on my machine that blocks silent emails.)

Thanks again!
xxx





> _Originally posted by MartinLiss_ 
> *A couple of suggestions.
> 
> You don't have to use the alogrythm that I use at all so you can make one up that doesn't use the square root, or you can use the Absolute Value function (I thinks it's Abs but I can't check it now) before taking the square root. Whatever you do however make sure that you make the algorythm the same in both places.*

----------


## manavo11

> _Originally posted by MartinLiss_ 
> *(I thinks it's Abs but I can't check it now)*


Yep, it is  :Wink:

----------


## Slaine

Excellent work Martin.

Just one suggestion to the people using this - You really do need to change the algorithm otherwise anybody can download the files above and generate keys for your program.

----------


## MartinLiss

Thanks, but it's not up to change it. That should be done by whomever downloads it and I implied that in my original post. I did however edit that post to reinforce that point.

----------


## David RH

Hello Marty

I have a question that is VB 101 I'm sure but I can't find a reference to this type of usage, the so here we go:

In your code you append a $ to the end of some variables.  I know that the $ is code for string variable.  But you have already declared the variable as a string at the start of the function.  So what is the purpose of the $ at this point?

Thanks

David

----------


## MartinLiss

It's redundant. Some of the code I used was picked up from other places and I never bothered to change it.

----------


## David RH

Hello Marty

I have the program setup and working. 

But my users get wigged out and shut it down when the program resolves the recipname and then again when it sends the email.

Either Outlook (depending on their security settings) or their anti-virus program will pop up a dire message on attempting to resolve the address that a virus may be attempting to access your address book and do you want to stop it? 

Then it happens again when it goes to send the message and you get a simularly frightening warning. I tried remming out the resolvename line To at least get rid of the most dire of the two messages, but now it won't send the message and throws the dreaded error 32002 unspecified error.

Any ideas?

Thanks

David

----------


## MartinLiss

Perhaps you could remove the automatic email and instead pop up a message saying something like "In order to register, please cut and paste the following information and send it in an email to..."

----------


## David RH

Is there a way to mail something without going thru Outlook? 

Mapi appears to just be a portal to the installed email client. So, it looks like I will have to use something else to bypass Outlook. Any ideas?

Also what is the purpose of "resolving" the email address in outlook? I'm confused as to why when I supply it with an email addy thru the code it still needs to look it up in the outlook addy book.

If I could get it to send with out the name resolve it might be doable. As most people will ignore one mild warning if they trust the app. But almost no one will bypass the 3 dire "THIS MAY BE A VIRUS" warnings that mapi triggers in outlook.

Thanks

David

----------


## MartinLiss

I did a forum search for email without outlook and this was one of the hits.

----------


## David RH

I also found this:
http://www.freevbcode.com/ShowCode.Asp?ID=109

I've given it a short test run and so far it seems to work very well. I'm going to send it to beta testers to see if it holds up under stress.

David

----------


## Dasiths

What if the user gets a new hard disk ..... 
he will have to register again ?

I use the same system with my program ..... and this is one of the problems I had to encounter .........

I save my registration info on a file .... is it better to store it on the registry ....... ?

----------


## MartinLiss

> _Originally posted by Dasiths_ 
> *What if the user gets a new hard disk ..... 
> he will have to register again ?
> 
> I use the same system with my program ..... and this is one of the problems I had to encounter .........
> 
> I save my registration info on a file .... is it better to store it on the registry ....... ?*


 Yes, the user will need to register again if he gets a new hard disk. I obviously think it's better to store the info in the Registry but some people like using files.

----------


## ZeBula8

could possibly be the reason the hard drive is showing as 0 is that the disks have been made as 'dynamic' under xp operating system?

----------


## weisi

Hi.....For the above code, may I know whether it is possible to modify it for my appforge program. My appforge program requires the user to register the name and product ID which is given by us and after the user register the name, he or she will be unable to change the name. My program is a chat program between a PDA and a desktop computer, so whenever the user message the computer using the PDA, the user name will be displayed. Assistance is much needed! Thank you for all the help!  :Smilie:

----------


## MartinLiss

I can't help you with that but you are welcome to copy and modify my code in any way you wish.

----------


## Maven

As someone already stated, it's probably not a good idea to base your registration scheme off of hardware. Instead I would look for information that is likely to be unique for a user but will survive some computer upgrades. Take a hash value of this information and then use it to generate the key.

----------


## manavo11

> _Originally posted by Maven_ 
> *As someone already stated, it's probably not a good idea to base your registration scheme off of hardware. Instead I would look for information that is likely to be unique for a user but will survive some computer upgrades. Take a hash value of this information and then use it to generate the key.*


Like what? What else is as unique as hardware? Something that just wouldn't possibly be the same for two different computers?  :Ehh:

----------


## Maven

> _Originally posted by manavo11_ 
> *Like what? What else is as unique as hardware? Something that just wouldn't possibly be the same for two different computers? *


You would take a mixture of things from the computer. The windows CD key would be a good place to start. Any personal information should also be added.

----------


## mykkel

Hello somebody can of yours help oneself? I descended his code but this does not work for me, when running the protec.vbp error hits on this code to me:

Public Function GetSerialNumber() As Long

Dim strVolumeBuffer As String
Dim strSysName As String
Dim lngSerialNumber As Long
Dim lngSysFlags As Long
Dim lngComponentLen As Long
Dim lngResult As Long

StrVolumeBuffer$ String$ ( 256, 0 )
StrSysName$ String$ ( 256, 0 )
LngResult GetVolumeInformation ( C:, strVolumeBuffer$, 255, lngSerialNumber,
LngComponentLen, lngSysFlags, strSysName$, 255 )

GetSerialNumber lngSerialNumber

End Function

error is in this code, where he marks string$ to me:

StrVolumeBuffer$ String$ ( 256, 0 )

And the error that slips out is :

Error of compilation:

can not find the project or the library

Some of you can of yours help to me?

I say hello from mexico and thanks

----------


## mykkel

I Right now did the trick, only me toward lack the reference to the library outl85.olb that is of outlook98, thanks anyway.

----------


## MartinLiss

> I Right now did the trick, only me toward lack the reference to the library outl85.olb that is of outlook98, thanks anyway.


My code is meant for VB and not VBA.

----------


## BrailleSchool

> Hello somebody can of yours help oneself? I descended his code but this does not work for me, when running the protec.vbp error hits on this code to me:
> 
> Public Function GetSerialNumber() As Long
> 
> Dim strVolumeBuffer As String
> Dim strSysName As String
> Dim lngSerialNumber As Long
> Dim lngSysFlags As Long
> Dim lngComponentLen As Long
> ...



Hi, I am new here.  I have downloaded your code.  I am too having a problem.

I am running Win XP Home and I was able to compile the program where you can generate the key.  But when I go to compile the protect.vbs it tells me the following:

Compile Error:
Can't find project or library

It references:
String$ in the line of strVolumeBuffer$ = String$(256, 0)

for 
Public Function GetSerialNumber() As Long

    Dim strVolumeBuffer As String
    Dim strSysName As String
    Dim lngSerialNumber As Long
    Dim lngSysFlags As Long
    Dim lngComponentLen As Long
    Dim lngResult As Long

    strVolumeBuffer$ = String$(256, 0)
    strSysName$ = String$(256, 0)
    lngResult = GetVolumeInformation("C:\", strVolumeBuffer$, 255, lngSerialNumber, _
            lngComponentLen, lngSysFlags, strSysName$, 255)

    GetSerialNumber = lngSerialNumber

End Function

in the modProtect.

Please advise.
Thanks

----------


## MartinLiss

My code is meant for VB and not VBA. Are you using VB6?

----------


## BrailleSchool

> My code is meant for VB and not VBA. Are you using VB6?


I am using VB6 Enterprise Edition

What is the difference between VB and VBA?

----------


## MartinLiss

VBA is Visual Basic for Applications and is the form of visual basic that you use from within Word, Excel etc.

What did you mean when you said "compile the protect.vbs"?

----------


## BrailleSchool

> VBA is Visual Basic for Applications and is the form of visual basic that you use from within Word, Excel etc.
> 
> What did you mean when you said "compile the protect.vbs"?


when i would do F5 when the project is open, or when it would attempt to compile into an exe.

----------


## stilekid007

Hey Martin....

Can you tell me what I am doing wrong here... I open your project vb file and I press the play button (F5)..

And I get a compile error - can't find project or library...

I am using Win XP and VB 6.0

The underlined line of code is highlighted blue when I get the error..


VB Code:
Public Function GetSerialNumber() As Long
     Dim strVolumeBuffer As String
    Dim strSysName As String
    Dim lngSerialNumber As Long
    Dim lngSysFlags As Long
    Dim lngComponentLen As Long
    Dim lngResult As Long
    
    strVolumeBuffer$ = [U]String$[/U](256, 0)
    strSysName$ = String$(256, 0)
    lngResult = GetVolumeInformation("C:\", strVolumeBuffer$, 255, lngSerialNumber, _
            lngComponentLen, lngSysFlags, strSysName$, 255)
                 
    GetSerialNumber = lngSerialNumber
    
End Function
Thank you for taking the time!
Stilekid007  :wave:

----------


## MartinLiss

There may be something in your project that's confusing VB. Try


VB Code:
strVolumeBuffer$ = [HL="#FFFF80"]VBA.[/HL]String$(256, 0)

----------


## stilekid007

Thank you so much marty!

Thats worked! Thats a really nice program...  :Thumb:  

So I understand if the user doesn't have outlook then it will display a message window saying send an email to blah blah blah...

Is this a correct asumption?

Thanks again man!   :wave:

----------


## MartinLiss

Yes, that's the _assumption_. There are other, more general, ways of sending email and so if you have the need you might want to look into changing the code.

----------


## dpr97

Hi,

I have tried using this register programming. If i just run, i am getting compile error as "Cannot Find Project or Library". Can anyone suggest me, whether i shd include any library as reference??? Expecting ur reply,

Thanks in advance,
Regards,
dpr

----------


## dpr97

HELLO,

Thanks a lot for the above suggestions. I read the previous thread and included VBA. The program is working fine.. Thanks a lot.

Regards,
dpr

----------


## Sidewinder87

What would I have to remove and fix, if I wanted it so it skipped the automatic outlook email, and just popped up the manual email form where it says an error has occured, please use your email system to manually send and email to....

Could someone tell me what I need to do?

PS: Im very very new to VB and have no idea what to do on my own.

-Sidewinder

----------


## MartinLiss

You are much better off creating an installation package so the user will be able to use MAPI but here you go.


VB Code:
Public Sub ShowStep1()
     cmdNext.Caption = "&Next >"
    cmdBack.Enabled = True
    lblReg.Caption = "Step 1 - Request Registration Key"
[HL="#FFFF80"]'    lblExplain.Caption = "Pressing Next will generate an " _
'                       & "E-mail requesting a Registration Key. When you receive " _
'                       & "that key via return E-mail, you can finish the " _
'                       & "registration process by completing the " & optRegStep(1).Caption _
'                       & " step, (Step 2)."
    lblExplain.Caption = "Press Next and then send me an " _
                       & "E-mail as you will be instructed to. When you receive " _
                       & "that key via return E-mail, you can finish the " _
                       & "registration process by completing the " & optRegStep[/HL](1).Caption _
                       & " step, (Step 2)."
    
    optRegStep(0).Visible = False
    optRegStep(1).Visible = False
    lblName.Visible = True
    txtName.Visible = True
[HL="#FFFF80"]    'new
    txtName.Text = "Press Next"
    txtName.Enabled = False[/HL]
     lblRegKey.Visible = False
    lblRegisterTo.Visible = False
    txtRegisterTo.Visible = False
    txtRegKey(0).Visible = False
    txtRegKey(1).Visible = False
    txtRegKey(2).Visible = False
    lblDash1.Visible = False
    lblDash2.Visible = False
    
[HL="#FFFF80"]'    txtName.SetFocus[/HL]
 End Sub
 Public Function RequestKey() As Boolean
 '    Dim strCriteria As String
    Dim mpSession As MAPISession
    Dim mpMessages As MAPIMessages
    
    On Error GoTo ErrorRoutine
    
    ' This causes this validation (for step 1) to
    ' be bypassed when going directly to step 2
    If txtName.Visible = False Then
        RequestKey = True
        Exit Function
    End If
    
    If Trim(txtName) = "" Then
        MsgBox "Please enter your name.", _
             vbExclamation, REG_ERR_TITLE
        txtName.SetFocus
        m_StepCompleted = m_StepCompleted - 1
        Exit Function
    End If
    
    Screen.MousePointer = vbHourglass
    Me.Hide
[HL="#FFFF80"]'    frmWait.Show
'
'    gRegClass.Subject = StrConv(LCase(App.EXEName), vbProperCase) & " Registration Request"
'
'    Set mpSession = MAPISession1
'    Set mpMessages = MAPIMessages1
'
'    mpSession.DownLoadMail = False
'    'show the logon interface for the mail
'    mpSession.LogonUI = True
'    'sign on to selected account
'    mpSession.SignOn
'
'    DoEvents
'
'    'check if logon was successful
'    If mpSession.SessionID = 0 Then
'        'SendMAPIMail = False
'        MsgBox "Error On login To MAPI", _
'        vbCritical, "MAPI"
'        Exit Function
'    End If
'
'    'set the session IDs the same on both objects
'    mpMessages.SessionID = mpSession.SessionID
'
'    'Set the MSgIndex to -1, this needs to be
'    'done for the Compose event to work
'    mpMessages.MsgIndex = -1
'    'compose a new message
'    mpMessages.Compose
'
'    'don't show the resolve address interface
'    mpMessages.AddressResolveUI = False
'
'    'set the recipient
'    mpMessages.RecipIndex = 0
'    mpMessages.RecipType = mapToList
'    mpMessages.RecipAddress = EMAIL
'    'resolve the recipient's email addresses
'    mpMessages.ResolveName
'
'    'set the subject
'    mpMessages.MsgSubject = gRegClass.Subject
'
'    'set the Message/Body/NoteText
'    mpMessages.MsgNoteText = txtName & " " & GetSerialNumber
'
'    'send the message
'    mpMessages.Send
'
'    'close the current session
'    mpSession.SignOff
'
'    'clear objects
'    Set mpMessages = Nothing
'    Set mpSession = Nothing
'new
    MsgBox "Send me an email which includes your name and this number." _
            & vbCrLf & vbCrLf & GetSerialNumber[/HL]
    Screen.MousePointer = vbNormal
    
    Unload Me
    DoEvents
    
    RequestKey = True
    Unload frmWait
    
    Exit Function
    
ErrorRoutine:
     Set mpMessages = Nothing
    Set mpSession = Nothing
    
    Screen.MousePointer = vbNormal
    
    frmRegError.Show vbModal
    m_StepCompleted = m_StepCompleted - 1
    RequestKey = False
    Err.Clear
 End Function

----------


## divined

I`m using your code as a foundation to my own registration scheme. It`s been very instructive and helpful. One thing I`d like to ask is why do you tell that the main form of my program has to be loaded in _modal_ mode. My main form is an MDI container form and it crashes when I try to load it in _modal_ mode.

----------


## MartinLiss

Because in the code below if frmDone wasn't shown modally, the code would continue through the unloading of all forms and the immediate ending of the program.

VB Code:
Public Sub Main()
     Dim frm As Form ' Create a Form object
    
    GetAppEnvironment ' Calls the routine that finds out if the user is registered
    
    If Not gRegClass.Registered Then ' Registered is a boolean property of theCRegister class
        frmRegister.Show vbModal ' If the user is not registered then the register form is displayed
    Else
        frmDone.Show vbModal ' In this app if the user is registered then frmDone is displayed.
                             ' In your app you would probably replace frmDone with your main form
    End If
    
    For Each frm In Forms ' Loop through all the forms...
        Unload frm        ' and unload them...
        Set frm = Nothing ' and set them to Nothing
    Next
    
    End ' 99.99999% of the time not needed, but it can't hurt after you've unloaded your forms.
 End Sub

----------


## divined

I`m not doing it exactly that way. I load my main MDI form in non-modal mode. Then , I just unload the form showing the splash screen. All, others forms are unloaded when the main MDI form is closed. So, effectively the program does not terminate. Is there any defect to this method?

----------


## MartinLiss

None that I can see.

----------


## wildcat_2000

first of all, thank you martin for providing such a useful and practical piece of code. this is definitely a good start for anyone out there wishing to implement a registration routine.

however, i am actually a 'protection freak', and believe that some members might not realize that despite being an excellent start, this scheme is very easy to crack.

therefore, though being as i stated an excellent starting point, i would recommend all users of this piece of code to consider implementing some of these suggestions  to ensure an increased protection of their software.

i had provided an example of what could be attacked in the scheme, however as you can see in the post here below it has been removed by martin.

unfortunately, it is hard to explain how to protect a software without having a basic understanding of what you are trying to protect from, however i guess martin is right, this might have given bad ideas to some uneperienced vb'ers.

i remain however at disposal to discuss 'concepts' (i won't then distribute code) to honest programmers trying to protect their software.

cheers,

wc.

----------


## MartinLiss

I removed the attachment since code like that should not be distributed on this forum even if you have the best of intentions. 

My program is not meant to be foolproof (if there is actually such a thing) but only a "locked door" to keep out the casual hacker.

----------


## divined

No way of protection is certainly foolproof. While there are fairly simple easy ways to break the scheme proposed my Martin, it is only a matter of time and resources to break more complicated schemes. 

  It remains a matter of how broad an audience your application is targeted. Not many people will go into lengths to crack an application that is only being used by a few people.

----------


## wildcat_2000

> It remains a matter of how broad an audience your application is targeted. Not many people will go into lengths to crack an application that is only being used by a few people.


this is particularly true. however, it is not my intention here to enter another lengthy discussion on the fact that there are no unbreakable protections. we all know that.

my point was that you can seriously 'buy time' before your program protection is broken, and that this scheme, though being as i stated an excellent start, is only useful 'as is' exactly if the audience you are targeting as no interest in doing so (for instance in professional and specific applications).

----------


## sangit

Hi 
I am facing a silly problem. I downloaded your code as it is and trying to comple it. When I am compiling it, it is giving me an error ie, " Compile Error : Can't  find project or library." and closing it. it is getting stuck in this section : 

Public Function GetSerialNumber() As Long

    Dim strVolumeBuffer As String
    Dim strSysName As String
    Dim lngSerialNumber As Long
    Dim lngSysFlags As Long
    Dim lngComponentLen As Long
    Dim lngResult As Long

    strVolumeBuffer$ = *String$*(256, 0)
    strSysName$ = String$(256, 0)
    lngResult = GetVolumeInformation("C:\", strVolumeBuffer$, 255, lngSerialNumber, _
            lngComponentLen, lngSysFlags, strSysName$, 255)

    GetSerialNumber = lngSerialNumber

End Function

           highlighting String$ in the code. Also I tried to find the defination of String$ by right clicking but the result is "Identifier under cursor is not recognized." Can you tell me how to solve this problem and compile your code.

 :Confused:

----------


## MartinLiss

String$ is a member of VBA's Strings class just as are Trim, strConv, Right$, etc. Highlight String$ and press Shift-F2 to open up the Object Browser. Does it find it String$? The only things I can suggest is that you try using String instead of String$ or perhaps VBA.String$. BTW when you type VBA.S does Intellisense show you String$ as one of the possible choices?

----------


## r6k.net

can someone pm me the exe files?, b/c my vb is corupt

----------


## BrailleSchool

> can someone pm me the exe files?, b/c my vb is corupt


i doubt anyone is going to do it and if its a corrupt installation then youre going to have to reinstal VB.

----------


## eddied316

Im not sure if this post is still alive but i doo see a post from a few days ago. But i tihnk i have a simple error. When i try to get my serial number from the program i get a negative number (-2072485274) and of course the program does not like that. 

I tried change a line of the generaation a someone posted way back, but still that did not help...Any Ideas?

----------


## MartinLiss

> Im not sure if this post is still alive but i doo see a post from a few days ago. But i tihnk i have a simple error. When i try to get my serial number from the program i get a negative number (-2072485274) and of course the program does not like that. 
> 
> I tried change a line of the generaation a someone posted way back, but still that did not help...Any Ideas?


Just work with the absolute value (using the Abs function).

----------


## eddied316

I did try that.  

I changed:


VB Code:
strLicenseKey = CStr(Int(3456 * Sqr(lngSerialNum / 5)))

To 


VB Code:
strLicenseKey = CStr(Int(3456 * Sqr(Abs(lngSerialNum) / 5)))

On both PRojects but my number still turns out t be:

(-2072485274)

----------


## MartinLiss

Do

strLicenseKey = CStr(Int(3456 * Sqr(Abs(lngSerialNum) / 5)))

----------


## MartinLiss

I got your PM. If you use the formula I posted in post #115 in both places you will get a value of 70361397.

----------


## eddied316

lol...i DID use it in both places
but it doesnt change

I used it in the Main program in the Moduels and the second on on the gen

but stil get the -207...

----------


## osemollie

Hi guys,

I have read with interest the discusion on the above program. However, I was thinking aloud, suppose my client does NOT have an e-mail address or his machine is not connected to the internet, then how can he be able to install this sofware on his machine|? How do you generate the serial number manually?

Thanks.

----------


## MartinLiss

> Hi guys,
> 
> I have read with interest the discusion on the above program. However, I was thinking aloud, suppose my client does NOT have an e-mail address or his machine is not connected to the internet, then how can he be able to install this sofware on his machine|? How do you generate the serial number manually?
> 
> Thanks.


When the person who doesn't have email installs the program, a value that represents the hard drive serial number will be displayed. Have them phone or snail-mail the value to you. You then run GenKey (as you would normally) and call or snail-mail them back their key.

----------


## osemollie

Sorry, I am trying out the program but I don't see a value that represents the hard drive serial number displayed. How do I get it displayed?

Thanks

----------


## osemollie

Martin I am new to VB and I think i might be slow in understanding the VB concepts. I don't want to make assumptions, 1- When compiling my program should I include the Key generator program too? 2 - You mentioned that one should change the alogarythm in the project, this should be changed too what before compiling it?

Hope you understand my sitauation.

Thanks

----------


## MartinLiss

Well since I have email I can't test the program with %100 confidence, but when an error occurrs in the RequestKey function because for example you don't have an email program, it displays frmRegError which contains the registration info. Have you run the program before? If so you may already be registered and so you won't get to that function. Check the registry and delete your former information and try it again.

----------


## osemollie

No, I have not yet run thr prog. I want to understand it b4 running it so that i don't make errors. Like i mentioned i need to know what and what exactly i should chage b4 running it

----------


## MartinLiss

> Martin I am new to VB and I think i might be slow in understanding the VB concepts. I don't want to make assumptions, 1- When compiling my program should I include the Key generator program too? 2 - You mentioned that one should change the alogarythm in the project, this should be changed too what before compiling it?
> 
> Hope you understand my sitauation.
> 
> Thanks


Sorry, I missed this post of yours.

1) No. That is just for you. After the user gets his information to you, you use that program to generate his key.

2) I believe the formula in the two programs is now


VB Code:
strLicenseKey = CStr(Int(3456 * Sqr(lngSerialNum / 5)))

That is just an arbitrary calculation and you could change it to anything you want such as any of the following. You don't actually _have_ to change it at all, but if you don't then some knowledgeable user might stumble across the existing formula and be able to register without contacting you.


VB Code:
strLicenseKey = CStr(Int(666 * Sqr(lngSerialNum / 5)))
strLicenseKey = CStr(Int(1234 * Sqr(lngSerialNum / 4)))
strLicenseKey = CStr(Int(999 * Sqr(lngSerialNum / 3)))
strLicenseKey = CStr(Int(2222 * Sqr(lngSerialNum / 5)))
Just make sure you make the same change in both programs.

----------


## Atribune

Think I found why people were getting the error on string$ OLE Automation in project references is unchecked. If you recheck it everything works fine.

----------


## Jamie_Garland

Can anyone implament a demo to this source code.?

----------


## MartinLiss

> Can anyone implament a demo to this source code.?


See Post #1.

----------


## highflight1985

Would this routine still work under VS2005 .NET? And what kind of modifications would I need to make to make this work in the compact framework?

----------


## MartinLiss

> Would this routine still work under VS2005 .NET? And what kind of modifications would I need to make to make this work in the compact framework?


I assume that any code when propery converted to .Net would work, but I have no idea how you would do that since I don't do .Net.

----------


## Hashi Nara

Hello Martin,
I stumbled across your site looking for just this application to use for MS Access applications I have written. I take note that your code is written for VB and not VBA and will be looking at suitable adjustments.

I haven't at this time opened your project, but accept that it functions as you have described. I have read all of this thread and I am impressed with the way you have zeroed in on issues raised.

The applications I have written are used on a LAN comprising some 50-100 workstations with the application residing on a central server. My question is: Will the program need to be registered only on the computer it is loaded on or on each computer it will run on?

----------


## MartinLiss

First, I assume you'll have to make modifications to the program in order to run it in a VBA app. As to your question, as written the program assumes that it is installed on an individual's PC and so each user needs to register. The code is of course yours to do what you want with, so you can modify it as you see fit.

----------


## adamm83

Hi,
this is a nice program. I have set up similar code a while ago with a program I made for a company for private use. It was a small company so it was easy to keep track of. What I did was I generated a serial using the following information:

HDD serial numberMAC AddressProcessor IDWindows Product ID

I then concatenated the strings generated from the above items into one long string, and encrypted the string using a specific encryption (which, if you use this method is up to you). I used the encrypted string as a unique ID to generate the serial number.

This may be thought of as excessive (and possibly redundant) but it helped protect unauthorized people from using the application. On top of that, once a serial number was generated for a specific computer it was added to a database controlled by myself of active serial numbers. Every time the user logged in to the program, it verified the computer's information with the serial number, then it contacts my "active serial" database to check if it's serial number is ok.

If the serial number did not check out for whatever reason (i.e. changed hardware in computer) they are prompted to request a new serial number from me.

Again, some of you may think this is extremely excessive and redundant... but I do not.

One reason I did this was because I originally started out using ONLY the hdd serial number as a unique identifier like the project posted in this thread, but I quickly realized 2 things:

1. The code I found for the HDD serial number did NOT return the HDD serial number, but rather the partition's volume number. This is a totally different thing. For example, if you have 2 partitions on a hdd, the code would return the volume id for a specified partition (i.e. C: drive)

2. I found code that actually retrieved the HDD's serial number (the serial number that is put in by the manufacturer of the HDD). BUT for some reason, some computers returned the proper serial number from the manufacturer and some did not return anything at all. This posed a slight problem.

Anyhow, thats was my solution. Enjoy!

----------


## matrik02

I can't download the code. Could some one help me?Here is my email astalavista_um@yahoo.com

----------


## Al42

What happens when you try to download it?  I just downloaded it a few minutes ago.

----------


## MartinLiss

I just sent it to him.

----------


## ksuwanto8ksd

Hi MartinLis,

This is nice code.
but I find a hardisk number is 2288776782
and generate an error overflow

thank for your code
I really appreciate

Kamus

----------


## Paul M

You would have to declare what ever variable it is as Double or Single but Double would be best  :Wink:

----------


## MartinLiss

Yes. Change (and rename) lngSerialNum in both programs to a Double.

----------


## ksuwanto8ksd

Yes Martinlis I change  it to double in both
how about this one? 



```
Public Function GetSerialNumber() As Long

    Dim strVolumeBuffer As String
    Dim strSysName As String
    Dim lngSerialNumber As Long
    Dim lngSysFlags As Long
    Dim lngComponentLen As Long
    Dim lngResult As Long
    
    strVolumeBuffer$ = VBA.String$(256, 0)
    strSysName$ = VBA.String$(256, 0)
    lngResult = GetVolumeInformation("C:\", strVolumeBuffer$, 255, lngSerialNumber, _
            lngComponentLen, lngSysFlags, strSysName$, 255)
                 
    GetSerialNumber = lngSerialNumber
    
End Function
```

and this one 


```
Public Function CalcRegKey(lngSerialNum As Long) As String

    Dim strLicenseKey As String
    Const ZEROS = "000000000"
    
    lngSerialNum = Abs(lngSerialNum)
    
    ' This calculation must be the same as the one used in GenKey
    strLicenseKey = CStr(Int(3456 * Sqr(Abs(lngSerialNum) / 5)))
    strLicenseKey = VBA.Left$(strLicenseKey, 9)
    If Len(strLicenseKey) < 9 Then
        strLicenseKey = VBA.Left$(ZEROS, 9 - Len(strLicenseKey)) & strLicenseKey
    End If
    
    CalcRegKey = strLicenseKey

End Function
```

thanks.
I really appreciated

----------


## MartinLiss

Those two subs are what I meant by "both programs".

----------


## ksuwanto8ksd

In both I mean this from genkey


```
Public Sub Main()

    Dim strLicenseKey As String
    Dim lngSerialNum As Double
    Const ZEROS = "000000000"
    
    lngSerialNum = InputBox("Enter user's hard drive serial number")
    
    ' This calculation must be the same as the one used in your application
    strLicenseKey = CStr(Int(3456 * Sqr(lngSerialNum / 5)))
    strLicenseKey = Left$(strLicenseKey, 9)
    If Len(strLicenseKey) < 9 Then
        strLicenseKey = Left$(ZEROS, 9 - Len(strLicenseKey)) & strLicenseKey
    End If
    
    strLicenseKey = Format(strLicenseKey, "@@@-@@@-@@@")
    frmGenKey.txtKey = strLicenseKey
    frmGenKey.Show vbModal

End Sub
```

and this from protect 


```
Public Function CalcRegKey(lngSerialNum As Long) As String

    Dim strLicenseKey As String
    Const ZEROS = "000000000"
    
    lngSerialNum = Abs(lngSerialNum)
    
    ' This calculation must be the same as the one used in GenKey
    strLicenseKey = CStr(Int(3456 * Sqr(Abs(lngSerialNum) / 5)))
    strLicenseKey = VBA.Left$(strLicenseKey, 9)
    If Len(strLicenseKey) < 9 Then
        strLicenseKey = VBA.Left$(ZEROS, 9 - Len(strLicenseKey)) & strLicenseKey
    End If
    
    CalcRegKey = strLicenseKey

End Function
```

how about this from protect



```
Public Function GetSerialNumber() As Long

    Dim strVolumeBuffer As String
    Dim strSysName As String
    Dim lngSerialNumber As Long
    Dim lngSysFlags As Long
    Dim lngComponentLen As Long
    Dim lngResult As Long
    
    strVolumeBuffer$ = VBA.String$(256, 0)
    strSysName$ = VBA.String$(256, 0)
    lngResult = GetVolumeInformation("C:\", strVolumeBuffer$, 255, lngSerialNumber, _
            lngComponentLen, lngSysFlags, strSysName$, 255)
                 
    GetSerialNumber = lngSerialNumber
    
End Function
```

thanks for clarify 
very much appreciate.

----------


## Paul M

Yep there it  :Smilie:

----------


## ksuwanto8ksd

is it has to declare as double too?


```
Dim lngSerialNumber As Long
```

thanks

----------


## MartinLiss

> is it has to declare as double too?
> 
> 
> ```
> Dim lngSerialNumber As Long
> ```
> 
> thanks


Wouldn't it be easy to try it and find out?

----------


## ksuwanto8ksd

I try this:


```
Public Function GetSerialNumber() As double
    Dim strVolumeBuffer As String
    Dim strSysName As String
    Dim lngSerialNumber As double
    Dim lngSysFlags As Long
    Dim lngComponentLen As Long
    Dim lngResult As Long
    
    strVolumeBuffer$ = VBA.String$(256, 0)
    strSysName$ = VBA.String$(256, 0)
    lngResult = GetVolumeInformation("C:\", strVolumeBuffer$, 255, lngSerialNumber, _
            lngComponentLen, lngSysFlags, strSysName$, 255)
                 
    GetSerialNumber = lngSerialNumber
    
End Function
```

come with "compile error byref argument type mismatch"
code marked italic.

thanks.

----------


## MartinLiss

I'm sorry but I don't know how to get around that.

----------


## canadadoya

> Attached is a project (actually two projects) that show one way of having the user register his copy of your program. This is the way it works:
> 
> The main application displays a registration screen with two options: "Register" and "Request Registration Key".If the user selects "Register" a new screen is shown that asks the user for his name and tells him that if he continues it will generate an e-mail message to you (via MAPI) and that you will send him the registration key by return e-mail. If he continues, the program gets his hard drive serial number and includes it in the e-mail to you.Once you receive the registration request email, you use the second project (GenKey) to generate a registration key by way of a simple algorithm that you can change based on the hard drive serial number. Just remember that the algorithm is in both projects and it must be exactly the same in both.You then send the registration key back to the user and have them enter it in the second part of the registration screen which writes the key to the registry.When they start the main program again it uses the same algorithm to see if the registration key in the Registry matches the HD serial number. If it matches the program starts (see Notes below). If it doesn't match or if there is no registry entry, the program does not start or you could arrange it so that it starts with only a few demo functions available. 
> 
> Notes:Your main form must be shown using vbModal.You will need to modify the program to change the constant named EMAIL to your e-mail address.You should change the registration key algorythm. See CalcRegKey in modProtect and Sub Main in modGenKey. The changes should be the same in both places.



Hi there, i tried out your project and it works well. I know this is an old post,i hope i can get a reply. What i wanted to know is instead of numbers for the geygen i wanted to figure out letters from the serial number entered.such as 20 letters in @@@@@-@@@@@-@@@@@-@@@@@ format. this is for a program i have i wish to give others and not abused. thanks

----------


## MartinLiss

> Hi there, i tried out your project and it works well. I know this is an old post,i hope i can get a reply. What i wanted to know is instead of numbers for the geygen i wanted to figure out letters from the serial number entered.such as 20 letters in @@@@@-@@@@@-@@@@@-@@@@@ format. this is for a program i have i wish to give others and not abused. thanks


You can do anything you want with the code. If you wanted to produce letters instead of numbers a simple 1=A 2=B or something more complicated would be easy to do.

----------


## canadadoya

Hi ty for the reply, im a beginner in vb here is what i did

```
Option Explicit


Public Sub Main()

    Dim strLicenseKey As String
    Dim lngSerialNum As Long
    Const VALID_CHARS = "ABCDEFGHJKLMNPQRTUVWXY"
    
    lngSerialNum = InputBox("Enter user's hard drive serial number")
    
    ' This calculation must be the same as the one used in your application
    strLicenseKey = CStr(Int(3456 * Sqr(lngSerialNum / 5)))
    strLicenseKey = Left$(strLicenseKey, 20)
    If Len(strLicenseKey) < 20 Then
        strLicenseKey = Left$(VALID_CHARS, 20 - Len(strLicenseKey)) & strLicenseKey
    
    End If
    
    
    strLicenseKey = Format(strLicenseKey, "@@@@@-@@@@@-@@@@@-@@@@@")
    frmGenKey.txtKey = strLicenseKey
    frmGenKey.Show vbModal
    


End Sub
```

 this works to a point  i still get 9 numbers at the end and  the letters arn't random.  i tryed to adapt from another source  code, it wouldn't work. see attachment

----------


## ProphetBeal

I believe what Martin was sayign to do is something like this (although this may not be the best way to do it  :Wink: )...    
VB Code:
strLicenseKey = Replace(strLicenseKey, "0", "X")
    strLicenseKey = Replace(strLicenseKey, "1", "D")
    strLicenseKey = Replace(strLicenseKey, "2", "G")
    strLicenseKey = Replace(strLicenseKey, "3", "M")
    strLicenseKey = Replace(strLicenseKey, "4", "A")
    strLicenseKey = Replace(strLicenseKey, "5", "E")
    strLicenseKey = Replace(strLicenseKey, "6", "P")
    strLicenseKey = Replace(strLicenseKey, "7", "V")
    strLicenseKey = Replace(strLicenseKey, "8", "B")
    strLicenseKey = Replace(strLicenseKey, "9", "R")

----------


## canadadoya

thanks prophet that works pretty good, i got the keygen to add a - after every 5 keys but i get numbers again at the first 3 keys 
VB Code Code:
Option Explicit
  Public Sub Main()
     Dim strLicenseKey As String
    Dim lngSerialNum As Long
    Const VALID_CHARS = "0123456789"
     
    lngSerialNum = InputBox("Enter user's hard drive serial number")
    
    ' This calculation must be the same as the one used in your application
    strLicenseKey = CStr(Int(3456 * Sqr(lngSerialNum / 5)))
    strLicenseKey = Left$(strLicenseKey, 22)
    If Len(strLicenseKey) < 22 Then
        strLicenseKey = Left$(VALID_CHARS, 22 - Len(strLicenseKey)) & strLicenseKey
    End If
    
    strLicenseKey = Replace(strLicenseKey, "0", "X")
    strLicenseKey = Replace(strLicenseKey, "1", "D")
    strLicenseKey = Replace(strLicenseKey, "2", "G")
    strLicenseKey = Replace(strLicenseKey, "3", "M")
    strLicenseKey = Replace(strLicenseKey, "4", "A")
    strLicenseKey = Replace(strLicenseKey, "5", "E")
    strLicenseKey = Replace(strLicenseKey, "6", "P")
    strLicenseKey = Replace(strLicenseKey, "7", "V")
    strLicenseKey = Replace(strLicenseKey, "8", "B")
    strLicenseKey = Replace(strLicenseKey, "9", "R")
    strLicenseKey = Replace(strLicenseKey, "10", "H")
    strLicenseKey = Replace(strLicenseKey, "11", "Y")
    strLicenseKey = Replace(strLicenseKey, "12", "C")
    strLicenseKey = Replace(strLicenseKey, "13", "W")
    strLicenseKey = Replace(strLicenseKey, "14", "U")
    strLicenseKey = Replace(strLicenseKey, "15", "T")
    strLicenseKey = Replace(strLicenseKey, "16", "Q")
    strLicenseKey = Replace(strLicenseKey, "17", "F")
    strLicenseKey = Replace(strLicenseKey, "18", "L")
    strLicenseKey = Replace(strLicenseKey, "19", "J")
    strLicenseKey = Replace(strLicenseKey, "20", "k")
    strLicenseKey = Replace(strLicenseKey, "21", "N")
    
     frmGenKey.txtKey = strLicenseKey
    frmGenKey.Show vbModal
 End Sub
 i was thinking about an MD5 hash to calculate the keygen
i got that in the attachment in my previous post. HEH MY BRAIN HURTS LOL  :Eek Boom:

----------


## MartinLiss

> thanks prophet that works pretty good, i got the keygen to add a - after every 5 keys but i get numbers again at the first 3 keys 
> VB Code Code:
> Option Explicit
  Public Sub Main()
     Dim strLicenseKey As String
    Dim lngSerialNum As Long
    Const VALID_CHARS = "0123456789"
     
    lngSerialNum = InputBox("Enter user's hard drive serial number")
    
    ' This calculation must be the same as the one used in your application
    strLicenseKey = CStr(Int(3456 * Sqr(lngSerialNum / 5)))
    strLicenseKey = Left$(strLicenseKey, 22)
    If Len(strLicenseKey) < 22 Then
        strLicenseKey = Left$(VALID_CHARS, 22 - Len(strLicenseKey)) & strLicenseKey
    End If
    
    strLicenseKey = Replace(strLicenseKey, "0", "X")
    strLicenseKey = Replace(strLicenseKey, "1", "D")
    strLicenseKey = Replace(strLicenseKey, "2", "G")
    strLicenseKey = Replace(strLicenseKey, "3", "M")
    strLicenseKey = Replace(strLicenseKey, "4", "A")
    strLicenseKey = Replace(strLicenseKey, "5", "E")
    strLicenseKey = Replace(strLicenseKey, "6", "P")
    strLicenseKey = Replace(strLicenseKey, "7", "V")
    strLicenseKey = Replace(strLicenseKey, "8", "B")
    strLicenseKey = Replace(strLicenseKey, "9", "R")
    strLicenseKey = Replace(strLicenseKey, "10", "H")
    strLicenseKey = Replace(strLicenseKey, "11", "Y")
    strLicenseKey = Replace(strLicenseKey, "12", "C")
    strLicenseKey = Replace(strLicenseKey, "13", "W")
    strLicenseKey = Replace(strLicenseKey, "14", "U")
    strLicenseKey = Replace(strLicenseKey, "15", "T")
    strLicenseKey = Replace(strLicenseKey, "16", "Q")
    strLicenseKey = Replace(strLicenseKey, "17", "F")
    strLicenseKey = Replace(strLicenseKey, "18", "L")
    strLicenseKey = Replace(strLicenseKey, "19", "J")
    strLicenseKey = Replace(strLicenseKey, "20", "k")
    strLicenseKey = Replace(strLicenseKey, "21", "N")
    
     frmGenKey.txtKey = strLicenseKey
    frmGenKey.Show vbModal
 End Sub
>  i was thinking about an MD5 hash to calculate the keygen
> i got that in the attachment in my previous post. HEH MY BRAIN HURTS LOL


I looks like you don't fully understand how Replace works. What I mean is that your second replace is *strLicenseKey = Replace(strLicenseKey, "1", "D")*. That's fine but it means that _all_ ones in the key will be replaced by "D" so this line *strLicenseKey = Replace(strLicenseKey, "10", "H")* and all that follow them will never work since there are no more ones.

----------


## canadadoya

Hi this is what i did 

```
Private Sub Command1_Click()
   Text1 = GenerateCode()
End Sub

Public Function GenerateCode()

   strInputString = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   
   intLength = Len(strInputString)
   
   intNameLength = 20
   
   Randomize
   
   strName = ""
   
   For intStep = 1 To intNameLength
       intRnd = Int((intLength * Rnd) + 1)
   
       strName = strName & Mid(strInputString, intRnd, 1)
       
   Next
   
       strName = Format(strName, "@@@@@-@@@@@-@@@@@-@@@@@")
       
   GenerateCode = strName
   
End Function
```

 now if i could include the serial number and product id shown in the attachment to generate the key i can rest i guess.Ive tried your code and it doesn't seam to work.

----------


## MartinLiss

I'm sorry but I have no idea what you are trying to do.

----------


## canadadoya

sorry about confusement martin. I wanted to take the circled hard drive serial number and productid in the attached image then in my code generate a license key using both. is that possible or do i need to use license key script from hard key license manager for wich i have.

----------


## MartinLiss

The code is yours to do whatever you want to with it. Currently the code just gets the serial number and generates a registration key from it however there is nothing to stop you from combining the serial number and productid somehow and generating the registration code from the result.

----------


## Relative0

I was wondering where in the code it does the saving the code and such to registry so that it can check if it has been installed?  I am trying to understand the program so that I can try to use this idea in VB.NET (Express).  If anyone knows of some tutorials or if this has already been done I would love to not have to try to re-invent the wheel.

Brian

----------


## MartinLiss

The data is stored by SaveSetting in HKEY_CURRENT_USER\Software\VB and VBA Program settings

----------


## M C Benzerari

> Attached is a project (actually two projects) that show one way of having the user register his copy of your program. This is the way it works:
> 
> The main application displays a registration screen with two options: "Register" and "Request Registration Key".If the user selects "Register" a new screen is shown that asks the user for his name and tells him that if he continues it will generate an e-mail message to you (via MAPI) and that you will send him the registration key by return e-mail. If he continues, the program gets his hard drive serial number and includes it in the e-mail to you.Once you receive the registration request email, you use the second project (GenKey) to generate a registration key by way of a simple algorithm that you can change based on the hard drive serial number. Just remember that the algorithm is in both projects and it must be exactly the same in both.You then send the registration key back to the user and have them enter it in the second part of the registration screen which writes the key to the registry.When they start the main program again it uses the same algorithm to see if the registration key in the Registry matches the HD serial number. If it matches the program starts (see Notes below). If it doesn't match or if there is no registry entry, the program does not start or you could arrange it so that it starts with only a few demo functions available. 
> 
> Notes:Your main form must be shown using vbModal.You will need to modify the program to change the constant named EMAIL to your e-mail address.You should change the registration key algorythm. See CalcRegKey in modProtect and Sub Main in modGenKey. The changes should be the same in both places.


I had a look to your 'A Program Registration Scheme' it looks working OK I will try to make it simple to my application.

Thank you :wave:

----------


## steve1040

Is it possible to modify this so instead of sending an activation code.
 The values  "email address" & "HD serial" into my online MySql db?

I want the program to check the database each time the program runs.

This way if the user request a refund I can deactivate.

----------


## MartinLiss

Sure, the code is yours to do anything you want with it.

----------


## steve1040

Thanks

----------


## Biggy-D

" Compile error:
Can't find project or library "

i use vb6 pro  

help ....

----------


## MartinLiss

Do you have a Reference to Outlook in your project?

----------


## cybersandokan

Martin,
I would like to know if you had a chance to try your registration code on Windows Vista. I have only xp and was wondering if your code will work on all platforms.
Please let me know.

Thanks for the excelent help I learned a lot with this code.

Jose

----------


## MartinLiss

> Martin,
> I would like to know if you had a chance to try your registration code on Windows Vista. I have only xp and was wondering if your code will work on all platforms.
> Please let me know.
> 
> Thanks for the excelent help I learned a lot with this code.
> 
> Jose


You're welcome. No I haven't. I don't have Vista.

----------


## fruitman

> Martin,
> I would like to know if you had a chance to try your registration code on Windows Vista. I have only xp and was wondering if your code will work on all platforms.
> Please let me know.
> 
> Thanks for the excelent help I learned a lot with this code.
> 
> Jose


Seems to work ok on vista so far  :Smilie:

----------


## fruitman

hi Martin,
          Was there a reason why you got the code to look at the HDD serial number rather than say the processor ID serial ?

Why i ask is a lot of people would say  i have changed my hard drive or formatted it and the code no longer works  having it looking at the processor number instead would be less likely to change would it not ?

Also would you know what i need to change to get the processor serial instead of the HDD  or is this not a good idea ?

Many thanks  Steve.

----------


## MartinLiss

> hi Martin,
>           Was there a reason why you got the code to look at the HDD serial number rather than say the processor ID serial?...


It was what I knew how to do.




> ...having it looking at the processor number instead would be less likely to change would it not ?....


Yes




> ...Also would you know what i need to change to get the processor serial instead of the HDD  or is this not a good idea ?
> 
> Many thanks  Steve.


Sorry but I have no idea but I wouldn't be surprised if a search would find it in the Classic forum.

----------


## fruitman

ok cheers i will do some more searching  :Smilie: 

Steve

----------


## winman

Hi.. I dont know if the topic is still active. but i wanna raise a problem which i faced. The hard disk serial number which is returned is not actually the manuafacturers serial number, but the drive volume serial number which will change if we format the hard disk. I would like to use a computer key which will not change even after we format the hard disk as the same serial number will register the software. Thanks in advance.

----------


## fruitman

Hi,
    Yes i looked into this as well but didnt manage to find out how, if you find out how i would love to know too as i tried a few things without success.

----------


## MartinLiss

Take a look at this thread. I don't know if there's a real solution there or not but you can investigate it.

----------


## winman

Thanks for the reply. The topic you said had a bit. but when i tested there were some problems. like the OCX said there was not working and other suggested codes were actually the same given by you. The code by you is really good and workable to some extent. The problem i am facing is that the people take registration keys telling that they have formatted the system. the drive volume key will be entirely different from the previous one. So if i thought if i could get this hard disk manufacturers serial number would be very helpful. Thanks for the code.

----------


## pranavalwar

I dont want it to store my registery in VB folder is their any way to change this

----------


## Danish786

Hi Martin,
i am facing a problem when i added your code in my program. shall i mail you the program ?

----------


## Keithuk

Its a great app for registering an app. My main concern is getting the hard drive serial number which you can get from 

Public Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

I run 2 systems WinXP generates -1330466363 and Win7 32bit generates -0084672515

My main concern is getting the keygen part which brings an error 5. Even changing the code as suggested by j2k in post #2

from

strLicenseKey = CStr(Int(3456 * Sqr(lngSerialNum / 5)))

to

strLicenseKey = CStr(Int(3456 * Sqr(Abs(lngSerialNum) / 5)))

But that only show 000-000-000 which is the Const ZEROS

I also wonder why you use Microsoft MAPI Controls 6.0 for the email when you can use the simple

ShellExecute Me.hwnd, "open", "mailto:" & lblEmail.Caption & "?subject=" & App.Title & " Registration", vbNullString, vbNullString, SW_SHOW

Which works perfectly on the default email system.

----------


## Keithuk

Ok I'm back on this hard drive serial number. As I've said I can find the hard drive serial numbers of both my computer, WinXP generates -1330466363 and Win7 32bit generates -0084672515. I want to convert that number to alpha numeric. I've downloaded a few apps from PSC.

http://www.planet-source-code.com/vb...57366&lngWId=1

I like this one:

http://www.planet-source-code.com/vb...54088&lngWId=1

I've taken out the parts for Alpha Replacement Sequence but that clicks Selective Inversion Process which clicks Split and Morph Code.

It compiles and runs ok. I tried it the other day after removing things I didn't need and it now shows Out of Stack Space Error 28.

https://msdn.microsoft.com/en-us/lib...(v=vs.60).aspx

The only functions in there are Invert and iSplit, I wonder why this Error 28 has started showing when it worked ok before.

The other thing is it uses multiple textboxes to show different codes. I want to check if the registration number entered is valid for that HDD serial without using a Form.



```
Private Sub cmdAlpha_Click()

cmdSelective_Click

Text13.Text = Replace(Text8.Text, "27", "Z3")
Text13.Text = Replace(Text13.Text, "91", "8F")
Text13.Text = Replace(Text13.Text, "72", "1K")
Text13.Text = Replace(Text13.Text, "19", "PS")
Text13.Text = Replace(Text13.Text, "56", "O1")
Text13.Text = Replace(Text13.Text, "65", "M3")
Text13.Text = Replace(Text13.Text, "83", "L0")
Text13.Text = Replace(Text13.Text, "38", "E5")
Text13.Text = Replace(Text13.Text, "01", "XD")
Text13.Text = Replace(Text13.Text, "10", "PW")

Text14.Text = Replace(Text9.Text, "30", "C4")
Text14.Text = Replace(Text14.Text, "03", "UX")
Text14.Text = Replace(Text14.Text, "55", "I8")
Text14.Text = Replace(Text14.Text, "66", "PS")
Text14.Text = Replace(Text14.Text, "23", "MZ")
Text14.Text = Replace(Text14.Text, "32", "8Q")
Text14.Text = Replace(Text14.Text, "14", "0L")
Text14.Text = Replace(Text14.Text, "41", "XS")
Text14.Text = Replace(Text14.Text, "74", "9U")
Text14.Text = Replace(Text14.Text, "47", "NT")

Text15.Text = Replace(Text10.Text, "27", "Z3")
Text15.Text = Replace(Text15.Text, "91", "8F")
Text15.Text = Replace(Text15.Text, "72", "1K")
Text15.Text = Replace(Text15.Text, "19", "PS")
Text15.Text = Replace(Text15.Text, "56", "O1")
Text15.Text = Replace(Text15.Text, "32", "8Q")
Text15.Text = Replace(Text15.Text, "14", "0L")
Text15.Text = Replace(Text15.Text, "41", "XS")
Text15.Text = Replace(Text15.Text, "74", "9U")
Text15.Text = Replace(Text15.Text, "47", "NT")

Text16.Text = Replace(Text11.Text, "27", "Z3")
Text16.Text = Replace(Text16.Text, "91", "8F")
Text16.Text = Replace(Text16.Text, "72", "1K")
Text16.Text = Replace(Text16.Text, "19", "PS")
Text16.Text = Replace(Text16.Text, "56", "O1")
Text16.Text = Replace(Text16.Text, "65", "M3")
Text16.Text = Replace(Text16.Text, "83", "L0")
Text16.Text = Replace(Text16.Text, "38", "E5")
Text16.Text = Replace(Text16.Text, "01", "XD")
Text16.Text = Replace(Text16.Text, "10", "PW")

Text17.Text = Replace(Text12.Text, "30", "C4")
Text17.Text = Replace(Text17.Text, "03", "UX")
Text17.Text = Replace(Text17.Text, "55", "I8")
Text17.Text = Replace(Text17.Text, "66", "PS")
Text17.Text = Replace(Text17.Text, "23", "MZ")
Text17.Text = Replace(Text17.Text, "32", "8Q")
Text17.Text = Replace(Text17.Text, "14", "0L")
Text17.Text = Replace(Text17.Text, "41", "XS")
Text17.Text = Replace(Text17.Text, "74", "9U")
Text17.Text = Replace(Text17.Text, "47", "NT")

txtFullAlpha.Text = Text13.Text & "-" & Text14.Text & "-" & Text15.Text & "-" & Text16.Text & "-" & Text17.Text

End Sub
```

You said earlier in the this thread this isn't the best sequence.

----------

