Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Option Explicit
Dim objXmlHttpMain,URL,Title,FromLine,ToLine,fso,Readfile,strBuff,InputFile,TotalNbLines,strJSONToSend, emailObj, emailConfig
Title = "DataSender Crash Reporter"
SendCrashReportMail()
Public Function CrashReportFromLogFile
InputFile = "c:\Program Files\Lely\T4C\CDS\Datasender\Trace\DataSenderService.trace.log"
Set fso = CreateObject("Scripting.FileSystemObject")
Set Readfile = Fso.OpenTextFile(InputFile,1)
strBuff = Readfile.ReadAll
TotalNbLines = Readfile.Line
FromLine = Round(TotalNbLines - (TotalNbLines * 0.2))
Readfile.Close
CrashReportFromLogFile = ExtractLinesFromTextFile(InputFile,FromLine, TotalNbLines)
End Function
Public Function ExtractLinesFromTextFile(ByRef TextFile, ByRef FromLine, ByRef ToLine)
Const TristateUseDefault = -2
On Error Resume Next
If FromLine <= ToLine Then
With CreateObject("Scripting.FileSystemObject").OpenTextFile(TextFile,1,true,TristateUseDefault)
If Err.number <> 0 Then
'MsgBox err.description,16,err.description
Exit Function
Else
Do Until .Line = FromLine Or .AtEndOfStream
.SkipLine
Loop
Do Until .Line > ToLine Or .AtEndOfStream
ExtractLinesFromTextFile = ExtractLinesFromTextFile & (.ReadLine & vbNewLine)
Loop
End If
End With
Else
'MsgBox "Error to Read Line in TextFile", vbCritical,"Error to Read Line in TextFile"
End If
End Function
Public Function SendCrashReport()
strJSONToSend = "{'LicenseKey': 'V5QFF-HH9RQ-KAH35-FMTJH-JCYLV', 'StackTrace': '"+ CrashReportFromLogFile +"'}"
URL="http://localhost:15357/api/quest/add"
Set objXmlHttpMain = CreateObject("Msxml2.ServerXMLHTTP")
on error resume next
objXmlHttpMain.open "POST",URL, False
objXmlHttpMain.setRequestHeader "Content-Type", "application/json"
objXmlHttpMain.send strJSONToSend
set objJSONDoc = nothing
set objResult = nothing
End Function
Public Function SendCrashReportMail()
Set emailObj = CreateObject("CDO.Message")
emailObj.From = "mail@cankemik.com"
emailObj.To = "alican.kemikoglu@triodor.eu"
emailObj.Subject = "DataSender Crash | V5QFF-HH9RQ-KAH35-FMTJH-JCYLV"
emailObj.TextBody = CrashReportFromLogFile
Set emailConfig = emailObj.Configuration
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.yandex.com"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = true
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "mail@cankemik.com"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "<password>"
emailConfig.Fields.Update
emailObj.Send
If err.number = 0 then Msgbox "Done"
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.