home *** CD-ROM | disk | FTP | other *** search
/ PC World 2003 March / PCWorld_2003-03_cd.bin / Software / Vyzkuste / openoffice / f_0283 / Protect.xba < prev    next >
Extensible Markup Language  |  2002-02-19  |  5KB  |  175 lines

  1. <?xml version="1.0" encoding="UTF-8"?>
  2. <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
  3. <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Protect" script:language="StarBasic">REM  *****  BASIC  *****
  4. Option Explicit
  5.  
  6. Public PWIndex as Integer
  7.  
  8.  
  9. Function UnprotectSheetsWithPassWord(oSheets as Object, bDoUnProtect as Boolean)
  10. Dim i as Integer
  11. Dim MaxIndex as Integer
  12. Dim iMsgResult as Integer
  13.     PWIndex = -1
  14.     If bDocHasProtectedSheets Then
  15.         If Not bDoUnprotect Then
  16.             ' At First query if sheets shall generally be unprotected
  17.             iMsgResult = Msgbox(sMsgUNPROTECT,36,sMsgDLGTITLE)
  18.             bDoUnProtect = iMsgResult = 6
  19.         End If
  20.         If bDoUnProtect Then    
  21.             MaxIndex = oSheets.Count-1
  22.             For i = 0 To MaxIndex
  23.                 bDocHasProtectedSheets = Not UnprotectSheet(oSheets(i))
  24.                 If bDocHasProtectedSheets Then
  25.                     ReprotectSheets()
  26.                     Exit For
  27.                 End If
  28.             Next i
  29.             If PWIndex = -1 Then
  30.                 ReDim UnProtectList() as String
  31.             Else
  32.                 ReDim Preserve UnProtectList(PWIndex) as String
  33.             End If
  34.         Else
  35.             Msgbox (sMsgSHEETSNOPROTECT, 64, sMsgDLGTITLE)
  36.         End If
  37.     End If
  38.     UnProtectSheetsWithPassword = bDocHasProtectedSheets
  39. End Function
  40.  
  41.  
  42. Function UnprotectSheet(oListSheet as Object)
  43. Dim ListSheetName as String
  44. Dim sStatustext as String
  45. Dim i as Integer
  46. Dim bOneSheetIsUnprotected as Boolean
  47.     i = -1
  48.     ListSheetName = oListSheet.Name
  49.     If oListSheet.IsProtected Then
  50.         oListSheet.Unprotect("")
  51.         If oListSheet.IsProtected Then
  52.             ' Sheet is protected by a Password
  53.             bOneSheetIsUnProtected = UnprotectSheetWithDialog(oListSheet, ListSheetName)
  54.             UnProtectSheet() = bOneSheetIsUnProtected
  55.         Else
  56.             ' The Sheet could be unprotected without a password
  57.             AddSheettoUnprotectionlist(ListSheetName,"")
  58.             UnprotectSheet() = True
  59.         End If
  60.     Else
  61.         UnprotectSheet() = True
  62.     End If
  63. End Function
  64.  
  65.  
  66. Function UnprotectSheetWithDialog(oListSheet as Object, ListSheetName as String) as Boolean
  67. Dim PWIsCorrect as Boolean
  68. Dim QueryText as String
  69.     oDocument.CurrentController.SetActiveSheet(oListSheet)
  70.     QueryText = ReplaceString(sMsgPWPROTECT,"'" & ListSheetName & "'", "%1TableName%1")
  71.     '"Geben Sie das Kennwort zum Entsch├╝tzen der Tabelle '" & ListSheetName & " ein:'"
  72.     Do
  73.         ExecutePasswordDialog(QueryText)
  74.         If bCancelProtection Then
  75.             bCancelProtection = False
  76.             Msgbox (sMsgSHEETSNOPROTECT, 64, sMsgDLGTITLE)
  77.             UnprotectSheetWithDialog() = False   '"Tabelle wird nicht entsch├╝tzt!"
  78.             exit Function
  79.         End If
  80.         oListSheet.Unprotect(Password)
  81.         If oListSheet.IsProtected Then
  82.             PWIsCorrect = False
  83.             Msgbox (sMsgWRONGPW, 64, sMsgDLGTITLE)
  84.         Else
  85.             ' Sheet could be unprotected
  86.             AddSheettoUnprotectionlist(ListSheetName,Password)
  87.             PWIsCorrect = True
  88.         End If
  89.     Loop Until PWIsCorrect
  90.     UnprotectSheetWithDialog() = True   '"Tabelle wird nicht entsch├╝tzt!"    
  91. End Function
  92.  
  93.  
  94. Sub    ExecutePasswordDialog(QueryText as String)
  95.     With PasswordModel
  96.         .Title = QueryText
  97.         .hlnPassword.Label = sMsgPASSWORD
  98.         .cmdCancel.Label = sMsgCANCEL
  99.         .cmdHelp.Label = sHELP
  100.         .cmdGoOn.Label = sMsgOK
  101.         .cmdGoOn.DefaultButton = True
  102.     End With
  103.     DialogPassword.Execute
  104. End Sub
  105.  
  106. Sub ReadPassword()
  107.     Password = PasswordModel.txtPassword.Text
  108.     DialogPassword.EndExecute
  109. End Sub
  110.  
  111.  
  112. Sub RejectPassword()
  113.     bCancelProtection = True
  114.     DialogPassword.EndExecute
  115. End Sub
  116.  
  117.  
  118. ' Reprotects the previousliy protected sheets
  119. ' The passwordinformation is stored in the List 'UnProtectList()'
  120. Sub ReprotectSheets()
  121. Dim i as Integer
  122. Dim oProtectSheet as Object
  123. Dim ProtectList() as String
  124. Dim SheetName as String
  125. Dim SheetPassword as String
  126.     If PWIndex > -1 Then
  127.         oStatusline.SetText(sStsREPROTECT)
  128.         For i = 0 To PWIndex
  129.             ProtectList() = ArrayOutOfString(UnProtectList(i),";")
  130.             SheetName = ProtectList(0)
  131.             If Ubound(ProtectList()) > 0 Then
  132.                 SheetPassWord = ProtectList(1)
  133.             Else
  134.                 SheetPassword = ""
  135.             End If
  136.             oProtectSheet =  oSheets.GetbyName(SheetName)
  137.             If Not oProtectSheet.IsProtected Then
  138.                 oProtectSheet.Protect(SheetPassWord)
  139.             End If
  140.         Next i
  141.         oStatusline.SetText("")        
  142.     End If
  143.     PWIndex = -1
  144.     ReDim UnProtectList()
  145. End Sub
  146.  
  147.  
  148. ' Add a Sheet to the list of sheets that finally have to be
  149. ' unprotected
  150. Sub AddSheettoUnprotectionlist(ListSheetName as String, Password as String)
  151. Dim MaxIndex as Integer
  152.     MaxIndex = Ubound(UnProtectList())
  153.     PWIndex = PWIndex + 1
  154.     If PWIndex > MaxIndex Then
  155.         ReDim Preserve UnprotectList(MaxIndex + SBRANGEUBOUND)
  156.     End If
  157.     UnprotectList(PWIndex) = ListSheetName & ";" & Password
  158. End Sub
  159.  
  160.  
  161. Function CheckSheetProtection(oSheets as Object) as Boolean
  162. Dim MaxIndex as Integer
  163. Dim i as Integer
  164. Dim bProtectedSheets as Boolean
  165.     bProtectedSheets = False
  166.     MaxIndex = oSheets.Count-1
  167.     For i = 0 To MaxIndex
  168.         bProtectedSheets = oSheets(i).IsProtected
  169.         If bProtectedSheets Then
  170.             CheckSheetProtection() = True
  171.             Exit Function
  172.         End If
  173.     Next i
  174.     CheckSheetProtection() = False
  175. End Function</script:module>