VERSION 5.00
Object = "{0722C825-2406-11D3-AA78-DF8855C10005}#1.0#0"; "XMCOMM.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form HpLdr 
   Caption         =   "HP Serial Transmitter"
   ClientHeight    =   5730
   ClientLeft      =   2415
   ClientTop       =   1800
   ClientWidth     =   5685
   LinkTopic       =   "Form1"
   ScaleHeight     =   5730
   ScaleWidth      =   5685
   Begin MSComctlLib.ProgressBar ProgressBar1 
      Height          =   465
      Left            =   120
      TabIndex        =   15
      Top             =   5115
      Width           =   5415
      _ExtentX        =   9551
      _ExtentY        =   820
      _Version        =   393216
      BorderStyle     =   1
      Appearance      =   1
      Max             =   1.00000e5
   End
   Begin VB.CommandButton RawReceiveButton 
      Caption         =   "Receive File"
      Height          =   435
      Left            =   135
      TabIndex        =   14
      Top             =   4470
      Width           =   2175
   End
   Begin VB.VScrollBar PortScroll 
      Height          =   390
      Left            =   3180
      Max             =   5
      TabIndex        =   6
      Top             =   3930
      Value           =   3
      Width           =   210
   End
   Begin VB.TextBox Port 
      Alignment       =   2  'Center
      Height          =   285
      Left            =   2880
      Locked          =   -1  'True
      TabIndex        =   12
      TabStop         =   0   'False
      Text            =   "2"
      Top             =   3975
      Width           =   285
   End
   Begin XMCom.XMComm Comm 
      Height          =   255
      Left            =   5445
      TabIndex        =   7
      Top             =   4170
      Width           =   315
      _ExtentX        =   556
      _ExtentY        =   450
      PacketTimeout   =   1
      PackCharacter   =   26
      MaxErrors       =   10
      DisplayStatus   =   -1  'True
      Settings        =   "9600,n,8,1"
      CommPort        =   2
      Handshaking     =   0
      InputBufferSize =   32767
      InputLength     =   32767
      InputMode       =   0
      NullDiscard     =   0   'False
      OutputBufferSize=   512
      ParityReplace   =   "?"
      OnCommReceiveThreshold=   0
      RTSEnable       =   0   'False
      OnCommSendThreshold=   0
      EnableCancel    =   0   'False
      Object.Top             =   4170
      Object.Left            =   5445
      Object.Height          =   255
      Object.Width           =   315
   End
   Begin VB.CommandButton CancelButton 
      Caption         =   "Stop Transfer"
      Height          =   420
      Left            =   2490
      TabIndex        =   5
      Top             =   4485
      Width           =   1830
   End
   Begin VB.CommandButton SendButton 
      Caption         =   "Send File to HP PTR"
      Height          =   450
      Left            =   135
      TabIndex        =   4
      Top             =   3900
      Width           =   2175
   End
   Begin VB.FileListBox FileBox 
      Height          =   3015
      Left            =   2820
      TabIndex        =   3
      Top             =   675
      Width           =   2715
   End
   Begin VB.DirListBox DirBox 
      Height          =   3015
      Left            =   135
      TabIndex        =   2
      Top             =   675
      Width           =   2565
   End
   Begin VB.TextBox Filename 
      Height          =   315
      Left            =   960
      TabIndex        =   1
      Top             =   180
      Width           =   4545
   End
   Begin VB.Label ByteText 
      Alignment       =   2  'Center
      Height          =   210
      Left            =   4470
      TabIndex        =   13
      Top             =   4575
      Width           =   990
   End
   Begin VB.Label Label5 
      Caption         =   "Port"
      Height          =   225
      Left            =   2520
      TabIndex        =   11
      Top             =   4020
      Width           =   330
   End
   Begin VB.Label Label4 
      Caption         =   "EOF"
      Height          =   195
      Left            =   5070
      TabIndex        =   10
      Top             =   4110
      Width           =   345
   End
   Begin VB.Label Label3 
      Caption         =   "Sending"
      Height          =   210
      Left            =   4290
      TabIndex        =   9
      Top             =   4095
      Width           =   585
   End
   Begin VB.Label Label2 
      Caption         =   "Waiting"
      Height          =   225
      Left            =   3645
      TabIndex        =   8
      Top             =   4095
      Width           =   645
   End
   Begin VB.Shape EofLED 
      BackColor       =   &H000000FF&
      BackStyle       =   1  'Opaque
      Height          =   210
      Left            =   5130
      Shape           =   3  'Circle
      Top             =   3840
      Width           =   180
   End
   Begin VB.Shape SendLED 
      BackColor       =   &H00FFFF00&
      BackStyle       =   1  'Opaque
      Height          =   210
      Left            =   4485
      Shape           =   3  'Circle
      Top             =   3840
      Width           =   180
   End
   Begin VB.Shape WaitLED 
      BackColor       =   &H0000FF00&
      BackStyle       =   1  'Opaque
      Height          =   210
      Left            =   3825
      Shape           =   3  'Circle
      Top             =   3840
      Width           =   180
   End
   Begin VB.Label Label1 
      Caption         =   "Filename:"
      Height          =   225
      Left            =   195
      TabIndex        =   0
      Top             =   285
      Width           =   750
   End
End
Attribute VB_Name = "HpLdr"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'HpLoader - Old HP Serial File Transmitter
'(c)2002 Terry Newton, original version 1-9-02
'After selecting file and clicking send, app
'waits for "!" from serial then sends next byte
'repeats until cancel is clicked or eof reached.
'1-12-02 - better blinky lights, added byte counter,
'saves ini file with port setting and last directory
'5-27-02 - added raw receive (raw send does nothing)
'6-23-02 - added "are you sure?" for overwrites
'7-26-02 - removed raw send button, relabeled others
'8-3-02 - added progress bar
'10-11-02 - optimizations

Dim CancelFlag As Boolean
Dim Sending As Boolean
Dim Receiving As Boolean
Dim FileChanged As Boolean

Private Sub CancelButton_Click()
 CancelFlag = True
 CancelButton.Enabled = False
End Sub

Private Sub DirBox_Change()
 On Error Resume Next
 FileBox.Path = DirBox.Path
 FileBox.Filename = "*.*"
 Filename.Text = ""
 SendButton.Enabled = False
 FileChanged = True
End Sub

Private Sub FileBox_Click()
 If Len(DirBox.Path) = 3 Then
  Filename.Text = DirBox.Path + FileBox.Filename
 Else
  Filename.Text = DirBox.Path + "\" + FileBox.Filename
 End If
 SendButton.Enabled = True
 RawReceiveButton.Enabled = True
 FileChanged = True
End Sub

Private Sub Filename_Change()
 SendButton.Enabled = False
 RawReceiveButton.Enabled = True
 FileChanged = True
End Sub

Private Sub Filename_KeyPress(KeyAscii As Integer)
 Dim Temp As String
 Dim i As Integer
 Dim LastSlash As Integer
 On Error Resume Next
 If KeyAscii = 13 Then
 'this part is tricky, update dir and file boxes
 'when new name is entered.. if exists highlight it
 'and enable send button. Probably not bug-free...
  Temp = Filename.Text
  LastSlash = 0
  For i = 1 To Len(Temp)
   If Mid$(Temp, i, 1) = "\" Then LastSlash = i
  Next i
  If LastSlash > 0 Then
   If Mid(Temp, 2, 1) = ":" And LastSlash = 3 Then
    DirBox.Path = Left$(Temp, LastSlash - 1) + "\"
   Else
    DirBox.Path = Left$(Temp, LastSlash - 1)
   End If
   FileBox.Path = Left$(Temp, LastSlash - 1)
   If LastSlash <> Len(Temp) Then
    FileBox.Filename = Mid$(Temp, LastSlash + 1)
    If LCase$(FileBox.Filename) = LCase$(Mid$(Temp, LastSlash + 1)) Then
     SendButton.Enabled = True
    End If
   Else
    FileBox.Filename = "*.*"
   End If
  End If
 End If
End Sub

Private Sub Form_Load()
 Dim HeaderValid As Boolean
 Dim iniLineCount As Integer
 Dim iniLine$
 Dim tempstr$
 SendButton.Enabled = False
 RawReceiveButton.Enabled = False
 CancelButton.Enabled = False
 'when filename becomes valid then send button
 'is enabled, when send clicked send button is
 'disabled and cancel button enabled
 Sending = False
 Receiving = False
 FileChanged = False
 WaitLED.BackStyle = 0 'transparent
 SendLED.BackStyle = 0
 EofLED.BackStyle = 0
 ProgressBar1.Max = 100000
 ProgressBar1.Value = 0
 'see if ini file available
 On Error Resume Next
 Open "HpLoader.ini" For Input As #1
 If Err.Number = 0 Then
  iniLineCount = 0
  iniLine$ = ""
  HeaderValid = False
  While Not EOF(1) And iniLineCount < 1000 'avoid bad-file hang
   Line Input #1, iniLine$
   If HeaderValid = True And _
     Left$(iniLine$, 1) = "[" Then HeaderValid = False
   If iniLine$ = "[HpLoader]" Then HeaderValid = True
   iniLineCount = iniLineCount + 1
   If HeaderValid Then
    If Left$(iniLine$, 9) = "CommPort=" Then
     tempstr$ = Mid$(iniLine, 10, 1)
     If tempstr$ >= "1" And tempstr$ <= "4" Then
      Port.Text = tempstr$
       PortScroll.Value = 5 - Val(tempstr$)
     End If
    End If
    If Left$(iniLine$, 8) = "LastDir=" Then
     tempstr$ = Mid$(iniLine, 9)
     If Mid$(tempstr$, 2, 2) = ":\" Then
      DirBox.Path = tempstr$
      FileBox.Path = tempstr$
     End If
    End If
   End If
  Wend
 End If
 Close #1
End Sub

Private Sub Form_Unload(Cancel As Integer)
 If Sending Then
  Cancel = 1
  MsgBox "HpLoader ©2002 Terry Newton" + vbCrLf + _
         "Cancel before exiting program."
 Else
  'save ini file
  On Error Resume Next
  Open "HpLoader.ini" For Output As #1
  If Err.Number = 0 Then
   Print #1, "[HpLoader]"
   Print #1, "CommPort="; Port.Text
   Print #1, "LastDir="; DirBox.Path
  End If
  Close #1
 End If
End Sub

Private Sub PortScroll_Change()
 If PortScroll.Value < 1 Then PortScroll.Value = 1
 If PortScroll.Value > 4 Then PortScroll.Value = 4
 Port.Text = Trim$(Str(5 - PortScroll.Value))
 ' 1 to 4 becomes 4 to 1 to make up and down
 ' buttons work like they should
End Sub

Private Sub RawReceiveButton_Click()
 Dim Ok As Boolean
 Dim Rv As Integer
 Dim Fname As String
 Dim Bcount As Integer
 Dim Waiting As Boolean
 Dim CommInput$
 On Error Resume Next
 If Not Receiving And Not Sending Then
  Receiving = True
  SendButton.Enabled = False
  RawReceiveButton.Enabled = False
  Fname = Filename.Text
  If Len(Fname) > 0 Then
   If Mid(Fname, 2, 1) <> ":" Then
    Fname = DirBox.Path & "\" & Fname
   End If
   Open Fname For Input As #1
   Ok = False
   If Err.Number > 0 Then Ok = True
   Close #1
   If Ok = False Then
    Rv = MsgBox("Overwrite?", vbYesNo, "File Exists")
    If Rv = vbYes Then Ok = True
   End If
   If Ok Then
    Err.Number = 0
    Open Fname For Output As #1
    If Err.Number > 0 Then
     MsgBox "can't open file"
    Else
     Comm.CommPort = Val(Port.Text)
     Comm.PortOpen = True
     If Comm.PortOpen = False Then
      MsgBox "Can't open comm port"
     Else
      FlickVal = 20  'delay lighting wait
      FlickCount = 0
      Bcount = 0
      CancelFlag = False
      CancelButton.Enabled = True
      While Not CancelFlag
       ByteText.Caption = Str(Bcount)
       Waiting = True
       While Waiting And Not CancelFlag
        If FlickCount = FlickVal Then
         FlickCount = FlickCount + 1 'do it once
         WaitLED.BackStyle = 1 'opaque to "light"
         SendLED.BackStyle = 0 'turn off send light
        Else
         FlickCount = FlickCount + 1
        End If
        DoEvents
        CommInput$ = Comm.InputData
        If CommInput$ <> "" Then
         Waiting = False
        End If
       Wend
       If FlickCount > 0 Then
        SendLED.BackStyle = 1
        WaitLED.BackStyle = 0
        FlickCount = 0
       End If
       Print #1, CommInput$;
       Bcount = Bcount + Len(CommInput$)
      Wend
      ByteText.Caption = ""
      SendLED.BackStyle = 0
      WaitLED.BackStyle = 0
     End If 'can open comm port
    End If 'can open
    Close #1
   End If 'Ok
  End If 'len > 0
  Receiving = False
  RawReceiveButton.Enabled = True
  CancelButton.Enabled = False
 End If 'not rec and not sending
End Sub

Private Sub SendButton_Click()
 Dim MyByte As Byte
 Dim CommInput$
 Dim Waiting As Boolean
 Dim FlickVal As Integer
 Dim FlickCount As Integer
 Dim ByteNumber As Long
 Dim FileSize As Long
 On Error Resume Next
 If Not Sending And Not Receiving Then
  'if navigating to new file while
  'sending when selected send button will be reenabled,
  'must avoid send action until current send has closed
  '(otherwise would have to disable file selection)
  Sending = True
  FileChanged = False
  SendButton.Enabled = False
  RawReceiveButton.Enabled = False
  FlickVal = 20  'delay lighting wait
  FlickCount = 0
  ByteNumber = 0
  ByteCount = 0
  Open Filename.Text For Binary As #1
  If Err.Number > 0 Then
   MsgBox "Can't open file"
  Else
   FileSize = LOF(1)
   ProgressBar1.Value = 0
   ProgressBar1.Max = FileSize
   Comm.CommPort = Val(Port.Text)
   Comm.PortOpen = True
   If Comm.PortOpen = False Then
    MsgBox "Can't open comm port"
   Else
    CancelFlag = False
    CancelButton.Enabled = True
    While Not EOF(1) And Not CancelFlag
     Get #1, , MyByte
     If Not EOF(1) Then 'in VB EOF fires after attempt
      'wait for "!"
      Waiting = True
      While Waiting And Not CancelFlag
       If FlickCount = FlickVal Then
        FlickCount = FlickCount + 1 'do it once
        WaitLED.BackStyle = 1 'opaque to "light"
        SendLED.BackStyle = 0 'turn off send light
       Else
        FlickCount = FlickCount + 1
       End If
       DoEvents
       CommInput$ = Comm.InputData
       If CommInput$ <> "" Then
        If Right$(CommInput$, 1) = "!" Then
         Waiting = False
        End If
       End If
      Wend
      'send MyByte
      If Not CancelFlag Then
       If FlickCount > 0 Then 'do it once
        SendLED.BackStyle = 1
        WaitLED.BackStyle = 0
        FlickCount = 0
       End If
       ByteCount = ByteCount + 1
       If ByteCount = 50 Then 'do every 50 times
        ByteNumber = ByteNumber + ByteCount
        ByteCount = 0
        KiloBytes = Int(ByteNumber / 102.4) / 10
        ByteText.Caption = Str$(KiloBytes) + "K"
        ProgressBar1.Value = ByteNumber
       End If
       Comm.Output = Chr$(MyByte)
      End If
     End If 'not eof
    Wend 'not eof and not cancelflag
    WaitLED.BackStyle = 0
    SendLED.BackStyle = 0
    If EOF(1) Then
     EofLED.BackStyle = 1
     'wait for cancel
     While Not CancelFlag
      DoEvents
     Wend
     EofLED.BackStyle = 0
    End If
   End If 'commport open errorcheck
   Comm.PortOpen = False
  End If 'open errorcheck
  Close #1
  Sending = False
  ByteText.Caption = ""
  If Not FileChanged Then
   SendButton.Enabled = True
   RawReceiveButton.Enabled = True
  End If
 End If 'not sending
End Sub

'end of VB source