نمونه کد های کوچک و کاربردی VB.Net

با سلام!

در این تاپیک کد های کوچک و مفید VB.Net را قرار می دهیم.:great:

هرگونه مشکلی که در رابطه با سورس ها داشتید، در همین قسمت بیان کنید!:wink:

امیدوارم برایتان مفید باشد!:yes:

این کد تک خطی مقدار زمان بارگذاری سیستم عامل را (بر حسب دقیقه) در قالب یک MsgBox به شما نمایش می دهد:

کد:

---

MsgBox(My.Computer.Clock.TickCount \ 60000)

---

با این کد می توان مقدار حافظه ی فیزیکی رایانه (مقدار RAM) بر حسب مگابایت به دست آورد و آن را در یک MsgBox نمایش داد:

کد:

---

MsgBox(My.Computer.Info.TotalPhysicalMemory \ 1023 ^ 2)

---

این کد در رویداد FormLoad برنامه قرار می گیرد و مسیر اجرای برنامه را بررسی می کند. اگر درایوی که برنامه از روی آن اجرا می شود از نوع CD Rom, CD Writer و ... نبود، برنامه با دستور End بسته می شود.

کد زیر را در رویداد FormLoad فرم اصلی قرار دهید:

کد:

---

  Dim appdrive As New IO.DriveInfo(Application.StartupPath.Substring(0, 2))
If appdrive.DriveType <> 5 Then End

---

کد زیر را در رویداد FromClosing فرم قرار دهید تا با کلیک بر روی دکمه ی Close X فرم بسته نشود:

کد:

---

e.Cancel = True

---

کد:

---

Hibernate'

Application.SetSuspendState(PowerState.Hibernate, True, False)

'Stand By
Application.SetSuspendState(PowerState.Suspend, True, False)

---

ابتدا کد زیر را در Public Class فرم قرار دهید:

کد:

---

Public Declare Function BlockInput Lib "user32" (ByVal Block As Boolean) As Long

---

سپس با فرمان های زیر می توانید صفحه کلید و موشواره را قفل یا آزاد کنید:

کد:

---

'قفل کردن
BlockInput(True)

'آزاد کردن
BlockInput(False)

---

عمل قفل کردن را می توان با کلید ترکیبی Alt + Ctrl + Del خنثی کرد.

ابتدا کد زیر را در Public Class فرم قرار دهید:

کد:

---

Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal Command As String, ByVal ReturnString As String, ByVal ReturnLength As Long, ByVal Callback As Long) As Long

---

بعد از فرمان های زیر استفاده می کنید:

کد:

---

'باز کردن
mciSendString("Set CDAudio Door Open Wait", 0, 0, 0)

'بستن
mciSendString("Set CDAudio Door Closed Wait", 0, 0, 0)

---

کد:

---

My.Computer.Clipboard.Clear()

---

کد:

---

Dim helpoint As New Point(0 , 0)
Help.ShowPopup(Me, "Your Text", helpoint)

---

به جای اعداد 0 و 0 می توانید مختصات مکان دلخواه خود برای نمایش PopUp را وارد کنید.
به جای Your Text ، متن PopUp دلخواه خود را درون نقل قول قرار دهید.

کد:

---

MsgBox("Screen Resolution: " + Cstr(My.Computer.Screen.WorkingArea.Width) + " * " + Cstr(My.Computer.Screen.WorkingArea.Height))

---

کد:

---

My.Computer.Audio.Play("File Path")

---

به جای عبارت File Path، مسیر فایل صوتی را داخل نقل قول قرار دهید.

ابتدا مرجع System.Management را به پروژه خودتان اضافه کنید. برای این کار به منوی Project رفته و گزینه ی Add Refrence را انتخاب کنید سپس در پنجره ی جدید باز شده مرجع System.Management را انتخاب و آن را به برنامه اضافه کنید.

سپس کد زیر را در خارج Public Class فرم برنامه قرار دهید:

کد:

---

Imports System.Management

---

اکنون از کد زیر استفاده کنید:

کد:

---

Dim objMOS As ManagementObjectSearcher
Dim objMOC As Management.ManagementObjectCollection
Dim objMO As Management.ManagementObject


objMOS = New ManagementObjectSearcher("Select * From Win32_Processor")
objMOC = objMOS.Get

For Each objMO In objMOC
 MessageBox.Show("CPU ID = " & objMO("ProcessorID"))
Next

objMOS.Dispose()
objMOS = Nothing
objMO.Dispose()
objMO = Nothing

---

منبع: برای مشاهده این لینک/عکس می بایست عضو شوید !برای عضویت اینجا کلیک کنید ]

کد:

---

Dim cpuinfo(3) As String
        cpuinfo(0) = My.Computer.Registry.GetValue("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0", "ProcessorNameString", "")
        cpuinfo(1) = My.Computer.Registry.GetValue("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0", "Identifier", "")
        cpuinfo(2) = My.Computer.Registry.GetValue("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0", "VendorIdentifier", "")
        cpuinfo(3) = My.Computer.Registry.GetValue("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0", "~MHz", "")
        MsgBox("CPU Name: " + cpuinfo(0) + Chr(13) + "Identifier (Model): " + cpuinfo(1) + Chr(13) + "Vendor ID (Manufacture): " + cpuinfo(2) + Chr(13) + "CPU Frequency: " + cpuinfo(3) + " MHz", 64)

---

ابتدا کد (API) زیر را در Public Class فرم برنامه قرار دهید:

کد:

---

Private Declare Function MonTurnOff Lib "user32" Alias "SendMessageA"(ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer

---

سپس از فرمان زیر استفاده کنید:

کد:

---

MonTurnOff(Me.Handle.ToInt32, &H112s, &HF170, 2)

---

کد:

---

MsgBox(System.Windows.Forms.SystemInformation.BootMode.ToString)

---

كد زير مسيري را كه فايل .exe در حال حاضر از آن جا اجرا مي شود را با جعبه ي متني نمايش مي دهد:

کد:

---

MsgBox(Application.StartupPath)

---

كد زير علاوه بر مسير اجراي، نام فايل اجرايي را نيز نمايش مي دهد:

کد:

---

MsgBox(Application.ExecutablePath)

---

کد:

---

'مقدار فضاي مصرف شده رم

        MsgBox((My.Computer.Info.TotalPhysicalMemory - My.Computer.Info.AvailablePhysicalMemory) \ 1024 ^ 2)
'مقدار فضاي آزاد رم
        MsgBox(My.Computer.Info.AvailablePhysicalMemory \ 1024 ^ 2)

---

اگر برنامه ی شما شامل چندین فرم است، با این کد می توانید عنوان پنجره هایی از برنامه که بارگذاری شده اند را در قالب یک جعبه ی متنی مشاهده کنید:

کد:

---

Dim openfrmtle As String
For Each appform As Form In Application.OpenForms
    openfrmtle += Chr(13) + appform.Text
    MsgBox(openfrmtle, 64, "Open Form(s) : " + CStr(Application.OpenForms.Count))
Next

---

هر بار كه اين كد اجرا شود يك عدد بين 1 تا 6 -اعداد تاس- را به طور تصادفي با جبعه متني نمايش مي دهد:

کد:

---

Dim diceno As New Random
MsgBox(diceno.Next(1, 6), 64, "Dice")

---

این کد عکس گرفته شده را در متغیر screenshot ذخیره می کند.

کد:

---

Dim bounds As Rectangle
Dim screenshot As Bitmap
Dim graph As Graphics
bounds = Screen.PrimaryScreen.Bounds
screenshot = New Bitmap(bounds.Width, bounds.Height)
graph = Graphics.FromImage(screenshot)
graph.CopyFromScreen(bounds.X, bounds.Y, 0, 0, bounds.Size, CopyPixelOperation.SourceCopy)

---

برای مشاهده این لینک/عکس می بایست عضو شوید !برای عضویت اینجا کلیک کنید ]

ابتدا مرجع (Reference) System.Management را به پروژه ي خود اضافه مي كنيم. سپس از كد زير استفاده مي كنيم. اين كد تمام نام هاي كاربري را با يك جعبه ي متني نمايش مي دهد:

کد:

---

        Dim compusrs As String
Dim query As New System.Management.SelectQuery("Win32_UserAccount")
Dim searcher As New System.Management.ManagementObjectSearcher(query)
For Each envVar As System.Management.ManagementObject In searcher.Get()
      compusrs += envVar("Name") + Chr(13)
Next
MsgBox(compusrs, 64, My.Computer.Name + "'s Users")

---

برای مشاهده این لینک/عکس می بایست عضو شوید !برای عضویت اینجا کلیک کنید ]

برای اين كار از الگوی زير پيروی كنيد:

کد:

---

Windows.Forms.Cursor.Position = New Point(x As Integer, y As Integer)

---

مثال

کد:

---

'با اين كد نشانگر به مكانی به طول 400 و عرض 300 پيكسل می رود
Windows.Forms.Cursor.Position = New Point(400, 300)

---

کد:

---

MsgBox(Windows.Forms.Cursor.Position.ToString)

---

کد:

---

'پنهان كردن

        Windows.Forms.Cursor.Hide()

        'آشكار  كردن

        Windows.Forms.Cursor.Show()

---

برای اين كار كد زير را در رويداد Form_Load برنامه قرار دهيد:

کد:

---

For i As Integer = 0 To  100

Opacity = i /  100     

Next
 

---

كد زير را در رويداد Form_FromClosing برنامه قرار دهيد:

کد:

---

e.Cancel = True 
  For i As Integer = 99 To 25  Step -1
       Opacity = i /  100   
  Next
  End

---

کد:

---

Controls.Clear()

---

اين كد با InputBox يک متن را از كاربر دريافت می كند و سپس اعداد موجود در رشته را با جعبه ی متنی به او نمايش می دهد.

کد:

---

Dim mychr As  String = InputBox("Type sth here:")
For i As Integer = 0 To  mychr.Length - 1
  If IsNumeric(mychr.Chars(i)) Then 
    nochar +=  mychr.Chars(i) 
  Else
    nochar += "-" 
 End If 
Next
  MsgBox(nochar, 64, "The String contains these  number(s):")
 

---

بخش اول اين كد جالب، زمانی كه فرم در حال بسته شدن است مختصات فرم و اندازه ی آن را در رجيستری ذخيره می كند. بخش دوم كد نيز زمانی كه فرم در حال بار گذاری است، مختصات و اندازه ی ذخيره شده در رجيستری را دريافت می كند و آن ها را روی فرم برنامه اعمال می نمايد.

كد زير را در رويداد Form_Load برنامه قرار دهيد:

کد:

---

Location =  New Point(GetSetting(Application.ProductName,  "FormSet", "LocX", Location.X),  GetSetting(Application.ProductName, "FormSet", "LocY", Location.Y))
         Size = New  Size(GetSetting(Application.ProductName, "FormSet", "SizeX", Size.Width),  GetSetting(Application.ProductName, "FormSet", "SizeY", Size.Height))

---

كد زير را در رويداد From_FormClosing برنامه قرار دهيد:

کد:

---

  SaveSetting(Application.ProductName, "FormSet", "LocX", Location.X)
         SaveSetting(Application.ProductName, "FormSet", "LocY", Location.Y)
         SaveSetting(Application.ProductName, "FormSet", "SizeX", Size.Width)
         SaveSetting(Application.ProductName, "FormSet", "SizeY", Size.Height)

---

ابتدا مرجع System.Management را به پروژه ی خود اضافه می كنيد.

كد زير را در خارج از Public Class فرم برنامه قرار می دهيم:

کد:

---

Imports System.Management

---

سپس از كد زير استفاده می كنيم. اين كد شماره سريال را با جعبه ی متنی نمايش می دهد:

کد:

---

Dim objMOS As ManagementObjectSearcher
Dim objMOC As  Management.ManagementObjectCollection
Dim objMO As  Management.ManagementObject

objMOS = New ManagementObjectSearcher("Select *  From Win32_OperatingSystem")
objMOC =  objMOS.Get

ForEach objMO In objMOC
  MessageBox.Show(objMO("SerialNumber"))
Next

objMOS.Dispose()
objMOS = Nothing
objMO.Dispose()
objMO = Nothing

---

منبع: DevASP

این کد درایو های مربوط به حافظه های فلش را شناسایی می کند و نام آن ها را با جعبه متنی بر می گرداند:

كد زير را در خارج از Public Class فرم برنامه قرار می دهيم:

کد:

---

Imports System.IO

---

سپس از این کد استفاده کنید:

کد:

---

On Error Resume Next
Dim rmdrvs As String
For iDrive As Integer = 0 To DriveInfo.GetDrives.Length - 1
    If DriveInfo.GetDrives(iDrive).DriveType = 2 And DriveInfo.GetDrives(iDrive).Name <> "A:\" And DriveInfo.GetDrives(iDrive).Name <> "B:\" Then
        rmdrvs += ControlChars.NewLine + DriveInfo.GetDrives(iDrive).Name + " - " + DriveInfo.GetDrives(iDrive).VolumeLabel
    End If
Next
MsgBox(rmdrvs)

---

کد:

---

For Each prntr As String In Drawing.Printing.PrinterSettings.InstalledPrinters
      MsgBox(prntr)
Next

---

برای مشاهده این لینک/عکس می بایست عضو شوید !برای عضویت اینجا کلیک کنید ]

کد:

---

Function getMD5Hash(ByVal strToHash As String) As String
        Dim md5Obj As New Security.Cryptography.MD5CryptoServiceProvider
        Dim bytesToHash() As Byte = System.Text.Encoding.ASCII.GetBytes(strToHash)
        bytesToHash = md5Obj.ComputeHash(bytesToHash)
        Dim strResult As String = ""
      For Each b As Byte In bytesToHash
            strResult += b.ToString("x2")
        Next
        Return strResult
End Function

---

برای مشاهده این لینک/عکس می بایست عضو شوید !برای عضویت اینجا کلیک کنید ]

نقل قول:

---

ارسالی توسط ravegoat برای مشاهده این لینک/عکس می بایست عضو شوید !برای عضویت اینجا کلیک کنید ]

کد:

---

Function getMD5Hash(ByVal strToHash As String) As String
        Dim md5Obj As New Security.Cryptography.MD5CryptoServiceProvider
        Dim bytesToHash() As Byte = System.Text.Encoding.ASCII.GetBytes(strToHash)
        bytesToHash = md5Obj.ComputeHash(bytesToHash)
        Dim strResult As String = ""
      For Each b As Byte In bytesToHash
            strResult += b.ToString("x2")
        Next
        Return strResult
End Function

---

برای مشاهده این لینک/عکس می بایست عضو شوید !برای عضویت اینجا کلیک کنید ]

---

فقط توجه داشته باشید MD5Hash دیگه قابلیت Decode شدن رو نداره.

پس واسه رمزنگاری مطالب نباید ازش استفاده کنید چون میشه شتر دیدی ندیدی :1. (38): (انگار نه انگار چیزی وجود داشته ! )

با تشکر :1. (21):

کد:

---

For Each appf As Form In Application.OpenForms
    msgbox(appf.Text)
Next

---

برگرفته شده از سایت برای مشاهده این لینک/عکس می بایست عضو شوید !برای عضویت اینجا کلیک کنید ]

این سورس مقدار TimeZone رو بر می گردونه (نشون میده الگوی زمانی برای چه منطقه ای تنظیم شده):

کد:

---

MsgBox(TimeZone.CurrentTimeZone.StandardName)

---

این کد به شما نشون آدرس ایمیلی را که کاربر وارد کرده، معتبر است یا خیر؟
مثلا" example@dom@main.com یه آدرس غیر معتبره.

کد:

---

Imports System.Text.RegularExpressions

---

کد:

---

Dim emailAddress As String = InputBox("Plz enter ur Email Address:")
Dim pattern As String = "^[a-zA-Z][\w\.-]*[a-zA-Z0-9]@[a-zA-Z0-9][\w\.-]*[a-zA-Z0-9]\.[a-zA-Z][a-zA-Z\.]*[a-zA-Z]$"
Dim emailAddressMatch As Match = Regex.Match(emailAddress, pattern)
If emailAddressMatch.Success Then
      MsgBox("Correct Email Address.", 64)
Else
      MsgBox("Invalid Email Address.", 48)
End If

---

نویسنده ی کد: Muhammed Mohiudeen.M.N

این کد رو در رویداد KeyPress ، جعبه متنی (TextBox) قرار بدید. با این کار جعبه متنی فقط از صفحه کلید کارکتر های عددی رو دریافت می کنه؛ نه چیز دیگه !

کد:

---

If Not IsNumeric(e.KeyChar) Then e.Handled = True

---

ابتدا API زیر را تعریف می کنیم (این تعریف می تواند در Public Class فرم یا در یک ماژول صورت گیرد.):

کد:

---

Private Declare Auto Function SystemParametersInfo Lib "user32.dll" (ByVal uAction As Integer, ByVal uParam As Integer, ByVal lpvParam As String, ByVal fuWinIni As Integer) As Integer

---

سپس از این دستور استفاده می کنیم:

کد:

---

SystemParametersInfo(&H14 , 0, "Bitamp Image Path", &H1)

---

به جای عبارت Bitmap Image Path ، مسیر عکس Bitmap (با پسوند BMP) را قرار می دهیم. این تصویر به عنوان پس زمینه ی میزکار ویندوز قرار می گیرد.