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.
353 lines
10 KiB
353 lines
10 KiB
VERSION 5.00
|
|
Begin VB.Form frmGroup
|
|
BorderStyle = 3 'Fixed Dialog
|
|
Caption = "* #"
|
|
ClientHeight = 5250
|
|
ClientLeft = 1095
|
|
ClientTop = 1515
|
|
ClientWidth = 5460
|
|
Icon = "group.frx":0000
|
|
LinkTopic = "Form1"
|
|
LockControls = -1 'True
|
|
MaxButton = 0 'False
|
|
MinButton = 0 'False
|
|
ScaleHeight = 350
|
|
ScaleMode = 3 'Pixel
|
|
ScaleWidth = 364
|
|
Begin VB.DirListBox dir95Groups
|
|
Height = 930
|
|
Left = 765
|
|
TabIndex = 8
|
|
Top = 60
|
|
Visible = 0 'False
|
|
Width = 3810
|
|
End
|
|
Begin VB.Frame Frame1
|
|
Height = 30
|
|
Left = 105
|
|
TabIndex = 7
|
|
Top = 4650
|
|
Width = 5220
|
|
End
|
|
Begin VB.CommandButton cmdCancel
|
|
Cancel = -1 'True
|
|
Caption = "#"
|
|
Height = 345
|
|
Left = 2880
|
|
MaskColor = &H00000000&
|
|
TabIndex = 3
|
|
Top = 4800
|
|
Width = 1140
|
|
End
|
|
Begin VB.CommandButton cmdContinue
|
|
Caption = "#"
|
|
Default = -1 'True
|
|
Height = 345
|
|
Left = 1395
|
|
MaskColor = &H00000000&
|
|
TabIndex = 2
|
|
Top = 4800
|
|
Width = 1140
|
|
End
|
|
Begin VB.ListBox lstGroups
|
|
Height = 2010
|
|
ItemData = "group.frx":0442
|
|
Left = 1080
|
|
List = "group.frx":0449
|
|
Sorted = -1 'True
|
|
TabIndex = 1
|
|
Top = 2220
|
|
Width = 3240
|
|
End
|
|
Begin VB.TextBox txtGroup
|
|
Height = 300
|
|
Left = 1080
|
|
TabIndex = 0
|
|
Text = "*"
|
|
Top = 1410
|
|
Width = 3270
|
|
End
|
|
Begin VB.Label lblDDE
|
|
Height = 225
|
|
Left = 225
|
|
TabIndex = 9
|
|
Top = 1350
|
|
Visible = 0 'False
|
|
Width = 705
|
|
End
|
|
Begin VB.Label lblGroups
|
|
AutoSize = -1 'True
|
|
Caption = "#"
|
|
Height = 195
|
|
Left = 1080
|
|
TabIndex = 6
|
|
Top = 1950
|
|
Width = 105
|
|
End
|
|
Begin VB.Label lblGroup
|
|
AutoSize = -1 'True
|
|
Caption = "#"
|
|
Height = 195
|
|
Left = 1080
|
|
TabIndex = 5
|
|
Top = 1170
|
|
Width = 105
|
|
End
|
|
Begin VB.Label lblMain
|
|
AutoSize = -1 'True
|
|
Caption = "#"
|
|
Height = 195
|
|
Left = 180
|
|
TabIndex = 4
|
|
Top = 165
|
|
Width = 5100
|
|
WordWrap = -1 'True
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmGroup"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
Dim mstrGroup As String
|
|
Dim mstrDefGroup As String
|
|
Dim mstrProgramsPath As String
|
|
Dim mfrm As Form
|
|
Dim fPrivate As Boolean
|
|
Dim fStartMenu As Boolean
|
|
|
|
Private Sub cmdCancel_Click()
|
|
ExitSetup frmGroup, gintRET_EXIT
|
|
End Sub
|
|
|
|
Private Sub cmdContinue_Click()
|
|
mstrGroup = txtGroup.Text
|
|
If Not fCreateProgGroup() Then
|
|
'
|
|
' Couldn't create the group. Let
|
|
' the user try again.
|
|
'
|
|
txtGroup.SetFocus
|
|
Else
|
|
'
|
|
' The group got created ok, so unload Choose Program Group dialog
|
|
' and continue on with setup.
|
|
'
|
|
Unload Me
|
|
End If
|
|
End Sub
|
|
Private Function fCreateProgGroup() As Boolean
|
|
'
|
|
' Create a program group for either NT or Win95.
|
|
'
|
|
Dim strMsg As String
|
|
If TreatAsWin95() Then
|
|
If Not fValidFilename(mstrGroup) Then
|
|
strMsg = ResolveResString(resGROUPINVALIDGROUPNAME, "|1", CStr(gintMAX_PATH_LEN), "|2", ResolveResString(resCOMMON_INVALIDFILECHARS))
|
|
MsgFunc strMsg, vbOKOnly Or vbQuestion, gstrTitle
|
|
GoTo CGError
|
|
End If
|
|
Else
|
|
If Not fValidNTGroupName(mstrGroup) Then
|
|
strMsg = ResolveResString(resGROUPINVALIDGROUPNAME, "|1", CStr(gintMAX_GROUPNAME_LEN%), "|2", ResolveResString(resGROUPINVALIDCHARS))
|
|
MsgFunc strMsg, vbOKOnly Or vbQuestion, gstrTitle
|
|
GoTo CGError
|
|
End If
|
|
|
|
End If
|
|
'
|
|
'Go ahead and create the main program group
|
|
'
|
|
If Not fCreateOSProgramGroup(mfrm, mstrGroup, True, , fPrivate, fStartMenu) Then
|
|
GoTo CGError
|
|
End If
|
|
|
|
fCreateProgGroup = True
|
|
Exit Function
|
|
CGError:
|
|
fCreateProgGroup = False
|
|
End Function
|
|
Private Sub Form_Load()
|
|
'
|
|
' Initialize localized control properties.
|
|
'
|
|
SetFormFont Me
|
|
Me.Caption = ResolveResString(resGROUPFRM, "|1", gstrAppName)
|
|
lblMain.Caption = ResolveResString(resGROUPLBLMAIN)
|
|
lblGroup.Caption = ResolveResString(resGROUPLBLGROUP)
|
|
lblGroups.Caption = ResolveResString(resGROUPLBLGROUPS)
|
|
cmdContinue.Caption = ResolveResString(resGROUPBTNCONTINUE)
|
|
cmdCancel.Caption = ResolveResString(resLOG_vbCancel)
|
|
'
|
|
' Initialize the Program Group text box with the
|
|
' title of the application.
|
|
'
|
|
txtGroup.Text = gstrTitle
|
|
'
|
|
' Load the ListBox with the program manager groups.
|
|
'
|
|
If TreatAsWin95() Then
|
|
LoadW95Groups
|
|
Else
|
|
LoadProgManGroups
|
|
End If
|
|
'
|
|
' Initialize the Program Group textbox with the
|
|
' default group selected in the list box.
|
|
'
|
|
txtGroup.Text = lstGroups.List(lstGroups.ListIndex)
|
|
End Sub
|
|
|
|
Private Sub lstGroups_Click()
|
|
txtGroup.Text = lstGroups.List(lstGroups.ListIndex)
|
|
End Sub
|
|
|
|
Private Sub txtGroup_Change()
|
|
cmdContinue.Enabled = Len(Trim(txtGroup.Text)) > 0
|
|
End Sub
|
|
Sub LoadProgManGroups()
|
|
'
|
|
' This routine uses DDE to talk to Program Manager
|
|
' to retrieve a list of all the groups it manages.
|
|
' It should only be called if the shell is NT 3.51.
|
|
' If it is Win95 or NT4, call LoadW95Groups()
|
|
' instead.
|
|
'
|
|
' Special strings used in this routine. Do not
|
|
' localize these strings.
|
|
'
|
|
Const strPROGMANLINKTOPIC = "ProgMan|Progman"
|
|
Const strPROGMANLINKITEM = "Progman"
|
|
Const strNDWGROUP = "Quick Access"
|
|
|
|
Dim strGroups As String
|
|
Dim strGroup As String
|
|
Dim intOffset As Integer
|
|
Dim intAnchor As Integer
|
|
Dim iGroup As Long
|
|
|
|
lblDDE.LinkTopic = strPROGMANLINKTOPIC
|
|
lblDDE.LinkItem = strPROGMANLINKITEM
|
|
lblDDE.LinkMode = 2
|
|
lblDDE.LinkRequest
|
|
On Error Resume Next
|
|
lblDDE.LinkMode = 0
|
|
'
|
|
' The DDE call just made put the names of all the groups
|
|
' into the caption property of the lblDDE control.
|
|
' We want to transfer them to the list box. They are
|
|
' separated by vbcrlf's.
|
|
'
|
|
strGroups = lblDDE.Caption
|
|
intAnchor = 1
|
|
intOffset = InStr(intAnchor, strGroups, vbCrLf)
|
|
lstGroups.Clear
|
|
Do While intOffset > 0
|
|
strGroup = Mid(strGroups, intAnchor, intOffset - intAnchor)
|
|
'
|
|
' Norton Desktop for Windows uses the "Quick Access" group
|
|
' to replace program manager. Trying to add icons to this
|
|
' group will fail later when we perform our DDE.linkrequest.
|
|
' Therefore, skip this group.
|
|
'
|
|
If strGroup <> strNDWGROUP Then
|
|
lstGroups.AddItem strGroup
|
|
End If
|
|
|
|
intAnchor = intOffset + 2
|
|
intOffset = InStr(intAnchor, strGroups, vbCrLf)
|
|
Loop
|
|
'
|
|
' The lstGroups listbox now contains a listing of all the program
|
|
' manager groups.
|
|
'
|
|
' Look for the default group in the list and select it. If it's
|
|
' not there, add it.
|
|
'
|
|
iGroup = SendMessageString(lstGroups.hwnd, LB_FINDSTRINGEXACT, -1, mstrDefGroup)
|
|
If iGroup = LB_ERR Then
|
|
'
|
|
' The group doesn't yet exist, add it to the list.
|
|
'
|
|
lstGroups.AddItem mstrDefGroup
|
|
lstGroups.ListIndex = lstGroups.NewIndex
|
|
Else
|
|
lstGroups.ListIndex = iGroup
|
|
End If
|
|
End Sub
|
|
Sub LoadW95Groups()
|
|
'
|
|
' This routine uses the system registry to
|
|
' retrieve a list of all the subfolders in the
|
|
' \windows\start menu\programs folder.
|
|
' It should only be called if the shell is Win95
|
|
' NT4. If it is NT 3.51, call LoadProgManGroups()
|
|
' instead.
|
|
'
|
|
Dim strFolder As String
|
|
Dim iFolder As Integer
|
|
|
|
mstrProgramsPath = strGetProgramsFilesPath()
|
|
strFolder = Dir(mstrProgramsPath, vbDirectory) ' Retrieve the first entry.
|
|
lstGroups.Clear
|
|
Do While strFolder <> ""
|
|
'
|
|
' Ignore the current directory and the encompassing directory.
|
|
'
|
|
If strFolder <> "." And strFolder <> ".." Then
|
|
'
|
|
' Verify that we actually got a directory and not a file.
|
|
'
|
|
If (GetAttr(mstrProgramsPath & strFolder) And vbDirectory) = vbDirectory Then
|
|
'
|
|
' We got a directory, add it to the list.
|
|
'
|
|
lstGroups.AddItem strFolder
|
|
End If
|
|
End If
|
|
'
|
|
' Get the next subfolder in the Programs folder
|
|
'
|
|
strFolder = Dir
|
|
Loop
|
|
'
|
|
' The lstGroups listbox now contains a listing of all the Programs
|
|
' subfolders (the groups).
|
|
'
|
|
' Look for the default folder in the list and select it. If it's
|
|
' not there, add it.
|
|
'
|
|
iFolder = SendMessageString(lstGroups.hwnd, LB_FINDSTRINGEXACT, -1, mstrDefGroup)
|
|
If iFolder = LB_ERR Then
|
|
'
|
|
' The group doesn't yet exist, add it to the list.
|
|
'
|
|
lstGroups.AddItem mstrDefGroup
|
|
lstGroups.ListIndex = lstGroups.NewIndex
|
|
Else
|
|
lstGroups.ListIndex = iFolder
|
|
End If
|
|
End Sub
|
|
Public Property Get GroupName(frm As Form, strDefGroup As String, Optional fPriv As Boolean = True, Optional ByVal fStart As Boolean = False) As String
|
|
mstrDefGroup = strDefGroup
|
|
Set mfrm = frm
|
|
|
|
fPrivate = fPriv
|
|
fStartMenu = fStart
|
|
If gfNoUserInput = True Then
|
|
mstrGroup = mstrDefGroup
|
|
If Not fCreateProgGroup() Then
|
|
ExitSetup frmSetup1, gintRET_FATAL
|
|
End If
|
|
Else
|
|
Me.Show vbModal
|
|
End If
|
|
GroupName = mstrGroup
|
|
End Property
|
|
|
|
Private Sub txtGroup_GotFocus()
|
|
txtGroup.SelStart = 0
|
|
txtGroup.SelLength = 32767
|
|
End Sub
|