vbAccelerator - Contents of code file: frmStartupDemo.frm

VERSION 5.00
Begin VB.Form frmStartupDemo 
   Caption         =   "Startup and Command Line Passing Demo"
   ClientHeight    =   3990
   ClientLeft      =   2955
   ClientTop       =   2550
   ClientWidth     =   6555
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmStartupDemo.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   3990
   ScaleWidth      =   6555
   Begin VB.TextBox txtDemo 
      Height          =   2535
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Text            =   "frmStartupDemo.frx":27A2
      Top             =   1080
      Width           =   6375
   End
   Begin VB.Label lblInfo 
      Caption         =   $"frmStartupDemo.frx":27AC
      Height          =   675
      Left            =   120
      TabIndex        =   2
      Top             =   60
      Width           =   6195
   End
   Begin VB.Label lblCurrent 
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   780
      Width           =   6315
   End
End
Attribute VB_Name = "frmStartupDemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Implements ISubclass
Private m_emr As EMsgResponse


Private Sub ParseCommand(ByVal sCmd As String)
Dim sFIle As String
Dim iFIle As Long
Dim sText As String

   ' If you are running as a systray app and your
   ' main window is hidden, then restore it (not
   ' applicable in this simple app):
   If (Me.Visible = False) Then
      Me.Visible = True
   End If
   
   ' Bring me to the foreground and restore
   ' if iconic:
   RestoreAndActivate Me.hwnd
   ' Your function to parse the command line:
   sCmd = Trim$(sCmd)
   ' for debugging:
   If Len(sCmd) > 0 Then
      If (Left$(sCmd, 1) = """") Then
         sCmd = Mid$(sCmd, 2)
      End If
      If (Right$(sCmd, 1) = """") Then
         sCmd = Left$(sCmd, Len(sCmd) - 1)
      End If
      On Error GoTo ErrorHandler
      sFIle = Dir(sCmd, vbNormal)
      ' for debugging:
      lblCurrent = sCmd
      ' We have a file:
      iFIle = FreeFile
      Open sCmd For Binary Access Read As #iFIle
      sText = Space$(LOF(iFIle))
      Get #iFIle, , sText
      Close #iFIle
      iFIle = 0
      txtDemo.Text = sText
   End If
   Exit Sub
   
ErrorHandler:
Dim sErr As String
   sErr = Err.Description
   If (iFIle <> 0) Then
      Close #iFIle
   End If
   MsgBox "An error occurred: " & sErr, vbExclamation
   Exit Sub
   
End Sub

Private Sub Form_Load()
Dim sPath As String

   sPath = App.Path
   If (Right$(sPath, 1) <> "\") Then sPath = sPath & "\"
   sPath = sPath & App.EXEName & ".exe"

   ' Create an association with this program to
   ' .VAS files:
   Dim cR As New cRegistry
   ' Create an open association, and set the file icon to be the icon with
    resource id 24 within
   ' the executable (note that resource id 1 is the exe's icon):
   cR.CreateEXEAssociation sPath, "StartupDemo.StartUpFile", "vbAccelerator
    StartUp Demo", "VAS", lDefaultIconIndex:=1
   ' Create a customised right click menu item in explorer to allow the file
   ' to be opened with Notepad...
   cR.CreateAdditionalEXEAssociations "StartupDemo.StartUpFile", "Notepad",
    "Open with &Notepad", "NOTEPAD.EXE ""%1"""
   
   ' Start subclassing:
   AttachMessage Me, Me.hwnd, WM_COPYDATA
   
   ' Tell the startup module to tag this window:
   TagWindow Me.hwnd
   
   ' If we have a command line, then parse it:
   ParseCommand Command
   
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   ' stop subclassing:
   DetachMessage Me, Me.hwnd, WM_COPYDATA
   ' clear up mutex...
   EndApp
End Sub

Private Sub Form_Resize()
   On Error Resume Next
   txtDemo.Move txtDemo.Left, txtDemo.Top, Me.ScaleWidth - txtDemo.Left * 2,
    Me.ScaleHeight - txtDemo.Top - 8 * Screen.TwipsPerPixelY
End Sub

Private Property Let ISubclass_MsgResponse(ByVal RHS As EMsgResponse)
   ' This shouldn't really be in SSUBTMR.
   ' In fact, SSUBTMR should have a BeforeMessage and AfterMessage
   ' function if it was going to be easier to use.
   ' Sometime....
End Property

Private Property Get ISubclass_MsgResponse() As EMsgResponse
   ' This will tell you which message you are responding to:
   ' WM_COPYDATA, send response after we've done with it:
   ISubclass_MsgResponse = emrPostProcess
   
End Property

Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long,
 ByVal wParam As Long, ByVal lParam As Long) As Long
Dim tCDS As COPYDATASTRUCT
Dim b() As Byte
Dim sCommand As String

   Select Case iMsg
   Case WM_COPYDATA
      ' Copy for processing:
      CopyMemory tCDS, ByVal lParam, Len(tCDS)
      If (tCDS.cbData > 0) Then
         ReDim b(0 To tCDS.cbData - 1) As Byte
         CopyMemory b(0), ByVal tCDS.lpData, tCDS.cbData
         sCommand = StrConv(b, vbUnicode)
         
         ' We've got the info, now do it:
         ParseCommand sCommand
      Else
         ' no data.  This is only sent by the main
         ' module if it detects this window is hidden.
         ' since this can't occur in this project,
         ' this won't occur.  However, in a project
         ' where your main window can be hidden, you
         ' would make your window visible and activate
         ' it here.
      End If
      
   End Select
   
End Function