Find/Replace

[Shiv Kumar G.M.]

Hello gurus,
May I get some code on find and replace some word in a text file.

Regards,
Shivakumar G.M.

[Clearcode]

The find/replace dialog box is exported by the common dialog dll and used in most text applications.

The following is how to use it from VB.

First we need to declare all the API calls this uses and some global variables....


public Type FINDREPLACE
lStructSize as Long ' size of this struct 0x20
hwndOwner as Long ' handle to owner's window
hInstance as Long ' instance handle of.EXE that
' contains cust. dlg. template
flags as Long ' one or more of the FR_??
lpstrFindWhat as Long ' ptr. to search string
lpstrReplaceWith as Long ' ptr. to replace string
wFindWhatLen as Integer ' size of find buffer
wReplaceWithLen as Integer ' size of replace buffer
lCustData as Long ' data passed to hook fn.
lpfnHook as Long ' ptr. to hook fn. or null
lpTemplateName as Long ' custom template name
End Type

Declare Function FindText Lib "comdlg32.dll" Alias "FindTextA" (pFindreplace as FINDREPLACE) as Long
Declare Function ReplaceText Lib "comdlg32.dll" Alias "ReplaceTextA" (pFindreplace as FINDREPLACE) as Long



public Enum FindReplaceConstants
FR_DIALOGTERM = &H40
FR_DOWN = &H1
FR_ENABLEHOOK = &H100
FR_ENABLETEMPLATE = &H200
FR_ENABLETEMPLATEHANDLE = &H2000
FR_FINDNEXT = &H8
FR_HIDEMATCHCASE = &H8000
FR_HIDEUPDOWN = &H4000
FR_HIDEWHOLEWORD = &H10000
FR_MATCHCASE = &H4
FR_NOMATCHCASE = &H800
FR_NOUPDOWN = &H400
FR_NOWHOLEWORD = &H1000
FR_REPLACE = &H10
FR_REPLACEALL = &H20
FR_WHOLEWORD = &H2
End Enum

public Enum FindReplaceErrors
FRERR_BUFFERLENGTHZERO = &H4001
FRERR_FINDREPLACECODES = &H4000
End Enum

Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (byval lpString as string) as Long

'\ to find out why a common dialog call failed...
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () as Long


'\ to handle Tab/UpDown keys in dialog box
Type POINTAPI
x as Long
y as Long
End Type

Type Msg
hwnd as Long
message as Long
wParam as Long
lParam as Long
time as Long
pt as POINTAPI
End Type
Declare Function IsDialogMessage Lib "user32" Alias "IsDialogMessageA" (byval hDlg as Long, lpMsg as Msg) as Long

'\ to run apps
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (byval hwnd as Long, byval lpOperation as string, byval lpFile as string, byval lpParameters as string, byval lpDirectory as string, byval nShowCmd as Long) as Long

'\ member variables
private mTxtBox as TextBox

'\ USED to HANDLE DIALOG MESSAGES
Declare Function DefDlgProc Lib "user32" Alias "DefDlgProcA" (byval hDlg as Long, byval wMsg as Long, byval wParam as Long, byval lParam as Long) as Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (byval lpPrevWndFunc as Long, byval hwnd as Long, byval Msg as Long, byval wParam as Long, byval lParam as Long) as Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (byval hwnd as Long, byval nIndex as Long) as Long

Global mDlgHandle as Long
Global mDlgWndProc as Long

Global frThis as FINDREPLACE
Global sFindWhat as string
Global sReplaceWhat as string

Global ByteArray() as Byte
Global ByteArrayReplace() as Byte

private Const FINDREPLACEMESSAGE = "commdlg_FindReplace"


'\ sUBCLASSING THE TEXTBOX's parent....
'\ Declarations
private Const GWL_WNDPROC = (-4)
private Declare Function SetWindowLongApi Lib "user32" Alias "SetWindowLongA" (byval hwnd as Long, byval nIndex as Long, byval dwNewLong as Long) as Long
private lOldWndProcAddress as Long

'\ Getting the data from lParam
private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination as Any, _
Source as Any, _
byval Length as Long)


' Declarations for StringFromPointer
private Declare Function IsBadStringPtrByLong Lib "kernel32" Alias "IsBadStringPtrA" (byval lpsz as Long, byval ucchMax as Long) as Long




Then we need to write a WindowProc that handles the messages sent by the Find/Replace dialog box...


public Function VB_WindowProc(byval hwnd as Long, byval wMsg as Long, byval wParam as Long, byval lParam as Long) as Long

Dim mFindReplace as FINDREPLACE

If wMsg = FINDMSGSTRING then
'\ lParam is a pointer to a FINDREPLACE object
Call CopyMemory(mFindReplace, byval lParam, len(mFindReplace))

With mFindReplace
'\ Decode the message....
'\ Find out what data we have been passed....
If .wFindWhatLen > 0 then
sFindWhat = StringFromPointer(.lpstrFindWhat, CLng(.wFindWhatLen))
End If
If .wReplaceWithLen > 0 then
sReplaceWhat = StringFromPointer(.lpstrReplaceWith, CLng(.wReplaceWithLen))
End If

'\ And what button was pressed
Select Case true
Case .flags And FR_FINDNEXT
Call FindNext(sFindWhat, (.flags And FR_WHOLEWORD), (.flags And FR_MATCHCASE))
Case .flags And FR_REPLACE
Call Replace(sFindWhat, sReplaceWhat, (.flags And FR_WHOLEWORD), (.flags And FR_MATCHCASE), false)
Case .flags And FR_REPLACEALL
Call Replace(sFindWhat, sReplaceWhat, (.flags And FR_WHOLEWORD), (.flags And FR_MATCHCASE), true)
End Select
End With

else
'\ pass the message on to the textbox's window proc for processing
VB_WindowProc = CallWindowProc(lOldWndProcAddress, hwnd, wMsg, wParam, lParam)
End If

End Function




and because the window message FINDMSGSTRING must be registered before it can be used, I have put this in a function thus...


public property get FINDMSGSTRING() as Long

static msgValue as Long

If msgValue = 0 then
msgValue = RegisterWindowMessage(FINDREPLACEMESSAGE)
End If

FINDMSGSTRING = msgValue

End property





You can now start up the common dialog box and pass it whatever is selected in the textbox thus:


private Sub ShowDialog(byval txtboxIn as TextBox, byval bReplace as Boolean)

'\ Pre-initialise the strings that FindWhat and Replacewhat go into
sFindWhat = string$(1024, 0)
sReplaceWhat = string$(1024, 0)


Dim nByte as Long

'\ if we can't register the window message, do not proceed..
If FINDMSGSTRING = 0 then
MsgBox "Cannot Find/Replace - Call to register message failed"
Exit Sub
End If

'\ If a textbox was already subclassed, free it...
If lOldWndProcAddress <> 0 then
lOldWndProcAddress = SetWindowLongApi(mTxtBox.Parent.hwnd, GWL_WNDPROC, lOldWndProcAddress)
End If

'\ set our internal reference to be the actual textbox
set mTxtBox = txtboxIn

'\ Subclass that textbox to recieve messages from the Find/Replace dialog box
lOldWndProcAddress = SetWindowLongApi(mTxtBox.Parent.hwnd, GWL_WNDPROC, AddressOf VB_WindowProc)

sFindWhat = mTxtBox.SelText
ReDim ByteArray(0 to 1024) as Byte

If bReplace then
ReDim ByteArrayReplace(0 to 1024) as Byte
End If

'\ Copy the string to a byte array
for nByte = 0 to len(sFindWhat) - 1
ByteArray(nByte) = Asc(mid$(sFindWhat, nByte + 1, 1))
If bReplace then
ByteArrayReplace(nByte) = ByteArray(nByte)
End If
next nByte

With frThis
.lStructSize = len(frThis)
.hwndOwner = mTxtBox.Parent.hwnd
.lpstrFindWhat = VarPtr(ByteArray(0))
.wFindWhatLen = UBound(ByteArray)
If bReplace then
.lpstrReplaceWith = VarPtr(ByteArrayReplace(0))
.wReplaceWithLen = UBound(ByteArrayReplace)
else
.lpstrReplaceWith = 0
.wReplaceWithLen = 0
End If
End With

If bReplace then
mDlgHandle = ReplaceText(frThis)
else
mDlgHandle = FindText(frThis)
End If

If mDlgHandle <> 0 then
'\ get the resulting dialog's window proc in order to pass
'\ messages we don't handle to it...
mDlgWndProc = GetWindowLong(mDlgHandle, GWL_WNDPROC)
else
'\ Failed to show dialog - find out why...
If CommDlgExtendedError <> 0 then
'\ error HAS OCCURED
Debug.print CommDlgExtendedError
End If
End If

End Sub





Of course I've left the implementation of FindText() and ReplaceText for you - I can't do all the work

-------------------------------------------------
Ex. Datis: Duncan Jones
Merrion Computing Ltd
http://www.merrioncomputing.com
Check out the new downloads - ImageMap.ocx is the VB control that emulates an HTML image map, EventVB.OCX for adding new events to your VB form and adding System Tray support simply, MCL Hotkey for implemenmting system-wide hotkeys in your application...all with source code included.

[Green_Beret]

dim fs as Scripting.FileSystemObject
dim ts as TextStream

set fs = CreateObject("Scripting.FileSystemObject
")

Set ts = fs.OpenTextFile("c:\just.txt", ForReading)

txt = ts.ReadAll

txt = Replace(txt, "just", "merely", , , vbTextCompare)

ts.Close

Set ts = fs.OpenTextFile("c:\just.txt", ForWriting)

ts.Write (txt)

ts.Close

e.g : just.txt contains :
this is just a file
After the above operation :
this is merely a file.


Regards,
The Beret.

[Shiv Kumar G.M.]

Hello guru,
Thanks for ur help.

Regards,
Shivakumar G.M.

[Green_Beret]

You can atleast rate me!

Regards,
The Beret.

[TurboTad]

Will this work in ASP as well? I'm trying to do something similar right now where I've just got a whole bunch of CSV files in a directory, and I'm trying to do a batch find/replace on the whole thing automatically. I just want something simple that I can schedule and have it go through the directory and change the commas to semicolons.

I tried just making a VBscript using your code, and then running it with Cscript, but I failed utterly. Help?

--tad

[Green_Beret]

Can you post the code, and also mention what problems you faced?

Regards,
The Beret.

[TurboTad]

Green Beret -

Thanks for the help offer! Here's what I did (and mind you - I'm brand damned new at VBScript), basically modifying your earlier code.



dim fs as Scripting.FileSystemObject
dim ts as TextStream

set fs = CreateObject("Scripting.FileSystemObject")

set ts = fs.OpenTextFile("F:\Inetpub\wwwroot\TestData\DiskData\server1.txt", ForReading)

txt = ts.ReadAll
' I want to read in the file and change every
' instance of {quote},{quote} to no quotes and
' a semicolon delimiter. then I want to replace
' all the quotes with nothing.
txt = Replace(txt, "","", ";", , , vbTextCompare)
txt = Replace(txt, """, "", , , vbTextCompare)

ts.Close

set ts = fs.OpenTextFile("F:\Inetpub\wwwroot\TestData\DiskData\server1.txt", ForWriting)

ts.Write (txt)

ts.Close





--
Now, do I need to put any include statements in this in order to get it to work? Am I rolling in the right direction? My end goal in this is just to be able to do a mass find/replace of all the CSV files in a directory. Any help would be wonderful.

Thanks,

--tad

[Green_Beret]

Do you mean double quotes or single quotes?
Because if you mean single quotes then your code will become :

txt = Replace(txt,"','",";",,,vbTextCompare)
txt = Replace(txt,"'","",,,vbTextCompare)




Let me know if this is what you want?

Regards,
The Beret.