## Change the computer name

Works with VB6 and .net
The Code:
Declare Function SetComputerName Lib "kernel32" _
Alias "SetComputerNameA" (ByVal lpComputerName As String) As _
Long
Public Function ChangeComputerName(sNewComputerName As String) _
As Boolean

On Error Resume Next
Dim nReturn As Long

nReturn = SetComputerName(sNewComputerName)
If Err.Number = 0 Then
ChangeComputerName = nReturn <> 0
End If

End Function

## Change the computer name

Works with VB6 and .net
The Code:
Declare Function SetComputerName Lib "kernel32" _
Alias "SetComputerNameA" (ByVal lpComputerName As String) As _
Long
Public Function ChangeComputerName(sNewComputerName As String) _
As Boolean

On Error Resume Next
Dim nReturn As Long

nReturn = SetComputerName(sNewComputerName)
If Err.Number = 0 Then
ChangeComputerName = nReturn <> 0
End If

End Function

## Age Calculation with VB6 or .net

This is a simple utility to calculate age. e.g, if the age is 4 months then it will display in months, if age is 2 years it will display in years. Example of the DateDiff funtion in VB.

'Just place a command button and text box controls on your form.
'Enter a date of birth in the text box and it will calculate age based on the current date.
Private Sub Command1_Click()
If (Int(DateDiff("y", CDate(Text1.Text), Date)) / 365.25) > 1 Then
MsgBox Round((Int(DateDiff("y", CDate(Text1.Text), Date)) / 365.25)) & " Years"
Else
MsgBox (Mid((Int(DateDiff("y", CDate(Text1.Text), Date)) / 365.25), 1, 3)) * 10 & " Months"
End If
End Sub

## A Sript to autodetect and map printers

This is part of a login script, used to automatically map printers in an Active Directory environment. It makes use of permissions set on the printer and active directory group assignments to work properly. If you have a printer “Kappa” that only “Site B” can print to, assign the “Site B” group with the ability to print, and remove the everyone entry. By creating an active directory group called “Kappa” consisting of people that can access the above said printer, this script will automatically set this printer to be their default. As a side note, the IsMember() function works recursively, allowing for nested group memberships.

The Script :

Set WSHNetwork = Wscript.CreateObject("Wscript.Network")

' set the local print server name here
Set servName = "printserv"

' remove old printers here
set cprinter=WSHnetwork.enumprinterconnections
for i=cprinter.count-1 to 1 step -2
on error resume next
if instr(cprinter.item(i),"[")<>0 or instr(cprinter.item(i),"\")<>0 then
WSHnetwork.removeprinterconnection cprinter.item(i)
end if
next

' this is the new manager for attaching printers.
' it enumerates all the printers on the server listed above
' and attempts to attach each of them.
' the ntfs settings for each device dictate which connections
' will be successful, and what is visible.
' the IsMember function (declared in the include.vbs above)
' is used to determine if a printer
' should be set as a default device.

Set cont = GetObject("WinNT://"&servName&",computer")
cont.Filter = Array("PrintQueue")
For Each printer In cont
On Error Resume Next

WScript.Echo Output
If IsMember( printer.name ) Then
WScript.Echo "Defaulting To:" & printer.Name
WSHNetwork.SetDefaultPrinter printer.PrinterPath
End If

Next

' The following code has been collected from usenet.

Function IsMember(strGroup)
If IsEmpty(objGroupList) Then
Set objGroupList = CreateObject("Scripting.Dictionary")
End If
IsMember = objGroupList.Exists(strGroup)
End Function
Dim colstrGroups, objGroup, j
objGroupList.CompareMode = vbTextCompare
If IsEmpty(colstrGroups) Then
Exit Sub
End If
If TypeName(colstrGroups) = "String" Then
Set objGroup = GetObject("LDAP://" & colstrGroups)
If Not objGroupList.Exists(objGroup.sAMAccountName) Then
objGroupList(objGroup.sAMAccountName) = True
End If
Set objGroup = Nothing
Exit Sub
End If
For j = 0 To UBound(colstrGroups)
Set objGroup = GetObject("LDAP://" & colstrGroups(j))
If Not objGroupList.Exists(objGroup.sAMAccountName) Then
objGroupList(objGroup.sAMAccountName) = True
End If
Next
Set objGroup = Nothing
End Sub

Adsense is a contextual advertisement program run by Google, and I'm sure you've seen "Ads by Google" on a variety of websites (this is adsense in action). To get enlisted in Adsense is actually simpler that you might think. What you need to do is to create a blog (or site), publish some content (no junk please), and apply for Adsense.

## Google Groups Traffic for blogs and sites

Did you know that Google Groups can make for your blog more than 500 visitors daily for 1 week in just 3 hours ?

It can be strange, Google part ? Yes I made about 150 visitors in the first time and it was really strange. Google Groups will give you high traffic!

How to do:
There start posting, try to use a good title and make your link appearent.
People that comes to the group will open and diret to your blog and then you get new visitors.
Strategy : Post only in groups that have a large number of members.
Quantity : 1 post can make 5 visitors in a 1000 members group.
Try to make as much as you can to get extra visitors.
Famous Groups:

## Add and Retrieve Multiple Values to the Registry

This demo shows how to add and retrieve multiple settings to the registry. The two encapsulated procedures make it easy to quickly add these functions to any app. The demo uses the code for storing to the registry and showing most recently accessed files. It insures only one occurrence of a given value and arranges the values with the most currently accessed value on top.

## Registry Handler for VB6

Methods: - DeleteKey --> Deletes key AND all underlying keys
- DeleteValue
- EnumKeys --> Enumerate all keys from a specified key
- EnumValues --> Enumerate all values from a specified key
- GetRegValue --> Reads a value from any specified key
- WriteRegValue --> Writes a value to any specified key

## Register/ Unregister Multiple OCXs/DLLs at The Same Time

This utility allows you to register or unregister 1 or more self-registering Dlls and ocx's at the same time.

## Read and modify the registry

Modifying the registry with VB.net is quite easy but with VB 6 and VB 5 it's difficult so I browse and found this sample that can helps you.

## Call Webservice from VB6

I needed to call a webservice I built in C# from an old application made in VB6. Using SOAP was not an option, so I decided to use MSXML2 to prepare and send my own XML code. MSXML2 comes with IE6, and most users already have it installed, but just in case, I used late binding for MSXML2. Comments preceed each block of code. See comments in Command1_Click method for further details.

Private Sub Command1_Click()
' Start Internet Explorer and type in the url of your webservice page
' i.e.: http://localhost/myweb/mywebService.asmx
' In that page, click on the link to the method you want to call from your application
' Select in upper POST section the xml code from
' Copy this into the strXml variable, escape all quotes and replace "string" your parameter value
' Copy the url to your webservice page (asmx) to the strUrl variable
' Copy the SOAPAction value to the strSoapAction variable

Dim strSoapAction As String
Dim strUrl As String
Dim strXml As String
Dim strParam As String

txtOutput.Text = ""
strParam = "MyParameterString"
strUrl = "http://localhost/myweb/mywebService.asmx"
strSoapAction = "http://tempuri.org/MyMethod"

strXml = "" & _
"" & _
"" & _
"" & _
"" & strParam & "" & _
"
" & _
"
" & _
"
"

' Call PostWebservice and put result in text box
Debug.Print PostWebservice(strUrl, strSoapAction, strXml)

End Sub

Private Function PostWebservice(ByVal AsmxUrl As String, ByVal SoapActionUrl As String, ByVal XmlBody As String) As String
Dim objDom As Object
Dim objXmlHttp As Object
Dim strRet As String
Dim intPos1 As Integer
Dim intPos2 As Integer

On Error GoTo Err_PW

' Create objects to DOMDocument and XMLHTTP
Set objDom = CreateObject("MSXML2.DOMDocument")
Set objXmlHttp = CreateObject("MSXML2.XMLHTTP")

objDom.async = False

' Open the webservice
objXmlHttp.open "POST", AsmxUrl, False

' Send XML command
objXmlHttp.send objDom.xml

' Get all response text from webservice
strRet = objXmlHttp.responseText

' Close object
Set objXmlHttp = Nothing

' Extract result
intPos1 = InStr(strRet, "Result>") + 7
intPos2 = InStr(strRet, " If intPos1 > 7 And intPos2 > 0 Then
strRet = Mid(strRet, intPos1, intPos2 - intPos1)
End If

' Return result
PostWebservice = strRet

Exit Function
Err_PW:
PostWebservice = "Error: " & Err.Number & " - " & Err.Description

End Function

## Calling an API Function From VB.NET

This snippet calls the GetSystemDirectory API function in VB.NET and shows how to use the StringBuilder class to create a string buffer for API functions that require it. See comments within code for more information.

Put this at the top of your module.
'Required in all cases when calling API functions
Imports System.Runtime.InteropServices

'Required in this example and any API function which
'use a string buffer. Provides the StringBuilder class

Imports System.Text

'Put these declarations right under the class declaration
'(e.g., in a Form, right under Public Class Form1)

SetLastError:=True, CharSet:=CharSet.Unicode, _
ExactSpelling:=True, _
CallingConvention:=CallingConvention.StdCall)> _
Public Shared Function GetSystemDirectory(ByVal Buffer _
As StringBuilder, ByVal Size As Integer) As Long
' Leave function empty - DLLImport attribute
' forces calls to GetSystemDirectory to
' be forwarded to GetSystemDirectory in KERNEL32.DLL
End Function

Public Const MAX_PATH As Integer = 256

'How to call the API function:

Dim s As New StringBuilder(MAX_PATH)

GetSystemDirectory(s, MAX_PATH)
msgbox(s.ToString(), , "System Directory")

## Accessing LDAP using VB.NET

Option Explicit On
Imports System.DirectoryServices

Public Function GetLDAPUsers(ByVal ldapServerName As String, ByVal pFindWhat As String) As ArrayList
Dim oSearcher As New DirectorySearcher
Dim oResults As SearchResultCollection
Dim oResult As SearchResult
Dim RetArray As New ArrayList
Dim mCount As Integer
Dim mIdx As Integer
Dim mLDAPRecord As String

Dim ResultFields() As String = {"securityEquals", "cn"}

Try
With oSearcher
.SearchRoot = New DirectoryEntry("LDAP://" & ldapServerName & _
"/dc=lippogeneral,dc=com")
.Filter = "cn=" & pFindWhat & "*"
oResults = .FindAll()
End With

mCount = oResults.Count
If mCount > 0 Then
For Each oResult In oResults
mLDAPRecord = oResult.GetDirectoryEntry().Properties("cn").Value & " " & oResult.GetDirectoryEntry().Properties("mail").Value
Next
End If
Catch e As Exception

MsgBox("Error is " & e.Message)
Return RetArray

End Try

Return RetArray

End Function

## A Function To Simplify ExecuteNonQuery Statements

Use this function to simplify ExecuteNonQuery. Normally, you need to setup a command and connection objects, which this code does. Just pass the SQL statement and the connection object that points to your database.

Function ExecuteSQL(ByVal sSQL As String, ByVal dbOLE As OleDb.OleDbConnection) As Integer
Dim command As New OleDb.OleDbCommand(sSQL, dbOLE)
If command.Connection.State = ConnectionState.Closed Then command.Connection.Open()
Command.CommandType = CommandType.Text
ExecuteSQL = command.ExecuteNonQuery()
command.Connection.Close()
Application.DoEvents()
End Function

## Get a list of all Fonts

'This will get all of the available fonts on the computer and add

'them to the 'cmbFont' combobox control.

Dim f As System.Drawing.Text.InstalledFontCollection = New _

System.Drawing.Text.InstalledFontCollection

Dim fFamily As FontFamily

For Each fFamily In f.Families

Next

## Remove Extra Space from a string

Quickly remove extra whitespace from inside a string.

Function fSQLSpalten(ByVal sSpaltenZeile$) As String sSpaltenZeile = Trim(sSpaltenZeile) Do While InStr(1, sSpaltenZeile, " ") > 0 sSpaltenZeile = fReplace(sSpaltenZeile, " ", " ") Loop fSQLSpalten = sSpaltenZeile End Function ## Auto File BackUp with VB.net This code keeps backup of three different locations at a time in regular interval as per set by the user. It also works through network. 'For this Application you need: '1. 3 Check Boxes. '2. 6 text Boxes. '3. 5 Command Buttons. '4. 3 Combo Boxes. '5. 6 Progressbar Controls. '6. 3 File List Box Controls. '7. 1 ImageList control. '8. 3 Timer Controls 'N.B:(Controls that are directly involved with the code is mentioned above.) Dim fln, root, fld, val, val1, val2 As String Private Sub Check1_Click() On Error GoTo err: If Check1.Value = 1 Then Text1.Enabled = True Text4.Enabled = True Text1.SetFocus Else Text1.Enabled = False Text4.Enabled = False End If Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub Check2_Click() On Error GoTo err: If Check2.Value = 1 Then Text2.Enabled = True Text5.Enabled = True Text2.SetFocus Else Text2.Enabled = False Text5.Enabled = False End If Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub Check3_Click() On Error GoTo err: If Check3.Value = 1 Then Text3.Enabled = True Text6.Enabled = True Text3.SetFocus Else Text3.Enabled = False Text6.Enabled = False End If Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub Command1_Click() On Error GoTo err: File1.path = Text1.Text MkDir Text4.Text Label6.Caption = File1.path & " (" & File1.ListCount & ") files." val = 60 * Combo1.Text Pr4.Max = val Exit Sub err: MsgBox "Directory Already created", vbExclamation End Sub Private Sub Command2_Click() On Error GoTo err: File2.path = Text2.Text MkDir Text5.Text Label7.Caption = File2.path & " (" & File2.ListCount & ") files." val1 = 60 * Combo2.Text Pr5.Max = val1 Exit Sub err: MsgBox "Directory Already created", vbExclamation End Sub Private Sub Command3_Click() On Error GoTo err: File3.path = Text3.Text MkDir Text6.Text Label8.Caption = File3.path & " (" & File3.ListCount & ") files." val2 = 60 * Combo2.Text Pr6.Max = val2 Exit Sub err: MsgBox "Directory Already created", vbExclamation End Sub Private Sub Command4_Click() On Error GoTo err: If Len(Text4.Text) > 0 Then Timer1.Enabled = True Else Timer1.Enabled = False End If If Len(Text5.Text) > 0 Then Timer2.Enabled = True Else Timer2.Enabled = False End If If Len(Text6.Text) > 0 Then Timer3.Enabled = True Else Timer3.Enabled = False End If err: MsgBox err.Description, vbCritical End Sub Private Sub Command5_Click() On Error GoTo err: Text1.Text = "" Text2.Text = "" Text3.Text = "" Text4.Text = "" Text5.Text = "" Text6.Text = "" Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub ex_Click() On Error GoTo err: Dim i As Integer i = MsgBox("Before Quiting make sure that all Backup Processes are stopped" & vbCrLf & "Are sure to quit?", vbYesNo + vbQuestion) If i = vbYes Then Unload Me Else End If Exit Sub err: MsgBox err.Description End Sub Private Sub File1_Click() On Error GoTo err: fld = File1.path fln = File1.FileName root = fld & "\" & fln FileCopy root, Text4.Text & "\" & fln Pr1.Value = Pr1.Value + 1 If Pr1.Value >= Pr1.Max Then Pr1.Value = 0 End If Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub File2_Click() On Error GoTo err: fld = File2.path fln = File2.FileName root = fld & "\" & fln FileCopy root, Text5.Text & "\" & fln Pr2.Value = Pr2.Value + 1 If Pr2.Value >= Pr2.Max Then Pr2.Value = 0 End If Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub File3_Click() On Error GoTo err: fld = File3.path fln = File3.FileName root = fld & "\" & fln FileCopy root, Text6.Text & "\" & fln Pr3.Value = Pr3.Value + 1 If Pr3.Value >= Pr3.Max Then Pr3.Value = 0 End If Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub Form_Load() On Error GoTo err: Dim i As Integer For i = 0 To 120 Step 2 Combo1.AddItem i Combo2.AddItem i Combo3.AddItem i Next i Text1.Enabled = False Text2.Enabled = False Text3.Enabled = False Text4.Enabled = False Text5.Enabled = False Text6.Enabled = False Command1.Enabled = False Command2.Enabled = False Command3.Enabled = False Command4.Enabled = False Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub Form_Unload(Cancel As Integer) On Error GoTo err: Dim i As Integer i = MsgBox("Before Quiting make sure that all Backup Processes are stopped" & vbCrLf & "Are sure to quit?", vbYesNo + vbQuestion) If i = vbYes Then Cancel = 0 Else Cancel = 1 End If Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub hlp_Click() MsgBox "Change Mode: F1" & vbCrLf & "NetDel: F2" & vbCrLf & "Refresh: F5" & vbCrLf & "Restore: F6", vbInformation, "DelMas: Help" End Sub Private Sub Text4_Change() On Error GoTo err: If Len(Text4.Text) >= 0 Then Command1.Enabled = True Command4.Enabled = True Else Command1.Enabled = False End If Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub Text5_Change() On Error GoTo err: If Len(Text5.Text) >= 0 Then Command2.Enabled = True Else Command2.Enabled = False End If Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub Text6_Change() On Error GoTo err: If Len(Text6.Text) >= 0 Then Command3.Enabled = True Else Command3.Enabled = False End If Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub selectAll1() On Error GoTo err: Dim i As Integer For i = 0 To Me.File1.ListCount - 1 Me.File1.Selected(i) = True Next i Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub selectAll2() On Error GoTo err: Dim i As Integer For i = 0 To Me.File2.ListCount - 1 Me.File2.Selected(i) = True Next i Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub selectAll3() On Error GoTo err: Dim i As Integer For i = 0 To Me.File3.ListCount - 1 Me.File3.Selected(i) = True Next i Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub Timer1_Timer() On Error GoTo err: Pr1.Max = File1.ListCount Label6.Caption = File1.path & " (" & File1.ListCount & ") files." Pr4.Value = Pr4.Value + 1 Label9.Caption = "Backing up after " & Pr4.Value & " seconds..." If Pr4.Value >= Pr4.Max Then selectAll1 Pr4.Value = 0 End If File1.Refresh Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub Timer2_Timer() On Error GoTo err: Pr2.Max = File2.ListCount Label7.Caption = File2.path & " (" & File2.ListCount & ") files." Pr5.Value = Pr5.Value + 1 Label10.Caption = "Backing up after " & Pr5.Value & " seconds..." If Pr5.Value >= Pr5.Max Then selectAll2 Pr5.Value = 0 File2.Refresh End If Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub Timer3_Timer() On Error GoTo err: Pr3.Max = File3.ListCount Label8.Caption = File3.path & " (" & File3.ListCount & ") files." Pr6.Value = Pr6.Value + 1 Label11.Caption = "Backing up after " & Pr6.Value & " seconds..." If Pr6.Value >= Pr6.Max Then selectAll3 Pr6.Value = 0 End If File3.Refresh Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) On Error GoTo err: If Button.Index = 1 Then If Len(Text4.Text) > 0 Then Timer1.Enabled = True Else Timer1.Enabled = False End If If Len(Text5.Text) > 0 Then Timer2.Enabled = True Else Timer2.Enabled = False End If If Len(Text6.Text) > 0 Then Timer3.Enabled = True Else Timer3.Enabled = False End If ElseIf Button.Index = 2 Then PopupMenu stp ElseIf Button.Index = 3 Then PopupMenu pbp ElseIf Button.Index = 4 Then Unload Me End If Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub Toolbar1_ButtonMenuClick(ByVal Button As MSComctlLib.ButtonMenu) On Error GoTo err: If Button.Index = 1 Then Timer1.Enabled = True ElseIf Button.Index = 2 Then Timer2.Enabled = True ElseIf Button.Index = 3 Then Timer3.Enabled = True End If Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub t1_Click() On Error GoTo err: Timer1.Enabled = False Pr4.Value = 0 Label9.Caption = "" Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub t2_Click() On Error GoTo err: Timer2.Enabled = False Pr5.Value = 0 Label10.Caption = "" Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub t3_Click() On Error GoTo err: Timer3.Enabled = False Pr6.Value = 0 Label11.Caption = "" Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub Tsk1_Click() On Error GoTo err: Timer1.Enabled = False Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub tsk2_Click() On Error GoTo err: Timer2.Enabled = False Exit Sub err: MsgBox err.Description, vbCritical End Sub Private Sub tsk3_Click() On Error GoTo err: Timer3.Enabled = False Exit Sub err: MsgBox err.Description, vbCritical End Sub ## Open Acrobat Reader How to open Acrobat in One click ! Imports System.Diagnostics Public Class Form1 Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim proc As New Process() With proc.StartInfo .Arguments = "Your PDF Path eg:- C:\MyFiles\Ebook2007.pdf" .UseShellExecute = True .WindowStyle = ProcessWindowStyle.Maximized .WorkingDirectory = "C:\Program Files\Adobe\Reader 8.0\Reader\" '<----- Set Acrobat Install Path .FileName = "AcroRd32.exe" '<----- Set Acrobat Exe Name End With proc.Start() proc.Close() proc.Dispose() End Sub End Class ## List View Example This code will sum-up the value of a listview and save the entire list of a listview in just one click. Dim scon As ADODB.Connection Dim srec As ADODB.Recordset Dim slist As ListItem Dim sum As Double Private Sub Command2_Click() Dim sql As String Dim x sum = 0 For x = 1 To ListView1.ListItems.Count sum = sum + CDbl(ListView1.ListItems.Item(x).SubItems(2)) sql = "insert into salary2 (idno,name,salary) values " sql = sql & "(" & CLng(ListView1.ListItems.Item(x)) & ",'" sql = sql & ListView1.ListItems.Item(x).SubItems(1) & "'," sql = sql & CDbl(ListView1.ListItems.Item(x).SubItems(2)) & ")" scon.Execute sql Next x Set slist = ListView1.ListItems.Add(, , " ") Set slist = ListView1.ListItems.Add(, , "") slist.SubItems(1) = "Total is==> P" slist.SubItems(2) = Format(sum, "##,##0.00") MsgBox "save record" End Sub Private Sub Form_Load() Set scon = New ADODB.Connection scon.Open "Provider=microsoft.jet.oledb.4.0;" & _ "Data source=" & App.Path & "\sum.mdb" displayrec End Sub Sub displayrec() Set srec = New ADODB.Recordset srec.Open "select * from salary", scon, adOpenDynamic, adLockPessimistic If srec.EOF Then Exit Sub Do While Not srec.EOF Set slist = ListView1.ListItems.Add(, , srec(0)) slist.SubItems(1) = srec!Name slist.SubItems(2) = Format(srec!salary, "##,##0.00") srec.MoveNext Loop End Sub ## Upload file with ASP.NET emember to import the system.file namespace Also you will have to add a upload file server control to your html code. Like this. The Code : If FileUpload1.HasFile Then FileUpload1.SaveAs(Server.MapPath("The_Name_Of_The_File")) End If ## Prime Number Generation A console Application Module Module1 Sub Main() Dim n As Integer Dim i As Integer Dim flag As Boolean For n = 1 To 50 flag = True For i = 2 To n / 2 If n Mod i = 0 Then flag = False End If Next If flag Then Console.WriteLine(n) End If Next Console.ReadLine() End Sub End Module ## Creating a line and displaying angle using System; using Autodesk.AutoCAD.Runtime; using Autodesk.AutoCAD.ApplicationServices; using Autodesk.AutoCAD.Colors; using Autodesk.AutoCAD.DatabaseServices; using Autodesk.AutoCAD.EditorInput; using Autodesk.AutoCAD.Geometry; using Autodesk.AutoCAD.GraphicsInterface; using Autodesk.AutoCAD.Windows; using System.Windows.Forms; [assembly: CommandClass(typeof(ClassLibrary.Class))] namespace ClassLibrary { /// /// Summary description for Class. /// public class Class :IExtensionApplication { private static Editor pEditor; public static Line pLine; public Class() { } [CommandMethod("lian")] static public void test() { Database pDatabase = HostApplicationServices.WorkingDatabase; Editor pEditor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor; Autodesk.AutoCAD.DatabaseServices.TransactionManager pTransactionManager = pDatabase.TransactionManager; Transaction pTransaction = pTransactionManager.StartTransaction(); try { //for creating a line Autodesk.AutoCAD.DatabaseServices.Line pLine = new Line(); PromptPointOptions pPromptPointOptions1 = new PromptPointOptions("enter first point of line"); PromptPointResult pPromptPointResult1 = pEditor.GetPoint(pPromptPointOptions1); PromptPointOptions pPromptPointOptions2 = new PromptPointOptions("enter second point of line"); PromptPointResult pPromptPointResult2 = pEditor.GetPoint(pPromptPointOptions2); pLine.StartPoint = pPromptPointResult1.Value; pLine.EndPoint = pPromptPointResult2.Value; BlockTable pBlockTable = pTransaction.GetObject(pDatabase.BlockTableId, OpenMode.ForRead, false) as BlockTable; BlockTableRecord pBlockTableRecord = pTransaction.GetObject(pBlockTable[BlockTableRecord.ModelSpace], OpenMode.ForWrite, false) as BlockTableRecord; ObjectId objId = pBlockTableRecord.AppendEntity(pLine); pTransaction.AddNewlyCreatedDBObject(pLine, true); //to get text Point3d pPoint3d = new Point3d((pLine.StartPoint.X + pLine.EndPoint.X) / 2, (pLine.StartPoint.Y + pLine.EndPoint.Y ) / 2, 0.0); DBText pDBText = new DBText(); pDBText.VerticalMode = TextVerticalMode.TextBottom; pDBText.HorizontalMode = TextHorizontalMode.TextCenter; pDBText.Height = 0.5; //to find angle btwn to points double angle = Angle(pLine.StartPoint, pLine.EndPoint); //for getting angle in degrees upto 4 decimals pDBText.TextString = "Angle = " + Converter.DistanceToString(angle * (180.0 / Math.PI), DistanceUnitFormat.Decimal, 4); pDBText.Rotation = angle; pDBText.AlignmentPoint = pPoint3d; objId = pBlockTableRecord.AppendEntity(pDBText); pTransaction.AddNewlyCreatedDBObject(pDBText, true); } catch (System.Exception pException) { pEditor.WriteMessage(pException.ToString()); } finally { pTransaction.Commit(); } pTransaction.Dispose(); } public static double Angle(Point3d firPnt, Point3d secPnt) { double lineAngle; if (firPnt.X == secPnt.X) { if (firPnt.Y < secPnt.Y) lineAngle = Math.PI / 2.0; else lineAngle = (Math.PI / 2.0) * 3.0; } else { lineAngle = Math.Atan((secPnt.Y - firPnt.Y) / (secPnt.X - firPnt.X)); if (firPnt.X > secPnt.X) lineAngle = Math.PI + lineAngle; else if (lineAngle < 0.0) lineAngle = (Math.PI * 2.0) + lineAngle; } return (lineAngle); } #region IExtensionApplication Members public void Initialize() { MessageBox.Show("application loaded"); } public void Terminate() { } #endregion } } ## Finiding Maximum Value on an Array This code will show you how your going to find and display the maximum value in your array. The Code: 'You will need a FORM and a command button Option Explicit Dim A(20), num, i, j, max As Integer Private Sub Command1_Click() Print "Your array contains:" For i = 0 To num - 1 Print A(i) Next i Print "Maximum Value= "; max End Sub Private Sub Form_Load() num = InputBox("Initialize your array [1-20]:") For i = 0 To num - 1 A(i) = InputBox("Enter your array:") Next i 'find maximum max = A(0) For i = 0 To num - 1 If max < A(i) Then max = A(i) End If Next End Sub ## Catch Win32 Services The following code will allow you to catch running Win32Services The Code: Option Explicit On Imports System Imports System.Management Public Class Form1 Private MgClass As New Management.ManagementClass("Win32_Service") Private Sub ButtonLoadServices_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonLoadServices.Click Try Me.Cursor = Cursors.WaitCursor ListView1.Items.Clear() Label3.Text = "" Label5.Text = "" Label7.Text = "" Label9.Text = "" ButtonLoadServices.Enabled = False ButtonLoadServices.Refresh() Label1.Text = "0% Complete." Label1.Refresh() With ProgressBar1 .Value = 0 .Minimum = 0 .Maximum = MgClass.GetInstances().Count .Refresh() End With For Each obj As Management.ManagementObject In MgClass.GetInstances() Application.DoEvents() Dim MHeader As New ListViewItem() Dim SHeader As New ListViewItem.ListViewSubItem() MHeader.Text = obj.GetPropertyValue("Caption").ToString If obj.GetPropertyValue("Description") <> "" Then SHeader.Text = obj.GetPropertyValue("Description").ToString() End If ListView1.Items.Add(MHeader).SubItems.Add(SHeader) ProgressBar1.Value += 1 ProgressBar1.Refresh() Label1.Text = ((ProgressBar1.Value / ProgressBar1.Maximum) * 100).ToString("0.00") & "% Complete." Label1.Refresh() Next ButtonLoadServices.Enabled = True ButtonLoadServices.Refresh() Me.Cursor = Cursors.Default Catch ex As Exception MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) ButtonLoadServices.Enabled = True ButtonLoadServices.Refresh() Me.Cursor = Cursors.Default End Try End Sub Private Sub ListView1_AfterLabelEdit(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LabelEditEventArgs) Handles ListView1.AfterLabelEdit e.CancelEdit = True End Sub Private Sub ListView1_BeforeLabelEdit(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LabelEditEventArgs) Handles ListView1.BeforeLabelEdit e.CancelEdit = True End Sub Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Label3.Text = "" Label5.Text = "" Label7.Text = "" Label9.Text = "" End Sub Private Sub ListView1_MouseClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles ListView1.MouseClick Dim SelectItem As String = "" Dim SelRow As Integer = 0 Try Me.Cursor = Cursors.WaitCursor SelRow = ListView1.SelectedItems.Item(0).Index SelectItem += """" SelectItem += ListView1.Items.Item(SelRow).Text.ToString() SelectItem += """" Dim SelQuery As New SelectQuery("Win32_Service", "Caption=" & SelectItem & "") Dim ObjectSearcher As New ManagementObjectSearcher(SelQuery) For Each service As ManagementObject In ObjectSearcher.Get() Label3.Text = service.GetPropertyValue("PathName") Label5.Text = service.GetPropertyValue("ServiceType") Label7.Text = service.GetPropertyValue("StartMode") Label9.Text = service.GetPropertyValue("State") Exit For Next SelQuery = Nothing ObjectSearcher.Dispose() Me.Cursor = Cursors.Default Catch ex As Exception MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) Me.Cursor = Cursors.Default End Try End Sub End Class ## Regular Expression Tester This is a simple Regular Expression Tester. Imports System.Text.RegularExpressions Public Class Form1 Private Function TestRegularExpression(ByVal TestValue As Object, ByVal TestPattern As String) As Boolean TestRegularExpression = False If Regex.IsMatch(TestValue, TestPattern) Then TestRegularExpression = True Else TestRegularExpression = False End If Return TestRegularExpression End Function Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim Ans As Boolean = False Try Ans = TestRegularExpression(TextBox2.Text.ToString().Trim(), TextBox1.Text.ToString().Trim()) If Ans = True Then MessageBox.Show("Correct", "Regular Expressions", MessageBoxButtons.OK, MessageBoxIcon.Information) Else MessageBox.Show("Not Correct", "Regular Expressions", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) End If Catch ex As Exception MessageBox.Show(ex.Message, "Error ...", MessageBoxButtons.OK, MessageBoxIcon.Error) End Try ## Prime Number Generation Open Visual Basic (.net) and create a new Console Application Paste the following code and run ! Module Module1 Sub Main() Dim n As Integer Dim i As Integer Dim flag As Boolean For n = 1 To 50 flag = True For i = 2 To n / 2 If n Mod i = 0 Then flag = False End If Next If flag Then Console.WriteLine(n) End If Next Console.ReadLine() End Sub End Module ## Addition of the Digg Button After a long search I found the method to add the Digg button to all the posts of the Blog. Don't forget to Digg anypost you found helpful ! ## New Site Skin ! Hi, I just fixed a new skin!! What do you think of it? ## How to check a valid IP Address Another idea to check an IP Address format The Code: 'will make the text black if its a valid IP address 'or red if its not Private Sub Text1_Change() Text1.ForeColor = 255 If IsIP(Text1.Text) Then Text1.ForeColor = 0 End Sub 'place this part in a module Public Function IsIP(TestAddress As String) As Boolean Dim IPt As String Dim TQ As Long Dim TT As Long Dim TW As Long Dim IPTemp As Long IsIP = False 'Set return value as false On Error GoTo cockup 'if an error occures the string is not valid If Left(TestAddress, 1) = "." Then Exit Function If Right(TestAddress, 1) = "." Then Exit Function 'check first and last are not "." For TQ = 1 To Len(TestAddress) 'test all chars IPt = Mid(TestAddress, TQ, 1) If IPt <> "." Then 'if its not a "." it must be 0-9 If Asc(IPt) > 57 Or Asc(IPt) < 48 Then Exit Function End If Next TQ TQ = InStr(1, TestAddress, ".", vbTextCompare) 'find the three dots TT = InStr(TQ + 1, TestAddress, ".", vbTextCompare) TW = InStr(TT + 1, TestAddress, ".", vbTextCompare) If InStr(TW + 1, TestAddress, ".", vbTextCompare) <> 0 Then Exit Function 'if there is a fourth then the string is invalid 'test each number is between 0 and 255 IPTemp = Val(Left(TestAddress, TQ - 1)) If IPTemp > 255 Or IPTemp < 0 Then Exit Function IPTemp = Val(Mid(TestAddress, TQ + 1, TT - TQ - 1)) If IPTemp > 255 Or IPTemp < 0 Then Exit Function IPTemp = Val(Mid(TestAddress, TT + 1, TW - TT - 1)) If IPTemp > 255 Or IPTemp < 0 Then Exit Function IPTemp = Val(Right(TestAddress, Len(TestAddress) - TW)) If IPTemp > 255 Or IPTemp < 0 Then Exit Function IsIP = True 'it has passed all tests so make it true cockup: End Function ## Read the Content of XML file into the DataSet This is the inverse of the last post! The code : Imports System Imports System.Data Imports System.Data.SqlClient Private Sub btnReadXMLData_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnReadXMLData.Click Dim dsPubs As New DataSet() ' Read in XML from file dsPubs.ReadXml("Pubs.xml") ' Bind DataSet to Data Grid grdData.DataMember = "publishers" grdData.DataSource = dsPubs End Sub Hope it helps and good luck, any suggestion or questions post a comment ! ## How to save a DataSet As XML File This is a cool idea to save a DataSet as XML file with VB.net, So far you can convert an SQL DataBase to XML format. The code : Private Sub btnWriteXMLData_Click(ByVal sender As System.Object, _ ByVal e As System.EventArgs) Handles btnWriteXMLData.Click Dim dsSales As New DataSet() Dim cn As New SqlConnection _ ("data source=localhost;initial catalog=pubs;user id=sa") Dim daAuthors As New SqlDataAdapter("select * from sales ", cn) Dim daPublishers As New SqlDataAdapter("select * from stores ", cn) ' Load data from database daAuthors.Fill(dsSales, "Sales") daPublishers.Fill(dsSales, "Stores") ' Write XML to file dsSales.WriteXml("XMLFile.xml") End Sub Hope it helps and good luck, any suggestion or questions post a comment ! ## Create a CSV File with VB Hi friends, This is a method to create a CSV file with VB6. To make it with vb2005 just upgrade the code with the vb2005 tool The Code : Dim nfile As Integer Dim conx as Integer Private Sub cmdExport_Click() nfile = FreeFile ProgressBar1.Value = 1 Open "filea" For Output As #nfile For conx = 1 To nbr StatusBar1.Panels(1).Text = CInt(conx * 100 / nbr) & "% completed" 'Print to file each field of the structure "Customer" Print #nfile, conx & ", " & Customer(conx).Field1 & ", " & Customer(conx).Field2 & ", " & Customer(conx).Field3 & ", " & Customer(conx).Field4 & ", " & Customer(conx).Field5 & ", " & Customer(conx).Field6 & ", " ProgressBar1.Value = conx * 100 / nbr Next conx Close #nfile FileCopy "filea", App.Path & "\ExportedFile.csv" Kill "filea" If err.Number = 0 Then MsgBox "File exported to working directory!" Else MsgBox "Error exporting file: " & err.Number End If End Sub 'The data structure has to be defined like this one: Type Customer Field1 as String Field2 as String 'You can add as many fields as you need ... End Type Hope it helps and good luck, any suggestion or questions post a comment ! ## Show/Hide the System Tray This a good and short code to show and hide the Windows Tray. It compatible with VB6 and also .net Declaration : Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _ ByVal nCmdShow As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Private Const Tray_SHOW = 5 Private Const Tray_HIDE = 0 Dim Trayhwnd As Long Code : Private Sub Form_Load() Trayhwnd = FindWindow("Shell_TrayWnd", "") Trayhwnd = FindWindowEx(Trayhwnd, 0, "TrayNotifyWnd", vbNullString) ShowWindow Trayhwnd, Tray_HIDE 'To Hide 'To show the System Tray add this code insteed of above 'ShowWindow Trayhwnd, Tray_SHOW 'To Show End Sub ## How to use text files with VB.net Hi there! This is a small tutorial on using files with VB.net. As VB.net uses new technologies it will be strange for some new developers! First we must import the Syste.IO Class Imports System.IO Reading Text Files: the easiest way to open a text file is with the System.IO.File.OpenText() method. Code:'Dim your StreamReader Dim TextFileStream As System.IO.TextReader 'Load the textfile into the stream TextFileStream = System.IO.File.OpenText("C:\MyTextFile.txt") 'Read to the end of the file into a String variable. Dim MyFileContents As String = TextFileStream.ReadToEnd 'Close the Stream object TextFileStream.Close() The above code will open a text file on your C drive called MyTextFile.txt. It will load all of the text into a string variable called MyFileContents. It won't create a file of that name if it doesn't already exist (and will throw an exception which you should handle - but see later in the FAQ for how to create a new file). Creating Text Files: Code:'Dim your Text Writer Dim TW As System.IO.TextWriter 'Create a Text file and load it into the TextWriter TW = System.IO.File.CreateText("C:\MyTextFile.txt") 'Write a line TW.WriteLine("Hello World") 'Write another line TW.WriteLine("Hello World Again") 'Flush the text to the file TW.Flush() 'Close the File TW.Close() Append to an existing Text file: Code:'Dim your Stream Writer or Text Writer. Dim SW As IO.TextWriter 'Open a file for Appending SW = IO.File.AppendText("C:\MyTextFile.txt") 'Write a line to the bottom of the text file SW.WriteLine("This is another line added to the bottom of the text file.") 'Flush to the file SW.Flush() 'Close the object SW.Close() Here is how to get a random line from a text file with the smallest code I can think of. Extracting One Line From a File: Code:Dim RandomNumber As New Random() Dim Tr As IO.TextReader = System.IO.File.OpenText("C:\MyTextFile.txt") Dim FileLines() As String = Split(Tr.ReadToEnd(), vbCrLf) Tr.Close Dim MyRandomLine As String = FileLines(RandomNumber.Next(0, UBound(FileLines))) MsgBox(MyRandomLine) If you know what line you want to access then you can make it smaller like this : Code: Dim Tr As IO.TextReader = System.IO.File.OpenText("C:\MyTextFile.txt") Dim MyFileLine As String = Split(Tr.ReadToEnd(), vbCrLf)(3) Tr.Close MsgBox(MyFileLine) Note that the above code will return the fourth line from the file. It's zero based, so you would enter (0) for line 1, (1) for line 2 and so on. If you need more, I advice you to focus on the MSDN Library! ## Solution for Base Conversion Option Explicit 'Variables to hold Old Base Type and New Base Type Private OldBase As Integer Private NewBase As Integer >In the form load: Private Sub Form_Load() 'Initialize Old and New Base Type to Decimal OldBase = 10 NewBase = 10 End Sub >in the textbox named txtnumber Private Sub txtNumber_KeyPress(KeyAscii As Integer) 'If the key is NOT Backspace or Delete or Left or Right If KeyAscii <> vbKeyBack Then 'Determine the Base Type are we dealing with Select Case OldBase Case 2 'Only allow Binary numbers to be entered (0-1) If KeyAscii <> vbKey1 Then KeyAscii = 0 End If Case 8 'Only allow Octal numbers to be entered (0-7) If KeyAscii <> vbKey7 Then KeyAscii = 0 End If Case 10 'Only allow Decimal numbers to be entered (0-9) If KeyAscii <> vbKey9 Then KeyAscii = 0 End If Case 16 'Only allow Hexidecimal numbers to be entered (0-9 & A-F) If KeyAscii <> vbKey9 Then If KeyAscii <> vbKeyF Then 'If a-f then change to A-F If KeyAscii >= 97 And KeyAscii <= 102 Then KeyAscii = KeyAscii - 32 Else KeyAscii = 0 End If End If End If End Select End If End Sub >in the option buttons (oct, hex, decimal,bin) named optNumber: Private Sub optNumber_Click(Index As Integer) Dim OldNumber As String Dim NewNumber As String OldNumber = txtNumber.Text NewBase = optNumber(Index).Tag Select Case NewBase Case 2 txtNumber.MaxLength = 50 Case 8 txtNumber.MaxLength = 17 Case 10 txtNumber.MaxLength = 15 Case 16 txtNumber.MaxLength = 13 End Select 'If Base Type was clicked but no numbers entered then 'change Old and New Base to the Type selected and exit If OldNumber = "" Then OldBase = NewBase Exit Sub End If 'Determine the Base Type combo we are dealing with Select Case True Case OldBase = 2 And NewBase = 2 'Binary & Binary NewNumber = OldNumber Case OldBase = 2 And NewBase = 8 'Binary & Octal NewNumber = Dec2Base(Base2Dec(OldNumber, OldBase), NewBase) Case OldBase = 2 And NewBase = 10 'Binary & Decimal NewNumber = Base2Dec(OldNumber, OldBase) Case OldBase = 2 And NewBase = 16 'Binary & Hexidecimal NewNumber = Dec2Base(Base2Dec(OldNumber, OldBase), NewBase) Case OldBase = 8 And NewBase = 2 'Octal & Binary NewNumber = Dec2Base(Base2Dec(OldNumber, OldBase), NewBase) Case OldBase = 8 And NewBase = 8 'Octal & Octal NewNumber = OldNumber Case OldBase = 8 And NewBase = 10 'Octal & Decimal NewNumber = Base2Dec(OldNumber, OldBase) Case OldBase = 8 And NewBase = 16 'Octal & Hexidecimal NewNumber = Dec2Base(Base2Dec(OldNumber, OldBase), NewBase) Case OldBase = 10 And NewBase = 2 'Decimal & Binary NewNumber = Dec2Base(OldNumber, NewBase) Case OldBase = 10 And NewBase = 8 'Decimal & Octal NewNumber = Dec2Base(OldNumber, NewBase) Case OldBase = 10 And NewBase = 10 'Decimal & Decimal NewNumber = OldNumber Case OldBase = 10 And NewBase = 16 'Decimal & Hexidecimal NewNumber = Dec2Base(OldNumber, NewBase) Case OldBase = 16 And NewBase = 2 'Hexidecimal & Binary NewNumber = Dec2Base(Base2Dec(OldNumber, OldBase), NewBase) Case OldBase = 16 And NewBase = 8 'Hexidecimal & Octal NewNumber = Dec2Base(Base2Dec(OldNumber, OldBase), NewBase) Case OldBase = 16 And NewBase = 10 'Hexidecimal & Decimal NewNumber = Base2Dec(OldNumber, OldBase) Case OldBase = 16 And NewBase = 16 'Hexidecimal & Hexidecimal NewNumber = OldNumber End Select txtNumber.Text = NewNumber OldBase = NewBase End Sub >private function: Private Function Dec2Base(ByVal DecNum, ByVal Base) As String Dim NHD As Double Dim HN As String 'Convert until done While DecNum <> 0 'Get the largest number of the Base Type NHD = DecNum - (Int(DecNum / Base) * Base) 'Find it's converted Base number then concatenate 'to the beginning of the resulting string HN = Mid("0123456789ABCDEF", NHD + 1, 1) & HN 'Subtract the amount we converted DecNum = Int(DecNum / Base) Wend 'Return our new number in the requested Base Type Dec2Base = HN End Function >another private function: Private Function Base2Dec(BaseNum As String, ByVal Base) As String Dim BN As Double Dim i As Double Dim j As Double BN = 0 j = 1 'Step from Right to Left of the numbers For i = Len(BaseNum) To 1 Step -1 'Determine what number we are dealing with then 'multiply its value by the power of the Base Type 'then add it to the total resulting value Select Case UCase(Mid(BaseNum, i, 1)) Case "0" BN = BN + j * 0 Case "1" BN = BN + j * 1 Case "2" BN = BN + j * 2 Case "3" BN = BN + j * 3 Case "4" BN = BN + j * 4 Case "5" BN = BN + j * 5 Case "6" BN = BN + j * 6 Case "7" BN = BN + j * 7 Case "8" BN = BN + j * 8 Case "9" BN = BN + j * 9 Case "A" BN = BN + j * 10 Case "B" BN = BN + j * 11 Case "C" BN = BN + j * 12 Case "D" BN = BN + j * 13 Case "E" BN = BN + j * 14 Case "F" BN = BN + j * 15 End Select 'Multiply our Base Type Power times the Base to get our next power j = j * Base Next i 'Return our new number in Decimal format Base2Dec = Trim(Str(BN)) End Function ## How to get the number of days in a month This is a good idea to get the number of days of any month 'For current month... MsgBox DateAdd("m", 1, Now) - Now 'For some other month (Example: June) Dim FirstDate As Date FirstDate = "01/06/2006" MsgBox DateAdd("m", 1, FirstDate) - FirstDate ## Another way to eject a CD This is another way to easily eject CD in only 5 line of code. Private Sub Form_Load() Call eject End Sub Public Sub eject() 'code to eject cdrom ok Dim owmp As Object Dim colCDROMs Set owmp = CreateObject("WMPlayer.OCX.7") Set colCDROMs = owmp.cdromCollection If colCDROMs.Count >= 1 Then For i = 0 To colCDROMs.Count - 1 colCDROMs.Item(i).eject Next End If End Sub ## Search Text in a database This code will help you search any text in a database and show it in a datagridview Create a button named utOk, a text box named txtName and a datagrid named Datagrid1. Private Sub butOk_Click(ByValsender As System.Object, ByVal e As System.EventArgs) Handles but_ok.Click Dim strConnection As String = "Data Source=your SQL data source;Initial Catalog=your database; Integrated Security=True" Dim cn As SqlClient.SqlConnection = New SqlClient.SqlConnection(strConnection) Dim ds As New DataSet Dim strSelect As String 'strSelect As String strSelect = "SELECT * FROM " & YourTable & " WHERE [Search Field] = '" & Me.txtName.Text & "'" Dim dscmd As New SqlClient.SqlDataAdapter(strSelect, cn) dscmd.Fill(ds, "your table") Me.Datagrid1.DataSource = ds Me.Datagrid1.DataMember = "your table" Dim con As Integer con = Me.BindingContext(ds, "your table").Count If con = 0 Then MessageBox.Show("Recourd could not be found") End If End Sub ## How to Eject a CD or DVD This short code Snippet will help you eject a CD or DVD using Windows Media Player API Public Class frmEject 'you need window media player reference in your project '1 combo box ' 2 button control Dim omal As New WMPLib.WindowsMediaPlayer Dim total As Integer Dim i As Integer Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing omal.close() End Sub Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load total = 0 i = 0 total = omal.cdromCollection.count If (total >= 1) Then For i = 0 To (total - 1) ComboBox1.Items.Add(omal.cdromCollection.Item(i).driveSpecifier) Next ComboBox1.Text = ComboBox1.Items.Item(0) End If MyBase.CenterToScreen() End Sub Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click If Not (ComboBox1.Text = "") Then omal.cdromCollection.Item(ComboBox1.SelectedIndex).eject() End If End Sub Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click For i = 0 To (total - 1) omal.cdromCollection.Item(i).eject() Next End Sub End Class ## Finding Maximum Value This code will show you how your going to find and display the maximum value in your array. 'You will need a FORM and a command button Option Explicit Dim A(20), num, i, j, max As Integer Private Sub Command1_Click() Print "Your array contains:" For i = 0 To num - 1 Print A(i) Next i Print "Maximum Value= "; max End Sub Private Sub Form_Load() num = InputBox("Initialize your array [1-20]:") For i = 0 To num - 1 A(i) = InputBox("Enter your array:") Next i 'find maximum max = A(0) For i = 0 To num - 1 If max < A(i) Then max = A(i) End If Next End Sub ## Try Windows Live Space Good I'm Back Again I had just tried out Windows Live Space. There you can make a home page very customizable and you can include many gadget. The thing that I loved is to include the blog summary or photo of my friends in MSN on the Blog. I liked it so much, plus you can include HTML and Script Text. Just have a look @ my space : http://omarabid.spaces.live.com ## Exam Finished Yeah I've just finished school exams, but oof I didn't do well in this term. I know I have much since my lastet posts, but I think I have to start a new project. Now I don't have time, it's true that I have about 15 days of holiday, but I must also take care of my studies. And now happy holidays for all students. ## The MSDN forum Tracker Blog Hi! I just strated the Msdn Forum Tracker Blog! What's that ? A very simple idea invented by me! This consist by getting best answered topics and posting them in the blog. How this will help you ? +You can subscribe to the feed burner and receive newest answered posts by email +You can browse on any topic and the solution is 100% found ! Help us grow ! Link to the blog Comment the posts The blog is here : www.msdntracker.blogspot.com ## Using Registry keys with VB.net Now we pass to an important part. How to use the registry keys (add, delete and modify) with VB.net First let's start: Create a new project, and add a button where you'll put the code. Open the registry editor to check that the changes are applied correctly. Now as you see there's keys (that are folder) an contain value. Let's start by making a key. This will make a key in the Current user root folder. My.Computer.Registry.CurrentUser.CreateSubKey("TestKey") Now expand the The Current User root folder and you'll find a new key (folder) made! Lety set a value on it. My.Computer.Registry.SetValue("HKEY_CURRENT_USER\TestKey", _"TestValue", "This is a test value.") As you'll see a new "REG_SZ" value was added. Very Important : If you want to presice the registry key value type just type ',' and Visual Studio editor will list you the value types. Now let's read what we wrote! Dim readValue As String readValue = My.Computer.Registry.GetValue _ ("HKEY_CURRENT_USER\TestKey", "TestValue", Nothing) MsgBox("The value is " & readValue) Let's finish by deleting it. My.Computer.Registry.CurrentUser.DeleteSubKey("TestKey") I think now you know a lot about Registry keys with vb.net but just now we didn't affrod the most important thing : Modify registry keys made by the System (windows)! This can be difficult but we'll do it, now watch out this code. autoshell = Registry.LocalMachine.OpenSubKey("Software\Microsoft\Windows NT\CurrentVersion\Winlogon", True) '' Set the value to 0 autoshell.SetValue("autorestartshell", 0) autoshell.Close() The following code change the "Autorestartshell" to 0. be carefull to make the following steps. Make a new object and set i to a Registry.Rootfolder.opensubkey("the sub key",True) If True is false or not set the change will fail! Now set the value with Name.Setvalue("valuename", depend on the value type) Finally don't forget to close the key! Have questions ? Post a comment and I'll reply with a comment! ## Introduction to Windows Registry Keys As you know Registry Keys are quite important when you are programming an application to interact with the Windows Interface and properties. This a simple tutorial to show you how to use registry keys with VB.net You can edit them manually using the Windows Registry Editor. To launch it, click on "execute" and type "Regedit" As you'll see there's a 5 different folders keys (root folder). 1. HIVES The Registry is split into a number of logical sections, or "hives". Hives are generally named by their Windows API definitions, which all begin "HKEY". They are abbreviated to a three- or four-letter short name starting with "HK" (e.g. HKCU and HKLM). The HKEY_LOCAL_MACHINE and HKEY_CURRENT_USER nodes have a similar structure to each other; applications typically look up their settings by first checking for them in "HKEY_CURRENT_USER\Software\Vendor's name\Application's name\Version\Setting name", and if the setting is not found looking instead in the same location under the HKEY_LOCAL_MACHINE key. When writing settings back, the reverse approach is used — HKEY_LOCAL_MACHINE is written first, but if that cannot be written to (which is usually the case if the logged-in user is not an administrator), the setting is stored in HKEY_CURRENT_USER instead. 2. HKEY_CLASSES_ROOT Abbreviated HKCR, HKEY_CLASSES_ROOT stores information about registered applications, such as Associations from File Extensions and OLE Object Class ID's tying them to the applications used to handle these items. On Windows 2000 and above, HKCR is a compilation of HKCU\Software\Classes and HKLM\Software\Classes. If a given value exists in both of the subkeys above, the one in HKCU\Software\Classes is used. 3. HKEY_CURRENT_USER Abbreviated HKCU, HKEY_CURRENT_USER stores settings that are specific to the currently logged-in user. The HKCU key is a link to the subkey of HKEY_USERS that corresponds to the user; the same information is reflected in both locations. On Windows-NT based systems, each users' settings are stored in their own files called NTUSER.DAT and USRCLASS.DAT inside their own documents and settings subfolder. 4. HKEY_LOCAL_MACHINE Abbreviated HKLM, HKEY_LOCAL_MACHINE stores settings that are general to all users on the computer. On NT-based versions of Windows, HKLM contains four subkeys, SAM, SECURITY, SOFTWARE and SYSTEM, that are found within their respective files located in the %SystemRoot%\System32\Config folder. A fifth subkey, HARDWARE, is volatile and is created dynamically, and as such is not stored in a file. Information about system hardware drivers and services are located under the SYSTEM subkey, whilst the SOFTWARE subkey contains software and windows settings. 5. HKEY_USERS Abbreviated HKU, HKEY_USERS contains subkeys corresponding to the HKEY_CURRENT_USER keys for each user registered on the machine. 6. HKEY_CURRENT_CONFIG Abbreviated HKCC, HKEY_CURRENT_CONFIG contains information gathered at runtime; information stored in this key is not permanently stored on disk, but rather regenerated at boot time. As you'll focus each folder and sub folder you'll find values. Values have different format Binary Value REG_BINARY Raw binary data. Most hardware component information is stored as binary data and is displayed in Registry Editor in hexadecimal format. DWORD Value REG_DWORD Data represented by a number that is 4 bytes long (a 32-bit integer). Many parameters for device drivers and services are this type and are displayed in Registry Editor in binary, hexadecimal, or decimal format. Related values are DWORD_LITTLE_ENDIAN (least significant byte is at the lowest address) and REG_DWORD_BIG_ENDIAN (least significant byte is at the highest address). Expandable String Value REG_EXPAND_SZ A variable-length data string. This data type includes variables that are resolved when a program or service uses the data. Multi-String Value REG_MULTI_SZ A multiple string. Values that contain lists or multiple values in a form that people can read are generally this type. Entries are separated by spaces, commas, or other marks. String Value REG_SZ A fixed-length text string. Binary Value REG_RESOURCE_LIST A series of nested arrays that is designed to store a resource list that is used by a hardware device driver or one of the physical devices it controls. This data is detected and written in the \ResourceMap tree by the system and is displayed in Registry Editor in hexadecimal format as a Binary Value. Binary Value REG_RESOURCE_REQUIREMENTS_LIST A series of nested arrays that is designed to store a device driver's list of possible hardware resources the driver or one of the physical devices it controls can use. The system writes a subset of this list in the \ResourceMap tree. This data is detected by the system and is displayed in Registry Editor in hexadecimal format as a Binary Value. Binary Value REG_FULL_RESOURCE_DESCRIPTOR A series of nested arrays that is designed to store a resource list that is used by a physical hardware device. This data is detected and written in the \HardwareDescription tree by the system and is displayed in Registry Editor in hexadecimal format as a Binary Value. None REG_NONE Data without any particular type. This data is written to the registry by the system or applications and is displayed in Registry Editor in hexadecimal format as a Binary Value Link REG_LINK A Unicode string naming a symbolic link. QWORD Value REG_QWORD Data represented by a number that is a 64-bit integer. This data is displayed in Registry Editor as a Binary Value and was introduced in Windows 2000. Advantages of Registry Keys: Here's the aim! Why to use registry keys ? Suppose for example you are making a program where you want to disable the Task Manager, How to do that ? Simply using Registry keys. I'll describe in the following post how to use it with VB.net and then I'll give you samples of Registry keys that let's you take control of your Windows ! For more information about Registry Editor see Microsoft Site ## Google-Mini Dead Google-Mini is dead ? Try out Microsoft search engine express with advanced features and best of all : FREE ! http://www.microsoft.com/enterprisesearch/serverproducts/searchserverexpress/default.aspx ## Alexa Ranking System Lots of you know Google Page Ranks for sure, but what about Alexa. First of all alexa don't rank pages but whole sites. Second if Google Page Rank is based on the pages that links to you, Alexa is based on the Traffic and this make it more real! Alexa compare traffic between sites and give top 500 sites, and also a search engine to search the top 100,000 sites. Then getting in top 100,000 is so hard? Yes so hard but why not getting linked in the Top 100,000 ? This is another thing but the thing that I liked most in Alexa is the real ranking For example : number 1 is yahoo then 2 is google 3 is you tube 4 is live (ms) and 5 is MSN. With Alexa, you can know the sites that are linking to you and their rank. and now the rank help you more than Google PR because you know the site traffic and how much it can drive traffic to you;) Alexa.com visit it and give it a try ! ## List of sites like Digg Ah Digg! a good sites for us (( Says reader)) We find fresh informations! Ah Digg! a wonderfull site for us ((Says webmasters)) We get huge traffic throght it. AAA Says both we want sites alike DIGG. Ah Good, this is a list of sites like digg. Digg.com : Number 1 The most powerful, easy to use and drive most traffic to you. Fark.com : I didn't try it a lot but good traffic Stumbleupon.com : yes but no so easy in navigation Reddit.com : Okay it drives also traffic but you can't submit many urls a time! i-am-bored.com : need that admin accept link isnare.com : you submit the whole article (few traffic) News.ycombinator.com : fast, easy and simple but small traffic this is the list and I'll update it every day I found interesting site. If you know another site, post it in a comment and 10x ## 3 month of blogging and 300$ in Google Adsense!

Yes you see well I think! I have only 3 month of blogging with this blogger, but I have 300$now on my account and that are increasing day by day! My earning reached 20$ per day now and I have only 3 month!
I'm not joking or just attracting attention, I speak seriously.How could I do this ?

Posting Topic :
Simple and easy, posts on anything you like (but interesting). Like Me, source code and example helpful for VB.net programers.
Post a lot of topic and make a clear title for your post, that attract seekers.
You'll need at least 50 topic to attract readers, but you can do them quicly.
Digg with me !
Google isn't very good for traffic, but for long. That mean Google direct to you a small traffic but every day.
Digg drive to you huge traffic, but only the moment when you submit!
So you have to make 5 posts per day and submit them to Digg. Interesting posts will attract lots of readers. Digg give me about 120 reader daily (if I submit) and 3 or 4 if i don't. But Google drive traffic constantly and the traffic of google increase as your Page Rank Increase!
Comment:
Forum:
Yes, but High Page Ranks forums only
Blog Directory:
I'm using but they don't drive well
Use automated ping and ping your blog.

That's all! and you'll start having traffic and then money

Today 10 November, I received my first mail from Google Adsense, wait it isn't the check but the PIN code.
I'm very happy and I entred it and all goes well and I'll receive my check the end of this month. Nice, no?

## Another Way to get traffic and increase page rank

OK, if we'll see all the sites want traffic and page ranks for it self! So don't run behind those sites "that increase page ranks of traffic", but just read reall interesting posts.
I'm making those days, reasearch how other people have traffic. It's interestant to know. I see that many people post comments and add their link to the comment.
Ah here it come! Suppose a person with PR 7 blog. And just posted a new topic (in the first page) and thousands of hits come. If you posts your link in a comment, you get small traffic of his traffic. But if you make an interesting post you'll get more and more and more until you say : "thanks god I don't need more".
Let say this person have 1000 hits daily and you make the comment. If good comment you recieve at least 50 hits! and let say you posted 20 comments, then you'll receive 1000 hits! and more over page rank increase. 1000 hits ?! What do you want more.
Sart commenting now! But first you must find the PR high blog, oh another difficult step to do!

Many of webmasters wants to know how Google detects click frauds, perhaps to prevent from being banned. No one right now have the correct answer!. I had (with some of my friends) made two Adsense account and made the tests.

Account Number 1:
The site was accepted! We added the ads, and then I started my self by clicking on the ads. I was the only person that access to this site. So when seeing the Adsense reports, I see that the CTR level is high (80 %) due to the huge number of click and few impression (Ex : 50 impression and 35 clicks). After some days, Google prevent me from being banned. So Google won't delete your account from the first time, but it will inform you! I continue in click frauds and google disabled my account.
Account Number 2:
I have good traffic with this one because of my friends! We made a lot of traffic and page impression and few clicks (CTR = 5 or 8 %) Google Adsense Generate money. After some days we get an email alerting us from click frauds! (Note : We use a fix IP Address)

Conclusion:
1/ Google detects CTR and inform (Adsense robots) it's engineers when a CTR reach a high level (25 % for example) for a long period of time. The engineer won't disable the account, it will visit the site and see what's going on and then alert you.
2/ Google detects the IP address of the computer that make clicks and impression (If always the same that made clicks and impression, then something is strange) Google will alert you before any action he will take
3/ The normal CTR is from 2% to 8% max. If you have 2% or less then you adsense need optimization. If you have more than 10% (for a long period, 1 week for example) and you don't make clicks frauds, then try to detect (with google analytics) who is coming to your site and abusing your ads. tell Google (with email) when you found an abusing IP Address.
4/ As your impression and visitors are numbrous as google won't see click frauds (will pass them). If you have for example 5000 page impression daily, Google Adsense won't take care of an abusing IP Address and will block it him self (simply the clicks of this IP won't generate money, so if you have good traffic don't make click frauds because this don't generate money)

I'm not sure of that (In other words it can be not google method to detect click fraud), you'd better make more research if you want to know!.
Afraid from being banned ?
Simply follow yout CTR and all should go well. If you found for example 5 clicks without revenue then those clicks are click frauds (in normal condition 1 click generate 0.28 ot 0.48 $) and also page impression generate up to 1$ per 1000 impression (not much but good if you have enough money)

As I have a blog, then I must have a traffic because of numbers of posts, PR and other pages that links to me. Most of bloggers use Adsense to earn money from their blog. But I'm seeing in almost of blog only Adsense working. what about other ?. I make a small analytics. When you have a blog, where you made long and many posts, the page size (height) will be large! in the right or the left panel you won't have anything to display! As Adsense allow only 3 ads to display you can use others ad provider and earn more money.
Let say you have added 3 other ad publisher then your earning will be 3 times more and also from different sources. For these reason I started to try Adbrite that I had seen in some sites. I just put it and the ads shows that I must wait 30 minutes until showing !!! But perhaps until it track the web site content.

## How Page Ranks Works !

Page Rank, page rank and all web masters are talking about! What's this other thing?

PageRank is a numeric value that represents how important a page is on the web. Google figures that when one page links to another page, it is effectively casting a vote for the other page. The more votes that are cast for a page, the more important the page must be. Also, the importance of the page that is casting the vote determines how important the vote itself is. Google calculates a page's importance from the votes cast for it. How important each vote is is taken into account when a page's PageRank is calculated.
PageRank is Google's way of deciding a page's importance. It matters because it is one of the factors that determines a page's ranking in the search results. It isn't the only factor that Google uses to rank pages, but it is an important one.

How to increase your page rank ?

How Page Rank is calculated ?

To calculate the PageRank for a page, all of its inbound links are taken into account. These are links from within the site and links from outside the site.
PR(A) = (1-d) + d(PR(t1)/C(t1) + ... + PR(tn)/C(tn))
That's the equation that calculates a page's PageRank. It's the original one that was published when PageRank was being developed, and it is probable that Google uses a variation of it but they aren't telling us what it is. It doesn't matter though, as this equation is good enough.
In the equation 't1 - tn' are pages linking to page A, 'C' is the number of outbound links that a page has and 'd' is a damping factor, usually set to 0.85.
We can think of it in a simpler way:-
a page's PageRank = 0.15 + 0.85 * (a "share" of the PageRank of every page that links to it)
"share" = the linking page's PageRank divided by the number of outbound links on the page.

How to know Sites linking to me and the Page Rank ?

For the Page Rank download Google ToolBar and it will displays Page Rank Information for each page

## Make more traffic with your blog

Use lists.
Be topical... write posts that need to be read right now.
Learn enough to become the expert in your field.
Break news.
Be timeless... write posts that will be readable in a year.
Be among the first with a great blog on your topic, then encourage others to blog on the same topic.
Share your expertise generously so people recognize it and depend on you.
Announce news.
Write short, pithy posts.
Write long, definitive posts.
Be snarky. Write nearly libelous things about fellow bloggers, daring them to respond (with links back to you) on their blog.
Be sycophantic. Share linklove and expect some back.
Include polls, meters and other eye candy.
Coin a term or two.
Do email interviews with the well-known.
Use photos. Salacious ones are best.
Be anonymous.
Encourage your readers to digg your posts. (and to use furl and reddit). Do it with every post.
Start at the beginning and take your readers through a months-long education.
Include comments so your blog becomes a virtual water cooler that feeds itself.
Assume that every day is the beginning, because you always have new readers.
Point to useful but little-known resources.
Don't include comments, people will cross post their responses.
Write posts that each include dozens of trackbacks to dozens of blog posts so that people will notice you.
Keep tweaking your template to make it include every conceivable bell or whistle.
Digest the good ideas of other people, all day, every day.
Invent a whole new kind of art or interaction.
Post on weekdays, because there are more readers.
Post on weekends, because there are fewer new posts.
Dress your blog (fonts and design) as well as you would dress yourself for a meeting with a stranger.
Edit yourself. Ruthlessly.
Be patient.
Give credit to those that inspired, it makes your writing more useful.
Ping technorati. Or have someone smarter than me tell you how to do it automatically.
Write about only one thing, in ever-deepening detail, so you become definitive.
Write in English.
Better, write in Chinese.
Write about obscure stuff that appeals to an obsessed minority.
Don't be boring.
Write stuff that people want to read and share.

## Boost Windows Vista Speed

While the discussion pertains to Vista particularly, the same applies to Windows in general too ! For a general user the first three are usually more than sufficient to make your Vista faster. The remaining are some more which a tweak enthusiast may wish to consider. Utilities like WinPatrol or Tune-Up Utilities can help you in most of the cases.

1. Restrict the no. of start-ups. Why have programs starting up when you dont really use them. Even those you use can always be started manually by clicking on the. I personally prefer not to have ANY starups. I click on my Internet Defense Suite manually, before connecting to the Internet. So decide for yourself which one's you really need as start-ups.

2. Disable services which one may not require. For example, if your pc is a stand-alone one, there may be sevral services which you can disable or switch over to manual mode. Auto-starting and closing down of services takes time & resources. These can be saved. BlackViper's Vista Service Configurations Windows Vista Service Configurations by Black Viper is an excellent guide to follow.

3. Reducing visual effects (eye candy). Right-click on “My Computer” > Properties > Advanced > Performance-Settings > Visual Effects > Adjust for best performance > Apply > OK.
To allow the themes and the glass effects, you may have to check on the boxes : enable transperant glass and use visual styles; this way atleast the spirit of Vista will be preserved- else be prepared for a really bland Vista ! Use your discretion. I know disabling all can actually negate the purpose of 'eye-friendly' Vista.

4. Ensure that boot defragmentation is enabled, so that files used during start-up are clubbed together.
Start Regedit. Navigate to HKEY_LOCAL_MACHINE\SOFTWARE\ Microsoft\Dfrg\BootOptimizeFunction . Select Enable from the list on the right.
Right Click on it and select Modify. Change the value to Y to enable and N to disable. Reboot.

5. Disable : "clear page file on shutdown" option. Cleaning the page-file on every shutdown means overwriting the data by zeros, and it takes time.
To clear/not clear page file you can apply this reg tweak. Back up registry before trying this.
Start->run->regedit [enter]
Go to HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Contro l\Session Manager\Memory Management
Modify (if not present, rt click in open space and create) the Value Data Type/s and Value Name/s :
Data Type: REG_DWORD [Dword Value]
Value Name: ClearPageFileAtShutdown
Setting for Value Data: [0 = Clear Page File Disabled / 1 = Clear Page File Enabled]
Exit Registry and Reboot.

6. Defragment your System Disk & Fine Tune your Registry. If you find the Vista's in-built defragger slow, you can try SysInternals Power Defragmenter Download Power Defragmenter 2.0.125 - Power Defragmenter takes defragmentation process to a whole new level - Softpedia which works on Vista too ! Use the freeware CCleaner to clear up your PC Junk and clean up the Registry. Compacting the Registry occasionally is a good idea too !

7. Generally people also recommend emptying the Prefetch directory once in a while. But Windows uses this directory to speed up launching
applications. It analyzes the files you use during startup and the applications you launch, and it creates an index to where those files and applications are located on your hard disk. Using this index, Windows can launch files and applications faster. Nevertheless clearing the Prefetcher say once a month is what I do !

8. Go to BIOS settings, by pressing del key during boot-up, and disable 'seek floppy drive' option. This saves time for those who do not use floppy drives. There are also some BIOS hacks like Enabling Quick Post, Disabling Boot Daly, etc but best to refrain from these.

9. Change Boot-Order Sequence : Normally, the bios is set to boot from floppy first, then CD and then Hard Disk. Changing the Boot-Order to be: Hard Disk first, then maybe CD/Floppy, could possibly "shave" a second, I guess !

10. Disable windows startup/shutdown/logon/logoff sounds. Go to control panel, sounds & audio devices, sound tab, in program events select 'no sound' for these events.

11. Disable the ScreenSaver if you dont need it. Rt-Click desktop>ScreenSaver>None>OK.

12. Fonts take time to load. Removing some can save on resources. But one must be careful in deciding which fonts to remove. If you delete some system fonts, you may b in for trouble. Tweak VI Pro is a good shareware to manage fonts. It uninstalls fonts without physically removing them. Open its help file. It lists down the system fonts which must not be deleted ! use the list; and then decide what to delete and what to keep.

13. To REALLY reduce your shutdown time.
Start Regedit. Navigate to HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Control.
Click on the "Control" Folder. Select "WaitToKillServiceTimeout"
Right click on it and select Modify. the default value is ( i think) 12000.
Setting it to a lower 4 digit value,( say 1000) will make your PC shutdown faster, but you could end up losing data, so use this tweak judiciously.

14. Get rid of all the extra programs Windows Vista installs. You may not be using some like WLM, Calculator, Games, Meeting Space, Fax, etc. Go To Control Panel\Programs\Programs and Features > Turn windows On or Off and do the needful.

15. Go To Control Panel\System and Maintenance\Performance Information and Tools. On the LHS you will see options to Adjust Indexing options, visual effexts, power Settings, etc. These all help directly and indirectly.