VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "p4interface"
Attribute VB_GlobalNameSpace = True
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
' All the various functions for the Perforce integration with Word/Excel/PowerPoint
' This module (p4interface) has the common functions.
' Note that it is a GlobalMultiUse class so that the public functions can also
' be called by Word/Excel/PowerPoint templates to provide Office 97 compatibility.
' (For Office 2000/XP there is no need for other templates).
'
' Copyright (c) 2000-2005 Vaccaperna Systems Ltd
'
' Globals to store results of last command
Private g_InfoArr() As String
Private g_ErrorArr() As String
' Store global application object passed in
Private m_App As Object
Private m_OfficeApp As OfficeApp
Private m_Fstat As Fstat
' Flag used after Submit and in CheckFile
Private m_FileJustSubmitted As Boolean
' Flag used after Revert and in CheckFile
Private m_FileJustReverted As Boolean
' Used for PowerPoint XP when doc closed
Private m_CloseCancelled As Boolean
' Used to store P4PORTs for which not to display errors
Private m_ConnectionWarnings As Collection
' Used to store P4PORTs version
Private m_ServerVersions As Collection
' Place to store help file object
Private m_Help As WinHelp
Private cQuote As String ' Privately initialise quote
Private Declare Function GetFocus Lib "user32" () As Integer
Private m_ProgId As String ' Used in menu creation
Private PerforceMenu97 As Office.CommandBarControl
Private FileMenu As Office.CommandBar
Const cActionMacro As String = "MenuEvents"
Private Declare Function MessageBoxW Lib "user32" _
(ByVal hwnd As Long, ByVal lpText As Long, _
ByVal lpCaption As Long, ByVal wType As Long) As Long
' Variables used to trap Word/Excel/PowerPoint events
Private WithEvents WordApp As WORD.Application
Attribute WordApp.VB_VarHelpID = -1
Private WithEvents ExcelApp As excel.Application
Attribute ExcelApp.VB_VarHelpID = -1
Private WithEvents PowerPointApp As PowerPoint.Application
Attribute PowerPointApp.VB_VarHelpID = -1
' This will be set to the new command bar control.
Private WithEvents PerforceMenuButton As CommandBarButton
Attribute PerforceMenuButton.VB_VarHelpID = -1
Private PerforcePopupMenu As CommandBar
Const PerforcePopupMenuName = "P4OFCMenu"
' Items on the Perforce Menu
Private WithEvents AddMenuItem As Office.CommandBarButton
Attribute AddMenuItem.VB_VarHelpID = -1
Private WithEvents CheckOutMenuItem As Office.CommandBarButton
Attribute CheckOutMenuItem.VB_VarHelpID = -1
Private WithEvents OpenedMenuItem As Office.CommandBarButton
Attribute OpenedMenuItem.VB_VarHelpID = -1
Private WithEvents SubmitMenuItem As Office.CommandBarButton
Attribute SubmitMenuItem.VB_VarHelpID = -1
Private WithEvents LockMenuItem As Office.CommandBarButton
Attribute LockMenuItem.VB_VarHelpID = -1
Private WithEvents ExpandKeywordsMenuItem As Office.CommandBarButton
Attribute ExpandKeywordsMenuItem.VB_VarHelpID = -1
Private WithEvents RevertMenuItem As Office.CommandBarButton
Attribute RevertMenuItem.VB_VarHelpID = -1
Private WithEvents HistoryMenuItem As Office.CommandBarButton
Attribute HistoryMenuItem.VB_VarHelpID = -1
Private WithEvents FstatMenuItem As Office.CommandBarButton
Attribute FstatMenuItem.VB_VarHelpID = -1
Private WithEvents DiffMenuItem As Office.CommandBarButton
Attribute DiffMenuItem.VB_VarHelpID = -1
Private WithEvents InfoMenuItem As Office.CommandBarButton
Attribute InfoMenuItem.VB_VarHelpID = -1
Private WithEvents LastCommandMenuItem As Office.CommandBarButton
Attribute LastCommandMenuItem.VB_VarHelpID = -1
Private WithEvents OpenFromPerforceMenuItem As Office.CommandBarButton
Attribute OpenFromPerforceMenuItem.VB_VarHelpID = -1
Private WithEvents OptionsMenuItem As Office.CommandBarButton
Attribute OptionsMenuItem.VB_VarHelpID = -1
Private WithEvents HelpMenuItem As Office.CommandBarButton
Attribute HelpMenuItem.VB_VarHelpID = -1
Private WithEvents AboutMenuItem As Office.CommandBarButton
Attribute AboutMenuItem.VB_VarHelpID = -1
' Stuff for creating menus - initialized in object init
Private PerforceMenuName As String
Private Const cMenuCaptionAdd As String = "&Add to Perforce"
Private Const cMenuCaptionEdit As String = "&Check Out"
Private Const cMenuCaptionSubmit As String = "Chec&k In..."
Private Const cMenuCaptionRevert As String = "&Undo Add/Check Out"
Private Const cMenuCaptionLock As String = "&Lock Document"
Private Const cMenuCaptionUnlock As String = "Un&lock Document"
Private Const cMenuCaptionExpandKeywords As String = "E&xpand Keywords"
Private Const cMenuCaptionUnexpandKeywords As String = "Une&xpand Keywords"
Private Const cMenuCaptionResults As String = "Result&s of Last Command..."
Private Const cMenuCaptionFstat As String = "&Document Status..."
Private Const cMenuCaptionHistory As String = "Document &History..."
Private Const cMenuCaptionDiff As String = "Compare &Versions..."
Private Const cMenuCaptionOpened As String = "Checked &Out Documents..."
Private Const cMenuCaptionInfo As String = "Perforce &Information..."
Private Const cMenuCaptionOpenFromPerforce As String = "Get Latest Revision &from Perforce..."
Private Const cMenuCaptionOptions As String = "Optio&ns..."
Private Const cMenuCaptionHelp As String = "Hel&p..."
Private Const cMenuCaptionAbout As String = "A&bout P4OFC..."
Private Const cMenuTagAdd As String = "add"
Private Const cMenuTagEdit As String = "edit"
Private Const cMenuTagOpened As String = "opened"
Private Const cMenuTagSubmit As String = "submit"
Private Const cMenuTagLock As String = "lock"
Private Const cMenuTagExpandKeywords As String = "expand"
Private Const cMenuTagHistory As String = "history"
Private Const cMenuTagRevert As String = "revert"
Private Const cMenuTagDiff As String = "diff"
Private Const cMenuTagFstat As String = "fstat"
Private Const cMenuTagInfo As String = "info"
Private Const cMenuTagResults As String = "results"
Private Const cMenuTagOpenFromPerforce As String = "openfrom"
Private Const cMenuTagOptions As String = "options"
Private Const cMenuTagHelp As String = "help"
Private Const cMenuTagAbout As String = "about"
' Initialize - expected to be called once with Application object passed in
Public Sub Initialize(App As Object, PROGID As String)
' Save application for later usage
Set m_App = App
PerforceMenuName = "&Perforce"
Set g_p4interface = Me
m_ProgId = PROGID
Set m_OfficeApp = New OfficeApp
m_OfficeApp.Initialize m_App
Set m_ConnectionWarnings = New Collection
If IsWord() Then
GStacker.SetApplicationName "Microsoft Word", m_App.Version & " (" & m_App.build & ")"
ElseIf IsExcel() Then
GStacker.SetApplicationName "Microsoft Excel", m_App.Version & " (" & m_App.build & ")"
Else
GStacker.SetApplicationName "Microsoft PowerPoint", m_App.Version & " (" & m_App.build & ")"
End If
End Sub
Private Sub Class_Initialize()
cQuote = Chr(34)
End Sub
Private Sub Class_Terminate()
' No extra cleanup needed
End Sub
Public Property Get App() As Object
Set App = m_App
End Property
' General about form
Public Sub P4Office_About()
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_About")
Dim Msg As String
Dim h As Hourglass: Set h = New Hourglass
Msg = m_App.Version
Msg = Msg & " (" & m_App.build & ")"
AboutForm.m_AppVersion = Msg
ShowForm AboutForm
Exit Sub
Error_Block:
t.Report
Exit Sub
End Sub
Private Sub AddFileType(arr() As String, ft As String)
Dim i As Integer
On Error Resume Next
i = UBound(arr)
If err.Number <> 0 Or i < 0 Then
i = 0
ReDim arr(0)
Else
i = UBound(arr) + 1
ReDim Preserve arr(i)
End If
arr(i) = ft
End Sub
Private Sub GetFileTypes(arr() As String)
If IsWord() Then
AddFileType arr, "All Word Files (*.doc; *.docx; *.dot; *.dotx)"
AddFileType arr, "Word Documents (*.doc; *.docx; *.docm)"
AddFileType arr, "Document Templates (*.dot; *.dotx; *.dotm)"
AddFileType arr, "Rich Text Format (*.rtf)"
ElseIf IsExcel() Then
AddFileType arr, "All Excel Files (*.xl*)"
AddFileType arr, "Worksheets (*.xls; *.xlsx; *.xlsb)"
AddFileType arr, "Workspaces (*.xlw; *.xlwx)"
AddFileType arr, "Templates (*.xlt; *.xltx; *.xltm)"
AddFileType arr, "Add-Ins (*.xla; *.xll; *.xlam)"
Else
AddFileType arr, "All PowerPoint Presentations (*.ppt; *.pptx; *.pptm; *.pps; *.pptsx; *.pot; *.potx)"
AddFileType arr, "Presentations and Shows (*.ppt; *.pptx; *.pptm; *.pps; *.pptsx)"
AddFileType arr, "PowerPoint Add-ins (*.ppa)"
End If
AddFileType arr, "All Files (*.*)"
End Sub
Public Sub P4Office_OpenFromPerforce()
' Open a new file from Perforce
On Error GoTo Error_Block
Const CmdTitle = "P4OFC - Open from Perforce"
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_OpenFromPerforce")
Dim SelectedFile As String
Dim InfoArr() As String
Dim ErrorArr() As String
Dim dlg As P4Dialogs.OpenDepot
Set dlg = New P4Dialogs.OpenDepot
Dim hwnd As Long
' Get the Application window handle
hwnd = m_OfficeApp.GetActiveWindowHandle
Dim FileTypes() As String
GetFileTypes FileTypes
SelectedFile = dlg.Run(hwnd, FileTypes)
If Len(SelectedFile) > 0 Then
' If file doesn't exist then try doing a sync -f on it
Dim fso As FileSystemObject
Set fso = New FileSystemObject
If Not fso.FileExists(SelectedFile) Then
Dim p4cmd As String
Dim TempFile As String
Dim Result As Integer
p4cmd = p4cmdstring("sync -f ", SelectedFile)
Result = p4runcmd(p4cmd, InfoArr, ErrorArr, TempFile)
End If
m_OfficeApp.OpenFile SelectedFile, False
End If
Exit Sub
Error_Block:
If InStr(1, err.Description, "Connect to server failed") > 0 Then
ResultForm.DisplayResult CmdTitle, "", 1, InfoArr, ErrorArr
Else
t.Report
End If
Exit Sub
End Sub
' Options form
Public Sub P4Office_Options()
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_Options")
Dim h As Hourglass: Set h = New Hourglass
ShowForm OptionsForm
Exit Sub
Error_Block:
t.Report
Exit Sub
End Sub
' Display help file
Public Sub P4Office_Help()
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_Help")
Const CmdTitle = "P4OFC - Help"
Dim h As WinHelp
Dim b As Boolean
Dim hwnd As Long
Dim HelpFile As String
HelpFile = RegOptions.HelpFilePath()
If Len(HelpFile) = 0 Then
MsgBox "Couldn't find help file - check installation!", _
vbExclamation + vbOKOnly, CmdTitle
GoTo Exit_Block
End If
If m_Help Is Nothing Then
Set m_Help = New WinHelp
End If
hwnd = GetFocus
b = m_Help.SetHelpInfo(hwnd, HelpFile)
m_Help.ShowContents
Exit_Block:
Exit Sub
Error_Block:
t.Report
Exit Sub
End Sub
' Diff current file with the version in Perforce - menu command
Public Sub P4Office_Diff()
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_Diff")
Const CmdTitle = "P4OFC - Compare current document with version in Perforce"
Dim h As Hourglass: Set h = New Hourglass
If m_OfficeApp.NoCurrDoc() Then GoTo Exit_Block
If Not ValidServerVersion() Then
InvalidServerMsg CmdTitle
GoTo Exit_Block
End If
If Len(m_OfficeApp.GetCurrDocPath()) = 0 Then
MsgBox "You must save the document first before you can compare it with the Perforce version!", vbOKOnly + vbExclamation, CmdTitle
GoTo Exit_Block
End If
If m_OfficeApp.GetActiveDocument.ProtectionType <> wdNoProtection Then
MsgBox "You can't compare a protected document!", vbOKOnly + vbExclamation, CmdTitle
GoTo Exit_Block
End If
If Not m_OfficeApp.GetCurrDocSaved() And Not m_OfficeApp.GetCurrDocReadonly() Then
Dim bDoSave As Integer
bDoSave = MsgBox("Would you like to save the document before comparing it with the Perforce version?", vbYesNo + vbQuestion, CmdTitle)
If bDoSave = vbOK Then
PowerpointSave
m_OfficeApp.SaveCurrDoc
End If
End If
P4Office_DoDiffCurrent "head"
Exit_Block:
Exit Sub
Error_Block:
t.Report
Exit Sub
End Sub
' Diff current file with a particular version
Public Sub P4Office_DoDiffCurrent(ver As String)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_DoDiffCurrent")
Const CmdTitle = "P4OFC - Compare current document with version in Perforce"
Dim CurrDoc As WORD.Document
Dim p4cmd As String
Dim DocPathname As String
Dim Result As Long
Dim InfoArr() As String
Dim ErrorArr() As String
Dim FileName As String
Dim h As Hourglass: Set h = New Hourglass
' This function is only intended to be used in Word
If Not IsWord() Then GoTo Exit_Block
If m_OfficeApp.NoCurrDoc() Then GoTo Exit_Block
If Not ValidServerVersion() Then
InvalidServerMsg CmdTitle
GoTo Exit_Block
End If
Set CurrDoc = m_OfficeApp.GetActiveDocument
' Save user info context - will be restored by deleting object
Dim ui As UserInfo
Set ui = New UserInfo
ui.SaveContext m_App, m_OfficeApp
' Make sure we change to appropriate directory (to pick up P4CONFIG file if there)
m_OfficeApp.ChangeCurrDocDir
' Note that we add the version number of file in as well (which may be #head)
DocPathname = m_OfficeApp.GetCurrDocPathname()
p4cmd = p4cmdstring("print ", DocPathname & "#" & ver)
Result = p4runcmd(p4cmd, InfoArr, ErrorArr, FileName)
If Result = 0 And IsEmptyArray(ErrorArr) Then
Dim Fname As String
Fname = VersionFilename(m_OfficeApp.GetCurrDocName(), ver)
Fname = RenameFile(FileName, Fname)
SetFileWriteable Fname
SetUserName ver, Fname
ui.RestoreContext
DoCompare CurrDoc, Fname
If CurrDoc.Revisions.Count = 0 Then
CurrDoc.Undo 1 ' Undo compare versions
MsgBox "No differences found between current document and the Perforce version.", vbOKOnly, CmdTitle
Else
DiffResultForm.ShowMe
End If
Else
ResultForm.DisplayResult CmdTitle, DocPathname, Result, InfoArr, ErrorArr
End If
Exit_Block:
Exit Sub
Error_Block:
If err.Number = 4198 Then
' Command (presumably Compare) failed - get this if user gets a warning and
' cancels the Compare
err.Clear
GoTo Exit_Block
Else
t.Report
End If
End Sub
Private Sub SetUserName(ByVal ver As String, ByVal Fname As String)
' Sets user information so that Word docs have correct changes in them
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "SetUserName")
Dim f As Fstat
Dim d As WORD.Document
Dim Msg As String
Dim NameOnly As String
Dim spec As P4COM.p4
Dim User As String
Dim InfoArr() As String
Dim ChangeDate As String
NameOnly = StripPath(Fname)
Set f = New Fstat
f.Initialize m_OfficeApp, ver
f.Run
Set spec = NewP4
spec.ExceptionLevel = 0
spec.ParseForms
spec.Connect
InitP4 spec
InfoArr = spec.Run("change -o " & CStr(f.HeadChange))
User = spec.Var("User")
ChangeDate = spec.Var("Date")
Msg = "#" & f.HeadRev & " change " & f.HeadChange & " on " & _
ChangeDate & " by " & User
If Len(Msg) > 50 Then ' Needs to be truncated to avoid error
Msg = Left$(Msg, 50)
End If
spec.Disconnect
m_App.UserName = Msg
' Now open and close doc so that it is associated with this info
' Would like to open doc not visible in Word XP, but this then makes it not
' the active doc...
m_App.Documents.Open FileName:=Fname, addtorecentfiles:=False
' Find just opened document
If GStacker.Tracing Then
GStacker.TraceMsg "Have opened doc:" & NameOnly
End If
m_App.Documents(NameOnly).Saved = False
If GStacker.Tracing Then
GStacker.TraceMsg "Set to unsaved"
End If
m_App.Documents(NameOnly).Close SaveChanges:=True
End Sub
' Diff two versions of the current file - called from history form
Public Sub P4Office_DoDiffOld(ver1 As String, ver2 As String)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_DoDiffOld")
Const CmdTitle = "P4OFC - Compare two versions of document from Perforce"
Dim CurrDoc As WORD.Document
Dim p4cmd As String
Dim DocPathname As String
Dim Result As Long
Dim InfoArr() As String
Dim ErrorArr() As String
Dim FileName As String
Dim Ver1FileName As String
Dim Ver2FileName As String
Dim h As Hourglass: Set h = New Hourglass
' Note that we only expect to be called for a Word Doc
If Not IsWord() Then GoTo Exit_Block
If m_OfficeApp.NoCurrDoc() Then GoTo Exit_Block
Set CurrDoc = m_OfficeApp.GetActiveDocument
' Make sure we change to appropriate directory (to pick up P4CONFIG file if there)
m_OfficeApp.ChangeCurrDocDir
' Save user info context - will be restored by deleting object
Dim ui As UserInfo
Set ui = New UserInfo
ui.SaveContext m_App, m_OfficeApp
' Note that we add the version number of file in as well (which may be #head)
DocPathname = m_OfficeApp.GetCurrDocPathname()
p4cmd = p4cmdstring("print ", DocPathname & "#" & ver1)
Result = p4runcmd(p4cmd, InfoArr, ErrorArr, FileName)
If Result = 0 Then
Ver1FileName = VersionFilename(CurrDoc.Name, ver1 & "-vs-v" & ver2)
Ver1FileName = RenameFile(FileName, Ver1FileName)
Else
ResultForm.DisplayResult CmdTitle, DocPathname, Result, InfoArr, ErrorArr
Exit Sub
End If
p4cmd = p4cmdstring("print ", DocPathname & "#" & ver2)
Result = p4runcmd(p4cmd, InfoArr, ErrorArr, FileName)
If Result = 0 Then
Ver2FileName = VersionFilename(m_OfficeApp.GetCurrDocName(), ver2)
Ver2FileName = RenameFile(FileName, Ver2FileName)
Else
ResultForm.DisplayResult CmdTitle, DocPathname, Result, InfoArr, ErrorArr
GoTo Exit_Block
End If
' Make the files not readonly
SetFileWriteable Ver1FileName
SetFileWriteable Ver2FileName
SetUserName ver2, Ver2FileName
SetUserName ver1, Ver1FileName
m_App.Documents.Open FileName:=Ver1FileName
Set CurrDoc = m_OfficeApp.GetActiveDocument
DoCompare CurrDoc, Ver2FileName
' Save doc so user can just close it when finished
' and don't bother showing DiffDialog
CurrDoc.Save
CurrDoc.Activate
If CurrDoc.Revisions.Count = 0 Then
MsgBox "No differences found between versions " & ver1 & " and " & ver2 & ".", vbOKOnly, CmdTitle
End If
Exit_Block:
Exit Sub
Error_Block:
If err.Number = 4198 Then
' Command (presumably Compare) failed - get this if user gets a warning and
' cancels the Compare
err.Clear
GoTo Exit_Block
Else
t.Report
End If
End Sub
Private Sub DoCompare(Doc As Object, Fname As String)
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "DoCompare")
' Office XP constants - need to remove if built with those type libs
Const wdCompareTargetCurrent = 1
Const wdMergeTargetCurrent = 1
Dim SavedType As WdViewType
SavedType = Doc.ActiveWindow.View.Type
If Not (SavedType = wdNormalView Or SavedType = wdPrintView) Then
Doc.ActiveWindow.View.Type = wdPrintView
End If
' Different versions of Word behave differently - prefer the Merge command for more recent versions.
If IsVersion2010OrGreater() Then
Doc.Merge Fname, MergeTarget:=wdMergeTargetCurrent, DetectFormatChanges:=True
ElseIf IsVersionXPOrGreater() Then
Doc.Compare Fname, CompareTarget:=wdCompareTargetCurrent, DetectFormatChanges:=True
Else
Doc.Compare Fname
End If
If Not (SavedType = wdNormalView Or SavedType = wdPrintView) Then
Doc.ActiveWindow.View.Type = SavedType
End If
End Sub
Private Sub SetFileWriteable(ByVal Fname As String)
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "SetFileWriteable")
Dim fso As FileSystemObject
Dim f As File
Set fso = New FileSystemObject
Set f = fso.GetFile(Fname)
f.Attributes = f.Attributes And Not ReadOnly
End Sub
' Display p4 info - menu command
Public Sub P4Office_Info()
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_Info")
Const CmdTitle = "P4OFC - Perforce Connection Information"
Dim h As Hourglass: Set h = New Hourglass
RunP4CommandNoDoc CmdTitle, "info", SaveResults:=False
Exit Sub
Error_Block:
t.Report
End Sub
' Display opened files in current workspace - menu command
Public Sub P4Office_Opened()
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_Opened")
Const CmdTitle = "P4OFC - Checked Out Documents"
Dim Result As Long
Dim InfoArr() As String
Dim ErrorArr() As String
Dim h As Hourglass: Set h = New Hourglass
If Not ValidServerVersion() Then
InvalidServerMsg CmdTitle
GoTo Exit_Block
End If
Result = p4runcmd("opened", InfoArr, ErrorArr, "")
OpenedForm.DisplayResult CmdTitle, "", Result, InfoArr, ErrorArr
Exit_Block:
Exit Sub
Error_Block:
t.Report
End Sub
' Run FSTAT on current file - menu command
Public Sub P4Office_Fstat()
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_Fstat")
Const CmdTitle = "P4OFC - Document Status"
Dim InfoArr() As String
Dim ErrorArr() As String
Dim DocPath As String
Dim DocPathname As String
Dim Result As Long
Dim h As Hourglass: Set h = New Hourglass
If m_OfficeApp.NoCurrDoc() Then GoTo Exit_Block
If Not ValidServerVersion() Then
InvalidServerMsg CmdTitle
GoTo Exit_Block
End If
DocPath = m_OfficeApp.GetCurrDocPath()
If Len(DocPath) = 0 Then
MsgBox "You must save the document first before you can show its information!", vbOKOnly + vbExclamation, CmdTitle
GoTo Exit_Block
End If
DoFstat
m_Fstat.FormattedInfo InfoArr
Result = 0
DocPathname = m_OfficeApp.GetCurrDocPathname()
If IsEmptyArray(InfoArr) And IsEmptyArray(ErrorArr) Then Result = 1
ResultForm.DisplayResult CmdTitle, DocPathname, Result, InfoArr, ErrorArr
Exit_Block:
Exit Sub
Error_Block:
t.Report
End Sub
' Revert currently opened file - menu command
Public Sub P4Office_Revert()
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_Revert")
Const CmdTitle = "P4OFC - Undo Add/Check Out"
Dim Choice As Integer
Dim f As Fstat
Dim IsAdded As Boolean
Dim Msg As String
Dim h As Hourglass: Set h = New Hourglass
If m_OfficeApp.NoCurrDoc() Then GoTo Exit_Block
If Not ValidServerVersion() Then
InvalidServerMsg CmdTitle
GoTo Exit_Block
End If
If Len(m_OfficeApp.GetCurrDocPath()) = 0 Then
MsgBox "You can't undo a check out of a new document!", vbOKOnly + vbExclamation, CmdTitle
GoTo Exit_Block
End If
' Let's find out if doc is opened for edit, add or whatever
Set f = New Fstat
f.Initialize m_OfficeApp
f.Run
IsAdded = f.Action = "add"
If Len(f.DepotFile) = 0 And f.Action <> "add" Then
' File isn't in depot and is not being added
GoTo Exit_Block
ElseIf Len(f.DepotFile) <> 0 And Len(f.Action) = 0 Then
MsgBox "The document is not checked out!", vbOKOnly + vbExclamation, CmdTitle
GoTo Exit_Block
End If
If IsAdded Then
Msg = "Are you sure you wish to cancel adding the document to Perforce?"
Else
Msg = "Are you sure you wish to discard changes and revert to the previous version?"
End If
Choice = MsgBox(Msg, vbYesNo + vbQuestion, CmdTitle)
If Choice = vbYes Then
RevertAndReopenFile IsAdded
End If
Exit_Block:
Exit Sub
Error_Block:
t.Report
End Sub
' Display results of last command - menu command
Public Sub P4Office_DisplayLastCommand()
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_DisplayLastCommand")
Const CmdTitle = "P4OFC - Results of Last Perforce Command"
Dim h As Hourglass: Set h = New Hourglass
ResultForm.DisplayResult CmdTitle, "", 0, g_InfoArr, g_ErrorArr
Exit Sub
Error_Block:
t.Report
End Sub
Public Sub SaveArrays(InfoArr() As String, ErrorArr() As String)
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "SaveArrays")
' Saves the contents of the arrays.
Dim i As Integer
If IsEmptyArray(InfoArr) Then
Erase g_InfoArr
Else
ReDim g_InfoArr(UBound(InfoArr))
For i = LBound(InfoArr) To UBound(InfoArr)
g_InfoArr(i) = InfoArr(i)
Next
End If
If IsEmptyArray(ErrorArr) Then
Erase g_ErrorArr
Else
ReDim g_ErrorArr(UBound(ErrorArr))
For i = LBound(ErrorArr) To UBound(ErrorArr)
g_ErrorArr(i) = ErrorArr(i)
Next
End If
End Sub
' Check current file out for editing - menu command
Public Sub P4Office_Edit()
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_Edit")
Const CmdTitle = "P4OFC - Check Out From Perforce"
Dim h As Hourglass: Set h = New Hourglass
If m_OfficeApp.NoCurrDoc() Then GoTo Exit_Block
If Not ValidServerVersion() Then
InvalidServerMsg CmdTitle
GoTo Exit_Block
End If
If Len(m_OfficeApp.GetCurrDocPath()) = 0 Then
MsgBox "You can't check out an unsaved document!", vbOKOnly + vbExclamation, CmdTitle
GoTo Exit_Block
End If
EditAndReopenFile False
Exit_Block:
Exit Sub
Error_Block:
t.Report
End Sub
' Ping server to see if there or not by running "p4 info"
Private Function ServerPresent() As Boolean
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "ServerPresent")
Dim Result As Long
Dim InfoArr() As String
Dim ErrorArr() As String
Dim FileName As String
' Make sure we change to appropriate directory (to pick up P4CONFIG file if there)
If Not m_OfficeApp.NoCurrDoc() Then m_OfficeApp.ChangeCurrDocDir
Result = p4runcmd("info", InfoArr, ErrorArr, FileName)
ServerPresent = (Result = 0)
End Function
' Run a p4 command which doesn't require a document as parameter
Private Sub RunP4CommandNoDoc(CmdTitle As String, ByVal cmd As String, _
Optional SaveResults As Boolean = True)
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "RunP4CommandNoDoc")
Dim Result As Long
Dim InfoArr() As String
Dim ErrorArr() As String
Dim FileName As String
Dim DocPathname As String
' Make sure we change to appropriate directory (to pick up P4CONFIG file if there)
If Not m_OfficeApp.NoCurrDoc() Then m_OfficeApp.ChangeCurrDocDir
Result = p4runcmd(cmd, InfoArr, ErrorArr, FileName)
If SaveResults Then
SaveArrays InfoArr, ErrorArr
End If
ResultForm.DisplayResult CmdTitle, DocPathname, Result, InfoArr, ErrorArr
End Sub
' Run the specified p4 command on the current document
Private Sub RunP4Command(CmdTitle As String, ByVal cmd As String, SuccessString As String, _
Optional bFstatCmd As Boolean = False, Optional ConfirmDialog As Boolean = False)
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "RunP4Command")
Dim Result As Long
Dim InfoArr() As String
Dim ErrorArr() As String
Dim FileName As String
Dim DocPathname As String
' Make sure we change to appropriate directory (to pick up P4CONFIG file if there)
m_OfficeApp.ChangeCurrDocDir
DocPathname = m_OfficeApp.GetCurrDocPathname()
cmd = p4cmdstring(cmd, DocPathname)
Result = p4runcmd(cmd, InfoArr, ErrorArr, FileName)
' Special processing to update format of datetime
If bFstatCmd Then
UpdateFstatDatetime InfoArr
End If
SaveArrays InfoArr, ErrorArr
' Search for success string - if found then don't display results
If Len(SuccessString) <> 0 Then
If Not IsEmptyArray(InfoArr) Then
Dim i As Integer
i = LBound(InfoArr)
If (InStr(1, InfoArr(i), SuccessString) = 0) Then
ResultForm.DisplayResult CmdTitle, DocPathname, Result, InfoArr, ErrorArr
ElseIf ConfirmDialog Then
ResultForm.DisplayResult CmdTitle, DocPathname, Result, InfoArr, ErrorArr, ConfirmDialog
End If
Else
ResultForm.DisplayResult CmdTitle, DocPathname, Result, InfoArr, ErrorArr
End If
Else
ResultForm.DisplayResult CmdTitle, DocPathname, Result, InfoArr, ErrorArr
End If
End Sub
' Display filelog history - menu command
Public Sub P4Office_Filelog()
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_Filelog")
Const CmdTitle = "P4OFC - Document History"
Dim DocPathname As String
Dim h As Hourglass: Set h = New Hourglass
If m_OfficeApp.NoCurrDoc() Then GoTo Exit_Block
If Not ValidServerVersion() Then
InvalidServerMsg CmdTitle
GoTo Exit_Block
End If
If Len(m_OfficeApp.GetCurrDocPath()) = 0 Then
MsgBox "You must save the document first before you can view the history!", vbOKOnly + vbExclamation, CmdTitle
GoTo Exit_Block
End If
' Make sure we change to appropriate directory (to pick up P4CONFIG file if there)
m_OfficeApp.ChangeCurrDocDir
DocPathname = m_OfficeApp.GetCurrDocPathname()
HistoryForm.DoHistory DocPathname
Exit_Block:
Exit Sub
Error_Block:
t.Report
Exit Sub
End Sub
' View specified version of a file
Public Sub P4Office_ViewVersion(ver As String)
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_ViewVersion")
Const CmdTitle = "P4OFC - View Specified Version of a Document From Perforce"
Dim p4cmd As String
Dim DocPathname As String
Dim Result As Long
Dim InfoArr() As String
Dim ErrorArr() As String
Dim FileName As String
Dim Fname As String
Dim h As Hourglass: Set h = New Hourglass
If m_OfficeApp.NoCurrDoc() Then GoTo Exit_Block
If Not ValidServerVersion() Then
InvalidServerMsg CmdTitle
GoTo Exit_Block
End If
' Make sure we change to appropriate directory (to pick up P4CONFIG file if there)
m_OfficeApp.ChangeCurrDocDir
' Note that we add the version number of file in as well (which may be #head)
DocPathname = m_OfficeApp.GetCurrDocPathname()
p4cmd = p4cmdstring("print ", DocPathname & "#" & ver)
Result = p4runcmd(p4cmd, InfoArr, ErrorArr, FileName)
If Result = 0 Then
Fname = VersionFilename(m_OfficeApp.GetCurrDocName(), ver)
Fname = RenameFile(FileName, Fname)
m_OfficeApp.OpenFile Fname, True
m_OfficeApp.ActivateDoc StripPath(Fname)
Else
ResultForm.DisplayResult CmdTitle, DocPathname, Result, InfoArr, ErrorArr
End If
Exit_Block:
End Sub
' Checks if specified file is in Perforce => True if so
Public Function P4Office_IsInPerforce() As Boolean
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_IsInPerforce")
Dim f As Fstat
P4Office_IsInPerforce = False
' Only start doing stuff if not embedded
If Not m_OfficeApp.EmbeddedApp() Then
Set f = New Fstat
f.Initialize m_OfficeApp
f.Run
If Len(f.DepotFile) <> 0 And f.HaveRev <> 0 Then
P4Office_IsInPerforce = True
End If
End If
End Function
' Add current file to p4 - menu command
Public Sub P4Office_Add()
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_Add")
Const CmdTitle = "P4OFC - Confirmation of Add to Perforce"
Dim bDoSave As Integer
Dim h As Hourglass: Set h = New Hourglass
If m_OfficeApp.NoCurrDoc() Then GoTo Exit_Block
If Not ValidServerVersion() Then
InvalidServerMsg CmdTitle
GoTo Exit_Block
End If
If Len(m_OfficeApp.GetCurrDocPath()) = 0 Then
MsgBox "You need to save the document in a directory in the client workspace (Perforce controlled area) before you can add it to Perforce", vbOKOnly + vbExclamation, "Error Adding Document to Perforce"
GoTo Exit_Block
End If
If Not m_OfficeApp.GetCurrDocSaved() Then
If m_OfficeApp.GetCurrDocReadonly() Then
MsgBox "The current document has been modified but is read-only - please undo changes or save as a different document and redo the add!", vbOKOnly + vbExclamation, "Error Adding Document to Perforce"
GoTo Exit_Block
Else
bDoSave = MsgBox("Would you like to save the document before adding it to Perforce?", vbOKCancel + vbQuestion, CmdTitle)
If bDoSave = vbOK Then
PowerpointSave
m_OfficeApp.SaveCurrDoc
End If
End If
End If
RunP4Command CmdTitle, "add", "opened for add", ConfirmDialog:=RegOptions.DisplayConfirmations
' If successfully added then see if user wants to be prompted to submit
DoFstat
If m_Fstat.Action = "add" Then
If RegOptions.CheckinAfterAddReminder = Always Then
P4Office_Submit
ElseIf CheckinAfterAddForm.Answer = vbOK Then
P4Office_Submit
End If
End If
Exit_Block:
Exit Sub
Error_Block:
t.Report
End Sub
' Do submit command - menu command
Private Sub DoSubmit(ReopenDoc As Boolean, f As Fstat, Optional CancelSave As Boolean = False)
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "DoSubmit")
Const CmdTitle = "P4OFC - Check In to Perforce"
Const CmdTitleResult = "P4OFC - Confirmation of Check In to Perforce"
Const CmdTitleLock = "P4OFC - Confirmation of Check Out from Perforce"
Dim Result As Long
Dim InfoArr() As String
Dim ErrorArr() As String
Dim FileName As String
Dim DocPathname As String
Dim Answer As Integer
Dim submit As P4COM.p4
Dim h As Hourglass: Set h = New Hourglass
If m_OfficeApp.NoCurrDoc() Then GoTo Exit_Block
If Not ValidServerVersion() Then
GoTo Exit_Block
End If
If IsWord() Then
' Check no revisions marks are still in the doc
Dim CurrDoc As WORD.Document
Set CurrDoc = m_OfficeApp.GetActiveDocument
If CurrDoc.Revisions.Count <> 0 Then
Answer = MsgBox("There are revisions from document comparison still active in the current document. " & vbCrLf & _
"To remove them, click Cancel and choose Edit>Undo. To check in the document including the comparison results, click OK.", _
vbOKCancel + vbQuestion, CmdTitle)
If Answer <> vbOK Then
GoTo Exit_Block
End If
End If
End If
If f Is Nothing Then
Set f = New Fstat
f.Initialize m_OfficeApp
f.Run
End If
' Make sure we change to appropriate directory (to pick up P4CONFIG file if there)
m_OfficeApp.ChangeCurrDocDir
DocPathname = ConvertSlashes(f.ClientFile)
' Check if we need to resolve or not
If f.HaveRev <> f.HeadRev Then
If f.HeadAction = "delete" Then
MsgBox "This file has been deleted in the depot, and you cannot check it in. " & _
"Save it using a different filename and then add it, or " & _
"use another Perforce client program to sync and edit an earlier revision.", _
vbOKOnly + vbExclamation, CmdTitle
GoTo Exit_Block
Else
Answer = ResolveForm.Action
If Answer = CancelCheckin Then
GoTo Exit_Block
ElseIf Answer = AcceptTheirs Then
' Throw ours away - this will prompt to be sure
P4Office_Revert
GoTo Exit_Block
Else ' Accept Yours
' Do sync/resolve and then carry on for submit
If Not SyncAndResolve(f) Then
GoTo Exit_Block
End If
End If
End If
End If
Set submit = NewP4
submit.ExceptionLevel = 0
submit.ParseForms
submit.Connect
InitP4 submit
' Now check if we are in the default change list or not.
If f.Change = "default" Then
InfoArr = submit.Run("change -o -s")
Else
InfoArr = submit.Run("change -o -s " & f.Change)
End If
If SubmitForm.DoSubmit(CmdTitleResult, submit, f, InfoArr) = vbCancel Then GoTo Exit_Block
' Find out what happened and save
ErrorArr = submit.Errors
SaveArrays InfoArr, ErrorArr
Result = 0
If IsEmptyArray(InfoArr) And IsEmptyArray(ErrorArr) Then
Result = 1
End If
ResultForm.DisplayResult CmdTitleResult, f.ClientFile, Result, InfoArr, ErrorArr
If ReopenDoc Then
' If submit was successful and file has changed state, then check if
' currently have open for edit and offer to open for edit again.
f.Run
If Len(f.Action) = 0 Then ' Would be "edit" if still opened for edit - i.e. submit wan't done
' Note that just by closing and reopening the document the user will be asked
' if they want to open the file for editing.
m_OfficeApp.CloseCurrDoc True
' So now reopen the document!
m_FileJustSubmitted = True
m_OfficeApp.OpenFile DocPathname, False
Else ' opened for edit
If RegOptions.AutoLock = Always Then
LockFile f
ElseIf RegOptions.AutoLock = Prompt Then
Answer = MsgBox("Click OK to lock the document.", _
vbOKCancel, CmdTitleLock)
If Answer = vbOK Then
LockFile f
End If
End If
End If
End If
Exit_Block:
' For Powerpoint we may need to get rid of a dialog coming up
If CancelSave Then
SendKeys "n"
End If
Exit Sub
End Sub
' Do submit command - menu command
Public Sub P4Office_Submit()
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_Submit")
Const CmdTitle = "P4OFC - Check In to Perforce"
Dim Result As Long
Dim Answer As Integer
Dim f As Fstat
Dim h As Hourglass: Set h = New Hourglass
If m_OfficeApp.NoCurrDoc() Then GoTo Exit_Block
If Not ValidServerVersion() Then
InvalidServerMsg CmdTitle
GoTo Exit_Block
End If
If Len(m_OfficeApp.GetCurrDocPath()) = 0 Then
MsgBox "You must save the document before you can check it in to Perforce!", vbOKOnly + vbExclamation, CmdTitle
GoTo Exit_Block
End If
If Not m_OfficeApp.GetCurrDocSaved() Then
If m_OfficeApp.GetCurrDocReadonly() Then
' Causes too many problems to try to auto save because of delayed events
' firing while waiting for submit dialog to be completed
MsgBox "The current document has been modified but is read-only - please undo changes or save as a different document and redo the submit!", vbOKOnly + vbExclamation, CmdTitle
GoTo Exit_Block
Else
If m_OfficeApp.KeywordPropertiesExist Then
m_OfficeApp.KeywordPropertiesUpdate bSubmitting:=True
m_OfficeApp.KeywordPropertiesFieldsUpdate
End If
Answer = MsgBox("Save the latest changes before checking in to Perforce?", vbOKCancel + vbQuestion, CmdTitle)
If Answer = vbOK Then
PowerpointSave
m_OfficeApp.SaveCurrDoc
Else
' Causes too many problems if we allow to continue with an unsaved doc.
GoTo Exit_Block
End If
End If
Else
' Check for keywords requiring updating
If m_OfficeApp.KeywordPropertiesExist Then
m_OfficeApp.KeywordPropertiesUpdate bSubmitting:=True
m_OfficeApp.KeywordPropertiesFieldsUpdate
PowerpointSave
m_OfficeApp.SaveCurrDoc
End If
End If
DoSubmit ReopenDoc:=True, f:=f
Exit_Block:
Exit Sub
Error_Block:
t.Report
End Sub
Private Function JobList(Jobs() As String) As String
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "JobList")
Dim list As String
list = "(" & Join(Jobs, ", ") & ")"
JobList = list
End Function
Private Function SyncAndResolve(f As Fstat) As Boolean
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "SyncAndResolve")
Dim Result As Long
Dim InfoArr() As String
Dim ErrorArr() As String
Dim FileName As String
Dim DocPathname As String
Dim cmd As String
SyncAndResolve = False
m_OfficeApp.ChangeCurrDocDir
DocPathname = f.ClientFile
' Do a sync to schedule a resolve
cmd = p4cmdstring("sync", DocPathname)
Result = p4runcmd(cmd, InfoArr, ErrorArr, FileName)
SaveArrays InfoArr, ErrorArr
' Now check to see if we successfully synced (and forced resolve)
f.Run
If f.HaveRev <> f.HeadRev Or Not f.Unresolved Then
Exit Function
End If
cmd = p4cmdstring("resolve -ay", DocPathname)
Result = p4runcmd(cmd, InfoArr, ErrorArr, FileName)
SaveArrays InfoArr, ErrorArr
f.Run
If Not f.Unresolved Then
SyncAndResolve = True
End If
End Function
' If the specified document is readonly AND in Perforce control then allow user
' to check out for edit.
Public Sub P4Office_CheckOnClose(Doc As Object, Cancel As Boolean)
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_CheckOnClose")
Const CmdTitle As String = "P4OFC - Closing Document"
CheckClose Doc, Cancel
Exit Sub
Error_Block:
t.Report
End Sub
' If the specified document is readonly AND in Perforce control then allow user
' to check out for edit.
Public Sub P4Office_CheckFile()
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_CheckFile")
Const CmdTitle As String = "P4OFC - Opening Document"
Static AlreadyProcessing As Boolean
Dim DoEdit As Boolean
Dim CheckOutOnReopen As OptionsValue
Dim CheckOutOnOpen As OptionsValue
Dim FileJustReverted As Boolean
Dim p4 As P4COM.p4
' Guard against being called more than once
If AlreadyProcessing Then Exit Sub
AlreadyProcessing = True
Dim h As Hourglass: Set h = New Hourglass
' Ignore file if embedded inside Explorer or similar...
If m_OfficeApp.EmbeddedApp() Then GoTo Exit_Block
' Check flag that file has just been closed and reopened as part of Submit
If m_FileJustSubmitted Then
m_FileJustSubmitted = False
GoTo Exit_Block
End If
CheckOutOnReopen = RegOptions.CheckOutOnReopen
CheckOutOnOpen = RegOptions.CheckOutOnOpen
FileJustReverted = False
If m_FileJustReverted Then
FileJustReverted = True
m_FileJustReverted = False
If CheckOutOnReopen = Never Then
GoTo Exit_Block
End If
End If
If CheckOutOnOpen = Never Then
GoTo Exit_Block
End If
' Check if we should ask server about this
If Not m_OfficeApp.NoCurrDoc Then
ChDir m_OfficeApp.GetCurrDocPath
End If
Set p4 = NewP4
If HideConnectionWarning(p4.port) Then
GoTo Exit_Block
End If
' Do initial connection in seperate form in case of timeouts etc.
If Not ConnectForm.Connect Then
GoTo Exit_Block
End If
DoFstat
If m_Fstat.Error Then
Dim InfoArr() As String
Dim ErrorArr() As String
' Force hide connection warning to be displayed
ResultForm.DisplayResult CmdTitle, "", 1, InfoArr, ErrorArr
End If
If Not ValidServerVersion() Then
GoTo Exit_Block
End If
If Len(m_Fstat.DepotFile) <> 0 And m_Fstat.HaveRev <> 0 And Len(m_Fstat.Action) = 0 Then
If FileJustReverted Then
If CheckOutOnReopen = Prompt Then
DoEdit = AskOpenForEdit(True, CmdTitle)
Else
DoEdit = True
End If
Else
If CheckOutOnOpen = Prompt Then
DoEdit = AskOpenForEdit(True, CmdTitle)
Else
DoEdit = True
End If
End If
If DoEdit Then
EditAndReopenFile True
End If
End If
Exit_Block:
AlreadyProcessing = False
End Sub
Private Function AskOpenForEdit(ByVal FromCheckfile As Boolean, ByVal CmdTitle As String) As Boolean
' Check if user wants to open for edit - done in different ways depending on the
' state of the file
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "AskOpenForEdit")
Dim Msg As String
Dim Answer As VbMsgBoxResult
If FromCheckfile Then
Msg = "This document is in Perforce." & vbCrLf & vbCrLf
Else
Msg = vbNullString
End If
AskOpenForEdit = False
If Len(m_Fstat.DepotFile) <> 0 Then
If m_Fstat.Action = "edit" Then
' If already opened for edit we don't need to do it...
ElseIf m_Fstat.HaveRev <> m_Fstat.HeadRev Then
' File is not opened for editing and we have an older version
If m_Fstat.HeadRev = 0 Then
Msg = Msg & "This document is no longer in the client workspace view - " & _
"please synchronize your client workspace using p4win or p4."
MsgBox Msg, vbOKOnly, CmdTitle
ElseIf m_Fstat.HeadAction = "delete" Then
Msg = Msg & "You have an old version of this document (" & CStr(m_Fstat.HaveRev) & ") and the " & _
"newest version in the Perforce depot (" & CStr(m_Fstat.HeadRev) & ") has been deleted." & vbCrLf & vbCrLf & _
"Please use P4Win to recover the document."
MsgBox Msg, vbOKOnly, CmdTitle
Else ' More normal case TODO - sync
Msg = Msg & "You have an old version of this document (" & CStr(m_Fstat.HaveRev) & ") and the " & _
"newest version in the Perforce depot is " & CStr(m_Fstat.HeadRev) & "." & vbCrLf & vbCrLf & _
LockStatusMsg()
If SyncCheckoutForm.Action(m_App, m_OfficeApp, Msg, IsExclusiveEdit(m_Fstat.HeadType)) = CheckOut Then
AskOpenForEdit = True
End If
End If
ElseIf m_Fstat.NumOtherOpen <> 0 Then
' Check that file has not been opened by anyone else
If IsExclusiveEdit(m_Fstat.HeadType) Then
Msg = Msg & LockStatusMsg()
MsgBox Msg, vbOKOnly + vbInformation, CmdTitle
ElseIf m_Fstat.LockType = OtherLock Then
' We want to lock file but won't be able to!
Msg = Msg & LockStatusMsg()
If RegOptions.AutoLock = Always Then
Msg = Msg & vbCrLf & "Click OK to check out without locking it."
End If
Answer = MsgBox(Msg, vbOKCancel + vbQuestion, CmdTitle)
If Answer = vbOK Then
AskOpenForEdit = True
End If
Else
Msg = Msg & LockStatusMsg() & vbCrLf & _
"Click OK to check out."
Answer = MsgBox(Msg, vbOKCancel + vbQuestion, CmdTitle)
If Answer = vbOK Then
AskOpenForEdit = True
End If
End If
ElseIf FromCheckfile Then
Msg = Msg & vbCrLf & _
"Click OK to check out."
Answer = MsgBox(Msg, vbOKCancel + vbQuestion, CmdTitle)
If Answer = vbOK Then
AskOpenForEdit = True
End If
Else
' Just check out
AskOpenForEdit = True
End If
End If
End Function
Private Function FormatOtherOpen() As String
FormatOtherOpen = " " & Join(Split(m_Fstat.WhoOtherOpen, vbCrLf), vbCrLf & " ") & vbCrLf
End Function
Private Function LockStatusMsg() As String
If m_Fstat.NumOtherOpen <> 0 Then
' Check that file has not been opened by anyone else
If IsExclusiveEdit(m_Fstat.HeadType) Then
LockStatusMsg = "The document has been checked out for exclusive editing by someone else:" & _
vbCrLf & FormatOtherOpen & vbCrLf & _
"It is not possible to check it out."
ElseIf m_Fstat.LockType = OtherLock Then
' We want to lock file but won't be able to!
LockStatusMsg = "The document has already been locked by someone else:" & vbCrLf & _
FormatOtherOpen & vbCrLf
If RegOptions.AutoLock <> Never Then
' We want to lock file but won't be able to!
LockStatusMsg = LockStatusMsg & "Automatic locking after Check Out is not possible."
End If
Else ' Not locked
LockStatusMsg = "The document has already been checked out by someone else:" & vbCrLf & _
FormatOtherOpen & vbCrLf
End If
End If
End Function
' Opens file for editing.
' Handle the following situations:
' 1. Someone else has the file opened - in which case offer opportunity not to do it
' 2. Edit doesn't work
Private Sub EditAndReopenFile(ByVal FromCheckfile As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "EditAndReopenFile")
Const CmdTitle = "P4OFC - Confirmation of Check Out from Perforce"
Dim p4cmd As String
Dim Result As Long
Dim InfoArr() As String
Dim ErrorArr() As String
Dim FileName As String
Dim DocPathname As String
Dim OpenForEdit As Boolean
Dim OpenedOK As Boolean
Dim Answer As Integer
OpenedOK = False
DocPathname = m_OfficeApp.GetCurrDocPathname()
If FromCheckfile Then
OpenForEdit = True
Else
DoFstat
OpenForEdit = AskOpenForEdit(False, CmdTitle)
End If
' Actually open for edit if we need to.
If OpenForEdit Then
p4cmd = p4cmdstring("edit ", DocPathname)
Result = p4runcmd(p4cmd, InfoArr, ErrorArr, FileName)
SaveArrays InfoArr, ErrorArr
' Don't bother displaying the results unless error - see later
'ResultForm.DisplayResult CmdTitle, DocPathname, Result, InfoArr, ErrorArr
' Check the results of our open
m_Fstat.Run
If m_Fstat.Action = "edit" Then
OpenedOK = True
End If
End If
' Check if an error in opening for edit
If OpenForEdit And Not OpenedOK Then
ResultForm.DisplayResult CmdTitle, DocPathname, Result, g_InfoArr, g_ErrorArr
ElseIf OpenForEdit And OpenedOK Then
If RegOptions.DisplayConfirmations Then
ResultForm.DisplayResult CmdTitle, DocPathname, Result, g_InfoArr, g_ErrorArr, RegOptions.DisplayConfirmations
End If
Dim AutoLock As OptionsValue
AutoLock = RegOptions.AutoLock
If AutoLock <> Never Then
Dim TryToLock As Boolean
TryToLock = False
If AutoLock = Prompt Then
' Only prompt if we are going to be able to lock
If m_Fstat.LockType = NoLock Then
Answer = MsgBox("Click OK to lock the document.", vbQuestion + vbOKCancel, CmdTitle)
TryToLock = (Answer = vbOK)
End If
Else
TryToLock = True
End If
' Try and lock the file
If TryToLock Then
If Not LockFile() Then
m_Fstat.Run
MsgBox "Failed to lock the document - it has been locked for exclusive editing by someone else:" & _
vbCrLf & FormatOtherOpen & vbCrLf & _
"It is checked out but not locked!", vbOKOnly + vbInformation, CmdTitle
End If
End If
End If
End If
' Now check if we need to reopen the doc
' Not if already open for writing
If OpenedOK And m_OfficeApp.GetCurrDocReadonly() Then
If m_OfficeApp.GetCurrDocReadonlyRecommended() Then
' We can't close and reopen as writeable a ReadOnlyRecommended file - Word
' doesn't allow it unfortunately.
' The best we can do is to tell the user and ask them to do it.
MsgBox "Please close the current document and re-open it not read-only. " & _
"Unfortunately this can't be done automatically because the 'Recommend Read-only'" & _
"property is set for this document. You might want to turn this off under General Options in " & _
" the File/Save As... dialog.", vbOKOnly + vbInformation, CmdTitle
ElseIf m_OfficeApp.GetCurrDocReadonly() And Not m_OfficeApp.GetCurrDocSaved() Then
SaveModifedReadOnlyDoc
Else
m_OfficeApp.CloseCurrDoc False
' So now reopen the document!
m_OfficeApp.OpenFile DocPathname, False
m_OfficeApp.SetCurrDocReadOnlyRecommended False
End If
End If
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub PowerpointSave()
' Special checks for certain types of powerpoint docs
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "PowerpointSave")
If IsPowerPoint() And IsVersionXPOr2003() Then
' See MSKB - http://support.microsoft.com/kb/905166
Const ppRevisionInfoNone = 0
' is there already a baseline?
If m_App.ActivePresentation.HasRevisionInfo = ppRevisionInfoNone Then
' NO - then do we have the custom document properties...
Dim i As Integer
For i = 1 To m_App.ActivePresentation.CustomDocumentProperties.Count
If m_App.ActivePresentation.CustomDocumentProperties(i).Name = "_AdHocReviewCycleID" Then
' we have an AdHoc presentation review...
' So add a baseline to prevent the dialog...
m_App.ActivePresentation.AddBaseline
End If
Next
End If
End If
End Sub
Private Sub SaveModifedReadOnlyDoc()
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "SaveModifedReadOnly")
' Because Word doesn't allow us to save on top of a readonly file:
' Save current file as a temp file
' rename original from Perforce to a backup
' Rename temp file to original filename and reopen
Dim Docname As String
Dim Backup As String
Dim Temp As String
Docname = m_OfficeApp.GetCurrDocPathname
Backup = GetDir(Docname) & "\~-" & StripPath(Docname)
Temp = GetDir(Docname) & "\~" & StripPath(Docname)
PowerpointSave
m_OfficeApp.SaveAsCurrDoc Temp
m_OfficeApp.CloseCurrDoc False
m_OfficeApp.Rename Docname, StripPath(Backup)
m_OfficeApp.Rename Temp, StripPath(Docname)
m_OfficeApp.OpenFile Docname, False
End Sub
Private Function IsExclusiveEdit(FileType As String) As Boolean
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "IsExclusiveEdit")
' Check for +L in filetype
Dim i As Integer
IsExclusiveEdit = False
i = InStr(1, FileType, "+")
If i > 0 Then
If InStr(i, FileType, "l") <> 0 Then
IsExclusiveEdit = True
End If
End If
End Function
Private Function LockFile(Optional fs As Fstat) As Boolean
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "LockFile")
Dim Result As Long
Dim InfoArr() As String
Dim ErrorArr() As String
Dim FileName As String
Dim DocPathname As String
Dim cmd As String
Dim f As Fstat
LockFile = False
m_OfficeApp.ChangeCurrDocDir
DocPathname = m_OfficeApp.GetCurrDocPathname()
If IsMissing(fs) Or fs Is Nothing Then
Set f = New Fstat
f.Initialize m_OfficeApp
f.Run
Else
Set f = fs
End If
' Can't lock if already locked!
If f.LockType = OtherLock Or f.LockType = OtherExclusiveLock Then Exit Function
If f.LockType = OurLock Or f.LockType = OurExclusiveLock Then
LockFile = True
Exit Function
End If
cmd = p4cmdstring("lock", DocPathname)
Result = p4runcmd(cmd, InfoArr, ErrorArr, FileName)
SaveArrays InfoArr, ErrorArr
' Now check to see if we successfully locked file
If CommandSuccessful(Result, InfoArr, " locking") Then
LockFile = True
End If
End Function
' Lock/unlock - menu command
Public Sub P4Office_Lock()
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_Lock")
Const CmdTitle = "P4OFC - Lock/Unlock Document"
Const CmdTitleResult = "P4OFC - Confirmation of Lock/Unlock Document"
Dim p4cmd As String
Dim SuccessString As String
If m_OfficeApp.NoCurrDoc() Then GoTo Exit_Block
If Not ValidServerVersion() Then
InvalidServerMsg CmdTitle
GoTo Exit_Block
End If
If Len(m_OfficeApp.GetCurrDocPath()) = 0 Then
MsgBox "Can't lock unsaved document!", vbOKOnly + vbExclamation, CmdTitle
GoTo Exit_Block
End If
If CurrentLockCaption(IsVersion97()) = cMenuCaptionLock Then
p4cmd = "lock"
SuccessString = " locking"
Else
p4cmd = "unlock"
SuccessString = "unlocking"
End If
RunP4Command CmdTitleResult, p4cmd, SuccessString, ConfirmDialog:=False
Exit_Block:
Exit Sub
Error_Block:
t.Report
End Sub
' ExpandKeywords/unExpandKeywords - menu command
Public Sub P4Office_ExpandKeywords()
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "P4Office_ExpandKeywords")
Const CmdTitle = "P4OFC - ExpandKeywords/UnExpandKeywords Document"
Const CmdTitleResult = "P4OFC - Confirmation of ExpandKeywords/UnExpandKeywords Document"
Dim p4cmd As String
Dim SuccessString As String
If m_OfficeApp.NoCurrDoc() Then GoTo Exit_Block
If Not ValidServerVersion() Then
InvalidServerMsg CmdTitle
GoTo Exit_Block
End If
If Len(m_OfficeApp.GetCurrDocPath()) = 0 Then
MsgBox "Can't ExpandKeywords for an unsaved document!", vbOKOnly + vbExclamation, CmdTitle
GoTo Exit_Block
End If
If CurrentExpandKeywordsCaption(IsVersion97()) = cMenuCaptionExpandKeywords Then
m_OfficeApp.KeywordPropertiesCreate
Else
If m_OfficeApp.KeywordPropertiesExist Then
m_OfficeApp.KeywordPropertiesDelete
End If
End If
Exit_Block:
Exit Sub
Error_Block:
t.Report
End Sub
' Revert currently open file
Private Sub RevertAndReopenFile(Added As Boolean)
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "RevertAndReopenFile")
Dim path As String
path = m_OfficeApp.GetCurrDocPathname
If Not Added Then
m_OfficeApp.CloseCurrDoc False
End If
m_FileJustReverted = True
' Save revert command to run after close has done
If m_OfficeApp.UseDelayedEvent() Then
Dim de As DelayedEvent
Set de = New DelayedEvent
de.InitRevert m_App, m_OfficeApp, Added, path
m_OfficeApp.SaveDelayedEvent de
Else
m_OfficeApp.RevertImmediate Added, path
End If
End Sub
' function to detect if we are in Office97 (instead of 2000)
Public Function IsVersion97() As Boolean
IsVersion97 = m_OfficeApp.IsVersion97()
End Function
' function to detect if we are in Office2000 (instead of 97)
Public Function IsVersion2000() As Boolean
IsVersion2000 = m_OfficeApp.IsVersion2000()
End Function
Public Function IsVersionXP() As Boolean
IsVersionXP = m_OfficeApp.IsVersionXP()
End Function
Public Function IsVersionXPOrGreater() As Boolean
IsVersionXPOrGreater = m_OfficeApp.IsVersionXPOrGreater()
End Function
Public Function IsVersion2010OrGreater() As Boolean
IsVersion2010OrGreater = m_OfficeApp.IsVersion2010OrGreater()
End Function
Public Function IsVersionXPOr2003() As Boolean
IsVersionXPOr2003 = m_OfficeApp.IsVersionXPOr2003()
End Function
Public Function IsExcel() As Boolean
IsExcel = m_OfficeApp.IsExcel()
End Function
Public Function IsWord() As Boolean
IsWord = m_OfficeApp.IsWord()
End Function
Public Function IsPowerPoint() As Boolean
IsPowerPoint = m_OfficeApp.IsPowerPoint()
End Function
Public Sub CreatePerforceMenu(Optional bStartup As Boolean = False)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "CreatePerforceMenu")
CreateMenu bOffice97:=False, bStartup:=bStartup
Exit Sub
Error_Block:
t.Report
End Sub
Public Sub CreatePerforceMenu97()
' This is the version to be called from Office97
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "CreatePerforceMenu97")
' Make sure we are not trying to create a menu which already exists...
If Not IsVersion97() Then Exit Sub
CreateMenu bOffice97:=True, bStartup:=False
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub CreateMenu(bOffice97 As Boolean, bStartup As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "CreateMenu")
Dim Action As String
Dim MenuName As String
Dim ti As TemplateInfo
If Not bOffice97 And m_OfficeApp.EmbeddedDocument() Then Exit Sub
MenuName = MainMenuBarName()
Set ti = New TemplateInfo
ti.SaveContext m_App, m_OfficeApp
If Not bOffice97 Then
If IsWord() Then
Set WordApp = m_App
ElseIf IsExcel() Then
Set ExcelApp = m_App
Else
Set PowerPointApp = m_App
End If
End If
' Put as 3rd menu from end
Dim Offset As Integer
Offset = m_App.CommandBars(MenuName).Controls.Count
If Offset > 2 Then
Offset = Offset - 2
End If
If bOffice97 Then
On Error Resume Next
' Try and find existing menu or create
Set PerforceMenu97 = m_App.CommandBars(MenuName).Controls(PerforceMenuName)
If err <> 0 Then
GStacker.Clear
err.Clear
On Error GoTo Error_Block
Set PerforceMenu97 = m_App.CommandBars(MenuName).Controls.Add( _
Type:=msoControlPopup, Before:=Offset, Temporary:=True)
Else
On Error GoTo Error_Block
End If
If PerforceMenu97.Caption <> PerforceMenuName Then PerforceMenu97.Caption = PerforceMenuName
If PerforceMenu97.Tag <> PerforceMenuName Then PerforceMenu97.Tag = PerforceMenuName
If IsWord() Then
Action = cActionMacro
Else
Action = "!" & cActionMacro
End If
If PerforceMenu97.OnAction <> Action Then PerforceMenu97.OnAction = Action
If Not PerforceMenu97.Visible Then PerforceMenu97.Visible = True
Else
Dim TempButton As Office.CommandBarButton
Set TempButton = CreateMenuItem(PerforceMenuName, BeforeOffset:=Offset, Menu:=m_App.CommandBars(MenuName))
' Having created the menu item we can assign to our main var which will
' then respond to events
Set PerforceMenuButton = TempButton
Set TempButton = Nothing
On Error Resume Next
Set PerforcePopupMenu = m_App.CommandBars(PerforcePopupMenuName)
If err <> 0 Then
GStacker.Clear
err.Clear
On Error GoTo Error_Block
Set PerforcePopupMenu = m_App.CommandBars.Add(Position:=msoBarPopup, Temporary:=True)
PerforcePopupMenu.Name = PerforcePopupMenuName ' For use in testing via automation - just needs to be unique
End If
End If
If bOffice97 Then
' Create the perforce menu entries
CreateMenuItem97 cMenuCaptionAdd, cMenuTagAdd
CreateMenuItem97 cMenuCaptionEdit, cMenuTagEdit
CreateMenuItem97 cMenuCaptionSubmit, cMenuTagSubmit
' Lock item might exist already...
CreateMenuItem97 CurrentLockCaption(True), cMenuTagLock
CreateMenuItem97 CurrentExpandKeywordsCaption(True), cMenuTagExpandKeywords
CreateMenuItem97 cMenuCaptionRevert, cMenuTagRevert
CreateMenuItem97 cMenuCaptionResults, cMenuTagResults, True
CreateMenuItem97 cMenuCaptionFstat, cMenuTagFstat
CreateMenuItem97 cMenuCaptionHistory, cMenuTagHistory
If g_p4interface.IsWord() Then
CreateMenuItem97 cMenuCaptionDiff, cMenuTagDiff
End If
CreateMenuItem97 cMenuCaptionOpened, cMenuTagOpened
CreateMenuItem97 cMenuCaptionInfo, cMenuTagInfo
CreateMenuItem97 cMenuCaptionOpenFromPerforce, cMenuTagOpenFromPerforce, True
CreateMenuItem97 cMenuCaptionOptions, cMenuTagOptions, True
CreateMenuItem97 cMenuCaptionHelp, cMenuTagHelp
CreateMenuItem97 cMenuCaptionAbout, cMenuTagAbout
Else
' Create the perforce menu entries for Office2k and above
Set AddMenuItem = CreateMenuItem(cMenuCaptionAdd)
Set CheckOutMenuItem = CreateMenuItem(cMenuCaptionEdit)
Set SubmitMenuItem = CreateMenuItem(cMenuCaptionSubmit)
Set LockMenuItem = CreateMenuItem(cMenuCaptionLock, UseIndex:=LockMenuItem)
Set ExpandKeywordsMenuItem = CreateMenuItem(cMenuCaptionExpandKeywords, UseIndex:=ExpandKeywordsMenuItem)
Set RevertMenuItem = CreateMenuItem(cMenuCaptionRevert)
Set LastCommandMenuItem = CreateMenuItem(cMenuCaptionResults, True)
Set FstatMenuItem = CreateMenuItem(cMenuCaptionFstat)
Set HistoryMenuItem = CreateMenuItem(cMenuCaptionHistory)
If IsWord() Then
Set DiffMenuItem = CreateMenuItem(cMenuCaptionDiff)
End If
Set OpenedMenuItem = CreateMenuItem(cMenuCaptionOpened)
Set InfoMenuItem = CreateMenuItem(cMenuCaptionInfo)
Set OpenFromPerforceMenuItem = CreateMenuItem(cMenuCaptionOpenFromPerforce, True)
Set OptionsMenuItem = CreateMenuItem(cMenuCaptionOptions, True)
Set HelpMenuItem = CreateMenuItem(cMenuCaptionHelp)
Set AboutMenuItem = CreateMenuItem(cMenuCaptionAbout)
' Decide on button states
EnDisablePerforceMenuItems False, bStartup:=bStartup
End If
ti.RestoreContext
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub PerforceMenuButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "PerforceMenuButton_Click")
Dim Left As Integer
Dim Top As Integer
' Instead of just executing PerforcePopupMenu.ShowPopup
' we create a delayed event to do that so that we can exit this event handler
' before it happens and the menu button events will fire....
If m_OfficeApp.EmbeddedDocument() Then Exit Sub
' Save these values as Ctrl may get reset by CreatePerforceMenu
Left = Ctrl.Left
Top = Ctrl.Top + Ctrl.Height - 1
CreatePerforceMenu
Dim de As DelayedEvent
Set de = New DelayedEvent
de.InitMenuPopup m_App, m_OfficeApp, PerforcePopupMenu, Left, Top
m_OfficeApp.SaveDelayedEvent de
Exit Sub
Error_Block:
t.Report
End Sub
' Add item to the Perforce menu - Office 2k and above
Private Function CreateMenuItem(Caption As String, _
Optional bBeginGroup As Boolean = False, Optional BeforeOffset As Integer = 0, _
Optional UseIndex As Office.CommandBarButton, Optional Menu As Office.CommandBar) _
As Office.CommandBarButton
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "CreateMenuItem")
If IsMissing(Menu) Or Menu Is Nothing Then
Set Menu = PerforcePopupMenu
End If
On Error Resume Next
If IsMissing(UseIndex) Or UseIndex Is Nothing Then
Set CreateMenuItem = Menu.Controls(Caption)
Else
Set CreateMenuItem = Menu.Controls(UseIndex.Index)
End If
If err <> 0 Then
GStacker.Clear
err.Clear
On Error GoTo 0
If BeforeOffset = 0 Then
Set CreateMenuItem = Menu.Controls.Add(msoControlButton, Temporary:=True)
Else
Set CreateMenuItem = Menu.Controls.Add(msoControlButton, Before:=BeforeOffset, Temporary:=True)
End If
Else
On Error GoTo 0
End If
With CreateMenuItem
If .Caption <> Caption Then .Caption = Caption
If .Style <> msoButtonCaption Then .Style = msoButtonCaption
If .Tag <> Caption Then .Tag = Caption
If .OnAction <> "!<" & m_ProgId & ">" Then .OnAction = "!<" & m_ProgId & ">"
If Not .Visible Then .Visible = True
.BeginGroup = bBeginGroup
End With
End Function
' Add item to the Perforce menu
Private Sub CreateMenuItem97(Caption As String, Tag As String, _
Optional bBeginGroup As Boolean = False)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "CreateMenuItem97")
Dim NewMenuItem
Dim Action As String
' Only change the values if they are different (avoid changing menu items
' unneccesarily since it requires saving of Normal.dot or equivalent).
On Error Resume Next
Set NewMenuItem = PerforceMenu97.Controls(Caption)
If err <> 0 Then
GStacker.Clear
err.Clear
On Error GoTo Error_Block
Set NewMenuItem = PerforceMenu97.Controls.Add(msoControlButton, 1, Tag)
Else
On Error GoTo Error_Block
End If
With NewMenuItem
If .Caption <> Caption Then .Caption = Caption
If .Style <> msoButtonCaption Then .Style = msoButtonCaption
If .Tag <> Caption Then .Tag = Caption
If IsWord() Then
Action = cActionMacro
Else
Action = "!" & cActionMacro
End If
If .OnAction <> Action Then .OnAction = Action
If Not .Visible Then .Visible = True
.BeginGroup = bBeginGroup
End With
Exit Sub
Error_Block:
End Sub
' Handle a menu event - called from Office97 template
Public Sub MenuEvents97(Tag As String, Caption As String)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "MenuEvents97")
Dim bolSaved As Boolean
Dim bNotEntryError As Boolean '''If an error is raised in a called routine. It can incorrectly bobble here.
' Handle the set menu quickly then exit.
If Caption = PerforceMenuName Then
' In here we can chose to do Item enabling depending on status
Set PerforceMenu97 = m_App.CommandBars(MainMenuBarName()).Controls(PerforceMenuName)
EnDisablePerforceMenuItems bOffice97:=True
GoTo Exit_Block
End If
' Passed the entry point of routine.
bNotEntryError = True
Select Case Tag
Case cMenuTagAdd
P4Office_Add
Case cMenuTagEdit
P4Office_Edit
Case cMenuTagOpened
P4Office_Opened
Case cMenuTagSubmit
P4Office_Submit
Case cMenuTagLock
P4Office_Lock
Case cMenuTagExpandKeywords
P4Office_ExpandKeywords
Case cMenuTagHistory
P4Office_Filelog
Case cMenuTagRevert
P4Office_Revert
Case cMenuTagDiff
P4Office_Diff
Case cMenuTagFstat
P4Office_Fstat
Case cMenuTagInfo
P4Office_Info
Case cMenuTagResults
P4Office_DisplayLastCommand
Case cMenuTagOpenFromPerforce
P4Office_OpenFromPerforce
Case cMenuTagOptions
P4Office_Options
Case cMenuTagHelp
P4Office_Help
Case cMenuTagAbout
P4Office_About
End Select
Exit_Block:
Exit Sub
Error_Block:
Select Case err.Number
Case 91
If Not bNotEntryError Then
MsgBox "This macro must be run from the Perforce menu or toolbar.", vbOKOnly
End If
Case Else
t.Report
End Select
End Sub
Public Sub DeletePerforceMenu()
' Tidy up menus to ensure they're not floating around for next time
Dim ti As TemplateInfo
On Error Resume Next ' Don't care about errors
Set ti = New TemplateInfo
ti.SaveContext m_App, m_OfficeApp
If IsVersion97() Then
PerforceMenu97.Delete
Else
PerforceMenuButton.Delete
AddMenuItem.Delete
CheckOutMenuItem.Delete
OpenedMenuItem.Delete
SubmitMenuItem.Delete
LockMenuItem.Delete
ExpandKeywordsMenuItem.Delete
HistoryMenuItem.Delete
RevertMenuItem.Delete
If IsWord() Then
DiffMenuItem.Delete
End If
FstatMenuItem.Delete
InfoMenuItem.Delete
LastCommandMenuItem.Delete
OptionsMenuItem.Delete
AboutMenuItem.Delete
PerforcePopupMenu.Delete
' Word seems to leave blank menu item
If IsWord() Then
m_App.CommandBars(MainMenuBarName()).Controls(PerforceMenuName).Delete
End If
End If
ti.RestoreContext
err.Clear
GStacker.Clear
End Sub
Private Sub AddMenuItem_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "AddMenuItem_Click")
P4Office_Add
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub DiffMenuItem_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "DiffMenuItem_Click")
P4Office_Diff
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub CheckOutMenuItem_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "CheckOutMenuItem_Click")
P4Office_Edit
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub LockMenuItem_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "LockMenuItem_Click")
P4Office_Lock
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub ExpandKeywordsMenuItem_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "ExpandKeywordsMenuItem_Click")
P4Office_ExpandKeywords
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub FstatMenuItem_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "FstatMenuItem_Click")
P4Office_Fstat
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub AboutMenuItem_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "AboutMenuItem_Click")
P4Office_About
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub HelpMenuItem_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "HelpMenuItem_Click")
P4Office_Help
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub HistoryMenuItem_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "HistoryMenuItem_Click")
P4Office_Filelog
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub InfoMenuItem_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "InfoMenuItem_Click")
P4Office_Info
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub LastCommandMenuItem_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "LastCommandMenuItem_Click")
P4Office_DisplayLastCommand
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub OpenedMenuItem_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "OpenedMenuItem_Click")
P4Office_Opened
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub OpenFromPerforceMenuItem_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "OpenFromPerforceMenuItem_Click")
P4Office_OpenFromPerforce
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub OptionsMenuItem_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "OptionsMenuItem_Click")
P4Office_Options
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub RevertMenuItem_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "RevertMenuItem_Click")
P4Office_Revert
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub SubmitMenuItem_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "SubmitMenuItem_Click")
P4Office_Submit
Exit Sub
Error_Block:
t.Report
End Sub
' The follow procedures are to do with trapping Application open events for
' Word/Excel/PowerPoint
Private Sub CheckOpen(ByVal Doc As Object)
' We check for the document being readonly
' if so, we have a look to see if it is in Perforce, and then
' ask the user if they want to open it for editing.
P4Office_CheckFile
End Sub
Private Sub ExcelApp_WorkbookOpen(ByVal Doc As Workbook)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "ExcelApp_WorkbookOpen")
Debug.Print "Excel DocumentOpen Event"
CheckOpen Doc
Exit_Block:
Exit Sub
Error_Block:
t.Report
Resume Exit_Block
End Sub
Private Sub PowerPointApp_PresentationOpen(ByVal Doc As Presentation)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "PowerPointApp_PresentationOpen")
Debug.Print "PowerPoint DocumentOpen Event"
CheckOpen Doc
Exit_Block:
Exit Sub
Error_Block:
t.Report
Resume Exit_Block
End Sub
Private Sub WordApp_DocumentOpen(ByVal Doc As Document)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "WordApp_DocumentOpen")
Debug.Print "Word DocumentOpen Event"
CheckOpen Doc
Exit_Block:
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub PowerPointApp_PresentationClose(ByVal Pres As PowerPoint.Presentation)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "PowerPointApp_PresentationClose")
Dim Cancel As Boolean
CheckClose Pres, Cancel
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub ExcelApp_WorkbookBeforeClose(ByVal Wb As excel.Workbook, Cancel As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "ExcelApp_WorkbookBeforeClose")
CheckClose Wb, Cancel
Exit Sub
Error_Block:
t.Report
End Sub
Private Sub CheckClose(Doc As Object, Cancel As Boolean)
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "CheckClose")
Const CmdTitle = "P4OFC - Checkin On Close"
Dim Answer As Integer
Dim f As Fstat
Dim CurrDocPath As String
Dim CancelSave As Boolean ' Whether to cancel save dialog - for Powerpoint
On Error GoTo Error_Block
Cancel = False
CancelSave = False
m_CloseCancelled = True
If m_OfficeApp.m_FileClosing Then
m_OfficeApp.m_FileClosing = False
GoTo Exit_Block
End If
CurrDocPath = m_OfficeApp.GetCurrDocPath()
If Len(CurrDocPath) = 0 Then
GoTo Exit_Block
End If
Dim CheckInOnClose As OptionsValue
CheckInOnClose = RegOptions.CheckInOnClose
If CheckInOnClose <> Never Then
' Check if we should try and communicate with the server
Dim p4 As P4COM.p4
ChDir CurrDocPath
Set p4 = NewP4
If HideConnectionWarning(p4.port) Then
GoTo Exit_Block
End If
If Not ValidServerVersion() Then
GoTo Exit_Block
End If
Set f = New Fstat
' Powerpoint fires this event after doc has been closed...
If IsPowerPoint() Then
f.Initialize m_OfficeApp, "", Doc.FullName
Else
f.Initialize m_OfficeApp
End If
f.Run
If Len(f.Action) > 0 Then
Answer = vbYes
If Not Doc.Saved Then
Dim Msg As String
Msg = "Do you want to save the changes to " & Doc.Name & "?"
Answer = MessageBoxW(0, StrPtr(Msg), StrPtr(CmdTitle), vbYesNoCancel + vbExclamation)
If Answer = vbYes Then
Doc.Save
CancelSave = IsPowerPoint()
ElseIf Answer = vbNo Then
If IsPowerPoint() Then
SendKeys "n" ' Answer prompt with No - dodgy hack!!
Else
Doc.Saved = True ' Avoid real save prompt
End If
ElseIf Answer = vbCancel Then
Cancel = True
m_CloseCancelled = True
If IsPowerPoint() Then
SendKeys "{Esc}" ' Answer Cancel to prompt dialog
End If
End If
End If
If Doc.Saved And Answer <> vbNo Then
If CheckInOnClose = Always Then
DoSubmit ReopenDoc:=False, f:=f, CancelSave:=CancelSave
ElseIf CheckinOnCloseForm.Answer() = vbOK Then
DoSubmit ReopenDoc:=False, f:=f, CancelSave:=CancelSave
End If
End If
End If
End If
Exit_Block:
Exit Sub
Error_Block:
If err.Number <> 68 Then ' Ignore Device Unavailable error
t.Report
End If
Exit Sub
End Sub
Private Sub WordApp_DocumentBeforeClose(ByVal Doc As Document, Cancel As Boolean)
On Error GoTo Error_Block
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "WordApp_DocumentBeforeClose")
Const CmdTitle = "P4OFC - Checkin On Close"
Dim Answer As Integer
CheckClose Doc, Cancel
Exit_Block:
Exit Sub
Error_Block:
t.Report
End Sub
Public Sub EnDisablePerforceMenuItems(bOffice97 As Boolean, Optional bStartup As Boolean = False)
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "EnDisablePerforceMenuItems")
Dim f As Fstat
Dim InPerforce As Boolean
Dim IsOpen As Boolean
Dim CanLock As Boolean
Dim CanUnlock As Boolean
Dim CanExpandKeywords As Boolean
Dim CanUnexpandKeywords As Boolean
Dim ServerVersion As Long
Dim ti As TemplateInfo
Set ti = New TemplateInfo
ti.SaveContext m_App, m_OfficeApp
' check if there is the menu items exist and exit if not
If Not IsVersion97() Then
If HelpMenuItem Is Nothing Then
GoTo Exit_Block
End If
End If
Set f = New Fstat
f.Initialize m_OfficeApp
' Do initial connection in seperate form in case of timeouts etc.
Dim p4 As P4COM.p4
Set p4 = NewP4
If Not HideConnectionWarning(p4.port) And Not bStartup Then
If ConnectForm.Connect Then
f.Run
End If
End If
' First check if in Perforce (and indeed if a proper file at all)
' Only do this if the server version is valid - otherwise leave at defaults
InPerforce = False
IsOpen = False
If Not (Len(f.DepotFile) = 0 And f.HaveRev = 0) Then
If f.HeadRev <> 0 Then
InPerforce = True
End If
End If
' Now check if opened for some action
If Len(f.Action) <> 0 Then
IsOpen = True
If f.LockType = OurLock Then
CanUnlock = True
ElseIf f.LockType = NoLock Then
CanLock = True
End If
If m_OfficeApp.KeywordPropertiesExist Then
CanUnexpandKeywords = True
Else
CanExpandKeywords = True
End If
End If
' The following are the default values
EnDisableItem bOffice97, cMenuCaptionAdd, False
EnDisableItem bOffice97, cMenuCaptionEdit, False
EnDisableItem bOffice97, cMenuCaptionOpened, Not f.Error
EnDisableItem bOffice97, cMenuCaptionSubmit, False
EnDisableItem bOffice97, cMenuCaptionRevert, False
EnDisableItem bOffice97, cMenuCaptionHistory, False
EnDisableItem bOffice97, cMenuCaptionFstat, False
If IsWord() Then
EnDisableItem bOffice97, cMenuCaptionDiff, False
End If
EnDisableItem bOffice97, cMenuCaptionOpenFromPerforce, True
EnDisableItem bOffice97, cMenuCaptionInfo, True
EnDisableItem bOffice97, cMenuCaptionResults, True
EnDisableItem bOffice97, cMenuCaptionHelp, True
EnDisableItem bOffice97, cMenuCaptionAbout, True
EnDisableLockStatus bOffice97, CanLock, CanUnlock
EnDisableExpandKeywordsStatus bOffice97, CanExpandKeywords, CanUnexpandKeywords
If IsOpen Then
' Open means also in Perforce
EnDisableItem bOffice97, cMenuCaptionSubmit, True
If f.HeadRev <> 0 Then
EnDisableItem bOffice97, cMenuCaptionHistory, True
End If
EnDisableItem bOffice97, cMenuCaptionFstat, True
EnDisableItem bOffice97, cMenuCaptionRevert, True
If IsWord() And f.Action <> "add" Then
EnDisableItem bOffice97, cMenuCaptionDiff, True
End If
Else
' Not opened
If InPerforce Then
EnDisableItem bOffice97, cMenuCaptionEdit, True
EnDisableItem bOffice97, cMenuCaptionHistory, True
EnDisableItem bOffice97, cMenuCaptionFstat, True
If IsWord() And f.Action <> "add" Then
EnDisableItem bOffice97, cMenuCaptionDiff, True
End If
Else
If Not m_OfficeApp.NoCurrDoc() And f.HaveRev = 0 Then
EnDisableItem bOffice97, cMenuCaptionAdd, True
End If
End If
End If
Exit_Block:
ti.RestoreContext
End Sub
Private Sub EnDisableItem(bOffice97 As Boolean, MenuCaption As String, EnDisable As Boolean)
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "EnDisableItem")
If bOffice97 Then
PerforceMenu97.Controls(MenuCaption).Enabled = EnDisable
Else
PerforcePopupMenu.Controls(MenuCaption).Enabled = EnDisable
End If
End Sub
Private Sub EnDisableLockStatus(bOffice97 As Boolean, CanLock As Boolean, CanUnlock As Boolean)
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "EnDisableLockStatus")
Dim NewCaption As String
Dim CurrCaption As String
Dim EnDisable As Boolean
EnDisable = False
CurrCaption = CurrentLockCaption(bOffice97)
NewCaption = CurrCaption
If CanLock Then
NewCaption = cMenuCaptionLock
EnDisable = True
ElseIf CanUnlock Then
NewCaption = cMenuCaptionUnlock
EnDisable = True
End If
If bOffice97 Then
DumpMenu
PerforceMenu97.Controls(CurrCaption).Enabled = EnDisable
PerforceMenu97.Controls(CurrCaption).Caption = NewCaption
DumpMenu
Else
PerforcePopupMenu.Controls(LockMenuItem.Index).Enabled = EnDisable
PerforcePopupMenu.Controls(LockMenuItem.Index).Caption = NewCaption
End If
If GStacker.Tracing Then
GStacker.TraceMsg "NewLockCaption: " & NewCaption
End If
End Sub
Private Sub EnDisableExpandKeywordsStatus(bOffice97 As Boolean, CanExpandKeywords As Boolean, CanUnexpandKeywords As Boolean)
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "EnDisableExpandKeywordsStatus")
Dim NewCaption As String
Dim CurrCaption As String
Dim EnDisable As Boolean
EnDisable = False
CurrCaption = CurrentExpandKeywordsCaption(bOffice97)
NewCaption = CurrCaption
If CanExpandKeywords Then
NewCaption = cMenuCaptionExpandKeywords
EnDisable = True
ElseIf CanUnexpandKeywords Then
NewCaption = cMenuCaptionUnexpandKeywords
EnDisable = True
End If
If bOffice97 Then
DumpMenu
PerforceMenu97.Controls(CurrCaption).Enabled = EnDisable
PerforceMenu97.Controls(CurrCaption).Caption = NewCaption
DumpMenu
Else
PerforcePopupMenu.Controls(ExpandKeywordsMenuItem.Index).Enabled = EnDisable
PerforcePopupMenu.Controls(ExpandKeywordsMenuItem.Index).Caption = NewCaption
End If
If GStacker.Tracing Then
GStacker.TraceMsg "NewExpandKeywordsCaption: " & NewCaption
End If
End Sub
Private Sub DumpMenu()
' Debugging utility
If GStacker.Tracing Then
Dim i As Integer
Dim Msg As String
For i = 1 To PerforceMenu97.Controls.Count
If InStr(1, PerforceMenu97.Controls(i).Caption, "ock") > 0 Then
Msg = Msg & "|" & PerforceMenu97.Controls(i).Caption
End If
Next
GStacker.TraceMsg "SetLockCaption - menus: " & Msg
End If
End Sub
Private Function CurrentLockCaption(bOffice97 As Boolean) As String
If bOffice97 Then
On Error Resume Next
CurrentLockCaption = PerforceMenu97.Controls(cMenuCaptionLock).Caption
If err.Number <> 0 Then
If GStacker.Tracing Then
GStacker.TraceMsg "LockCaption: unlock"
End If
GStacker.Clear
err.Clear
Else
If GStacker.Tracing Then
GStacker.TraceMsg "LockCaption: lock"
End If
End If
Else
CurrentLockCaption = PerforcePopupMenu.Controls(LockMenuItem.Index).Caption
If GStacker.Tracing Then
GStacker.TraceMsg "LockCaption: " & CurrentLockCaption
End If
End If
End Function
Private Function CurrentExpandKeywordsCaption(bOffice97 As Boolean) As String
If bOffice97 Then
On Error Resume Next
CurrentExpandKeywordsCaption = PerforceMenu97.Controls(cMenuCaptionExpandKeywords).Caption
If err.Number <> 0 Then
If GStacker.Tracing Then
GStacker.TraceMsg "ExpandKeywordsCaption: unExpandKeywords"
End If
GStacker.Clear
err.Clear
Else
If GStacker.Tracing Then
GStacker.TraceMsg "ExpandKeywordsCaption: ExpandKeywords"
End If
End If
Else
CurrentExpandKeywordsCaption = PerforcePopupMenu.Controls(ExpandKeywordsMenuItem.Index).Caption
If GStacker.Tracing Then
GStacker.TraceMsg "ExpandKeywordsCaption: " & CurrentExpandKeywordsCaption
End If
End If
End Function
Private Sub SetVisibleMenuItem(bOffice97 As Boolean, MenuCaption As String, Value As Boolean)
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "SetVisibleMenuItem")
If bOffice97 Then
PerforceMenu97.Controls(MenuCaption).Visible = Value
Else
PerforcePopupMenu.Controls(MenuCaption).Visible = Value
End If
End Sub
Private Function MainMenuBarName() As String
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "MainMenuBarName")
MainMenuBarName = "Menu Bar"
If IsExcel() Then
MainMenuBarName = "Worksheet Menu Bar"
End If
End Function
Private Function CommandSuccessful(Result As Long, InfoArr() As String, SuccessString As String) As Boolean
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "CommandSuccessful")
Dim i As Integer
Dim Docname As String
CommandSuccessful = False
If Result = 0 Then
Docname = m_OfficeApp.GetCurrDocName()
If Not IsEmptyArray(InfoArr) Then
If UBound(InfoArr) >= 0 Then
i = LBound(InfoArr)
If (InStr(1, InfoArr(i), Docname) <> 0) And _
(InStr(1, InfoArr(i), SuccessString) <> 0) Then
CommandSuccessful = True
End If
End If
End If
End If
End Function
Private Sub DoFstat()
If m_Fstat Is Nothing Then
Set m_Fstat = New Fstat
m_Fstat.Initialize m_OfficeApp
End If
m_Fstat.Run
End Sub
Private Sub ServerVersionCheck()
If m_ServerVersions Is Nothing Then
Set m_ServerVersions = New Collection
If GStacker.Tracing Then
GStacker.TraceMsg "ServerVersion: new collection"
End If
End If
End Sub
Private Function ServerVersion(p4 As P4COM.p4)
Dim ver As Long
On Error Resume Next
ServerVersionCheck
ServerVersion = 0
ver = m_ServerVersions(p4.port)
If err.Number = 0 Then
GStacker.Clear
err.Clear
If GStacker.Tracing Then
GStacker.TraceMsg "Previous ServerVersion: " & p4.port & " " & CStr(ver)
End If
ServerVersion = ver
End If
err.Clear
End Function
Private Sub ServerVersionAdd(p4 As P4COM.p4)
Dim ver As Long
ver = p4.ServerVersion
If ver <> 0 Then
m_ServerVersions.Add ver, p4.port
If GStacker.Tracing Then
GStacker.TraceMsg "New ServerVersion: " & p4.port & " " & CStr(ver)
End If
End If
End Sub
Public Sub ServerVersionStore(p4 As P4COM.p4)
If ServerVersion(p4) = 0 Then
ServerVersionAdd p4
End If
End Sub
Private Function ValidServerVersion() As Boolean
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "ValidServerVersion")
Const cMinServerVersion = 11 ' Equates to 2001.1 server
Dim ver As Long
Dim p4 As P4COM.p4
ValidServerVersion = False
Set p4 = NewP4
ver = ServerVersion(p4)
If ver <> 0 Then
ValidServerVersion = (ver <= 0 Or ver >= cMinServerVersion)
Else
' Not found so we need to talk to server and then read value
If HideConnectionWarning(p4.port) Then
ValidServerVersion = True
Exit Function
End If
On Error Resume Next
p4.ExceptionLevel = 0
p4.Connect
InitP4 p4
If err.Number <> 0 Then
GStacker.Clear
err.Clear
ValidServerVersion = True
Else
On Error GoTo Error_Block
Dim InfoArr() As String
InfoArr = p4.Run("info")
ServerVersionAdd p4
ver = p4.ServerVersion
ValidServerVersion = (ver <= 0 Or ver >= cMinServerVersion)
p4.Disconnect
End If
End If
Exit Function
Error_Block:
Exit Function
End Function
Private Sub InvalidServerMsg(ByVal CmdTitle As String)
Dim Msg As String
Dim p4 As P4COM.p4
Set p4 = NewP4
Msg = "Cannot perform operation: the Perforce server running at " & p4.port & vbCrLf & _
" is below the minimum version required by P4OFC (2001.1)."
MsgBox Msg, vbExclamation + vbOKOnly, CmdTitle
End Sub
Public Sub SaveConnectionWarning(ByVal port As String)
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "SaveConnectionWarning")
Dim p As String
' Check for already stored
On Error Resume Next
p = m_ConnectionWarnings(port)
If err.Number = 0 Then
Exit Sub
End If
m_ConnectionWarnings.Add "1", port
GStacker.Clear
err.Clear
End Sub
Public Function HideConnectionWarning(ByVal port As String) As Boolean
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "HideConnectionWarning")
Dim p As String
HideConnectionWarning = False
On Error Resume Next
p = m_ConnectionWarnings(port) = "1"
If err.Number = 0 Then
HideConnectionWarning = True
End If
GStacker.Clear
err.Clear
End Function
Public Function ShellExecute(LocalFileName As String)
Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "ShellExecute")
m_OfficeApp.ShellExecute LocalFileName
End Function
| # | Change | User | Description | Committed | |
|---|---|---|---|---|---|
| #2 | 11201 | Robert Cowham |
Do better Word diffing in Word 2010 or greater by using the Merge method rather than Compare method. Compare gave more obvious results for older versions of Office. |
||
| #1 | 10843 | Robert Cowham |
Initial version of P4OFC source code. See README.txt (and LICENSE.txt and doc\P4OFC-Design.docx) |