Word Wrap

2009-02-05T19:08:00.001-08:00

Using Visual Basic to word wrap :

Function WordWrap$ (St$, Length)

'-- This function converts raw text into CRLF delimited lines.
Length = Length + 1
St$ = Trim$(St$)
Cr$ = Chr$(13)
Crlf$ = Chr$(13) & Chr$(10)
Do
L = Len(NextLine$)
S = InStr(St$, " ")
C = InStr(St$, Cr$)
If C Then
If L + C <= Length Then
Text$ = Text$ & NextLine$ & Left$(St$, C)
NextLine$ = ""
St$ = Mid$(St$, C + 1)
GoTo LoopHere
End If
End If
If S Then
If L + S <= Length Then
DoneOnce = True
NextLine$ = NextLine$ & Left$(St$, S)
St$ = Mid$(St$, S + 1)
ElseIf S > Length Then
Text$ = Text$ & Crlf$ & Left$(St$, Length)
St$ = Mid$(St$, Length + 1)
Else
Text$ = Text$ & NextLine$ & Crlf$
NextLine$ = ""
End If
Else
If L Then
If L + Len(St$) > Length Then
Text$ = Text$ & NextLine$ & Crlf$ & St$ & Crlf$
Else
Text$ = Text$ & NextLine$ & St$ & Crlf$
End If
Else
Text$ = Text$ & St$ & Crlf$
End If
Exit Do
End If

LoopHere:

Loop
WordWrap$ = Text$

End Function

Replace String

2009-02-05T19:05:00.000-08:00

Function to replace string :

Public Function ReplaceString(ByVal pString As String, ByVal Keyword As String, ByVal NewKeyWord As String) As String
Dim StrLen As Integer
Dim StrOut As String
Dim KeyPos As Integer
Dim StrLenChange As Boolean
Dim StartPos As Integer

' set a few values before we go any further
StartPos = 1
StrLen = Len(pString)

' if the word to replace and the word to replace by are different lengths, record that they are
If Len(Keyword) <> Len(NewKeyWord) Then StrLenChange = True

' check to see where the first occurence of the keyword to replace is in the string
KeyPos = InStr(StartPos, pString, Keyword)

' only do the replace loop if the keyword string is there
While KeyPos > 0
' rebuild the string, taking out the keyword and replacing it with the NewKeyword
pString = Left(pString, KeyPos - 1) & NewKeyWord & Mid(pString, KeyPos + Len(Keyword), StrLen - KeyPos - Len(Keyword) + 1)

' if the Keyword and NewKeyword as different lengths then recalc the length of the string
If StrLenChange Then StrLen = Len(pString)

' calculate the position where we should start looking to see if the KeyWord is in the string
StartPos = KeyPos + Len(NewKeyWord)

' check to see where the next occurence of the keyword to replace is in the string
KeyPos = InStr(StartPos, pString, Keyword)
Wend

' return the string
ReplaceString = pString

End Function

Parse String

2009-02-05T19:03:00.000-08:00

This code is using to parse string :

Private Sub cmdParse_Click()

Dim colWords As Collection
Dim lngWordCount As Long
Dim lngCounter As Long

lstResults.Clear

Set colWords = ParseString(txtParse.Text)
lngWordCount = colWords.Count

For lngCounter = 1 To lngWordCount
lstResults.AddItem colWords.Item(lngCounter).Value
DoEvents
Next lngCounter

Set colWords = Nothing

End Sub

Delay Program

2009-02-05T18:58:00.000-08:00

Here if you want to make delay program using Visual Basic :

Public Sub BKWait(HowManySecs)
' pause for HowManySecs seconds
Dim EndWait
EndWait = DateAdd("s", HowManySecs, Now)
While Now < EndWait
' dummy text
Wend
End Sub

Check String

2009-02-04T23:37:00.000-08:00

Option Explicit

Private Function IsNumber(strg As String)

Dim nInt As String

'Check if string contains a number

If IsNumeric(strg) Then
nInt = Int(strg)

' Check if number is an integer
If strg = nInt Then

' Put your code here

MsgBox "It is an Integer number"

Else

' Put your code here

MsgBox "It is a NON Integer number"

End If
Else

' Put your code here

MsgBox "It is NOT a number"

End If

End Function

Private Sub Command1_Click()

IsNumber Text1.Text

End Sub

Read and Write INI file

2009-02-04T23:28:00.000-08:00

This sample code how to create visual basic program to write and read ini file :

VERSION 5.00
Begin VB.Form frmReadAndWriteIni
Caption = "Form1"
ClientHeight = 2265
ClientLeft = 60
ClientTop = 345
ClientWidth = 4590
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 2265
ScaleWidth = 4590
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdWritePrivateProfileSetting
Caption = "&Write Private Profile Setting"
Height = 840
Left = 150
TabIndex = 1
Top = 1200
Width = 4125
End
Begin VB.CommandButton cmdReadFromIni
Caption = "&Read From Ini"
Height = 840
Left = 150
TabIndex = 0
Top = 150
Width = 4125
End
End
Attribute VB_Name = "frmReadAndWriteIni"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1999-2005, Vivek Nigam All Rights Reserved.
' Code contain copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' You are free to use this code within your own applications,
' but you are expressly forbidden from selling or otherwise
' distributing this source code without prior written consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' #VBCode#************************************************************
' * Programmer Name : Vivek Nigam
' * Web Site :
' * E-Mail : vivek.nigam19@hotmail.com
' * Date : 16/04/2002
' * Time : 12:40 PM
' * Module Name : Read And Write your Ini Files
' * Module Filename : Prjini.vbp
' * Procedure Name :
' * Parameters :
' *
' **********************************************************************
' * Comments : Read And write From Ini
' *
' **********************************************************************
Dim RtnStr As String ' receives the value read from the INI file
Dim sRetVal As Long ' receives length of the returned string
Dim ComputerName As String
Dim UserName As String
Dim ScanDate As Variant
Dim OperatingSystem As String
Dim ServicePack As String
Dim WindowsVersion As String
Dim CPUManufacturer As String
Dim CPUType As String
Dim CPUSpeed As Integer
Dim MemoryTotal As Long
Dim MemoryPaged As Long
Dim FixedDrive As String
Dim CdRom As String
Dim NetworkDrive As String
Dim SourceFolder As String
Dim objFSO As Object
Dim ObjFile As Variant
Dim ObjFolder As Variant
Dim ProductName As String
Dim ProductVersion As String
Dim PrinterName As String
Dim PrinterConnection As String
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Sub ReadFromINI()
'---------------------------------------------------------------------------------
'Procedure: ReadFromINI
'Parameter:
'Return Value :RtnStr : Number Of Characters Read From The Files
'Description : This function call the WindowsAPI Function (GetPrivateProfileString) To read data from the section from INI
'---------------------------------------------------------------------------------
On Error Resume Next
sRetVal = GetPrivateProfileString("PCInfo", "ComputerName", "0", RtnStr, 255, SourceFolder & "\" & ObjFile.Name)
ComputerName = Left$(RtnStr, sRetVal) ' extract the returned string from the buffer

sRetVal = GetPrivateProfileString("PCInfo", "UserName", "0", RtnStr, 255, SourceFolder & "\" & ObjFile.Name)
UserName = Left$(RtnStr, sRetVal) ' extract the returned string from the buffer

sRetVal = GetPrivateProfileString("PCInfo", "ScanDate", "0", RtnStr, 255, SourceFolder & "\" & ObjFile.Name)
ScanDate = Left$(RtnStr, sRetVal) ' extract the returned string from the buffer

sRetVal = GetPrivateProfileString("PCInfo", "OperatingSystem", "0", RtnStr, 255, SourceFolder & "\" & ObjFile.Name)
OperatingSystem = Left$(RtnStr, sRetVal) ' extract the returned string from the buffer

sRetVal = GetPrivateProfileString("PCInfo", "ServicePack", "0", RtnStr, 255, SourceFolder & "\" & ObjFile.Name)
ServicePack = Left$(RtnStr, sRetVal) ' extract the returned string from the buffer

sRetVal = GetPrivateProfileString("PCInfo", "WindowsVersion", "0", RtnStr, 255, SourceFolder & "\" & ObjFile.Name)
WindowsVersion = Left$(RtnStr, sRetVal) ' extract the returned string from the buffer

sRetVal = GetPrivateProfileString("PCInfo", "CPUManufacturer", "0", RtnStr, 255, SourceFolder & "\" & ObjFile.Name)
CPUManufacturer = Left$(RtnStr, sRetVal) ' extract the returned string from the buffer

sRetVal = GetPrivateProfileString("PCInfo", "CPUType", "0", RtnStr, 255, SourceFolder & "\" & ObjFile.Name)
CPUType = Left$(RtnStr, sRetVal) ' extract the returned string from the buffer

sRetVal = GetPrivateProfileString("PCInfo", "CPUSpeed", "0", RtnStr, 255, SourceFolder & "\" & ObjFile.Name)
CPUSpeed = Left$(RtnStr, sRetVal) ' extract the returned string from the buffer

sRetVal = GetPrivateProfileString("PCInfo", "MemoryTotal", "0", RtnStr, 255, SourceFolder & "\" & ObjFile.Name)
MemoryTotal = Left$(RtnStr, sRetVal) ' extract the returned string from the buffer

sRetVal = GetPrivateProfileString("PCInfo", "MemoryPaged", "0", RtnStr, 255, SourceFolder & "\" & ObjFile.Name)
MemoryPaged = Left$(RtnStr, sRetVal) ' extract the returned string from the buffer

sRetVal = GetPrivateProfileString("Drives", "Fixed Drive", "0", RtnStr, 255, SourceFolder & "\" & ObjFile.Name)
FixedDrive = Left$(RtnStr, sRetVal) ' extract the returned string from the buffer

sRetVal = GetPrivateProfileString("Drives", "Cd-Rom", "0", RtnStr, 255, SourceFolder & "\" & ObjFile.Name)
CdRom = Left$(RtnStr, sRetVal) ' extract the returned string from the buffer

sRetVal = GetPrivateProfileString("Drives", "Network Drive", "0", RtnStr, 255, SourceFolder & "\" & ObjFile.Name)
NetworkDrive = Left$(RtnStr, sRetVal) ' extract the returned string from the buffer

Call ReadPrinter
Call ReadSoftware

End Sub
Sub ReadPrinter()
On Error Resume Next
Dim TextLine As String
Dim strTemp1 As String
Dim strTemp2 As String
Dim strTemp3 As String
Dim strTemp4 As String
Dim BlankLnFlag As Boolean
BlankLnFlag = False
Open SourceFolder & "\" & ObjFile.Name For Input As #1 ' Open file.
strTemp1 = "PrinterName="
strTemp2 = "PrinterConnection="
Do While Not EOF(1) ' Loop until end of file.
Line Input #1, TextLine
strTemp3 = Left(TextLine, 12)
If TextLine = "" And BlankLnFlag = True Then
Exit Do
End If
If strTemp1 = strTemp3 Then
BlankLnFlag = True
PrinterName = Mid(TextLine, Len(strTemp1) + 1, Len(Trim(TextLine)))
If Not EOF(1) Then
Line Input #1, TextLine
strTemp4 = Left(TextLine, 18)
If strTemp2 = strTemp4 Then
PrinterConnection = Mid(TextLine, Len(strTemp4) + 1, Len(Trim(TextLine)))
End If
End If
End If
Loop
Close #1 ' Close file
End Sub
Sub ReadSoftware()
On Error Resume Next
Dim TextLine As String
Dim strTemp1 As String
Dim strTemp2 As String
Dim strTemp3 As String
Dim strTemp4 As String

Open SourceFolder & "\" & ObjFile.Name For Input As #1 ' Open file.
strTemp1 = "ProductName="
strTemp2 = "ProductVersion="
Do While Not EOF(1) ' Loop until end of file.
Line Input #1, TextLine
strTemp3 = Left(TextLine, 12)
If strTemp1 = strTemp3 Then
ProductName = Mid(TextLine, Len(strTemp1) + 1, Len(Trim(TextLine)))
If Not EOF(1) Then
Line Input #1, TextLine
strTemp4 = Left(TextLine, 15)
If strTemp2 = strTemp4 Then
ProductVersion = Mid(TextLine, Len(strTemp4) + 1, Len(Trim(TextLine)))
End If
End If
End If
Loop
Close #1 ' Close file
End Sub
Sub ReadFiles()
On Error GoTo ErrorHandler ' Enable error-handling routine.
Set objFSO = CreateObject("Scripting.FileSystemObject")
SourceFolder = App.Path
If objFSO.FolderExists(SourceFolder) Then
Set ObjFolder = objFSO.GetFolder(SourceFolder)
For Each ObjFile In ObjFolder.Files
'If InStr(ObjFile.Type, UCase("INI")) > 0 Then '// For reading the Type of File
If InStr(ObjFile, ".ini") > 0 Then
Call ReadFromINI '// Ok
'Kill (SourceFolder & "/" & ObjFile.Name)'// Please remove the comments if you wants to kill file after reading
End If
Next
End If
Set ObjFolder = Nothing
Set ObjFile = Nothing
Set objFSO = Nothing
Exit Sub ' Exit to avoid handler.
ErrorHandler: ' Error-handling routine.
Set ObjFolder = Nothing
Set ObjFile = Nothing
Set objFSO = Nothing
End
End Sub

Private Sub cmdReadFromIni_Click()
RtnStr = Space(255) ' provide enough room for the function to put the value into the buffer
Call ReadFiles
Debug.Print ComputerName & ";" & UserName & ";" & ScanDate & ";" & OperatingSystem & ";" & ServicePack _
& ";" & WindowsVersion & ";" & CPUManufacturer & ";" & CPUType & ";" & CPUSpeed _
& ";" & MemoryTotal & ";" & MemoryPaged & ";" & FixedDrive & ";" & CdRom _
& ";" & NetworkDrive & ";" & PrinterName & ";" & PrinterConnection & ";" & ProductName _
& ";" & ProductVersion

End Sub
Private Sub cmdWritePrivateProfileSetting_Click()
Call WriteToINI
End Sub

Sub WriteToINI()
'---------------------------------------------------------------------------------
'Procedure: WriteToINI
'Parameter:
'Return Value :RtnStr : Number Of Characters Read From The Files
'Description : This function call the WindowsAPI Function (WritePrivateProfileString) To store data into INI
'sRetVal = WritePrivateProfileString(SectionName, KeyField, KeyVal, FilePath)
'---------------------------------------------------------------------------------
sRetVal = WritePrivateProfileString("Personal Information", "Name", "Vivek Nigam", App.Path & "\WriteIniFile.ini")
sRetVal = WritePrivateProfileString("Personal Information", "Address", "UK", App.Path & "\WriteIniFile.ini")
sRetVal = WritePrivateProfileString("EmailAddress", "EmailId", "vivek_nigam19@hotmail.com", App.Path & "\WriteIniFile.ini")
End Sub

Free Visual Basic

2009-02-04T20:07:00.000-08:00

Welcome to freevisualbasic.blogspot.com

You can find all of visual basic code here..

I hope you will enjoy with my blog.

Regards.