在 VB.NET 应用程序中集成 PSR

Question

由于 PSR（问题步骤记录器）不能被认为是一种广泛使用的工具，我正在考虑将它集成到我的 VB.NET 应用程序中。

它可能是一个有用的工具，可以帮助您了解用户如何解决问题并重现问题和错误。更多关于 PSR 的信息：http://blogs.msdn.com/b/patricka/archive/2010/01/04/using-the-secret-windows-7-problem-step-recorder-to-create-step-by-step-screenshot-documents.aspx

我认为将它集成到应用程序中将有助于用户使用它，即使他们可能不知道它的存在，并帮助维护者获得有关用户如何遇到问题的更多信息。

是否有人已经做过这样的事情，可能使用 VB.NET？

建议？

提前致谢。

Answer 1

这篇文章没有兴趣（只有 23 次浏览 :( ），所以我花了一些时间编写自己的类以将 PSR 集成到我的应用程序中。

我必须调整我的代码（它是一个更大项目的一部分），并且我必须将 cmets 从意大利语翻译成英语，但以下应该可以工作（或需要最少的更改）：

Public Class clsPSRDemo
Private WithEvents prcPSR As New Process
Private i32TimeSpent As Int32
Private bEventHandled As Boolean
Friend Event Exited As EventHandler

''' <summary>
''' Tracks User action using PSR and send the file obtained through email
''' </summary>
''' <remarks>AA20140801 - ☮ Andrea Antonangeli per © Octet - Ingegneria dei Sistemi - S.r.l.</remarks>
Friend Function TrackActions() As String
    Dim OSVersion As Version = Environment.OSVersion.Version
    Dim Win7Version As Version = Version.Parse("6.1.7600")
    Dim strFilePSR As String = My.Computer.FileSystem.SpecialDirectories.MyDocuments & "\MyProject\PSRFile" & Format(Now, "yyyyMMdd_HHmmss") & ".zip"   'Change this depending on your needs
    Const i32Timeout As Int32 = 600000 '(10 minuti)
    Const i32SleepInterval As Int32 = 200   '(0,2 secondi)

    i32TimeSpent = 0
    bEventHandled = False
    Try
        'Check Windows version
        If OSVersion.CompareTo(Win7Version) < 0 Then
            MessageBox.Show("You must have Windows 7 or newer", "Unusable function", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
            Return "Err: SO too old"
            Exit Function
        End If
        Dim strPSRPath As String = Environment.GetFolderPath(Environment.SpecialFolder.System) & "\psr.exe "
        'Check if psr.exe exists (should always be true, but who knows...)
        If IO.File.Exists(strPSRPath) = False Then
            MessageBox.Show("Could not find file 'psr.exe' in folder " & Environment.GetFolderPath(Environment.SpecialFolder.System), "Funzione non utilizzabile", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Return "Err: PSR not found"
            Exit Function
        End If
        'Start PSR and check event when finished
        prcPSR.StartInfo.FileName = strPSRPath
        prcPSR.StartInfo.CreateNoWindow = True
        prcPSR.StartInfo.Arguments = " /start /maxsc 50 /exitonsave 1 /output " & strFilePSR
        prcPSR.EnableRaisingEvents = True
        prcPSR.Start()
    Catch ex As Exception
        MessageBox.Show("Error executing PSR." & ex.Message, "Retry.")
        Return "Err: PSR excepion " & ex.Message
    End Try
    'Wait for "Exited" event for the time specified in i32Timeout (10 minutes)
    Do While Not bEventHandled
        i32TimeSpent += i32SleepInterval
        If i32TimeSpent > i32Timeout Then
            MessageBox.Show("Timeout (10 minutes). We stop tracking", "Operazion not completed", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
            prcPSR.CloseMainWindow()
            prcPSR.Close()
            Return "Err: Timeout"
            Exit Function
        End If
        Application.DoEvents()
        System.Threading.Thread.Sleep(i32SleepInterval)
    Loop
    MessageBox.Show("Thanks, your steps have been recorded and now we are sending them through email", "Operation completed", MessageBoxButtons.OKCancel, MessageBoxIcon.Information, MessageBoxDefaultButton.Button1)
    Dim strMsgUscita As String = String.Empty
    Try
        Dim MailTicket As New clsMandaMail
        With MailTicket
            .Mittente = frmOpzioni.prpMailMittente
            .MandoCC = .Mittente    'Metto il mittente in copia 
            .MandoA = "supportosocrate@octet.it"
            .Soggetto = "Messaggio TAS del " & Now.ToString & " eseguito da " & objOctetLib.DimmiNomeUtente & " da computer " & objOctetLib.DimmiNomeQuestoComputer
        End With
        'La creo
        Dim mailToBeSent As New Net.Mail.MailMessage("yourUserMail@hisdomain.com", "yoursupportmail@yourdomain.it", "PSR file attached", "Check the .zip file attached")
        If Not IO.File.Exists(strFilePSR) Then
            MessageBox.Show("Il file " & strFilePSR & " was NOT found." & vbCrLf & "Check folder " & My.Computer.FileSystem.SpecialDirectories.MyDocuments & "\MyProject & and send it to support manually", "PSR file not found.", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
            strMsgUscita = "Err: PDR file not found"
            Return strMsgUscita
            Exit Function
        End If
        Dim PSRAttachment As New Net.Mail.Attachment(strFilePSR)
        mailToBeSent.Attachments.Add(PSRAttachment)
        'Sending
        Dim MailClient As New Net.Mail.SmtpClient("CustomerFavoriteSMTPServer")
        MailClient.UseDefaultCredentials = True
        MailClient.Send(mailToBeSent)
    Catch ex As Exception
        MessageBox.Show("Error sending mail " & ex.Message, "Error.", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
        strMsgUscita = "Err: mail NOT sent"
    End Try
    Return strMsgUscita
End Function

'Exited event 
Private Sub prcPSR_Exited(ByVal sender As Object, ByVal e As System.EventArgs) Handles prcPSR.Exited
    bEventHandled = True
    Debug.Print("Exited at " & prcPSR.ExitTime & " code " & prcPSR.ExitCode)
End Sub  
End Class

如果您有我的相同需求，希望对您有所帮助。享受吧。