'==============================================================================
' COPYRIGHT: Blue Fish Development Group
'			 All rights reserved.
'
' PROCEDURE NAME: ...create_acl.ebs
'
' DESCRIPTIVE NAME: dmdeveloper.com - Utility Function for Creating ACLs
'
'==============================================================================
' FUNCTION:
'	   This docbasic routine contains a utility function for creating a EDMS98
'	   ACL. It does not currently support creation of 4i extended permissions.
'
'==============================================================================
' DEPENDENCIES: N/A
'
' RESTRICTIONS: N/A
'
' EXTERNAL REFERENCES: N/A
'
'==============================================================================
' CHANGE HISTORY:
'   Date	   Author  Description
'   ---------  ------  -----------
'   09 Jan 97  MJT	   Initial code
'   26 Jan 00  MJT     Updated for dmdeveloper.com
'
'==============================================================================
Option Explicit
'******************************************************************************
' User-Defined Types
'******************************************************************************

'******************************************************************************
' Public (Global) Variables
'******************************************************************************
Public g_strAppTitle as String
'------------------------------------------------------------------------------
' Public Variables for reporting
'------------------------------------------------------------------------------	
Public g_intLogFileNum as Integer
Public g_blnWriteToStatusBar as Boolean
Public g_blnShowMessageBox as Boolean
Public g_blnPrintToLogFile as Boolean
Public g_blnPrintToServerLogFile as Boolean
Public g_strLogFileName as String
Public g_intReportStatus as Integer
'******************************************************************************
' Private (Module-Level) Variables
'******************************************************************************

'******************************************************************************
' Constants
'******************************************************************************
Const vbCRLF as String = Chr$(13) & Chr$(10)
'------------------------------------------------------------------------------
' Constants for reporting
'------------------------------------------------------------------------------	
Const intREPORT_CLIENT_NONE as Integer = 1
Const intREPORT_CLIENT_LOGFILE as Integer = 2
Const intREPORT_CLIENT_MSGBOX as Integer = 4
Const intREPORT_CLIENT_STATUSBAR as Integer = 8
Const intREPORT_CLIENT_ALL as Integer = 14
Const intREPORT_SERVER_NONE as Integer = 15
Const intREPORT_SERVER_LOGFILE as Integer = 16
Const intREPORT_SERVER_SERVERLOG as Integer = 32
Const intREPORT_SERVER_ALL as Integer = 48
'------------------------------------------------------------------------------
' Constants for ACLs
'------------------------------------------------------------------------------	
Const intACL_DELETE_ACCESS as Integer = 7
Const intACL_WRITE_ACCESS as Integer = 6
Const intACL_VERSION_ACCESS as Integer = 5
Const intACL_RELATE_ACCESS as Integer = 4
Const intACL_READ_ACCESS as Integer = 3
Const intACL_BROWSE_ACCESS as Integer = 2
Const intACL_NONE_ACCESS as Integer = 1

Const intACL_ACCESSOR_NAME as Integer = 0
Const intACL_ACCESSOR_PERMIT as Integer = 1
'------------------------------------------------------------------------------
' Constants for Message Boxes
'------------------------------------------------------------------------------	
Const vbOKOnly as Integer =	0			'Display OK button only.
Const vbOKCancel as Integer = 1   		'Display OK and Cancel buttons.
Const vbAbortRetryIgnore as Integer = 2	'Display Abort, Retry, and Ignore buttons.
Const vbYesNoCancel as Integer = 3		'Display Yes, No, and Cancel buttons.
Const vbYesNo as Integer = 4			'Display Yes and No buttons.
Const vbRetryCancel as Integer = 5		'Display Retry and Cancel buttons.

Const vbCritical as Integer = 16	'Display Critical Message icon. 
Const vbQuestion as Integer = 32	'Display Warning Query icon.
Const vbExclamation as Integer = 48	'Display Warning Message icon.
Const vbInformation as Integer = 64	'Display Information Message icon.

Const vbDefaultButton1 as Integer = 0	'First button is default.
Const vbDefaultButton2 as Integer = 256	'Second button is default.
Const vbDefaultButton3 as Integer = 512	'Third button is default.
Const vbDefaultButton4 as Integer = 768	'Fourth button is default.

Const vbApplicationModal as Integer = 0	'Application modal
Const vbSystemModal as Integer = 4096	'System modal

Const vbOK as Integer = 1		'OK
Const vbCancel as Integer = 2	'Cancel
Const vbAbort as Integer = 3	'Abort
Const vbRetry as Integer = 4	'Retry
Const vbIgnore as Integer = 5	'Ignore
Const vbYes as Integer = 6		'Yes
Const vbNo as Integer = 7		'No

'******************************************************************************
' Declare the functions outside this module.
'******************************************************************************

'******************************************************************************
' Declare the functions in this module.
'******************************************************************************
'------------------------------------------------------------------------------
' Helper Routines for reporting
'------------------------------------------------------------------------------	
Declare Sub 	 OpenLogFile(strFileName as String)
Declare Sub 	 CloseLogFile()
Declare Sub 	 PrintToLogFile(strMessage as String)
Declare Sub 	 Report(strMessage as String)
Declare Sub 	 SetupReporting(intReportType as Integer, Optional strClientLogFile as Variant)
Declare Sub 	 ShowStatus(strMessage as String)
'------------------------------------------------------------------------------
' Helper Routines for Creating ACLs
'------------------------------------------------------------------------------	
Declare Function CreateACL(strACLName as String, ByRef vntACLDef() as Variant) as Boolean
Declare Function BeginTran() as Boolean
Declare Function Commit() as Boolean
Declare Sub      Abort()
'------------------------------------------------------------------------------
' Routines for Creating ACLs
'------------------------------------------------------------------------------	
Declare Function CreateSampleACLs() as Boolean
'******************************************************************************
' SUB: 			Main
'
' Description:  Used for testing and as the entry point to the procedure
'
' Parameters:	None
'******************************************************************************
Sub Main()
	Dim strCmd as String
	Dim intRetCode as Integer
	'--------------------------------------------------------------------------	
	' Set the title of this utility so that it will appear in any message boxes
	'--------------------------------------------------------------------------
	g_strAppTitle = "dm_developer Create ACL Utility"
	'--------------------------------------------------------------------------	
	' Setup the Reporting - this will ask the user to specify a log file
	'--------------------------------------------------------------------------
	Call SetupReporting(intREPORT_CLIENT_LOGFILE)
	'--------------------------------------------------------------------------	
	' Set the mouse pointer to an hourglass so we know it's working
	'--------------------------------------------------------------------------
	strCmd = "setdata,c,dcapp,wait_cursor,T"
	intRetCode = dmAPISet(strCmd, "")
	
	'--------------------------------------------------------------------------	
	' Now call the Function that will create all the Sample ACLs
	'--------------------------------------------------------------------------
	If Not CreateSampleACLs() Then Goto COMPLETED_WITH_ERRORS
	
	'--------------------------------------------------------------------------	
	' Set the mouse pointer back to normal and present a success message
	'--------------------------------------------------------------------------
	strCmd = "setdata,c,dcapp,wait_cursor,F"
	intRetCode = dmAPISet(strCmd, "")

	MsgBox "Install Completed Without Errors."

	Exit Sub
COMPLETED_WITH_ERRORS:
	'--------------------------------------------------------------------------	
	' Set the mouse pointer back to normal and present a failure message
	'--------------------------------------------------------------------------
	strCmd = "setdata,c,dcapp,wait_cursor,F"
	intRetCode = dmAPISet(strCmd, "")

	MsgBox "Install Failed. Refer to Log File for more information."
	Exit Sub


End Sub
'******************************************************************************
' FUNCTION: 	CreateSampleACLs
'
' Description:  Creates a sample ACL to demonstrate the CreateACL utility
'
'				Use the following constants for access levels
'					Const intACL_DELETE_ACCESS as Integer = 7
'					Const intACL_WRITE_ACCESS as Integer = 6
'					Const intACL_VERSION_ACCESS as Integer = 5
'					Const intACL_RELATE_ACCESS as Integer = 4
'					Const intACL_READ_ACCESS as Integer = 3
'					Const intACL_BROWSE_ACCESS as Integer = 2
 '					Const intACL_NONE_ACCESS as Integer = 1
'				Use the following constants to index the array
'					Const intACL_ACCESSOR_NAME as Integer = 0
'					Const intACL_ACCESSOR_PERMIT as Integer = 1
'
' Notes:		The vntACLDef() Array is used to hold the ACL Definition. It is
'				currently configured to create an ACL with up to 50 different 
'				accessors. If you need to create a larger ACL, simply increase
'				the size of the vntACLDef() array.
'
' Parameters:	None
'******************************************************************************
Function CreateSampleACLs() as Boolean
	Dim vntACLDef(2, 50) as Variant
	Dim strACLName as String
	Dim intArrayIndex as Integer
	Dim strAccessorName as Variant
	Dim intAccessorPermit as Variant

	Call ShowStatus("Creating ACLs...")
	CreateSampleACLs = False
	'--------------------------------------------------------------------------	
	' Begin a transaction so that if any ACLs fail, all the ACLs are rolled 
	' back
	'--------------------------------------------------------------------------
	Call Report(vbCRLF & "Beginning Transaction:  Creating All Sample ACLs")
	If Not BeginTran() Then
		Call Report("Unable to Begin Transaction.  No ACLs were created.")
		Exit Function
	End If
	'--------------------------------------------------------------------------
	' Define the Sample ACL 
	'--------------------------------------------------------------------------	
	' First define the name (also used for the description)
	'--------------------------------------------------------------------------	
	strACLName = "Sample ACL"
	'--------------------------------------------------------------------------
	' Set the intArrayIndex = 0 so that the first accessor name goes in the 
	' first position of the ACL Definition Array
	'--------------------------------------------------------------------------	
	intArrayIndex = 0
	'--------------------------------------------------------------------------
	' Set the first accessor name and accessor permit, and put these values in
	' the ACL Definition Array
	'--------------------------------------------------------------------------	
	strAccessorName = "dm_world"
	intAccessorPermit = intACL_NONE_ACCESS

	vntACLDef(intACL_ACCESSOR_NAME, intArrayIndex) = strAccessorName
	vntACLDef(intACL_ACCESSOR_Permit, intArrayIndex) = intAccessorPermit
	'--------------------------------------------------------------------------
	' Increment the Index position of the ACL Definition Array
	'--------------------------------------------------------------------------	
	intArrayIndex = intArrayIndex + 1
	'--------------------------------------------------------------------------
	' Now Set the other accessors in the same manner
	'--------------------------------------------------------------------------	
	strAccessorName = "dm_owner"
	intAccessorPermit = intACL_DELETE_ACCESS

	vntACLDef(intACL_ACCESSOR_NAME, intArrayIndex) = strAccessorName
	vntACLDef(intACL_ACCESSOR_Permit, intArrayIndex) = intAccessorPermit
	intArrayIndex = intArrayIndex + 1

	strAccessorName = "docu"
	intAccessorPermit = intACL_READ_ACCESS

	vntACLDef(intACL_ACCESSOR_NAME, intArrayIndex) = strAccessorName
	vntACLDef(intACL_ACCESSOR_Permit, intArrayIndex) = intAccessorPermit
	intArrayIndex = intArrayIndex + 1
	'--------------------------------------------------------------------------	
	' End of ACL Definition with an empty accessor name
	'--------------------------------------------------------------------------	
	strAccessorName = ""
	vntACLDef(intACL_ACCESSOR_NAME, intArrayIndex) = strAccessorName
	'--------------------------------------------------------------------------	
	' Now create the ACL by calling the Create ACL Function
	'--------------------------------------------------------------------------
	If Not CreateACL(strACLName, vntACLDef) Then
		Call Abort()
		Call Report("Unable to Create " & strACLName & " ACL. Transaction is aborted.  No ACLs were created.")
		Exit Function
	End If
	'--------------------------------------------------------------------------	
	' End the transaction
	'--------------------------------------------------------------------------
	Call Report("Ending Transaction:  Creating Sample ACLs")
	If Commit() Then
		Call Report("Transaction Commit Succeeded. All ACLs were created.")
	Else
		Call Report("Transaction Commit Failed. No ACLs were created.")
	End If

	CreateSampleACLas = True
End Function
'******************************************************************************
' SUB: 			SetupReporting
'
' Description:  Sets up the type of reporting for debugging and tracing.  Also
'				sets the logfile name according to a client or server constant 
'
' Parameters:	intReportType - Integer describibg the type of debugging
'
' Notes:		Use these constants
'					Const intREPORT_CLIENT_NONE as Integer = 1
'					Const intREPORT_CLIENT_LOGFILE as Integer = 2
'					Const intREPORT_CLIENT_MSGBOX as Integer = 4
'					Const intREPORT_CLIENT_STATUSBAR as Integer = 8
'					Const intREPORT_CLIENT_ALL as Integer = 14
'					Const intREPORT_SERVER_NONE as Integer = 15
'					Const intREPORT_SERVER_LOGFILE as Integer = 16
'					Const intREPORT_SERVER_SERVERLOG as Integer = 32
'					Const intREPORT_SERVER_ALL as Integer = 48
'				
'******************************************************************************
Sub SetupReporting(intReportType as Integer, Optional strLogFileName as Variant)

	g_blnWriteToStatusBar = False
	g_blnShowMessageBox = False
	g_blnPrintToLogFile = False
	g_blnPrintToServerLogFile = False
	g_intReportStatus = intReportType
	g_strLogFileName = ""

	If intReportType - intREPORT_SERVER_SERVERLOG >= 0 Then
		g_blnPrintToServerLogFile = True

		intReportType = intReportType - intREPORT_SERVER_SERVERLOG
	End If

	If intReportType - intREPORT_SERVER_LOGFILE >= 0 Then
		If Not IsMissing(strLogFileName) Then
			g_strLogFileName = strLogFileName
			g_blnPrintToLogFile = True
		Else
			Print "A server log file was not specified so there will be no logging."
		End If

		intReportType = intReportType - intREPORT_SERVER_LOGFILE
	End If

	If intReportType - intREPORT_SERVER_NONE >= 0 Then
		g_blnPrintToLogFile = False
		g_blnPrintToServerLogFile = False

		intReportType = intReportType - intREPORT_SERVER_NONE
	End If

	If intReportType - intREPORT_CLIENT_STATUSBAR >= 0 Then
		g_blnWriteToStatusBar = True

		intReportType = intReportType - intREPORT_CLIENT_STATUSBAR
	End If

	If intReportType - intREPORT_CLIENT_MSGBOX >= 0 Then
		g_blnShowMessageBox = True

		intReportType = intReportType - intREPORT_CLIENT_MSGBOX
	End If

	If intReportType - intREPORT_CLIENT_LOGFILE >= 0 Then
		'------------------------------------------------------------------
		' If the Client Log File has not been passed in, prompt the user
		' to create one
		'------------------------------------------------------------------
		If Not IsMissing(strLogFileName) Then
			g_strLogFileName = strLogFileName
			g_blnPrintToLogFile = True
		Else
			g_strLogFileName = SaveFileName$("Specify Log File for Reporting")
			If g_strLogFileName = "" Then
				MsgBox "You did not choose a log file, therefore nothing will be logged."
			Else
				If FileExists(g_strLogFileName) Then
					Kill g_strLogFileName
				End If
				g_blnPrintToLogFile = True
			End If
		End If

		intReportType = intReportType - intREPORT_CLIENT_LOGFILE
	End If

	If intReportType - intREPORT_CLIENT_NONE >= 0 Then
		g_blnWriteToStatusBar = False
		g_blnShowMessageBox = False
		g_blnPrintToLogFile = False

		intReportType = intReportType - intREPORT_CLIENT_NONE
	End If

End Sub
'******************************************************************************
' SUB: 			OpenLogFile
'
' Description:  Opens a file and assigns the file handle to a global variable
'
' Parameters:	strFileName - Name of the file to open
'******************************************************************************
Sub OpenLogFile(strFileName as String)
	g_intLogFileNum = FreeFile()
	Open strFileName for Append as #g_intLogFileNum
End Sub

'******************************************************************************
' SUB: 			CloseLogFile
'
' Description:  Closes the log file assigned to the global variable
'
' Parameters:	None
'******************************************************************************
Sub CloseLogFile()
	Close #g_intLogFileNum
End Sub

'******************************************************************************
' SUB: 			PrintToLogFile
'
' Description:  Write a message to a log file
'
' Parameters:	strMessage - Message to write to the log file
'******************************************************************************
Sub PrintToLogFile(strMessage as String)
	Print #g_intLogFileNum, strMessage
End Sub
'******************************************************************************
' SUB: 			Report
'
' Description:  Write to the log file, statusbar, and/or show a message box
'
' Parameters:	strMessage - Message to write to the log file
'******************************************************************************
Sub Report(strMessage as String)
	Dim intRetCode as Integer
	'----------------------------------------------------------------------
	' Set the methods of reporting
	' Only use the Statusbar and Messagebox if the process is running on
	' a client.  Only use the Server log file if the process is running as
	' a server method
	'----------------------------------------------------------------------	
	If g_blnPrintToLogFile Then
		OpenLogFile(g_strLogFileName)
		PrintToLogFile(strMessage)
		CloseLogFile
	End If

	If g_blnShowMessageBox Then
	   MsgBox strMessage, 48, g_strAppTitle
	End If

	If g_blnWriteToStatusBar Then
		intRetCode = dmAPIExec("setdata,c,dcapp,statusbar," & strMessage)
	End If

	If g_blnPrintToServerLogFile Then
	   Print strMessage
	End If

End Sub
'******************************************************************************
' FUNCTION: BeginTran
'
' Description:  Begin a transaction
'
' Parameters:	None
'******************************************************************************
Function BeginTran() as Boolean
	Dim intRetCode as Integer
	Dim strError as String
	Dim strCmd as String
	
	BeginTran = False

	strCmd = "begintran,c"
	intRetCode = dmAPIExec(strCmd)
	If intRetCode = 0 Then
		strError = "Error Excuting Command: " & strCmd
		Call Report(strError)
		strError = "Error from server was: " & dmAPIGet("getmessage,c")
		Call Report(strError)
		Exit Function
	End If

	BeginTran = True
End Function
'******************************************************************************
' FUNCTION: Commit
'
' Description:  Commit a transaction
'
' Parameters:	None
'******************************************************************************
Function Commit() as Boolean
	Dim intRetCode as Integer
	Dim strError as String
	Dim strCmd as String

	Commit = False

	strCmd = "commit,c"
	intRetCode = dmAPIExec(strCmd)
	If intRetCode = 0 Then
		strError = "Error Excuting Command: " & strCmd
		Call Report(strError)
		strError = "Error from server was: " & dmAPIGet("getmessage,c")
		Call Report(strError)
		Exit Function
	End If

	Commit = True
End Function
'******************************************************************************
' SUB: Abort
'
' Description:  Abort a transaction
'
' Parameters:	None
'******************************************************************************
Sub Abort()
	Dim intRetCode as Integer
	Dim strError as String
	Dim strCmd as String

	strCmd = "abort,c"
	intRetCode = dmAPIExec(strCmd)
End Sub
'******************************************************************************
' CreateACL
'
' Description:  Creates an ACL.  The ACLDefinition is a two dimentional array 
'			   that contains user or group name and the access permission
'
' Parameters:   strACLName - Name of the ACL
'				vntACLDef - Array containing ACL Definition
'******************************************************************************
Function CreateACL(strACLName as String, ByRef vntACLDef() as Variant) as Boolean
	Dim strLogEntry as String
	Dim strCmd as String
	Dim strValue as String
	Dim strACLID as String
	Dim intRetCode as Integer
	Dim strError as String
	Dim strAccessorName as Variant
	Dim intAccessorPermit as Variant
	'--------------------------------------------------------------------------
	' Log File Entry
	'--------------------------------------------------------------------------
	strLogEntry = "Creating ACL " & strACLName & "..."
	Report(strLogEntry)

	CreateACL = False
	'--------------------------------------------------------------------------
	' Create the ACL
	'--------------------------------------------------------------------------
	strCmd = "create,c,dm_acl"
	strACLID = dmAPIGet(strCmd)
	If strACLID = "" Then
		strError = "Error Excuting Command: " & strCmd
		Call Report(strError)
		strError = "Error from server was: " & dmAPIGet("getmessage,c")
		Call Report(strError)

		Exit Function
	End If

	strCmd = "set,c," & strACLID & ",owner_name"
	strValue = "dm_dbo"
	intRetCode = dmAPISet(strCmd, strValue)
	If intRetCode = 0 Then
		strError = "Error Excuting Command: " & strCmd
		Call Report(strError)
		strError = "Error from server was: " & dmAPIGet("getmessage,c")
		Call Report(strError)

		Exit Function
	End If

	strCmd = "set,c," & strACLID & ",object_name"
	strValue = strACLName
	intRetCode = dmAPISet(strCmd, strValue)
	If intRetCode = 0 Then
		strError = "Error Excuting Command: " & strCmd
		Call Report(strError)
		strError = "Error from server was: " & dmAPIGet("getmessage,c")
		Call Report(strError)

		Exit Function
	End If

	strCmd = "set,c," & strACLID & ",description"
	strValue = strACLName
	intRetCode = dmAPISet(strCmd, strValue)
	If intRetCode = 0 Then
		strError = "Error Excuting Command: " & strCmd
		Call Report(strError)
		strError = "Error from server was: " & dmAPIGet("getmessage,c")
		Call Report(strError)

		Exit Function
	End If

	Dim i as Integer
	i = 0

	While vntACLDef(intACL_ACCESSOR_NAME, i) <> ""
		'---------------------------------------------------------------------
		' Grant the permission level to this accessor
		'---------------------------------------------------------------------
		strAccessorName = vntACLDef(intACL_ACCESSOR_NAME, i)
		intAccessorPermit = vntACLDef(intACL_ACCESSOR_PERMIT, i)
		strCmd = "grant,c," & strACLID & "," & strAccessorName & "," & intAccessorPermit
		intRetCode = dmAPIExec(strCmd)
		If intRetCode = 0 Then
			strError = "Error Excuting Command: " & strCmd
				Call Report(strError)
			strError = "Error from server was: " & dmAPIGet("getmessage,c")
				Call Report(strError)
	
			Exit Function
		End If

		i = i + 1
	Wend

	strCmd = "save,c," & strACLID
	intRetCode = dmAPIExec(strCmd)
	If intRetCode = 0 Then
		strError = "Error Excuting Command: " & strCmd
		Call Report(strError)
		strError = "Error from server was: " & dmAPIGet("getmessage,c")
		Call Report(strError)

		Exit Function
	End If
	
	strLogEntry = "ACL " & strACLName & " Creation Complete."
	Call Report(strLogEntry)

	CreateACL = True
End Function
'******************************************************************************
' SUB: 			ShowStatus
'
' Description:  Prints a message to the Status Bar
'
' Parameters:	strMessage - Text to display on the statusbar
'******************************************************************************
Sub ShowStatus(strMessage as String)
	Dim intRetCode as Integer
	intRetCode = dmAPIExec("setdata,c,dcapp,statusbar," & strMessage)	
End Sub