SlaveTab2: SlaveTab folgt QuellTab nur innerhalb des "Astes"

Forum zur Erstellung von Anwendungen der erweiterten Scripting-Funktion
Info: Diese Schalter und Script-Anwendungen funktionieren erst ab der Version 11
Antworten
wazlaf
Beiträge: 52
Registriert: 18. Mär 2014 11:06
Betriebssystem: Win 8.1 Pro x64
Produkt: DOpus 11.1 x64
Version DOpus: Pro

SlaveTab2: SlaveTab folgt QuellTab nur innerhalb des "Astes"

Beitrag von wazlaf » 8. Mai 2014 11:35

SlaveTab2: SlaveTab folgt QuellTab nur inneralb eines "Astes"

Idee:
Um die Synchronisation zum SlaveTab nicht zu verlieren ist die Navigation im Quellpfad
nur abwärts ab einem festlegbaren Ordner möglich.

Bsp.:
QuellTab : C:\Daten
SlaveTab: C:\Daten.Backup

Bisher:
Versehentlicher Wechsel über C:\Daten hinaus zu C:\.
Danach wieder Rückwechsel auf C:\Daten.
Der SlaveTab folgt nun ebenfalls in den Ordner C:\Daten.

Jetzt:
Kein versehentlicher Wechsel über C:\Daten hinaus mehr möglich.
Der SlaveTab bleibt somit auf C:\Daten.Backup

Anwendung:
QuellTab:
Zum gewünschten Ordner navigieren.
Button SlaveTab2 drücken

= Kein Wechsel mehr über den gewählten Ordner möglich

SlaveTab:
Zum gewünschten Ordner navigieren
Im QuellTab: Register verbinden (Entsprechenden SlaveTab auswählen)

= SlaveTab folgt dem QuellTab aber nur bis zum gewälltem Ordner im QuellTab

Anmerkung:
An eigenen Möglichkeit von DOpus (Navigationsverknüpfung) hat mir der dezente
Hinweis beim Verlust der Synchronisation nicht gefallen, sowie das sich die
Navigationsverknüpfung auch auf neue Tabs auswirkt und dann dort ebenfalls
der dezente Hinweis erfolgt.

Button

Code: Alles auswählen

@language vbscript

Function OnClick(ByRef ClickData)
	Dim TabNr
	Set TabNr = ClickData.Func.Command.SourceTab 

	If TabNr.vars.exists("tblck") Then
		TabNr.vars.Delete("tblck")
		TabNr.vars.Delete("tab2")
		
		DOpus.vars.delete(TabNr)
		
		ClickData.Func.Command.RunCommand("GO TABLOCK=Off")
	Else
		TabNr.vars.Set "tblck", -1
		DOpus.vars.Set TabNr, TabNr.path
		ClickData.Func.Command.RunCommand("GO TABLOCK=lockchanges")
	End If
	
	ClickData.Func.Command.RunCommand("SlaveTab2")
End Function
Script

Code: Alles auswählen

Option Explicit

' SlaveTab2
' 
' 
' This is a script for Directory Opus.
' See http://www.gpsoft.com.au/DScripts/redirect.asp?page=scripts for development information.
' 
' 
' 
' Called by Directory Opus to initialize the script
Function OnInit(initData)
	initData.name = "SlaveTab2"
	initData.desc = ""
	initData.copyright = ""
	initData.version = "1.0"
	initData.default_enable = False
	initData.config.DEBUG = True
	
	Dim cmd
	Set cmd = initData.AddCommand
    cmd.name = "SlaveTab2"
    cmd.method = "OnStart"
    cmd.label = "SlaveTab2"
End Function

Function OnStart(ClickData)
	LogMsg("OnStart 0")	
	LogMsg("OnStart 1")
End Function

' Called when a new tab is opened
Function OnOpenTab(openTabData)
	LogMsg("OnOpenTab 0")
	LogMsg("OnOpenTab 1")
End Function

' Called when a tab is closed
Function OnCloseTab(closeTabData)
	LogMsg("OnCloseTab 0")
	LogMsg("OnCloseTab 1")
End Function

' Called when a tab is activated
Function OnActivateTab(activateTabData)
	LogMsg("OnActivateTab 0")
	LogMsg("OnActivateTab 1")
End Function

' Called when the source and destination are changed
Function OnSourceDestChange(sourceDestChangeData)
	LogMsg("OnSourceDestChange 0")
	LogMsg("OnSourceDestChange 1")
End Function

' Called before a new folder is read in a tab
Function OnBeforeFolderChange(beforeFolderChangeData)
	LogMsg("OnBeforeFolderChange 0")
	
	Dim bOK : bOK = False
	
	Dim TabNr
	Set TabNr = beforeFolderChangeData.tab
	
	LogMsg("OnBeforeFolderChange: TabNr = " & TabNr)
	
	Dim path
	path = beforeFolderChangeData.path
	
	If CheckTab(TabNr) = True Then	
		Dim path0
		If DOpus.vars.exists(TabNr) Then path0 = DOpus.vars.get(TabNr)
	
		If CheckPath(path, TabNr) = False Then
			If TabNr.Path = path0 Then
				bOK = True
			End If
		End If
	End If
	
	OnBeforeFolderChange = bOK

	LogMsg("OnBeforeFolderChange 1")
End Function

' Called after a new folder is read in a tab
Function OnAfterFolderChange(afterFolderChangeData)
	LogMsg("OnAfterFolderChange 0")
	
	Dim TabNr
	Set TabNr = afterFolderChangeData.tab
	
	If CheckTab(TabNr) = True Then
		Dim path, path0, path1, path1a, path2, path3
		
		If DOpus.vars.exists(TabNr) Then path0 = DOpus.vars.get(TabNr)
		
		Dim quote : quote = """"
		
		If afterFolderChangeData.result = True Then
			LockTab(TabNr)
			
			path = TabNr.path
			
			If CheckPath(path, TabNr) = False Then								
					RunDOpusCommand("GO " & quote & path0 & quote)
			Else
				If TabNr.LinkTab > 0 Then
					Dim tab2
					Set tab2 = TabNr.LinkTab
					
					path1 = TabNr.Path
					path2 = tab2.Path
					
					If Not TabNr.Vars.Exists("tab2") Then
						TabNr.vars.Set "tab2", path2
					Else
						path2 = TabNr.vars.get("tab2")
					End If
								
					path1a = Mid(path1, Len(path0) + 1 )
					
					path3 = path2 & path1a
					
					If path3 <> tab2.path Then
						'Evtl auch mittles FSUtil
						Dim fso
						Set fso = CreateObject("Scripting.FileSystemObject")
						
						If fso.FolderExists(path3) Then							
							RunDOpusCommand("GO " & quote & path3 & quote & " OPENINRIGHT")	
						End If
						
						Set fso = Nothing					
					End If
				Else
					If TabNr.Vars.Exists("tab2") Then
						TabNr.vars.Delete("tab2")
					End If
				End If
			End If
		End If		
	End If
		
	LogMsg("OnAfterFolderChange 1")
End Function

Function RunDOpusCommand(cmd)
	Dim DopusCmd

	LogMsg(cmd)

	Set DopusCmd = DOpus.CreateCommand
	RunDOpusCommand = DopusCmd.RunCommand(cmd)
End Function

' Subroutine to allow toggling of the global DEBUG variable to control whether logging is performed or not
Sub LogMsg(ByRef message)
   If (Script.config.DEBUG) Then DOpus.OutputString(message)
End Sub

Function CheckTab(ByVal TabNr)
	LogMsg("CheckTab: 0")
	
	If TabNr.Vars.Exists("tblck") Then
		CheckTab = True
	Else
		CheckTab = False
	End If
	
	LogMsg("CheckTab: 1")
End Function

Function CheckPath(ByVal path, ByVal TabNr) 'As String
	LogMsg("CheckPath: 0")

	Dim bOK : bOK = False

	Dim path0
	
	If DOpus.vars.exists(TabNr) Then path0 = DOpus.vars.get(TabNr)
	
	If path0 = Mid( path, 1, Len(path0) ) Then
		bOK = True
		
		If Len(path) > Len(path0) Then
			Dim c, s
	
			s = Mid( path, 1, Len(path0) + 1)
			c = Right(s, 1)
			
			If c <> "\" Then
				bOK = False
			End If
		End If
	Else
		bOK = False
	End If
		
	CheckPath = bOK
	
	LogMsg("CheckPath: 1")
End Function

Function LockTab(tab)
	LogMsg("LockTab: 0")

	Dim DopusCmd

	Set DopusCmd = DOpus.CreateCommand
	DopusCmd.SetSourceTab(tab)
	DopusCmd.RunCommand("GO TABLOCK=lockchanges")

	Set DopusCmd = Nothing
	
	LogMsg("LockTab: 1")
End Function

Antworten

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 1 Gast