Thread: Snippets Vault

Page 1 of 8 123 ... LastLast
Results 1 to 15 of 113
  1. #1
    NextGen1's Avatar
    Join Date
    Dec 2009
    Gender
    male
    Location
    Not sure really.
    Posts
    6,312
    Reputation
    382
    Thanks
    3,019
    My Mood
    Amazed

    Snippets Vault

    https://www.mpgh.net/forum/160-tools/...l-release.html

    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:

    • 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.

    My Snippets (gathered from my tutorials)

    - Note: Some code snippets are MSDN standard.

    Just another collection of code snippets from me to you.
    (also check out my UI Snippets)

    Use this as a "Quick Reference Guide" when you need to remember "how to it"

    VB.net Code Snippets Reference

    Move a File

    [highlight=vbnet]
    My.Computer.FileSystem.CopyFile("FileLocaion", "FileDestination")
    [/highlight]

    Save Window Size Settings

    [highlight=vbnet]
    If Me.WindowState = FormWindowState.Normal Then
    My.Settings.WindowSize = Me.Size
    End If
    [/highlight]

    Save Windows Location

    [highlight=vbnet]
    If Me.WindowState = FormWindowState.Normal Then
    My.Settings.WindowLocation = Me.Location
    End If
    [/highlight]

    Loads a windows previous size from settings

    [highlight=vbnet]
    If Not My.Settings.WindowSize.Width = 0 Then
    Me.Size = My.Settings.WindowSize
    End If
    [/highlight]

    Loads Previous Locations From Settings

    [highlight=vbnet]
    If Not My.Settings.WindowLocation.X = 0 Then
    Me.Location = My.Settings.WindowLocation
    End If
    [/highlight]

    Auto Update Previous Version Settings

    [highlight=vbnet]
    If My.Settings.CallUpgrade = True Then
    My.Settings.Upgrade()
    My.Settings.CallUpgrade = False
    End If
    [/highlight]


    Minimize to tray

    Form Load (Set Icon)
    [highlight=vbnet]
    Me.NotifyIcon1.Icon = Me.Icon
    [/highlight]


    Form Load, Set it true

    [highlight=vbnet]
    Me.NotifyIcon1.Visible = true
    [/highlight]


    VB Syntax for Minimizing to System Tray

    [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]


    Show Balloon Tip
    (use on minimize, but can be adjusted for anything

    [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]

    Save Checkbox Settings

    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

    Get and Save Settings

    Get Setting:

    [highlight=vbnet]
    MySettingValue = My.Settings.Default.SettingName
    [/highlight]

    [highlight=vbnet]
    My.Settings.Default.SettingName = ConnString
    My.Settings.Save()
    [/highlight]

    Send Input to Send Mouse Clicks

    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]

    Get Windows Title

    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]

    Play Wav File

    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]

    A Collection Of UI Code Snippets to enhance your users interface.

    Check Mouse Click

    [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]

    Disable (X) On form
    (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]

    Fade Out

    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]

    Make form transparent while dragging
    (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]

    Windows Shadow - (Tested in Xp)

    [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"]Snippets Part 3
    I will Be adding more as I write them

    Empty Recycling Bin

    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]


    Add a Windows User

    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]

    Get Hardware Serial

    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]

    Clear All Controls in a Form (MSDN Standard CODE)

    [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]

    Read File Content

    [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")

    Get File Extension

    [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")

    Prevent Pasting in a Textbox with Ctrl + V

    [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]

    Random Password String From GUID

    [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)

    Encrypt Text

    [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.

    Get List Of Installed Printers on your machine

    Add a Combo-Box to your form

    In Namespace

    [highlight=vbnet]
    Imports System.Drawing

    Form Load Event

    <<<@!14!@>>>

    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">
    <requestedExecutionLevel level="asInvoker" uiAccess="false"/>
    </requestedPrivileges>
    </security>
    </trustInfo>
    </assembly>
    [/highlight]

    The information is as follows

    requireAdministrator:
    highestAvailable:
    asInvoker: 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">
    <requestedExecutionLevel level="requireAdministrator:" uiAccess="false"/>
    </requestedPrivileges>
    </security>
    </trustInfo>
    </assembly>
    [/highlight]

    Change Background Color of Form with Color Dialog

    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.


    Create A Tab Delimited Text File with listcheckedbox

    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
    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]

    Run Application from Resources

    Name Space
    [highlight=vbnet]
    Imports System****
    [/highlight]

    Now this in a button click (or whet ever triggers the event)

    [highlight=vbnet]
    Dim RPath As String = Application.StartupPath & "\File.exe" 'File.exe will be a temp name given to your exe, you can make it anything you want, or keep it as is.

    ' Will create the file with the given name
    Using CreateFile As New FileStream(RPath, FileMode.Create)
    CreateFile.Write(My.Resources.YourResource, 0, My.Resources.YourResource.Length)
    End Using
    ' Start the application
    Process.Start(RPath)
    [/highlight]

    Note: "Your Resource" in my code example above needs to be the EXE name without the exe extension, so for example, if you add notepad.exe as a resource, then the code would be

    [highlight=vbnet]
    Dim RPath As String = Application.StartupPath & "\File.exe"

    Using CreateFile As New FileStream(RPath, FileMode.Create)
    CreateFile.Write(My.Resources.Notepad, 0, My.Resources.Notepad.Length)
    End Using

    Process.Start(RPath)
    [/highlight]


    Opening and saving .txt files
    https://www.mpgh.net/forum/33-visual-...-text-tut.html


    Using SAPI/Making your computer "Speak":
    https://www.mpgh.net/forum/33-visual-...uter-talk.html


    Last edited by NextGen1; 02-03-2011 at 01:00 PM. Reason: Organizing, Fixing mistakes In <<<<@>>>>, blocked for some reason


     


     


     



    The Most complete application MPGH will ever offer - 68%




  2. The Following 34 Users Say Thank You to NextGen1 For This Useful Post:

    ♪~ ᕕ(ᐛ)ᕗ (08-01-2010),aidandabest09 (11-24-2010),Ali (06-23-2010),AndrewxXx (09-20-2011),biohazardzz (06-29-2011),Blubb1337 (03-04-2010),cgallagher21 (09-06-2010),chikencow (02-11-2011),FlashDrive (03-04-2010),FUKO (10-21-2011),gunman353 (09-08-2012),hopefordope (05-03-2010),Katie_Perry (07-27-2010),Lolland (03-04-2010),matjuh123 (04-24-2010),MJLover (03-05-2010),mnpeepno2 (03-05-2010),nathanael890 (04-05-2010),nepito (03-13-2010),Nitehawk772 Bkup (10-10-2011),Opim10 (06-18-2013),poneboy00 (03-07-2010),Renamon Toast Crunch (06-10-2013),samerlol (06-28-2013),Sketchy (05-04-2011),skiiiz (03-13-2010),Sneakzy (05-09-2010),tempta43 (04-15-2010),Tony Stark` (02-09-2011),why06 (03-20-2010),zJester (09-03-2014),zmansquared (03-07-2010),Zoee (04-01-2014),Zoom (03-07-2010)

  3. #2
    NextGen1's Avatar
    Join Date
    Dec 2009
    Gender
    male
    Location
    Not sure really.
    Posts
    6,312
    Reputation
    382
    Thanks
    3,019
    My Mood
    Amazed

    Visual Basic Code Snippers [Shell Commands]

    Visual Basic .Net RunDll32 Commands


    Display the BlueScreen Of Death

    [highlight=vbnet]Shell ("rundll32 user,disableoemlayer")[/highlight]

    'Open Control Panel

    [highlight=vbnet]Shell("rundll32.exe shell32.dll Control_RunDLL")[/highlight]

    'Add Or Remove Programs

    [highlight=vbnet]Shell("rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,1")[/highlight]

    'Turn Off Computer

    [highlight=vbnet]Shell ("Rundll32.exe user32.dll,LockWorkStation")[/highlight]

    'Load Mouse Properties

    [highlight=vbnet]Shell ("Rundll32.exe shell32.dll,Control_RunDLL main.cpl @0")[/highlight]

    'Keyboard Properties

    [highlight=vbnet]Shell("Rundll32.exe shell32.dll,Control_RunDLL main.cpl @1")
    [/highlight]
    'Printer Properties

    [highlight=vbnet]Shell( "Rundll32.exe shell32.dll,Control_RunDLL main.cpl @2")[/highlight]

    'Fonts Folder

    [highlight=vbnet]Shell ("Rundll32.exe shell32.dll,Control_RunDLL main.cpl @3")[/highlight]

    'Internet Properties

    [highlight=vbnet]Shell ("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl,,5")[/highlight]

    'Keyboard Accessibility

    [highlight=vbnet]Shell ("rundll32.exe shell32.dll,Control_RunDLL access.cpl,,1")[/highlight]

    'Sound / Accessibility

    [highlight=vbnet]Shell("rundll32.exe shell32.dll,Control_RunDLL access.cpl,,2")[/highlight]

    Display Accessibility

    [highlight=vbnet]Shell ("rundll32.exe shell32.dll,Control_RunDLL access.cpl,,3")[/highlight]

    'Display Settings

    [highlight=vbnet]Shell ("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,0")[/highlight]

    Screen Saver

    [highlight=vbnet]Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,1")[/highlight]

    Internet Security

    [highlight=vbnet]Shell ("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl,,1")[/highlight]

    Display Properties Window

    [highlight=vbnet]Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl")[/highlight]

    Networking

    [highlight=vbnet]Shell ("rundll32.exe shell32.dll,Control_RunDLL netcpl.cpl")[/highlight]

    System Properties

    [highlight=vbnet]Shell ("rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl")[/highlight]

    Lock the Keyboard

    [highlight=vbnet]Shell ("rundll32.exe keyboard,disable")[/highlight]

    Disable the Mouse

    [highlight=vbnet]Shell ("rundll32.exe mouse,disable")[/highlight]

    Swap Mouse Buttons (left = right and vice Versa )

    [highlight=vbnet]Shell ("rundll32.exe user.dll,swapmousebutton")[/highlight]

    Shut Down Computer

    [highlight=vbnet]Shell ("rundll32.exe shell32.exe,SHExitWindowsEx 1")[/highlight]

    Log Off

    [highlight=vbnet]Shell ("rundll32.exe shell32.exe,SHExitWindowsEx 0")[/highlight]
    Last edited by NextGen1; 02-03-2011 at 01:02 PM.


     


     


     



    The Most complete application MPGH will ever offer - 68%




  4. The Following 18 Users Say Thank You to NextGen1 For This Useful Post:

    ♪~ ᕕ(ᐛ)ᕗ (08-01-2010),AndrewxXx (09-20-2011),biohazardzz (06-29-2011),Blubb1337 (03-12-2010),cgallagher21 (09-06-2010),deadskulzz (04-17-2011),Decreased (08-05-2010),hopefordope (05-03-2010),icebolt900 (11-19-2014),Katie_Perry (07-27-2010),MJLover (03-12-2010),mr farouk (02-01-2012),Ninja® (09-12-2011),Sketchy (04-28-2011),tempta43 (04-15-2010),tinnetju (05-26-2014),Tony Stark` (02-17-2011),why06 (03-20-2010)

  5. #3
    NextGen1's Avatar
    Join Date
    Dec 2009
    Gender
    male
    Location
    Not sure really.
    Posts
    6,312
    Reputation
    382
    Thanks
    3,019
    My Mood
    Amazed

    Post

    Multi Key [Example Ctrl + P]

    If you want to make a Ctrl+P Do something then..

    In KeyUp Sub of your form

    [highlight=vbnet]
    If e.Control = True And e.KeyCode = Keys.P Then
    Msgbox ("You pressed Ctrl + P") ' Anything you want here
    End If
    [/highlight]

    Connect to a Access Database
    'This one has been asked alot today

    NameSpace

    [highlight=vbnet]
    imports system.data.oledb
    [/highlight]

    [highlight=vbnet]
    Dim conn As New OleDbConnection
    conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data SourceDataDirectory|Data.mdb;Persist Security Info=True"
    conn.Open()
    ' conn.Close() 'Closes database
    'Which you can do immediately,
    [/highlight]

    This method can be applied to numerous database types, The connection string will have to be modified.

    SQL Server

    [highlight=vbnet]
    Data Source=myServerAddress;Initial Catalog=myDataBase;User Id=myUsername;Password=myPassword;
    [/highlight]

    Oracle Database

    [highlight=vbnet]
    Data Source=TORCL;User Id=myUsername;Password=myPassword;
    [/highlight]

    Excel

    [highlight=vbnet]
    Provider=Microsoft.ACE.OLEDB.12.0;Data Source=c:\myFolder\myExcel2007file.xlsx;Extended Properties="Excel 12.0 Xml;HDR=YES";
    [/highlight]

    Access

    [highlight=vbnet]
    Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\mydatabase.mdb;User Id=admin;Password=;
    [/highlight]

    Text File

    [highlight=vbnet]
    Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\txtFilesFolder\;Extended Properties="text;HDR=Yes;FMT=Delimited";
    [/highlight]

    Check List Box For Item

    [highlight=vbnet]
    Public Function inList(list As listbox, item As String) as Boolean
    Dim i As Long

    For i = 0 To list.ListCount - 1
    If (list.ItemData(i) = item) Then
    inlist = True
    Exit Function
    End If
    Next i

    inlist = False
    End Function
    [/highlight]

    to user it

    [highlight=vbnet]
    inlist(listbox , text to look for)
    [/highlight]


    Random Alphanumeric String

    [highlight=vbnet]
    Public Function RS(ByVal intLength As Integer, Optional ByVal strAllowedCharacters As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVW XYZ0123456789")
    Randomize()
    Dim chrC() As Char = strAllowedCharacters.ToCharArray
    Dim strR As New StringBuilder
    Dim grtR As New Random
    Do Until Len(strR.ToString) = intLength
    Dim x As Integer = Rnd() * (chrC.Length - 1)
    strR.Append(chrC(CInt(x)))
    Loop
    Return strR.ToString
    End Function
    [/highlight]

    You will need to imports system.text and system.drawing

    To use the code it is

    rs(number of characters to generate)

    Example:

    [highlight=vbnet]
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    TextBox1.Text = RS(20)

    End Sub

    Public Function RS(ByVal intLength As Integer, Optional ByVal strAllowedCharacters As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVW XYZ0123456789")
    Randomize()
    Dim chrC() As Char = strAllowedCharacters.ToCharArray
    Dim strR As New StringBuilder
    Dim grtR As New Random
    Do Until Len(strR.ToString) = intLength
    Dim x As Integer = Rnd() * (chrC.Length - 1)
    strR.Append(chrC(CInt(x)))
    Loop
    Return strR.ToString
    End Function
    [/highlight]

    Activate a Running Process By Name

    [highlight=vbnet]
    AppActivate("Untitled - Notepad")
    [/highlight]

    Activate Running Process by id

    [highlight=vbnet]
    Dim processID As Integer

    processID = Shell("NOTEPAD.EXE", AppWinStyle.NormalFocus)

    AppActivate(processID)
    [/highlight]

    SendKeys To application

    [highlight=vbnet]
    SendKeys.SendWait("{ENTER}")
    [/highlight]

    Write to application log file.

    [highlight=vbnet]
    My.Application.Log.WriteEntry("Entry Here")
    [/highlight]

    Define a Structure

    [highlight=vbnet]
    Structure MyStructure
    Public ValueOne As Integer
    Public ValueTwo As Boolean
    End Structure
    [/highlight]

    Sound

    Loop a Sound

    [highlight=vbnet]
    My.Computer.Audio.Play("SoundFile.wav", AudioPlayMode.BackgroundLoop)
    [/highlight]

    Play Sound

    [highlight=vbnet]
    My.Computer.Audio.Play("ringout.wav", AudioPlayMode.WaitToComplete)
    [/highlight]

    Stop Playing Sound

    [highlight=vbnet]
    My.Computer.Audio.Stop()

    [/highlight]



    Last edited by NextGen1; 02-03-2011 at 01:05 PM.


     


     


     



    The Most complete application MPGH will ever offer - 68%




  6. The Following 12 Users Say Thank You to NextGen1 For This Useful Post:

    ♪~ ᕕ(ᐛ)ᕗ (08-01-2010),biohazardzz (06-29-2011),cgallagher21 (09-06-2010),House (11-30-2010),Katie_Perry (07-27-2010),Ninja® (09-12-2011),noob555 (04-12-2010),Sketchy (05-04-2011),tempta43 (04-15-2010),Tony Stark` (02-17-2011),why06 (03-20-2010),williamph (11-16-2010)

  7. #4
    NextGen1's Avatar
    Join Date
    Dec 2009
    Gender
    male
    Location
    Not sure really.
    Posts
    6,312
    Reputation
    382
    Thanks
    3,019
    My Mood
    Amazed
    As requested, XML

    Imports

    [highlight=vbnet]
    Imports System.Xml
    Imports System.Xml.Schema
    Imports System.Xml.XPath
    [/highlight]


    Query in XML

    [highlight=vbnet]
    Dim y = <Root>
    <%= From i In "abc" _
    Where i = "b" _
    Select <Result>
    <%= i %>
    </Result> _
    %>
    </Root>
    [/highlight]


    Create Schema for XMl

    [highlight=vbnet]

    Dim infer = New XmlSchemaInference()
    Dim sc = New XmlSchemaSet()
    sc = infer.InferSchema(New XmlTextReader("sample.xml"))

    Dim w = XmlWriter.Create(New StreamWriter("sampleSchema.xsd"))
    For Each schemafile In sc.Schemas()
    schemafile.Write(w)
    Next
    [/highlight]


    _________________

    Resize a button dynamically based on text

    [highlight=vbnet]
    ' Use a Graphics object to measure the button's text. Then add blanks to leave space on either side.
    Dim surface As Graphics = Button1.CreateGraphics
    Dim textSize As SizeF = surface.MeasureString(" " & Button1.Text & " ", Button1.Font)
    surface.Dispose()
    Button1.Width = CInt(textSize.Width)
    [/highlight]

    Create a Pen

    [highlight=vbnet]
    Dim myPen As System.Drawing.Pen
    myPen = New System.Drawing.Pen(Color.Black)
    [/highlight]

    Display a animated Gif

    [highlight=vbnet]
    PictureBox1.Image() = Image.FromFile("gifname.gif")
    [/highlight]

    _______________

    Convert Mouse Coordinates to screen coordinates

    [highlight=vbnet]
    Private Sub Me_MouseDown(ByVal sender As Object, _
    ByVal e As System.Windows.Forms.MouseEventArgs) _
    Handles Me.MouseDown
    Dim screenPoint As Point
    screenPoint = Me.PointToScreen(New Point(e.X, e.Y))
    End Sub
    [/highlight]

    Create a Transparent form

    [highlight=vbnet]
    frmTransparentForm.Opacity = 0.90
    [/highlight]

    Determine modifier key pressed

    [highlight=vbnet]
    Private Sub Me_KeyPress(ByVal sender As Object, _
    ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles Me.KeyPress

    If (Control.ModifierKeys And Keys.Shift) = Keys.Shift Then

    End If

    End Sub
    [/highlight]

    Remove Title Bar

    [highlight=vbnet]
    Me.FormBorderStyle = Windows.Forms.FormBorderStyle.None
    [/highlight]


    Create Email Message

    [highlight=vbnet]
    Dim message As New MailMessage("sender@address", "from@address", "Subject", "Message Text")
    Dim emailClient As New SmtpClient("Email Server Name")
    emailClient.Send(message)
    [/highlight]

    Use Serial Port To Dial A Number

    [highlight=vbnet]

    Using comPort As SerialPort = My.Computer.Ports.OpenSerialPort("COM1", 2400)
    comPort.DtrEnable = True
    comPort.Write("555-555-5455" & vbCrLf)


    End Using
    [/highlight]


    ____________


    Search Files for an expression

    [highlight=vbnet]
    Dim files As ReadOnlyCollection(Of String)
    files = My.Computer.FileSystem.FindInFiles("C:\", "what you are looking for goes in here IE Food", True, FileIO.SearchOption.SearchAllSubDirectories, "*.txt")
    [/highlight]

    _________________________________

    A more advanced basic spammer

    Add 2 Text boxes and one button

    Name Space
    - I notated everything

    [highlight=vbnet]
    'Used to import COM and Invoke services , needed for DLL Import
    Imports System****ntime.InteropServices
    [/highlight]

    Functions (just below public call formname

    [highlight=vbnet]
    ' This function will allow us to get a window and find it, by window name
    ' You can use this anytime you need to find a window by window name for any reason
    <DllImport("USER32.DLL", CharSet:=CharSet.Unicode)> _
    Public Shared Function WindowName(ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
    End Function
    [/highlight]

    and below that

    [highlight=vbnet]
    ' This function will allow us set the foreground window
    ' This will bring the window we need to send the keystrokes to upfront
    <DllImport("USER32.DLL")> _
    Public Shared Function UpFront(ByVal hWnd As IntPtr) As Boolean
    End Function
    [/highlight]

    On the button click event

    [highlight=vbnet]
    ' when you use try, it litterly means "attempt the following code before catch, if the "code is unseccesful"
    ' then catch the exception and display it in a message box , you can use list boxes for storing errors in a database
    ' but that is a little more advaced
    Try
    ' (apph = name I have chosen for the declaration, you can choose any thing you wish)
    ' Declaring AppH as IntPtr which is used represent a pointer or a handle, in this case we are setting = to windowname
    ' which is a function I created above to set the window to sendkeys to, the format is
    ' (ByVal lpClassName As String, ByVal lpWindowName As String)
    ' I Use Nothing as the IPclassname, if you know the IPclassname you can use it.
    ' In textbox1 you can add the name of the window to check for
    'lets use notepad, the name of a unnamed notepad is Unitled - Notepad
    ' so if you were to open notepad without a given name, and put Unitled - Notepad in textbox1
    'this would continue and function, if not you will get an error
    Dim AppH As IntPtr = WindowName(Nothing, TextBox1.Text)
    'IntPtr is a set value so if the value is 0 [window name is wrong or not a open application, error])
    If AppH = IntPtr.Zero Then
    MsgBox("Chosen Application is not Running")
    Return
    End If
    ' If successful bring the window to the foreground
    UpFront(AppH)
    'sendkeys the content of textbox2
    SendKeys.SendWait(TextBox2.Text)
    Catch ex As Exception
    MsgBox(ex.Message)
    End Try
    [/highlight]


    Last edited by NextGen1; 02-03-2011 at 01:06 PM.


     


     


     



    The Most complete application MPGH will ever offer - 68%




  8. The Following 15 Users Say Thank You to NextGen1 For This Useful Post:

    .:Kikko:. (08-02-2011),biohazardzz (06-29-2011),cgallagher21 (09-06-2010),Katie_Perry (07-27-2010),mexicano007 (04-24-2010),Ninja® (09-12-2011),noob555 (04-12-2010),Sketchy (05-04-2011),tempta43 (04-15-2010),Tony Stark` (02-17-2011),War3Cadu (09-15-2010),why06 (03-20-2010),williamph (11-16-2010),Zoom (03-20-2010),[color=red]FHB[/color] (09-25-2010)

  9. #5
    Hassan's Avatar
    Join Date
    May 2010
    Gender
    male
    Location
    System.Threading.Tasks
    Posts
    4,764
    Reputation
    495
    Thanks
    2,132
    My Mood
    Dead
    Extracting specific piece of string between brackets:

    Suppose this is the string:

    "[Hello][Bye]CakeBuster[Dead]"

    The following function will extract 'CakeBuster' from the above string.

    [highlight=vbnet]Dim Source As String = "[Hello][Bye]CakeBuster[Dead]"
    Dim _1 As Integer = Source.LastIndexOf("[")
    Dim Ex1 As String = Mid(Source, 1, _1)
    Dim _2 As Integer = Ex1.LastIndexOf("]") + 2
    Dim FinalExtraction As String = Mid(Ex1, _2)[/highlight]

    A little explanation:

    Dim _1 As Integer = Source.LastIndexOf("[")

    This line gets the index (number) for last "[".

    Dim Ex1 As String = Mid(Source, 1, _1)

    This will store the string up to last "[" but not after that.

    Dim _2 As Integer = Ex1.LastIndexOf("]") + 2

    Similarly this will get the last index of "]" in the new string which is Ex1 now !!

    Dim FinalExtraction As String = Mid(Ex1, _2)

    Finally, extract the word you need by starting the string from "]".

    Here is a string manipulation library from CodeProject:

    Just create a new module named 'StringFunctions' and paste the following code in it:

    [highlight=vbnet]Imports System.Text

    Module StringFunctions
    'Retrieves the path part of a full filename
    'C:\Folder\file.exe -> C:\Folder\
    Public Function GetPath(ByVal Full As String) As String
    For i As Integer = Full.Length - 1 To 0 Step -1
    If Full.Substring(i, 1) = "\" OrElse Full.Substring(i, 1) = "/" Then 'Find the rightmost \ or /, which should be cut off the file part
    Return Full.Substring(0, i) & "\"
    End If
    Next
    Return ""
    End Function

    'Retrieves the name of the file from a filename
    'C:\Folder\file.exe - > file
    'OR
    'file.exe -> file
    Public Function GetName(ByVal Full As String) As String
    Dim Start As Integer = GetPath(Full).Length 'If it's has path it gets how long it only the path is
    Return RemoveExtension(Full.Substring(Start)) 'take of the path and the extension
    End Function

    'Retrieves the extension of the file from a filename
    'C:\Folder\file.exe - > exe
    'OR
    'file.exe -> exe
    Public Function GetExtension(ByVal Full As String) As String
    Dim Index As Integer
    For i As Integer = Full.Length - 1 To 0 Step -1
    Index = Full.IndexOf(".", i) 'Find the right most . (a different technique than GetPath)
    If Index > -1 Then
    Return Full.Substring(Index)
    End If
    Next
    Return ""
    End Function

    'Removes extension from a filename
    'C:\Folder\file.exe - > C:\Folder\file
    'OR
    'file.exe -> file
    Public Function RemoveExtension(ByVal Full As String) As String
    Dim Last As Integer = Full.Length - GetExtension(Full).Length
    Return Full.Substring(0, Last)
    End Function

    'Removes path from a filename
    'C:\Folder\file.exe - > file.exe
    Public Function GetFullName(ByVal Full As String) As String
    Return Full.Substring(GetPath(Full).Length) 'Cut off everything up to the path
    End Function

    'Capitalizes a word or sentence
    'word -> Word
    'OR
    'this is a sentence -> This is a sentence
    Public Function Capitalize(ByVal [String] As String) As String
    If [String].Length = 1 Then Return [String].ToUpper 'one letter just return it capitalized
    Return [String].Substring(0, 1).ToUpper & [String].Substring(1) 'cut the first letter and capitalize it and then add the rest
    End Function

    'checks whether a word or sentence is capitalized
    'Word -> True
    'OR
    'This is a sentence -> True
    Public Function IsCapitalized(ByVal [String] As String) As Boolean
    Return AscW([String].Substring(0, 1)) = AscW([String].Substring(0, 1).ToUpper) 'compare the ascii value of the first letter and a capitalized first letter
    End Function

    'checks whether a word or char is in lower case
    'word -> True
    'Word -> False
    Public Function IsLower(ByVal [String] As String) As Boolean
    For i As Integer = 0 To [String].Length - 1
    If Not AscW([String].Substring(i, 1)) = AscW([String].Substring(i, 1).ToLower) Then Return False 'compare the asc values
    Next
    Return True
    End Function

    'checks whether a word or char is in upper case
    'word -> False
    'Word -> False
    'WORD -> True
    Public Function IsUpper(ByVal [String] As String) As Boolean
    For i As Integer = 0 To [String].Length - 1
    If Not AscW([String].Substring(i, 1)) = AscW([String].Substring(i, 1).ToUpper) Then Return False 'compare asc values
    Next
    Return True
    End Function

    'swaps the cases in a word
    'word -> WORD
    'Word -> wORD
    'WoRd -> wOrD
    Public Function SwapCases(ByVal [String] As String) As String
    Dim ret As New StringBuilder 'StringBuilder used to be faster on bigger strings
    For i As Integer = 0 To [String].Length - 1
    If IsUpper([String].Substring(i, 1)) Then 'check whether it's a capital letter or not and make it the opposite
    ret.Append([String].Substring(i, 1).ToLower)
    Else
    ret.Append([String].Substring(i, 1).ToUpper)
    End If
    Next
    Return ret.ToString 'Take of ".ToString" if you prefer it in StringBuilder form (and change the function to StringBuilder also)
    End Function

    'Alternates cases between letters of a string, first letter's case stays the same
    'Hi -> Hi
    'longstring -> lOnGsTrInG
    Public Function AlternateCases(ByVal [String] As String) As String
    If [String].Length = 1 Then Return [String] 'Can't alternate if only one letter
    Dim Upper As Boolean = Not IsUpper([String].Substring(0, 1)) 'start alternation depending on the first letter's case
    Dim ret As New StringBuilder([String].Substring(0, 1))
    For i As Integer = 1 To [String].Length - 1
    If Upper Then
    ret.Append([String].Substring(i, 1).ToUpper)
    Else
    ret.Append([String].Substring(i, 1).ToLower)
    End If
    Upper = Not Upper 'switch to capitalize or not
    Next
    Return ret.ToString
    End Function

    'Checks to see if a string has alternate cases
    'lOnGsTrInG -> True
    Public Function IsAlternateCases(ByVal [String] As String) As Boolean
    If [String].Length = 1 Then Return False 'One letter strings can't be alternate cases
    Dim Upper As Boolean = Not IsUpper([String].Substring(0, 1)) 'Same structure as AlternateCases function, depends on the first letter
    For i As Integer = 1 To [String].Length - 1
    If Upper Then
    If Not IsUpper([String].Substring(i, 1)) Then Return False
    Else
    If IsUpper([String].Substring(i, 1)) Then Return False
    End If
    Upper = Not Upper
    Next
    Return True
    End Function

    'Checks for mixed upper and lower cases
    'string -> False
    'String -> True
    Public Function IsMixedCases(ByVal [String] As String) As Boolean
    Dim upper As Boolean
    For i As Integer = 0 To [String].Length - 1 'look for the first letter and see if it's capitalized or not
    If IsLetters([String].Substring(i, 1)) Then
    upper = IsUpper([String].Substring(i, 1))
    End If
    Next
    If [String].Length = 1 Then Return False
    For i As Integer = 1 To [String].Length - 1
    If IsUpper([String].Substring(i, 1)) <> upper AndAlso _
    IsLetters([String].Substring(i, 1)) Then Return True 'something has a different case, then it's now mixed, ignores numbers and others
    Next
    Return False
    End Function

    'Counts total number of a char or chars in a string
    'hello, l -> 2
    'hello, he -> 1
    Public Function CountTotal(ByVal [String] As String, ByVal [Chars] As String) As Integer
    Dim Count As Integer
    For i As Integer = 0 To [String].Length - 1 Step [Chars].Length
    'The way String.Compare works, "Not CBool" converts it to a traditional True/False
    'Compare is used to compare ignoring capitalization
    If Not i + [Chars].Length > [String].Length AndAlso Not CBool(String.Compare([String].Substring(i, [Chars].Length), [Chars], True)) Then
    Count += 1
    End If
    Next
    Return Count
    End Function

    'Removes vowels from a word
    'remove -> rmv
    Public Function RemoveVowels(ByVal [String] As String) As String
    Dim ret As New StringBuilder
    For i As Integer = 0 To [String].Length - 1
    If Not (Not CBool(String.Compare([String].Substring(i, 1), "a", True)) OrElse Not CBool(String.Compare([String].Substring(i, 1), "e", True)) OrElse _
    Not CBool(String.Compare([String].Substring(i, 1), "i", True)) OrElse Not CBool(String.Compare([String].Substring(i, 1), "o", True)) OrElse _
    Not CBool((String.Compare([String].Substring(i, 1), "u", True)))) Then
    'only add to the final string if it doesn't match the vowels
    ret.Append([String].Substring(i, 1))
    End If
    Next
    Return ret.ToString
    End Function

    'Checks to see if a word contains vowels
    'hello -> True
    'rmv -> False
    Public Function HasVowels(ByVal [String] As String) As Boolean
    For i As Integer = 0 To [String].Length - 1
    If (Not CBool(String.Compare([String].Substring(i, 1), "a", True)) OrElse Not CBool(String.Compare([String].Substring(i, 1), "e", True)) OrElse _
    Not CBool(String.Compare([String].Substring(i, 1), "i", True)) OrElse Not CBool(String.Compare([String].Substring(i, 1), "o", True)) OrElse _
    Not CBool(String.Compare([String].Substring(i, 1), "u", True))) Then
    'if something equals one of the vowels then it has vowels
    Return True
    End If
    Next
    Return False
    End Function

    'Checks if string is nothing but spaces
    '" " -> True
    Public Function IsSpaces(ByVal [String] As String) As Boolean
    For i As Integer = 0 To [String].Length - 1
    If Not AscW([String].Substring(i, 1)) = 32 Then '32 is the asc value of a space
    Return False
    End If
    Next
    Return True
    End Function

    'Checks if string has only numbers
    '(Since parameter is String instead of Object, it should be faster)
    '12453 -> True
    '234d3 -> False
    Public Function IsNumeric(ByVal [String] As String) As Boolean
    For i As Integer = 0 To [String].Length - 1
    If Not (AscW([String].Substring(i, 1)) >= 48 AndAlso AscW([String].Substring(i, 1)) <= 57) Then 'asc value range of numbers
    Return False
    End If
    Next
    Return True
    End Function

    'Checks if the string contains numbers
    'hello -> False
    'h3llo -> True
    Public Function HasNumbers(ByVal [String] As String) As Boolean
    Return System.Text.RegularExpressions.Regex.IsMatch([String], "\d+")
    End Function

    'Checks if string is numbers and letters
    'Test1254 -> True
    '$chool -> False
    Public Function IsAlphaNumberic(ByVal [String] As String) As Boolean
    For i As Integer = 0 To [String].Length - 1
    If Not (IsNumeric([String].Substring(i, 1)) OrElse _
    (AscW([String].Substring(i, 1)) >= 65 AndAlso AscW([String].Substring(i, 1)) <= 90) OrElse _
    (AscW([String].Substring(i, 1)) >= 97 AndAlso AscW([String].Substring(i, 1)) <= 122)) Then
    'checks asc value range of lower case and upper case letters and check if it's a number, if either fail, then it's not
    'only numbers and letters
    Return False
    End If
    Next
    Return True
    End Function

    'Checks if a string contains only letters
    'Hi -> True
    'Hi123 -> False
    Public Function IsLetters(ByVal [String] As String) As Boolean
    If IsAlphaNumberic([String]) Then 'Only numbers and letters, good
    If Not IsNumeric([String]) Then 'no numbers, good
    Return True
    End If
    End If
    Return False
    End Function

    'Returns the initials of a name or sentence
    'Capitalize - whether to make intials capitals
    'ReturnSeparator - to return intials separated (True - J. S. or False - J.S.)
    'John Smith -> J. S. or J.S.
    Public Function Initials(ByVal [String] As String, ByVal Capitalize As Boolean, ByVal ReturnSeparator As Boolean, Optional ByVal Separator As String = " ") As String
    Dim strs As String() = [String].Split(Separator) 'split all the words
    For i As Integer = 0 To strs.Length - 1
    'Leave only the first letter of everyword and add a . after each
    If Capitalize Then
    strs(i) = strs(i).Substring(0, 1).ToUpper & "."
    Else
    strs(i) = strs(i).Substring(0, 1) & "."
    End If
    Next
    If ReturnSeparator Then
    Return String.Join(Separator, strs)
    Else
    Return String.Join("", strs) 'No separator
    End If
    End Function

    'Capitalizes the first letter of every word
    'the big story -> The Big Story
    Public Function Title(ByVal [String] As String, Optional ByVal Separator As String = " ") As String
    Dim ret As String
    If [String].IndexOf(Separator) > -1 Then
    Dim strs As String() = [String].Split(Separator) 'split all the words so to capitalize the first letter of each
    For i As Integer = 0 To strs.Length - 1
    If strs(i).Length = 1 Then
    strs(i) = strs(i).ToUpper
    Else
    strs(i) = strs(i).Substring(0, 1).ToUpper & strs(i).Substring(1)
    End If
    Next
    ret = String.Join(Separator, strs) 'join them back together
    End If
    Return ret
    End Function

    'Checks whether the first letter of each word is capitalized
    'The Big Story -> True
    'The big story -> False
    Public Function IsTitle(ByVal [String] As String, Optional ByVal Separator As String = " ") As Boolean
    If [String].IndexOf(Separator) > -1 Then
    Dim strs As String() = [String].Split(Separator) 'split the words to check the first letter of each word is capitalized
    For i As Integer = 0 To strs.Length - 1
    If Not AscW(strs(i).Substring(0, 1)) = AscW(strs(i).Substring(0, 1).ToUpper) Then Return False
    Next
    End If
    Return True
    End Function

    'Checks if string is a valid emailaddress-format
    'name@place.com -> True
    'hahaimfaking -> False
    '(Function works assuming the last part is no bigger than 3 letters (com, net, org))
    Public Function IsEmailAddress(ByVal [String] As String) As Boolean
    If [String].IndexOf("@") > -1 Then
    For i As Integer = [String].Length - 1 To 0 Step -1
    If [String].Substring(i, 1) = "." Then
    If [String].Length - i <= 4 Then
    Return True
    End If
    End If
    Next
    End If
    Return False
    End Function

    'Returns all the locations of a char in a string
    'Hello, l -> 2, 3
    'Hello, o -> 4
    Public Function IndexesOf(ByVal [String] As String, ByVal [Char] As String) As Integer()
    Dim inx As New ArrayList
    For i As Integer = 0 To [String].Length - 1
    If [String].Substring(i, 1) = [Char] Then inx.Add(i) 'for every location found add it
    Next
    Dim final(in*****unt - 1) As Integer
    in*****pyTo(final) 'convert the ArrayList to an Integer array
    inx.Clear()
    Return final
    End Function

    'Return a rating for how strong the string is as a password
    'Max rating is 100
    'Credits for original function to D. Rijmenants, this is just a vb.net version
    'If there are problems with copyright or whatever, contact me and i'll delete this
    Public Function PasswordStrength(ByVal [String] As String) As Integer
    Dim Total As Integer
    Dim Uc As Boolean
    Dim Lc As Boolean

    Total = [String].Length * 3
    For i As Integer = 1 To [String].Length - 1
    If AscW([String].Substring(i, 1)) >= 65 AndAlso AscW([String].Substring(i, 1)) <= 92 Then Uc = True 'contains uppercases
    Next
    For i As Integer = 1 To [String].Length - 1
    If AscW([String].Substring(i, 1)) >= 97 And AscW([String].Substring(i, 1)) <= 122 Then Lc = True 'contains lowercases
    Next
    If Uc = True And Lc = True Then Total *= 1.2
    For i As Integer = 1 To [String].Length - 1
    If AscW([String].Substring(i, 1)) >= 48 And AscW([String].Substring(i, 1)) <= 57 Then 'contains numbers
    If Uc = True Or Lc = True Then Total *= 1.4
    Exit For
    End If
    Next
    For i As Integer = 1 To [String].Length - 1
    If AscW([String].Substring(i, 1)) <= 47 Or AscW([String].Substring(i, 1)) >= 123 Or (AscW([String].Substring(i, 1)) >= 58 And AscW([String].Substring(i, 1)) <= 64) Then
    'contains some extra symbols
    Total *= 1.5
    Exit For
    End If
    Next
    If Total > 100 Then Total = 100 'make sure not over 100
    Return Total
    End Function

    'Gets the char in a string at a given position, but from right to left
    'string, 0 -> g
    Public Function CharRight(ByVal [String] As String, ByVal Position As Integer) As Char
    Return [String].Substring([String].Length - Position - 1, 1)
    End Function

    'Gets the char in a string at a given position from the given starting point, reads left to right
    'string, 0, 2 -> r
    Public Function CharMid(ByVal [String] As String, ByVal Position As Integer, ByVal Start As Integer) As Char
    If Not Start + Position > [String].Length Then
    Return [String].Substring(Start + Position, 1)
    Else
    Return ""
    End If
    End Function

    'Inserts a separator after every letter
    'hello, - -> h-e-l-l-o
    Public Function InsertSeparator(ByVal [String] As String, ByVal Separator As String) As String
    Dim final As New StringBuilder
    For i As Integer = 0 To [String].Length - 1
    final.Append([String].Substring(i, 1) & Separator) 'after every letter add the separator
    Next
    Return final.ToString.Substring(0, final.Length - 1) 'Cut out last separator (h-e-l-l-o- -> h-e-l-l-o)
    End Function

    'Inserts a separator after every Count letters
    'hello, -, 2 -> he-ll-o
    Public Function InsertSeparatorEvery(ByVal [String] As String, ByVal Separator As String, ByVal Count As Integer) As String
    Dim final As New StringBuilder
    For i As Integer = 0 To [String].Length - 1 Step Count 'every so steps add the separator
    If Not i + Count > [String].Length Then
    final.Append([String].Substring(i, Count) & Separator)
    Else
    final.Append([String].Substring(i) & Separator)
    End If
    Next
    Return final.ToString.Substring(0, final.Length - 1) 'Cut out last separator
    End Function

    'Inserts a separator at given position
    'hello, -, 3 -> hel-lo
    Public Function InsertSeparatorAt(ByVal [String] As String, ByVal Separator As String, ByVal Position As Integer) As String
    Return [String].Substring(0, Position) & Separator & [String].Substring(Position) 'split the string at that position and add the separator
    End Function

    'Function that works the same way as the default Substring, but
    'it takes Start and End parameters instead of Start and Length
    Public Function Substring(ByVal [String] As String, ByVal Start As Integer, ByVal [End] As Integer) As String
    If Start > [End] Then 'If start is after the end then just flip the values
    Start = Start Xor [End]
    [End] = Start Xor [End]
    Start = Start Xor [End]
    End If
    If [End] > [String].Length Then [End] = [String].Length 'if the end is outside of the string, just make it the end of the string
    Return [String].Substring(Start, [End] - Start)
    End Function

    'Reverses a string
    'Hello -> olleH
    Public Function Reverse(ByVal [String] As String) As String
    Dim final As New StringBuilder
    For i As Integer = [String].Length - 1 To 0 Step -1 'read the string backwards
    final.Append([String].Substring(i, 1))
    Next
    Return final.ToString
    End Function

    'Splits strings, but leaves anything within quotes
    'This is a "very long" string ->
    'This
    'is
    'a
    'very long
    'string
    Public Function Split(ByVal [String] As String, Optional ByVal DontAccountQuotes As Boolean = False, Optional ByVal Separator As String = " ") As String()
    If DontAccountQuotes Then
    Return [String].Split(Separator)
    Else
    Dim words As String() = [String].Split(Separator)
    Dim newwords As New ArrayList
    For i As Integer = 0 To words.Length - 1
    If words(i).StartsWith("""") Then
    Dim linked As New ArrayList
    For y As Integer = i To words.Length - 1
    If words(y).EndsWith("""") Then
    linked.Add(words(y).Substring(0, words(y).Length - 1))
    i = y
    Exit For
    Else
    If words(y).StartsWith("""") Then words(y) = words(y).Substring(1)
    linked.Add(words(y))
    End If
    Next
    Dim tmp(linked.Count - 1) As String
    linked.CopyTo(tmp)
    If Not linked.Count = 0 Then newwords.Add(String.Join(Separator, tmp))
    linked.Clear()
    Erase tmp
    Else
    newwords.Add(words(i))
    End If
    Next
    Dim tmp2(newwords.Count - 1) As String
    newwords.CopyTo(tmp2)
    newwords.Clear()
    Return tmp2
    End If
    End Function
    End Module
    [/highlight]

    Functions are:

    GetPath(<Full Path>)
    The function retrieves the path part from the full filename like, C:\Folder\file.exe -> C:\Folder\.

    GetName(<Full Path>)
    It retrieves the name of the file from the full filename like, C:\Folder\file.exe - > file, file.exe -> file.

    GetExtension(<Full Path>)
    It retrieves the extension of the file from a filename C:\Folder\file.exe - > exe, file.exe -> exe.

    RemoveExtension(<Full Path>)
    It removes the extension from a filename like, C:\Folder\file.exe - > C:\Folder\file, file.exe -> file.

    GetFullName(<Full Path>)
    It removes the path from a filename like, C:\Folder\file.exe - > file.exe.

    IsCapitalized(<String>)
    It checks whether a word or sentence is capitalized like, Word -> True, This is a sentence -> True.

    IsLower(<String>)
    It checks whether a word or character is in lower case like, word -> True, Word -> False.

    IsUpper(<String>)
    It checks whether a word or character is in upper case like, word -> False, Word -> False, WORD -> True.

    SwapCases(<String>)
    It swaps the cases in a string like, word -> WORD, Word -> wORD, WoRd -> wOrD.

    AlternateCases(<String>)
    It alternates the cases between letters of a string, the first letter's case stays the same like, Hi -> Hi, longstring -> lOnGsTrInG.

    IsAlternateCases(<String>)
    It checks to see if a string has alternate cases like, lOnGsTrInG -> True.

    IsMixedCases(<String>)
    It checks for mixed upper and lower cases like, string -> False, String -> True.

    CountTotal(<String>, <Chars>)
    It counts total number of a string or character in a string like, hello, l -> 2, hello, he -> 1.

    RemoveVowels(<String>)
    It removes vowels from a string like, remove -> rmv.

    HasVowels(<String>)
    It checks to see if a string contains vowels like, hello -> True, rmv -> False.

    IsSpaces(<String>)
    It checks if a string is nothing but spaces like, " " -> True.

    IsNumeric(<String>)
    It checks if a string has only numbers like, 12453 -> True, 234d3 -> False.
    I know that there is already an existing IsNumeric function, but the existing one takes the input parameter as an Object, so in theory, this function should be faster for larger strings because it takes the input as a String.

    HasNumbers(<String>)
    It checks if the string contains numbers like, hello -> False, h3llo -> True.

    IsAlphaNumberic(<String>)
    It checks if the string has numbers and letters like, Test1254 -> True, $chool -> False.

    IsLetters(<String>)
    It checks if the string contains only letters like, Hi -> True, Hi123 -> False.

    Initials(<String>, <Capitalize>, <ReturnSeparator>, <Optional Separator = " ">)
    It returns the initials of a name or sentence.

    * Capitalize- To return the initials as lower or upper case.
    * ReturnSeparator - To return the initials with the original separator (John Smith, a space is the separator, so return J. S. or J.S.).
    * Separator - The character that marks the separation of words (John Smith, space is the separator (default)) John Smith -> J. S.

    Title(<String>, <Optional Separator = " ">)
    It capitalizes the first letter of every word in the string like, the big story -> The Big Story.

    IsEmailAddress(<String>)
    It checks if a string is in a valid email address-format like, name@place.com -> True, hahaimfaking -> False. (The function works by assuming the last part is no bigger than 3 letters (com, net, org).)

    IndexesOf(<String>, ByVal [Char] As String) As Integer()
    It returns all the locations of a given char in a string like, Hello, l -> 2, 3, Hello, o -> 4.
    This function works with an ArrayList and then converts it to an Integer array, if you prefer the ArrayList it can be easily modified.

    CharRight(<String>, <Position>) As Char
    It gets the char in a string at a given position, but from right to left like, string, 0 -> g.

    CharMid(<String>, <Position>, <Start>) As Char
    It gets the char in a string at a given position from a given starting point, and reads from left to right like, string, 0, 2 -> r.

    InsertSeparator(<String>, <Separator As String>)
    It inserts a separator after every letter like, hello, "-" -> h-e-l-l-o.

    InsertSeparatorEvery(<String>, <Separator>, <Count>)
    It inserts a separator after every Count letters like, hello, "-", 2 -> he-ll-o.

    Substring(<String>, <Start>, <End>)
    This is a function that works the same way as the default Substring, but it takes Start and End parameters instead of Start and Length.

    Reverse(<String>)
    It reverses a string like, Hello -> olleH.

    PasswordStrength(<String>) As Integer
    It is a borrowed function. It returns a rating for how strong the string is as a password. (Max rating is 100).
    The credits for the original function goes to D. Rijmenants, this is just a VB.NET version. If there is any problem with copyright or whatever, contact me and I'll delete this. This is just an interesting function that took me a long time to find, so I thought it'd be useful to include it here.

    Split(<String>, <Optional Don't Account for Quotes>, <Optional Separator>)
    This function is newly added (on 9/27/05). Thanks to j1webb for the idea. This is just like the default Split function, but it keeps everything inside the quotes, intact. For example: 'This is a "very long" string' would return 'This', 'is', 'a', 'very long', 'string'. A limitation of this function is that if there's a quote inside quotes it will mess up. The quote symbol is " by default, but it can be changed to look for ' instead.

    Hope this helps !!!
    Last edited by NextGen1; 02-03-2011 at 01:07 PM.

  10. The Following 4 Users Say Thank You to Hassan For This Useful Post:

    biohazardzz (06-29-2011),House (11-30-2010),Ninja® (09-12-2011),Tony Stark` (02-17-2011)

  11. #6
    Hassan's Avatar
    Join Date
    May 2010
    Gender
    male
    Location
    System.Threading.Tasks
    Posts
    4,764
    Reputation
    495
    Thanks
    2,132
    My Mood
    Dead

    Some API Functions

    I created this class for my programming language, thought it would be useful for you guys too. Create a class named 'APIFunctions' and paste the following in it:

    [highlight=vbnet]Imports System****ntime.InteropServices
    Imports System.Drawing.Imaging

    Public Class APIFunctions
    #Region "Keyboard"
    Class Keyboard
    Private Const VK_NUMLOCK As Integer = &H90
    Private Const VK_SCROLL As Integer = &H91
    Private Declare Sub keybd_event Lib "user32" ( _
    ByVal bVk As Byte, _
    ByVal bScan As Byte, _
    ByVal dwFlags As Integer, _
    ByVal dwExtraInfo As Integer _
    )

    Private Const VK_CAPITAL As Integer = &H14
    Private Const KEYEVENTF_EXTENDEDKEY As Integer = &H1
    Private Const KEYEVENTF_KEYUP As Integer = &H2

    Public Sub num()
    keybd_event(VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0)

    ' Simulate the Key Release
    keybd_event(VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)

    End Sub
    Public Sub caps()
    keybd_event(VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0)

    ' Simulate the Key Release
    keybd_event(VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)


    End Sub
    Public Sub scr()
    keybd_event(VK_SCROLL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0)

    ' Simulate the Key Release
    keybd_event(VK_SCROLL, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)


    End Sub
    End Class
    Class Monitor
    Public WM_SYSCOMMAND As Integer = &H112
    Public SC_MONITORPOWER As Integer = &HF170
    <DllImport("user32.dll")> _
    Private Shared Function SendMessage(ByVal hWnd As Integer, ByVal hMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    End Function

    Public Sub TurnOn()

    Dim x As Int32
    x = Main.Handle
    SendMessage(x, WM_SYSCOMMAND, SC_MONITORPOWER, -1)

    ' System.Threading.Thread.Sleep(2000)
    ' SendMessage(Me.Handle.ToInt32(), WM_SYSCOMMAND, SC_MONITORPOWER, -1)
    End Sub

    Public Sub TurnOff()

    Dim x As Int32
    x = Main.Handle
    SendMessage(x, WM_SYSCOMMAND, SC_MONITORPOWER, 2)

    ' System.Threading.Thread.Sleep(2000)
    ' SendMessage(Me.Handle.ToInt32(), WM_SYSCOMMAND, SC_MONITORPOWER, -1)
    End Sub

    Public Sub Lowstate()

    Dim x As Int32
    x = Main.Handle

    SendMessage(x, WM_SYSCOMMAND, SC_MONITORPOWER, 1)

    ' System.Threading.Thread.Sleep(2000)
    ' SendMessage(Me.Handle.ToInt32(), WM_SYSCOMMAND, SC_MONITORPOWER, -1)
    End Sub
    End Class
    Class CDROM
    Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
    (ByVal lpCommandString As String, ByVal lpReturnString As String, _
    ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
    Public Sub OpenCDDoor()

    Dim retval As Long

    retval = mciSendString("set CDAudio door open", "", 0, 0)

    End Sub


    Public Sub CloseCDDoor()

    Dim retval As Long

    retval = mciSendString("set CDAudio door closed", "", 0, 0)

    End Sub
    End Class
    Class Wallpaper

    Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Integer, ByVal uParam As Integer, ByVal lpvParam As String, ByVal fuWinIni As Integer) As Integer

    'constants to be used with the above api
    Private Const SPI_SETDESKWALLPAPER = 20
    Private Const SPIF_UPDATEINIFILE = &H1
    Dim pic As New PictureBox
    Public Sub main(ByVal dialog As Boolean, ByVal qu As String)

    SetWall(dialog, qu)

    End Sub
    Dim z As String = ""

    Private Sub SetWall(Optional ByVal Dialog As Boolean = True, Optional ByVal qu As String = "")
    If Dialog Then
    open()
    End If
    If c Then
    Exit Sub

    End If

    'just some generic path and name for the image in the picturebox to save to
    If Not qu = "" Then
    Dim a As New PictureBox
    Dim imagePath1 As String = Application.StartupPath & "\myNewWallpaper.bmp"


    a.Image = Image.FromFile(qu)


    a.Image.Save(imagePath1, ImageFormat.Bmp)

    'set the parameters to change the wallpaper to the image you selected
    SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, imagePath1, SPIF_UPDATEINIFILE)
    My.Computer.FileSystem.DeleteFile(imagePath1)

    Exit Sub
    End If

    Dim imagePath As String = Application.StartupPath & "\myNewWallpaper.bmp"



    pic.Image.Save(imagePath, ImageFormat.Bmp)

    'set the parameters to change the wallpaper to the image you selected
    SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, imagePath, SPIF_UPDATEINIFILE)

    End Sub
    Dim c As Boolean = False

    Public Sub open()
    c = False

    'select a image and get the path
    Dim dlg As OpenFileDialog = New OpenFileDialog

    dlg.Filter = "Image Files (*.bmp, *.gif, *.jpg)|*.bmp;*.gif;*.jpg"
    dlg.Title = "Select the image to load."

    If Not dlg.ShowDialog() = DialogResult.Cancel Then
    pic.Image = Image.FromFile(dlg.FileName)
    Else
    c = True
    End If
    dlg.Dispose()
    'put the selected image in the picturebox to see it


    End Sub

    End Class
    #End Region

    End Class
    [/highlight]

    This class has the following functions:

    NumLock Toggling
    CapsLock Toggling
    ScrollLock Toggling

    Open CD Rom
    Close CD Rom

    Put Monitor To Low State
    Turn Off Monitor
    Turn On Monitor

    Change Desktop Wallpaper Via Explorer / Path


    ************************************************** ******

    Following are some more useful functions from the same project that can be useful:

    This function Breaks the code into tokens (Words), which you can analyze anyway you want.

    [highlight=vbnet]Public Shared Function TokenizeLine(ByVal line As String)
    Dim g As String = ""
    Dim q As Boolean = False
    For i As Integer = 1 To line.Length
    Dim c As String = Mid(line, i, 1)
    If c = """" Then
    If q Then
    q = False
    Else
    q = True
    End If
    End If
    If q Then
    g += c
    Continue For
    End If
    If Char.IsLetter(c) Then
    g += c
    ElseIf Char.IsDigit(c) Then
    g += c
    ElseIf Char.IsWhiteSpace(c) Then
    g += vbCrLf
    ElseIf c = "(" Or c = ")" Or c = "+" Or c = "-" Or c = "*" Or c = "/" Or c = "." Or c = "=" Or c = "," Or c = "&" Then
    g += vbCrLf & c & vbCrLf
    ElseIf c = """" Then
    If Not q Then
    g += """"
    End If
    End If
    Next
    Dim f() As String = g.Split(ChrW(10))
    Dim ic As String = ""
    For Each j As String In f
    If Char.IsWhiteSpace(j) Then
    j = j.Replace(j, "")
    End If
    ic += j
    Next
    Return ic.Trim()


    End Function[/highlight]

    This function will evaluate expressions like we do in visual basic. It is capable of solving very complex mathematical expressions and supports default visual basic and C# math keywords. Just input the string which you want to solve as the only parameter. It's from MSDN.

    [highlight=vbnet]Private Shared Function ProcessCommand(ByVal command As String) As Double
    'Create a C# Code Provider
    Dim myCodeProvider As New CSharpCodeProvider()
    ' Build the parameters for source compilation.
    Dim cp As New CompilerParameters()
    cp.GenerateExecutable = False
    'No need to make an EXE file here.
    cp.GenerateInMemory = True
    'But we do need one in memory.
    cp.OutputAssembly = "TempModule"
    'This is not necessary, however, if used repeatedly, causes the CLR to not need to
    'load a new assembly each time the function is run.
    'The below string is basically the shell of a C# program, that does nothing, but contains an
    'Evaluate() method for our purposes. I realize this leaves the app open to injection attacks,
    'But this is a simple demonstration.
    Dim TempModuleSource As String = ("namespace ns{" & "using System;" & "class class1{" & "public static double Evaluate(){return ") + command & ";}}} "
    'Our actual Expression evaluator
    Dim cr As CompilerResults = myCodeProvider.CompileAssemblyFromSource(cp, TempModuleSource)
    If cr.Errors.Count > 0 Then
    'If a compiler error is generated, we will throw an exception because
    'the syntax was wrong - again, this is left up to the implementer to verify syntax before
    'calling the function. The calling code could trap this in a try loop, and notify a user
    'the command was not understood, for example.
    Throw New ArgumentException("Expression cannot be evaluated, please use a valid C# expression")
    Else
    Dim Methinfo As MethodInfo = cr.CompiledAssembly.[GetType]("ns.class1").GetMethod("Evaluate")
    Return CDbl(Methinfo.Invoke(Nothing, Nothing))
    End If
    End Function[/highlight]


    The following function flips all windows in vista / 7 in 3D.

    [highlight=vbnet]Try
    Shell("C:\Windows\System32\rundll32.exe DwmApi #105")
    Catch ex As Exception
    MsgBox("Flip3D is only supported in Microsoft Windows Vista and Microsoft Windows 7.")
    Exit Function
    End Try[/highlight]

    The following function sets the mouse position without any API:


    [highlight=vbnet]
    Cursor.Position = New System.Drawing.Point(40,345)[/highlight]

    More coming soon
    Last edited by NextGen1; 02-03-2011 at 01:08 PM.

  12. The Following 6 Users Say Thank You to Hassan For This Useful Post:

    biohazardzz (06-29-2011),chikencow (02-11-2011),House (11-30-2010),Lyoto Machida (04-16-2011),Ninja® (09-12-2011),Tony Stark` (02-17-2011)

  13. #7
    Samueldo's Avatar
    Join Date
    Jan 2010
    Gender
    male
    Location
    Meh
    Posts
    1,023
    Reputation
    29
    Thanks
    348
    My Mood
    Inspired
    Here's a simple but useful one. These are 2 easy ways to convert a color from a string.

    [highlight=vbnet]Color.FromName("Blue") 'Whatever color name you want in those brackets

    Color.FromArgb(red value, green value, blue value) 'You could you strings or integers here[/highlight]
    Last edited by NextGen1; 02-03-2011 at 01:09 PM.
    Quote Originally Posted by Grim View Post
    glad to be an inspiration
    Minions rule. /endof

    InjectPlz Refresh - download v1.0 now!

  14. The Following User Says Thank You to Samueldo For This Useful Post:

    Ninja® (09-12-2011)

  15. #8
    Blubb1337's Avatar
    Join Date
    Sep 2009
    Gender
    male
    Location
    Germany
    Posts
    5,915
    Reputation
    161
    Thanks
    3,108
    I wrote up this little configureable function to read between strings.

    [highlight=vbnet]Imports System.IO
    Imports System.Text[/highlight]

    [highlight=vbnet] Public Function rb(ByVal readfrom As String, ByVal startstring As String, ByVal str1 As String, ByVal str2 As String)
    Dim writeto As String
    Dim s As New MemoryStream(Encoding.ASCII.GetBytes(readfrom))

    Dim reader As New IO.StreamReader(s)

    While Not reader.EndOfStream

    writeto = reader.ReadLine()

    If writeto.StartsWith(startstring) Then

    Dim x1 As Integer = writeto.IndexOf(str1) + (str1.Length + 1)
    Dim x2 As Integer = writeto.IndexOf(str2, x1) + 1

    Dim result As String = Mid(writeto, x1, x2 - x1)

    Return result

    End If


    End While

    End Function[/highlight]

    I.E. a youtube video...

    <strong class="watch-view-count">301</strong>
    Textbox1.Text = the document text of the youtube video

    [highlight=vbnet]Dim views as string = rb(Textbox1.Text, "<strong class="watch-view-count">", "<strong class="watch-view-count">", "</strong>")[/highlight]

    The 'startstring' thingy is optional but may come in handy in more complex strings :P.
    Last edited by NextGen1; 02-03-2011 at 01:14 PM.



  16. The Following 5 Users Say Thank You to Blubb1337 For This Useful Post:

    biohazardzz (06-29-2011),cgallagher21 (09-06-2010),K4GE (08-07-2010),Ninja® (09-12-2011),Tony Stark` (02-17-2011)

  17. #9
    NovaSynth's Avatar
    Join Date
    Jan 2010
    Gender
    male
    Posts
    14
    Reputation
    10
    Thanks
    10

    Memory Editing [vb6]

    This is my memory editing snippet. Just place this code inside a module and use it in your programs if you wish Unfortunatly, i had coded this module in vb6, so not every command will work with vb.net. You may translate if you wish, i just ask that you re-post for others to use.


    ~~~~~Declarations~~~~~
    [highlight=vbnet] Public Const PROCESS_ALL_ACCESS = &H1F0FFF
    Dim f1holder As Integer
    Dim timer_pos As Long
    Dim hProcess As Long

    Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal SomeValueIsStoredHere As Long, ByVal lpdwProcessId As Long) As Long
    Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    Public Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Object, ByVal lpBuffer As Object, ByVal nSize As Long, ByVal lpNumberOfBytesWritten As Long) As Long
    Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal Classname As String, ByVal WindowName As String) As Long
    Public Declare Function GetKeyPress Lib "user32" Alias "GetAsyncKeyState" (ByVal key As Long) As Integer
    Public Declare Function ReadProcessMem Lib "kernel32" Alias "ReadProcessMemory" (ByVal hProcess As Long, ByVal lpBaseAddress As Object, ByRef lpBuffer As Object, ByVal nSize As Long, ByVal lpNumberOfBytesWritten As Long) As Long[/highlight]


    ~~~~~Module~~~~~
    [highlight=vbnet] Public Function WriteALong(ByVal TheGame As String, ByVal TheAddress As Long, ByVal ThisIsTheValue As Long)
    Dim SomeValueIsStoredHere As Long
    Dim SomeValueIsStoredHereToo As Long
    Dim SomeValue As Long
    SomeValueIsStoredHere = FindWindow(vbNullString, TheGame)
    GetWindowThreadProcessId(SomeValueIsStoredHere, SomeValueIsStoredHereToo)
    SomeValue = OpenProcess(PROCESS_ALL_ACCESS, False, SomeValueIsStoredHereToo)
    If (SomeValue = 0) Then
    Exit Function
    End If
    WriteProcessMemory(SomeValue, TheAddress, ThisIsTheValue, 4, 0&)
    CloseHandle(hProcess)
    End Function[/highlight]
    [highlight=vbnet] Public Function ReadALong(ByVal TheGame As String, ByVal TheAddress As Long, ByVal TheValue As Long)
    Dim SomeValueIsStoredHere As Long
    Dim SomeValueIsStoredHereToo As Long
    Dim SomeValue As Long
    SomeValueIsStoredHere = FindWindow(vbNullString, TheGame)
    GetWindowThreadProcessId(SomeValueIsStoredHere, SomeValueIsStoredHereToo)
    SomeValue = OpenProcess(PROCESS_ALL_ACCESS, False, SomeValueIsStoredHereToo)
    If (SomeValue = 0) Then
    Exit Function
    End If
    ReadProcessMem(SomeValue, TheAddress, TheValue, 4, 0&)
    CloseHandle(hProcess)
    End Function[/highlight]
    [highlight=vbnet] Public Function ReadAFloat(ByVal TheGame As String, ByVal TheAddress As Long, ByVal TheValue As Single)
    Dim SomeValueIsStoredHere As Long
    Dim SomeValueIsStoredHereToo As Long
    Dim SomeValue As Long
    SomeValueIsStoredHere = FindWindow(vbNullString, TheGame)
    GetWindowThreadProcessId(SomeValueIsStoredHere, SomeValueIsStoredHereToo)
    SomeValue = OpenProcess(PROCESS_ALL_ACCESS, False, SomeValueIsStoredHereToo)
    If (SomeValue = 0) Then
    Exit Function
    End If
    ReadProcessMem(SomeValue, TheAddress, TheValue, 4, 0&)
    CloseHandle(hProcess)
    End Function[/highlight]
    [highlight=vbnet] Public Function WriteAFloat(ByVal TheGame As String, ByVal TheAddress As Long, ByVal ThisIsTheValue As Single)
    Dim SomeValueIsStoredHere As Long
    Dim SomeValueIsStoredHereToo As Long
    Dim SomeValue As Long
    SomeValueIsStoredHere = FindWindow(vbNullString, TheGame)
    GetWindowThreadProcessId(SomeValueIsStoredHere, SomeValueIsStoredHereToo)
    SomeValue = OpenProcess(PROCESS_ALL_ACCESS, False, SomeValueIsStoredHereToo)
    If (SomeValue = 0) Then
    Exit Function
    End If
    WriteProcessMemory(SomeValue, TheAddress, ThisIsTheValue, 4, 0&)
    CloseHandle(hProcess)
    End Function[/highlight]


    ~~~~~Instructions~~~~~
    Alright. In order for this to work, im gonna show you a quick example using that cheezy little Pinball game that comes with Windows XP.

    lets say we turned the game on and made a button that we set the button command to this: [highlight=vbnet]
    Private Sub Command1_Click()
    Call WriteALong("3D Pinball for Windows, Space Cadet", &HA12EF4, 999999)
    Call WriteALong("3D Pinball for Windows, Space Cadet", &HB8AEBA, 999999)
    End Sub
    [/highlight]

    Basically what the code means, is that i Called the function "WriteALong" from the module that is just above. "3D Pinball for Windows, Space Cadet" is the window title, &HB8AEBA is the address. "999999" is the value you set that specific address to.

    *Note: Add &H instead of the 2 00 (two zero's), Here's an example: Your address is 00L1FD4. You need to replace the 00 (two zero's) with an &H , then you would get this: &HL1FD4. If there is only 1 0 at the beginning then just replace it with an &. If there are no zero's at the beginning then this rule does not apply.


    And thats it!

    oh and p.s. This is basically how people use VB and make trainers for games and such.
    Last edited by NextGen1; 02-03-2011 at 02:12 PM.

  18. The Following 4 Users Say Thank You to NovaSynth For This Useful Post:

    biohazardzz (06-29-2011),Lyoto Machida (04-16-2011),Ninja® (09-12-2011),Tony Stark` (02-17-2011)

  19. #10
    Hawky1337's Avatar
    Join Date
    Jun 2010
    Gender
    male
    Posts
    88
    Reputation
    11
    Thanks
    27
    My Mood
    Shocked
    Reading the header of a .mp3 file to get the Artist/Year/Album/Title.

    Create the following class:

    [highlight=vbnet]Imports System.IO

    Public Class MP3TagData

    Private _Artist As String
    Private _SongTitle As String
    Private _Album As String
    Private _Year As String

    Public ReadOnly Property Artist() As String
    Get
    Return _Artist
    End Get
    End Property

    Public ReadOnly Property SongTitle() As String
    Get
    Return _SongTitle
    End Get
    End Property

    Public ReadOnly Property Album() As String
    Get
    Return _Album
    End Get
    End Property

    Public ReadOnly Property Year() As String
    Get
    Return _Year
    End Get
    End Property

    Public Sub ReadFromFile(ByVal filename As String)
    ' Bereits vorhandene Werte l?schen.
    Me._SongTitle = ""
    Me._Artist = ""
    Me._Album = ""
    Me._Year = ""
    Dim fs As New FileStream(filename, FileMode.Open)
    ' MP3-Tag lesen.
    fs.Seek(0 - 128, SeekOrigin.End)
    Dim Tag(2) As Byte
    fs.Read(Tag, 0, 3)
    ' ?berpr?fen, ob ein Tag vorhanden ist.
    If System.Text.Encoding.ASCII.GetString(Tag).Trim() = "TAG" Then
    ' Titel.
    Me._SongTitle = GetTagData(fs, 30)
    ' K?nstler.
    Me._Artist = GetTagData(fs, 30)
    ' Album.
    Me._Album = GetTagData(fs, 30)
    ' Jahr.
    Me._Year = GetTagData(fs, 4)
    End If
    fs.Close()
    End Sub

    Private Function GetTagData(ByVal stream As Stream, _
    ByVal length As Integer) As String
    ' Daten lesen.
    Dim Bytes(length - 1) As Byte
    stream.Read(Bytes, 0, length)
    Dim TagData As String = System.Text.Encoding.ASCII.GetString(Bytes)
    ' Nullen abschneiden.
    Dim TrimChars() As Char = {Char.Parse(" "), Char.Parse(vbNullChar)}
    TagData = TagData.Trim(TrimChars)
    Return TagData
    End Function

    End Class[/highlight]

    On button click_event or wherever:

    [highlight=vbnet] Dim MP3Tag As New MP3TagData
    Dim Dateiname As String = "C:\test.mp3"

    Try
    MP3Tag.ReadFromFile(Dateiname)
    Catch ex As Exception
    MsgBox(ex.Message.ToString)
    End Try


    Dim album As String = MP3Tag.Album
    Dim artist As String = MP3Tag.Artist
    Dim title As String = MP3Tag.SongTitle
    Dim year As String = MP3Tag.Year[/highlight]

    @Above, I'd suggest using Phenix module since it is working with the process and not with the window name.
    Last edited by NextGen1; 02-03-2011 at 02:13 PM.

  20. The Following 4 Users Say Thank You to Hawky1337 For This Useful Post:

    biohazardzz (06-29-2011),Ninja® (09-12-2011),Tony Stark` (02-17-2011),Withoutwings (03-12-2011)

  21. #11
    wtfiwantthatname's Avatar
    Join Date
    Oct 2008
    Gender
    male
    Posts
    260
    Reputation
    10
    Thanks
    39
    My Mood
    Bored
    Here is a module with code for encrypting and decrypting strings.

    Code:
    Imports System.Security.Cryptography
    Module Encryption
        Public Function AESEncrypt(ByVal Key As String, ByVal Data As String) As String
            Try
                Dim AES As AesCryptoServiceProvider
                With AES
                    .Mode = CipherMode.ECB
                    .Key = System.Text.ASCIIEncoding.ASCII.GetBytes(Key)
                    .IV = .Key
                End With
                Dim AESEncryptor As ICryptoTransform = AES.CreateEncryptor
                Dim DataBuffer As Byte()
                Dim EncryptedData As Byte()
                DataBuffer = System.Text.ASCIIEncoding.ASCII.GetBytes(Data)
                EncryptedData = AESEncryptor.TransformFinalBlock(DataBuffer, 0, DataBuffer.Length)
                Return ByteToString(EncryptedData)
            Catch ex As Exception
                MessageBox.Show("The Following Error(s) occured: " & ex.Message, "Error", MessageBoxButtons.OK)
            End Try
        End Function
    
    
        Public Function AESEncrypt(ByVal Key() As Byte, ByVal Data() As Byte) As Byte()
            Try
                Dim AES As AesCryptoServiceProvider
                With AES
                    .Mode = CipherMode.ECB
                    .Key = Key
                    .IV = .Key
                End With
                Dim AESEncryptor As ICryptoTransform = AES.CreateEncryptor
                Dim DataBuffer As Byte()
                Dim EncryptedData As Byte()
                DataBuffer = Data
                EncryptedData = AESEncryptor.TransformFinalBlock(DataBuffer, 0, DataBuffer.Length)
                Return EncryptedData
            Catch ex As Exception
                MessageBox.Show("The Following Error(s) occured: " & ex.Message, "Error", MessageBoxButtons.OK)
            End Try
        End Function
    
    
        Public Function AESDecrypt(ByVal Key() As Byte, ByVal Data() As Byte) As Byte()
            Try
                Dim AES As AesCryptoServiceProvider
                With AES
                    .Mode = CipherMode.ECB
                    .Key = Key
                    .IV = .Key
                End With
                Dim AESDecryptor As ICryptoTransform = AES.CreateDecryptor
                Dim DataBuffer As Byte()
                Dim DecryptedData As Byte()
                DataBuffer = Data
                DecryptedData = AESDecryptor.TransformFinalBlock(DataBuffer, 0, DataBuffer.Length)
                Return DecryptedData
            Catch ex As Exception
                MessageBox.Show("The Following Error(s) occured: " & ex.Message, "Error", MessageBoxButtons.OK)
            End Try
        End Function
    
    
        Public Function AESDecrypt(ByVal Key As String, ByVal Data As String) As String
            Try
                Dim AES As AesCryptoServiceProvider
                With AES
                    .Mode = CipherMode.ECB
                    .Key = System.Text.ASCIIEncoding.ASCII.GetBytes(Key)
                    .IV = .Key
                End With
                Dim AESDecryptor As ICryptoTransform = AES.CreateDecryptor
                Dim DataBuffer As Byte()
                Dim DecryptedData As Byte()
                DataBuffer = System.Text.ASCIIEncoding.ASCII.GetBytes(Data)
                DecryptedData = AESDecryptor.TransformFinalBlock(DataBuffer, 0, DataBuffer.Length)
                Return ByteToString(DecryptedData)
            Catch ex As Exception
                MessageBox.Show("The Following Error(s) occured: " & ex.Message, "Error", MessageBoxButtons.OK)
            End Try
        End Function
    
    
        Public Function RC2Encrypt(ByVal Key As String, ByVal Data As String) As Byte()
            Try
                Dim RC2 As RC2CryptoServiceProvider
                With RC2
                    .Mode = CipherMode.ECB
                    .UseSalt = True
                    .Key = System.Text.ASCIIEncoding.ASCII.GetBytes(Key)
                    .IV = .Key
                End With
                Dim RC2Encryptor As ICryptoTransform = RC2.CreateEncryptor
                Dim databuffer As Byte()
                Dim EncryptedData As Byte()
                databuffer = System.Text.ASCIIEncoding.ASCII.GetBytes(Data)
                EncryptedData = RC2Encryptor.TransformFinalBlock(databuffer, 0, databuffer.Length)
                Return EncryptedData
            Catch ex As Exception
                MessageBox.Show("The Following Error(s) occured: " & ex.Message, "Error", MessageBoxButtons.OK)
            End Try
        End Function
    
        Public Function RC2Encrypt(ByVal Key() As Byte, ByVal Data() As Byte) As Byte()
            Try
                Dim RC2 As RC2CryptoServiceProvider
                With RC2
                    .Mode = CipherMode.ECB
                    .UseSalt = True
                    .Key = Key
                    .IV = .Key
                End With
                Dim RC2Encryptor As ICryptoTransform = RC2.CreateEncryptor
                Dim databuffer As Byte()
                Dim EncryptedData As Byte()
                databuffer = Data
                EncryptedData = RC2Encryptor.TransformFinalBlock(databuffer, 0, databuffer.Length)
                Return EncryptedData
            Catch ex As Exception
                MessageBox.Show("The Following Error(s) occured: " & ex.Message, "Error", MessageBoxButtons.OK)
            End Try
        End Function
    
        Public Function RC2Decrypt(ByVal key() As Byte, ByVal data() As Byte) As Byte()
            Try
                Dim RC2 As RC2CryptoServiceProvider
                With RC2
                    .Mode = CipherMode.ECB
                    .UseSalt = True
                    .Key = key
                    .IV = .Key
                End With
                Dim RC2Decryptor As ICryptoTransform = RC2.CreateDecryptor
                Dim databuffer As Byte()
                Dim Decrypteddata As Byte()
                databuffer = data
                Decrypteddata = RC2Decryptor.TransformFinalBlock(databuffer, 0, databuffer.Length)
                Return Decrypteddata
            Catch ex As Exception
                MessageBox.Show("The Following Error(s) occured: " & ex.Message, "Error", MessageBoxButtons.OK)
            End Try
        End Function
    
        Public Function RC2Decrypt(ByVal Key As String, ByVal Data As String) As String
            Try
                Dim RC2 As RC2CryptoServiceProvider
                With RC2
                    .Mode = CipherMode.ECB
                    .UseSalt = True
                    .Key = System.Text.ASCIIEncoding.ASCII.GetBytes(Key)
                    .IV = .Key
                End With
                Dim RC2Decryptor As ICryptoTransform = RC2.CreateDecryptor
                Dim DataBuffer As Byte()
                Dim DecryptedData As Byte()
                DataBuffer = System.Text.ASCIIEncoding.ASCII.GetBytes(Data)
                DecryptedData = RC2Decryptor.TransformFinalBlock(DataBuffer, 0, DataBuffer.Length)
                Return ByteToString(DecryptedData)
            Catch ex As Exception
                MessageBox.Show("The Following Error(s) occured: " & ex.Message, "Error", MessageBoxButtons.OK)
            End Try
        End Function
    
        Public Function DESEncrypt(ByVal Key As String, ByVal Data As String) As String
            Try
                Dim DES As DESCryptoServiceProvider
                With DES
                    .Mode = CipherMode.ECB
                    .Key = System.Text.ASCIIEncoding.ASCII.GetBytes(Key)
                    .IV = .Key
                End With
                Dim DESEncryptor As ICryptoTransform = DES.CreateEncryptor
                Dim DataBuffer As Byte()
                Dim EncryptedData As Byte()
                DataBuffer = System.Text.ASCIIEncoding.ASCII.GetBytes(Data)
                EncryptedData = DESEncryptor.TransformFinalBlock(DataBuffer, 0, DataBuffer.Length)
                Return ByteToString(EncryptedData)
            Catch ex As Exception
                MessageBox.Show("The Following Error(s) occured: " & ex.Message, "Error", MessageBoxButtons.OK)
            End Try
        End Function
    
        Public Function DESEncrypt(ByVal key() As Byte, ByVal data() As Byte) As Byte()
            Try
                Dim DES As DESCryptoServiceProvider
                With DES
                    .Mode = CipherMode.ECB
                    .Key = key
                    .IV = .Key
                End With
                Dim DESEncryptor As ICryptoTransform = DES.CreateEncryptor
                Dim DataBuffer As Byte()
                Dim Encrypteddata As Byte()
                DataBuffer = data
                Encrypteddata = DESEncryptor.TransformFinalBlock(DataBuffer, 0, DataBuffer.Length)
                Return Encrypteddata
            Catch ex As Exception
                MessageBox.Show("The Following Error(s) occured: " & ex.Message, "Error", MessageBoxButtons.OK)
            End Try
        End Function
    
    
    
        Public Function DESDecrypt(ByVal Key As String, ByVal Data As String) As String
            Try
                Dim DES As DESCryptoServiceProvider
                With DES
                    .Mode = CipherMode.ECB
                    .Key = System.Text.ASCIIEncoding.ASCII.GetBytes(Key)
                    .IV = .Key
                End With
                Dim DESDecryptor As ICryptoTransform = DES.CreateDecryptor
                Dim DataBuffer As Byte()
                Dim DecryptedData As Byte()
                DataBuffer = System.Text.ASCIIEncoding.ASCII.GetBytes(Data)
                DecryptedData = DESDecryptor.TransformFinalBlock(DataBuffer, 0, DataBuffer.Length)
                Return ByteToString(DecryptedData)
            Catch ex As Exception
                MessageBox.Show("The Following Error(s) occured: " & ex.Message, "Error", MessageBoxButtons.OK)
            End Try
        End Function
    
        Public Function DESDecrypt(ByVal Key() As Byte, ByVal data() As Byte) As Byte()
            Try
                Dim DES As DESCryptoServiceProvider
                With DES
                    .Mode = CipherMode.ECB
                    .Key = Key
                    .IV = .Key
                End With
                Dim DESDecryptor As ICryptoTransform = DES.CreateDecryptor
                Dim DataBuffer As Byte()
                Dim DecryptedData As Byte()
                DataBuffer = data
                DecryptedData = DESDecryptor.TransformFinalBlock(DataBuffer, 0, DataBuffer.Length)
                Return DecryptedData
            Catch ex As Exception
                MessageBox.Show("The Following Error(s) occured: " & ex.Message, "Error", MessageBoxButtons.OK)
            End Try
        End Function
    
        Public Function TripleDESEncrypt(ByVal Key As String, ByVal Data As String) As String
            Try
                Dim TripleDes As TripleDESCryptoServiceProvider
                With TripleDes
                    .Mode = CipherMode.ECB
                    .Key = System.Text.ASCIIEncoding.ASCII.GetBytes(Key)
                    .IV = .Key
                End With
                Dim TripleDESEncryptor As ICryptoTransform = TripleDes.CreateEncryptor
                Dim DataBuffer As Byte()
                Dim EncryptedData As Byte()
                DataBuffer = System.Text.ASCIIEncoding.ASCII.GetBytes(Data)
                EncryptedData = TripleDESEncryptor.TransformFinalBlock(DataBuffer, 0, DataBuffer.Length)
                Return ByteToString(EncryptedData)
            Catch ex As Exception
                MessageBox.Show("The Following Error(s) occured: " & ex.Message, "Error", MessageBoxButtons.OK)
            End Try
        End Function
    
        Public Function TripleDESEncrypt(ByVal key As Byte(), ByVal data As Byte()) As Byte()
            Try
                Dim TripleDes As TripleDESCryptoServiceProvider
                With TripleDes
                    .Mode = CipherMode.ECB
                    .Key = key
                    .IV = .Key
                End With
                Dim TripleDESEncryptor As ICryptoTransform = TripleDes.CreateEncryptor
                Dim DataBuffer As Byte()
                Dim EncryptedData As Byte()
                DataBuffer = data
                EncryptedData = TripleDESEncryptor.TransformFinalBlock(DataBuffer, 0, DataBuffer.Length)
                Return EncryptedData
            Catch ex As Exception
                MessageBox.Show("The Following Error(s) occured: " & ex.Message, "Error", MessageBoxButtons.OK)
            End Try
        End Function
    
    
        Public Function TriplesDESDecrypt(ByVal key As Byte(), ByVal Data As Byte()) As Byte()
            Try
                Dim TripleDes As TripleDESCryptoServiceProvider
                With TripleDes
                    .Mode = CipherMode.ECB
                    .Key = key
                    .IV = .Key
                End With
                Dim TripleDESDecryptor As ICryptoTransform = TripleDes.CreateDecryptor
                Dim DataBuffer As Byte()
                Dim DecryptedData As Byte()
                DataBuffer = Data
                DecryptedData = TripleDESDecryptor.TransformFinalBlock(DataBuffer, 0, DataBuffer.Length)
                Return DecryptedData
            Catch ex As Exception
                MessageBox.Show("The Following Error(s) occured: " & ex.Message, "Error", MessageBoxButtons.OK)
            End Try
        End Function
        Public Function TripleDESDecrypt(ByVal Key As String, ByVal Data As String) As String
            Try
                Dim TripleDes As TripleDESCryptoServiceProvider
                With TripleDes
                    .Mode = CipherMode.ECB
                    .Key = System.Text.ASCIIEncoding.ASCII.GetBytes(Key)
                    .IV = .Key
                End With
                Dim TripleDESDecryptor As ICryptoTransform = TripleDes.CreateDecryptor
                Dim DataBuffer As Byte()
                Dim DecryptedData As Byte()
                DataBuffer = System.Text.ASCIIEncoding.ASCII.GetBytes(Data)
                DecryptedData = TripleDESDecryptor.TransformFinalBlock(DataBuffer, 0, DataBuffer.Length)
                Return ByteToString(DecryptedData)
            Catch ex As Exception
                MessageBox.Show("The Following Error(s) occured: " & ex.Message, "Error", MessageBoxButtons.OK)
            End Try
        End Function
    
    
        Public Function ByteToString(ByVal Bytes As Byte()) As String
            Return Convert.ToString(Bytes)
        End Function
    End Module
    Here is another module. This time its for setting debug privileges in the case that you dont have them.
    Code:
    Module SetDebugPrivileges
        Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, ByRef lpLuid As LUID) As Int32
        Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Int32, ByVal DisableAllPrivileges As Int32, ByRef NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Int32, ByRef PreviousState As TOKEN_PRIVILEGES, ByRef ReturnLength As Int32) As Int32
        Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Int32, ByVal DesiredAccess As Int32, ByRef TokenHandle As Int32) As Int32
        Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Int32
    
        Private Const SE_DEBUG_NAME As String = "SeDebugPrivilege"
        Private Const TOKEN_ADJUST_PRIVILEGES As Int32 = &H20
        Private Const TOKEN_QUERY As Int32 = &H8
        Private Const SE_PRIVILEGE_ENABLED As Int32 = &H2
    
    
        Private Structure LUID
            Dim LowPart As Int32
            Dim HighPart As Int32
        End Structure
    
        Private Structure LUID_AND_ATTRIBUTES
            Dim pLuid As LUID
            Dim Attributes As Int32
        End Structure
    
        Private Structure TOKEN_PRIVILEGES
            Dim PrivilegeCount As Int32
            Dim TheLuid As LUID
            Dim Attributes As Int32
        End Structure
    
    
        Public Function LoadPrivilege(ByVal Privilege As String) As Boolean
            On Error GoTo ErrHandler
            Dim ProcHandle As Int32
            Dim htoken As Int32
            Dim tokenPrivileges As TOKEN_PRIVILEGES
            Dim SEDebugNameValue As LUID
            Dim tkpNewButIgnored As TOKEN_PRIVILEGES
    
            ProcHandle = GetCurrentProcess()
            OpenProcessToken(ProcHandle, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, htoken)
            LookupPrivilegeValue("", Privilege, SEDebugNameValue)
            With tokenPrivileges
                .PrivilegeCount = 1
                .TheLuid = SEDebugNameValue
                .Attributes = SE_PRIVILEGE_ENABLED
            End With
            AdjustTokenPrivileges(htoken, False, tokenPrivileges, Len(tokenPrivileges), tkpNewButIgnored, Nothing)
            Return True
            Exit Function
    ErrHandler:
            Return False
        End Function
    
    End Module
    And here is a module for DLL injection on 32-Bit OS's
    Code:
    Module InjLib
    
        'CreateRemoteThread for calling loadlibrary in the target process address space to load our Dll
        Private Declare Function CreateRemoteThread Lib "kernel32.dll" (ByVal hProcess As Int32, ByVal lpThreadAttributes As Int32, ByVal dwStackSize As Int32, ByVal lpStartAddress As Int32, ByVal lpParameter As Int32, ByVal dwCreationFlags As Int32, ByRef lpThreadId As Int32) As Int32
        'VirtualAllocEx to allocate space in our target process so that we can write the path to our Dll
        Private Declare Function VirtualAllocEx Lib "kernel32.dll" (ByVal hProcess As Int32, ByVal lpAddress As Int32, ByVal dwSize As Int32, ByVal flAllocationType As Int32, ByVal flProtect As Int32) As Int32
        'WriteProcessMemory to write the path to our Dll in the target process address space
        Private Declare Function WriteProcessMemory Lib "kernel32.dll" (ByVal hProcess As Int32, ByVal lpBaseAddress As Int32, ByVal lpBuffer As String, ByVal nSize As Int32, ByRef lpNumberOfBytesWritten As Int32) As Int32
        'VirtualFreeEx to clean up when done
        Private Declare Function VirtualFreeEx Lib "kernel32.dll" (ByVal hProcess As Int32, ByVal lpAddress As Int32, ByRef dwSize As Int32, ByVal dwFreeType As Int32) As Int32
        'Get ModuleHandle to get a handle to LoadLibrary so we can use the Handle to get its Address in the target Process' space
        Private Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Int32
        'GetProcAddress to get the address that LoadLibraryA resides at
        Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Int32, ByVal lpProcName As String) As Int32
        'OpenProcess to get a handle to our target process and open it with the rights we require
        Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Int32, ByVal bInheritHandle As Int32, ByVal dwProcessId As Int32) As Int32
        'CloseHandle to Close all open handles we needed
        Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Int32) As Int32
    
    
        Private Const Create_Suspended As Int32 = &H4 'To freeze process when we call createremotethread
        Private Const process_vm_operation As Int32 = &H8 ' Access Rights
        Private Const process_create_thread As Int32 = &H2
        Private Const process_suspend_resume As Int32 = &H800 
        Private Const process_vm_write As Int32 = &H20 ' Access Rights 
        Private Const process_vm_read As Int32 = &H10 ' Access Rights
        Private Const mem_commit As Int32 = &H1000 ' What to do with memory from VirtualallocEx
        Private Const mem_release As Int32 = &H8000 ' Tells the Computer to free memory when called with VirtualFree
        Private Const page_readwrite As Int32 = &H4 
    
    
        Private Access As Int32 = process_vm_read Or process_vm_write Or process_vm_operation Or process_create_thread
    
        Public Function InjectDlls(ByVal ProcessName As String, ByVal DllPaths() As String) As int32
            Dim ProcHandle As Int32 ' Handle to Target Process
            Dim DllVirtLoc As Int32 ' Address of Dll Path
            Dim Inject As Int32     ' Error Checking
            Dim CreateThread As Int32 ' Error Checking
            Dim ThreadID As Int32   ' Handle to our Created Thread
            Dim MHandle As Int32    ' Handle to Kernel32.dll
            Dim i As Int32          ' Counter
            Dim TargetProc As Process() = Process.GetProcessesByName(ProcessName) ' Gets Process info
    
            MHandle = GetModuleHandle("Kernel32.dll") ' Gets Handle to Kernel32.dll
            If MHandle = 0 Then
                MessageBox.Show("Could not get a handle to Kernel32.dll", "Error", MessageBoxButtons.OK)
                Return 0
                Exit Function
            Else
                ProcHandle = OpenProcess(Access, 0, TargetProc(0).Id) ' Gets Handle to Process and opens with our desired rights
                If ProcHandle = 0 Then
                    MessageBox.Show("Could not get a handle to Target process", "Error", MessageBoxButtons.OK)
                    CloseHandle(MHandle) ' Closes handle to kernel32.dll because we could not open our target process
                    Return 0
                    Exit Function
                Else
                    For i = 0 To UBound(DllPaths) - 1
                        System.Threading.Thread.Sleep(100) ' Our Delay for initial Injection and subsequent injection
                        DllVirtLoc = VirtualAllocEx(ProcHandle, 0, DllPaths(i), mem_commit, page_readwrite) ' Allocates Space in Target Address Space
                        If DllVirtLoc = 0 Then
                            MessageBox.Show("Could not allocate space in target process", "Error", MessageBoxButtons.OK)
                            CloseHandle(MHandle) ' Closes Handle to Kernel32.dll because we could not allocate space
                            CloseHandle(ProcHandle) ' Closes Handle to Process becausewe could not allocate the space
                        Else
                            Inject = WriteProcessMemory(ProcHandle, DllVirtLoc, DllPaths(i), DllPaths(i).Length + 1, Nothing) ' Writes our Dll's path to Targets Address Space
                            If Inject = 0 Then
                                MessageBox.Show("Could not write to process' address space", "Error", MessageBoxButtons.OK)
                                VirtualFreeEx(ProcHandle, DllVirtLoc, 0, mem_release) ' Free Allocated Space because writing failed
                                CloseHandle(MHandle) ' Close handle to kernel32.dll because writing failed
                                CloseHandle(ProcHandle) ' Close Handle to Process because writing failed
                            Else
                                CreateThread = CreateRemoteThread(ProcHandle, 0, 0, GetProcAddress(MHandle, "LoadLibraryA"), DllVirtLoc, 0, ThreadID)
                                If CreateThread = 0 Then
                                    MessageBox.Show("Could not create remote thread", "Error", MessageBoxButtons.OK)
                                    VirtualFreeEx(ProcHandle, DllVirtLoc, 0, mem_release) ' Frees Allocated space because we could not create our remote thread
                                    CloseHandle(MHandle) ' Closes Handle to Kernel32.dll because we could not create our remote thread
                                    CloseHandle(ProcHandle) ' Closes Handle to Target Process because we could not create our remote thread
                                    Return 0
                                    Exit Function
                                Else
                                    VirtualFreeEx(ProcHandle, DllVirtLoc, 0, mem_release) ' Frees Allocated Space because we are done
                                End If
                            End If
                        End If
                        Return 1 ' Returns 1 for Success 0 for failure declare recieving variable as array
                    Next i
                    CloseHandle(MHandle) ' Close Handle to Kernel32.dll because we are done
                    CloseHandle(ProcHandle) ' Close Handle to Target Process because we are done
                End If
            End If
        End Function
    
    
    End Module
    Last edited by wtfiwantthatname; 06-09-2010 at 10:07 AM.
    "I don't believe in an afterlife, so I don't have to spend my whole life fearing hell, or fearing heaven even more. For whatever the tortures of hell, I think the boredom of heaven would be even worse." - Isaac Asimov

  22. The Following 3 Users Say Thank You to wtfiwantthatname For This Useful Post:

    biohazardzz (06-29-2011),Ninja® (09-12-2011),Tony Stark` (02-17-2011)

  23. #12
    Hassan's Avatar
    Join Date
    May 2010
    Gender
    male
    Location
    System.Threading.Tasks
    Posts
    4,764
    Reputation
    495
    Thanks
    2,132
    My Mood
    Dead
    Extracting Youtube Download Link:

    First add this function:

    Code:
    Function GetPage(ByVal pageUrl As String) As String
            Dim s As String = ""
            Try
                Dim request As HttpWebRequest = WebRequest.Create(pageUrl)
                Dim response As HttpWebResponse = request.GetResponse()
                Using reader As StreamReader = New StreamReader(response.GetResponseStream())
                    s = reader.ReadToEnd()
                End Using
            Catch ex As Exception
                Debug.WriteLine("FAIL: " + ex.Message)
            End Try
            Return s
        End Function
    Then this sub-procedure:
    'Remember to give credits to FlameXaber
    Code:
    Sub DownloadVideo(ByVal videoLink As String)
            Dim x As String = GetPage(videoLink)
            Dim first As String = "delete yt.preload.videoConnection"
            Dim second As String = "img = null"
            Dim f1 As Integer = x.IndexOf(first) + first.Length + 1
            Dim f2 As Integer = x.IndexOf(second, f1) + 1
            Dim final As String = Mid(x, f1, f2 - f1)
            Dim q1 As Integer = final.IndexOf("};") + 3
            Dim q2 As Integer = final.IndexOf(";", q1) + 1
            Dim final2 As String = Mid(final, q1, q2 - q1)
            final2 = final2.Replace("img.src = ", "")
            final2 = final2.Replace("'", "")
            final2 = final2.Replace("https:\/\/", "https://")
            final2 = final2.Replace("\/", "/")
            final2 = final2.Replace("generate_204", "videoplayback")
            final2 = final2.Trim
            Dim ff As New SaveFileDialog
            ff.Filter = "FLV FILE (*.flv)|*.flv"
            If Not ff.ShowDialog = Windows.Forms.DialogResult.Cancel Then
                My.Computer.Network.DownloadFile(final2, ff.FileName, "", "", True, 100000, True)
            End If
        End Sub
    Then call it from whereever you want like:

    Code:
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
            DownloadVideo("https://www.youtube.com/watch?v=a81eP2E8MEQ")
        End Sub
    Last edited by Hassan; 02-08-2012 at 11:10 AM.

  24. The Following 5 Users Say Thank You to Hassan For This Useful Post:

    biohazardzz (06-29-2011),Jason (06-10-2010),Lyoto Machida (02-18-2011),Ninja® (09-12-2011),Tony Stark` (02-17-2011)

  25. #13
    Hassan's Avatar
    Join Date
    May 2010
    Gender
    male
    Location
    System.Threading.Tasks
    Posts
    4,764
    Reputation
    495
    Thanks
    2,132
    My Mood
    Dead
    Snap Form To Screen Borders:

    This feature allows you to drag your window near the screen border and have the window automatically get pulled towards that border like a magnet. It's Perry Marchant's implementation of VB.NET.

    ■ Import this namespace to the form:

    [highlight=vb.net]Imports system****ntime.InteropServices[/highlight]

    ■ Declare the following:

    [highlight=vb.net] Private Const mSnapOffset As Integer = 35
    Private Const WM_WINDOWPOSCHANGING As Integer = &H46

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure WINDOWPOS
    Public hwnd As IntPtr
    Public hwndInsertAfter As IntPtr
    Public x As Integer
    Public y As Integer
    Public cx As Integer
    Public cy As Integer
    Public flags As Integer
    End Structure
    [/highlight]

    ■ After that add these sub-procedures to the program:
    [highlight=vb.net]Protected Overrides Sub WndProc(ByRef m As Message)
    ' Listen for operating system messages
    Select Case m.Msg
    Case WM_WINDOWPOSCHANGING
    SnapToDesktopBorder(Me, m.LParam, 0)
    End Select

    MyBase.WndProc(m)
    End Sub

    Public Shared Sub SnapToDesktopBorder(ByVal clientForm As Form, ByVal LParam As IntPtr, ByVal widthAdjustment As Integer)
    If clientForm Is Nothing Then
    ' Satisfies rule: Validate parameters
    Throw New ArgumentNullException("clientForm")
    End If

    ' Snap client to the top, left, bottom or right desktop border
    ' as the form is moved near that border.

    Try
    ' Marshal the LPARAM value which is a WINDOWPOS struct
    Dim NewPosition As New WINDOWPOS
    NewPosition = CType(Runtime.InteropServices.Marshal.PtrToStructu re( _
    LParam, GetType(WINDOWPOS)), WINDOWPOS)

    If NewPosition.y = 0 OrElse NewPosition.x = 0 Then
    Return ' Nothing to do!
    End If

    ' Adjust the client size for borders and caption bar
    Dim ClientRect As Rectangle = clientForm.RectangleToScreen(clientForm.ClientRect angle)
    ClientRect.Width += SystemInformation.FrameBorderSize.Width - widthAdjustment
    ClientRect.Height += (SystemInformation.FrameBorderSize.Height + SystemInformation.CaptionHeight)

    ' Now get the screen working area (without taskbar)
    Dim WorkingRect As Rectangle = Screen.GetWorkingArea(clientForm.ClientRectangle)

    ' Left border
    If NewPosition.x >= WorkingRect.X - mSnapOffset AndAlso _
    NewPosition.x <= WorkingRect.X + mSnapOffset Then
    NewPosition.x = WorkingRect.X
    End If

    ' Get screen bounds and taskbar height (when taskbar is horizontal)
    Dim ScreenRect As Rectangle = Screen.GetBounds(Screen.PrimaryScreen.Bounds)
    Dim TaskbarHeight As Integer = ScreenRect.Height - WorkingRect.Height

    ' Top border (check if taskbar is on top or bottom via WorkingRect.Y)
    If NewPosition.y >= -mSnapOffset AndAlso _
    (WorkingRect.Y > 0 AndAlso NewPosition.y <= (TaskbarHeight + mSnapOffset)) OrElse _
    (WorkingRect.Y <= 0 AndAlso NewPosition.y <= (mSnapOffset)) Then
    If TaskbarHeight > 0 Then
    NewPosition.y = WorkingRect.Y ' Horizontal Taskbar
    Else
    NewPosition.y = 0 ' Vertical Taskbar
    End If
    End If

    ' Right border
    If NewPosition.x + ClientRect.Width <= WorkingRect.Right + mSnapOffset AndAlso _
    NewPosition.x + ClientRect.Width >= WorkingRect.Right - mSnapOffset Then
    NewPosition.x = WorkingRect.Right - (ClientRect.Width + SystemInformation.FrameBorderSize.Width)
    End If

    ' Bottom border
    If NewPosition.y + ClientRect.Height <= WorkingRect.Bottom + mSnapOffset AndAlso _
    NewPosition.y + ClientRect.Height >= WorkingRect.Bottom - mSnapOffset Then
    NewPosition.y = WorkingRect.Bottom - (ClientRect.Height + SystemInformation.FrameBorderSize.Height)
    End If

    ' Marshal it back
    Runtime.InteropServices.Marshal.StructureToPtr(New Position, LParam, True)
    Catch ex As ArgumentException
    End Try
    End Sub[/highlight]

    You're done
    Last edited by Jason; 02-15-2011 at 09:23 PM.

  26. The Following 4 Users Say Thank You to Hassan For This Useful Post:

    Blubb1337 (06-11-2010),Lolland (06-11-2010),Ninja® (09-12-2011),Tony Stark` (02-17-2011)

  27. #14
    MJLover's Avatar
    Join Date
    Feb 2010
    Gender
    male
    Location
    Neverland
    Posts
    759
    Reputation
    33
    Thanks
    110
    My Mood
    Cheerful
    It's a piece of snippet ppl2pass requested me. I was unable to deliver him on MSN coz of internet issues:


    Code:
    Function StringToHex(ByVal text As String) As String
            Dim hex As String = Nothing
            For i As Integer = 0 To text.Length - 1
                hex &= Asc(text.Substring(i, 1)).ToString("x").ToUpper
            Next
            Return hex
        End Function
    Use this function to convert each value to hex:

    Code:
    Sub conversion(ByVal s As String)
            Dim n As String = s
            Dim x As Boolean = False
            Dim y As Boolean = False
            Dim str As String = ""
            For i As Integer = 1 To n.Length
                Dim c As String = Mid(n, i, 1)
                If c = "[" Then
                    x = True
                End If
                If c = "]" Then
                    If x Then
                        x = False
                        y = True
                        str += "]" & vbCrLf
                    End If
                End If
                If x Then
                    str += c
                End If
            Next
            Dim g() As String = str.Split(ChrW(10))
            If g.Length < 1 Then
                Exit Sub
            End If
            For Each q As String In g
                If Not q = vbNullString Then
    q=q.replace("[","")
    q=q.replace("]","")
                    MsgBox(StringToHex(q))
                End If
            Next
        End Sub
    Last edited by MJLover; 06-27-2010 at 12:06 AM.

  28. The Following 3 Users Say Thank You to MJLover For This Useful Post:

    Lolland (06-26-2010),Ninja® (09-12-2011),Tony Stark` (02-17-2011)

  29. #15
    Blubb1337's Avatar
    Join Date
    Sep 2009
    Gender
    male
    Location
    Germany
    Posts
    5,915
    Reputation
    161
    Thanks
    3,108
    Calculating the md5 checksum of a file(used it for my md5 updater):

    Code:
    Public Function MD5File(ByVal filepath As String) As String
    
            ' open file (as read-only)
            Using reader As New System.IO.FileStream(filepath, IO.FileMode.Open, IO.FileAccess.Read)
                Using md5 As New System.Security.Cryptography.MD5CryptoServiceProvider
    
                    ' hash contents of this stream
                    Dim hash() As Byte = MD5.ComputeHash(reader)
    
                    ' return formatted hash
                    Return ByteArrayToString(hash)
    
                End Using
            End Using
    
        End Function
    
        ' utility function to convert a byte array into a hex string
        Private Function ByteArrayToString(ByVal arrInput() As Byte) As String
    
            Dim sb As New System.Text.StringBuilder(arrInput.Length * 2)
    
            For i As Integer = 0 To arrInput.Length - 1
                sb.Append(arrInput(i).ToString("X2"))
            Next
    
    
    
            Return sb.ToString().ToLower
    
        End Function
    Code:
    dim s as string = md5file("C:\nub.txt")



  30. The Following User Says Thank You to Blubb1337 For This Useful Post:

    Ninja® (09-12-2011)

Page 1 of 8 123 ... LastLast