تقييم الموضوع :
  • 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
هل من يستطيع المساعدة ؟
الرد }}}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [كود] تعديل كود البحث بين تاريخينب hglogtd 2 44 29-11-16, 01:37 AM
آخر رد: hglogtd
  مطلوب تعديلات في هذه الاكواد بحيث تكون فعاله اكثر معتز الجازوي 2 75 28-11-16, 05:36 PM
آخر رد: معتز الجازوي
  [VB.NET] طلب تعديل ع الكود ليصبح البرنامج جاهزاً 3asfa~mdmra 8 202 12-11-16, 02:30 AM
آخر رد: 3asfa~mdmra
Question [VB.NET] ممكن احد يشرح لي المطلوب :( a_abdullah 2 84 05-11-16, 08:43 PM
آخر رد: a_abdullah
  ممكن مساعدة اخواني في Inherits ابراهيم كركوكي 2 72 03-11-16, 09:19 PM
آخر رد: ابراهيم كركوكي
  ممكن طريقة عرض بيانات على ListView ؟ mmm650 2 123 30-10-16, 10:14 PM
آخر رد: adel27
  ممكن طريقة عرض بيانات على ListView ؟ mmm650 0 55 29-10-16, 08:37 PM
آخر رد: mmm650
  [VB.NET] تعديل بسيط على المشروع المرفق أبووسم 4 137 29-10-16, 03:42 PM
آخر رد: أبووسم
  هل ممكن مساعدة من أهل الخبرة sambro 1 86 27-10-16, 11:50 PM
آخر رد: sambro
  [VB.NET] كيف ممكن اجعل هذا الاتصال بتصل بip مختلف عن ip اتصالي 3asfa~mdmra 0 57 27-10-16, 09:56 PM
آخر رد: 3asfa~mdmra

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


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