home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Freelog 125
/
Freelog_MarsAvril2015_No125.iso
/
Bureautique
/
OpenOffice
/
Apache_OpenOffice_4.1.1_Win_x86_install_fr.exe
/
openoffice1.cab
/
Protect.xba
< prev
next >
Wrap
Extensible Markup Language
|
2014-02-25
|
6KB
|
196 lines
<?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>