DOCUMENT:Q258144 01-MAY-2001 [ssafe] TITLE :HOWTO: Get a List of All Pinned Files from OLE Automation in VB PRODUCT :Microsoft SourceSafe PROD/VER::5.0,6.0 OPER/SYS: KEYWORDS:kbAutomation kbSSafe500 kbSSafe600 kbDSupport kbGrpDSSSafe ====================================================================== ------------------------------------------------------------------------------- The information in this article applies to: - Microsoft Visual SourceSafe for Windows, versions 5.0, 6.0 ------------------------------------------------------------------------------- SUMMARY ======= Visual SourceSafe OLE Automation does not expose any pinning functionality directly, so there is no direct way to tell if a file is pinned from OLE Automation. This article provides sample code to work around this problem and retrieve this information. MORE INFORMATION ================ The following sample assumes that you have a Microsoft Visual Basic project, and that when you want to get the path information, you call the CheckPaths routine. This sample can easily be modified to take a project as a parameter, or to do something other than output the results with Debug.Print. ' Used to store VSSItem Objects. Public objVSSObject As VSSItem Public objVSSProject As VSSItem ' This routine begins the printing of all items that are pinned. Public Sub CheckPaths() ' Set On Error routine. On Error GoTo ErrHandler ' Used as a reference to the VSS database. Dim objVSSDatabase As New VSSDatabase ' Used to store the VSS Username, password and SrcSafe.ini data. Dim UserName As String Dim SrcSafeIni As String Dim Password As String ' Set up the username, password, database path. UserName = "Admin" Password = "" SrcSafeIni = "C:\Program Files\Microsoft Visual Studio\Common\VSS60a\srcsafe.ini" ' Attempt to log into SourceSafe. objVSSDatabase.Open SrcSafeIni, UserName, Password ' Create VSS Database object and set current item to $/ (root project). Set objVSSProject = objVSSDatabase.VSSItem("$/", False) ' Set the current project. objVSSDatabase.CurrentProject = objVSSProject.Spec ' Check for pinned files in this project. Call Links(objVSSProject) ' Iterate through all items in current project (false means ignore deleted items). For Each objVSSObject In objVSSProject.Items(False) ' Check to see what type of object we have. Select Case objVSSObject.Type ' Current item is a project. Case 0 ' Call procedure to check for existing sub projects of this ' project. Call CheckSubProjects(objVSSObject) ' Current Object is a file. Case 1 ' Do nothing for files. ' Unknown object type. Case Else MsgBox ("Unknown object type encountered!") End Select Next ' Inform the user that we are finished. MsgBox "All Done" Set objVSSProject = Nothing Set objVSSObject = Nothing Set objVSSDatabase = Nothing Exit Sub ErrHandler: Response = MsgBox(Err.Description, vbExclamation, "VSS") Err.Clear Set objVSSProject = Nothing Set objVSSObject = Nothing Set objVSSDatabase = Nothing End Sub ' This routine is passed a project item as a parameter. It checks for existing ' sub projects in the passed project and calls the links function to check for ' pinned files in this project. Public Sub CheckSubProjects(objVSSProject As VSSItem) Dim i As Integer ' Check for pinned files in this project. Call Links(objVSSProject) ' Iterate through each item of the project (false means ignore deleted). For Each objVSSObject In objVSSProject.Items(False) ' Check to see what type of object we have. Select Case objVSSObject.Type ' Current item is a project. Case 0 i = DoEvents Call CheckSubProjects(objVSSObject) ' Current Object is a file. Case 1 ' Do nothing for files ' Unknown object type. Case Else MsgBox ("Unknown object type encountered!") End Select Next End Sub Private Sub Links(objVSSFile As VSSItem) Dim objVSSVersion As VSSVersion Dim UnpinArray() As String Dim i As Integer Dim j As Integer Dim found As Boolean ' Set up array to store each time we get an unpin event. ReDim UnpinArray(40) i = 1 found = False ' Loop through the projects events to see if we find a pin or unpin event. For Each objVSSVersion In objVSSFile.Versions If Left(objVSSVersion.Action, 6) = "Pinned" Then ' Check whether we already have an unpin event for this file. ' Because we are going through history from most recent to oldest, ' if we don't have an unpin event now, the file is pinned. For j = 1 To i If InStr(1, objVSSVersion.Action, UnpinArray(j), vbTextCompare) > 0 And UnpinArray(j) <> "" Then ' Found an unpin event; the file is not pinned. found = True End If Next ' If we didn't find an unpin event, print out the pin event that has the ' filename and version it is pinned at. If found = False Then Debug.Print objVSSVersion.Action End If ElseIf Left(objVSSVersion.Action, 8) = "Unpinned" Then ' Store the unpin event in our array. UnpinArray(i) = Right(objVSSVersion.Action, Len(objVSSVersion.Action) - 10) i = i + 1 End If Next Set objVSSVersion = Nothing End Sub REFERENCES ========== http://msdn.microsoft.com/library/default.asp?URL=/library/techart/vssauto.htm Q257989 HOWTO: Pin and Unpin Files in SourceSafe from OLE Automation in Visual C++ Additional query words: ====================================================================== Keywords : kbAutomation kbSSafe500 kbSSafe600 kbDSupport kbGrpDSSSafe Technology : kbSSafeSearch kbAudDeveloper kbSSafe600 kbSSafe500 Version : :5.0,6.0 Issue type : kbhowto ============================================================================= THE INFORMATION PROVIDED IN THE MICROSOFT KNOWLEDGE BASE IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND. MICROSOFT DISCLAIMS ALL WARRANTIES, EITHER EXPRESS OR IMPLIED, INCLUDING THE WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT SHALL MICROSOFT CORPORATION OR ITS SUPPLIERS BE LIABLE FOR ANY DAMAGES WHATSOEVER INCLUDING DIRECT, INDIRECT, INCIDENTAL, CONSEQUENTIAL, LOSS OF BUSINESS PROFITS OR SPECIAL DAMAGES, EVEN IF MICROSOFT CORPORATION OR ITS SUPPLIERS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. SOME STATES DO NOT ALLOW THE EXCLUSION OR LIMITATION OF LIABILITY FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES SO THE FOREGOING LIMITATION MAY NOT APPLY. Copyright Microsoft Corporation 2001.