Server : Apache/2.4.43 (Win64) OpenSSL/1.1.1g PHP/7.4.6 System : Windows NT USER-PC 6.1 build 7601 (Windows 7 Professional Edition Service Pack 1) AMD64 User : User ( 0) PHP Version : 7.4.6 Disable Function : NONE Directory : C:/Program Files (x86)/OpenOffice 4/share/basic/Euro/ |
<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> <!--*********************************************************** * * Licensed to the Apache Software Foundation (ASF) under one * or more contributor license agreements. See the NOTICE file * distributed with this work for additional information * regarding copyright ownership. The ASF licenses this file * to you under the Apache License, Version 2.0 (the * "License"); you may not use this file except in compliance * with the License. You may obtain a copy of the License at * * http://www.apache.org/licenses/LICENSE-2.0 * * Unless required by applicable law or agreed to in writing, * software distributed under the License is distributed on an * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY * KIND, either express or implied. See the License for the * specific language governing permissions and limitations * under the License. * ***********************************************************--> <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>