/////////////////////////////////////////////////////
//			Secure OCX
//
//
//
//			 by Pavel
//
//
//	      Learn how to create Secure OCX
/////////////////////////////////////////////////////


Text Title	:	Secure OCX
Text Author	:	Pavel
Author Mail	:	sadreck@yahoo.com
Web Site	:	www.cccp.8m.net

-=[Maximize Window For Better View]=-

	This text was written for people who know how to program.All the examples presented here
	are  written  in  Visual Basic , but  could  also  be  used  if  re-written in any other 
	programming language.

	This text was written to show you an infective way to protect your OCX files.For example
	let's say that you create an OCX with some functions that are used by  your programs and
	you dont want anyone to use these functions.Like you already know it is very easy to use
	an OCX while developing a program.

	The  best  way to protect your OCX is to Password Protect it and Encrypt it. Here I will 
	show you a very good way to use password protection for your OCX.But enough of the talk!
	Let's get serious !

	The  way  to  Password  Protect  an OCX (or just a function) is to generate an encrypted 
	string  before  calling  the  function. Then, that string will be generated again by the 
	function and compared.If the two string match , the program will continue running , else
	it will generate an error and end.Here we go...

	========================================================================================

Create an ActiveX with Visual Basic and place the following function in it :
'//Place the following (2) lines in a module
Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Sub FatalExit Lib "kernel32" (ByVal code As Long)

'//Put the following code at the UserControl Declarations Area
Function WindowsDirectory(Password As Double)

'//Set Dim(s)
Dim fs, d, s
Dim DriveName, SerialNumber, UserName, sBuffer As String
Dim lSize As Long
Dim MCounter As Integer
Dim letterA, letterB, letterC, SecretNumber, SecretNumber01, SecretNumber02 As Double
    
'//Create Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(drvpath)))

'//Get Volume Name
s = d.VolumeName

'//Set DriveName as Volume Name
DriveName = s

'//Get HDD Serial Number
s = d.SerialNumber

'//Set SerialNumber as Serial Number
SerialNumber = s
    
'//Get UserName
sBuffer = Space$(255)
lSize = Len(sBuffer)
    
Call GetUserName(sBuffer, lSize)

'//Set UserName as Computer User Name
UserName = Left$(sBuffer, lSize)

'//Now we have DriveName , SerialNumber , UserName

'//Set All values to Zero (0)

MCounter = 0
letterA = 0
letterB = 0
letterC = 0

'//Below is an encryption function

For i = 1 To Len(DriveName)
    
    '//Add +1 to MCounter
    MCounter = MCounter + 1
    
    '//Take the letter at position (i) from the (DriveName) string
    '//and make operations to it's ASCII code
    letterA = (Asc(Mid$(DriveName, i, 1)) * 3) + 256
    
    '//Check if MCounter value is bigger than the Length of the
    '//(UserName) string.If it is , then set MCounter to (1)
    If MCounter > Len(UserName) Then MCounter = 1
    
    '//Take the letter at position (MCounter) from the (UserName) string
    '//and make operations to it's ASCII code
    letterB = (Asc(Mid$(UserName, MCounter, 1)) * 7) + 128
    
    '//Finally set (letterC) value , as the sum of (letterA) and
    '//(letterB) value
    letterC = letterA + letterB + letterC

Next i

'//Set (SecretNumber01) value to the value of (letterC) multiplied by 2
SecretNumber01 = letterC * 2

'//Set All values to Zero (0)
letterA = 0
letterB = 0
letterC = 0

'//Below is an encryption function
For i = 1 To Len(SerialNumber)
    
    '//Take the letter from the (SerialNumber) string with (i) position
    letterA = Asc(Mid$(SerialNumber, i, 1))
    
    '//Do operations to (letterA) value
    letterB = (((letterA * 16) + 1) * 8) + 256
    
    '//Set (letterC) as the sum of itself and (letterB)
    letterC = letterC + letterB
    
Next i

'//Set (SecretNumber01) value to the value of (letterC) multiplied by 4
SecretNumber02 = letterC * 4

'//Finally , set SecretNumber as the sum of (SecretNumber01) and
'//(SecretNumber02)
SecretNumber = SecretNumber01 + SecretNumber02

'//Compare Encrypted Password with the Password given
If SecretNumber = Password Then
    '//If two passwords match then set DirWin as Windows Directory
    '//fs.GetSpecialFolder(0) = Windows Directory
    '//fs.GetSpecialFolder(1) = System Directory
    '//fs.GetSpecialFolder(2) = Temp Directory
    Set dirwin = fs.GetSpecialFolder(0)
    '//Set WindowsDirectory as WindowsDirectory
    WindowsDirectory = dirwin
Else
    '//Call FatalExit Function and end program !
    FatalExit "0000"
End If

End Function

	========================================================================================
	========================================================================================

To call the function use this :
'//Let's say that the name of your OCX is "testOCX"

Private Sub Form_Load()
'//Set Dim(s)
Dim fs, d, s
Dim DriveName, SerialNumber, UserName, sBuffer As String
Dim lSize As Long
Dim MCounter As Integer
Dim letterA, letterB, letterC, SecretNumber, SecretNumber01, SecretNumber02, PassWd As Double
    
'//Create Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(drvpath)))

'//Get Volume Name
s = d.VolumeName

'//Set DriveName as Volume Name
DriveName = s

'//Get HDD Serial Number
s = d.SerialNumber

'//Set SerialNumber as Serial Number
SerialNumber = s
    
'//Get UserName
sBuffer = Space$(255)
lSize = Len(sBuffer)
    
Call GetUserName(sBuffer, lSize)

'//Set UserName as Computer User Name
UserName = Left$(sBuffer, lSize)

'//Now we have DriveName , SerialNumber , UserName

'//Set All values to Zero (0)

MCounter = 0
letterA = 0
letterB = 0
letterC = 0

'//Below is an encryption function

For i = 1 To Len(DriveName)
    
    '//Add +1 to MCounter
    MCounter = MCounter + 1
    
    '//Take the letter at position (i) from the (DriveName) string
    '//and make operations to it's ASCII code
    letterA = (Asc(Mid$(DriveName, i, 1)) * 3) + 256
    
    '//Check if MCounter value is bigger than the Length of the
    '//(UserName) string.If it is , then set MCounter to (1)
    If MCounter > Len(UserName) Then MCounter = 1
    
    '//Take the letter at position (MCounter) from the (UserName) string
    '//and make operations to it's ASCII code
    letterB = (Asc(Mid$(UserName, MCounter, 1)) * 7) + 128
    
    '//Finally set (letterC) value , as the sum of (letterA) and
    '//(letterB) value
    letterC = letterA + letterB + letterC

Next i

'//Set (SecretNumber01) value to the value of (letterC) multiplied by 2
SecretNumber01 = letterC * 2

'//Set All values to Zero (0)
letterA = 0
letterB = 0
letterC = 0

'//Below is an encryption function
For i = 1 To Len(SerialNumber)
    
    '//Take the letter from the (SerialNumber) string with (i) position
    letterA = Asc(Mid$(SerialNumber, i, 1))
    
    '//Do operations to (letterA) value
    letterB = (((letterA * 16) + 1) * 8) + 256
    
    '//Set (letterC) as the sum of itself and (letterB)
    letterC = letterC + letterB
    
Next i

'//Set (SecretNumber01) value to the value of (letterC) multiplied by 4
SecretNumber02 = letterC * 4

'//Finally , set SecretNumber as the sum of (SecretNumber01) and
'//(SecretNumber02)

PassWd = SecretNumber01 + SecretNumber02

'//Call Function
WinDir = testOCX.WindowsDirectory (PassWd)

MsgBox WinDir
End Sub

	========================================================================================

	If the encryption function is correct then it will show the Windows Directory , else  it 
	will  generate  an  error  and  end  the  program. You can surely  make a more powerfull 
	encryption. This one shown here is just for an example.I wouldn't suggest using the same
	algorithm  in  all  the  functions. Just  make  a unique  encryption algorithm for every 
	function.It is the most secure way.