PC World 2003 April/PCWorld_2003-04_cd.bin/Software/Komercni/openoffice/f_0288/Protect.xba

Extensible Markup Language | 2002-02-19 | 5KB | 175 lines

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<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")
    '"Geben Sie das Kennwort zum Entsch├╝tzen der Tabelle '" & ListSheetName & " ein:'"
    Do
        ExecutePasswordDialog(QueryText)
        If bCancelProtection Then
            bCancelProtection = False
            Msgbox (sMsgSHEETSNOPROTECT, 64, sMsgDLGTITLE)
            UnprotectSheetWithDialog() = False   '"Tabelle wird nicht entsch├╝tzt!"
            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   '"Tabelle wird nicht entsch├╝tzt!"
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
        oStatusline.SetText(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
        oStatusline.SetText("")
    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>