[Leeched] Visual Basic Tutorials

[MJLover]

#1: How to Flip Windows
Works on Windows Vista And Windows 7, and if Aero is on.

'This will Flip all the windows

Shell("C:\Windows\System32\rundll32.exe DwmApi #105")

#2: Open / Close CD ROM Drive

Start by declaring a function. This function is a call from OS.

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

Then to Open the CD Door:

Public Sub OpenCDDoor()
Dim retval As Long
retval = mciSendString("set CDAudio door open", "", 0, 0)
End Sub

To Close the CD Door:

Public Sub CloseCDDoor()
Dim retval As Long
retval = mciSendString("set CDAudio door closed", "", 0, 0)
End Sub

#3: Turn Monitor to Off/On/LowState

First import this namespace:

Imports System.Runtime.InteropServices

Define constants:

Public WM_SYSCOMMAND As Integer = &H112
Public SC_MONITORPOWER As Integer = &HF170

Then declare a windows api function:

<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

To Turn On:

Public Sub TurnOn()
Dim x As Int32
'Main is the main form of the application. You can change it to any form of the application.
x = Main.Handle
SendMessage(x, WM_SYSCOMMAND, SC_MONITORPOWER, -1)
End Sub

To Turn Off:

Public Sub TurnOff()
Dim x As Int32
'Main is the main form of the application. You can change it to any form of the application.
x = Main.Handle
SendMessage(x, WM_SYSCOMMAND, SC_MONITORPOWER, 2)
End Sub

Put it to Lowstate:

Public Sub LowState()
Dim x As Int32
'Main is the main form of the application. You can change it to any form of the application.
x = Main.Handle
SendMessage(x, WM_SYSCOMMAND, SC_MONITORPOWER, 1)
End Sub

#4: Set Desktop Wallpaper

First import this namespace:

Imports System.Drawing.Imaging

Then declare a windows API:

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

'Create a new picture box:

Dim pic As New PictureBox

Finally call the following code to change the wallpaper:

Dim ImageToSet  As String="Full location of the image"
Dim imagePath1 As String = Application.StartupPath & "\wall.bmp"
pic.Image = Image.FromFile(ImageToSet)
pic.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)

#5: Toggle NumLock/CapsLock/ScrollLock

'Constants to be used:

Private Const VK_NUMLOCK As Integer = &H90
Private Const VK_SCROLL As Integer = &H91
Private Const VK_CAPITAL As Integer = &H14
Private Const KEYEVENTF_EXTENDEDKEY As Integer = &H1
Private Const KEYEVENTF_KEYUP As Integer = &H2

API Function:

Private Declare Sub keybd_event Lib "user32" ( _
ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Integer, _
ByVal dwExtraInfo As Integer _
)

Now to toggle the Numlock key, use:

Public Sub NumLock()
keybd_event(VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0)
' Release the key
keybd_event(VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
End Sub

To toggle the CapsLock key, use:

Public Sub CapsLock()
keybd_event(VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0)
' Release the key
keybd_event(VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
End Sub

To toggle the ScrollLock key, use:

Public Sub ScrollLock()
keybd_event(VK_SCROLL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0)
' Release the key
keybd_event(VK_SCROLL, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
End Sub

Note: You can check the state of the NumLock/CapsLock/ScrollLock before toggling them:

'This will turn on NumLock if it is turned off.
If Not My.Computer.Keyboard.NumLock Then
NumLock()
End If

I will keep posting new tutorials from time to time.

Thanks and Regards,
Hassan

[MJLover]

A custom Encode/Decoder:

Declare an integer:

Dim x as integer

To Encode:

Function Encode(ByVal str As String)
Dim res As String = ""
If Not str = vbNullString Then
For i As Integer = 0 To str.Length - 1
If x = 2 Then
Dim n As Integer = Asc(Mid(str, i + 1, 1)) + x
res += Chr(n)
x = 4
ElseIf x = 4 Then
Dim n As Integer = Asc(Mid(str, i + 1, 1)) + x
res += Chr(n)
x = 1
Else
Dim n As Integer = Asc(Mid(str, i + 1, 1)) + x
res += Chr(n)
x = 2
End If
Next
End If
x = 2
Return res
End Function

To Decode:

Function Decode(Str as string)
Dim res As String = ""
If Not str = vbNullString Then
For i As Integer = 0 To str.Length - 1
If x = 2 Then
Dim n As Integer = Asc(Mid(str, i + 1, 1)) - x
res += Chr(n)
x = 4
ElseIf x = 4 Then
Dim n As Integer = Asc(Mid(str, i + 1, 1)) - x
res += Chr(n)
x = 1
Else
Dim n As Integer = Asc(Mid(str, i + 1, 1)) - x
res += Chr(n)
x = 2
End If
Next
End If
x = 2
Return res
End Function

Example:

Msgbox(Encode("JOIN THIS CHAT ABOUT VB ;)"))
'Will return "LSJP$UJMT"GICX!CFPWX!XF!=-"

Msgbox(Decode("LSJP$UJMT"GICX!CFPWX!XF!=-"))
'Will return "JOIN THIS CHAT ABOUT VB ;)"

You can enhance it using advanced string parsing techniques

Regards

[Blubb1337]

Selfwritten?

Thanks for sharing.

[MJLover]

Encoder/Decoder is self written.

The API tutorials aren't mine !!

And you're welcome !

[Blubb1337]

Give credits then :P

[MJLover]

This is how we can extract the Youtube Title:

First we need to import the following namespaces:

Imports System.Net
Imports System.IO

Then add this function to the application. This function gets the source code of any webpage.

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
Throw New Exception("Failed to get source code !!!")
End Try
Return s

Now we need to parse the source code to extract the data we need:

First we extract the Video Title using the following function:
'This function is optional and is not needed if you want to just download the video.

Function GetTitle(ByVal URL As String)
Dim result As String = "Couldn't extract title !!"
Try
If Not URL = vbNullString Then
Dim c As String = GetPage(URL)
Dim a1 As Integer = c.IndexOf("<title>") + 8
Dim a2 As Integer = c.IndexOf("</title>", a1)
Dim title As String = Mid(c, a1, a2 - a1).Replace("YouTube", "")
title = title.Trim
title = title.Remove(0, 2)
result = title
End If
Catch ex As Exception
End Try
Return result
End Function

Then we use the following function to extract the video's download link:

Function getDownloadLink(ByVal URL As String)
Dim result As String = "Couldn't extract link !!"
Try
If Not URL = vbNullString Then
Dim c As String = GetPage(URL)
Dim a1 As Integer = c.IndexOf("'VIDEO_ID': '") + 14
Dim a2 As Integer = c.IndexOf("'", a1) + 1
Dim id As String = Mid(c, a1, a2 - a1)
Dim a3 As Integer = c.IndexOf("""t"": """) + 7
Dim a4 As Integer = c.IndexOf("""", a3) + 1
Dim t As String = Mid(c, a3, a4 - a3)
result = id & "&t=" & t
End If
Catch ex As Exception
End Try
Return result
End Function

This is all the code.

Example:

System.Diagnostics.Process.Start("https://www.youtube.com/get_video?video_id=" & getDownloadLink("https://www.youtube.com/watch?v=u_0q0kL03Lg"))

If you want to download the video in high quality, insert "&fmt=18" or in HD then insert "&fmt=22" at the end of the Video URL.

Hope this helps !!

Regards

[MJLover]

I googled all these functions long time ago so I don't know to whom these actually belong. I think originally they belong to Microsoft. If so, credits for API tutorials goes to Microsoft !!

[NextGen1]

These are all standard MSDN , Not self written code at all, The ones that are written

"anyone with DIM"

are all leeched. (C&P)

But it doesn't matter, thanks for sharing.

[MJLover]

@[MPGH]NextGen1:

I don't understand "anyone with DIM" are all leeched. (C&P) !!!

What it means ???

Anywayz here's a Gmail client:

Create a GUI like the one shown below:


Then import this namespace:

Imports System.Net.Mail

Create a new listbox:

Dim attachments As New ListBox

If you want attachments in your mail, then attach the following code to the attachment button:

OFD.Filter = "All Files (*.*)|*.*"
If Not OFD.ShowDialog = Windows.Forms.DialogResult.Cancel Then
For Each n As String In OFD.FileNames
attachments.Items.Add(n)
Next
End If
lblAtt.Text = "Attachments [" & attachments.Items.Count & "]:"

Finally attach the following code to the send button:

'Check the textboxes:

If Not senderID.Text.EndsWith("@gmail.com") Then
MsgBox("You must enter your Gmail ID to send an email.")
Exit Sub
End If
If pass.Text = vbNullString Then
MsgBox("You must enter your password for the given ID.")
Exit Sub
End If
If recievers.Text = vbNullString Then
MsgBox("Please enter recipients of the email.")
Exit Sub
End If
If subj.Text = vbNullString Then
subj.Text = "No Subject"
End If
If emailbody.Text = vbNullString Then
emailbody.Text = "No Body"
End If

'If there are any attachments, calculate their size:
Dim attchsz As Integer = 0
If attachments.Items.Count > 0 Then
For Each n As String In attachments.Items
attchsz += CInt(My.Computer.FileSystem.GetFileInfo(n).Length / 1024 / 1024)
Next
End If
If attchsz > 10 Then
MsgBox("You have crossed the size limit of the email attachment.")
Exit Sub
End If

'Try to send the mail:

Try

'Create a new mail message:
Dim msg As New MailMessage(senderID.Text, recievers.Text, subj.Text, emailbody.Text)

'If there are any carbon copies, attach them:
If Not CCs.Text = vbNullString Then
msg.CC.Add(CCs.Text)
End If

'If there are any blind carbon copies, attach them:
If Not BCCs.Text = vbNullString Then
msg.Bcc.Add(BCCs.Text)
End If

'If there are any attachments, attach them:
If attachments.Items.Count > 0 Then
For Each z As String In attachments.Items
msg.Attachments.Add(New Net.Mail.Attachment(z))
Next
End If

'Now enter the client info for your email.
'I got the Google's smtp server and port number on the web.

Dim client As New SmtpClient("smtp.gmail.com", 587)

'Validate user...
Dim Credentials As New System.Net.NetworkCredential(senderID.Text, pass.Text)
client.Credentials = Credentials

'Some sites require secure sockets layer connection. Google is one of them, so enable the ssl:

client.EnableSsl = True

'Finally send the message:
client.Send(msg)

Catch ex As Exception
'If error occurs, report it to the user:
MsgBox("Error sending email !!" & vbCrLf & ex.Message)
Exit Sub
End Try
'If the mail is sent successfully, inform the user.
MsgBox("Your email has been sent.")

Hope this helps !!

Regards

[NextGen1]

I determine leeched code based on 'Comments , Declarations, Decorations, You admit you got all these from google but yet you give no credit, your above gmail code matches tutorials online almost word for word .

I will close this thread if you don't give credit

If You get it from MSDN , Mark it MSDN, If you get it form codeproject, give credit,
last thing we want over here at mpgh.net is to be known as leechers or anything similar
,
'If for some reason, that is not ok with you, or you want to debate the matter, PM, don't discuss it further in here.

Read Updated Rules
https://www.mpgh.net/forum/33-visual-...2-24-10-a.html

[MJLover]

I was just asking that what leechers means, and have I already told you that I just remember that I googled the API functions a long time ago. And now i don't know where google linked me !!!

Plus the gmail code above is written by me (I just got the smtp server and port number from web as I mentioned), 40-50 minutes ago. I really don't get how it matched word by word !! ??????????? That is impossible !!!

Regards

[NextGen1]

'If for some reason, that is not ok with you, or you want to debate the matter, PM, don't discuss it further in here.

What part of that did you not get?

Fact: Most of these are straight off MSDN site, The above is very similar, but it doesn't matter, just remember to give credit

This isn't a debate, I am sorry if it seems I am being offensive, Just keeping my section clean, and I like to keep the rules followed as well.

And we don't need a whole thread that essentially is MSDN, We all know where to go for that....

/Closed for being just like MSDN Library, if you don't know how to get there.

https://msdn.microsof*****m/en-us/default.aspx
You can get all these codes there