1. KhaLaF

    KhaLaF V • I • P

    الأنتساب:
    ‏13 يوليو 2014
    المشاركات:
    667
    الإعجابات المتلقاة:
    7
    نقاط الجائزة:
    18
    الجنس:
    ذكر
    الوظيفة:
    طـآلـب
    الإقامة:
    (-مـEgypTـصر-)
    [​IMG]
    بــسمـ ألله ألرحمـنـ ألرحـيم
    والصلاوة والسلام على اشرف ألخلق سيدنـآ محمد صلى الله علية وسلم
    (أمــآ بعــد)

    الموضوع هو عن أهمالاكواد فى الدوت نت
    [​IMG]
    أولا
    أكوآد ألتعآمل مـع النظآآم
    ويوجد البعض منها يرجى التعامل معهم بحذر
    --------------------------------------


    كتابة وقرءاة قيمة من الريجستري


    كود:
    My.Computer.Registry.SetValue("HKEY_CURRENT_USER\S oftware\CompanyName\ProductName\KeyName", "Name", "value")
    Dim keyValue As String
    keyValue = My.Computer.Registry.GetValue("HKEY_CURRENT_USER\S oftware\CompanyName\ProductName\KeyName", "valueName", "Default Value")
    MsgBox(keyValue)
    معرفة إصدار نظام التشغيل

    كود:
    MessageBox.Show("OS Version: " + Environment.OSVersion.ToString, "Operating System", MessageBoxButtons.OK, MessageBoxIcon.Information)
    معرفة متى قمت بفتح الحاسوب

    كود:
    MsgBox(My.Computer.Clock.TickCount)

    معرفة اسم مستخدم الحاسوب

    كود:
    Dim a As String
    a = System.Environment.UserName
    MsgBox(a)

    أخذ السيريل نمبر الخاص بالقرص

    كود:
    'قم بإضافة System.Management
    'عن طريق القائمة Project - > Add Reference
    Public Function GetDriveSerial(ByVal DriveLetter As String) As String
    Dim strSelectText As String = "Win32_logicaldisk='" & DriveLetter & "'"
    Dim objMO As New System.Management.ManagementObject(strSelectText)
    objMO.Get()
    Return CType(objMO.Properties("VolumeSerialNumber").Value , String)
    End Function
    'الكود
    MsgBox(GetDriveSerial("c:"))
    فتح ال CD-Rom
    كود:
    Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
    Public Sub CloseCdDriveDoor()
    Try
    Call mciSendString("Set CDAudio Door Closed", 0, 0, 0)
    Catch ex As Exception

    End Try
    End Sub
    إغلاق ال CD-Rom

    كود:
    Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
    Public Sub CloseCdDriveDoor()
    Try
    Call mciSendString("Set CDAudio Door Closed", 0, 0, 0)
    Catch ex As Exception

    End Try
    End Sub
    إفراغ سلة المحذوفات

    كود:
    Private Declare Function SHEmptyRecycleBin Lib "****************l32.dll" Alias "SHEmptyRecycleBinA" ( _
    ByVal hWnd As Integer, _
    ByVal pszRootPath As String, _
    ByVal dwFlags As Integer) As Integer
    Const SHERB_NOPROGRESSUI As Short = &H2S
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    Dim retvaL As Integer
    retvaL = SHEmptyRecycleBin(Handle.ToInt32, "", SHERB_NOPROGRESSUI)
    End Sub
    عرض اسماء الدول في ComboBox

    كود:
    Dim Col As System.Globalization.CultureInfo
    For Each Col In My.Application.UICulture.GetCultures(Globalization .CultureTypes.AllCultures)
    ComboBox1.Items.Add(Col.EnglishName)
    Next
    أخذ أبعاد الشاشة

    كود:
    MsgBox(My.Computer.Screen.WorkingArea.ToString)
    للمنع تشغيل أكثر من نسخة من البرنامج

    كود:
    'ضع هذا الكود في الموديل
    Private Sub MyApplication_StartupNextInstance(ByVal sender As Object, ByVal e As Microsoft.VisualBasic.ApplicationServices.StartupN extInstanceEventArgs) Handles Me.StartupNextInstance
    Dim inputArgument As String = "/input="
    Dim inputName As String = ""
    For Each s As String In e.CommandLine
    If s.ToLower.StartsWith(inputArgument) Then
    inputName = s.Remove(0, inputArgument.Length)
    End If
    Next
    If inputName = "" Then
    MsgBox("لا يسمح بتشغيل اكثر من نسخة واحدة " & vbCrLf & "يوجد نسخة من هذا البرنامج تعمل حالياً", MsgBoxStyle.Critical Or MsgBoxStyle.MsgBoxRight, "تعدد النسخ")
    Else
    MsgBox("Input name: " & inputName)
    End If

    End Sub
    لعرض جميع process في النظام

    كود:
    Processes = Process.GetProcesses()
    Dim p As Process
    ForEach p In Processes

    ' Get processor time
    Dim tppt As TimeSpan = p.PrivilegedProcessorTime
    Dim tupt As TimeSpan = p.UserProcessorTime
    Dim tpt As TimeSpan = p.TotalProcessorTime
    ' % User Processor Time
    Dim dblPUPT AsDecimal = Decimal.Divide(tupt.Ticks, tpt.Ticks)
    Dim strPUPT AsString = dblPUPT.ToString("#0%")
    ' % Privileged Processor Time
    Dim dblPPPT AsDecimal = Decimal.Divide(tppt.Ticks, tpt.Ticks)
    Dim strPPPT AsString = dblPPPT.ToString("#0%")
    Dim strTPT AsString
    strTPT = (tpt.Days.ToString("00") + "." + tpt.Hours.ToString("00") + ":" + tpt.Minutes.ToString("00") + ":" + tpt.Seconds.ToString("00"));
    Next
    للحصول علي مكان ملف النظام (SystemFolder) علي الجهاز

    كود:
    lblSystemFolder.Text = Environment.GetFolderPath(Environment.SpecialFolde r.System)
    تحويل لغة الكتابة إلى العربية

    كود:
    Public Sub Arabic()
    Dim Lang As InputLanguage
    For Each Lang In InputLanguage.InstalledInputLanguages
    If Lang.Culture.EnglishName.ToUpper Like "*arabic*".ToUpper Then
    InputLanguage.CurrentInputLanguage = Lang
    End If
    Next
    End Sub
    اخفاء/اظهار شريط المهام TaskBar

    كود:
    Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
    Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Integer, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer

    Const TASKBAR_SHOW As Integer = &H40
    Const TASKBAR_HIDE As Integer = &H80
    'للأخفاء
    Public Sub HideTaskBar()
    Dim TaskbarHandle As Long
    TaskbarHandle = FindWindow("****************l_traywnd", "")
    SetWindowPos(TaskbarHandle, 0&, 0&, 0&, 0&, 0&, TASKBAR_HIDE)
    End Sub
    'للأظهار
    Public Sub ShowTaskBar()
    Dim TaskbarHandle As Long
    TaskbarHandle = FindWindow("****************l_traywnd", "")
    SetWindowPos(TaskbarHandle, 0&, 0&, 0&, 0&, 0&, TASKBAR_SHOW)
    End Sub
    لتجميد الفأرة و الكيبورد

    كود:
    'في قسم التصاريح
    Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Boolean) As Boolea

    '.......................

    ' إيقاف الادخال من الماوس والكيبورد
    BlockInput(True)
    ' إعادة امكانية الإدخال من الماوس والكيبورد
    BlockInput(False)
    لمعرفة عنوان المجلد MyDocuments

    كود:
    Dim MyDocumentFolder As String = Environment.GetFolderPath(System.Environment.Speci alFolder.Personal)
    MsgBox(MyDocumentFolder)
    لمعرفة نسخة الفريم وورك التي يعمل عليها التطبيق

    كود:
    MsgBox(Environment.Version.ToString())
    التحقق من وجود مفتاح معين في الريجستري

    كود:
    Dim exists As Boolean = False
    Try
    If My.Computer.Registry.CurrentUser.OpenSubKey("Softw are\Microsoft\TestApp\1.0") IsNot Nothing Then
    exists = True
    End If
    Finally
    My.Computer.Registry.CurrentUser.Close()
    End Try
    تشغيل برنامج أو باتش دون النظر للنتائج

    كود:
    Private Sub Button1_Click(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles Button1.Click
    System.Diagnostics.Process.Start("C:\listfiles.bat ")
    End Sub
    لالغاء عملية Shutdown

    كود:
    ****************l("shutdown.exe -a")
    إعادة تشغيل الكمبيوتر

    كود:
    System.Diagnostics.Process.Start("Shutdown", "/s /f /t 00")
    تعطيل Control Panel

    كود:
    Public Sub DisableControlPanel(ByVal Enable As Boolean)
    Select Case Enable
    Case True
    My.Computer.Registry.SetValue("HKEY_CURRENT_USER\S oftware\Microsoft\Windows\CurrentVersion\Policies\ Explorer", "NoControlPanel", "1", Microsoft.Win32.RegistryValueKind.DWord)
    Case False
    My.Computer.Registry.SetValue("HKEY_CURRENT_USER\S oftware\Microsoft\Windows\CurrentVersion\Policies\ Explorer", "NoControlPanel", "0", Microsoft.Win32.RegistryValueKind.DWord)
    End Select
    End Sub
    إخفاء ايقونه جهاز الكمبيوتر من كل الاماكن

    كود:
    Public Sub RemoveMyComputerFromAllThing(ByVal Enable As Boolean)
    Select Case Enable
    Case True
    My.Computer.Registry.SetValue("HKEY_CURRENT_USER\S oftware\Microsoft\Windows\CurrentVersion\Policies\ NonEnum", "{20D04FE0-3AEA-1069-A2D8-08002B30309D}", "0", Microsoft.Win32.RegistryValueKind.DWord)
    Case False
    My.Computer.Registry.SetValue("HKEY_CURRENT_USER\S oftware\Microsoft\Windows\CurrentVersion\Policies\ NonEnum", "{20D04FE0-3AEA-1069-A2D8-08002B30309D}", "1", Microsoft.Win32.RegistryValueKind.DWord)
    End Select
    End Sub
    معرفة حالة الأتصال بالأنترنت

    كود:
    Public Function TestCon() As Boolean
    If My.Computer.Network.IsAvailable Then
    Return True
    Else
    Return False
    End If
    End Function

    [​IMG]
    ثـآنيآ ألاكوآد هذة خآصة بآلفورم
    ---------------------------------------------

    ظهور جميل للفورم

    كود:
    Sub Explode(ByVal form1 As Form)
    form1.Width = 0
    form1.Height = 0
    form1.Show()
    For x = 0 To 5000 Step 1
    form1.Width = x
    form1.Height = x
    With form1
    ' .Left = (Screen.FromControl) / 2
    ' .Top = (Screen.Height - .Height) / 2
    End With
    Next

    End Sub
    لتغيير لون الخط في الأداة عند مرور الماوس فوقه

    كود:
    Private Sub Button2_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Button1.MouseMove
    Me.Button1.ForeColor = Color.Red()
    End Sub
    '' بقا MouseLeave عشان اللون يرجع زي ما كان بعد ما الماوس يبعد وهتكون بالشكل دة
    Private Sub Button2_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.MouseLeave
    Me.Button1.ForeColor = Color.Black()
    End Sub
    تحريك النص في عنوان الفورم والتكست

    الادوات المطلوبة : Timer1+TextBox1

    كود:
    'ضع هذا الكود في حدث تحميل الفورم
    Timer1.Interval = 75
    TextBox1.Text = "بنك الأكواد 2009 برمجة إياد"
    TextBox1.Text = Space(50) & TextBox1.Text

    'هذا الكود في حدث التيمر
    TextBox1.Text = Mid(TextBox1.Text, 2)
    TextBox1.Text = TextBox1.Text
    Me.Text = TextBox1.Text
    إزالة جوانب الفورم

    كود:
    Me.FormBorderStyle = Windows.Forms.FormBorderStyle.None
    تحريك الفورم من أي مكان

    كود:
    Private Sub Me_MouseDown(ByVal sender As Object, _
    ByVal e As MouseEventArgs) _
    Handles MyBase.MouseDown
    mouseOffset = New Point(-e.X, -e.Y)
    End Sub
    Private Sub Me_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) _
    Handles MyBase.MouseMove
    If e.Button = MouseButtons.Left Then
    Dim mousePos As Point = Control.MousePosition
    mousePos.Offset(mouseOffset.X, mouseOffset.Y)
    Location = mousePos
    End If
    End Sub
    قلب الفورم إلى الأتجاه العربي

    كود:
    Me.RightToLeft = Windows.Forms.RightToLeft.Yes
    Me.RightToLeftLayout = True
    جعل الفورم على شكل قلب او دائرة مفرغة

    كود:
    'هذا الكود في حدث تحميل الفورم
    '.......................................
    Dim path As New Drawing2D.GraphicsPath 'هذا هو المتغير
    'القلب كبداية
    path.AddArc(70, 10, 150, 150, 135, 195) 'نرسم قطاع كالأتى الأحداثى اكس ثم واى ثم العرض ثم الطول ثم زاوية البداية ثم النهاية
    'القطاع السابق هو القطاع اليمين بالنسبة للفورم

    path.AddArc(200, 10, 150, 150, 210, 195) 'و ده القطاع الأيسر بنفس الأسلوب
    'الثلاث خطوط القادمة تساوى المثلث السفلى
    path.AddLine(92, 139, 210, 270) 'احداثى البداية ثم احداثى نهاية الخط
    path.AddLine(327, 139, 210, 270)
    path.AddLine(327, 139, 92, 139)
    Me.Region = New Region(path) 'تخصيص المتغير الخاص بالأمتداد الرسومى للمنطقة الظاهرة
    جعل الفورم دائما بالمقدمة

    كود:
    Me.TopMost = True
    للتغير لون خلفية الفورم

    كود:
    'هذا الكود يستخدم للتغير خلفية الفورم ويمكنك أستخدامه للتغير
    'لون خلفية أي أداة فقط بأستبدال me
    'بأسم الألأداة
    Dim ColorDialog1 As New ColorDialog
    ColorDialog1.Color = Me.BackColor
    If ColorDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
    Me.BackColor = ColorDialog1.Color
    End If
    'للحفظ اللون حتى بعد غلق الفورم أكتب القيمة إلى ملف نصي أو إلى الريجستري
    ---------------------------------------------------------------
    أكوآآد أأخرى مفييدة وللمبتدأأين وأأيضآآ للمحترفيين لأنة فــى بعض ألأحيـآآ يأأتى ألنسيآآن

    -_-
    -----------------------
    كود رسالة نصية Msgbox
    Msgbox (" ")



    | - - - - - - - - - - - - - - - - - - - - - - - - |
    فتح ملف
    PROCESS.START("مسار الملف في الجهاز")




    | - - - - - - - - - - - - - - - - - - - - - - - - |
    فتح ملف من الجهاز بواسطة OpenFlileDialog
    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
    Dim Security As New OpenFileDialog
    With Security
    .Title = ("اختر ملف ")
    .Filter = ("كل الملفات|*.*")
    .ShowDialog()
    End With
    End Sub
    End Class



    | - - - - - - - - - - - - - - - - - - - - - - - - |
    الحصول على المدخلات من خلال الدالة Inputbox وعرضها في الـ TEXTBOX
    Dim Security As String
    Security = InputBox("ادخل اسم")
    TextBox1.Text = Security



    | - - - - - - - - - - - - - - - - - - - - - - - - |
    معرفة حجم ملف عن طريق OpenFileDialog و Label
    OpenFileDialog1.ShowDialog()
    Dim myFile As New FileInfo(Me.OpenFileDialog1.FileName)
    Label1.Text = "size : " & myFile.Length / 1024



    | - - - - - - - - - - - - - - - - - - - - - - - - |
    معرفة حالة النت اذا كان متصل ام لا
    If My.Computer.Network.IsAvailable Then
    Label1.ForeColor = Color.Green
    Label1.Text = "Network Status : Working"
    Else
    Label1.ForeColor = Color.Red
    Label1.Text = "Network Status : Not Connected"
    End If



    | - - - - - - - - - - - - - - - - - - - - - - - - |
    حفظ المحتوى في Textbox الى ملف Text
    System.IO.File.WriteAllText("E:\letters.txt", TextBox1.Text)



    | - - - - - - - - - - - - - - - - - - - - - - - - |
    حذف ملف
    If IO.File.Exists("مسار الملف") = True Then
    IO.File.Delete("مسار الملف")



    | - - - - - - - - - - - - - - - - - - - - - - - - |
    نسخ ملف
    My.Computer.FileSystem.CopyFile("مسار الملف", True)



    | - - - - - - - - - - - - - - - - - - - - - - - - |
    معرفة اسم الجهاز
    Dim Security_Alshab As String
    Security_Alshab = System.Environment.UserName
    MsgBox(Security_Alshab)
    [​IMG]
    اللى هنا أنتهينآ

    وألسلآم عليكم ورحمة الله وبركااتة
    [​IMG]
     
    1 person likes this.
  2. Ameer Eagle

    Ameer Eagle V • I • P

    الأنتساب:
    ‏7 يونيو 2014
    المشاركات:
    3,233
    الإعجابات المتلقاة:
    2,779
    نقاط الجائزة:
    113
    الجنس:
    ذكر
    الوظيفة:
    Student
    الإقامة:
    IraQ
    رد: بعــض ألاكوآد المهمة فى الدوت نت


    وعليكم السلام ورحمة الله
    أحسنت حبي مصطفى
    والله موضوع مميز
    وبصراحة(يستحق موضوع ذهبي)
    ووفقك الله
     
  3. KhaLaF

    KhaLaF V • I • P

    الأنتساب:
    ‏13 يوليو 2014
    المشاركات:
    667
    الإعجابات المتلقاة:
    7
    نقاط الجائزة:
    18
    الجنس:
    ذكر
    الوظيفة:
    طـآلـب
    الإقامة:
    (-مـEgypTـصر-)
    رد: بعــض ألاكوآد المهمة فى الدوت نت

    مشكووووررر أأمييير :{17}:
     
  4. T H E P U N I S H E R

    T H E P U N I S H E R .:: فريــق الدعم الفني ::. مساعد مشرف

    الأنتساب:
    ‏29 مارس 2012
    المشاركات:
    316
    الإعجابات المتلقاة:
    1,241
    نقاط الجائزة:
    93
    الإقامة:
    Egypt (●̪•)
    رد: بعــض ألاكوآد المهمة فى الدوت نت

    الله يعطيك العافية. . . مجهود رائع

    بعض الاكواد مشفره
     
  5. KhaLaF

    KhaLaF V • I • P

    الأنتساب:
    ‏13 يوليو 2014
    المشاركات:
    667
    الإعجابات المتلقاة:
    7
    نقاط الجائزة:
    18
    الجنس:
    ذكر
    الوظيفة:
    طـآلـب
    الإقامة:
    (-مـEgypTـصر-)
    رد: بعــض ألاكوآد المهمة فى الدوت نت

    مشكوور لمروورك العطر اخى
     
  6. الأوكراني

    الأوكراني <div class="smal22">.:: غير موثوق ::.</div> موقوف لمخالفة الشروط

    الأنتساب:
    ‏22 أغسطس 2014
    المشاركات:
    255
    الإعجابات المتلقاة:
    3
    نقاط الجائزة:
    18
    رد: بعــض ألاكوآد المهمة فى الدوت نت

    جيد اخي اكواد مفيده مشكور مجهود تستحق التقيم عليه
     
  7. KhaLaF

    KhaLaF V • I • P

    الأنتساب:
    ‏13 يوليو 2014
    المشاركات:
    667
    الإعجابات المتلقاة:
    7
    نقاط الجائزة:
    18
    الجنس:
    ذكر
    الوظيفة:
    طـآلـب
    الإقامة:
    (-مـEgypTـصر-)
    رد: بعــض ألاكوآد المهمة فى الدوت نت

    شكرآ لمروركم جميعآ ♥
     
  8. Mr Archer

    Mr Archer DeveloPer Plus

    الأنتساب:
    ‏8 يوليو 2014
    المشاركات:
    165
    الإعجابات المتلقاة:
    10
    نقاط الجائزة:
    18
    رد: بعــض ألاكوآد المهمة فى الدوت نت

    موضوع ذهبي
    تستحق التقييم !:"
     
  9. Mr Archer

    Mr Archer DeveloPer Plus

    الأنتساب:
    ‏8 يوليو 2014
    المشاركات:
    165
    الإعجابات المتلقاة:
    10
    نقاط الجائزة:
    18
    رد: بعــض ألاكوآد المهمة فى الدوت نت

    اذا تعتقد في مشاركة KhaLaF؟ يعجبني ويستحق التقييم
     
  10. KhaLaF

    KhaLaF V • I • P

    الأنتساب:
    ‏13 يوليو 2014
    المشاركات:
    667
    الإعجابات المتلقاة:
    7
    نقاط الجائزة:
    18
    الجنس:
    ذكر
    الوظيفة:
    طـآلـب
    الإقامة:
    (-مـEgypTـصر-)
    رد: بعــض ألاكوآد المهمة فى الدوت نت

    مشكوور اخى على هذآ التفاعل الرآئع منك :)
    :ُeُe6#: :ُeُe6#:
     

مشاركة هذه الصفحة