سورس کدهای مفید و کاربردی VB.Net

elahi

مدیریت
مدیر کل انجمن
با سلام به همه کاربران گرامی انجمن برنامه نویس
با توجه به این که بنده تاپیکی جامع در مورد سورس کدهای VB.NET ندیدم ، تصمیم گرفتم تا یک تاپیک در این رابطه راه اندازی کنم و از این به بعد نمونه کدهای کاربردی رو در اینجا قرار بدیم .
با کمک و یاری دوستان انشاالله تاپیک پر محتوایی خواهد شد .
دوستان عزیز ، برای جلوگیری از هرج و مرج و بهم ریختگی تاپیک از شما عزیزان درخواست میکنم که به نکات زیر توجه کنید :
1- از سوال کردن در این تاپیک خودداری کنید . سوالات خود را در تاپیک جداگانه مطرح کنید .
2- از پرداختن به بحث های حاشیه ای و مشاجره لفظی با دیگر کاربران اکیدا خودداری کنید .
3- از قرار دادن فایل اجرایی ( Exe ) بدون سورس کد امتنا کنید .
4- برای تشکر کردن از سورس کدهای دیگران نیز از دکمه تشکر استفاده کنید و پست بیهوده ارسال نکنید .
5- سورس کدهای خود را در فضایی که سایت به شما ارائه میدهد آپلود کنید و در صورتی که فایل شما حجیم تر از فضای ارائه شده است ، فایل خود را در مکانی دیگر آپلود و سپس لینک را در سایت قرار دهید . از درخواست ایمیل کاربران برای فرستادن سورس کد که باعث بوجود آمدن پست های بیهوده (حاوی آدرس ایمیل ها) میشود خودداری کنید .

6- در هر پست یک سورس ارسال کنید و از قرار دادن دسته جمعی سورس کدها در یک پست که باعث سردرگم شدن کاربر میشود خودداری کنید .


در پایان از همه دست اندرکاران سایت برنامه نویس و کاربران فهیم و گرامی کمال تشکر را دارم.
امید ما ، سورس کدهای خوب و مفید شما .........
با تشکر ...........
 
آخرین ویرایش:

elahi

مدیریت
مدیر کل انجمن
بخش نمونه کدهای VB.Net

سلام .
اولین برنامه رو هم خودم میزارم . با این برنامه میتونید آیکون درایوهاتون رو عوض کنید .
 

پیوست ها

elahi

مدیریت
مدیر کل انجمن
بخش نمونه کدهای VB.Net

اینم برنامه بعدی که واستون میزام . آموزش کامل انجام کارهای گرافیکی در vb.net
20 تابع در مورد کارهای گرافیکی در این برنامه بررسی شدن .
 

پیوست ها

elahi

مدیریت
مدیر کل انجمن
بخش نمونه کدهای VB.Net

با این برنامه میتونید اطلاعات مفید هر درایو رو بگیرید . مثل :
1- فضای کلی
2- فضای خالی
3- فضای استفاده شده
4- نوع درایو
5- فرمت درایو
امیدوارم خوشتون بیاد .
 

پیوست ها

elahi

مدیریت
مدیر کل انجمن
خش نمونه کدهای VB.Net

اینم برنامه کرنومتر که با یه روش جالب نوشتم که امیدوارم به دردتون بخوره.
 

پیوست ها

elahi

مدیریت
مدیر کل انجمن
بخش نمونه کدهای VB.Net

با این برنامه میتونید اطلاعات دمربوط به یک فایل رو استخراج کنید :
1- آدرس کامل فایل
2- ساعت ساخته شدن فایل
3- تاریخ ساخته شدن فایل
4- پسوند فایل
5- زمان آخرین دسترسی به فایل
6- زمان آخرین ویرایش فایل
7- اندازه فایل
امیدوارم خوشتون بیاد .
 

پیوست ها

elahi

مدیریت
مدیر کل انجمن
کد بعدی که میزارم میتونه واستون یه متن رو به صورت Vertical ( عمودی ) روی فرم چاپ کنه . امیدوارم خوشتون بیاد :
HTML:
Dim formgraphic As System.Drawing.Graphics = Me.CreateGraphics
    
    Dim drawstring As String = "N e t s k y"
   
     Dim drawfont As New Font("Tahoma", 25)
      
  Dim drawbrush As New SolidBrush(Color.Blue)

        Dim x As Single = 150.0

        Dim y As Single = 50.0
  
      Dim drawformat As New StringFormat
 
       drawformat.FormatFlags = StringFormatFlags.DirectionVertical
    
    formgraphic.DrawString(drawstring, drawfont, drawbrush, x, y, drawformat)

        drawfont.Dispose()
    
    drawbrush.Dispose()
      
  formgraphic.Dispose()
 

elahi

مدیریت
مدیر کل انجمن
اینم یک برنامه که عکس اسکن شده از اسکنر رو مستقیم میاره تو یک پیکچر باکس.
 

پیوست ها

elahi

مدیریت
مدیر کل انجمن
با این برنامه میتونید درایوهای usb کامپیوترتون رو پیدا کنید .
امیدوارم خوشتون بیاد .
 

پیوست ها

elahi

مدیریت
مدیر کل انجمن
کار این کد اینه که عکس مورد نظرتون رو Rotate ( چرخش ) میکنه .
اگه خواستید زاویه رو هم تغییر بدید توی اعدادی که داخل کد هست ، دست ببرید .

HTML:
Dim Graphic As Graphics

Graphic = Me.CreateGraphics

'---------------------------

Dim DestPoint As Point() = {New Point(100, 0), New Point(260, 50), New Point(100, 200)}

'DestPoint = Destination Point

'----------------------------                 

'Adrese Aks Mored Nazare Khodetoon Ro Be Jaye ("c:\Your_Image.jpg") Bezarid . 

Dim NewImage As Image = Image.FromFile("C:\Your_Image.jpg")

'-------------------------------------------------

Graphic.DrawImage(NewImage, DestPoint)
 

elahi

مدیریت
مدیر کل انجمن
یه سورس کد دیگه واستون دارم . اینو از سایت Code Project دانلود کردم . خیلی باحاله . میتونید به عکس هاتون افکت های بسیار زیبای انیمیشنی بدید . اگه دانلود نکنید ضرر کردید .
 

پیوست ها

elahi

مدیریت
مدیر کل انجمن
[FONT=&quot]با این کد میشه سری اطلاعات رو یه جای خاص از رجیستری ذخیره کنید که مثلا برای ثبت تنظیمات کاربر میتونید مورد استفاده قرار بدید


[/FONT]
[FONT=&quot]ذخیره اطلاعات
[/FONT]
[FONT=&quot]
HTML:
 SaveSetting(My.Application.Info.AssemblyName, "Appearance", "Font", FontName)

SaveSetting(My.Application.Info.AssemblyName, "Appearance", "Color", ColorName)
[/FONT]
[FONT=&quot]
[/FONT]

[FONT=&quot]بازیابی اطلاعات

[/FONT]
[FONT=&quot]
HTML:
 FontName=GetSetting(My.Application.Info.AssemblyNa  me, "Appearance", "Font","")

ColorName=GetSetting(My.Application.Info.AssemblyN  ame, "Appearance", "Color","")
[/FONT]
[FONT=&quot]HKEY_CURRENT_USER\Software\VB and VBA Program Settings محل ذخیره سازی اطلاعات [/FONT][FONT=&quot][/FONT]
 

elahi

مدیریت
مدیر کل انجمن
[FONT=&quot]با این کد می تونید یک فایل رو در شبکه با استفاده از وینسوک ارسال کنید.

[/FONT]
[FONT=&quot]
HTML:
 Public Sub SendData(ByVal sFile As String, ByVal sSaveAs As String, ByVal tcpSend As Winsock)
    On Error GoTo ErrHandler

    Dim sSend As String, sBuf As String

    Dim ifreefile As Integer

    Dim lRead As Long, lLen As Long, lThisRead As Long, lLastRead As Long

    Dim strData As String

    tcpSend.GetData(strData)

    ifreefile = FreeFile
 
    ' Open file for binary access: 
   Open sFile For Binary Access Read As #ifreefile

    lLen = LOF(ifreefile)
     ' Loop through the file, loading it up in chunks of 64k:
    Do While lRead < lLen

        lThisRead = 65536
      
  If lThisRead + lRead > lLen Then
        
    lThisRead = lLen - lRead

        End If
     
   If Not lThisRead = lLastRead Then
      
      sBuf = Space$(lThisRead)

        End If
 
       Get #ifreefile, , sBuf
    
    lRead = lRead + lThisRead

        sSend = sSend & sBuf

        sBuf = Space$(0)

    Loop

    lTotal = lLen

    Close(ifreefile)

    bSendingFile = True
  
  '// Send the file notification

    tcpSend.SendData("FILE" & sSaveAs)

    DoEvents()
 
   '// Send the file

    tcpServer.SendData(sSend)

    DoEvents()

    '// Finished

    tcpSend.SendData("FILEEND")

    bSendingFile = False

    MMControl1.FileName = "FileDone.wav"
 
   MMControl1.Command = "Open"
 
   MMControl1.Command = "Play"

    Exit Sub
ErrHandler

:  
  MsgBox "Err " & Err & " : " & Error
End Sub
 
Private Sub tcpServer_DataArrival(ByVal bytesTotal As Long)
    Dim strData As String

    Dim ifreefile
 
    '    DoEvents

    tcpServer.GetData(strData)

    If Right$(strData, 7) = "FILEEND" Then

        bFileArriving = False
     
   lblProgress = "Saving File to " & App.Path & "\" & sFile
     
   sArriving = sArriving & Left$(strData, Len(strData) - 7)

        ifreefile = FreeFile

        MMControl1.FileName = "File.wav"

        MMControl1.Command = "Open"
     
   MMControl1.Command = "Play"
         
   Open sFile For Binary Access Write As #ifreefile
    
        Put #ifreefile, 1, sArriving
  
          Close #ifreefile
         
   ShellExecute 0, vbNullString, App.Path & "\" & sFile,
 
       vbNullString, vbNullString, vbNormalFocus

        lblProgress = "Complete"

    ElseIf Left$(strData, 4) = "FILE" Then
  
      bFileArriving = True
      
  sFile = Right$(strData, Len(strData) - 4)

    ElseIf bFileArriving Then
        
lblProgress = "Receiving " & bytesTotal & " bytes for " & sFile & ""

>from " & tcpServer.RemoteHostIP
  
     sArriving = sArriving & strData
     
   MMControl1.FileName = "FileDone.wav"
   
     MMControl1.Command = "Open"
    
    MMControl1.Command = "Play"

    End If
End Sub
[/FONT]
 

elahi

مدیریت
مدیر کل انجمن
[FONT=&quot]انجام اعمال متداول در رجیستری
[/FONT]
[FONT=&quot]
HTML:
Imports Microsoft.Win32 
 Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click
    ' // Create SubKey

    Registry.LocalMachine.CreateSubKey("Software\Sinpi  n", RegistryKeyPermissionCheck.ReadWriteSubTree)
 

    '//Create Key and Set Value

    Dim reg As RegistryKey = Registry.LocalMachine.OpenSubKey("Software\Sinpin"  , True)

    reg.SetValue("DWord", "1", RegistryValueKind.DWord)
 
   reg.SetValue("ExpandString", "1", RegistryValueKind.ExpandString)

    reg.SetValue("QWord", "1", RegistryValueKind.QWord)
  
  reg.SetValue("String", "1", RegistryValueKind.String)

    reg.SetValue("Unknown", "1", RegistryValueKind.Unknown) 

    '// Delete Key

    reg.DeleteValue("DWOrd")
 
    '// Delete SubKey
  
  Registry.LocalMachine.DeleteSubKey("Software\Sinpi  n")
 
    '// Read Key Value
 
  Dim val As String = reg.GetValue("QWord").ToString()
 
    '// Retrieve All Keys

    For Each s As String In reg.GetValueNames()
   
     MessageBox.Show(s)

    Next
 
End Sub
[/FONT]
 

elahi

مدیریت
مدیر کل انجمن
[FONT=&quot]اجرا کردن یک فایل اجرایی با کدنویسی
[/FONT]
[FONT=&quot]
HTML:
System.Diagnostics.Process.Start("mspaint.exe")
[/FONT]
[FONT=&quot]

چنانچه فایل اجرایی نیاز به آرگومان خط فرمان داشته باشد[/FONT]
[FONT=&quot]:
[/FONT]
[FONT=&quot]
کد:
[/FONT][/COLOR]System.Diagnostics.Process.Start("mspaint.exe", "c:\Test.bmp")[COLOR=black][FONT=&quot]
[/FONT]
[FONT=&quot][/FONT]
[FONT=&quot]


تغییر خواص یک فایل[/FONT]

کد:
Imports System.IO 

Public Class Form1 

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim file As FileInfo = New FileInfo("C:\test.txt")
        file.Attributes = file.Attributes Or FileAttributes.ReadOnly Or FileAttributes.Hidden
    End Sub
End Class
 

elahi

مدیریت
مدیر کل انجمن
چاپ متنی بر روی عکس
کد:
Dim bim AsNew Bitmap(PictureBox1.Image)
Dim g As Graphics = Graphics.FromImage(bim)
PictureBox1.CreateGraphics.DrawString(TextBox1.Tex  t, Me.Font, Brushes.Black, 10, 10)
g.DrawString(TextBox1.Text, Me.Font, Brushes.Black, 10, 10)
bim.Save("e:\test.jpg")
 

elahi

مدیریت
مدیر کل انجمن
با این کد میتونید انتقال هرگونه اطلاعات به USB درایوها غیر ممکن کنید .
البته نگران نباشید . کد واسه غیرفعال کردنش رو هم گذاشتم .

خب ، اول کد واسه فعال سازی :
کد:
Public Function Lock_USB()
     
   My.Computer.Registry.SetValue("HKEY_LOCAL_MACHINE\   SYSTEM\CurrentControlSet\Control\StorageDevicePoli  cies\",  "writeProtect", 1, Microsoft.Win32.RegistryValueKind.DWord)


    End Function
کد غیر فعال کردن :
کد:
Public Function Unlock_USB()
       
 My.Computer.Registry.LocalMachine.DeleteSubKey("SY  STEM\CurrentControlSet\Control\StorageDevicePolici  es")


    End Function
 

elahi

مدیریت
مدیر کل انجمن
1- اولی واسه بدست آوردن درایو ویندوز هستش :
کد:
[/FONT]Public Function Windows_Drive()


       MsgBox(My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Volatile  Environment", "HOMEDRIVE", 0), MsgBoxStyle.Information, "Windows  Drive")

 End Function  


[FONT=Tahoma]

2- کد دوم واسه بدست آوردن مسیر فولدر Application Data :
کد:
[/FONT]Public Function AppData_Path()


        MsgBox(My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Volatile  Environment", "APPDATA", 0), MsgBoxStyle.Information, "Application Data  Folder")


End Function


[FONT=Tahoma]

3- کد شماره 3 واستون مسیر فولدر یوزر برمیگردونه :

کد:
[/FONT]Public Function UserFolder_Path()


Dim win_drv As String



win_drv = My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Volatile Environment", "HOMEDRIVE", 0)


MsgBox(win_drv  + My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Volatile  Environment", "HOMEPATH", 0), MsgBoxStyle.Information, "User Folder")


End Function


[FONT=Tahoma]

 

elahi

مدیریت
مدیر کل انجمن
یلی از برنامه نویسا واسه اینکه تاریخ شمسی رو در برنامشون ایجاد کنند از کامپوننت های مختلف و زیادی استفاده میکنن ، در صورتی که در خود VB.Net میتونید خیلی راحت تاریخ میلادی رو به شمسی تبدیل کنید . بوسیله کد زیر میتونید این کار رو انجام بدید .
کد:
Public Function Shamsi_Date() As String

        Dim DT As Date = Date.Now

      
  Dim Year, Month, Day As String

      
  Dim Glob As New Globalization.PersianCalendar

 
       Year = Glob.GetYear(DT)

 
       Month = Glob.GetMonth(DT)

     
   Day = Glob.GetDayOfMonth(DT)

   
     Shamsi_Date = Year & "\" & Month & "\" & Day


        MsgBox(Shamsi_Date)


    End Function
 

elahi

مدیریت
مدیر کل انجمن
با این کد میتونید برنامه رو با 5 بار اجرا از کار بندازید .
نکته : این کد رو باید در رویداد Form_Load کپی کنید .
کد:
Dim verify


        verify = GetSetting(Application.CompanyName, "ST", "ST")


        If verify = "" Then

          
  SaveSetting(Application.CompanyName, "ST", "ST", 5)


        Else

       
     If verify <= 0 Then

           
     MsgBox("The Beta Period is Over!!!", MsgBoxStyle.Critical, "Beta Period")

             
   End

        
    End If

          
  verify = Val(verify) - 1

         
   SaveSetting(Application.CompanyName, "ST", "ST", verify)


        End If
البته نکته ای که باید بگم ، این روش رو خیلی راحت میشه دور زد . کافیه کاربر یکم با ریجستری آشنا باشه .
 
بالا