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