Protect.xba 5.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192
  1. <?xml version="1.0" encoding="UTF-8"?>
  2. <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
  3. <!--
  4. * This file is part of the LibreOffice project.
  5. *
  6. * This Source Code Form is subject to the terms of the Mozilla Public
  7. * License, v. 2.0. If a copy of the MPL was not distributed with this
  8. * file, You can obtain one at http://mozilla.org/MPL/2.0/.
  9. *
  10. * This file incorporates work covered by the following license notice:
  11. *
  12. * Licensed to the Apache Software Foundation (ASF) under one or more
  13. * contributor license agreements. See the NOTICE file distributed
  14. * with this work for additional information regarding copyright
  15. * ownership. The ASF licenses this file to you under the Apache
  16. * License, Version 2.0 (the "License"); you may not use this file
  17. * except in compliance with the License. You may obtain a copy of
  18. * the License at http://www.apache.org/licenses/LICENSE-2.0 .
  19. -->
  20. <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Protect" script:language="StarBasic">REM ***** BASIC *****
  21. Option Explicit
  22. Public PWIndex as Integer
  23. Function UnprotectSheetsWithPassWord(oSheets as Object, bDoUnProtect as Boolean)
  24. Dim i as Integer
  25. Dim MaxIndex as Integer
  26. Dim iMsgResult as Integer
  27. PWIndex = -1
  28. If bDocHasProtectedSheets Then
  29. If Not bDoUnprotect Then
  30. &apos; At First query if sheets shall generally be unprotected
  31. iMsgResult = Msgbox(sMsgUNPROTECT,36,sMsgDLGTITLE)
  32. bDoUnProtect = iMsgResult = 6
  33. End If
  34. If bDoUnProtect Then
  35. MaxIndex = oSheets.Count-1
  36. For i = 0 To MaxIndex
  37. bDocHasProtectedSheets = Not UnprotectSheet(oSheets(i))
  38. If bDocHasProtectedSheets Then
  39. ReprotectSheets()
  40. Exit For
  41. End If
  42. Next i
  43. If PWIndex = -1 Then
  44. ReDim UnProtectList() as String
  45. Else
  46. ReDim Preserve UnProtectList(PWIndex) as String
  47. End If
  48. Else
  49. Msgbox (sMsgSHEETSNOPROTECT, 64, sMsgDLGTITLE)
  50. End If
  51. End If
  52. UnProtectSheetsWithPassword = bDocHasProtectedSheets
  53. End Function
  54. Function UnprotectSheet(oListSheet as Object)
  55. Dim ListSheetName as String
  56. Dim sStatustext as String
  57. Dim i as Integer
  58. Dim bOneSheetIsUnprotected as Boolean
  59. i = -1
  60. ListSheetName = oListSheet.Name
  61. If oListSheet.IsProtected Then
  62. oListSheet.Unprotect(&quot;&quot;)
  63. If oListSheet.IsProtected Then
  64. &apos; Sheet is protected by a Password
  65. bOneSheetIsUnProtected = UnprotectSheetWithDialog(oListSheet, ListSheetName)
  66. UnProtectSheet() = bOneSheetIsUnProtected
  67. Else
  68. &apos; The Sheet could be unprotected without a password
  69. AddSheettoUnprotectionlist(ListSheetName,&quot;&quot;)
  70. UnprotectSheet() = True
  71. End If
  72. Else
  73. UnprotectSheet() = True
  74. End If
  75. End Function
  76. Function UnprotectSheetWithDialog(oListSheet as Object, ListSheetName as String) as Boolean
  77. Dim PWIsCorrect as Boolean
  78. Dim QueryText as String
  79. oDocument.CurrentController.SetActiveSheet(oListSheet)
  80. QueryText = ReplaceString(sMsgPWPROTECT,&quot;&apos;&quot; &amp; ListSheetName &amp; &quot;&apos;&quot;, &quot;%1TableName%1&quot;)
  81. &apos;&quot;Please insert the password to unprotect the sheet &apos;&quot; &amp; ListSheetName&apos;&quot;
  82. Do
  83. ExecutePasswordDialog(QueryText)
  84. If bCancelProtection Then
  85. bCancelProtection = False
  86. Msgbox (sMsgSHEETSNOPROTECT, 64, sMsgDLGTITLE)
  87. UnprotectSheetWithDialog() = False
  88. exit Function
  89. End If
  90. oListSheet.Unprotect(Password)
  91. If oListSheet.IsProtected Then
  92. PWIsCorrect = False
  93. Msgbox (sMsgWRONGPW, 64, sMsgDLGTITLE)
  94. Else
  95. &apos; Sheet could be unprotected
  96. AddSheettoUnprotectionlist(ListSheetName,Password)
  97. PWIsCorrect = True
  98. End If
  99. Loop Until PWIsCorrect
  100. UnprotectSheetWithDialog() = True
  101. End Function
  102. Sub ExecutePasswordDialog(QueryText as String)
  103. With PasswordModel
  104. .Title = QueryText
  105. .hlnPassword.Label = sMsgPASSWORD
  106. .cmdCancel.Label = sMsgCANCEL
  107. .cmdHelp.Label = sHELP
  108. .cmdGoOn.Label = sMsgOK
  109. .cmdGoOn.DefaultButton = True
  110. End With
  111. DialogPassword.Execute
  112. End Sub
  113. Sub ReadPassword()
  114. Password = PasswordModel.txtPassword.Text
  115. DialogPassword.EndExecute
  116. End Sub
  117. Sub RejectPassword()
  118. bCancelProtection = True
  119. DialogPassword.EndExecute
  120. End Sub
  121. &apos; Reprotects the previously protected sheets
  122. &apos; The password information is stored in the List &apos;UnProtectList()&apos;
  123. Sub ReprotectSheets()
  124. Dim i as Integer
  125. Dim oProtectSheet as Object
  126. Dim ProtectList() as String
  127. Dim SheetName as String
  128. Dim SheetPassword as String
  129. If PWIndex &gt; -1 Then
  130. SetStatusLineText(sStsREPROTECT)
  131. For i = 0 To PWIndex
  132. ProtectList() = ArrayOutOfString(UnProtectList(i),&quot;;&quot;)
  133. SheetName = ProtectList(0)
  134. If Ubound(ProtectList()) &gt; 0 Then
  135. SheetPassWord = ProtectList(1)
  136. Else
  137. SheetPassword = &quot;&quot;
  138. End If
  139. oProtectSheet = oSheets.GetbyName(SheetName)
  140. If Not oProtectSheet.IsProtected Then
  141. oProtectSheet.Protect(SheetPassWord)
  142. End If
  143. Next i
  144. SetStatusLineText(&quot;&quot;)
  145. End If
  146. PWIndex = -1
  147. ReDim UnProtectList()
  148. End Sub
  149. &apos; Add a Sheet to the list of sheets that finally have to be
  150. &apos; unprotected
  151. Sub AddSheettoUnprotectionlist(ListSheetName as String, Password as String)
  152. Dim MaxIndex as Integer
  153. MaxIndex = Ubound(UnProtectList())
  154. PWIndex = PWIndex + 1
  155. If PWIndex &gt; MaxIndex Then
  156. ReDim Preserve UnprotectList(MaxIndex + SBRANGEUBOUND)
  157. End If
  158. UnprotectList(PWIndex) = ListSheetName &amp; &quot;;&quot; &amp; Password
  159. End Sub
  160. Function CheckSheetProtection(oSheets as Object) as Boolean
  161. Dim MaxIndex as Integer
  162. Dim i as Integer
  163. Dim bProtectedSheets as Boolean
  164. bProtectedSheets = False
  165. MaxIndex = oSheets.Count-1
  166. For i = 0 To MaxIndex
  167. bProtectedSheets = oSheets(i).IsProtected
  168. If bProtectedSheets Then
  169. CheckSheetProtection() = True
  170. Exit Function
  171. End If
  172. Next i
  173. CheckSheetProtection() = False
  174. End Function</script:module>