15 Nisan 2013 Pazartesi
DOSYA İNDİRME PROJE KODLARI
DOSYA İNDİRME PROJE KODLARI
İNDİR
Not : VB.Net İle uğraşmayıp programı indirmek isteyenler için
Download.exe
İNDİR
Imports System.Net Imports Microsoft.Win32 ' Imports System.Runtime.InteropServices Imports System.IO 'liste Imports System.ComponentModel Public Class frmMain Dim Yaz As IO.StreamWriter Dim Yükle As IO.StreamReader Private Property Response As Object #Region " LİSTE DEĞİŞKEN VE KİTAPLIKLAR" Private Const WM_DRAWCLIPBOARD As Integer = &H308 Private Const WM_CHANGECBCHAIN As Integer = &H30D Private mNextClipBoardViewerHWnd As IntPtr Private Event OnClipboardChanged()
_ Private Shared Function SetClipboardViewer(ByVal hWnd As IntPtr) As IntPtr End Function
_ Private Shared Function ChangeClipboardChain(ByVal hWnd As IntPtr, ByVal hWndNext As IntPtr) As _
Boolean End Function
_ 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 #End Region #Region "PANODAN ALMA.." Private Sub ClipBoardChanged() If My.Computer.Clipboard.ContainsText Then If Uri.IsWellFormedUriString(My.Computer.Clipboard.GetText, UriKind.Absolute) Then ListBox1.Items.Add(My.Computer.Clipboard.GetText) 'If SplitContainer1.SplitterDistance = 37 Then ' SplitContainer1.SplitterDistance = 130 'Else ' SplitContainer1.SplitterDistance = 37 'End If End If End If End Sub #End Region #Region " frmMain OLAYLARI" Private Sub frmMain_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing ChangeClipboardChain(Me.Handle, mNextClipBoardViewerHWnd) 'pano olayı If ListBox1.Items.Count >= 1 Then LinkLstSakla.PerformClick() Else 'Dosya SİLME My.Computer.FileSystem.DeleteFile(Application.StartupPath & "\LinkDeposu.txt", FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin) End If SaveSetting(Application.ProductName, "Ayarlar", "üst", Me.Top) SaveSetting(Application.ProductName, "Ayarlar", "Sol", Me.Left) End Sub Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Me.Top = GetSetting(Application.ProductName, "Ayarlar", "üst", 200) Me.Left = GetSetting(Application.ProductName, "Ayarlar", "Sol", 200) UstteBtn.Checked = GetSetting(Application.ProductName, "Ayarlar", "Üstte Tut", False) If UstteBtn.Checked = False Then UstteBtn.Image = ÖneAlPic.Image UstteBtn.Checked = True Me.TopMost = False Else UstteBtn.Image = ArakayAlPic.Image UstteBtn.Checked = False Me.TopMost = True End If Me.Focus() Me.SaklamaAdresiTxt.Text = GetSetting(Application.ProductName, "Ayarlar", "Hedef Dizini", "C:\Users\" & KullAdi & "\Downloads\") ' Try KurulumuBaslat() Dim Dsyveyol As String = Application.StartupPath & "\LinkDeposu.txt" Dim dosyaBoyut As IO.FileInfo dosyaBoyut = My.Computer.FileSystem.GetFileInfo(Dsyveyol) 'MessageBox.Show("Dosya Boyut: " & dosyaBoyut.Length & " byte(s)") 'Dosya yoksa veya içi boş ise If Not System.IO.File.Exists(Dsyveyol) Or dosyaBoyut.Length <= 0 Then GoTo pasgec Call ListeYükle() If ListBox1.Items.Count - 1 >= 0 Then ListBox1.SelectedIndex = 0 'LinkListesiAcPic_Click(sender, e) 'Pano olayı pasgec: mNextClipBoardViewerHWnd = SetClipboardViewer(Me.Handle) AddHandler Me.OnClipboardChanged, AddressOf ClipBoardChanged Catch exc As Exception MessageBox.Show(exc.Message, " Bilgi!", MessageBoxButtons.OK, MessageBoxIcon.Information) End Try End Sub #End Region #Region "KURULUM OLAYLARI.." Sub KurulumuBaslat() Try AddHandler Indirilen.DownloadProgressChanged, AddressOf IlerlemeBariGoster AddHandler Indirilen.DownloadFileCompleted, AddressOf IndirmeBitti AddHandler SystemEvents.TimerElapsed, AddressOf IndirGuncelle Catch exc As Exception MessageBox.Show(exc.Message, " Bilgi!", MessageBoxButtons.OK, MessageBoxIcon.Information) End Try End Sub #End Region #Region "İNDİRME İŞLEMLERİ..." Sub IndirGuncelle(ByVal sender As Object, ByVal e As Microsoft.Win32.TimerElapsedEventArgs) Try GecenSure = TimeSpan.FromTicks((Now.Ticks - BaslamaSuresi)) lblGecenSure.Text = "Geçen Süre: " & String.Format("{0:00}:{1:00}:{2:00}", GecenSure.TotalHours, GecenSure.Minutes, GecenSure.Seconds) IndirmeHizi = (GecerliBayt - KalanBayt) lblHizKBayt.Text = "Hız: " & FormatNumber(IndirmeHizi / 1000, 2).ToString & " KB/s" lblHizKBit.Text = "Hız: " & FormatNumber((IndirmeHizi / 1000) * 8, 2).ToString & " Kb/s" KalanBayt = GecerliBayt Catch exc As Exception MessageBox.Show(exc.Message, " Bilgi!", MessageBoxButtons.OK, MessageBoxIcon.Information) End Try End Sub Sub Indir() Try Indirilen.DownloadFileAsync(indirilenDsy, SaklamaAdresiTxt.Text) IndirmeyaBasla = True btniptal.Enabled = True IndirmeyeBaslaBtn.Enabled = False IndirmeyaBasla = False Catch exc As Exception MessageBox.Show(exc.Message, " Bilgi!", MessageBoxButtons.OK, MessageBoxIcon.Information) End Try End Sub Sub IndirmeBitti(ByVal sender As Object, ByVal e As System.ComponentModel.AsyncCompletedEventArgs) Try If e.Cancelled Then lblDurum.Text = " İptal edildi" btnInenDsyAc.Enabled = False IndirmeyeBaslaBtn.BackColor = Color.Transparent IndirmeyeBaslaBtn.ForeColor = Color.Black Else lblDurum.Text = "Tamamlandı!" Beep() btnInenDsyAc.Enabled = True IndirmeyeBaslaBtn.BackColor = Color.Transparent IndirmeyeBaslaBtn.ForeColor = Color.Black End If btniptal.Enabled = False IndirmeyeBaslaBtn.Enabled = True If TimerID.ToInt32 > 0 Then SystemEvents.KillTimer(TimerID) TimerID = Nothing İlerlemeBarı.Visible = False End If Catch exc As Exception MessageBox.Show(e.Error.Message, " Bilgi!", MessageBoxButtons.OK, MessageBoxIcon.Information) End Try End Sub Sub IlerlemeBariGoster(ByVal sender As Object, ByVal e As System.Net.DownloadProgressChangedEventArgs) Try İlerlemeBarı.Value = e.ProgressPercentage lblilerlemeBarı.Text = "İlerleme: " & e.ProgressPercentage.ToString & "%" lblIndirilenBayt.Text = "İndirilen: " & FormatNumber(e.BytesReceived / 1000, 2).ToString & " KB" lblDosyaBoyutu.Text = "Dosya Boyutu: " & FormatNumber(e.TotalBytesToReceive / 1000, 2).ToString & " KB" GecerliBayt = e.BytesReceived Catch exc As Exception MessageBox.Show(exc.Message, " Bilgi!", MessageBoxButtons.OK, MessageBoxIcon.Information) End Try End Sub Private Sub IndirmeyeBaslaBtn_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles IndirmeyeBaslaBtn.Click Try İlerlemeBarı.Visible = True indirilenDsy = New Uri(IndirmeAdresiTxt.Text) İlerlemeBarı.MarqueeAnimationSpeed = 32 TimerID = SystemEvents.CreateTimer((2000)) Call Indir() BaslamaSuresi = Now.Ticks GecerliBayt = 0 KalanBayt = 0 IndirmeHizi = 0 İlerlemeBarı.Value = 0 lblDurum.ForeColor = System.Drawing.Color.FromName("Red") lblDurum.Text = "Başladı.." Catch exc As Exception MessageBox.Show(exc.Message, "İndir Butonu!", MessageBoxButtons.OK, MessageBoxIcon.Information) End Try End Sub Private Sub btniptal_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btniptal.Click Try If TimerID.ToInt32 > 0 Then SystemEvents.KillTimer(TimerID) TimerID = Nothing İlerlemeBarı.Visible = False IndirmeyeBaslaBtn.BackColor = Color.Transparent IndirmeyeBaslaBtn.ForeColor = Color.Black IndirmeyeBaslaBtn.Enabled = False End If Indirilen.CancelAsync() Catch exc As Exception MessageBox.Show(exc.Message, " Bilgi!", MessageBoxButtons.OK, MessageBoxIcon.Information) End Try End Sub Private Sub btnOpenDownload_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Try If My.Computer.FileSystem.FileExists(SaklamaAdresiTxt.Text) Then Process.Start(SaklamaAdresiTxt.Text) Else MessageBox.Show("Saklama konumunda Dosya yok" & vbNewLine & _ vbNewLine & "Dosya indirildi ve başarıyla kaydedildi ", " Dosya açamılmıyor", _ MessageBoxButtons.OK, MessageBoxIcon.Error) End If Catch exc As Exception MessageBox.Show(exc.Message, " Bilgi!", MessageBoxButtons.OK, MessageBoxIcon.Information) End Try End Sub #End Region Public Sub DosyaVarMi() Dim dosyaVarmi1 = My.Computer.FileSystem.FileExists(SaklamaAdresiTxt.Text) If dosyaVarmi1 = True Then Static i As Integer i = i.ToString + 1 yDsy = dsy & "(" & i & ")" '& ".rar" SaklamaAdresiTxt.Text = "C:\Users\" & KullAdi & "\Downloads\" & yDsy End If End Sub Private Sub HedefDznSec_Click(sender As System.Object, e As System.EventArgs) Handles HedefDznSec.Click Dim KlasorYoluDlg As New FolderBrowserDialog KlasorYoluDlg.SelectedPath = "C:\Users\" & KullAdi & "\Downloads\" KlasorYoluDlg.SelectedPath = SaklamaAdresiTxt.Text If (KlasorYoluDlg.ShowDialog() = DialogResult.OK) Then Windows.Forms.Cursor.Current = Cursors.AppStarting SaklamaAdresiTxt.Text = KlasorYoluDlg.SelectedPath SaveSetting(Application.ProductName, "Ayarlar", "Hedef Dizini", Me.SaklamaAdresiTxt.Text) End If End Sub Private Sub PanoyaAlPic_Click(sender As System.Object, e As System.EventArgs) On Error Resume Next 'panoya al Clipboard.SetText(IndirmeAdresiTxt.Text, TextDataFormat.Text) End Sub Public Function DosyaAdıBul(ByVal DosyaYolu As String) As String On Error Resume Next Dim SonPozisyon, Yenipozisyon As Integer, Filtre As String SonPozisyon = InStr(DosyaYolu, "/") Yenipozisyon = SonPozisyon Do While SonPozisyon > 0 Yenipozisyon = SonPozisyon SonPozisyon = InStr(Yenipozisyon + 1, DosyaYolu, "/") Loop Filtre = Mid(DosyaYolu, Yenipozisyon + 1) 'burdan aşağısı sadece dosya adını bulur SonPozisyon = InStr(Filtre, ".") Yenipozisyon = SonPozisyon Do While SonPozisyon > 0 Yenipozisyon = SonPozisyon SonPozisyon = InStr(Yenipozisyon + 1, Filtre, ".") Loop Filtre = Mid(Filtre, 1, Yenipozisyon - 1) Return Filtre End Function Private Sub PanodanYapistirPic_Click(sender As System.Object, e As System.EventArgs) Handles PanodanYapistirPic.Click ''panodan Texte Yapıştır IndirmeAdresiTxt.Text = Clipboard.GetText dsy = DosyaAdıBul(IndirmeAdresiTxt.Text) If dsy = "" Then Exit Sub SaklamaAdresiTxt.Text = GetSetting(Application.ProductName, "Ayarlar", "Hedef Dizini", Me.SaklamaAdresiTxt.Text) & "\" SaklamaAdresiTxt.Text = SaklamaAdresiTxt.Text & (dsy) ' & ".rar") Call DosyaVarMi() SaklamaAdresiTxt.Text = SaklamaAdresiTxt.Text End Sub Private Sub SilPic_Click(sender As System.Object, e As System.EventArgs) Handles SilPic.Click IndirmeAdresiTxt.Text = "" SaklamaAdresiTxt.Text = "" lblDurum.ForeColor = System.Drawing.Color.FromName("ControlText") IndirmeyeBaslaBtn.BackColor = Color.Transparent IndirmeyeBaslaBtn.ForeColor = Color.Black IndirmeyeBaslaBtn.Enabled = False Me.SaklamaAdresiTxt.Text = GetSetting(Application.ProductName, "Ayarlar", "Hedef Dizini", "C:\Users\" & KullAdi & "\Downloads\") End Sub Private Sub IndirmeAdresiTxt_TextChanged(sender As System.Object, e As System.EventArgs) Handles IndirmeAdresiTxt.TextChanged IndirmeyeBaslaBtn.Enabled = True IndirmeyeBaslaBtn.BackColor = Color.Red IndirmeyeBaslaBtn.ForeColor = Color.White End Sub Private Sub Hkk_Click(sender As System.Object, e As System.EventArgs) Handles Hkk.Click HkkFrm.Top = Me.Top HkkFrm.Left = Me.Left + Me.Width - HkkFrm.Width HkkFrm.ShowDialog() End Sub Private Sub btnInenDsyAc_Click(sender As System.Object, e As System.EventArgs) Handles btnInenDsyAc.Click Try If My.Computer.FileSystem.FileExists(SaklamaAdresiTxt.Text) Then Process.Start(SaklamaAdresiTxt.Text) Else MessageBox.Show("Saklama konumunda Dosya yok" & vbNewLine & _ vbNewLine & "Dosya indirildi ve başarıyla kaydedildi ", " Dosya açamılmıyor", _ MessageBoxButtons.OK, MessageBoxIcon.Error) End If Catch exc As Exception MessageBox.Show(exc.Message, " Bilgi!", MessageBoxButtons.OK, MessageBoxIcon.Information) End Try End Sub Private Sub HedefKlasörAç_Click(sender As System.Object, e As System.EventArgs) Handles HedefKlasörAç.Click Try Dim openDLG As New OpenFileDialog openDLG.Title = "İndirilen Dosyalar" openDLG.InitialDirectory = "C:\Users\" & KullAdi & "\Downloads\" ' IndirmeAdresiTxt.Text 'KlasorYoluDlg.SelectedPath = "C:\Users\" & KullAdi & "\Downloads\" openDLG.Filter = "Tüm Dosyalar (*.*)|*.*" If openDLG.ShowDialog = Windows.Forms.DialogResult.OK Then System.Diagnostics.Process.Start(openDLG.FileName) End If Catch exc As Exception MessageBox.Show(exc.Message, " Klasör Sorunu...") End Try End Sub Private Sub LinkDsyAc_Click(sender As System.Object, e As System.EventArgs) Handles LinkDsyAc.Click Dim openDLG As New OpenFileDialog openDLG.InitialDirectory = Application.StartupPath openDLG.Filter = "Text Dosyası (*.txt|*.txt" If openDLG.ShowDialog = DialogResult.OK Then Call ListeYükle() End If End Sub Public Sub ListeYükle() On Error GoTo hata Dim yol As String = Application.StartupPath Yükle = New IO.StreamReader(yol & "\LinkDeposu.txt") While (Yükle.Peek() > -1) Me.ListBox1.Items.Add(Yükle.ReadLine) End While Yükle.Close() Exit Sub hata: System.IO.File.Create(yol & "\LinkDeposu.txt") Return End Sub Private Sub LinkLstSakla_Click(sender As System.Object, e As System.EventArgs) Handles LinkLstSakla.Click On Error Resume Next Dim yol As String = Application.StartupPath Dim i As Integer Yaz = New IO.StreamWriter(yol & "\LinkDeposu.txt") For i = 0 To Me.ListBox1.Items.Count - 1 Yaz.WriteLine(Me.ListBox1.Items.Item(i)) Next Yaz.Close() End Sub Private Sub ListBox1_DoubleClick(sender As System.Object, e As System.EventArgs) Handles ListBox1.DoubleClick Me.IndirmeAdresiTxt.Text = ListBox1.Items(ListBox1.SelectedIndex) 'dsy = System.IO.Path.GetFileName(IndirmeAdresiTxt.Text) dsy = DosyaAdıBul(IndirmeAdresiTxt.Text) If dsy = "" Then Exit Sub SaklamaAdresiTxt.Text = GetSetting(Application.ProductName, "Ayarlar", "Hedef Dizini", Me.SaklamaAdresiTxt.Text) & "\" 'SaklamaAdresiTxt.Text = "C:\Users\" & KullAdi & "\Downloads\" SaklamaAdresiTxt.Text = SaklamaAdresiTxt.Text & (dsy & ".rar") 'uzantı Rar mı exe mi bulsun Call DosyaVarMi() SaklamaAdresiTxt.Text = SaklamaAdresiTxt.Text 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 If e.KeyCode = Keys.Enter Then Call ListBox1_DoubleClick(sender, e) End If If e.KeyCode = Keys.Escape Then Me.Close() End If End Sub Private Sub SatirSil() On Error Resume Next Dim secilecek, silinecek, LS 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 LS = LS - 1 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 SeciliSatiriSil_Click(sender As System.Object, e As System.EventArgs) Handles SeciliSatiriSil.Click Call SatirSil() End Sub Private Sub TumListeyiSil_Click(sender As System.Object, e As System.EventArgs) Handles TumListeyiSil.Click Me.ListBox1.Items.Clear() End Sub Private Sub UstteBtn_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles UstteBtn.CheckedChanged If UstteBtn.Checked = False Then UstteBtn.Image = ArakayAlPic.Image Me.TopMost = False Else UstteBtn.Image = ÖneAlPic.Image Me.TopMost = True End If SaveSetting(Application.ProductName, "Ayarlar", "Üstte Tut", UstteBtn.Checked) End Sub Private Sub UstteBtn_MouseLeave(sender As System.Object, e As System.EventArgs) Handles UstteBtn.MouseLeave Dim tooltip As New ToolTip() tooltip.SetToolTip(UstteBtn, "Formu Üstte Tut") End Sub Private Sub HedefKlasörAç_MouseLeave(sender As System.Object, e As System.EventArgs) Handles HedefKlasörAç.MouseLeave Dim tooltip As New ToolTip() tooltip.SetToolTip(HedefKlasörAç, "Hedef Klasörü Aç") End Sub End Class
Sonraki Kayıt
Önceki Kayıt
Ana Sayfa