by The Snippet Vault:
The Snippet Vault is a Stickied thread created in a effort to answer
those small questions before they have to be asked.
The rules of this thread is simple:
Post your Snippets here and share them.
For our purposed when I say Code snippets that includes Very short
tutorial (like add 2 text boxes and goto code)(Nothing extensive, save
those tutorials for the tutorial section.) or a few lines of code to
accomplish something Small.
-------------------------
CREDITS BY:
PuBlic Hacks
+
Umbrella Corporation
-------------------------
The Snippet Vault is a Stickied thread created in a effort to answer
those small questions before they have to be asked.
The rules of this thread is simple:
- This thread is open and will stay open.
- This thread is stickied and therefore can be posted in > 7 days.
- You can post in this thread, but if you post anything it [b] contain]/b] a snippet of code as well.
for the sake of keeping it uniform - This section is not
for "How to Run Visual Basic .NET" or "Download Visual Basic .NET
Express from" , It will be used for Snippets of code only. - If you leech the snippet, Give credit, (even if it is MSDN Standard)
- Check the posts before yours, don't post existing snippets or alternatives to snippets, it is not needed and will be removed.
Post your Snippets here and share them.
For our purposed when I say Code snippets that includes Very short
tutorial (like add 2 text boxes and goto code)(Nothing extensive, save
those tutorials for the tutorial section.) or a few lines of code to
accomplish something Small.
- Code:
[highlight=vbnet]
My.Computer.FileSystem.CopyFile("FileLocaion", "FileDestination")
[/highlight]
[color=DarkOrange]Save Window Size Settings[/color]
[highlight=vbnet]
If Me.WindowState = FormWindowState.Normal Then
My.Settings.WindowSize = Me.Size
End If
[/highlight]
[color=DarkOrange]Save Windows Location[/color]
[highlight=vbnet]
If Me.WindowState = FormWindowState.Normal Then
My.Settings.WindowLocation = Me.Location
End If
[/highlight]
[color=DarkOrange]Loads a windows previous size from settings[/color]
[highlight=vbnet]
If Not My.Settings.WindowSize.Width = 0 Then
Me.Size = My.Settings.WindowSize
End If
[/highlight]
[color=DarkOrange]Loads Previous Locations From Settings[/color]
[highlight=vbnet]
If Not My.Settings.WindowLocation.X = 0 Then
Me.Location = My.Settings.WindowLocation
End If
[/highlight]
[color=DarkOrange]Auto Update Previous Version Settings[/color]
[highlight=vbnet]
If My.Settings.CallUpgrade = True Then
My.Settings.Upgrade()
My.Settings.CallUpgrade = False
End If
[/highlight]
[color=DarkOrange] Minimize to tray[/color]
[color=Red]Form Load (Set Icon)[/color]
[highlight=vbnet]
Me.NotifyIcon1.Icon = Me.Icon
[/highlight]
[color=red]
Form Load, Set it true
[/color]
[highlight=vbnet]
Me.NotifyIcon1.Visible = true
[/highlight]
[color=red]
VB Syntax for Minimizing to System Tray
[/color]
[highlight=vbnet]
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
NotifyIcon1.Visible = False
End Sub
Private Sub NotifyIcon1_MouseDoubleClick(ByVal sender As
System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles
NotifyIcon1.MouseDoubleClick
Try
Me.Show()
Me.WindowState = FormWindowState.Normal
NotifyIcon1.Visible = False
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Private Sub Form1_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
Try
If Me.WindowState = FormWindowState.Minimized Then
Me.WindowState = FormWindowState.Minimized
NotifyIcon1.Visible = True
Me.Hide()
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
[/highlight]
[color=red]
Show Balloon Tip
(use on minimize, but can be adjusted for anything
[/color]
[highlight=vbnet]
notifyIcon1.ShowBalloonTip(3000, "Your App", ("Application has not
closed" & DirectCast((13), [Char]) & "You can access it from
System tray") + DirectCast((13), [Char]) & "Right click the Icon to
exit.", ToolTipIcon . info
[/highlight]
[color=DarkOrange] Save Checkbox Settings[/color]
Form Load
[highlight=vbnet]
CheckBox1.Checked = GetSetting(Application.ProductName, Application.ProductName, "CheckBox1")
[/highlight]
Form Closing
[highlight=vbnet]
SaveSetting(Application.ProductName, Application.ProductName, "CheckBox1", CheckBox1.Checked)
[/highlight]
This can be changed/modified for other components as well
[color=DarkOrange]Get and Save Settings[/color]
Get Setting:
[highlight=vbnet]
MySettingValue = My.Settings.Default.SettingName
[/highlight]
[highlight=vbnet]
My.Settings.Default.SettingName = ConnString
My.Settings.Save()
[/highlight]
[color=DarkOrange]Send Input to Send Mouse Clicks[/color]
Declare
[highlight=vbnet]
Public Structure MOUSEINPUT
Public dx As Integer
Public dy As Integer
Public mouseData As Integer
Public dwFlags As Integer
Public dwtime As Integer
[/highlight]
Code:
[highlight=vbnet]
Public Sub MouseClick()
Dim inputme(0) As INPUT_TYPE
inputme(0).xi.dx = 0
inputme(0).xi.dy = 0
inputme(0).xi.mouseData = 0
inputme(0).xi.dwFlags = M_MOVE + M_LD + M_LU
inputme(0).xi.dwtime = 0
inputme(0).xi.dwExtraInfo = 0
inputme(0).dwType = INPUT_MOUSE
SendInput(1, inputme(0), Len(inputme(0)))
SetCursorPos(xyC)
End Sub
[/highlight]
[color=DarkOrange]Get Windows Title[/color]
Declaration:This works with one textbox and one Button, But the code can be used where ever you like.
[highlight=vbnet]
Dim mce As Boolean
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias
"GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal
cch As Long) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
[/highlight]
Module
[highlight=vbnet]
Type POINTAPI
x As Long
y As Long
End Type
[/highlight]
Code
[highlight=vbnet]
Private Sub Button1_Click()
mse = True
intRetVal = SetCapture(hwnd)
End Sub
Private Sub Form_Load()
mse = False
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim window As Long
Dim buffer As String * 1024
Dim ptPoint As POINTAPI
If mse Then
ptPoint.x = x
ptPoint.y = y
retval = ClientToScreen(hwnd, ptPoint)
window = WindowFromPoint(ptPoint.x, ptPoint.y)
lngRetVal = GetWindowText(window, buffer, 1024)
Text1.Text = buffer
End If
End Sub
[/highlight]
[color=DarkOrange]Play Wav File[/color]
Declarations
[highlight=vbnet]
Public Const SND_ALIAS = &H10000
Public Const SND_ASYNC = &H1
Public Const SND_LOOP = &H8
Public Const SND_NOWAIT = &H2000
Public Const SND_SYNC = &H0
[/highlight]
Code
(place in any event or trigger you like)
[highlight=vbnet]
Dim sps As Long
sps = sndPlaySound("location/file.wav", SND_SYNC)
[/highlight]
Detect of computer has a wav compatible Sound Card...
Declarations
[highlight=vbnet]
Private Declare Function waveOutGetNumDevs Lib "winmm" () As Long
[/highlight]
Code
[highlight=vbnet]
Dim w As Long
w = waveOutGetNumDevs()
If i > 0 Then (there would have to be atleast 1 sound card)
MsgBox "Wav Compatible"
Else
MsgBox "Non Wav Comp."
End If
[/highlight]
[color=DarkRed][size=16]A Collection Of UI Code Snippets to enhance your users interface.[/size][/color]
[color=DarkOrange]Check Mouse Click[/color]
[highlight=vbnet]
Dim clickd As String
clickd = e.Button()
Select Case clickd
Case 2097152 '(right mouse Value)
MsgBox("You Right Clicked")
Case 1048576 '(left Mouse Value)
MsgBox("You Left Clicked")
End Select
MsgBox(clicktext)
[/highlight]
[color=DarkOrange]Disable (X) On form[/color]
(I have a full tutorial in my sig, but here is the code snippet, I wanted to include it in this list because it comes in handy)
[highlight=vbnet]
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As IntPtr,
ByVal nPosition As Integer, ByVal wFlags As Long) As IntPtr
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As IntPtr, ByVal bRevert As Boolean) As IntPtr
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As IntPtr) As Integer
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As IntPtr) As Boolean
Private Const MF_BYPOSITION = &H400
Private Const MF_REMOVE = &H1000
Private Const MF_DISABLED = &H2
Public Sub DisableCloseButton(ByVal hwnd As IntPtr)
Dim hMenu As IntPtr
Dim menuItemCount As Integer
hMenu = GetSystemMenu(hwnd, False)
menuItemCount = GetMenuItemCount(hMenu)
Call RemoveMenu(hMenu, menuItemCount - 1, _
MF_DISABLED Or MF_BYPOSITION)
Call RemoveMenu(hMenu, menuItemCount - 2, _
MF_DISABLED Or MF_BYPOSITION)
Call DrawMenuBar(hwnd)
End Sub
[/highlight]
Add this to the event that will trigger the disable
Ex: Form Load, Setting , Menu Item , etc...
[highlight=vbnet]
DisableCloseButton(Me.Handle)
[/highlight]
[color=DarkOrange]Fade Out[/color]
This goes in a Non-Class are
[highlight=vbnet]
Friend WithEvents fader As System.Windows.Forms.Timer
[/highlight]
Call this to fade out
[highlight=vbnet]
Public Sub fade()
Me.fader = New System.Windows.Forms.Timer
Me.fader.Enabled = True
Me.fader.Interval = 30
End Sub
[/highlight]
This is the actual fade
[highlight=vbnet]
Private Sub fader_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles fader.Tick
Me.Opacity -= 0.03 ('3% opacity, you can use anything youlike)
' this checks the opacity, it it is less then 5 then..end
' alot of people use 0, but I am doing it by 3% not by 1% , so check
and ' see if it is less then 5 as opposed to = 0,
however you can use any ' ' method you perfer, I just perfer
this way (looks cleaner to me)
If Me.Opacity < 2 Then
End
End If
End Sub
[/highlight]
[color=DarkOrange]Make form transparent while dragging[/color]
(this is and example of how checking the state of a mouse click can come in handy[above])
[highlight=vbnet]
Private Const WM_NCLBUTTONDOWN As Long = &HA1
Private Const WM_NCLBUTTONUP As Long = &HA0
Private Const WM_MOVING As Long = &H216
Private Const WM_SIZE As Long = &H5
Protected Overrides Sub DefWndProc(ByRef m As System.Windows.Forms.Message)
Static LButtonDown As Boolean
(checks left click)
If CLng(m.Msg) = WM_NCLBUTTONDOWN Then
'(as long as left button is down LButtonDown returns true)
LButtonDown = True
ElseIf CLng(m.Msg) = WM_NCLBUTTONUP Then
' (As long as left button is up, LButtonDown returns false)
LButtonDown = False
End If
If LButtonDown Then
If CLng(m.Msg) = WM_MOVING Then
'Changes form opacity to 70% if the form is being dragged
' You can change the 0.7 to anything 0.1 = 10% 0.2 = 20 % and so on
If Me.Opacity <> 0.9 Then Me.Opacity = 0.5
ElseIf CLng(m.Msg) = WM_SIZE Then
'Set the forms opacity to 60% if user is resizing the window
If Me.Opacity <> 0.6 Then Me.Opacity = 0.6
End If
ElseIf Not LButtonDown Then
If Me.Opacity <> 1.0 Then Me.Opacity = 1.0
End If
MyBase.DefWndProc(m)
End Sub
[/highlight]
[color=DarkOrange]Windows Shadow - (Tested in Xp)[/color]
[highlight=vbnet]
Protected Overrides ReadOnly Property CreateParams() As System.Windows.Forms.CreateParams
Get
Const CS_DROPSHADOW = &H20000
Dim CrPa As CreateParams = MyBase.CreateParams
CrPa.ClassStyle = CrPa.ClassStyle Or CS_DROPSHADOW
Return CrPa
End Get
End Property
[/highlight]
[FONT="Times New Roman"][COLOR="DarkOliveGreen"][font=Times New Roman][color=DarkOliveGreen][size=16]Snippets Part 3[/size]
[color=Red]I will Be adding more as I write them[/color]
[size=12][color=DarkOrange]Empty Recycling Bin[/color][/size]
Declarations And Variables
[highlight=vbnet]
Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias
"SHEmptyRecycleBinA" (ByVal hWnd As Int32, ByVal pszRootPath As String,
ByVal dwFlags As Int32) As Int32
Private Declare Function SHUpdateRecycleBinIcon Lib "shell32.dll" () As Int32
Private Const SHERB_NOCONFIRMATION = &H1
Private Const SHERB_NOPROGRESSUI = &H2
Private Const SHERB_NOSOUND = &H4
[/highlight]
Empty Recycling Bin Sub
[highlight=vbnet]
Private Sub takeoutthetrash()
SHEmptyRecycleBin(Me.Handle.ToInt32, vbNullString, SHERB_NOCONFIRMATION + SHERB_NOSOUND)
SHUpdateRecycleBinIcon()
End Sub
[/highlight]
Code to call the empty recycling bin sub
[highlight=vbnet]
takeoutthetrash()
[/highlight]
[color=DarkOrange]Add a Windows User[/color]
Add 3 TextBox's
Add 1 Button
TextBox1 will be for the new Username
Textbox2 will be the password field
Textbox3 will be the verify password field
Button_Click Event for button
[highlight=vbnet]
Dim username As String = TextBox1.Text
Dim password As String = TextBox2.Text
'Match the passwords, if they match, then add user
If TextBox2.Text = TextBox3.Text Then
Shell("net user " & username & " " & password & " /add")
MessageBox.Show("Windows User Created)
Else
MessageBox.Show("Passwords are different")
End If
[/highlight]
[color=DarkOrange]Get Hardware Serial[/color]
Create a New Class and add this code
[highlight=vbnet]
Public Class HardDrive
Private dsk_model As String
Private dsk_type As String
Private dsk_serialNo As String
Public Property Model() As String
Get
Return dsk_model
End Get
Set(ByVal value As String)
dsk_model = value
End Set
End Property
Public Property Type() As String
Get
Return dsk_type
End Get
Set(ByVal value As String)
dsk_type = value
End Set
End Property
Public Property serialNo() As String
Get
Return dsk_serialNo
End Get
Set(ByVal value As String)
dsk_serialNo = value
End Set
End Property
End Class
[/highlight]
Now Add a textbox to your form, set it to multiline=true
View Code
In the namespace
[highlight=vbnet]
Imports System
Imports System.Collections
Imports System.Management
[/highlight]
Variables and Declarations
'Dim appname as system.STATthreadattribute()
Dim WindowsApplication1 As System.STAThreadAttribute()
In Form1 Load add
[highlight=vbnet]
Dim SerialHD As New ArrayList()
Dim Obsearch As New ManagementObjectSearcher("SELECT * FROM Win32_DiskDrive")
Dim HDinfo As New ManagementObject()
For Each HDinfo In Obsearch.Get
Dim hd As New Class1.HardDrive()
hd.Model = HDinfo("Model").ToString()
hd.Type = HDinfo("InterfaceType").ToString()
SerialHD.Add(hd)
Next
Dim searcher1 As New ManagementObjectSearcher("SELECT * FROM Win32_PhysicalMedia")
Dim i As Integer = 0
For Each HDinfo In searcher1.Get()
Dim hd As Class1.HardDrive
hd = SerialHD(i)
If HDinfo("SerialNumber") = "" Then
hd.serialNo = "None"
Else
hd.serialNo = HDinfo("SerialNumber").ToString()
i += 1
End If
Next
Dim hd1 As Class1.HardDrive
Dim ii As Integer = 0
For Each hd1 In SerialHD
ii += 1
TextBox1.Text = TextBox1.Text + "Serial No: " + hd1.serialNo + Chr(13) + Chr(10) + Chr(13) + Chr(10)
Next
[/highlight]
[color=DarkOrange]Clear All Controls in a Form (MSDN Standard CODE)[/color]
[highlight=vbnet]
For Each objControls As Control In Me.Controls
If TypeOf objControls Is TextBox Then
CType(objControls, TextBox).Text = String.Empty
End If
If TypeOf objControls Is DropDownList Then
If Not CType(objControls, DropDownList).ID.Contains("ddlUSTYear") Then
CType(objControls, DropDownList).SelectedIndex = 0
End If
End If
If TypeOf objControls Is CheckBox Then
CType(objControls, CheckBox).Checked = False
End If
If TypeOf objControls Is RadioButton Then
CType(objControls, RadioButton).Checked = False
End If
Next
[/highlight]
[size=12][color=DarkOrange]Read File Content[/color][/size]
[highlight=vbnet]
Public Shared Function ReadFileContent(ByVal sFile As String) As String
Dim GetFileC As String = String.Empty
If File.Exists(sFile) Then
Dim ActualC As StreamReader = File.OpenText(sFile)
Try
ActualC = File.OpenText(sFile)
GetFileC = ActualC.ReadToEnd()
Catch exp As Exception
Throw ex
Finally
If Not Nothing Is ActualC Then
ActualC.Close()
End If
End Try
End If
Return GetFileC
End Function
[/highlight]
To Call it Use
ReadFileContent ("File Location")
[color=DarkOrange][size=12]Get File Extension[/size][/color]
[highlight=vbnet]
Public Shared Function GetExtension(ByVal strFileName As String) As String
If (strFileName.Length > 0) Then
stringDoc = strFileName.Split(characterA)
Return "." + stringDoc(stringDoc.Length - 1)
Else
Return ""
End If
End Function
[/highlight]
To use Call the Function
GetExtension ("File Location and Name")
[color=DarkOrange][size=12]Prevent Pasting in a Textbox with Ctrl + V[/size][/color]
[highlight=vbnet]
' This is Used in the Keypressed method, You can use the same concept on click , or Mouse Click, etc....
Private Sub TextBox1_KeyPress(ByVal sender As System.Object, ByVal e As
System.Windows.Forms.KeyPressEventArgs) Handles TextBox1.KeyPress
System.Windows.Forms.Clipboard.Clear()
End Sub
[/highlight]
[color=DarkOrange]Random Password String From GUID[/color]
[highlight=vbnet]
Public Function GetRandomPasswordUsingGUID1(ByVal length As Double) As String
Dim GR As String = System.Guid.NewGuid.ToString
GR = GR.Replace("-", String.Empty)
If length <= 0 OrElse length > GR.Length Then
Throw New ArgumentException("Length should be between 1 and " & GR.Length)
End If
Return GR.Substring(0, length)
End Function
[/highlight]
Use, (Sim liar to SOAP WSDL API, or Web Services in ASP.net)
GetRandomPasswordUsingGUID1(Legth Of Password)
Example
Button_Click Event
MsgBox(GetRandomPasswordUsingGUID1(25)
[color=DarkOrange]Encrypt Text[/color]
[highlight=vbnet]
Public Function EnDeCrypt(ByVal Text As String) As String
Dim TCr As String = "", i As Integer
For i = 1 To Len(Text)
If Asc(Mid$(Text, i, 1)) < 128 Then
TCr = CType(Asc(Mid$(Text, i, 1)) + 128, String)
ElseIf Asc(Mid$(Text, i, 1)) > 128 Then
TCr = CType(Asc(Mid$(Text, i, 1)) - 128, String)
End If
Mid$(Text, i, 1) = Chr(CType(TCr, Integer))
Next i
Return Text
[/highlight]
To use
MsgBox (EnDecrypt("Word to encrypt")
Example:
Msgbox (Endecrypt("Food")
Will encrypt the word food, you can use this in whole textbox's etc.
[color=DarkOrange]Get List Of Installed Printers on your machine[/color]
Add a Combo-Box to your form
In Namespace
[highlight=vbnet]
Imports System.Drawing
Form Load Event
<<<
@[url=http://www.mpgh.net/forum/members/398149--14-.html]!14![/url] @>>>
Force Application To Require Admin Approval
Show All files in your Solutions Explorer
Navigate to the Bin Folder ----> Debug ----> Applicationname.Vshost.exe.Manifest File
Double Click it and
add this code
<<<@!15!@>>>
Replacing it with the existing code
or
Use the existing code
[highlight=vbnet]
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity version="1.0.0.0" name="MyApplication.app"/>
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
<security>
<requestedPrivileges xmlns="urn:schemas-microsoft-com:asm.v3">
[b]<requestedExecutionLevel level="asInvoker" uiAccess="false"/>[/b]
</requestedPrivileges>
</security>
</trustInfo>
</assembly>
[/highlight]
[/color][/font]
- Code:
[font=Times New Roman][color=DarkOliveGreen]Declarations And Variables
[highlight=vbnet]
Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias
"SHEmptyRecycleBinA" (ByVal hWnd As Int32, ByVal pszRootPath As String,
ByVal dwFlags As Int32) As Int32
Private Declare Function SHUpdateRecycleBinIcon Lib "shell32.dll" () As Int32
Private Const SHERB_NOCONFIRMATION = &H1
Private Const SHERB_NOPROGRESSUI = &H2
Private Const SHERB_NOSOUND = &H4
[/highlight]
Empty Recycling Bin Sub
[highlight=vbnet]
Private Sub takeoutthetrash()
SHEmptyRecycleBin(Me.Handle.ToInt32, vbNullString, SHERB_NOCONFIRMATION + SHERB_NOSOUND)
SHUpdateRecycleBinIcon()
End Sub
[/highlight]
Code to call the empty recycling bin sub
[highlight=vbnet]
takeoutthetrash()
[/highlight]
[color=DarkOrange]Add a Windows User[/color]
Add 3 TextBox's
Add 1 Button
TextBox1 will be for the new Username
Textbox2 will be the password field
Textbox3 will be the verify password field
Button_Click Event for button
[highlight=vbnet]
Dim username As String = TextBox1.Text
Dim password As String = TextBox2.Text
'Match the passwords, if they match, then add user
If TextBox2.Text = TextBox3.Text Then
Shell("net user " & username & " " & password & " /add")
MessageBox.Show("Windows User Created)
Else
MessageBox.Show("Passwords are different")
End If
[/highlight]
[color=DarkOrange]Get Hardware Serial[/color]
Create a New Class and add this code
[highlight=vbnet]
Public Class HardDrive
Private dsk_model As String
Private dsk_type As String
Private dsk_serialNo As String
Public Property Model() As String
Get
Return dsk_model
End Get
Set(ByVal value As String)
dsk_model = value
End Set
End Property
Public Property Type() As String
Get
Return dsk_type
End Get
Set(ByVal value As String)
dsk_type = value
End Set
End Property
Public Property serialNo() As String
Get
Return dsk_serialNo
End Get
Set(ByVal value As String)
dsk_serialNo = value
End Set
End Property
End Class
[/highlight]
Now Add a textbox to your form, set it to multiline=true
View Code
In the namespace
[highlight=vbnet]
Imports System
Imports System.Collections
Imports System.Management
[/highlight]
Variables and Declarations
'Dim appname as system.STATthreadattribute()
Dim WindowsApplication1 As System.STAThreadAttribute()
In Form1 Load add
[highlight=vbnet]
Dim SerialHD As New ArrayList()
Dim Obsearch As New ManagementObjectSearcher("SELECT * FROM Win32_DiskDrive")
Dim HDinfo As New ManagementObject()
For Each HDinfo In Obsearch.Get
Dim hd As New Class1.HardDrive()
hd.Model = HDinfo("Model").ToString()
hd.Type = HDinfo("InterfaceType").ToString()
SerialHD.Add(hd)
Next
Dim searcher1 As New ManagementObjectSearcher("SELECT * FROM Win32_PhysicalMedia")
Dim i As Integer = 0
For Each HDinfo In searcher1.Get()
Dim hd As Class1.HardDrive
hd = SerialHD(i)
If HDinfo("SerialNumber") = "" Then
hd.serialNo = "None"
Else
hd.serialNo = HDinfo("SerialNumber").ToString()
i += 1
End If
Next
Dim hd1 As Class1.HardDrive
Dim ii As Integer = 0
For Each hd1 In SerialHD
ii += 1
TextBox1.Text = TextBox1.Text + "Serial No: " + hd1.serialNo + Chr(13) + Chr(10) + Chr(13) + Chr(10)
Next
[/highlight]
[color=DarkOrange]Clear All Controls in a Form (MSDN Standard CODE)[/color]
[highlight=vbnet]
For Each objControls As Control In Me.Controls
If TypeOf objControls Is TextBox Then
CType(objControls, TextBox).Text = String.Empty
End If
If TypeOf objControls Is DropDownList Then
If Not CType(objControls, DropDownList).ID.Contains("ddlUSTYear") Then
CType(objControls, DropDownList).SelectedIndex = 0
End If
End If
If TypeOf objControls Is CheckBox Then
CType(objControls, CheckBox).Checked = False
End If
If TypeOf objControls Is RadioButton Then
CType(objControls, RadioButton).Checked = False
End If
Next
[/highlight]
[size=12][color=DarkOrange]Read File Content[/color][/size]
[highlight=vbnet]
Public Shared Function ReadFileContent(ByVal sFile As String) As String
Dim GetFileC As String = String.Empty
If File.Exists(sFile) Then
Dim ActualC As StreamReader = File.OpenText(sFile)
Try
ActualC = File.OpenText(sFile)
GetFileC = ActualC.ReadToEnd()
Catch exp As Exception
Throw ex
Finally
If Not Nothing Is ActualC Then
ActualC.Close()
End If
End Try
End If
Return GetFileC
End Function
[/highlight]
To Call it Use
ReadFileContent ("File Location")
[color=DarkOrange][size=12]Get File Extension[/size][/color]
[highlight=vbnet]
Public Shared Function GetExtension(ByVal strFileName As String) As String
If (strFileName.Length > 0) Then
stringDoc = strFileName.Split(characterA)
Return "." + stringDoc(stringDoc.Length - 1)
Else
Return ""
End If
End Function
[/highlight]
To use Call the Function
GetExtension ("File Location and Name")
[color=DarkOrange][size=12]Prevent Pasting in a Textbox with Ctrl + V[/size][/color]
[highlight=vbnet]
' This is Used in the Keypressed method, You can use the same concept on click , or Mouse Click, etc....
Private Sub TextBox1_KeyPress(ByVal sender As System.Object, ByVal e As
System.Windows.Forms.KeyPressEventArgs) Handles TextBox1.KeyPress
System.Windows.Forms.Clipboard.Clear()
End Sub
[/highlight]
[color=DarkOrange]Random Password String From GUID[/color]
[highlight=vbnet]
Public Function GetRandomPasswordUsingGUID1(ByVal length As Double) As String
Dim GR As String = System.Guid.NewGuid.ToString
GR = GR.Replace("-", String.Empty)
If length <= 0 OrElse length > GR.Length Then
Throw New ArgumentException("Length should be between 1 and " & GR.Length)
End If
Return GR.Substring(0, length)
End Function
[/highlight]
Use, (Sim liar to SOAP WSDL API, or Web Services in ASP.net)
GetRandomPasswordUsingGUID1(Legth Of Password)
Example
Button_Click Event
MsgBox(GetRandomPasswordUsingGUID1(25)
[color=DarkOrange]Encrypt Text[/color]
[highlight=vbnet]
Public Function EnDeCrypt(ByVal Text As String) As String
Dim TCr As String = "", i As Integer
For i = 1 To Len(Text)
If Asc(Mid$(Text, i, 1)) < 128 Then
TCr = CType(Asc(Mid$(Text, i, 1)) + 128, String)
ElseIf Asc(Mid$(Text, i, 1)) > 128 Then
TCr = CType(Asc(Mid$(Text, i, 1)) - 128, String)
End If
Mid$(Text, i, 1) = Chr(CType(TCr, Integer))
Next i
Return Text
[/highlight]
To use
MsgBox (EnDecrypt("Word to encrypt")
Example:
Msgbox (Endecrypt("Food")
Will encrypt the word food, you can use this in whole textbox's etc.
[color=DarkOrange]Get List Of Installed Printers on your machine[/color]
Add a Combo-Box to your form
In Namespace
[highlight=vbnet]
Imports System.Drawing
Form Load Event
<<<
@[url=http://www.mpgh.net/forum/members/398149--14-.html]!14![/url] @>>>
Force Application To Require Admin Approval
Show All files in your Solutions Explorer
Navigate to the Bin Folder ----> Debug ----> Applicationname.Vshost.exe.Manifest File
Double Click it and
add this code
<<<@!15!@>>>
Replacing it with the existing code
or
Use the existing code
[highlight=vbnet]
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity version="1.0.0.0" name="MyApplication.app"/>
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
<security>
<requestedPrivileges xmlns="urn:schemas-microsoft-com:asm.v3">
[b]<requestedExecutionLevel level="asInvoker" uiAccess="false"/>[/b]
</requestedPrivileges>
</security>
</trustInfo>
</assembly>
[/highlight]
The information is as follows
[b]requireAdministrator:[/b]
[b]highestAvailable:[/b]
[b]asInvoker:[/b] Vb.net Default
So for this particular case it would be
[highlight=vbnet]
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity version="1.0.0.0" name="MyApplication.app"/>
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
<security>
<requestedPrivileges xmlns="urn:schemas-microsoft-com:asm.v3">
[b]<requestedExecutionLevel level="requireAdministrator:" uiAccess="false"/>[/b]
</requestedPrivileges>
</security>
</trustInfo>
</assembly>
[/highlight]
[color=DarkOrange]Change Background Color of Form with Color Dialog[/color]
Add a Color Dialog Box to your Form
Add a button
on button click Event
[highlight=vbnet]
Dim Bcolor As New ColorDialog()
Bcolor.ShowDialog()
Me.BackColor = Bcolor.Color
[/highlight]
Print a Textbox
* Every where I go , I see all this complex code, and all these Imports
and just ugly code, I think a rumor started along time ago that printing
a single textbox was hard and required system.drawing and ever since
then, everyone just copied and pasted everyone else's code and slightly
modified it and called it as thier own. I am here to break that rumor
Simple Print TextBox 1
[highlight=vbnet]
PrintDocument1.PrinterSettings.Copies = 1
PrintDocument1.Print()
[/highlight]
Then Add this
[highlight=vbnet]
Private Sub PrintDocument1_PrintPage(ByVal sender As System.Object,
ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles
PrintDocument1.PrintPage
e.Graphics.DrawString(TextBox1.Text, TextBox1.Font, Brushes.Blue, 100, 100)
End Sub
[/highlight]
Here is how to Create your own sleep method which will pause what you
want to pause, but still allow the application to function
[highlight=vbnet]
Private Sub Sleep(ByVal PauseTime As Double)
Dim Tind As Int16
For Tind = 1 To PauseTime / 50
Threading.Thread.Sleep(50)
Application.DoEvents()
Next
End Sub
[/highlight]
Note: the Application.DoEvents Will allow your application to function normally during sleep
Now you can call a "proper" Sleep
[highlight=vbnet]
Sleep(time to sleep)
[/highlight]
Changing XML Node Values
[highlight=vbnet]
Dim root As XElement = XElement.Load("Location\Filename.xml")
Dim xt As XElement = (From el In root.Descendants("Node1") _
Select el).First()
xt.SetValue("New Value")
root.Save("Location\Filename.xml")
[/highlight]
You can do this dynamically as well by using the value fields with combo-box data or textbox values, etc.
[size=12]Create A Tab Delimited Text File with listcheckedbox[/size]
I notated everything to help you get the basic understanding, Hope this
works without special encoding. (as far as the .gct is concerned)
Using ChecklistBox
---- Add Two Buttons
---- Add One TextBox
--- Add One CheckedListBox
Button 1 Text should be - Add
Button 2 Text should be - Save as .GCT
Button One Click Event
' This adds the item of textbox1.text to your checkedlistbox
[highlight=vbnet]
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
CheckedListBox1.Items.Add(TextBox1.Text)
End Sub
[/highlight]
Button Two Click Event
' This Calls the sub SaveCheckedlistBox which will save the checked list box of your choice
' The format is SaveCBox(clb)
' CLB = the name of the checkedlistbox you want to save as tab delimited
[highlight=vbnet]
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
SaveCBox(CheckedListBox1)
End Sub
[/highlight]
Now add this code below the above
' This is the part of the sub that saves the checked listbox as a .GCT Text file, with tabbed delimited format
[highlight=vbnet]
Private Sub SaveCBox(ByVal clb As CheckedListBox)
' Declares Save dialog as a new instance of Save File Dialog
Dim SaveDialog As New SaveFileDialog
' Allows us to add extensions, if this is false then extensions would be *.* All Files
SaveDialog.AddExtension = True
' The default extension is set to .GCT (the format you are looking for)
SaveDialog.DefaultExt = ".gct"
' This sets the save as combo-box items
' The Format is "Description|Extension"
SaveDialog.Filter = "GCT Files|*.GCT|All Files|*.*"
SaveDialog.FilterIndex = 0
' Sets the Text on the Title
SaveDialog.Title = "Save List Box as GCT"
' Saves the listcheckedbox as a .gct in tab delimited format.
If SaveDialog.ShowDialog = DialogResult.OK Then
Dim sw As New System****.StreamWriter(SaveDialog.FileName)
For i As Integer = 0 To clb.Items.Count - 1[/color][/font]
[img]data:image/jpeg;base64,/9j/4AAQSkZJRgABAQAAAQABAAD/2wBDAAkGBwgHBgkIBwgKCgkLDRYPDQwMDRsUFRAWIB0iIiAdHx8kKDQsJCYxJx8fLT0tMTU3Ojo6Iys/RD84QzQ5Ojf/2wBDAQoKCg0MDRoPDxo3JR8lNzc3Nzc3Nzc3Nzc3Nzc3Nzc3Nzc3Nzc3Nzc3Nzc3Nzc3Nzc3Nzc3Nzc3Nzc3Nzc3Nzf/wAARCACeAKQDASIAAhEBAxEB/8QAHAAAAgIDAQEAAAAAAAAAAAAAAAcCBgEDBAgF/8QATxAAAQMDAAQGCg0JCAMAAAAAAQACAwQFEQYHITESQVFhc5MTMjVVcYGRobHBFBUWIiM2QnKSlLPR0iUzNERSVGKE8BckJkVTY2SDgsLx/8QAGgEAAgMBAQAAAAAAAAAAAAAAAAMBAgQFBv/EAC8RAAIBAwAIBQQCAwAAAAAAAAABAgMEEQUSEyExMkFxFDNRUmEiI4GRFUKhwfD/2gAMAwEAAhEDEQA/AHihQ2oygCaFDPOjPOgCaFDPOjPOgCaFDPOjPOgCaFDPIjJQBNChlGedAE0KGedGedAE0KG1GccaAJoWvhLOdqAJoUEIAmhYCEARPOlNpfebpT6T3CGnuVXDEx7A1kcpAHwbTu8JKbKTOmvxtunSM+zYt1hFSqNNdDJdtqCwchv9578V/XlYN/vPfiv68r7GitjpLrRB0sIfM6RwBLiNxX33aBQ/JpYvHK5b51aEHhpGSMKkllMo50gvXfiv68qJ0ivXfiv69yuztAhxUlP45Hfeoe4D/iU3WO+9V29t8FtlV+SknSO99+K/r3KDtJb4P85r+vcrudX54qSl6x33qJ1fO4qOk6x6nb2/wTs6vyUY6T33vzX9e5QOlN+H+c1/XuV5Orx5/U6PrHKJ1dSH9To+scjb2/wTs6nyUQ6VX7v1X9e5a3aWX/ivdw69yvZ1byn9TousconVrKf1Ki61yNvb/BKhU+ShHS3SHv5cOvcoHS3SLv5cOvcr8dWb+OipfFKVj+zEnfRw+KVG3t/gnVqfIvzpdpF39uP1hygdL9I+/wBcfrDkw/7L4z21GPFMFWNNNFKOw2yd7YnMqWFowX5xkhTGrRk8JIHrrjk+fZNLdITeaLst6rpIzM0OY+YkOGdxC9CUUjpqWKR2MuGSvMFk7sUXTN9K9OWvufB80LFpCKjKOF0NFBtp5OpCELnmgkEICEARSY02+Nt06Rn2bE50mNNvjddOkZ9mxb9Hea+xkvORFg1cnDIByyyetMlLPV2dtKOWWT1pmpd75pa15DkrbjTUTmtqXlpeCQA0nPkXOy+298jIxOQ57g1uWEZJ3Lg05o/ZFmM7Rl9M4P8A/Hcfv8SXBmLSC0lrhtaeQ8SKFsqsNbIydRxlgdG9B2Bc1uq21tBT1Td0sYdjk5VpvtY2htFVUPdwQ2MgHnOwecrKovOBmd2TU6/25riDM7xMdt8y6bfcaW4xyPpJC8Ru4DvekYOM42+FIir0ipHzvd8K4FxxhvFxcacehNC6jsUJkBD5vhHA8/8AQWu5tVRim+LF06mu2j7+ELKMrGNMIWcrGQgAKUeuN3wFa3ni9ATbyEntcjv04fxQ+gLVZ+aIuOVC3sndmhH+830r09a+58HzQvMFjP5Zoemb6V6gtnc+D5oT9I88exFvwZ0oQhc40EghAQgCKTGmvxtuvSM+zYnOkvpt8brr0jPs2Lfo7zX2Ml7yI+7q7/OUnSS+tM5LDV3+dpOkl9aZ6Xe+aWteQ1VULKinkhk7SRpafAUkblmgqKiCpdwTA9zHk7thxlPIpKa7KGWlu1NUx5FPVtJdj9tuPVhN0dL7uo+pavujrehddVd6jutjmhYTmknLQDv4JGQfSuXXDdTR2FlMx3v5nZI8w9PmVJ1MXM0WkklFISI62LAB/bbtHmys626819/9jsJMcOGjxb/OXeQJ6tcXuOnEW632cle0MtbrvfqOnLcs7IHSD+EbV6JfXUlGWwSzMY5rR707wEstTlqDX1NxkbuAjYfOfUvraayuju5w4j3jNxPIVF59+41PQKX0U8l19uKD96Z5D9yx7b0Gf0yIfOOB50q4n1M7+BB2WR+M8FhJOFrrKiooRwqszQA7AZOE0FJ8FHONbeX2z44HC2ZsjA6N7XNO4tOQomXCTlv0wFuqGyw1rTg5cw5w8cYP3pqsqY6qmiqITmOVge08xGxKq20qTxIlVdZZR2eyAlFridmWtHF8CfMEzTJtSs1wO/vVYP4ID5ky3hq1BVSWY/koFi7tUPTt9K9RWzufB80Ly5Yu7VD07fSvUds7nwfNCtpHmj2G0ODOlCELnDyQQgIQBFJfTb43XTpGfZsToSW03+N116Rn2bFv0d5r7GS85Efd1dfnKTpJPWmelhq57em6ST1pnEql75pa15AcdipmtK0i6aKyvAzJSPEzeXA2O8xVvc5aKhjJopIpGhzHtLXA8h2JFKThNSXQdNKUWjzrZxLQXGmrINktPKHt8IXbdWOrLjPPIc5O/wDrxr6M9t9hVc1NKQHQvLDk4zjj8i6rXQNq6+ngbh3DkGcbcAbT6POvSSqQxteuDlfVnUGHoVQe19hpoyMPe3hv8J2qrayayOjujnyuwOxswOM7Cr/BhrWtG4DYk/rpcfdFFg7OwM9a5NonO4Weptm9WmdurG8sqNKZXVL44oGUzuDwiN5I41cNY10tMmjNVA+WGVz8cHg4PBI27+VImhZXSSOFvZUukDcuEAcTjxLZW01ybh1wirGgbAZ2OGPAXLfUsoSrqetjhuFRrNQxg10NPUXCrhpKdpfNKeCB6T4AvRNupjRWikpXHJiiazyBJ/QrSWDR6cF9sjkY7AkfveRyg+rcnOyqguFHFWUsgfBMwPY4cYP9eZI0hObqJSWF0LUlHVeGaC7aljrgd/fqpv8AswHzJmO3pYa4Ti51I4vY8HoSKXOuzIlw/JRrD3aoenZ6V6jtnc+D5oXluw92qHp2elepLZ3Pg+aFTSXPHsaaPA6UIQucOJBCAhAEUldN/jddekZ9mxOpJXTc/wCLrr0jPs2Lfo7zX2Ml5yI+9q430/Sv9aZbnJaatj72HpnetMdzlF4s1SbZ/QYcVrc5Zc5aXOWdIa2c9RS00zuHNBE93K5oJWllJTQv4cMETHcrW4K6HuWpxTkhTZuiO1KbW/F2XSOPmhj9BTVjd75LnWNEKi/5G0tijyPEVqs1i4TFVX9tnBqcpwzSmUkbDSvG0fxNTdvcFC+1VLK+Jj4HRkOaRtds3Dn5El7c2ooZTLTZbIRjhYOcL6UtbXTMImmIGNrjnPlKddWc61baJopTuoxhqtFZNu7FKYwc8DYSOUb0ztXvDbo46J/axzvDPAcE+fKqVFQvq5BHSt7I4nGRuHOSmJaqJtstsdK05IGXHlJ2n1ovasZKMFvZFCL3y6Gx+9KvXCfyzUD/AIsGxNN20pV64Qfb2oIBwKOAk43LPR512f8AoZLh+SlWLuzQ9Oz0r1JbO58HzQvLdiH5ZoOnZ6V6ktnc+D5oVdJc8expo8DpQhC5o4kEICEARST04+N916Rn2bE7EktOT/jC69Iz7Ni36O819jJd8iLBq17SPmnPrTEc4cqUeiN9orTRkz1DWTCUuDTjZtO8EjlVhk1i0o3VdN1Of/dMuKM5VMpFKVRRjhl1c8cq1OcqPJrJgG6qpD/Ln8a536yQe0noz/Kn8aWrep6FnVi+pe3FayVQnaxqk9oaI/yjvxrWdYVyPastx8NK78aYqNT0FupD1L+HYPF5Voq6CgrnNdWUsUr2jAc5oJxyZVG93t7d2kNrPhpXfjWRp1pDxU9q+rO/GpdvUfQr4imupc22Oyd7qf6AWRZbM05bb4AeZoVL93OknFT2j6s78ayNNtJzup7R9Xd+NV8NU/5k+Kp+v+C/MEEIxDE1oHIoPfn/AOqjDTLSh2wU9mHhp3/jU26VaVv3U9l+rv8Axqytqi6ESuaXuLnnnCqGk0TJ9MKtkrA9hoIAWkZBHvkN0l0tJ2U9k6h/41zRyXKsus9xu7aZs0kLIgKYENw0niJPLyptKjOM8tGe4uKcqbUXvK1VaL+wrtS1tCSadszXSRnfGM7xyhPi1nNvgIIILBtS1c7C+nY9IZLY4QzcKSkPyeNng+5ReUJVcSj0Isr7H0VP2MFC00tTDVwtmp5GyRuGxwW5cfGDtJ53kghAQgkjxJKadwTjS25vFPOWvewtc2JxBHY2DYccydnBXHVWmjqpOyTRNc7lKfb13RlrJCqtNVFg89PgqDupajqXfcueSlqjupKnqXfcvQ/tBbv3dqPaC3fu7Vs/kpe0V4WK6nnF9DWE7KOo6p33LLKGsB20k4/6yvRhsVux+jtXHUWahbnELR4kLSMn/UrK2SXEREdFUjaaabqyuqKlmG+GT6JTbqLVStziEL5lRb6cZxGE+Ny5dDHUppFDigeMcJjh4QuoRkDaF9+elYzPBbhcTotu4rRGWTDU3M+f2PmW2ONbzGc9qfIptDWdsccysKcscTMUXMutjA0bSAufsh+SMDzrBcTv2+FXUPUzyqLodRlY3lPgC0SVTvkgDwrS5+Bv865pJOdXUUU1mbZaqT9o+JcM07j8snxqEsvOuKWXepSRZJn27DpNWWOpDonmSBx+Ehcdh8HOm1Y7xSXuhZVUT8tO9p3tPIlHo5oxVXmdpexzYuMEY8vJ4N6blktMFopRDBvPbHG9ca/lRcsR5j0OjoVoxzLlPpjchYG5C5p0ySEIQAIQhAESMrTJTsfvz4luKwgGsnDJbIX7y/yrnksFLJsc+XxOK+shWU5LqV1Ivij4EmilC/e+f6ZWk6F247eyVA/7CrKhWVWa6ldjT9qKwdCbb/qVHWFA0HtgOeHP1is6Ebap7mRsaftX6KyNCrcN0k/01n3F27/Un+mrKhTtqnuZGwpe1forXuLtvG+b6SqendmpbKykNMXnspdwuEc7sfemiqHrRppqr2tjp25cXP28Q3LRaVpbZa0txmvKENi9WO/sLZznSP4EbS553AcauGiehktW5tTWghg25J9HKefyL7eiehcdOxtTXty4jPBO8+HkHMryxrWNDWNw0bABuCddX7lmNPh6ibTR6jiVTj6GmjpIKKEQ08Yawedb0IXMOqSCEBCAMoQhAAhCEARKwpYRhAEUKWEYQBFClhGEARQpYRhAEUKWEYQBFQkiZIWmRgcWnIyM4W3CMIAihSwjCAIoUsIwgAAQsoQB/9k=[/img][font=Times New Roman][color=DarkOliveGreen]Dim t As Boolean = clb.GetItemChecked(i)
sw.WriteLine(clb.Items(i).ToString & ControlChars.Tab & t.ToString)
Next
sw.Close()
End If
SaveDialog.Dispose()
End Sub
[/highlight][/color][/font]
-------------------------
CREDITS BY:
PuBlic Hacks
+
Umbrella Corporation
-------------------------
