KULLANICI ADI : ŞİFRE Şifremi Unuttum*

Anasayfa İLLEG4L BANK KREDİ SATIN AL İLLEG4LİZM RAP Sub Domain Bulucu Arama Yap Yeni Konular Bugünki Konular

Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 1
  • 2
  • 3
  • 4
  • 5
Vb.net UZANTI İKONLARINI BULUP GÖSTERME
Konu : Vb.net UZANTI İKONLARINI BULUP GÖSTERME - 13.09.2015, 01:14
Mesaj: #1
İmage

Kod:

Kod:
Imports System.Runtime.InteropServices
Imports Microsoft.Win32
Imports uygulama.Form1.Form1


Public Class Form1
    Public DsyTipi As String
    Public HataVar As Boolean = False

#Region "   FORM1 İÇİNDEKİ (PUBLIC CLASS FORM1) YAPISI.."

    'yeni açtığımız formun içine yeniden bir'(Public Class Form1) Açıyoruz.
    'Ikonu göstermek için  Private IconBilgisi As Hashtable ve  Private GecerliBoyut As ImageSize tanımlaması yapılır
    ' (Public Property CurrentImageSize() As ImageSize),(Public Enum ImageSize),(Public Property CurrentImageSize() As ImageSize)
    ' (Private Function IkonGosterPic() As Object) Oluşturulur.
    'Bu Formda 3 öğe bulunur 1-(public Class) 2-(Public Structure EmbeddedIconInfo) 3-(Public Class RegisteredFileType)
    Public Class Form1
        Private IconBilgisi As Hashtable
        Private GecerliBoyut As ImageSize

        Public Property CurrentImageSize() As ImageSize
            Get
                Return GecerliBoyut
            End Get
            Set(ByVal value As ImageSize)
                Me.GecerliBoyut = value
            End Set
        End Property

        Public Enum ImageSize
            ''' <summary>
            ''' View image in 16x16 px.
            ''' </summary>
            Small

            ''' <summary>
            ''' View image in 32x32 px.
            ''' </summary>
            Large
        End Enum

        Private Function IkonGosterPic() As Object
            'IkonGosterPic', 'çeviri.Form1.Form1' üyesi değil. hatasını önler
            Throw New NotImplementedException
        End Function

    End Class

    Public Structure EmbeddedIconInfo
        'Structure=yapı
        Public FileName As String
        Public IconIndex As Integer
    End Structure

    Public Class RegisteredFileType
        <DllImport("shell32.dll", EntryPoint:="ExtractIconA", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
        Shared Function ExtractIcon(ByVal hInst As Integer, ByVal lpszExeFileName As String, ByVal nIconIndex As Integer) As IntPtr
        End Function
        <DllImport("shell32.dll", CharSet:=CharSet.Auto)> _
        Shared Function ExtractIconEx(ByVal szFileName As String, ByVal nIconIndex As Integer, ByVal phiconLarge() As IntPtr, ByVal phiconSmall() As IntPtr, ByVal nIcons As Integer) As Integer
        End Function
        <DllImport("user32.dll", EntryPoint:="DestroyIcon", SetLastError:=True)> _
        Shared Function DestroyIcon(ByVal hIcon As IntPtr) As Integer
        End Function

        Public Shared Function DosyaTipindenIconAl() As Hashtable
            Try
                'HKEY_CLASSES_ROOT kayıt defteri bölümü temsil etmek için bir kayıt defteri anahtarı nesne oluşturma
                Dim rkRoot As RegistryKey = Registry.ClassesRoot

                'Tüm alt anahtarlar isimlerini alır.
                Dim keyNames As String() = rkRoot.GetSubKeyNames()
                Dim IconBilgisi As New Hashtable()

                'Dosya Ikonunu bul
                For Each keyName As String In keyNames
                    If [String].IsNullOrEmpty(keyName) Then
                        Continue For
                    End If
                    Dim indexOfPoint As Integer = keyName.IndexOf(".")

                    'Bu anahtarı bir dosya (Extension) uzantısı,  örneğin(.Zip; .bmp; .jpg) değilse, atlayın.
                    If indexOfPoint <> 0 Then
                        Continue For
                    End If

                    Dim rkFileType As RegistryKey = rkRoot.OpenSubKey(keyName)
                    If rkFileType Is Nothing Then
                        Continue For
                    End If

                    'Dosya türü bilgileri içeren bu anahtarın varsayılan değeri alır.
                    Dim defaultValue As Object = rkFileType.GetValue("")
                    If defaultValue Is Nothing Then
                        Continue For
                    End If

                    'Bu dosya türü ile varsayılan simge ortakları belirten anahtarına gidin.
                    Dim defaultIcon As String = defaultValue.ToString() + "\DefaultIcon"
                    Dim rkFileIcon As RegistryKey = rkRoot.OpenSubKey(defaultIcon)
                    If rkFileIcon IsNot Nothing Then
                        'Dosya simgesi ve bu dosyada simge dizini içereni alın.
                        Dim value As Object = rkFileIcon.GetValue("")
                        If value IsNot Nothing Then
                            'Hatayı önlemek için dizede tüm gereksiz "  işareti temizleyin.
                            Dim fileParam As String = value.ToString().Replace("""", "")
                            IconBilgisi.Add(keyName, fileParam)
                        End If
                        rkFileIcon.Close()
                    End If
                    rkFileType.Close()
                Next
                rkRoot.Close()
                Return IconBilgisi
            Catch exc As Exception
                Throw exc
            End Try
        End Function

        Public Shared Function DosyadanSimgeAl(ByVal DosyaVeIcon As String) As Icon
            Try
                Dim embeddedIcon As EmbeddedIconInfo = GomuluSimgeBilgisiAl(DosyaVeIcon)

                ' tanıtıcı Simgesini alır.
                Dim lIcon As IntPtr = ExtractIcon(0, embeddedIcon.FileName, embeddedIcon.IconIndex)

                'Gerçek simgeyi alır.
                Return Icon.FromHandle(lIcon)
            Catch exc As Exception
                Throw exc
            End Try
        End Function

        Public Shared Function DosyadanSimgeAl(ByVal DosyaVeIcon As String, ByVal Buyukse As Boolean) As Icon
            Dim SimgeSayisiniBul As UInteger = 0
            Dim YapayH As IntPtr() = New IntPtr(0) {IntPtr.Zero}
            Dim UzantiIconuH As IntPtr() = New IntPtr(0) {IntPtr.Zero}

            Try
                Dim embeddedIcon As EmbeddedIconInfo = GomuluSimgeBilgisiAl(DosyaVeIcon)

                If Buyukse Then
                    SimgeSayisiniBul = ExtractIconEx(embeddedIcon.FileName, 0, UzantiIconuH, YapayH, 1)
                Else
                    SimgeSayisiniBul = ExtractIconEx(embeddedIcon.FileName, 0, YapayH, UzantiIconuH, 1)
                End If

                If SimgeSayisiniBul > 0 AndAlso UzantiIconuH(0) <> IntPtr.Zero Then
                    'Ilk simgeyi al.
                    Dim extractedIcon As Icon = DirectCast(Icon.FromHandle(UzantiIconuH(0)).Clone(), Icon)

                    Return extractedIcon
                Else
                    ' alınacak Simge yok
                    Return Nothing
                End If
            Catch exc As Exception
                'Simge hatası ayıklayın.
                Throw New ApplicationException("Simgesi ayıklamak olamazdı", exc)
            Finally
                'Çıkış kaynakları.
                For Each ptr As IntPtr In UzantiIconuH
                    If ptr <> IntPtr.Zero Then
                        DestroyIcon(ptr)
                    End If
                Next

                For Each ptr As IntPtr In YapayH
                    If ptr <> IntPtr.Zero Then
                        DestroyIcon(ptr)
                    End If
                Next
            End Try

        End Function

        Protected Shared Function GomuluSimgeBilgisiAl(ByVal DosyaVeIcon As String) As EmbeddedIconInfo
            Dim embeddedIcon As New EmbeddedIconInfo()
            If [String].IsNullOrEmpty(DosyaVeIcon) Then
                Return embeddedIcon
            End If

            'Use to store the file contains icon.
            Dim fileName As String = [String].Empty

            'The index of the icon in the file.
            Dim iconIndex As Integer = 0
            Dim iconIndexString As String = [String].Empty

            Dim commaIndex As Integer = DosyaVeIcon.IndexOf(",")
            'if DosyaVeIcon is some thing likes that: "C:\\Program Files\\NetMeeting\\conf.exe,1".
            If commaIndex > 0 Then
                fileName = DosyaVeIcon.Substring(0, commaIndex)
                iconIndexString = DosyaVeIcon.Substring(commaIndex + 1)
            Else
                fileName = DosyaVeIcon
            End If

            If Not [String].IsNullOrEmpty(iconIndexString) Then
                'Get the index of icon.
                iconIndex = Integer.Parse(iconIndexString)
                If iconIndex < 0 Then
                    iconIndex = 0
                    'To avoid the invalid index.
                End If
            End If

            embeddedIcon.FileName = fileName
            embeddedIcon.IconIndex = iconIndex

            Return embeddedIcon
        End Function

        Shared Function DosyadanSimgeAl(icon As Drawing.Icon, Buyukse As Boolean) As Drawing.Icon
            Throw New NotImplementedException
        End Function

    End Class

#End Region

#Region "   FORM1 OLAYLARI.."
    Private Property GecerliBoyut As ImageSize
    Private Property IconBilgisi As Hashtable

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        Try
            'Gets file type and icon info.
            Me.IconBilgisi = RegisteredFileType.DosyaTipindenIconAl()
            Me.GecerliBoyut = ImageSize.Large

            'Loads file types to ListBox.
            For Each objString As Object In Me.IconBilgisi.Keys
                Me.TipListesi.Items.Add(objString)
            Next

        Catch exc As Exception
            MessageBox.Show(exc.Message)
        End Try

    End Sub


#Region "    RADIOBUTTON SECİM OLAYLARI.."


    Private Sub BykRdioBtn_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles BykRdioBtn.CheckedChanged

        Try

            If Me.TipListesi.Items.Count <= 0 OrElse Me.TipListesi.SelectedItem Is Nothing Then
                Return
            End If

            Me.GecerliBoyut = ImageSize.Large
            Call UzantiVeIConuBulGoster()

        Catch exc As Exception
            MessageBox.Show(exc.Message)
        End Try

    End Sub

    Private Sub BykRdioBtn_RightToLeftChanged(sender As System.Object, e As System.EventArgs) Handles BykRdioBtn.RightToLeftChanged
        If Me.BykRdioBtn.Checked Then
            Me.GecerliBoyut = ImageSize.Large
            'Me.Cevir()
            Beep()
            Call UzantiVeIConuBulGoster()
        End If
    End Sub

    Private Sub KckRdioBtn_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles KckRdioBtn.CheckedChanged
        If Me.KckRdioBtn.Checked Then
            Me.GecerliBoyut = ImageSize.Small
            'Me.Cevir()
            Call UzantiVeIConuBulGoster()
        End If
    End Sub
#End Region

#Region "     ARAMA BUTONU OLAYLARI.."


    Private Sub AramaBtn_Click(sender As System.Object, e As System.EventArgs) Handles AramaBtn.Click
        If String.IsNullOrEmpty(Me.ArananTxt.Text.Trim()) Then
            Return
        End If
        Dim ArananAd As String = [String].Empty
        If Not Me.ArananTxt.Text.Contains(".") Then
            ArananAd = "." + Me.ArananTxt.Text
        Else
            'Aranan metin yoksa 'bir nokta ekleyin.
            ArananAd = Me.ArananTxt.Text
        End If

        'Dosya türleri ve simgelerini koleksiyonlarında arar.
        Dim objAdi As Object = Me.IconBilgisi(ArananAd)
        If objAdi IsNot Nothing Then
            Me.TipListesi.SelectedItem = ArananAd
        End If

    End Sub
#End Region

#Region "     TİP LİSTE OLAYLARI.."

    Private Sub TipListesi_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles TipListesi.SelectedIndexChanged

        ArananTxt.Text = TipListesi.Items(TipListesi.SelectedIndex)

        Call UzantiVeIConuBulGoster()

        If HataVar = True Then
            Timer1.Interval = 50
            Timer1.Start()
            Lbl_HataMsj.Text = "(" & ArananTxt.Text & ")" & " Ikonu Oluşturamadı"
            IkonGosterPic.Image = Nothing
        Else
            Lbl_HataMsj.Visible = False
            Lbl_HataMsj.Text = ""
        End If



    End Sub

#End Region

    Private Sub ArananTxt_TextChanged(sender As System.Object, e As System.EventArgs) Handles ArananTxt.TextChanged
        If String.IsNullOrEmpty(Me.ArananTxt.Text.Trim()) Then
            Me.AramaBtn.Enabled = False
        Else
            Me.AramaBtn.Enabled = True
        End If
    End Sub

    Public Sub UzantiVeIConuBulGoster()
        'Dim DsyTipi As String = Me.TipListesi.SelectedItem.ToString()

        Try
            Dim DosyaVeIcon As String = (Me.IconBilgisi(ArananTxt.Text)).ToString()

            If [String].IsNullOrEmpty(DosyaVeIcon) Then
                Return
            End If

            Dim icon As Icon = Nothing

            Dim Buyukse As Boolean = True

            If GecerliBoyut = ImageSize.Small Then
                Buyukse = False
            End If

            icon = RegisteredFileType.DosyadanSimgeAl(DosyaVeIcon, Buyukse)

            'RegisteredFileType.DosyadanSimgeAl (DosyaVeIcon);
            'Simge sıfır olamaz.

            If icon IsNot Nothing Then
                'Resim kutusu simgesi çizin.
                Me.IkonGosterPic.Image = icon.ToBitmap()
            Else
                'simgesi geçersiz ise   bir hata resimi göster
                Me.IkonGosterPic.Image = Me.IkonGosterPic.ErrorImage
            End If
        Catch exc As Exception
            HataVar = True
            'mesajı labelde bir timer ile belli bir süre vermek daha kullanışlı olur. hata değişkeni ona yarayacak
            'MessageBox.Show(exc.Message & vbCrLf & "(" & ArananTxt.Text & ")" & " Ikonu Oluşturamadı")
        End Try
    End Sub

    Private Sub IkonGoster(DsyTipi As String)
        Try
            Throw New NotImplementedException

        Catch ex As Exception

        End Try
    End Sub

    Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick

        Lbl_HataMsj.Visible = True
        Timer1.Interval = Timer1.Interval - 1
        If Timer1.Interval = 1 Then Lbl_HataMsj.Visible = False : HataVar = False : Timer1.Stop()
    End Sub

#End Region

End Class
xThen, üyesi illegalizm | Private illegal Topluluk - Hack forum,Warez Scriptler forumlarına 11.07.2015 tarihinde katılmıştır.

WWW Alıntı ile Cevapla


Hızlı Menü:


Konuyu Okuyanlar: 1 Ziyaretçi
hd porno antalya escort türk ifşa porno izle türk ifşa porno samsun escort izmir escort ataşehir escort türk ifşa hd porno