Pages

Tuesday, 21 December 2010

Replace all Occurrences of One String With Another

Public Function Replace(ByVal sInputVal As String, _
sFind As String, sReplaceWith As String) As String

'NOTE: IF YOU HAVE VB6 OR HIGHER,
'YOU DON'T NEED THIS. JUST USE
'THE BUILT IN REPLACE FUNCTION
Dim nPos As Long
Dim sAns As String
Dim sWkg As String

If Len(sFind) <> 0 Then
nPos = InStr(sInputVal, sFind)
If nPos <> 0 Then
sWkg = sInputVal
Do
If nPos >= Len(sWkg) Then
sAns = sAns & Left$(sWkg, Len(sWkg) - 1) _
& sReplaceWith
Else
sAns = sAns & Left$(sWkg, nPos - 1) _
& sReplaceWith
nPos = nPos + Len(sFind) - 1
End If
sWkg = Mid$(sWkg, nPos + 1)
nPos = InStr(sWkg, sFind)
Loop While nPos > 0
sAns = sAns & sWkg
Else
sAns = sInputVal
End If
Replace = sAns
Else
Replace = sInputVal
End If

End Function

Wednesday, 1 December 2010

VB code :Use for Create an internet shortcut

Public Const NOERROR = 0
Public Const CSIDL_FAVORITES = &H6
Public Const CSIDL_DESKTOPDIRECTORY = &H10

Private Type SHITEMID
cb As Long
abID As Byte
End Type

Private Type ITEMIDLIST
mkid As SHITEMID
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll"_
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long,_
ByVal pszPath As String) As Long

Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long,_
ByVal nFolder As Long,_
pidl As ITEMIDLIST) As Long

Private Function GetSpecialPath(CSIDL As Long) As String

Dim r As Long
Dim path As String
Dim IDL As ITEMIDLIST

'fill the idl structure with the specified folder item
r = SHGetSpecialFolderLocation(Me.hwnd, CSIDL, IDL)

If r = NOERROR Then
path$ = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal path$)
GetSpecialPath = Left$(path, InStr(path, Chr$(0)) - 1)
Exit Function
End If

GetSpecialPath = ""

End Function

Private Sub cmdShortcut_Click()

Dim URLpath As String
Dim CSIDLpath As String
Dim nameofLink As String
Dim ff As Integer
URLpath = "http://www.vbsquare.com"
CSIDLpath = GetSpecialPath(CSIDL_FAVORITES) & "\"
nameofLink = "The VB Module.url"

ff = FreeFile

Open CSIDLpath & nameofLink For Output As #ff
Print #ff, "[InternetShortcut]"
Print #ff, "URL=" & URLpath
Close #ff

End Sub

Visual basic 6.0 wallpapers
Visual basic 6.0 wallpapers
Visual basic 6.0 wallpapers
Visual basic 6.0 wallpapers

Simple Visual basic : Disconnect from the internet

Be ready u can learn to visual basic 6.0 code is simple and easy.so, now u can learn at home or school. Here code and form.......

Public Const RAS_MAXENTRYNAME As Integer = 256
Public Const RAS_MAXDEVICETYPE As Integer = 16
Public Const RAS_MAXDEVICENAME As Integer = 128
Public Const RAS_RASCONNSIZE As Integer = 412

Public Type RasEntryName
dwSize As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
End Type

Public Type RasConn
dwSize As Long
hRasConn As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
szDeviceType(RAS_MAXDEVICETYPE) As Byte
szDeviceName(RAS_MAXDEVICENAME) As Byte
End Type

Public Declare Function RasEnumConnections Lib _
"rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As _
Any, lpcb As Long, lpcConnections As Long) As Long

Public Declare Function RasHangUp Lib "rasapi32.dll" Alias _
"RasHangUpA" (ByVal hRasConn As Long) As Long

Public gstrISPName As String
Public ReturnCode As Long

Public Sub HangUp()
Dim i As Long
Dim lpRasConn(255) As RasConn
Dim lpcb As Long
Dim lpcConnections As Long
Dim hRasConn As Long
lpRasConn(0).dwSize = RAS_RASCONNSIZE
lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize
lpcConnections = 0
ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, _
lpcConnections)

If ReturnCode = ERROR_SUCCESS Then
For i = 0 To lpcConnections - 1
If Trim(ByteToString(lpRasConn(i).szEntryName)) _
= Trim(gstrISPName) Then
hRasConn = lpRasConn(i).hRasConn
ReturnCode = RasHangUp(ByVal hRasConn)
End If
Next i
End If

End Sub

Public Function ByteToString(bytString() As Byte) As String
Dim i As Integer
ByteToString = ""
i = 0
While bytString(i) = 0&
ByteToString = ByteToString & Chr(bytString(i))
i = i + 1
Wend
End Function


Visual basic 6.0 wallpapers
Visual basic 6.0 wallpapers
Visual basic 6.0 wallpapers
Visual basic 6.0 wallpapers