C# KOD ÖRNEKLERİ: Mayıs 2013

26 Mayıs 2013 Pazar

TABLI WEB BROWSER ÖRNEĞİ

TABLI BROWSER KODLARI İNDİR
TABLI BROWSER SADECE EXE İNDİR

Form1 kodları

Imports System.Runtime.InteropServices 'PANO
Imports System.Xml

Public Class Form1

#Region " DEĞİKEN TANIMLAMA...."
    Public PanodanAlınan As String
    Public SecilenIndex As Integer
    Public AyniLinkKayitli As Boolean = False
    Public eleman As ListViewItem
    '
    Dim tabCount As Integer = 0
    Dim browser As New WebBrowser
    Dim url As String
    Dim dialog As DialogResult
    Dim i As Integer

#End Region

#Region " PANO İŞLEMLERİ...."

Private Const WM_DRAWCLIPBOARD As Integer = &H308
    Private Const WM_CHANGECBCHAIN As Integer = &H30D
    Private mNextClipBoardViewerHWnd As IntPtr
    Private Event OnClipboardChanged()

<DllImport("user32")> _
    Private Shared Function SetClipboardViewer(ByVal hWnd As IntPtr) As IntPtr
    End Function

<DllImport("user32")> _
    Private Shared Function ChangeClipboardChain(ByVal hWnd As IntPtr, ByVal hWndNext As IntPtr) As _
    <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function

<DllImport("user32")> _
    Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, _
    ByVal lParam As IntPtr) As IntPtr
    End Function

Protected Overrides Sub WndProc(ByRef m As Message)

Select Case m.Msg
            Case WM_DRAWCLIPBOARD
                RaiseEvent OnClipboardChanged()
                SendMessage(mNextClipBoardViewerHWnd, m.Msg, m.WParam, m.LParam)

Case WM_CHANGECBCHAIN
                If m.WParam.Equals(mNextClipBoardViewerHWnd) Then
                    mNextClipBoardViewerHWnd = m.LParam
                Else
                    SendMessage(mNextClipBoardViewerHWnd, m.Msg, m.WParam, m.LParam)
                End If
        End Select
        MyBase.WndProc(m)
    End Sub

'Dışardan panoya alınan bilgi değişiklik

Private Sub ClipBoardChanged()

If My.Computer.Clipboard.ContainsText Then
            If Uri.IsWellFormedUriString(My.Computer.Clipboard.GetText, UriKind.Absolute) Then

PanodanAlınan = (My.Computer.Clipboard.GetText)
                Dim uri As New Uri(PanodanAlınan)

SiteNotu.Text = uri.Host
                Dim uz As Integer
                uz = Len(SiteNotu.Text)
                If Mid(SiteNotu.Text, 1, 4) = "www." Then SiteNotu.Text = Mid(uri.Host, 5, uz)

SiteURLsi.Text = uri.AbsoluteUri
                TextURL.Text = uri.AbsoluteUri
                Call aynıKayıtVarMı()
                If AyniLinkKayitli = False Then Call ekle() : Call linkTextleriSil()
            End If
        End If
        Call linkTextleriSil()
    End Sub

Public Sub linkTextleriSil()
        SiteNotu.Text = ""
        SiteURLsi.Text = ""
        EkleBtn.Enabled = False
        AyniLinkKayitli = False
    End Sub

Private Sub PanodanYapistirBtn_Click(sender As System.Object, e As System.EventArgs) Handles PanodanYapistirBtn.Click

If Uri.IsWellFormedUriString(My.Computer.Clipboard.GetText, UriKind.Absolute) Then
            PanodanAlınan = (My.Computer.Clipboard.GetText)
            Dim uri As New Uri(PanodanAlınan)

SiteNotu.Text = uri.Host
            SiteURLsi.Text = uri.AbsoluteUri
            Call aynıKayıtVarMı()
            EkleBtn.PerformClick()
        End If

End Sub
#End Region

#Region " FORM İŞLEMLERİ...."

Private Sub Form1_FormClosed(sender As Object, e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
        SaveSetting(Application.ProductName, Application.ProductName, "Form Durumu", Me.WindowState)
        SaveSetting(Application.ProductName, Application.ProductName, "Yeni Tab Aç", Me.CheckBox1.Checked)
        End
    End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

Me.CheckBox1.Checked = GetSetting(Application.ProductName, Application.ProductName, "Yeni Tab Aç", False)
        Me.WindowState = GetSetting(Application.ProductName, Application.ProductName, "Form Durumu", 2)
        HkkFrm.ListeKapatChk.Checked = GetSetting(Application.ProductName, Application.ProductName, "Listeyi kapat", True)

'PANO
        mNextClipBoardViewerHWnd = SetClipboardViewer(Me.Handle)
        AddHandler Me.OnClipboardChanged, AddressOf ClipBoardChanged
        'PANO
        Call ListeYukle()
        ToolTip1.SetToolTip(TsGeri, " Geri Git ")
        ToolTip1.SetToolTip(Tsileri, " İleri Git ")
        ToolTip1.SetToolTip(TsTabAç, " Yeni Sekme Aç ")
        ToolTip1.SetToolTip(TsYeniSayfadaAç, " Yeni explorede Aç")
        ToolTip1.SetToolTip(TsTabSil, " Sekme sil ")
        ToolTip1.SetToolTip(TsHome, " Ana Sayfayı Aç (Google)")
        ToolTip1.SetToolTip(CheckBox1, " Tek Sekmede veya Yeni sekmede Aç seçeneği ")
        ToolTip1.SetToolTip(GitBtn, " Linki Çalıştır ")
        ToolTip1.SetToolTip(btnRefresh, " Sayfayı Güncelle ")
        ToolTip1.SetToolTip(TsFavListesi, " Favori Linkler Listesini Aç_kapat ")
        ToolTip1.SetToolTip(TsLinkEkle, " Favori listesine Manuel Eklemek ")
        ToolTip1.SetToolTip(SaklaBtn, " Favori listesini Sakla ")
        ToolTip1.SetToolTip(ListeKapatPic, " Listeyi Kapat ")
        ' 
        Me.SplitContainer1.Panel1Collapsed = False
        Me.SplitContainer1.Panel2Collapsed = True
        KYTimer.Interval = 20

TabControl1.TabPages.Add("TabBrowser")
        browser.Dock = DockStyle.Fill
        TabControl1.SelectedTab.Controls.Add(browser)
        AddHandler browser.DocumentCompleted, AddressOf Module1.Web_loading

tabCount = tabCount + 1
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).GoHome()
        TextURL.Focus()
    End Sub

Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
        If e.KeyCode = Keys.ControlKey Then
            CheckBox1.Checked = True
        End If
    End Sub

Private Sub Form1_KeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyUp
        If e.KeyCode = Keys.ControlKey Then
            CheckBox1.Checked = False
        End If
    End Sub

#End Region

#Region " TAB İŞLEMLERİ...."

Private Sub TsTabAç_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TsTabAç.Click
        Call TabAc()
    End Sub

Public Sub TabAc()

On Error Resume Next
        Dim Browser As New WebBrowser
        TabControl1.TabPages.Add(TextURL.Text)

TabControl1.SelectTab(tabCount)
        Browser.Dock = DockStyle.Fill

TabControl1.SelectedTab.Controls.Add(Browser)

AddHandler Browser.DocumentCompleted, AddressOf Module1.Web_loading
        tabCount = tabCount + 1

If TabControl1.TabCount = 1 Then
            TsTabSil.Image = Me.ImList.Images("GriSilTab.ico")
        ElseIf TabControl1.TabCount > 1 Then
            TsTabSil.Image = Me.ImList.Images("SilTab.ico")
        End If
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).Navigate(TextURL.Text)
    End Sub

#End Region

#Region " DURUMBAR İŞLEMLERİ...."

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        On Error Resume Next
        Me.Text = CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).DocumentTitle ' + "  << TabBrowser >> " + Format(TimeOfDay) + " " + (My.Computer.Name)
        ToolStripStatusLabel1.Text = CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).StatusText
    End Sub
#End Region

#Region " MENUSTRİP MENÜ TIKLAMA İŞLEMLERİ...."

Private Sub BrowserTs2_Click(sender As System.Object, e As System.EventArgs) Handles BrowserTs2.Click
        Dim NewMe As New Form1
        NewMe.Show()
    End Sub

cdlOpen.Title = " Dosya Aç "
            cdlOpen.ShowDialog()

If cdlOpen.FileName > Nothing Then
                CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).Navigate(cdlOpen.FileName)
            End If
        Catch ex As Exception
            Throw New Exception(ex.Message.ToString)
        End Try
    End Sub

Private Sub SaklaTs1_Click(sender As System.Object, e As System.EventArgs) Handles SaklaTs1.Click
        Dim saveFileDialog1 As New SaveFileDialog()
        saveFileDialog1.Filter = "HTML Dosyası|*.html|Text dosyası|*.txt"
        saveFileDialog1.Title = "TabBrowser | | İmaj Dosyası sakla"
        saveFileDialog1.FileName = CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).DocumentTitle
        saveFileDialog1.ShowDialog()
        My.Computer.FileSystem.WriteAllText(saveFileDialog1.FileName, CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).DocumentText, False)
    End Sub

Private Sub YazdırTs1_Click(sender As System.Object, e As System.EventArgs) Handles YazdırTs1.Click
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).ShowPrintDialog()
    End Sub

Private Sub ÖnizlemeTs1_Click(sender As System.Object, e As System.EventArgs) Handles ÖnizlemeTs1.Click
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).ShowPrintPreviewDialog()
    End Sub

Private Sub AyarlarTs_Click(sender As System.Object, e As System.EventArgs)
        On Error Resume Next
        'hatalı
        CType(TabControl1.Controls.Item(0), WebBrowser).ShowPageSetupDialog()
    End Sub

Private Sub ÖzelliklerTs1_Click(sender As System.Object, e As System.EventArgs) Handles ÖzelliklerTs1.Click
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).ShowPropertiesDialog()
    End Sub

Private Sub ÇıkTs1_Click(sender As System.Object, e As System.EventArgs) Handles ÇıkTs1.Click
        Me.Close()
    End Sub

Private Sub KesTs1_Click(sender As System.Object, e As System.EventArgs) Handles KesTs1.Click
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).Document.ExecCommand("Cut", False, vbNull)
    End Sub

Private Sub KopyalaTs1_Click(sender As System.Object, e As System.EventArgs) Handles KopyalaTs1.Click
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).Document.ExecCommand("Copy", False, vbNull)
        Clipboard.SetText(TextURL.Text, TextDataFormat.Text)
    End Sub

Private Sub YapıştırTs1_Click(sender As System.Object, e As System.EventArgs) Handles YapıştırTs1.Click
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).Document.ExecCommand("Paste", False, vbNull)
        TextURL.Text = Clipboard.GetText
    End Sub

Private Sub TümünüSeçTs1_Click(sender As System.Object, e As System.EventArgs) Handles TümünüSeçTs1.Click
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).Document.ExecCommand("Selectall", False, vbNull)
    End Sub

Private Sub AnasayfaTs1_Click(sender As System.Object, e As System.EventArgs) Handles AnasayfaTs1.Click
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).GoHome()
    End Sub

Private Sub GerTs1_Click(sender As System.Object, e As System.EventArgs) Handles GerTs1.Click, TsGeri.Click
        If CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).CanGoBack Then
            CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).GoBack()
        Else
            If CheckBox1.Checked = True Then Exit Sub 'TsTabSil_Click(sender, e) :
            'MsgBox("Web tarayıcı geçmişi sonuna geldi", MsgBoxStyle.Critical, "TabBrowser Sayfası")
            TsGeri.Enabled = False
            If Tsileri.Enabled = False Then Tsileri.Enabled = True
        End If
    End Sub

Private Sub ileriTs1_Click(sender As System.Object, e As System.EventArgs) Handles ileriTs1.Click, Tsileri.Click
        If CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).CanGoForward Then
            CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).GoForward()
        Else
            If CheckBox1.Checked = True Then Exit Sub
            'MsgBox("Bu web tarayıcısı gelecek sonuna geldik", MsgBoxStyle.Critical, "TabBrowser Sayfası ")

Tsileri.Enabled = False
            If TsGeri.Enabled = False Then TsGeri.Enabled = True
        End If
    End Sub

Private Sub ZomTs_Click(sender As System.Object, e As System.EventArgs) Handles ZomTs.Click
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).Refresh()
    End Sub

Private Sub Zum10Art_Click(sender As System.Object, e As System.EventArgs) Handles Zum10Art.Click
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).Document.Body.Style = "zoom:110%"
    End Sub

Private Sub Zum50Art_Click(sender As System.Object, e As System.EventArgs) Handles Zum50Art.Click
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).Document.Body.Style = "zoom:150%"
    End Sub

Private Sub Zum70Art_Click(sender As System.Object, e As System.EventArgs) Handles Zum70Art.Click
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).Document.Body.Style = "zoom:170%"
    End Sub

Private Sub Zum90Art_Click(sender As System.Object, e As System.EventArgs) Handles Zum90Art.Click
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).Document.Body.Style = "zoom:190%"
    End Sub

Private Sub Zum100Art_Click(sender As System.Object, e As System.EventArgs) Handles Zum100Art.Click
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).Document.Body.Style = "zoom:100%"
    End Sub

Private Sub Zum90Eks_Click(sender As System.Object, e As System.EventArgs) Handles Zum90Eks.Click
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).Document.Body.Style = "zoom:90%"
    End Sub

Private Sub Zum70Eks_Click(sender As System.Object, e As System.EventArgs) Handles Zum70Eks.Click
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).Document.Body.Style = "zoom:70%"
    End Sub

Private Sub Zum50Eks_Click(sender As System.Object, e As System.EventArgs) Handles Zum50Eks.Click
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).Document.Body.Style = "zoom:50%"
    End Sub

Private Sub Zum10Eks_Click(sender As System.Object, e As System.EventArgs) Handles Zum10Eks.Click
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).Document.Body.Style = "zoom:10%"
    End Sub

Private Sub IExpÖzellikTs_Click(sender As System.Object, e As System.EventArgs) Handles IExpÖzellikTs.Click
        'internet Özellikleri
        Shell("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl,,0", vbNormalFocus)
    End Sub

Private Sub HkkTs1_Click(sender As System.Object, e As System.EventArgs) Handles HkkTs1.Click
        HkkFrm.ShowDialog()
    End Sub

#End Region

#Region " DÜĞMELER PANELİ VE TKLAMA İŞLEMLERİ...."

Private Sub TsGeri_Click(sender As System.Object, e As System.EventArgs)
        Call GerTs1.PerformClick()
    End Sub

Private Sub Tsileri_Click(sender As System.Object, e As System.EventArgs)
        Call ileriTs1.PerformClick()
    End Sub

Private Sub TsHome_Click(sender As System.Object, e As System.EventArgs) Handles TsHome.Click
        Call AnasayfaTs1.PerformClick()
    End Sub

Private Sub TabEkleTs_Click(sender As System.Object, e As System.EventArgs) Handles TabEkleTs.Click
        Call TabAc()
    End Sub

Private Sub TsYeniSayfadaAç_Click(sender As System.Object, e As System.EventArgs) Handles TsYeniSayfadaAç.Click
        Me.BrowserTs2.PerformClick()
    End Sub

Private Sub TsTabSil_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TsTabSil.Click
        Dim sayfa As TabPage
        Dim silinen As Integer
        sayfa = TabControl1.SelectedTab
        If TabControl1.SelectedIndex = 0 And TabControl1.TabCount = 1 Then Exit Sub
        If Not sayfa Is Nothing Then
            sayfa.Dispose()
            silinen = silinen + 1
            TabControl1.SelectedIndex = TabControl1.TabCount - silinen
            If TabControl1.TabCount = 1 Then
                TsGeri.Enabled = True
                Tsileri.Enabled = False
                TsTabSil.Image = Me.ImList.Images("GriSilTab.ico")
            ElseIf TabControl1.TabCount >= 1 Then
                TsTabSil.Image = Me.ImList.Images("SilTab.ico")
            End If

End If
    End Sub

Private Sub CheckBox1_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles CheckBox1.CheckedChanged, CheckBox1.Click
        If CheckBox1.Checked = False Then
            CheckBox1.Image = Me.ImList.Images("Aynı_Sekmede.ico")
            TsGeri.Enabled = True
            Tsileri.Enabled = False
        Else
            CheckBox1.Image = Me.ImList.Images("Yeni_Sekmede.ico")
            TsGeri.Enabled = False
            Tsileri.Enabled = False
        End If
        SaveSetting(Application.ProductName, Application.ProductName, "Yeni Tab Aç", Me.CheckBox1.Checked)

End Sub
    Private Sub GitBtn_Click(sender As System.Object, e As System.EventArgs) Handles GitBtn.Click
        If TextURL.Text <> "" Then
            Me.browser.Navigate(TextURL.Text)
        End If
    End Sub
    Private Sub btnRefresh_Click(sender As System.Object, e As System.EventArgs) Handles btnRefresh.Click
        Me.browser.Refresh()
    End Sub

#Region " FAVORİLER LİSTESİ...."

Private Sub TsLinkEkle_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TsLinkEkle.Click
        Try
            If (MessageBox.Show(Me.TextURL.Text & vbCrLf & "Üstteki Link favorilere eklensin mi :  ", "Link ekle", MessageBoxButtons.YesNo) = Windows.Forms.DialogResult.Yes) Then
                Clipboard.SetText(TextURL.Text, TextDataFormat.Text)
            End If
        Catch ex As Exception
        End Try

End Sub

Private Sub TabTs_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TabTs.Click
        Dim Browser As New WebBrowser
        TabControl1.TabPages.Add("TabBrowser")
        TabControl1.SelectTab(tabCount)
        Browser.Dock = DockStyle.Fill
        TabControl1.SelectedTab.Controls.Add(Browser)
        AddHandler Browser.DocumentCompleted, AddressOf Module1.Web_loading
        tabCount = tabCount + 1
        CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).Navigate(TextURL.Text)
    End Sub
    Private Sub TsFavListesi_Click(sender As System.Object, e As System.EventArgs) Handles TsFavListesi.Click
        Call FavoriListesi()
    End Sub
    Public Sub FavoriListesi()

If Me.WebLinkListesi.Visible = False Then 'liste gizli ise
            Me.TsFavListesi.Image = Me.ImList.Images("FavoriKlasör_Aç.ico")
            Me.SplitContainer1.Panel1Collapsed = False
            Me.SplitContainer1.Panel2Collapsed = False
            Me.WebLinkListesi.Visible = True
        Else
            Me.TsFavListesi.Image = Me.ImList.Images("FavoriKlasör_Kapat.ico")
            Me.SplitContainer1.Panel1Collapsed = True 'true tam ekran yapıyor
            Me.SplitContainer1.Panel2Collapsed = True
            Me.WebLinkListesi.Visible = False
            Call Listeyikaydet()
        End If
    End Sub
#End Region

#End Region

#Region " LİNK LİSTESİNİ YÜKLE.."

Private Sub ListeYukle()

On Error Resume Next
        WebLinkListesi.Items.Clear()

Dim XMLoku As New XmlTextReader(My.Application.Info.DirectoryPath & "\" & My.Settings.XmlFileName)

XMLoku.MoveToContent()

Dim ElementName As String = ""
        Dim NextItem As Boolean = True
        Dim objListViewItem As ListViewItem = Nothing

Do While XMLoku.Read
            If NextItem Then
                objListViewItem = New ListViewItem
                NextItem = False
            End If
            Select Case XMLoku.NodeType
                Case XmlNodeType.Element
                    ElementName = XMLoku.Name
                Case XmlNodeType.Text
                    If ElementName = "Name" Then
                        objListViewItem.Text = XMLoku.Value
                    End If
                    If ElementName = "URL" Then
                        objListViewItem.SubItems.Add(XMLoku.Value)
                        WebLinkListesi.Items.Add(objListViewItem)
                        NextItem = True
                    End If
            End Select
        Loop
        XMLoku.Close()
    End Sub
#End Region

#Region " LİNK LİSTESİNİ SAKLA.."

Private Sub SaklaBtn_Click(sender As System.Object, e As System.EventArgs) Handles SaklaBtn.Click
        Call Listeyikaydet()
    End Sub

Public Sub Listeyikaydet()

Dim XMLyaz As New XmlTextWriter(Application.StartupPath & My.Settings.XmlFileName, System.Text.Encoding.UTF8)
        With XMLyaz
            .Formatting = Formatting.Indented
            .WriteStartDocument()
            .WriteStartElement("WebSites")
            Dim ListViewNesnesi As New ListViewItem
            For Each ListViewNesnesi In WebLinkListesi.Items
                .WriteStartElement("WebSite")
                .WriteElementString("Name", ListViewNesnesi.Text)
                .WriteElementString("URL", ListViewNesnesi.SubItems(1).Text)
                .WriteEndElement()
            Next
            .WriteEndElement()
            .WriteEndDocument()
            .Flush()
            .Close()
        End With
        SaklaBtn.Enabled = False
    End Sub

Public Sub aynıKayıtVarMı()

Dim XMLoku As New XmlTextReader(My.Application.Info.DirectoryPath & "\" & My.Settings.XmlFileName)
        Dim x As Integer
        Dim sonn As Integer = My.Settings.XmlFileName.Count - 1

For x = 0 To WebLinkListesi.Items.Count - 1 'sonn

If WebLinkListesi.Items(x).SubItems(1).Text = TextURL.Text Then
                AyniLinkKayitli = True
                Beep()
                LblMesaj.Visible = True
                KYTimer.Start()
                LblMesaj.Text = "BU KAYIT ZATEN VAR"

EkleBtn.Enabled = False
                WebLinkListesi.Items(x).Selected = True
                WebLinkListesi.Focus()
                Exit Sub
            Else
                'EkleBtn.Enabled = True
                AyniLinkKayitli = False
            End If
        Next
    End Sub
    Private Sub KYTimer_Tick(sender As System.Object, e As System.EventArgs) Handles KYTimer.Tick
        'dinamic i As Integer
        i = i + 1

If i > 100 Then
            i = 0
            LblMesaj.Visible = False
            KYTimer.Stop()
        End If
    End Sub

#End Region

#Region " LİNK LİSTVİEW (Yükle, çalıştır,seç) İŞLEMLERİ.."

Private Sub ekle()
        WebLinkListesi.Sorting = SortOrder.None 'önce sırasız LW

Dim item As New ListViewItem
        item.Text = SiteNotu.Text.ToUpper
        item.SubItems.Add(SiteURLsi.Text)
        WebLinkListesi.Items.Add(item)

WebLinkListesi.Items(WebLinkListesi.Items.Count - 1).Selected = True
        WebLinkListesi.Sorting = SortOrder.Ascending 'indexi bulunduktan sonra liste sıralanır 
        'ListView' e ekleneni Görünür alanda göstermek 
        WebLinkListesi.Items(WebLinkListesi.Items.Count - 1).EnsureVisible()
        WebLinkListesi.Focus()
    End Sub

Private Sub WebLinkListesi_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles WebLinkListesi.DoubleClick
        If My.Computer.Network.IsAvailable = True Then
            If CheckBox1.Checked = True Then
                'yeni sekmede aç
                Call TabAc()
            Else
                'Aynı sekmede aç
                CType(TabControl1.SelectedTab.Controls.Item(0), WebBrowser).Navigate(TextURL.Text)

End If
        Else
            MsgBox("Bilgisayarınız İnternete Bağlı Değil.")
        End If
        If HkkFrm.ListeKapatChk.Checked = True Then
            Call FavoriListesi()
        End If

End Sub

Private Sub WebLinkListesi_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles WebLinkListesi.SelectedIndexChanged
        Dim sayi As Integer = WebLinkListesi.Items.Count
        Dim eleman As ListViewItem

For i As Integer = 0 To sayi - 1
            eleman = WebLinkListesi.Items(i)

If eleman.Selected Then
                TextURL.Text = WebLinkListesi.Items(i).SubItems(1).Text
                '-------------------------
                LblSecilenIndex.Text = i
                ColumnHeader1.Text = "Site Adı :  " & "(" & sayi & "  Kayıt sayısı)"
                ColumnHeader2.Text = "URL  " & "(" & i + 1 & " .Satır seçili)"
            End If
        Next
        SaklaBtn.Enabled = True
    End Sub

Public Sub SatırSil()
        On Error Resume Next
        Dim indexes As ListView.SelectedIndexCollection = WebLinkListesi.SelectedIndices
        Dim index As Integer

SiteURLsi.Clear()
        SiteNotu.Clear()

For Each index In indexes
            WebLinkListesi.Items.RemoveAt(index)
        Next

If index = 0 Then index = 0

index = index - 1

If index = -1 Then index = 0

ColumnHeader1.Text = "Site Adı :  " & "(" & index & "  Kayıt sayısı)"
        ColumnHeader2.Text = "URL  " & "(" & index & " .Satır seçili)"

eleman = WebLinkListesi.Items(index)
        eleman.Selected = True
        WebLinkListesi.Focus()
        SaklaBtn.Enabled = True
    End Sub

Private Sub WebLinkListesi_KeyDown(sender As System.Object, e As System.Windows.Forms.KeyEventArgs) Handles WebLinkListesi.KeyDown
        If e.KeyCode = Keys.Delete Then
            Call SatırSil()
        End If
        If e.KeyCode = Keys.Escape Then
            Call FavoriListesi()
        End If
    End Sub

Private Sub ListeKapatPic_Click(sender As System.Object, e As System.EventArgs) Handles ListeKapatPic.Click
        Call FavoriListesi()
    End Sub

Private Sub EkleBtn_Click(sender As System.Object, e As System.EventArgs) Handles EkleBtn.Click

If TextURL.Text = "" Then Exit Sub

Dim item As New ListViewItem
        item.Text = SiteNotu.Text.ToUpper
        item.SubItems.Add(TextURL.Text)
        Call aynıKayıtVarMı()
        If AyniLinkKayitli = False Then
            WebLinkListesi.Items.Add(item)
        End If
        WebLinkListesi.Items(WebLinkListesi.Items.Count - 1).Selected = True
        WebLinkListesi.Sorting = SortOrder.Ascending 'indexi bulunduktan sonra liste sıralanır
        EkleBtn.Enabled = False
    End Sub

Private Sub ListeBaşlıkPaneli_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles ListeBaşlıkPaneli.MouseDown
        If e.Button = Windows.Forms.MouseButtons.Right Then
            If Me.WebLinkListesi.HeaderStyle = ColumnHeaderStyle.Nonclickable Then
                Me.WebLinkListesi.HeaderStyle = ColumnHeaderStyle.None
            Else
                Me.WebLinkListesi.HeaderStyle = ColumnHeaderStyle.Nonclickable
            End If

End If
    End Sub

#End Region

#Region " LİNK COMBO İŞLEMLERİ.."

Private Sub comboURL_KeyDown(sender As System.Object, e As System.Windows.Forms.KeyEventArgs)
        If e.KeyCode = Keys.Enter Then
            If TextURL.Text <> "" Then
                Me.browser.Navigate(TextURL.Text)
            End If
        End If
    End Sub

#End Region

End Class

Form2 Kodları

Public NotInheritable Class HkkFrm

Private Sub AboutBox1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

Dim ApplicationTitle As String
        If My.Application.Info.Title <> "" Then
            ApplicationTitle = My.Application.Info.Title
        Else
            ApplicationTitle = System.IO.Path.GetFileNameWithoutExtension(My.Application.Info.AssemblyName)
        End If
        Me.Text = String.Format("Hakkında {0}", ApplicationTitle)

Label1.Text = My.Application.Info.ProductName
        Me.LabelProductName.Text = My.Application.Info.ProductName
        Me.LabelVersion.Text = String.Format("Version {0}", My.Application.Info.Version.ToString)
        Me.LabelCopyright.Text = My.Application.Info.Copyright
        Me.LabelCompanyName.Text = My.Application.Info.CompanyName
        Me.TextBoxDescription.Text = My.Application.Info.Description
    End Sub

Private Sub OKButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles OKButton.Click
        Me.Close()
    End Sub

Private Sub ListakapatChk_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles ListeKapatChk.CheckedChanged
        SaveSetting(Application.ProductName, Application.ProductName, "Listeyi kapat", ListeKapatChk.Checked)
    End Sub
End Class

17 Mayıs 2013 Cuma

İNTERNET BAĞLI MI, BAĞLANTIYI KES VEYA BAĞLAN KODU

Public Class Form1
    'Kablolu Enable (0)
    'Kablosuz Enable (1)
    ' kaynak http://social.msdn.microsoft.com/Forums/tr-TR/vbnettr/thread/a2723001-1d61-4e73-bda0-9f1f2f72327a

Private Sub nEnable()

Dim objWMIService = GetObject("winmgmts:\\.\root\cimv2")
        Dim colAdapters = objWMIService.Execquery("Select * from Win32_NetworkAdapter Where NetEnabled=false")
        colAdapters.ItemIndex(1).Enable()
        Label1.Text = "internete Bağlandı"

End Sub

Private Sub nDisable()

Dim objWMIService = GetObject("winmgmts:\\.\root\cimv2")
        Dim colAdapters = objWMIService.Execquery("Select * from Win32_NetworkAdapter Where NetEnabled=true")
        colAdapters.ItemIndex(0).Disable() 'kablosuz
        Label1.Text = "internet Bağlantısı kesildi"
    End Sub

Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
        Button1.Enabled = True
        Button2.Enabled = False

Call nDisable()
    End Sub

Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        Button1.Enabled = False
        Button2.Enabled = True

Call nEnable()
    End Sub

Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        Try
            'Google IP numaralarına ping at
            'Dim internet = My.Computer.Network.Ping("208.67.222.222")

'If internet = True Then
            If My.Computer.Network.IsAvailable = True Then
                Label1.Text = "internet var"
                Button1.Enabled = False
                Button2.Enabled = True
            Else
                Label1.Text = "internet yok"
                Button2.Enabled = False
                Button1.Enabled = True

End If
        Catch ex As Exception
            'Button1.Enabled = True
            'Label1.Text = "internet yok" & Chr(13) & "..."

End Try
    End Sub
End Class

FormBorder=None olan Forma Kenar Çizgisi Eklemek,Sürüklemek, Skin kullanmak

Public Class Form1
#Region " FORM TAŞIMAK..."
    Const i As Integer = &HA1
    Const j As Integer = 2

Private Sub Form1_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles SuruklePic.MouseDown, MyBase.MouseDown
        If e.Button = Windows.Forms.MouseButtons.Left Then
            Me.Capture = False  'Panelden,pictureden,textten,vb sürüklemek için o nesne adınıncapture özelliğini False yapınız  örnek:Picture1.capture=false, panel1.capture=false gibi..
            Dim msg As Message = Message.Create(Me.Handle, i, New IntPtr(j), IntPtr.Zero)
            Me.DefWndProc(msg)

End If
    End Sub
#End Region

#Region "  KENARSIZ FORMU BÜYÜTÜP KÜÇÜLTMEK.."

#Region "  Boyutlandırma değişkenleri"
    Dim GripDrag As Boolean
    Dim InitialSizeX As Integer
    Dim InitialSizeY As Integer
#End Region
    Private Sub SuruklePic_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles SuruklePic.MouseDown
        If e.Button = Windows.Forms.MouseButtons.Left Then
            GripDrag = True
            InitialSizeX = Me.Width
            InitialSizeY = Me.Height
        End If
    End Sub

Private Sub SuruklePic_MouseMove(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles SuruklePic.MouseMove
        If GripDrag = True Then
            Me.Width = InitialSizeX + (Windows.Forms.Cursor.Position.X - (Me.Width + Me.Location.X))
            Me.Height = InitialSizeY + (Windows.Forms.Cursor.Position.Y - (Me.Height + Me.Location.Y))
            InitialSizeX = Me.Width
            InitialSizeY = Me.Height
            Me.Refresh()
        End If
    End Sub

Private Sub SuruklePic_MouseUp(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles SuruklePic.MouseUp
        GripDrag = False
    End Sub
#End Region

Private Sub PictureBox1_Click(sender As System.Object, e As System.EventArgs) Handles PictureBox1.Click
        Me.Close()
    End Sub

Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        Form2.Show()
    End Sub
End Class

Public Class Form2
#Region " FORM TAŞIMAK..."
    Const i As Integer = &HA1
    Const j As Integer = 2

Private Sub Form2_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles SuruklePic.MouseDown, MyBase.MouseDown
        If e.Button = Windows.Forms.MouseButtons.Left Then
            Me.Capture = False  'Panelden,pictureden,textten,vb tut sürükle
            Dim msg As Message = Message.Create(Me.Handle, i, New IntPtr(j), IntPtr.Zero)
            Me.DefWndProc(msg)

End If
    End Sub
#End Region

#Region " FORM KENAR ÇİZGİSİ EKLEMEK..."
    Private Sub Form2_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
        Dim g As Graphics = Me.CreateGraphics
        Dim cizgi As New Pen(Color.Gray, 5) 'Color.Black,Color.Blue, 'Color.red
        Dim dikdortgen As Rectangle = Me.ClientRectangle
        dikdortgen.Inflate(-1, -1)
        g.DrawRectangle(cizgi, dikdortgen)
        g.Dispose()
    End Sub

#End Region

#Region "  KENARSIZ FORMU BÜYÜTÜP KÜÇÜLTMEK.."

Private Sub SuruklePic_MouseUp(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles SuruklePic.MouseUp
        GripDrag = False
    End Sub
#End Region

Private Sub PictureBox1_Click(sender As System.Object, e As System.EventArgs) Handles PictureBox1.Click
        Me.Close()
    End Sub
End Class

6 Mayıs 2013 Pazartesi

ListBox Verilerini Text Dosyasına Yazdırma ve Okutma örneği

KOD İNDİR

Public Class Form1
    Dim DsyYolu As String = Application.StartupPath
    Dim DsyAdi As String = "\Listem.txt"

Private Sub SaklaBtn_Click(sender As System.Object, e As System.EventArgs) Handles SaklaBtn.Click
        Dim liste As New List(Of String)
       
        For Each i In ListBox1.Items
            liste.Add(i)
        Next
        System.IO.File.WriteAllLines(DsyYolu & DsyAdi, liste.ToArray)
    End Sub

Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click

Dim dosya As New System.IO.StreamReader(DsyYolu & DsyAdi)
        Dim str As String = dosya.ReadToEnd()
        TextBox1.Text = str
        dosya.Close()
    End Sub

Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
        Try
            Dim openDLG As New OpenFileDialog
            openDLG.Filter = "Text Dosyaları (*.txt)|*.txt|Tüm Dosyalar (*.*)|*.*"
            openDLG.InitialDirectory = DsyYolu
            If openDLG.ShowDialog = DialogResult.OK Then

Dim dosya As New System.IO.StreamReader(openDLG.FileName)

Dim str As String = dosya.ReadToEnd()
                TextBox1.Text = str
                dosya.Close()
            End If
        Catch exc As Exception
            MessageBox.Show(exc.Message, " Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
        End Try
    End Sub

Private Sub ListeyeEkleBtn_Click(sender As System.Object, e As System.EventArgs) Handles ListeyeEkleBtn.Click
        If LstEkleTxt.Text = "" Then Beep() : LstEkleTxt.Focus() : Exit Sub
        ListBox1.Items.Add(LstEkleTxt.Text)
        LstEkleTxt.Text = ""
    End Sub

Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        TextBox1.Text = Nothing
    End Sub

Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load

LstEkleTxt.Focus()

End Sub

Private Sub ListBox1_KeyDown(sender As System.Object, e As System.Windows.Forms.KeyEventArgs) Handles ListBox1.KeyDown
        On Error Resume Next
        If e.KeyCode = Keys.Delete Then
            Call SatirSil()
        End If

End Sub
    Private Sub SatirSil()
        Dim secilecek, silinecek As Integer

If ListBox1.SelectedIndex <= ListBox1.Items.Count - 1 Then
            silinecek = ListBox1.SelectedIndex
            secilecek = silinecek - 1
            Me.ListBox1.Items.RemoveAt(silinecek)
            Me.ListBox1.SelectedIndex = secilecek

End If

If ListBox1.SelectedIndex = -1 And ListBox1.Items.Count - 1 >= 0 Then
            If silinecek = 0 Then
                Me.ListBox1.SetSelected(secilecek + 1, True)
                Exit Sub
            End If
        End If
    End Sub

Private Sub ListBox1_MouseHover(sender As System.Object, e As System.EventArgs) Handles ListBox1.MouseHover
        Dim tooltip As New ToolTip()
        tooltip.SetToolTip(ListBox1, "ListBoxtan satır Silmek için DELETE tuşunu kullanın")
    End Sub
End Class

5 Mayıs 2013 Pazar

EXE programın Ikonunu almak

Imports vb = Microsoft.VisualBasic
Imports System.IO
Public Class Form1
    Dim programAdi As String

Private Sub DsyAçBtn_Click(sender As System.Object, e As System.EventArgs) Handles DsyAçBtn.Click
        Dim openDLG As New OpenFileDialog
        openDLG.InitialDirectory = GetSetting(Application.ProductName, "Ayarlar", "Uygulama Yolu", "C:\Program Files")

openDLG.Multiselect = False
        openDLG.DefaultExt = "exe"
        openDLG.Filter = "Programlar (*.exe)|*.exe"

If openDLG.ShowDialog = DialogResult.OK Then
            If vb.Right((openDLG.FileName), 4) = ".exe" Then
                UyYoluTxt.Text = openDLG.FileName

Else
                Exit Sub
            End If

UygulamaAdıTxt.Text = System.IO.Path.GetFileName(openDLG.FileName)
            programAdi = Mid(UygulamaAdıTxt.Text, 1, Len(UygulamaAdıTxt.Text) - 4) '".exe" kısmını çıkarıyoruz
            UygulamaAdıTxt.Text = UygulamaAdıTxt.Text 'programAdi
            UyVarsayılanAdıTxt.Text = programAdi

Dim sonuc As Icon = Nothing
            sonuc= Icon.ExtractAssociatedIcon(openDLG.FileName)
            Me.Icon = sonuc
            Me.ikonPic.Image = Me.Icon.ToBitmap

If Clipboard.ContainsImage() Then 'picturebox 'u  panoya aktar
                ikonPic.Image = Clipboard.GetImage()
            End If
         
            SaveSetting(Application.ProductName, "Ayarlar", "Uygulama Yolu", openDLG.InitialDirectory)
        End If
    End Sub
End Class

PROGRAM İÇİNDEN KENDİ İKONUNU DESKTOP POPUP MENÜYE EKLEME ÖRNEĞİ

#Region "  MASAÜSTÜ POPUP MENÜSÜNE KISAYOL EKLEME-SİLME İŞLEMLERİ "

Private Sub MasaUstuMn_Click(sender As System.Object, e As System.EventArgs) Handles MasaUstuMn.Click

If MasaUstuMn.Checked = True Then
            On Error Resume Next
            MasaUstuMn.Checked = False
            MasaUstuMn.Image = IconLst.Images("Bağlam_Menu_R.ico")

Dim kayit As RegistryKey
            Dim anahtar As String = "DesktopBackground\Shell"  'Masaüstüne boş alana tıklayınca gelmesini istiyorsan regedit te kullanman gereken alan 
            kayit = Registry.ClassesRoot.OpenSubKey(anahtar, True).CreateSubKey(Application.ProductName) 'Sağ Click menüme programAdinı Oluşturdum.

Dim icoYol As String = (Application.StartupPath & "\" & Application.ProductName & ".exe") '        'MessageBox.Show(icoYol)

kayit.SetValue("Icon", icoYol)

kayit.SetValue("Position", "Top") 'Programın menüdeki pozisyonunu belirledim. Top,center,bottom
            kayit.CreateSubKey("command").SetValue("", Application.StartupPath & "\" & Application.ProductName & ".exe")

Else
            MasaUstuMn.Checked = True
            Call BaglamMenuSil()
            MasaUstuMn.Image = IconLst.Images("Bağlam_Menu_G.ico")
        End If
    End Sub
    Private Sub BaglamMenuSil()

Try
            Dim kayit As RegistryKey
            Dim anahtar As String = "DesktopBackground\Shell"
            kayit = Registry.ClassesRoot.OpenSubKey(anahtar, True).CreateSubKey(Application.ProductName)
            kayit.DeleteSubKey("command") 'Önce alt menüyü siliiyor 
            'sonra
            '
            kayit = Registry.ClassesRoot.OpenSubKey(anahtar, True)
            kayit.DeleteSubKey(Application.ProductName) 'Sonra bunu siliyor diğeri zaten önce silinmiş

'MessageBox.Show("Masaüstü PopUp Menüsü Silindi")

Catch ex As Exception
            Debug.WriteLine(ex.Message)
            MessageBox.Show(ex.Message)
            Debug.WriteLine(ex.StackTrace)
        End Try

End Sub

#End Region

4 Mayıs 2013 Cumartesi

Dosya Adı,Yolu Alt dizinleriyle Listeleme

Kodlarını .......................................... İNDİR

Imports System.IO

Public Class Form1
    Dim a As New ArrayList
    Dim yol As New DirectoryInfo("C:\WINDOWS")

Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click

''Dosya yolu ve adı
        On Error Resume Next
        For Each liste In yol.GetFiles("*.exe")
            Me.ListBox1.Items.Add(liste.FullName)
        Next
    End Sub
    Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
        'sadece Dosya adı listelenir
        ListBox1.DataSource = yol.GetFiles("*.exe") '("*.*")
    End Sub

Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click

' '' ListBox1.DataSource = yol.GetFiles("*.exe")  Bunu silmiyor hata veriyor 
        ' (ListBox1.DataSource = Nothing) şeklinde olmalı 
        On Error GoTo alt
        Me.ListBox1.Items.Clear()
        Exit Sub
alt:
        ListBox1.DataSource = Nothing
    End Sub

Public Sub adddirectory(ByVal subdir1 As String, ByVal subdir2 As String)
        Dim file() As String = System.IO.Directory.GetFiles(subdir1, subdir2)

For Each files As String In file
            a.Add(files)
        Next
        For Each subdir As String In System.IO.Directory.GetDirectories(subdir1)
            If System.IO.Directory.GetFiles(subdir).Length <> 0 Then
                adddirectory(subdir, subdir2)
            End If
        Next
    End Sub

Private Sub Button4_Click(sender As System.Object, e As System.EventArgs) Handles Button4.Click
        adddirectory("D:\MP3\MP3", "*.MP3")
        'a.Clear()
        For i = 0 To a.Count - 1
            ListBox1.Items.Add(a(i))
        Next
    End Sub

Private Sub Button5_Click(sender As System.Object, e As System.EventArgs) Handles Button5.Click
        Dim KlasorGosterFBD As New FolderBrowserDialog
        LblBaslamaDizini.Text = GetSetting(Application.ProductName, Application.ProductName, "Alt Klasör başlama yolu", "")

KlasorGosterFBD.SelectedPath = LblBaslamaDizini.Text

If (KlasorGosterFBD.ShowDialog() = DialogResult.OK) Then
            a.Clear()
            Windows.Forms.Cursor.Current = Cursors.AppStarting
            LblBaslamaDizini.Text = KlasorGosterFBD.SelectedPath

Dim dsyAdi As String
            Dim uzanti As String = "*.mp3"
            a.Clear()
            adddirectory(LblBaslamaDizini.Text, uzanti)

For z As Integer = 0 To a.Count - 1

dsyAdi = System.IO.Path.GetFileName(a(z))
                ListBox1.Items.Add(Mid(dsyAdi, 1, Len(dsyAdi) - 4))
               
            Next
        End If
        SaveSetting(Application.ProductName, Application.ProductName, "Alt Klasör başlama yolu", KlasorGosterFBD.SelectedPath)
    End Sub

End Class