Restricting files to a single computer

[Guest]

Dear Anyone,

I have prepared a few excel files linked together and am planning to sell it
to a company. But they may copy and give these files to other companies to
use on their computer. I want to protect my work. Giving passwords to open
the files is not a solution because the first company to whom I sold the
files may also give the password with the copy it makes.
So, I thought the only way to differentiate one computer from the other is
the Hard Disk serial number. If I could only link the opening of the files
(or the whole folder in which they are) to the Hard Disk serial number, the
problem would be solved!
In this way, a copied file or the whole folder) will not work on the other
computer, unless, I intervene and link the files to the new Hard Disk serial
number.

Any Ideas of how to do this?
Or any other way is welcome.

Thanks whoever answers.
Berj Boshnakian

 

[Guest]

Sub ShowDriveInfo()
drvpath = "C:"
Dim fs,d,s
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName
(fs.GetAbsolutePathName(drvpath)))
s = "SN: " & d.SerialNumber
MsgBox s
End Sub

 

[Bob Phillips]

Take a look at AppSentinel, http://www.thescarms.com/appsentinel/default.asp

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[NickHK]

Berj,
Read the recent posts in this group on the same subject.
If your process is really that special, Excel is the wrong basis.
You can can make it difficult, but expect that it may be broken.

If you cannot accept that, you need some compiled solution.

NickHk

 

[Guest]

Dear Mr. Tom,
Thank you for your reply. I got other answers from other people, telling me
to register or copyright it. I don't want to do that. But I am into computers
from the days of DOS. That is why I thought of the hard disk serial number.
We used to type in those days DIR in DOS and among other info it used to tell
us the serial number of a hard disk which changed after formatting. So, this
number is unique. In those days, I have prepared programs in plain BASIC
language linked to this serial number. I used to fix a certain HD serial
number in the program and then the program, while starting to run, would get
the HD serial number and compare it to the one fixed in the program, then it
would decide to work or not.
I thought to use the same way for running these EXCEL files I have prepared.
You sir, are the only one replying exactly to my issue.
But the problem is, I don't know how to apply the given code. I know how to
enter the MACROS and visual BASIC section, but what to do from there on so
that the file while starting to run would check a serial number, is unknown
to me. Will you please help me in that?

Thank you very much.
Hope to hear from you very soon.

Best regards,
Berj

 

[Bob Phillips]

One way

Public WithEvents App As Application

Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
If Wb.Path = "C:\foldername" Then
If DiskVolumeId("C:") <> "94CA-4370" Then
Wb.Close savechanges:=False
End If
End If
End Sub

Private Sub Workbook_Open()
Set App = Application
End Sub

'This is workbook event code.
'To input this code, right click on the Excel icon on the worksheet
'(or next to the File menu if you maximise your workbooks),
'select View Code from the menu, and paste the code

but it is so easy to break as to be worth little.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[Guest]

Dear Mr. Bob.
First Thanks you for replying.

I tried as you told me.
I figured out I should replace the FOLDERNAME by the foldername in which my
file is. Also I should replace the serial number provided with the serial
number of my Hard disk. I did those. Did I do right?

Something happened even before I made those changes.
It gave me the following error:
COMPILE ERROR:
SUB OR FUNCTION NOT DEFINED

and it highlighted:
DiskVolumeId

What to do next?

Regards,
Berj
--------------------

 

[Bob Phillips]

On the changes, absolutely right.

DiskVolumId is a function that gets the user disk volume id, I assumed from
your posting that you already had one of those. Id not, then


'---------------------------------------------------------------
Function DiskVolumeId(Drive As String) As String
'---------------------------------------------------------------
Dim sTemp As String
Dim iPos As Long
iPos = InStr(1, Drive, ":")
Drive = IIf(iPos > 0, Left(Drive, iPos), Drive & ":")
sTemp = Hex(CreateObject("Scripting.FileSystemObject") _
.Drives.Item(CStr(Drive)).SerialNumber)
DiskVolumeId = Left(sTemp, 4) & "-" & Right(sTemp, 4)
End Function

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[Zone]

Now, Bob's reply should be of interest to anyone who wants to license a
program to individual computers. I know I'm going to wring this sucker
out. James

 

[Guest]

Dear BOB,

It Finally worked. I added the new subroutine at the beginning and replaced
a few things. now it's working fine.
I also removed the path, and now it works even if the file is in another
location.
Thanks.

Berj

 

[Bob Phillips]

Berj,

What do you mean you removed the path?

How about posting your final solution for the archives?

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[Guest]

Dear Bob.

It's me again, Berj.
I want to thank you again for the help you gave me.
I include below this note the final code I used. You will see that in it I
have removed the path section, where it checks for the folder.
Now I have another question. I want to ask it to you, since you are the one
who knows about the programming I requested.

As you remember, I requested a code which checks the serial number of a Hard
Disk to open an Excel file. It’s working fine. Now another possible problem
passed my mind:
What if the computer in which the file is, needs to be formatted, or a new
computer is bought and the file has to pass to the new hard disk. Considering
the fact that the file may already contain information which the person does
not want to lose. Of course a backup of the file will be made and then copied
to the new hard disk (with a new serial number!)
Of course it will not open on the new hard disk, since it has a different
serial number than the previous hard disk. So, if it is not opened, I will
not be able to modify the serial number to the new hard disk serial. As a
result, the file will be unusable!
(You see, I work in an area where all my customers can call me, and I am
there personally to solve the problem).

I thought of this for a while, and found a solution in the following way (if
it is possible):
The creation of an external program (EXE extension), which can be copied to
the folder in which the Excel file is. When this external program is
executed, it asks for the Excel filename concerned. It then creates a code in
the Excel file exactly like the one you gave me before (the working version).
This external program also reads the hard disk serial number and fixes it in
the Excel file.
Now, the new code in Excel is executed every time the file is opened,
checking the hard disk serial number.
In this way, even if the original Excel file is copied to a new hard disk,
the Excel file will not open. But if the new external program is executed
there, the code in Excel is renewed (taking in the new hard disk serial
number) and the file now opens.
This external program will be in my possession only, of course.

The same external program can be used maybe (as I think now) for Access,
Word, Excel and PowerPoint files too!

If such a program is possible to make, can you make it and send it to me?
I think this new program may be used by you too…
Below, I include the code which I used in Excel and it worked fine. Use this
one please.

++++++++++++++++++++++++++++++++++++++++++++
Public WithEvents App As Application
'---------------------------------------------------------------
Function DiskVolumeId(Drive As String) As String
'---------------------------------------------------------------
Dim sTemp As String
Dim iPos As Long
iPos = InStr(1, Drive, ":")
Drive = IIf(iPos > 0, Left(Drive, iPos), Drive & ":")
sTemp = Hex(CreateObject("Scripting.FileSystemObject") _
.Drives.Item(CStr(Drive)).SerialNumber)
DiskVolumeId = Left(sTemp, 4) & "-" & Right(sTemp, 4)
End Function

Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
If DiskVolumeId("C:") <> "E06F-9984" Then
Wb.Close savechanges:=False
End If
End Sub

Private Sub Workbook_Open()
Set App = Application
End Sub
+++++++++++++++++++++++++++++++++++++++++++++++++

Best regards and thanks in advance,
Berj

 

[Guest]

This is extremely cool Tom...........is there a way to also "change" the
serial number on the HD from a macro in Excel?

Vaya con Dios,
Chuck, CABGx3

 

[Tom Ogilvy]

I don't think you can but certainly wouldn't claim to be an expert.

 

[Guest]

LOL......maybe you wouldn't "claim" to be an expert, but you'll do for me
until one comes along........thanks Tom

Vaya con Dios,
Chuck, CABGx3