You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
370 lines
14 KiB
370 lines
14 KiB
VERSION 5.00
|
|
Begin VB.Form frmTestSLnk
|
|
BorderStyle = 4 'Fixed ToolWindow
|
|
Caption = "Tests the IShellLink Typelib Interface."
|
|
ClientHeight = 3780
|
|
ClientLeft = 420
|
|
ClientTop = 720
|
|
ClientWidth = 9195
|
|
LinkTopic = "Form1"
|
|
MaxButton = 0 'False
|
|
MinButton = 0 'False
|
|
ScaleHeight = 3780
|
|
ScaleWidth = 9195
|
|
ShowInTaskbar = 0 'False
|
|
Begin VB.TextBox txtProgramGroup
|
|
Height = 285
|
|
Left = 3120
|
|
TabIndex = 20
|
|
Top = 3300
|
|
Width = 5865
|
|
End
|
|
Begin VB.CommandButton cmdCreateGroup
|
|
Caption = "Create Group"
|
|
Height = 375
|
|
Left = 180
|
|
TabIndex = 18
|
|
Top = 1050
|
|
Width = 1125
|
|
End
|
|
Begin VB.CommandButton cmdGetLinkInfo
|
|
Caption = "GetLinkInfo"
|
|
Height = 375
|
|
Left = 180
|
|
TabIndex = 17
|
|
Top = 540
|
|
Width = 1125
|
|
End
|
|
Begin VB.ComboBox cmbSysFolders
|
|
Height = 315
|
|
Left = 3120
|
|
TabIndex = 16
|
|
Top = 90
|
|
Width = 5865
|
|
End
|
|
Begin VB.CommandButton cmdGetPath
|
|
Caption = "GetSysPath"
|
|
Height = 375
|
|
Left = 1920
|
|
TabIndex = 15
|
|
Top = 60
|
|
Width = 1125
|
|
End
|
|
Begin VB.TextBox txtShowCmd
|
|
Height = 285
|
|
Left = 3120
|
|
TabIndex = 13
|
|
Top = 2895
|
|
Width = 585
|
|
End
|
|
Begin VB.TextBox txtCmdArgs
|
|
Height = 285
|
|
Left = 3120
|
|
TabIndex = 11
|
|
Top = 1740
|
|
Width = 5865
|
|
End
|
|
Begin VB.TextBox txtIconIndex
|
|
Height = 285
|
|
Left = 3120
|
|
TabIndex = 9
|
|
Top = 2505
|
|
Width = 585
|
|
End
|
|
Begin VB.TextBox txtIconFile
|
|
Height = 285
|
|
Left = 3120
|
|
TabIndex = 7
|
|
Top = 2130
|
|
Width = 5865
|
|
End
|
|
Begin VB.TextBox txtWorkDir
|
|
Height = 285
|
|
Left = 3120
|
|
TabIndex = 5
|
|
Top = 1365
|
|
Width = 5865
|
|
End
|
|
Begin VB.TextBox txtExeName
|
|
Height = 285
|
|
Left = 3120
|
|
TabIndex = 3
|
|
Top = 975
|
|
Width = 5865
|
|
End
|
|
Begin VB.TextBox txtLinkName
|
|
Height = 285
|
|
Left = 3120
|
|
TabIndex = 1
|
|
Top = 600
|
|
Width = 5865
|
|
End
|
|
Begin VB.CommandButton cmdCreateLink
|
|
Caption = "CreateLink"
|
|
Height = 345
|
|
Left = 180
|
|
TabIndex = 0
|
|
Top = 60
|
|
Width = 1155
|
|
End
|
|
Begin VB.Label Label1
|
|
AutoSize = -1 'True
|
|
Caption = "Start Menu Group:"
|
|
Height = 195
|
|
Index = 7
|
|
Left = 1770
|
|
TabIndex = 19
|
|
Top = 3360
|
|
Width = 1305
|
|
End
|
|
Begin VB.Label Label1
|
|
AutoSize = -1 'True
|
|
Caption = "Show Command:"
|
|
Height = 195
|
|
Index = 6
|
|
Left = 1860
|
|
TabIndex = 14
|
|
Top = 2940
|
|
Width = 1200
|
|
End
|
|
Begin VB.Label Label1
|
|
AutoSize = -1 'True
|
|
Caption = "Cmd Arguments:"
|
|
Height = 195
|
|
Index = 5
|
|
Left = 1890
|
|
TabIndex = 12
|
|
Top = 1800
|
|
Width = 1155
|
|
End
|
|
Begin VB.Label Label1
|
|
AutoSize = -1 'True
|
|
Caption = "Icon Index:"
|
|
Height = 195
|
|
Index = 4
|
|
Left = 2265
|
|
TabIndex = 10
|
|
Top = 2565
|
|
Width = 795
|
|
End
|
|
Begin VB.Label Label1
|
|
AutoSize = -1 'True
|
|
Caption = "Icon FileName:"
|
|
Height = 195
|
|
Index = 3
|
|
Left = 1965
|
|
TabIndex = 8
|
|
Top = 2175
|
|
Width = 1065
|
|
End
|
|
Begin VB.Label Label1
|
|
AutoSize = -1 'True
|
|
Caption = "Working Directory:"
|
|
Height = 195
|
|
Index = 2
|
|
Left = 1740
|
|
TabIndex = 6
|
|
Top = 1425
|
|
Width = 1320
|
|
End
|
|
Begin VB.Label Label1
|
|
AutoSize = -1 'True
|
|
Caption = "Exe Name:"
|
|
Height = 195
|
|
Index = 1
|
|
Left = 2280
|
|
TabIndex = 4
|
|
Top = 1035
|
|
Width = 780
|
|
End
|
|
Begin VB.Label Label1
|
|
AutoSize = -1 'True
|
|
Caption = "Link Name:"
|
|
Height = 195
|
|
Index = 0
|
|
Left = 2250
|
|
TabIndex = 2
|
|
Top = 660
|
|
Width = 810
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmTestSLnk"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
|
|
'---------------------------------------------------------------
|
|
Private Sub cmdCreateGroup_Click()
|
|
'---------------------------------------------------------------
|
|
MkDir txtProgramGroup.Text ' Create Start Menu Program Group...
|
|
'---------------------------------------------------------------
|
|
End Sub
|
|
'---------------------------------------------------------------
|
|
|
|
'---------------------------------------------------------------
|
|
Private Sub cmdCreateLink_Click()
|
|
'---------------------------------------------------------------
|
|
Dim sLnk As cShellLink ' ShellLink Variable
|
|
'---------------------------------------------------------------
|
|
Set sLnk = New cShellLink ' Create ShellLink Instance
|
|
|
|
sLnk.CreateShellLink txtLinkName.Text, _
|
|
txtExeName.Text, _
|
|
txtWorkDir.Text, _
|
|
txtCmdArgs.Text, _
|
|
txtIconFile.Text, _
|
|
CLng(txtIconIndex.Text), _
|
|
CLng(txtShowCmd.Text) ' Create a ShellLink (ShortCut)
|
|
|
|
Set sLnk = Nothing ' Destroy object reference
|
|
'---------------------------------------------------------------
|
|
End Sub
|
|
'---------------------------------------------------------------
|
|
|
|
'---------------------------------------------------------------
|
|
Private Sub cmdGetLinkInfo_Click()
|
|
'---------------------------------------------------------------
|
|
Dim sLnk As cShellLink ' ShellLink class variable
|
|
Dim LnkFile As String ' Link file name
|
|
Dim ExeFile As String ' Link - Exe file name
|
|
Dim WorkDir As String ' - Working directory
|
|
Dim ExeArgs As String ' - Command line arguments
|
|
Dim IconFile As String ' - Icon File name
|
|
Dim IconIdx As Long ' - Icon Index
|
|
Dim ShowCmd As Long ' - Program start state...
|
|
'---------------------------------------------------------------
|
|
Set sLnk = New cShellLink ' Create new Explorer IShellLink Instance
|
|
|
|
LnkFile = txtLinkName.Text ' Get link file name
|
|
txtExeName.Text = "" ' Clear output variables...
|
|
txtWorkDir.Text = ""
|
|
txtCmdArgs.Text = ""
|
|
txtIconFile.Text = ""
|
|
txtIconIndex.Text = ""
|
|
txtShowCmd.Text = ""
|
|
|
|
sLnk.GetShellLinkInfo LnkFile, _
|
|
ExeFile, _
|
|
WorkDir, _
|
|
ExeArgs, _
|
|
IconFile, _
|
|
IconIdx, _
|
|
ShowCmd ' Get Info for shortcut file...
|
|
|
|
txtLinkName.Text = LnkFile ' Display output...
|
|
txtExeName.Text = ExeFile
|
|
txtWorkDir.Text = WorkDir
|
|
txtCmdArgs.Text = ExeArgs
|
|
txtIconFile.Text = IconFile
|
|
txtIconIndex.Text = Val(IconIdx)
|
|
txtShowCmd.Text = Val(ShowCmd)
|
|
|
|
Set sLnk = Nothing ' Destroy object reference...
|
|
'---------------------------------------------------------------
|
|
End Sub
|
|
'---------------------------------------------------------------
|
|
|
|
'---------------------------------------------------------------
|
|
Private Sub cmdGetPath_Click()
|
|
'---------------------------------------------------------------
|
|
Dim rc As Long ' return code
|
|
Dim sLnk As cShellLink ' ShellLink class object
|
|
Dim sfPath As String ' System folder path
|
|
Dim Id As Long ' ID of System folder...
|
|
'---------------------------------------------------------------
|
|
' Create instance of Explorer's IShellLink Interface Base Class
|
|
Set sLnk = New cShellLink
|
|
|
|
Id = cmbSysFolders.ItemData(cmbSysFolders.ListIndex) ' Get ID from combo box
|
|
If sLnk.GetSystemFolderPath(Me.hWnd, Id, sfPath) Then ' Get system folder path from id
|
|
SetDefaults sfPath ' Update UI with new path
|
|
End If
|
|
|
|
Set sLnk = Nothing ' Destroy object reference
|
|
'---------------------------------------------------------------
|
|
End Sub
|
|
'---------------------------------------------------------------
|
|
|
|
'---------------------------------------------------------------
|
|
Private Sub Form_Load()
|
|
'---------------------------------------------------------------
|
|
SetDefaults (App.Path & "\") ' Update UI with current application path
|
|
|
|
With cmbSysFolders ' Add ID's for system folders to combo box...
|
|
.AddItem "DESKTOP"
|
|
.ItemData(.NewIndex) = 0
|
|
.AddItem "PROGRAMS"
|
|
.ItemData(.NewIndex) = &H2
|
|
.AddItem "Controls"
|
|
.ItemData(.NewIndex) = &H3
|
|
.AddItem "Printers"
|
|
.ItemData(.NewIndex) = &H4
|
|
.AddItem "PERSONAL"
|
|
.ItemData(.NewIndex) = &H5
|
|
.AddItem "FAVORITES"
|
|
.ItemData(.NewIndex) = &H6
|
|
.AddItem "STARTUP"
|
|
.ItemData(.NewIndex) = &H7
|
|
.AddItem "RECENT"
|
|
.ItemData(.NewIndex) = &H8
|
|
.AddItem "SENDTO"
|
|
.ItemData(.NewIndex) = &H9
|
|
.AddItem "BITBUCKET: RECYCLE-BIN"
|
|
.ItemData(.NewIndex) = &HA
|
|
.AddItem "STARTMENU"
|
|
.ItemData(.NewIndex) = &HB
|
|
.AddItem "DESKTOPDIRECTORY"
|
|
.ItemData(.NewIndex) = &H10
|
|
.AddItem "DRIVES"
|
|
.ItemData(.NewIndex) = &H11
|
|
.AddItem "NETWORK"
|
|
.ItemData(.NewIndex) = &H12
|
|
.AddItem "NETHOOD"
|
|
.ItemData(.NewIndex) = &H13
|
|
.AddItem "Fonts"
|
|
.ItemData(.NewIndex) = &H14
|
|
.AddItem "TEMPLATES"
|
|
.ItemData(.NewIndex) = &H15
|
|
.AddItem "COMMON_STARTMENU"
|
|
.ItemData(.NewIndex) = &H16
|
|
.AddItem "COMMON_PROGRAMS"
|
|
.ItemData(.NewIndex) = &H17
|
|
.AddItem "COMMON_STARTUP"
|
|
.ItemData(.NewIndex) = &H18
|
|
.AddItem "COMMON_DESKTOPDIRECTORY"
|
|
.ItemData(.NewIndex) = &H19
|
|
.AddItem "APPDATA"
|
|
.ItemData(.NewIndex) = &H1A
|
|
.AddItem "PRINTHOOD"
|
|
.ItemData(.NewIndex) = &H1B
|
|
|
|
.ListIndex = 0
|
|
End With
|
|
'---------------------------------------------------------------
|
|
End Sub
|
|
'---------------------------------------------------------------
|
|
|
|
'---------------------------------------------------------------
|
|
Private Sub SetDefaults(pth As String)
|
|
'---------------------------------------------------------------
|
|
Dim AppPath As String ' Current Application path
|
|
'---------------------------------------------------------------
|
|
AppPath = App.Path ' Get current path
|
|
|
|
If (Right$(AppPath, 1) <> "\") Then AppPath = AppPath & "\" ' Fix application path if necessary
|
|
If (Right$(pth, 1) <> "\") Then pth = pth & "\" ' Fix path if necessary
|
|
|
|
txtLinkName.Text = pth & "testlink.lnk" ' Create a full path name for link file
|
|
txtExeName.Text = AppPath & App.EXEName & ".exe" ' Create a full path name for applicaton exe name
|
|
txtWorkDir.Text = AppPath ' Set default working directory
|
|
txtCmdArgs.Text = "-ARG1 -ARG2" ' Set default arguments
|
|
txtIconFile.Text = txtExeName.Text ' Set default IconFile name to default exename
|
|
txtIconIndex.Text = CStr(1) ' Set default Icon Index val
|
|
txtShowCmd.Text = CStr(7) ' set default showcommand val
|
|
txtProgramGroup.Text = pth & "Test Link Program Group" ' Set default Program group name
|
|
'---------------------------------------------------------------
|
|
End Sub
|
|
'---------------------------------------------------------------
|