اللهم لا علم لنا الا ما علمتنا إنك أنت العليم الحكيم
سلام الله عليكم أخوتي الكرام تحية طيبة وبعد
حبيت اليوم الخروج من نهج الكراك وصناعته والتوجه للأصل وهو البرمجة
بموضوع اليوم سنتعلم مع بعضنا البعض كبفية صناعة برنامج علي غرار
الانترنت داونلود مانيجر (طبعا ليس بعملقته)
البرنامج سيتم بنائه هنا امامكم بالصور عن طريق الفيجوال استوديو 2012
وخطوات بنائه ستكون علي النحو التالي :
1- بناء شكل البرنامج المراد تصميمه
2- ادخال العناصر جميعا فيه
3- ربط العناصر بالأكواد
وعلي بركة الله نبدأ :
سنقوم بداية ببناء مشروع جديد
مرحلة تصميم واجهة البرنامج
مرحلة ربط الأكواد بالعناصر
نتجه الآن لربط الأكواد بشكل عملي
دبل كلك علي أداة BackgroundWorker1 ثم ادخل هذا الكود
Code:
Dim whereToSave As String Delegate Sub ChangeTextsSafe(ByVal length As Long, ByVal position As Integer, ByVal percent As Integer, ByVal speed As Double) Delegate Sub DownloadCompleteSafe(ByVal cancelled As Boolean) Private Sub BackgroundWorker1_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork Me.Button3.Enabled = False Dim theResponse As HttpWebResponse Dim theRequest As HttpWebRequest Try theRequest = WebRequest.Create(Me.TextBox1.Text) theResponse = theRequest.GetResponse Catch ex As Exception MessageBox.Show("An error occurred while downloading file. Possibe causes:" & ControlChars.CrLf & _ "1) File doesn't exist" & ControlChars.CrLf & _ "2) Remote server error", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) Dim cancelDelegate As New DownloadCompleteSafe(AddressOf DownloadComplete) Me.Invoke(cancelDelegate, True) Exit Sub End Try Dim length As Long = theResponse.ContentLength Dim safedelegate As New ChangeTextsSafe(AddressOf ChangeTexts) Me.Invoke(safedelegate, length, 0, 0, 0) Dim writeStream As New IO.FileStream(Me.whereToSave, IO.FileMode.Create) Dim nRead As Integer Dim speedtimer As New Stopwatch Dim currentspeed As Double = -1 Dim readings As Integer = 0 Do If BackgroundWorker1.CancellationPending Then Exit Do End If speedtimer.Start() Dim readBytes(4095) As Byte Dim bytesread As Integer = theResponse.GetResponseStream.Read(readBytes, 0, 4096) nRead += bytesread Dim percent As Short = (nRead / length) * 100 Me.Invoke(safedelegate, length, nRead, percent, currentspeed) If bytesread = 0 Then Exit Do writeStream.Write(readBytes, 0, bytesread) speedtimer.Stop() readings += 1 If readings >= 5 Then currentspeed = 20480 / (speedtimer.ElapsedMilliseconds / 1000) speedtimer.Reset() readings = 0 End If Loop theResponse.GetResponseStream.Close() writeStream.Close() If Me.BackgroundWorker1.CancellationPending Then IO.File.Delete(Me.whereToSave) Dim cancelDelegate As New DownloadCompleteSafe(AddressOf DownloadComplete) Me.Invoke(cancelDelegate, True) Exit Sub End If Dim completeDelegate As New DownloadCompleteSafe(AddressOf DownloadComplete) Me.Invoke(completeDelegate, False) End Sub
Dim whereToSave As String Delegate Sub ChangeTextsSafe(ByVal length As Long, ByVal position As Integer, ByVal percent As Integer, ByVal speed As Double) Delegate Sub DownloadCompleteSafe(ByVal cancelled As Boolean) Private Sub BackgroundWorker1_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork Me.Button3.Enabled = False Dim theResponse As HttpWebResponse Dim theRequest As HttpWebRequest Try theRequest = WebRequest.Create(Me.TextBox1.Text) theResponse = theRequest.GetResponse Catch ex As Exception MessageBox.Show("An error occurred while downloading file. Possibe causes:" & ControlChars.CrLf & _ "1) File doesn't exist" & ControlChars.CrLf & _ "2) Remote server error", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) Dim cancelDelegate As New DownloadCompleteSafe(AddressOf DownloadComplete) Me.Invoke(cancelDelegate, True) Exit Sub End Try Dim length As Long = theResponse.ContentLength Dim safedelegate As New ChangeTextsSafe(AddressOf ChangeTexts) Me.Invoke(safedelegate, length, 0, 0, 0) Dim writeStream As New IO.FileStream(Me.whereToSave, IO.FileMode.Create) Dim nRead As Integer Dim speedtimer As New Stopwatch Dim currentspeed As Double = -1 Dim readings As Integer = 0 Do If BackgroundWorker1.CancellationPending Then Exit Do End If speedtimer.Start() Dim readBytes(4095) As Byte Dim bytesread As Integer = theResponse.GetResponseStream.Read(readBytes, 0, 4096) nRead += bytesread Dim percent As Short = (nRead / length) * 100 Me.Invoke(safedelegate, length, nRead, percent, currentspeed) If bytesread = 0 Then Exit Do writeStream.Write(readBytes, 0, bytesread) speedtimer.Stop() readings += 1 If readings >= 5 Then currentspeed = 20480 / (speedtimer.ElapsedMilliseconds / 1000) speedtimer.Reset() readings = 0 End If Loop theResponse.GetResponseStream.Close() writeStream.Close() If Me.BackgroundWorker1.CancellationPending Then IO.File.Delete(Me.whereToSave) Dim cancelDelegate As New DownloadCompleteSafe(AddressOf DownloadComplete) Me.Invoke(cancelDelegate, True) Exit Sub End If Dim completeDelegate As New DownloadCompleteSafe(AddressOf DownloadComplete) Me.Invoke(completeDelegate, False) End Sub
ثم اكتب ورائها هذه الجملة الشرطية الخاصة برابط التحميل وزر التحميل
Code:
Public Sub DownloadComplete(ByVal cancelled As Boolean) Me.TextBox1.Enabled = True Me.Button3.Enabled = True If cancelled Then Me.Button5.Enabled = False Me.label13.Text = "Cancelled" MessageBox.Show("Download Cancelled !", "Aborted", MessageBoxButtons.OK, MessageBoxIcon.Information) Else Me.Button5.Enabled = False Me.label13.Text = "Successfully downloaded" MessageBox.Show("Download Succeded !", "Aborted", MessageBoxButtons.OK, MessageBoxIcon.Information) End If Me.ProgressBar1.Value = 0 End Sub
ولحساب سرعة نحميل الملف ضع هذا الكود :
Code:
Public Sub ChangeTexts(ByVal length As Long, ByVal position As Integer, ByVal percent As Integer, ByVal speed As Double) Me.label12.Text = Math.Round((length / 1024), 2) & " KB" Me.label10.Text = Me.TextBox1.Text Me.label13.Text = Math.Round((position / 1024), 2) & " KB of " & Math.Round((length / 1024), 2) & "KB (" & Me.ProgressBar1.Value & "%)" Me.Label15.Text = Me.ProgressBar1.Value & "%" If speed = -1 Then Me.label14.Text = "calculating..." Else Me.label14.Text = Math.Round((speed / 1024), 2) & " KB/s" End If Me.ProgressBar1.Value = percent End Sub
اضغط دبل كلك علي زر Save As ثم ادخل هذا الكود
Code:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click If TextBox1.Text = "" Then SaveFileDialog1.Filter = "All File(*.*)--(*.*)" ElseIf Me.TextBox1.Text.EndsWith(".exe" Then SaveFileDialog1.Filter = "Setup File(*.exe)--*.exe" ElseIf Me.TextBox1.Text.EndsWith(".rar" Then SaveFileDialog1.Filter = "RAR File(*.rar)--*.rar" ElseIf Me.TextBox1.Text.EndsWith(".zip" Then SaveFileDialog1.Filter = "ZIP File(*.zip)--*.zip" ElseIf Me.TextBox1.Text.EndsWith(".pdf" Then SaveFileDialog1.Filter = "PDF(*.pdf)--*.pdf" End If Me.SaveFileDialog1.FileName = Me.TextBox1.Text.Split("/"c)(Me.TextBox1.Text.Split("/"c).Length - 1) Me.label9.Text = Me.TextBox1.Text.Split("/"c)(Me.TextBox1.Text.Split("/"c).Length - 1) Me.SaveFileDialog1.ShowDialog() Me.TextBox2.Text = Me.SaveFileDialog1.FileName End Sub
دبل كلك علي زر Start Dawnload وضع هذا الكود :
Code:
Private Sub btDownload_Click(sender As Object, e As EventArgs) Handles Button3.Click If Me.TextBox1.Text "" AndAlso Me.TextBox1.Text.StartsWith("http://") Then Me.whereToSave = Me.TextBox2.Text Me.SaveFileDialog1.FileName = "" Me.TextBox2.Text = whereToSave Me.TextBox1.Enabled = False Me.Button3.Enabled = False Me.Button5.Enabled = True Me.TextBox2.Enabled = False Me.Button1.Enabled = False Me.BackgroundWorker1.RunWorkerAsync() Else MessageBox.Show("This url is not valid", "Warning", MessageBoxButtons.OK, MessageBoxIcon.Warning) End If End Sub
دبل كلك زر Cancel ثم ضع هذا الكود :
Code:
Private Sub btCancel_Click(sender As Object, e As EventArgs) Handles Button5.Click Me.BackgroundWorker1.CancelAsync() TextBox2.Enabled = True Button1.Enabled = True End Sub
Code:
Private Sub btCancel_Click(sender As Object, e As EventArgs) Handles Button5.Click Me.BackgroundWorker1.CancelAsync() TextBox2.Enabled = True Button1.Enabled = True End Sub
دبل كلك زر Exit ثم ضع هذا الكود
Code:
Me.Close()
Me.Close()
دبل كلك علي الحقوق (زر about) ثم هذا الكود وغير بالكلام ما تشاء
Code:
MsgBox("مقدمة وإهداء من أخوكم ابو فهمي " & vbCrLf & "أتمني ان يحوز علي رضاكم" & vbCrLf & "جميع الحقوق محفوظة " & vbCrLf & "24/1/2015 : تاريخ الإصدار "
MsgBox("مقدمة وإهداء من أخوكم ابو فهمي " & vbCrLf & "أتمني ان يحوز علي رضاكم" & vbCrLf & "جميع الحقوق محفوظة " & vbCrLf & "24/1/2015 : تاريخ الإصدار "
مرحلة تصدير البرنامج
سنقوم بحول الله بتصدير البرنامج وعمل ستب له يثبت من أي وندوز
والآن لمعاينة العمل بشكل كامل
البرنامج المصنوع ستجدونه بالمرفقات بالإضافة الي ملف تكست
يحتوي علي الأكواد المكتوبة ... بالحقيقة لم أضع السورس كامل
حتي تقوموا بكتابتها بأيديكم وبالتالي التعلم بشكل سليم
هذا كل شيء وعلي المحبة نلتقي بمواضيع أخري بحول الله
والسلام عليكم ورحمة الله وبركاته