تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[VB.NET] ممكن اشوي تعديل على الاكواد
#1
اولا حابب تفهمون فكرتي .
الفكرة :
بدي اعمل برنامج يغير الايكون للملفات مثل : ( الفولدرات - ملفات EXE - ملفات Bat - وغيرها من الصيغ )
يفضل اني انا اختار الملف او الفولدر لاقوم بتغيير الايكون حقه .

سوف اقوم برفعه بعد التعديل عليه .

الاكواد كلها :

كود :
Imports System.Drawing
Imports System.Collections
Imports System.ComponentModel
Imports System.Windows.Forms
Imports System.Data
Imports System.IO
Imports Folder_icon_Changer.FolderIcons

Public Class Form1

   Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
       Dim FolderBrowserDialog1 As New FolderBrowserDialog
       FolderBrowserDialog1.SelectedPath = TextBox1.Text
       FolderBrowserDialog1.Description = "Select folder:"
       Dim result As DialogResult = FolderBrowserDialog1.ShowDialog()
       If result = DialogResult.OK Then
           TextBox1.Text = FolderBrowserDialog1.SelectedPath
       End If
   End Sub

   Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
       Dim FileBrowser As New OpenFileDialog

       If TextBox1.Text.Length > 0 Then
           FileBrowser.InitialDirectory = TextBox1.Text
       End If

       If TextBox2.Text.Length > 0 Then
           FileBrowser.FileName = TextBox2.Text
       Else
           FileBrowser.FileName = Nothing
       End If

       FileBrowser.Filter = "Icon files (*.ico)|*.ico|All files (*.*)|*.*"
       FileBrowser.FilterIndex = 1
       FileBrowser.RestoreDirectory = False
       Dim result As DialogResult = FileBrowser.ShowDialog()

       If result = DialogResult.OK Then
           TextBox2.Text = FileBrowser.FileName
       End If
   End Sub

   Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
       If MessageBox.Show("Once Changed the original icon can not be recovered Do you wish to Continue?", "Warning", MessageBoxButtons.YesNo) = Windows.Forms.DialogResult.Yes Then
           Try
               If TextBox1.Text.Length > 0 Then
                   If File.Exists(TextBox2.Text) Then
                       Dim myFolderIcon As New FolderIcon(TextBox1.Text)
                       myFolderIcon.CreateFolderIcon(TextBox2.Text, "MoDy kareem")
                       myFolderIcon = Nothing
                       MessageBox.Show("Icon assigned to folder.", "Icon Assigned", MessageBoxButtons.OK, MessageBoxIcon.Information)
                   Else
                       MessageBox.Show("Please enter or browse to a valid icon file.", "No Icon Selected", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
                   End If
               Else
                   MessageBox.Show("Please enter or browse to a valid folder.", "No Folder Selected", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
               End If
           Catch ex As Exception
               MsgBox("404")
           End Try
       Else
       End If
   End Sub
End Class

هذا للـ فولدر ايكون

كود :
Imports System.IO

Namespace FolderIcons
   Public Class FolderIcon
       Private m_folderPath As String = ""
       Private m_iniPath As String = ""
       Public Sub New(ByVal folderPath As String)
           Me.FolderPath = folderPath
       End Sub

       Public Sub CreateFolderIcon(ByVal iconFilePath As String, ByVal infoTip As String)
           If CreateFolder() Then
               CreateDesktopIniFile(iconFilePath, infoTip)
               SetIniFileAttributes()
               SetFolderAttributes()
           End If
       End Sub

       Public Sub CreateFolderIcon(ByVal targetFolderPath As String, ByVal iconFilePath As String, ByVal infoTip As String)
           Me.FolderPath = targetFolderPath
           Me.CreateFolderIcon(iconFilePath, infoTip)
       End Sub


       Public Property FolderPath() As String
           Get
               Return Me.m_folderPath
           End Get
           Set(ByVal value As String)
               m_folderPath = value
               If Not Me.m_folderPath.EndsWith("\") Then
                   Me.m_folderPath += "\"
               End If
           End Set
       End Property

       Public Property IniPath() As String
           Get
               Return m_iniPath
           End Get
           Set(ByVal value As String)
               m_iniPath = value
           End Set
       End Property

       Private Function CreateFolder() As Boolean

           If Me.FolderPath.Length = 0 Then
               Return False
           End If


           If Directory.Exists(Me.FolderPath) Then
               Return True
           End If

           Try

               Dim di As DirectoryInfo = Directory.CreateDirectory(Me.FolderPath)
           Catch e As Exception
               Return False
           End Try

           Return True
       End Function

       Private Function CreateDesktopIniFile(ByVal iconFilePath As String, ByVal getIconFromDLL As Boolean, ByVal iconIndex As Integer, ByVal infoTip As String) As Boolean

           If Not Directory.Exists(Me.FolderPath) Then
               Return False
           End If


           If Not File.Exists(iconFilePath) Then
               Return False
           End If

           If Not getIconFromDLL Then
               iconIndex = 0
           End If


           Me.IniPath = Me.FolderPath & "desktop.ini"


           IniWriter.WriteValue(".ShellClassInfo", "IconFile", iconFilePath, Me.IniPath)
           IniWriter.WriteValue(".ShellClassInfo", "IconIndex", iconIndex.ToString(), Me.IniPath)
           IniWriter.WriteValue(".ShellClassInfo", "InfoTip", infoTip, Me.IniPath)

           Return True
       End Function

       Private Sub CreateDesktopIniFile(ByVal iconFilePath As String, ByVal infoTip As String)
           Me.CreateDesktopIniFile(iconFilePath, False, 0, infoTip)
       End Sub

       Private Function SetIniFileAttributes() As Boolean

           If Not File.Exists(Me.IniPath) Then
               Return False
           End If


           If (File.GetAttributes(Me.IniPath) And FileAttributes.Hidden) <> FileAttributes.Hidden Then
               File.SetAttributes(Me.IniPath, File.GetAttributes(Me.IniPath) Or FileAttributes.Hidden)
           End If


           If (File.GetAttributes(Me.IniPath) And FileAttributes.System) <> FileAttributes.System Then
               File.SetAttributes(Me.IniPath, File.GetAttributes(Me.IniPath) Or FileAttributes.System)
           End If

           Return True

       End Function

       Private Function SetFolderAttributes() As Boolean

           If Not Directory.Exists(Me.FolderPath) Then
               Return False
           End If

           If (File.GetAttributes(Me.FolderPath) And FileAttributes.System) <> FileAttributes.System Then
               File.SetAttributes(Me.FolderPath, File.GetAttributes(Me.FolderPath) Or FileAttributes.System)
           End If

           Return True

       End Function

   End Class
End Namespace

وهذا للـ ان رايتر

كود :
Imports System.Runtime.InteropServices

Namespace FolderIcons

   Public Class IniWriter

       <DllImport("kernel32")> _
       Private Shared Function WritePrivateProfileString(ByVal iniSection As String, ByVal iniKey As String, ByVal iniValue As String, ByVal iniFilePath As String) As Integer
       End Function

       Public Shared Sub WriteValue(ByVal iniSection As String, ByVal iniKey As String, ByVal iniValue As String, ByVal iniFilePath As String)
           WritePrivateProfileString(iniSection, iniKey, iniValue, iniFilePath)
       End Sub

   End Class
End Namespace
الرد }}}}
تم الشكر بواسطة:
#2
هل من يستطيع المساعدة ؟
الرد }}}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [سؤال] المرجو المساعدة كود الاضافة ليعمل في تصميم برنامج صانع الاكواد brioule 1 58 25-02-17, 06:31 PM
آخر رد: khodor1985
  ممكن شرح لطريقة ربط أكثر من جدول اكسس ؟ أبووسم 5 136 24-02-17, 12:23 AM
آخر رد: أبووسم
  طلب تعديل كود لاظهار الصور من السكانر f-www 8 1,071 22-02-17, 07:25 PM
آخر رد: عدنان الشمري
  [VB.NET] ابغي كود او شرح مفصل مع الاكواد 0theghost0 0 55 13-02-17, 12:53 PM
آخر رد: 0theghost0
  [VB.NET] تعديل ع كود اتصال 3asfa~mdmra 0 48 06-02-17, 06:51 PM
آخر رد: 3asfa~mdmra
Photo [VB.NET] مساعده في تعديل كود التنبيه قبل انتهاء التاريخ بفتره زمنيه.. Marwan9990 11 244 02-02-17, 06:12 PM
آخر رد: Marwan9990
  ممكن احد يساعدني في التكست بوكس محمد بوقزاحة 4 105 01-02-17, 07:04 PM
آخر رد: محمد بوقزاحة
  [سؤال] تعديل عدة سجلات ابو يوسف النواوي 2 8 166 30-01-17, 03:19 AM
آخر رد: ابو ليلى
  [VB.NET] تعديل بيسط على الكود ليصيح جاهزآ 3asfa~mdmra 0 86 27-01-17, 06:01 PM
آخر رد: 3asfa~mdmra
  ممكن كود البوتن بالشكل ده MOSTAFA.KAMEL 7 229 24-01-17, 02:14 AM
آخر رد: مساعدة

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم