PDA

View Full Version : Sleeper: File opens as read only



alexanderd
06-15-2005, 02:44 PM
as some times can happen another person tries to access an already opened excel file, for which you are warned , you can open in read only.
some bright spark in our office said yes (to read only) and proceeded to create a new file by copy and paste and save as.

how can we stop this happening again:banghead:

austenr
06-15-2005, 03:01 PM
You can disable Cut, Copy and paste. I think there is a solution in the Knowledge base. If not someone will be along in a bit to help you out or you can do a Google search.

Zack Barresse
06-15-2005, 03:01 PM
I guess there may be a couple of things you could do ...

[1]:
Test if file is open manually, then disallow opening. (example (http://www.xcelfiles.com/IsFileOpen.html))

[2]:
Disallow Cut/Copy/Paste. (example (http://www.xcelfiles.com/VBA_Quick13.html), and our KB as well (http://www.vbaexpress.com/kb/getarticle.php?kb_id=373))

[3]:
Password protect the file(s).

[4]:
Ban this user.

[5]:
Cut this user's hands off.

[6]:
Sue this person. (if copyright has been broken)

These are just off the top of my head. It really sounds like this person does not need to be anywhere near a spreadsheet, let alone a computer.

alexanderd
06-15-2005, 03:14 PM
thank you both for your quick responses. Ivans site is OK but i cannot get verry far as the vba and api boxes are bothe empty!!!

i will try another way to his site may be it will work ok

Zack Barresse
06-15-2005, 03:32 PM
Option #1 (from xcelfiles.com)

API METHOD

Option Explicit
'http://www.xcelfiles.com/IsFileOpenAPI.htm
'// Note we use an Alias here as using the Actual
'// function name will not be accepted! ie underscore= "_lopen"

Private Declare Function lOpen _
Lib "kernel32" _
Alias "_lopen" ( _
ByVal lpPathName As String, _
ByVal iReadWrite As Long) _
As Long

Private Declare Function lClose _
Lib "kernel32" _
Alias "_lclose" ( _
ByVal hFile As Long) _
As Long

'// Don't use these...here for Info only

Private Const OF_SHARE_COMPAT = &H0
Private Const OF_SHARE_DENY_NONE = &H40
Private Const OF_SHARE_DENY_READ = &H30
Private Const OF_SHARE_DENY_WRITE = &H20

'// Use the Constant below
'// OF_SHARE_EXCLUSIVE = &H10
'// OPENS the FILE in EXCLUSIVE mode,
'// denying other processes AND the current process both read and write
'// access to the file. If the file has been opened in any other mode for read or
'// write access _lopen fails. This is important as if you open the file in the
'// current process = Excel BUT loose its handle
'// then you CANNOT open it again in the SAME session!
Private Const OF_SHARE_EXCLUSIVE = &H10

'If the Function succeeds, the return value is a File handle.
'If the Function fails, the return value is HFILE_ERROR = -1

Private Function IsFileAlreadyOpen(strFullPath_FileName As String) As Boolean
'// Ivan F Moala
'// http://www.xcelfiles.com
Dim hdlFile As Long
Dim lastErr As Long
hdlFile = -1
'// Open file for Read/Write and Exclusive Sharing.
hdlFile = lOpen(strFullPath_FileName, OF_SHARE_EXCLUSIVE)
'// If we can't open the file, get the last error.
If hdlFile = -1 Then
lastErr = Err.LastDllError
Else
'// Make sure we close the file on success!
lClose (hdlFile)
End If
'// Check for sharing violation error.
IsFileAlreadyOpen = (hdlFile = -1) And (lastErr = 32)
End Function

Sub TestAPI()
'// We can use this for ANY FILE not just Excel!
If IsFileAlreadyOpen("C:\Data.xls") Then
MsgBox "C:\Data.xls " & " is already Open" & _
vbCrLf & "By " & LastUser("C:\Data.xls"), vbInformation, "File in Use"
Else
MsgBox "File is NOT open", vbInformation
End If
End Sub

Private Function LastUser(strPath As String) As String
'// Code by Helen from http://www.visualbasicforum.com/index.php?s=
'// This routine gets the Username of the File In Use
'// Credit goes to Helen for code & Mark for the idea
'// Insomniac for xl97 inStrRev
'// Amendment 25th June 2004 by IFM
'// : Name changes will show old setting
'// : you need to get the Len of the Name stored just before
'// : the double Padded Nullstrings
Dim strXl As String
Dim strFlag1 As String, strflag2 As String
Dim i As Integer, j As Integer
Dim hdlFile As Long
Dim lNameLen As Byte
strFlag1 = Chr(0) & Chr(0)
strflag2 = Chr(32) & Chr(32)
hdlFile = FreeFile
Open strPath For Binary As #hdlFile
strXl = Space(LOF(hdlFile))
Get 1, , strXl
Close #hdlFile
j = InStr(1, strXl, strflag2)
#If Not VBA6 Then
'// Xl97
For i = j - 1 To 1 Step -1
If Mid(strXl, i, 1) = Chr(0) Then Exit For
Next
i = i + 1
#Else
'// Xl2000+
i = InStrRev(strXl, strFlag1, j) + Len(strFlag1)
#End If
'// IFM
lNameLen = Asc(Mid(strXl, i - 3, 1))
LastUser = Mid(strXl, i, lNameLen)
End Function


VBA METHOD


Option Explicit
'http://www.xcelfiles.com/IsFileOpenVBA.htm

Sub TestVBA()
'// Just change the file to test here
Const strFileToOpen As String = "C:\Data.xls"
If IsFileOpen(strFileToOpen) Then
MsgBox strFileToOpen & " is already Open" & _
vbCrLf & "By " & LastUser(strFileToOpen), vbInformation, "File in Use"
Else
MsgBox strFileToOpen & " is not open", vbInformation
End If
End Sub

Function IsFileOpen(strFullPathFileName As String) As Boolean
'// VBA version to check if File is Open
'// We can use this for ANY FILE not just Excel!
'// Ivan F Moala
'// http://www.xcelfiles.com
Dim hdlFile As Long
'// Error is generated if you try
'// opening a File for ReadWrite lock >> MUST BE OPEN!
On Error GoTo FileIsOpen:
hdlFile = FreeFile
Open strFullPathFileName For Random Access Read Write Lock Read Write As hdlFile
IsFileOpen = False
Close hdlFile
Exit Function
FileIsOpen:
'// Someone has it open!
IsFileOpen = True
Close hdlFile
End Function

Private Function LastUser(strPath As String) As String
'// Code by Helen from http://www.visualbasicforum.com/index.php?s=
'// This routine gets the Username of the File In Use
'// Credit goes to Helen for code & Mark for the idea
'// Insomniac for xl97 inStrRev
'// Amendment 25th June 2004 by IFM
'// : Name changes will show old setting
'// : you need to get the Len of the Name stored just before
'// : the double Padded Nullstrings
Dim strXl As String
Dim strFlag1 As String, strflag2 As String
Dim i As Integer, j As Integer
Dim hdlFile As Long
Dim lNameLen As Byte
strFlag1 = Chr(0) & Chr(0)
strflag2 = Chr(32) & Chr(32)
hdlFile = FreeFile
Open strPath For Binary As #hdlFile
strXl = Space(LOF(hdlFile))
Get 1, , strXl
Close #hdlFile
j = InStr(1, strXl, strflag2)
#If Not VBA6 Then
'// Xl97
For i = j - 1 To 1 Step -1
If Mid(strXl, i, 1) = Chr(0) Then Exit For
Next
i = i + 1
#Else
'// Xl2000+
i = InStrRev(strXl, strFlag1, j) + Len(strFlag1)
#End If
'// IFM
lNameLen = Asc(Mid(strXl, i - 3, 1))
LastUser = Mid(strXl, i, lNameLen)
End Function

Option #2 (from xcelfiles.com)


Option Explicit

Sub DisableCopyCutAndPaste()
EnableControl 21, False ' cut
EnableControl 19, False ' copy
EnableControl 22, False ' paste
EnableControl 755, False ' pastespecial
Application.OnKey "^c", "Dummy"
Application.OnKey "^v", "Dummy"
Application.OnKey "+{DEL}", "Dummy"
Application.OnKey "+{INSERT}", "Dummy"
Application.CellDragAndDrop = False
Application.OnDoubleClick = "Dummy"
CommandBars("ToolBar List").Enabled = False
End Sub

Sub EnableCopyCutAndPaste()
EnableControl 21, True ' cut
EnableControl 19, True ' copy
EnableControl 22, True ' paste
EnableControl 755, True ' pastespecial
Application.OnKey "^c"
Application.OnKey "^v"
Application.OnKey "+{DEL}"
Application.OnKey "+{INSERT}"
Application.CellDragAndDrop = True
Application.OnDoubleClick = ""
CommandBars("ToolBar List").Enabled = True
End Sub

Sub EnableControl(Id As Integer, Enabled As Boolean)
Dim CB As CommandBar
Dim C As CommandBarControl
On Error Resume Next
For Each CB In Application.CommandBars
Set C = CB.FindControl(Id:=Id, recursive:=True)
If Not C Is Nothing Then C.Enabled = Enabled
Next
End Sub

Sub Dummy()
'// NoGo
MsgBox "Sorry command not Available!"
End Sub

alexanderd
06-16-2005, 11:40 AM
thank you verry much i will enjoy trying this out at work tommorow, and hopefully given the time report back asap:hi:

alexanderd
06-27-2005, 01:07 PM
what i should have said was thank you to all who have helped me in resolving the iniquities of people who wish to corupt work which has taken in some cases months, or even longer if you count the man / women hours which are involved in data input.

i have been working away at trying to stop this happening at least where i work. the starting point for me was " DisableCopyCutAndPaste " which i would like to submit with my ammendments for my peers to pass judgement on.

Every time i think i have finished i find that there are more ways to corrupt the file than seem possible. short cuts " ctrl+ + /ctrl+ - / ctrl + spacebar / move or copy sheets " to name a few.
please critisize comment as you wish

Zack Barresse
06-28-2005, 08:59 AM
Alexanderd, I have not looked at your attachment yet, but thought I would outline some of my thoughts first, if you don't mind. IMHO, spreadsheets are not meant for protecting. They are very fragile and do not offer a sufficient level of protection. There are many things you can do to increase spreadsheet security, some of which have been outlined in this thread by yourself; although in the end, in the hands of a capable person, this protection means nothing. Even the most difficult protection can be undone by the hands of a skilled/knowledgable user. If you're looking for a secure application, Excel is not that one.

austenr
06-28-2005, 09:11 AM
We face this problem at work. You are right Zack, the protection is not that secure. I have at least 10 ways to crack passwords (I do not do it however unless instructed to and then I feel bad about it) and you can find lots more on the internet. I have come to the conclusion that nothing is totally secure. You can only hope that the wrong person does not get their hands on it.

alexanderd
06-28-2005, 11:56 AM
my problem as all programers problems arise from some one saying what if??? you then look to plug what could be a loophole. In my case that some nefarious person would would have the gaul to copy the spread sheet , because it had opened as read only as some one else was inputting data, do his or her little bit copy and paste back into the original, hence corrupting the data.

As long as there are no script kiddies, or people who enjoy causing havoc in the company, the security level which has been imposed might be enough.

to all who have contributed to my call for help i say thank you, if my small file is found to be of help to any one use it with pleasure (i cannot lay claim to the initial file from which i have learnt a great deal)