175 lines
No EOL
4.9 KiB
XML
175 lines
No EOL
4.9 KiB
XML
<?xml version="1.0" encoding="UTF-8"?>
|
|
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
|
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Protect" script:language="StarBasic">REM ***** BASIC *****
|
|
Option Explicit
|
|
|
|
Public PWIndex as Integer
|
|
|
|
|
|
Function UnprotectSheetsWithPassWord(oSheets as Object, bDoUnProtect as Boolean)
|
|
Dim i as Integer
|
|
Dim MaxIndex as Integer
|
|
Dim iMsgResult as Integer
|
|
PWIndex = -1
|
|
If bDocHasProtectedSheets Then
|
|
If Not bDoUnprotect Then
|
|
' At First query if sheets shall generally be unprotected
|
|
iMsgResult = Msgbox(sMsgUNPROTECT,36,sMsgDLGTITLE)
|
|
bDoUnProtect = iMsgResult = 6
|
|
End If
|
|
If bDoUnProtect Then
|
|
MaxIndex = oSheets.Count-1
|
|
For i = 0 To MaxIndex
|
|
bDocHasProtectedSheets = Not UnprotectSheet(oSheets(i))
|
|
If bDocHasProtectedSheets Then
|
|
ReprotectSheets()
|
|
Exit For
|
|
End If
|
|
Next i
|
|
If PWIndex = -1 Then
|
|
ReDim UnProtectList() as String
|
|
Else
|
|
ReDim Preserve UnProtectList(PWIndex) as String
|
|
End If
|
|
Else
|
|
Msgbox (sMsgSHEETSNOPROTECT, 64, sMsgDLGTITLE)
|
|
End If
|
|
End If
|
|
UnProtectSheetsWithPassword = bDocHasProtectedSheets
|
|
End Function
|
|
|
|
|
|
Function UnprotectSheet(oListSheet as Object)
|
|
Dim ListSheetName as String
|
|
Dim sStatustext as String
|
|
Dim i as Integer
|
|
Dim bOneSheetIsUnprotected as Boolean
|
|
i = -1
|
|
ListSheetName = oListSheet.Name
|
|
If oListSheet.IsProtected Then
|
|
oListSheet.Unprotect("")
|
|
If oListSheet.IsProtected Then
|
|
' Sheet is protected by a Password
|
|
bOneSheetIsUnProtected = UnprotectSheetWithDialog(oListSheet, ListSheetName)
|
|
UnProtectSheet() = bOneSheetIsUnProtected
|
|
Else
|
|
' The Sheet could be unprotected without a password
|
|
AddSheettoUnprotectionlist(ListSheetName,"")
|
|
UnprotectSheet() = True
|
|
End If
|
|
Else
|
|
UnprotectSheet() = True
|
|
End If
|
|
End Function
|
|
|
|
|
|
Function UnprotectSheetWithDialog(oListSheet as Object, ListSheetName as String) as Boolean
|
|
Dim PWIsCorrect as Boolean
|
|
Dim QueryText as String
|
|
oDocument.CurrentController.SetActiveSheet(oListSheet)
|
|
QueryText = ReplaceString(sMsgPWPROTECT,"'" & ListSheetName & "'", "%1TableName%1")
|
|
'"Please insert the password to unprotect the sheet '" & ListSheetName'"
|
|
Do
|
|
ExecutePasswordDialog(QueryText)
|
|
If bCancelProtection Then
|
|
bCancelProtection = False
|
|
Msgbox (sMsgSHEETSNOPROTECT, 64, sMsgDLGTITLE)
|
|
UnprotectSheetWithDialog() = False
|
|
exit Function
|
|
End If
|
|
oListSheet.Unprotect(Password)
|
|
If oListSheet.IsProtected Then
|
|
PWIsCorrect = False
|
|
Msgbox (sMsgWRONGPW, 64, sMsgDLGTITLE)
|
|
Else
|
|
' Sheet could be unprotected
|
|
AddSheettoUnprotectionlist(ListSheetName,Password)
|
|
PWIsCorrect = True
|
|
End If
|
|
Loop Until PWIsCorrect
|
|
UnprotectSheetWithDialog() = True
|
|
End Function
|
|
|
|
|
|
Sub ExecutePasswordDialog(QueryText as String)
|
|
With PasswordModel
|
|
.Title = QueryText
|
|
.hlnPassword.Label = sMsgPASSWORD
|
|
.cmdCancel.Label = sMsgCANCEL
|
|
.cmdHelp.Label = sHELP
|
|
.cmdGoOn.Label = sMsgOK
|
|
.cmdGoOn.DefaultButton = True
|
|
End With
|
|
DialogPassword.Execute
|
|
End Sub
|
|
|
|
Sub ReadPassword()
|
|
Password = PasswordModel.txtPassword.Text
|
|
DialogPassword.EndExecute
|
|
End Sub
|
|
|
|
|
|
Sub RejectPassword()
|
|
bCancelProtection = True
|
|
DialogPassword.EndExecute
|
|
End Sub
|
|
|
|
|
|
' Reprotects the previousliy protected sheets
|
|
' The passwordinformation is stored in the List 'UnProtectList()'
|
|
Sub ReprotectSheets()
|
|
Dim i as Integer
|
|
Dim oProtectSheet as Object
|
|
Dim ProtectList() as String
|
|
Dim SheetName as String
|
|
Dim SheetPassword as String
|
|
If PWIndex > -1 Then
|
|
SetStatusLineText(sStsREPROTECT)
|
|
For i = 0 To PWIndex
|
|
ProtectList() = ArrayOutOfString(UnProtectList(i),";")
|
|
SheetName = ProtectList(0)
|
|
If Ubound(ProtectList()) > 0 Then
|
|
SheetPassWord = ProtectList(1)
|
|
Else
|
|
SheetPassword = ""
|
|
End If
|
|
oProtectSheet = oSheets.GetbyName(SheetName)
|
|
If Not oProtectSheet.IsProtected Then
|
|
oProtectSheet.Protect(SheetPassWord)
|
|
End If
|
|
Next i
|
|
SetStatusLineText("")
|
|
End If
|
|
PWIndex = -1
|
|
ReDim UnProtectList()
|
|
End Sub
|
|
|
|
|
|
' Add a Sheet to the list of sheets that finally have to be
|
|
' unprotected
|
|
Sub AddSheettoUnprotectionlist(ListSheetName as String, Password as String)
|
|
Dim MaxIndex as Integer
|
|
MaxIndex = Ubound(UnProtectList())
|
|
PWIndex = PWIndex + 1
|
|
If PWIndex > MaxIndex Then
|
|
ReDim Preserve UnprotectList(MaxIndex + SBRANGEUBOUND)
|
|
End If
|
|
UnprotectList(PWIndex) = ListSheetName & ";" & Password
|
|
End Sub
|
|
|
|
|
|
Function CheckSheetProtection(oSheets as Object) as Boolean
|
|
Dim MaxIndex as Integer
|
|
Dim i as Integer
|
|
Dim bProtectedSheets as Boolean
|
|
bProtectedSheets = False
|
|
MaxIndex = oSheets.Count-1
|
|
For i = 0 To MaxIndex
|
|
bProtectedSheets = oSheets(i).IsProtected
|
|
If bProtectedSheets Then
|
|
CheckSheetProtection() = True
|
|
Exit Function
|
|
End If
|
|
Next i
|
|
CheckSheetProtection() = False
|
|
End Function</script:module> |