Form1.frm

 VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form Form1
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Change Drive Icon"
   ClientHeight    =   5610
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6840
   ForeColor       =   &H00FF0000&
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5610
   ScaleWidth      =   6840
   StartUpPosition =   2  'CenterScreen
   Begin VB.Frame Frame1
      Height          =   4095
      Left            =   240
      TabIndex        =   2
      Top             =   600
      Width           =   6015
      Begin MSComDlg.CommonDialog cd1
         Left            =   120
         Top             =   3840
         _ExtentX        =   847
         _ExtentY        =   847
         _Version        =   393216
      End
      Begin VB.DriveListBox Drive1
         Height          =   315
         Left            =   0
         TabIndex        =   8
         Top             =   4800
         Width           =   3015
      End
      Begin VB.CommandButton Command2
         Caption         =   "Default Icon"
         Height          =   495
         Left            =   3480
         TabIndex        =   6
         Top             =   3240
         Width           =   1815
      End
      Begin VB.CommandButton Command1
         Caption         =   "Change Icon..."
         Height          =   495
         Left            =   3480
         TabIndex        =   5
         Top             =   2640
         Width           =   1815
      End
      Begin VB.Frame Frame2
         Caption         =   "Current Drive Icon"
         BeginProperty Font
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   1455
         Left            =   3360
         TabIndex        =   4
         Top             =   600
         Width           =   2175
         Begin VB.Image Image1
            Height          =   255
            Left            =   840
            Top             =   480
            Width           =   255
         End
      End
      Begin VB.ListBox List1
         BeginProperty Font
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   2985
         Left            =   600
         TabIndex        =   3
         Top             =   720
         Width           =   2175
      End
      Begin VB.Label Label3
         Alignment       =   2  'Center
         Height          =   375
         Left            =   3480
         TabIndex        =   9
         Top             =   2160
         Width           =   2055
      End
      Begin VB.Label Label1
         Caption         =   "List of all drives:"
         BeginProperty Font
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   255
         Left            =   720
         TabIndex        =   7
         Top             =   360
         Width           =   2055
      End
   End
   Begin VB.CommandButton Command4
      Caption         =   "Exit"
      Height          =   495
      Left            =   4200
      TabIndex        =   1
      Top             =   4920
      Width           =   1935
   End
   Begin VB.CommandButton Command3
      BackColor       =   &H000080FF&
      Caption         =   "Developer..."
      Height          =   495
      Left            =   840
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   4920
      Width           =   2055
   End
   Begin VB.Image imgcd
      Height          =   480
      Left            =   3120
      Picture         =   "Form1.frx":212A
      Top             =   4800
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image imgdrive
      Height          =   480
      Left            =   3240
      Picture         =   "Form1.frx":256C
      Top             =   4920
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image Imgfloppy
      Height          =   480
      Left            =   0
      Picture         =   "Form1.frx":29AE
      Top             =   4680
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Label Label2
      Caption         =   "This software is developed by Mr.Hemant prasad. This software change drives icon in my computer. Select a drive to change icon."
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   615
      Left            =   120
      TabIndex        =   10
      Top             =   120
      Width           =   6615
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click()
If List1.ListIndex = -1 Then
MsgBox "Select a drive first", , "Change Drive Icon"
Else
Dim s As String
With cd1
    .CancelError = False
    .DefaultExt = "ICO"
    .DialogTitle = "Open"
    .Filter = "Icon pictures (*.ico)|*.ico"
    .FileName = ""
    .ShowOpen
    s = .FileName
End With
If s <> "" Then
    Dim salindex As Integer
    Dim salitem As String
    Dim getdrive As String
    Dim b As Boolean
    salindex = List1.ListIndex
    salitem = UCase(Mid(List1.List(salindex), 1, 1))
    b = SaveValue("HKEY_LOCAL_MACHINE", "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\DriveIcons" & salitem & "\DefaultIcon", "", s, "string")
    If b = True Then
    Image1.Picture = LoadPicture(s)
    MsgBox "Selected drive icon is changed. Refresh My computer to take effect.", , "Change Drive Icon"
    Else
    'Problem in saving
End If
End If
End If
End Sub

Private Sub Command2_Click()
If List1.ListIndex = -1 Then
MsgBox "Select a drive first.", , "Default Drive Icon"
Else
    Dim salindex As Integer
    Dim salitem As String
    Dim b As Boolean
    salindex = List1.ListIndex
    salitem = UCase(Mid(List1.List(salindex), 1, 1))
    b = DeleteKey("HKEY_LOCAL_MACHINE", "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\DriveIcons" & salitem & "\DefaultIcon")
    Dim i As Integer
    Dim s As String
    If b = True Then
        For i = 0 To List1.ListCount - 1
        s = UCase(Mid(List1.List(i), 1, 1))
        'For Default icon
        If s = salitem Then
        Select Case s
        Case "A"
        Image1.Picture = Imgfloppy.Picture
        Case UCase(Mid(List1.List(List1.ListCount - 1), 1, 1))
        Image1.Picture = imgcd.Picture
        Case Else
        Image1.Picture = imgdrive.Picture
        End Select
        End If
        Next
        MsgBox "Selected drive icon is changed to default. Refresh My computer to take effect.", , "Default Drive Icon"
    Else
    'Problem in dellete key
    End If
End If
End Sub

Private Sub Command3_Click()
hp.Show vbModal
End Sub

Private Sub Command4_Click()
End
End Sub


Private Sub Form_Load()
Dim i As Integer
Dim s As String
For i = 0 To Drive1.ListCount - 1
s = UCase(Mid(Drive1.List(i), 1, 1))
List1.AddItem s & " -Drive"
Next
Drive1.Visible = False
End Sub

Private Sub List1_Click()
Dim salindex As Integer
Dim salitem As String
Dim i As Integer
Dim s As String
Dim getdriveicon As String
salindex = List1.ListIndex
salitem = UCase(Mid(List1.List(salindex), 1, 1))
getdriveicon = GetValue("HKEY_LOCAL_MACHINE", "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\DriveIcons" & salitem & "\DefaultIcon", "")
If getdriveicon = "" Then
    For i = 0 To List1.ListCount - 1
    s = UCase(Mid(List1.List(i), 1, 1))
    'For Default icon
    If s = salitem Then
    Select Case s
    Case "A"
    Image1.Picture = Imgfloppy.Picture
    Case UCase(Mid(List1.List(List1.ListCount - 1), 1, 1))
    Image1.Picture = imgcd.Picture
    Case Else
    Image1.Picture = imgdrive.Picture
    End Select
    End If
    Next
Else
    Image1.Picture = LoadPicture(getdriveicon)
End If
Label3.Caption = List1.List(List1.ListIndex)
End Sub

Project Homepage: