السلام عليكم ورحمه الله وبركاته ..
اليوم أقدم لكم بعض الأكواد الهامة في Vb.NeT

ملحوظة هامة : بعض هذه الأكواد خطرة يجب التعامل معها بحذر :16:

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

كود:
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 :6:
كود:
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 :6:

كود:
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 في النظام :2:

كود:
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 :6:

كود:
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
لتجميد الفأرة و الكيبورد :2:

كود:
'في قسم التصاريح
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 :6:

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

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

كود:
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
إخفاء ايكونه جهاز الكمبيوتر من كل الاماكن :2:

كود:
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