这篇文章没有引起人们的兴趣（只有 23 个视图:( ），所以我花了一些时间编写自己的类来将 PSR 集成到我的应用程序中。
我不得不调整我的代码（它是一个更大项目的一部分），并且我必须将评论从意大利语翻译成英语，但以下应该可以工作（或需要最少的更改）：
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
如果您有我同样的需求，希望对您有所帮助。享受。