Protect.xba 5.8 KB

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