Trying to make a file un-usable if copied.

MDAUME · #1 (**permalink**) 06-24-04, 13:18

I am trying to prevent a file from being copied and used freely.

What I have in mind is to make the file reliant upon another files presence or else it will lock. I have it all laid out so that my file simply needs to retreve a "1" from a cell on another file.

The problem that I am having is that it appears to retain the "1" after the link is broken. For example I set it up so that book2 cell a1 is the sum of book1 cell a1 now you would think that if I delete book1 the sum would go to zero or error but it dosent.

Is there a way to make it error by the lack of the presence of book1?

Or is there a better way to accomplish the end result Im looking for?

Matthew

shades · #2 (**permalink**) 06-24-04, 14:00

First, Matthew, welcome to the board.

Quote:

Originally Posted by MDAUME

I have it all laid out so that my file simply needs to retreve a "1" from a cell on another file.

The problem that I am having is that it appears to retain the "1" after the link is broken. For example I set it up so that book2 cell a1 is the sum of book1 cell a1 now you would think that if I delete book1 the sum would go to zero or error but it dosent.

Is there a way to make it error by the lack of the presence of book1?

Or is there a better way to accomplish the end result Im looking for?

Without knowing how you are "retrieving" the 1, it is difficult to know if there is a better way.

Also, if you are trying to prevent copying, you might want to read the following link:

http://www.dbforums.com/t1002003.html

MDAUME · #3 (**permalink**) 06-24-04, 15:43

Thank you for the welcome Shades.

The mannor in which I am retreving the 1 is with the sum function. I followed your link to someone elses question about protecting a file from being copied but dont think that it applies to what I am trying to do.

Ill try to explain in a little more detail.

I want to put my file on a disk for someone else to copy to another computer (there is no data involved its really just a very coplex payment calculator). But what Im trying to do is to insure it dosent get passed on from there.

This is the plan. I put a function in the worksheet that will lock if a particular cell does not =1 with that cell being the sum of another cell in another file. In this mannor if this person tries to copy my file to another computer without my permission and without knowing about its reliance on another file that has been placed on his computer the copy wont work.

This brings me to the problem. In the absence of the other file it dosent lock. It alerts me that "This workbook contains one or more links that cannot be updated.". But retains the all crutial "1"!

Now... Is there a way to make it update and without a good link to the other file containing the "1" make it change to a "0" or an error or a blank cell or anything but a "1"?

Thank you in advance for any guidence you can offer.

Matthew

DavidCoutts · #4 (**permalink**) 06-25-04, 09:25

How about putting some code in to close the workbook if the filepath is not correct, i.e.

in the worksheet_Open Event try checking the file path by using

ThisWorkbook.Path

or if you want to look for a seperate file use the filesearch technique(it takes a while to run)

Code:

With Application.FileSearch
    .LookIn = "C:\"
    .SearchSubFolders = True
    .Filename = "otherbook.xls"
    If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderDescending) > 0 Then
        MsgBox "There were " & .FoundFiles.Count & " file(s) found."
        For I = 1 To .FoundFiles.Count
            Cells(I + 1, 1) = (.FoundFiles(I))
        Next I
    Else
        MsgBox "There were no files found."
    End If
End With

HTH
David

MDAUME · #5 (**permalink**) 06-25-04, 12:57

Or if you want to look for a seperate file use the filesearch technique(it takes a while to run)

David,

I think we are on the right track. Can you suggest a code that will close the program if the filesearch comes back emptyhanded? Or return the fiesearch to a cell instead of a message box. Preferrably with no message box.

Matthew

DavidCoutts · #6 (**permalink**) 06-25-04, 15:23

This is quite simple

If the If statement returns a true then
do something
Else
ThisWorkbook.Close(replace msgbox with this line in the else statement)

using this is ok but its very eaisly broken as someone can just disable the macros from running and do what they wan't anyway. so other things you need to think about is hiding the actual working sheets and password protecting them also password protect your code.

As described in the other thread excel security is pretty easily broken so you have to know that pretty much anything you do won't keep your file very secure.

the other thing is if there is a lot of files on the users machine this code can take an age to run.

David

MDAUME · #7 (**permalink**) 06-25-04, 15:36

Quote:

Originally Posted by DavidCoutts

This is quite simple

If the If statement returns a true then
do something
Else
ThisWorkbook.Close(replace msgbox with this line in the else statement)

using this is ok but its very eaisly broken as someone can just disable the macros from running and do what they wan't anyway.

Is there a code for that? Enable macros before opening.

Matthew

DavidCoutts · #8 (**permalink**) 06-25-04, 17:40

Quote:

Originally Posted by MDAUME

For instance can I set up a code to add a 1 to the value of sheet1 cell A1, then have that 1 deducted from the value before close or save?

as from your private message to add a value to sheet1 cell a1 on opening use
and closing use

Code:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'set value of A1 on sheet 1 to 0 on closing
    Worksheets("Sheet1").Range("A1").Value = 1
    ThisWorkbook.Save
End Sub

Private Sub Workbook_Open()
    'add 1 to A1 on sheet 1 on opening
    Worksheets("Sheet1").Range("A1").Value = 1
End Sub

these go in the workbook code window

Quote:

Originally Posted by MDAUME

Is there a code for that? Enable macros before opening.

no and im certainly glad there isn't all sorts of code can do hideous damage to the running of your PC and if you could add code to do this so could anybody and you don't want that, if you want macro's to run on machines without the pop up box then you have to digitally sign it and make sure the recipient pc allows that signature

post back to the forum if you need any more

David

MDAUME · #9 (**permalink**) 06-25-04, 18:22

Thank you for all your help David.

Quote:

Originally Posted by DavidCoutts

post back to the forum if you need any more

David

Sorry, Im still new to this forum. I dont mean to offend.

Matthew

MDAUME · #10 (**permalink**) 06-26-04, 10:11

Can we make the File Search for a Hidden File?

This is working out great! Here is what I have so far.

Private Sub Workbook_Activate()
With Application.FileSearch
.LookIn = "C:\key"
.SearchSubFolders = True
.Filename = "otherbook.xls"
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderDescending) > 0 Then

For I = 1 To .FoundFiles.Count

Next I
Else
Application.Quit
End If
End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'set value of A1 on sheet 1 to 0 on closing
Worksheets("Sheet1").Range("A1").Value = 0
ThisWorkbook.Save
End Sub

Private Sub Workbook_Open()
'add 1 to A1 on sheet 1 on opening
Worksheets("Sheet1").Range("A1").Value = 1
End Sub

blindman · #11 (**permalink**) 06-26-04, 12:43

Can't you do this without using a second file? Use a registry entry instead.

1) When the spreadsheet is opened, it checks the contents of a hidden cell.
2) If the cell is null, the spreadsheet fills it with a random number, or perhaps a hash of the machine name, and then stores that value in the registry.
2) If the cell is not null, the spreadsheet compares it to the value in the registry and shuts down if the value is different or if the registry value does not exist.

If you use a hash of the machine name or some other environment value, it would not even be possible to use the spreadsheet on a different system by copying the registry value.

MDAUME · #12 (**permalink**) 06-26-04, 13:03

Quote:

Originally Posted by blindman

Can't you do this without using a second file? Use a registry entry instead.

1) When the spreadsheet is opened, it checks the contents of a hidden cell.
2) If the cell is null, the spreadsheet fills it with a random number, or perhaps a hash of the machine name, and then stores that value in the registry.
2) If the cell is not null, the spreadsheet compares it to the value in the registry and shuts down if the value is different or if the registry value does not exist.

If you use a hash of the machine name or some other environment value, it would not even be possible to use the spreadsheet on a different system by copying the registry value.

This sounds incredible. Can you give me the code to make this happen. Id love to give it a try.

Matthew

blindman · #13 (**permalink**) 06-27-04, 00:03

It does?

The vb command for storing a registry value is SaveSetting, and the command for retrieving a value is GetSetting(). I use them in Access applications frequently, and I can't imagine that they wouldn't be available in an Excel module.

Not sure about HASH functions or niladic (system value) functions within Excel or VB For Applications, but you could just use a RANDOM function instead. It seems easier to me than having to worry about a second secret file.

MDAUME · #14 (**permalink**) 06-28-04, 09:19

Quote:

Originally Posted by blindman

It seems easier to me than having to worry about a second secret file.

Sounds great. Ill need some help though. I no nothing about writing code. If someone can give me some direction on that I would be grateful.

Matthew

DavidCoutts · #15 (**permalink**) 06-30-04, 04:53

Hi Mathew,

editing the registry is a new thing for me, but have looked into it and have come up with some code for doing this,
Post back if you have any queries

Code:

Sub WriteSettings()
    'Generate Random Key for the registry to hold
    Dim MyKey As String, I As Integer
    Dim Password As String
    
    'ask for a password before proceeding
    Password = InputBox("Please input the Administration password", "Password")
    
    'if wrong password inform and do nothing
    If Not Password = "admin" Then
        MsgBox "Incorrect password process will not run"
        Exit Sub
    End If
    
    Randomize 'Initalise the random number generator
    'generate a unique id for this program
    For I = 1 To 6
        MyKey = MyKey & CStr(Chr(Int((126 - 34) * Rnd) + 35))
    Next I
    'add the key to a worksheet
    Worksheets("Sheet1").Range("A1").Value = MyKey
    'Hide and Protect the Worksheet
    Worksheets("Sheet1").Visible = xlVeryHidden
    Worksheets("Sheet1").Protect Password:="admin", _
        DrawingObjects:=True, Contents:=True, Scenarios:=True
    
    'add setting to registry
    SaveSetting "xlApp", "Startup", "Access", MyKey
End Sub

Sub RemoveRegEntry()
    'ask for a password before proceeding
    Password = InputBox("Please input the Administration password", "Password")
    
    'if wrong password inform and do nothing
    If Not Password = "admin" Then
        MsgBox "Incorrect password process will not run"
        Exit Sub
    End If
    'remove the registry setting
    DeleteSetting "xlApp", "Startup"
    'Clear the Entry on the worksheet
    Worksheets("Sheet1").Range("A1").Value = ""
    
End Sub

Sub CheckSettings()
    'check to see if there is a valid registry entry
    'If not check to see if user has password
    'If not close workbook
    
    Dim MySetting As Variant, AppSetting As String
    'obtain the setting from the registry
    MySetting = GetSetting("xlApp", "StartUp", "Access")
    'Check to see if it is the right setting
    AppSetting = Worksheets("Sheet1").Range("A1").Value
    If Not MySetting = AppSetting Then
        Password = InputBox("Please input the Administration password", "Password")
    
        'if wrong password inform and Quit application
        If Not Password = "admin" Then
            MsgBox "Incorrect password exiting"
            Application.Quit
        Else
            MsgBox "Please run registry setting process"
        End If
    Else
        MsgBox "Welcome", vbOKOnly, "Welcome"
    End If
End Sub

David

Internet Services

Web Development

Digital Marketing

Consumer Tech