home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / DM_AppPath2133241152008.psc / DmAppPaths / frm / frmmain.frm < prev    next >
Text File  |  2008-11-05  |  14KB  |  455 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  3. Begin VB.Form frmmain 
  4.    Caption         =   "DM AppPaths"
  5.    ClientHeight    =   5505
  6.    ClientLeft      =   60
  7.    ClientTop       =   630
  8.    ClientWidth     =   6810
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   5505
  11.    ScaleWidth      =   6810
  12.    StartUpPosition =   2  'CenterScreen
  13.    Begin MSComctlLib.StatusBar StatusBar1 
  14.       Align           =   2  'Align Bottom
  15.       Height          =   285
  16.       Left            =   0
  17.       TabIndex        =   2
  18.       Top             =   5220
  19.       Width           =   6810
  20.       _ExtentX        =   12012
  21.       _ExtentY        =   503
  22.       _Version        =   393216
  23.       BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
  24.          NumPanels       =   1
  25.          BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  26.             Bevel           =   0
  27.          EndProperty
  28.       EndProperty
  29.    End
  30.    Begin MSComctlLib.Toolbar Toolbar1 
  31.       Align           =   1  'Align Top
  32.       Height          =   360
  33.       Left            =   0
  34.       TabIndex        =   1
  35.       Top             =   0
  36.       Width           =   6810
  37.       _ExtentX        =   12012
  38.       _ExtentY        =   635
  39.       ButtonWidth     =   609
  40.       ButtonHeight    =   582
  41.       Appearance      =   1
  42.       Style           =   1
  43.       ImageList       =   "ImageList1"
  44.       _Version        =   393216
  45.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  46.          NumButtons      =   5
  47.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  48.             Key             =   "M_ADD"
  49.             Object.ToolTipText     =   "Add"
  50.             ImageIndex      =   2
  51.          EndProperty
  52.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  53.             Key             =   "M_EDIT"
  54.             Object.ToolTipText     =   "Edit"
  55.             ImageIndex      =   3
  56.          EndProperty
  57.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  58.             Key             =   "M_DELETE"
  59.             Object.ToolTipText     =   "Delete"
  60.             ImageIndex      =   4
  61.          EndProperty
  62.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  63.             Style           =   3
  64.          EndProperty
  65.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  66.             Key             =   "M_RUN"
  67.             Object.ToolTipText     =   "Run Program"
  68.             ImageIndex      =   1
  69.          EndProperty
  70.       EndProperty
  71.    End
  72.    Begin MSComctlLib.ImageList ImageList1 
  73.       Left            =   6390
  74.       Top             =   990
  75.       _ExtentX        =   1005
  76.       _ExtentY        =   1005
  77.       BackColor       =   -2147483643
  78.       ImageWidth      =   16
  79.       ImageHeight     =   16
  80.       MaskColor       =   16711935
  81.       _Version        =   393216
  82.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  83.          NumListImages   =   4
  84.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  85.             Picture         =   "frmmain.frx":0000
  86.             Key             =   "App"
  87.          EndProperty
  88.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  89.             Picture         =   "frmmain.frx":0352
  90.             Key             =   ""
  91.          EndProperty
  92.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  93.             Picture         =   "frmmain.frx":06A4
  94.             Key             =   ""
  95.          EndProperty
  96.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  97.             Picture         =   "frmmain.frx":09F6
  98.             Key             =   ""
  99.          EndProperty
  100.       EndProperty
  101.    End
  102.    Begin MSComctlLib.ListView LstV 
  103.       Height          =   4680
  104.       Left            =   0
  105.       TabIndex        =   0
  106.       Top             =   450
  107.       Width           =   6195
  108.       _ExtentX        =   10927
  109.       _ExtentY        =   8255
  110.       View            =   3
  111.       LabelEdit       =   1
  112.       LabelWrap       =   -1  'True
  113.       HideSelection   =   -1  'True
  114.       FullRowSelect   =   -1  'True
  115.       _Version        =   393217
  116.       SmallIcons      =   "ImageList1"
  117.       ForeColor       =   -2147483640
  118.       BackColor       =   -2147483643
  119.       BorderStyle     =   1
  120.       Appearance      =   1
  121.       NumItems        =   2
  122.       BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  123.          Text            =   "Program Name"
  124.          Object.Width           =   2540
  125.       EndProperty
  126.       BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  127.          SubItemIndex    =   1
  128.          Text            =   "Program Path"
  129.          Object.Width           =   2540
  130.       EndProperty
  131.    End
  132.    Begin Project1.CReg CReg1 
  133.       Left            =   6285
  134.       Top             =   585
  135.       _ExtentX        =   635
  136.       _ExtentY        =   635
  137.    End
  138.    Begin VB.Menu mnuFile 
  139.       Caption         =   "&File"
  140.       Begin VB.Menu mnuExit 
  141.          Caption         =   "E&xit"
  142.       End
  143.    End
  144.    Begin VB.Menu mnuEdit 
  145.       Caption         =   "&Edit"
  146.       Begin VB.Menu mnuAdd 
  147.          Caption         =   "Add Item"
  148.       End
  149.       Begin VB.Menu mnuEditA 
  150.          Caption         =   "&Edit Item"
  151.       End
  152.       Begin VB.Menu mnuDel 
  153.          Caption         =   "Delete Item"
  154.       End
  155.       Begin VB.Menu mnublank1 
  156.          Caption         =   "-"
  157.       End
  158.       Begin VB.Menu mnuRun 
  159.          Caption         =   "&Run Program"
  160.       End
  161.    End
  162.    Begin VB.Menu mnuA 
  163.       Caption         =   "#"
  164.       Visible         =   0   'False
  165.       Begin VB.Menu mnuEdit1 
  166.          Caption         =   "&Edit Item"
  167.       End
  168.       Begin VB.Menu mnuDel1 
  169.          Caption         =   "Delete Item"
  170.       End
  171.       Begin VB.Menu mnuRun1 
  172.          Caption         =   "Run Program"
  173.       End
  174.    End
  175.    Begin VB.Menu mnuAbout 
  176.       Caption         =   "&About"
  177.    End
  178. End
  179. Attribute VB_Name = "frmmain"
  180. Attribute VB_GlobalNameSpace = False
  181. Attribute VB_Creatable = False
  182. Attribute VB_PredeclaredId = True
  183. Attribute VB_Exposed = False
  184. Option Explicit
  185. Private sSubKey As String
  186. Private mMouseButton As MouseButtonConstants
  187.  
  188. Private Sub AddItem()
  189. Dim tmp As String
  190.     tmp = sSubKey
  191.     
  192.     CReg1.SubKey = tmp & ExeName & ".exe"
  193.     'Check if the item already exists.
  194.     If (CReg1.KeyExsists) Then
  195.         MsgBox "This item already exists.", vbInformation, "Add"
  196.         Exit Sub
  197.     Else
  198.         If (CReg1.CreateKey <> 1) Then
  199.             MsgBox "The item could not be added.", vbExclamation, "Error Adding Item"
  200.         Else
  201.             'Add the Exe Path
  202.             CReg1.SetValue vbNullString, ExePath, REG_EXPAND_SZ
  203.             CReg1.SetValue "Path", GetPathFormFile(ExePath), REG_EXPAND_SZ
  204.         End If
  205.     End If
  206.     
  207.     Call RefreshList
  208.     'Clear up
  209.     tmp = vbNullString
  210. End Sub
  211.  
  212. Private Sub DeleteItem()
  213. Dim sExeName As String
  214. Dim sPath As String
  215.     'Get Program's exe name.
  216.     sExeName = LstV.SelectedItem.Key
  217.     sPath = sSubKey & sExeName
  218.     'Set the key to open
  219.     CReg1.SubKey = sPath
  220.     'Check if the item has deleted.
  221.     If (CReg1.DeleteKey <> 1) Then
  222.         MsgBox "The item could not be deleted.", vbExclamation, "Error Deleteing Item"
  223.     Else
  224.         'Refresh
  225.         Call RefreshList
  226.     End If
  227.     
  228.     'Clear up
  229.     sExeName = vbNullString
  230.     sPath = vbNullString
  231. End Sub
  232.  
  233. Private Sub EditItem()
  234. Dim sExeName As String
  235. Dim sPath As String
  236. Dim lIdx As Integer
  237. Dim mOld As String
  238.  
  239.     'Get Program's exe name.
  240.     lIdx = LstV.SelectedItem.Index
  241.     sExeName = LstV.SelectedItem.Key
  242.     mOld = sSubKey & sExeName
  243.     
  244.     'Set the key to open
  245.     sPath = sSubKey & ExeName & ".exe"
  246.     CReg1.SubKey = sPath
  247.     'Check if the key exsist
  248.     If CReg1.KeyExsists() Then
  249.         'Add the new item data
  250.          CReg1.SetValue vbNullString, ExePath, REG_EXPAND_SZ
  251.          CReg1.SetValue "Path", GetPathFormFile(ExePath), REG_EXPAND_SZ
  252.     Else
  253.         If (CReg1.CreateKey <> 1) Then
  254.             MsgBox "The item could not be updated.", vbExclamation, "Edit Item"
  255.         Else
  256.     
  257.             'Add the new item data
  258.             CReg1.SetValue vbNullString, ExePath, REG_EXPAND_SZ
  259.             CReg1.SetValue "Path", GetPathFormFile(ExePath), REG_EXPAND_SZ
  260.             CReg1.SubKey = mOld
  261.             'Delete the old Item
  262.             If (CReg1.DeleteKey <> 1) Then
  263.                 MsgBox "The item could not be updated.", vbExclamation, "Edit Item"
  264.             End If
  265.         End If
  266.     End If
  267.     
  268.     'Refresh
  269.     Call RefreshList
  270.     Call SelectItem(lIdx)
  271.     'Clear up
  272.     sPath = vbNullString
  273.     sExeName = vbNullString
  274. End Sub
  275.  
  276. Private Sub RefreshList()
  277. Dim Col As New Collection
  278. Dim fExt As String
  279. Dim Item
  280. Dim sIcon As Integer
  281. Dim lFile As String
  282.  
  283.     LstV.SortKey = 1
  284.     'Set the subkey
  285.     CReg1.SubKey = sSubKey
  286.     'Get the subkeys
  287.     Set Col = CReg1.GetSubKeys()
  288.     'Fill Listview with app paths
  289.     With LstV.ListItems
  290.         .Clear
  291.         For Each Item In Col
  292.             'Get File Ext
  293.             fExt = LCase(Right$(Item, 3))
  294.             If (fExt = "exe") Then
  295.                 CReg1.SubKey = sSubKey & Item
  296.                 'Get programs' Exe Path
  297.                 lFile = CReg1.GetValue(vbNullString, REG_EXPAND_SZ)
  298.                 'Check if the program above is found.
  299.                 If FindFile(lFile) Then
  300.                     'Font Icon
  301.                     sIcon = 1
  302.                 Else
  303.                     'Not Found icon
  304.                     sIcon = 4
  305.                 End If
  306.                 'Add Program's file title removeing .exe
  307.                 .Add , Item, Left$(Item, Len(Item) - 4), , sIcon
  308.                 'Add program's exe path
  309.                 .Item(.Count).SubItems(1) = lFile
  310.             End If
  311.         Next Item
  312.     End With
  313.     'Enable/Disable Toolbar buttons.
  314.     Toolbar1.Buttons(2).Enabled = LstV.ListItems.Count
  315.     Toolbar1.Buttons(3).Enabled = LstV.ListItems.Count
  316.     Toolbar1.Buttons(5).Enabled = LstV.ListItems.Count
  317.     'Enable/Disable Menu Items
  318.     mnuEditA.Enabled = LstV.ListItems.Count
  319.     mnuDel.Enabled = LstV.ListItems.Count
  320.     mnuRun.Enabled = LstV.ListItems.Count
  321.     
  322.     'Autosize Columns headers
  323.     Call lvSizeColumns(LstV)
  324.     Call SelectItem(1)
  325.     'Clear up
  326.     Set Col = Nothing
  327.     Item = vbNullString
  328. End Sub
  329.  
  330. Private Sub SelectItem(ByVal Index As Integer)
  331. Dim lItem As ListItem
  332.     'Select an Item
  333.     Set lItem = LstV.ListItems(Index)
  334.     Call LstV_ItemClick(lItem)
  335.     lItem.Selected = True
  336. End Sub
  337.  
  338. Private Sub Form_Load()
  339.     'Set the main Key to open.
  340.     CReg1.Key = HKEY_LOCAL_MACHINE
  341.     'Setup the main subkey to open
  342.     sSubKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\"
  343.     'Fill the Listview
  344.     Call RefreshList
  345. End Sub
  346.  
  347. Private Sub Form_Resize()
  348. On Error Resume Next
  349.     LstV.Width = frmmain.ScaleWidth
  350.     LstV.Height = (frmmain.ScaleHeight - StatusBar1.Height - LstV.Top)
  351. End Sub
  352.  
  353. Private Sub Form_Unload(Cancel As Integer)
  354.     Set frmAdd = Nothing
  355.     Set frmmain = Nothing
  356. End Sub
  357.  
  358. Private Sub LstV_DblClick()
  359.     If (LstV.ListItems.Count) Then
  360.         'Store List Item data
  361.         ExeName = LstV.SelectedItem.Text
  362.         ExePath = LstV.SelectedItem.SubItems(1)
  363.         'Edit Item
  364.         EditOp = 1
  365.         frmAdd.Show vbModal, frmmain
  366.     End If
  367. End Sub
  368.  
  369. Private Sub LstV_ItemClick(ByVal Item As MSComctlLib.ListItem)
  370.     ExeName = Item.Text
  371.     ExePath = Item.SubItems(1)
  372.     'Check what mouse button was pressed.
  373.     If (mMouseButton = vbRightButton) Then
  374.         'Show popup menu.
  375.         PopupMenu mnuA
  376.     End If
  377. End Sub
  378.  
  379. Private Sub LstV_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  380.     mMouseButton = Button
  381. End Sub
  382.  
  383. Private Sub mnuAbout_Click()
  384.     MsgBox frmmain.Caption & " V1.0" & vbCrLf & vbTab & "By DreamVB" _
  385.     & vbCrLf & vbTab & vbTab & "Please vote if you like this code.", vbInformation, "About"
  386. End Sub
  387.  
  388. Private Sub mnuAdd_Click()
  389.     EditOp = 0
  390.     'Show Add Form
  391.     frmAdd.Show vbModal, frmmain
  392.     If (ButtonPress = vbOK) Then
  393.         'Add New Item
  394.         Call AddItem
  395.     End If
  396. End Sub
  397.  
  398. Private Sub mnuDel_Click()
  399.     If MsgBox("Are you sure you want to delete this item.", vbYesNo Or vbQuestion, "Delete Item") = vbYes Then
  400.         'Delete Item
  401.         Call DeleteItem
  402.     End If
  403. End Sub
  404.  
  405. Private Sub mnuDel1_Click()
  406.     Call mnuDel_Click
  407. End Sub
  408.  
  409. Private Sub mnuEdit1_Click()
  410.     Call mnuEditA_Click
  411. End Sub
  412.  
  413. Private Sub mnuEditA_Click()
  414.     EditOp = 1
  415.     'Show Edit Form
  416.     frmAdd.Show vbModal, frmmain
  417.     If (ButtonPress = vbOK) Then
  418.         'Edit Item
  419.         Call EditItem
  420.     End If
  421. End Sub
  422.  
  423. Private Sub mnuExit_Click()
  424.     Unload frmmain
  425. End Sub
  426.  
  427. Private Sub mnuRun_Click()
  428.     If RunApp(frmmain.hwnd, "open", LstV.SelectedItem.SubItems(1)) = 2 Then
  429.         MsgBox "The selected program could not be opened.", vbCritical, "Run Program"
  430.     End If
  431. End Sub
  432.  
  433. Private Sub mnuRun1_Click()
  434.     Call mnuRun_Click
  435. End Sub
  436.  
  437. Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
  438.     Select Case Button.Key
  439.         Case "M_ADD"
  440.             'Add Item
  441.             Call mnuAdd_Click
  442.         Case "M_EDIT"
  443.             'Edit Item
  444.             Call mnuEditA_Click
  445.         Case "M_DELETE"
  446.             'Delete Item
  447.             Call mnuDel_Click
  448.         Case "M_RUN"
  449.             'Run Selected Program
  450.             Call mnuRun_Click
  451.     End Select
  452.     
  453.     ButtonPress = vbCancel
  454. End Sub
  455.