'FILE DESCRIPTION: Test and sample macros
Option Explicit


Sub EnumDocuments()
'DESCRIPTION: Displays all open documents
  ' To view the output messages of this macro, open the Output Window and
  '  select the "Macro" tab
  Dim doc
  For Each doc In Documents
    PrintToOutputWindow doc.FullName
  Next
End Sub


Sub EnumWindows()
'DESCRIPTION: Displays all open windows
  ' To view the output messages of this macro, open the Output Window and
  '  select the "Macro" tab
  Dim win
  For Each win In Windows
    PrintToOutputWindow win.Caption
  Next
End Sub


Sub SendMail()
'DESCRIPTION: Sends a test email via Outlook
  Dim outlook
On Error Resume Next
  Set outlook = CreateObject("Outlook.Application")
  If outlook Is Nothing Then
    MsgBox "Microsoft Outlook is not installed!",,"SendMail"
    Exit Sub
  End If
On Error GoTo 0
  Dim mail
  Dim outbox
  Dim mapi
  Dim recipient
  Dim address
  address = "email@example.com"
  address = InputBox("Send a test email to:", "SendMail", address)
  If address = "" Then
    Exit Sub
  End If
  Set mapi = outlook.GetNameSpace("MAPI")
  Set outbox = mapi.GetDefaultFolder(4)
  Set mail = outbox.Items.Add(0)
  Set recipient = mail.Recipients.Add(address)
  recipient.Type = 1
  mail.Subject = "Test"
  mail.Body = "This is a PCAN-Explorer 6 macro test."
  mail.Send
End Sub


Sub CreateOutputPane()
'DESCRIPTION: Creates a new pane in the Output window  
  Dim win
  Dim OutputWin
  Dim pane
  Set win = Windows(peWindowKindOutput)
  win.IsVisible = True
  Set OutputWin = win.Object
  Set pane = OutputWin.OutputWindowPanes("My pane")
  If pane Is Nothing Then
    Set pane = OutputWin.OutputWindowPanes.Add("My pane")
  End If
  pane.Activate  'Make pane visible
  pane.OutputString("This is a text" & vbCrLf)
End Sub


Sub NewClientSend()
'DESCRIPTION: Sends CAN messages using a new PCAN client
  Dim UseConn, conn
  ' Find the first enabled connection in the project that uses the CAN protocol
  Set UseConn = Nothing
  For Each conn In Connections
    If conn.IsEnabled And conn.Protocol = peProtocolCAN Then
      Set UseConn = conn
      Exit For
    End If
  Next 
  If UseConn Is Nothing Then
    MsgBox "Project does not contain any enabled CAN connections"
    Exit Sub
  End If

  ' Create a new client and connect it to the same Net that the
  '  found connection uses
  Dim MyClient, PcanConn
  Set MyClient = CreateObject("PCAN4.PCANClient")
  MyClient.Device = UseConn.Device
  MyClient.Name = "Macro"
  Set PcanConn = MyClient.Connections.Add(UseConn.CommunicationObject.NetName)

  ' Now create and initialize a new transmit message
  Dim msg, timestamp, i
  Set msg = MyClient.Messages.Add
  timestamp = MyClient.GetSystemTime + 1000
  With msg
    .ID = &H100
    .DLC = 4
    .MsgType = pcanMsgTypeExtended
    .Data(0) = &H11
    .Data(1) = &H22
    .Data(2) = &H33
  End With
  for i = 1 To 20
    msg.Data(3) = i
    msg.Write PcanConn, timestamp
    timestamp = timestamp + 500
  next
  ' Wait until all messages have been sent before finishing macro,
  '  since this would terminate the client and delete all messages
  '  that are still in the queue
  While not MyClient.XmtQueueEmpty
    Wait 500
  Wend
  Wait 500
End Sub


Sub WaitForID100()
'DESCRIPTION: Waits until CAN-ID 100h is received
  ' To view the output messages of this macro, open the Output Window and
  '  select the "Macro" tab
  Dim UseConn, conn
  ' Find the first enabled connection in the project that uses the CAN protocol
  Set UseConn = Nothing
  For Each conn In Connections
    If conn.IsEnabled And conn.Protocol = peProtocolCAN Then
      Set UseConn = conn
      Exit For
    End If
  Next 
  If UseConn Is Nothing Then
    MsgBox "Project does not contain any enabled CAN connections"
    Exit Sub
  End If

  ' Create a new client and connect it to the same Net that the
  '  found connection uses
  Dim MyClient, PcanConn
  Set MyClient = CreateObject("PCAN4.PCANClient")
  MyClient.Device = UseConn.Device
  MyClient.Name = "Macro"
  Set PcanConn = MyClient.Connections.Add(UseConn.CommunicationObject.NetName)
  If Not PcanConn.IsConnected Then
    MsgBox "Cannot connect to net " & PcanConn.NetName
    Exit Sub
  End If

  PcanConn.RegisterMsg &H100, &H200, False, False

  Dim RcvMsg, i
  i = 0
  Set RcvMsg = MyClient.Messages.Add
  Do
    Do While Not RcvMsg.Read
      ' Wait for an incoming message
      Wait 1
    Loop
    If RcvMsg.LastError = pcanErrorOk Then
      PrintToOutputWindow "Received!"
      i = i + 1
    End If
  Loop While RcvMsg.ID <> &H100
  PrintToOutputWindow "Finished, " & CStr(i) & " messages received!"
End Sub


Sub LosslessTrace()
'DESCRIPTION: Traces messages without losses and stores the data in multiple trace files
  ' Modify as required
  const DefaultDestDir = "c:\Trace"
  const DefaultConnection = "TestNet@pcan_virtual"
  const MessagesPerTracer = 1000000

  ' Explicit Variable declarations
  Dim CurrentTracer, NextTracer
  Dim doc, wnd
  Dim tracer1, tracer2
  Dim TracerNumber
  Dim IsRunning
  Dim DestDir, Connection

  ' Prompt for the destination directory
  DestDir = InputBox("Destination Directory:", "LosslessTrace", DefaultDestDir)
  If DestDir = "" Then Exit Sub

  ' Make sure the selected directory exists
  Dim fso
  Set fso = CreateObject("Scripting.FileSystemObject")
  If Not fso.FolderExists(DestDir) Then
    MsgBox "The selected directory does not exist!",,"LosslessTrace"
    Exit Sub
  End If

  If ActiveProject Is Nothing Then
    ' Create and configure a new project
    NewProject "LoslessTrace", ""
    ' Prompt for connection
    Connection = InputBox("Select Connection:", "LosslessTrace", DefaultConnection)
    Dim conn
    Set conn = Connections.Add(Connection)
    conn.IsEnabled = True
    If Not conn.IsEnabled Then
      MsgBox "Error while enabling the connection!",,"LosslessTrace"
      Exit Sub
    End If
  End If

  ' Create two tracers, which will be used alternately
  Set doc = Documents.Add(peDocumentKindTrace)
  Set wnd = doc.ActiveWindow
  Set tracer1 = wnd.Object.Tracer
  wnd.Left = 0
  wnd.Top = 0
  wnd.Height = 250
  wnd.Width = 600

  Set doc = Documents.Add(peDocumentKindTrace)
  Set wnd = doc.ActiveWindow
  Set tracer2 = wnd.Object.Tracer
  wnd.Left = 0
  wnd.Top = 250
  wnd.Height = 250
  wnd.Width = 600
  
  Set wnd = Nothing
  Set doc = Nothing

  ' Pre-configure both tracers
  tracer1.BufferType = peTraceBufferTypeFile
  tracer2.BufferType = peTraceBufferTypeFile

  ' Some initializations
  Set CurrentTracer = tracer1  ' Begin with tracer1
  Set NextTracer = tracer2

  TracerNumber = 1
  CurrentTracer.Document.Save DestDir & "\Trace" & TracerNumber & ".trc"
  CurrentTracer.Start
  IsRunning = True

  Do While IsRunning

    ' Tracer records data until the number of tracer entries reaches maximum
    Do While IsRunning And (CurrentTracer.EntryCount < MessagesPerTracer)
      Wait 50
      IsRunning = CurrentTracer.TraceState = peTraceStarted
    Loop
    
    If IsRunning Then
      TracerNumber = TracerNumber + 1
      NextTracer.Clear
      NextTracer.Document.Save DestDir & "\Trace" & TracerNumber & ".trc"
      NextTracer.Start
      CurrentTracer.Stop

      ' Toggle current/next tracers
      If NextTracer Is tracer1 Then
        Set CurrentTracer = tracer1
        Set NextTracer = tracer2
      Else
        Set CurrentTracer = tracer2
        Set NextTracer = tracer1
      End If
    End If

  Loop

End Sub