Calvin Hsia's WebLog

Thursday, June 15, 2006 12:04 PM

Customizing the Blog Crawler for different formats

I’ve had several requests that require customizing the Blog Crawler.

The entire source code of the Blog Crawler is available, so it can be modified to crawl blogs other than http://blogs.msdn.com

Currently, it saves the entire HTML retrieved from a blog’s URL. It converts relative links to absolute like so:

From href="http://blogs.msdn.com/Themes/Blogs/hover/style/style.css"

To href="http://blogs.msdn.com/Themes/Blogs/hover/style/style.css"

This allows the web control to render the page with the CSS references as well as making all the links on the page live. When it’s rendered, links like CSS and images are retrieved as needed. This is fairly slow, and requires an online connection.

The Foxpro version of the crawler actually saves the HTML page as an MHT file (from IE, File->Save As->Type->Web Archive, single file), which means all images and CSS are stored in the file, so no online content is retrieved, and it’s much faster to render the pages. I might update the VB version to save as MHT file, perhaps as an option. Which way would you prefer?

A blog endpoint is an actual blog post permalink. Several blog URL’s are not endpoints: for example, they may be a summary of postings for the month, by category, etc.

The crawler determines if it’s an endpoint by counting the number of “/” in the URL with 1 line of code. This can be changed easily to accommodate other blogs.

fIsPostedEntry = cUrl.Replace("/", "").Length + 8 = cUrl.Length ' if there are 8 backslashes, then it's a blog entry ("http://blogs.msdn.com/calvin_hsia/archive/2006/05/16/599108.aspx")

The crawler assumes that every blog entry starts with the same root URL, like “http://blogs.msdn.com/calvin_hsia”. It crawls the blog’s home page, like http://blogs.msdn.com/calvin_hsia and finds all the links with the same root and adds them to a table. If it’s an endpoint, the page is saved into the table as well.

The way the crawler parses out the published date is probably very customized to http://blogs.msdn.com

Case "div" ' Parse out the Publish date

If fIsPostedEntry Then

Dim oC As Object

oC = .Attributes.GetNamedItem("class")

If Not oC Is Nothing And Not oC.value Is Nothing Then

Dim cClass As String = oC.Value

If (cClass = "postfoot" Or cClass = "posthead") And Not .innerText Is Nothing Then

Dim cText As String = .innerText.Replace("Published", "")

If cText.Length > 0 Then

Try

cText = cText.Trim.Substring(0, cText.IndexOf(CStr(IIf(cText.IndexOf("AM") > 0, "AM", "PM"))) + 2)

dtPubDate = DateTime.Parse(cText)

fGotPubDate = True

Catch ex As Exception

System.Diagnostics.Debug.WriteLine("Date parse err: " + ex.Message)

End Try

End If

The way the crawler parses out links for endpoints, it looks for “archive/2” (as in “archive/2006”) in the URL There were some links on my blogs from comment spam which needed to be filtered out too.

Case "a" ' it's a link

cLink = .Attributes("href").value.Replace("%5f", "_").ToString.ToLower

If cLink.StartsWith(cBlogUrl) And cLink <> cCurrentLink Then ' if it's to the blog

If (Not cLink.Contains("#")) And cLink.Contains("archive/2") Then 'like archive/2006

If cLink.Contains("<") OrElse cLink.Contains("%") Then ' some comment spam

Else

<< got good link >>

End If

Changing the code to work with blogs other than http://blogs.msdn.com means seeing how much they differ in format and changing these areas of code.

For example, http://blogs is an internal Microsoft blogging site. It says “Posted on “ rather than “Published on “, so that would need to be changed.

posted by Calvin_Hsia | 0 Comments

Wednesday, June 14, 2006 4:52 PM

How does EventHandler work? IConnectionPoint!

The EventHandler function allows you to connect some code to an object’s event interface. For example, Word allows you to run code when the user changes the Selected text in a document. An ADODB Recordset will fire events, such as WillMove and MoveComplete when moving from record to record.

The EventHandler function takes 2 objects as parameters: the event source, like Word or a RecordSet, and the event sink, like the code you’d like to run. Your event sink code must Implement an interface defined by the source.

EventHandler then does some handshaking between the two to get the events working.

It queries the Source for IConnectionPointContainer,
then uses that to call EnumConnectionPoints to enumerate the connection points.
The sink object is queried for the interface of each found connection point to see if it’s implemented.
If found, then the IConnectionPoint->Advise method is called to start the event handling.

The sample below creates an ADODB Recordset and makes a few calls to MoveNext, with and without an event sink attached. You can change the event sink connection to be the VFP native EventHandler function, or you can use the generated machine code to show how it works. Both ways return the same results.

Here are a couple issues:

We need a COM interface to the Event Sink (“myclass”) , which is not a COM object. We get that from the _VFP.Objects collection, which is using COM
We need a way to call generated machine code. I used the EnumChildWindows function, which is relatively painless. I just pass it the address of the code to execute as the EnumChildWindowProc, which returns False, so that it’s only called once.
The code has a lot of conditional jumps and some error checking. The jumping needs to be resolved in a 2 pass assembler. That’s what the Jump table does. It records the definitions and references of labels, then after the code is generated, the table is scanned for jump address fixups. Most assemblers use two passes.
The sample code is a little different from the native VFP EventHandler function: it doesn’t enumerate all the connection points, but rather does a FindConnectionPoint for the particular RecordSetEvents interface.

You can modify the sample to bind events in other scenarios. For example, I’ve found some objects may not work properly with EnumConnectionPoints, but work only with FindConnectionPoint. Other people have reported that the object may not have a Source interface, but do implement IConnectionPointContainer on other interfaces.

For example, oleview and navigate to Microsoft Word 11.0 Object library and dbl-click. Navigate to CoClass, CoClass Application

coclass Application {

[default] interface _Application;

[source] dispinterface ApplicationEvents;

[source] dispinterface ApplicationEvents2;

[source] dispinterface ApplicationEvents3;

[default, source] dispinterface ApplicationEvents4;

};

The Word typelibrary shows that the Application interface sources some event interfaces.

If you look at c:\windows\system32\msfeeds.dll (which comes from installing IE7 beta 2) via OleView, there are no Source interfaces. However, you can call the GetWatcher method (the 24^th vTable entry (offset 0x60)) of the IFeedFolder object to get a ConnectionPointContainer object.

As an exercise to the reader (Craig: this means you!), modify the sample code to connect events for RSSFeeds.

The VB version of the Blog Crawler

This is the VB.Net 2005 version of the Blog Crawler. It’s based on the Foxpro version, but.it uses SQL Server Everywhere so you can deploy it on your mobile device! It crawls a blog and stores all entries into a SQL Server Everywhere table. This includes blog comments and Cascading Style Sheets.

I had to wait to post this blog entry because SQL Everywhere CTP public release is today (announced at Tech Ed)!

To run it, you only need to copy a few files from this link (1.6 megabytes) into a directory on your machine and start BlogCrawl.Exe. There is no registration or install of any kind required, except the Net Framework 2.0 (which is installed with Visual Studio 2005, or you can download the runtime). The Source code can be unzipped into the same folder and is here. The program (including SQL /E) is totally isolated to the install folder, except for the My Settings XML file which stores your preferences in your local settings folder. It doesn’t touch your registry or install any other files.

When you start the program, the top part shows a grid of already crawled blog posts. The bottom part shows each post in a web control as it looked at the time of download. The links on the page are live. When first starting, there will be no data. If you click the Crawl button, it will start a background thread that scans the blog and downloads any entries that have not been downloaded yet. The status bar shows crawl progress.

It takes about 20 minutes to crawl my blog and download my 240 posts. You can stop and continue the background thread at any time by hitting the same Crawl button. The data is stored as a SQL Mobile database in the same folder in a file called <blogname>.sdf.

You can type a search string in the textbox and click the Search button to limit the number of records in the grid to those blogs containing the search string.

It’s customized for blogs hosted on http://blogs.msdn.com for parsing out the blog entry publication date and determining what page is a blog post and what is just an intermediate page (like February posts). I haven’t tested it with all the various blog CSS styles, but the source can be modified.

The program defaults to crawling my blog, but allows you to switch to other blogs. Click the Blog Options button to crawl your favorite blog.

If you change the Followed value for a particular entry to 0, then the next crawl will recrawl that link, perhaps if you want to get the latest comments.

It uses the new MySettings feature to persist user settings, such as window position and which blog was last crawled. The new SplitContainer class allows you to move the splitter bar between the grid and the web control and the SplitterDistance is persisted in My.Settings.

One of my machines was playing a sound while my web crawler was crawling. The culprit was Control Panel->Sounds->Sound->Windows Explorer->Information Bar.

If your machine freezes, maybe you can reboot it gracefully from another machine

For some reason, one of my machines running Windows XP seemed to die while I was away at a meeting. I could still see all the applications I had left running on the desktop. The physical connections seemed to be fine, but any mouse move or keystroke was ignored. Even Ctrl-Alt-Del didn’t work. I could see the mouse cursor, but it didn’t budge.

It’s on a multiswitch box, which allows me to switch the mouse/keyboard/monitor to any of 3 different machines by a keystroke combination. The switching worked and showed that the mouse/keyboard were working just fine.

I could ping the machine, and it would respond. It’s a web server, and I could hit the web site and it served up web pages as expected.

The UI just seemed totally frozen. I didn’t want to just cycle the power on/off.

So I used the CREATEOBJECTEX( ) Function to create an instance of VFP on that machine and shut it down gracefully. The Kill command from the Windows resource kit sends a message to each app to shutdown. You can also use the TASKKILL command.

ox=CREATEOBJECTEX("visualfoxpro.application","calvinh6")

ox.DoCmd("!/n kill outlook")

ox.DoCmd("!/n kill mstsc")

ox.DoCmd("!/n kill ps")

ox.DoCmd("!/n kill winword")

ox.DoCmd("!/n shutdown -r")

Use conditional build events to freshen zip files in Visual Studio

I wanted to update a couple zip files of the VB version of my Blog Crawler (to be posted soon) with the latest and greatest when I built the Release version of a project. I used the XCOPY command with the /D option to update only if changed. Copying to a ZIP file extension actually puts the file into the ZIP file. Is this a feature of Win XP or Winzip? I suspect it’s Win XP Compressed folder behavior. Nice.

In VS 2005 (the steps for prior VS versions are slightly different), choose Project->Properties->Compile. Build Events.

I didn’t see a way to make the build events run conditionally depending on configuration: Debug or Release, nor did these configurations have their own separate settings. So, I used the IF command.

For the Post-Build Event, I added these lines using the build event editor and the Macros dialog to help build the strings.

if $(ConfigurationName)==Release xcopy /df $(ProjectDir)$(TargetName)*.vb $(ProjectDir)$(TargetName)Source.zip

if $(ConfigurationName)==Release xcopy /df $(TargetDir)$(TargetName)$(TargetExt) $(ProjectDir)$(TargetName)Runtime.zip

Choose: “Run the post build event:“ On Successful Build

In the Output Build window, the commands are echoed with the macros expanded, and the results are shown:

BlogCrawl -> d:\dev\vb\BlogCrawl\bin\Release\BlogCrawl.exe

if Release==Release xcopy /df d:\dev\vb\BlogCrawl\BlogCrawl*.vb d:\dev\vb\BlogCrawl\BlogCrawlSource.zip

if Release==Release xcopy /df d:\dev\vb\BlogCrawl\bin\Release\BlogCrawl.exe d:\dev\vb\BlogCrawl\BlogCrawlRuntime.zip

D:\dev\vb\BlogCrawl\BlogCrawl.vb -> D:\dev\vb\BlogCrawl\BlogCrawlSource.zip

1 File(s) copied

D:\dev\vb\BlogCrawl\bin\Release\BlogCrawl.exe -> D:\dev\vb\BlogCrawl\BlogCrawlRuntime.zip

1 File(s) copied

Of course, when building the Debug version the output is different:

BlogCrawl -> d:\dev\vb\BlogCrawl\bin\Debug\BlogCrawl.exe

if Debug==Release xcopy /df d:\dev\vb\BlogCrawl\BlogCrawl*.vb d:\dev\vb\BlogCrawl\BlogCrawlSource.zip

if Debug==Release xcopy /df d:\dev\vb\BlogCrawl\bin\Debug\BlogCrawl.exe d:\dev\vb\BlogCrawl\BlogCrawlRuntime.zip

posted by Calvin_Hsia | 2 Comments

Monday, June 05, 2006 3:10 PM

Error Reading File infinite loop if drive disabled while file open and Data Session window open

If you have a file open on some drive (perhaps a USB or network drive) and the Data Session window open, try disconnecting the drive somehow. Perhaps yank the network cable, pull the USB drive even though Windows says not to, or even move out of wireless range.

Change the filename below to refer to that drive and run this code:

CLEAR ALL

CLEAR

cTable="e:\test.dbf"

SET && activate data session window

IF !FILE(ctable)

CREATE TABLE (cTable) (name c(10))

INSERT INTO test VALUES ("one")

INSERT INTO test VALUES ("two")

ENDIF

USE (cTable) SHARED

LIST

MESSAGEBOX("Remove or disable drive now")

LIST

I get an error message: Error reading file e:\test.dbf.

When dismissed, the error recurs ad infinitum, allowing no chance for me to close the file. The only thing I can do is terminate the process.

Have you ever run into this one?

The Data Session window is periodically trying to refresh itself. It displays the various tables in use, the number of records and the workarea of the current cursor. When an error occurs, it reports it. Then it repeats.

A simple fix: catch the error and don’t do anything. If the use subsequently tries to read from the table using some other operation, then the error will recur then.

Moral: when processing a periodic event, be careful about reporting errors.

History: the Data Session window used to be called the View window, and in fact the routines are called ViewNull and DrawView. Parts of this code probably date back to FoxBase days over 15 years ago!

Webcrawl a blog to retrieve all entries locally: RSS on steroids

Today’s sample shows how to create a web crawler in the background. This crawler starts with a web page, looks for all links on that page, and follows all those links. The links are filtered to my blog, but generalizing the code to search the entire web or some other site is trivial (if you have enough disk space<g>). (VB.Net version to appear soon on this blog.)

I was doing a search on my blog for “ancestors” via the Search box on the sidebar on the left, and there were no results. Strange, I thought, so I used MSN search for my site:

http://search.msn.com/results.aspx?FORM=TOOLBR&q=ancestors+site%3Ahttp%3A%2F%2Fblogs.msdn.com%2FCalvin_Hsia%2F

That search succeeded: it came up with the expected blog entry.

This incident reminded me of the fact that I’ve done a lot of work to create my blog, but I depend on a 3^rd party to maintain it. There are hundreds of code samples, with links to references. If the blog server were to disappear for some reason, so would all my content. I wanted to retrieve all my blog content into a local table. Then I can manipulate it any way I want.

In particular, suppose I want to read my entire blog. I would have to do a lot of manual clicking to get to the month/day of the post, and then I might have missed something because I’m manually crawling. That’s pretty cumbersome. Also, I can have all of a blog available while offline, updating when connected.

So I wrote a code sample below that crawls my blog, looking for all the blog posts, and shows them in a form which has search capability. Because it’s all local, searching and navigating from post to post is extremely fast. The entry is displayed in a web control, so the page looks just like it would online and the hyperlinks are all live.

You can start a web crawl by pushing the Crawl button. You can interrupt the web crawl by typing ‘Q’ (<esc> will cancel the automation of the IE SaveAs dialog). The next time the crawl runs, it will resume where it left off. Crawling acts as if you were subscribed to my blog via RSS. Once you have all current content, Crawling again later will just add any new content. The saved content is the entire blog entry web page, including any comments. As an exercise, readers are encouraged to make the web crawling execute on a background thread!

A crawl starts at the main page http://blogs.msdn.com/Calvin_Hsia, which shows any new content and has links on the side bar for any other posts. The page is loaded and then parsed for any links. Any links pointing to my blog are inserted into a table if they’re not there already. Then the table is scanned for any unfollowed links and the process repeats. If a page is a leaf node (currently any link with 8 backslashes) then the Publication date is parsed, and the file is saved in the MHT field in the table. The link parsing was a little complicated due to some comment spam reducing measures and some broken links when the blog host server switched software.

You will probably have to modify the code if you want to do the same for other blogs. For example, some blogs may have the Publication date in a different place. Others may have archive links elsewhere or in a different format.

I experimented with using HTTPGet

cTempFile=ADDBS(GETENV("TEMP"))+SYS(3)+".htm"

LOCAL oHTTP as "winhttp.winhttprequest.5.1"

LOCAL cHTML

oHTTP=NEWOBJECT("winhttp.winhttprequest.5.1")

oHTTP.Open("GET","http://blogs.msdn.com/calvin_hsia/archive/2004/06/28/168054.aspx",.f.)

oHTTP.Send()

STRTOFILE(ohTTP.ResponseText,cTempFile)

oIE=CREATEOBJECT("InternetExplorer.Application")

oIE.Visible=1

oIE.Navigate(cTempFile)

But the content looked pretty bad, because of the CSS references, pictures, etc.

Being able to automate IE was helpful, but how do you parse the HTML for the links to each blog entry? I thought about using an XSLT, but that was fairly complex. I used the IE Document model IHTMLDocument,to search through the HTML nodes for links.

IE has a feature that saves a web page to a single file: Web Archive, single file(*.mht) from the File->SaveAs menu option. So I used Windows Scripting Host to automate this feature.

Making the code run in a background thread is trivial: just use the ThreadClass from here.

More Multithread capabilities: interthread synchronization, error checking

In a prior post: Create multiple threads from within your application, there is a sample Thread Class that can be used to create multiple threads that can execute VFP code.

Today’s sample presents code that demonstrates how a thread can send messages to another thread, such as “I’m almost done” or “Please abort what you’re doing”. Other inter-thread communication techniques can be used, such as placing work items into a shared table.

To construct today’s sample, save the code below to THREADS.PRG. It will be reused later in future samples. Much of the code is in the prior post as class ThreadClass, but with minor modifications.

The sample creates 3 threads: each thread is given the task of gathering file information from 3 different directories and placing it into a table.

oThreads=CREATEOBJECT("ThreadManager")

oThreads.CreateThread("MyThreadFunc","c:\","ThreadDone(1)")

oThreads.CreateThread("MyThreadFunc","c:\Windows\","ThreadDone(2)")

oThreads.CreateThread("MyThreadFunc","c:\Windows\System\","ThreadDone(3)")

As you can see, the ThreadManager class has made it even easier to create threads in VFP. Just pass the name of a function, a parameter to pass to that function, and any code to execute once the thread has finished executing. There is a call to BindEvent to bind the VFP window handle to the message WM_USER. When a thread is almost finished, it will use PostMessage to send a message to _screen.hWnd. I say “almost” because the thread must still be active to post a message. The main thread then figures out which thread is almost finished, waits for it to completely finish, then executes the user specified Done command. I had to modify the base class ThreadClass to store the Thread IDs because the API GetThreadId isn’t available on Windows XP (Only on Windows Server 2003 or Vista<sigh>.)

The code uses a Critical Section to synchronize thread access to a shared resource. It surrounds the creation of the file “FILES.DBF” with a critical section via SYS(2336). Try running the code without the CritSects and see what happens!

ThreadManager has a method SendMsgToStopThreads which uses CreateEvent to create a named event, which can be queried in the thread code which can then exit gracefully. Notice that all threads use the same named event, so setting it once will stop all threads.

The base class ThreadClass calls a method called GenCodeAtPoint, which does nothing but return an empty string. The ThreadClassEx subclass overrides that method and generates some code for error checking. If there is an error, it puts up a MessageBox.

Try running the code multiple times. Try with and without the SendMsgToStopThreads call after various time intervals, and including/excluding the DesiredDuration Sleep to make the thread take longer. Try making it take a long time and then start something in the VFP main window. I tried running Task Manager and a Query Wizard while the background threads were still going!

Be careful when modifying the code: it’s easy to create a race condition. For example, if the allocated memory gets freed (ThreadClass.Destroy) before the thread terminates, then Crash!.

In a near future post, I’ll show a web crawler that runs on a background thread.

oThreads=0 && just in case some threads still alive, fire destructor before anything else gets released

CLEAR ALL

CLEAR

#define WAIT_TIMEOUT 258

#define WM_USER 0x400

SET EXCLUSIVE OFF

SET SAFETY OFF

SET ASSERTS ON

CREATE TABLE ThreadLog (threadid i, timestamp t,misc c(80)) && A table into which each thread will insert results

USE ThreadLog && open shared

TEXT TO cstrVFPCode TEXTMERGE NOSHOW && generate the task to run: MyThreadFunc

PROCEDURE MyThreadFunc(p2) && p2 is the 2nd param to MyDoCmd

TRY && use exception handling

DECLARE integer GetCurrentThreadId in WIN32API

DECLARE integer PostMessage IN WIN32API integer hWnd, integer nMsg, integer wParam, integer lParam

cPath=SUBSTR(p2,AT(",",p2)+1)

hWnd=INT(VAL(p2))

CREATEOBJECT("SearchDisk",cPath)

PostMessage(hWnd, WM_USER, 0, GetCurrentThreadId()) && Tell main thread we're just about done!

CATCH TO oex

INSERT INTO <<DBF()>> VALUES (GetCurrentThreadId(), DATETIME(),p2+" Error: "+oex.message+" "+oex.details+" "+TRANSFORM(oex.lineno))

ENDTRY

DEFINE CLASS SearchDisk as Session

hAbortEvent=0

PROCEDURE init(cPath)

DECLARE integer CreateEvent IN WIN32API integer lpEventAttributes, integer bManualReset, integer bInitialState, string lpName

DECLARE integer WaitForSingleObject IN WIN32API integer hHandle, integer dwMilliseconds

DECLARE integer GetLastError IN WIN32API

this.hAbortEvent = CreateEvent(0,0,0,"VFPAbortThreadEvent") && Get the existing event

IF this.hAbortEvent = 0

THROW "Creating event error:"+TRANSFORM(GetLastError())

ENDIF

DECLARE integer Sleep in WIN32API integer

DECLARE integer CloseHandle IN WIN32API integer

nStart=SECONDS()

fUseCritSects=.t. && try with .f.

IF fUseCritSects

SYS(2336,1) && Enter a critical section. First thread in wins

ENDIF

IF !FILE("files.dbf")

IF !fUseCritSects

Sleep(1000) && give a chance for other threads to come in here!

ENDIF

CREATE TABLE files (path c(100), size n(10))

ENDIF

USE files SHARED && reopen shared

IF fUseCritSects

SYS(2336,2) && Exit the critical section

ENDIF

cResult = TRANSFORM(this.RecurPath(cPath)) && search disk to gather files into table. Returns file count

nDuration = SECONDS()-nStart

nDesiredDuration=5 && # secs

IF nDuration < nDesiredDuration && let's make the thread proc last longer: OS caches disk results

* Sleep((nDesiredDuration - nDuration)*1000)

ENDIF

IF this.IsThreadAborted() && if main thread said to abort

cResult=cResult+ " Aborted"

ENDIF

INSERT INTO <<DBF()>> VALUES (GetCurrentThreadId(), DATETIME(),TRANSFORM(cPath)+":"+cResult)

PROCEDURE IsThreadAborted as Boolean

IF WaitForSingleObject(this.hAbortEvent,0) = WAIT_TIMEOUT

RETURN .f.

ENDIF

RETURN .t.

PROCEDURE RecurPath(cPath as String) as Integer

LOCAL n,i,aa[1],nRetval

nRetval=0

n = ADIR(aa,cPath+"*.*","D")

FOR i = 1 TO n

IF "D"$aa[i,5] && if it's a dir

IF aa[i,1] != '.'

* nRetval=nRetval + this.RecurPath(cPath+aa[i,1]+"\") && be careful!

ENDIF

ELSE

INSERT INTO files VALUES (cPath+aa[i,1], aa[i,2])

nRetval=nRetval+1

IF this.IsThreadAborted() && Did main thread request abort

EXIT

ENDIF

ENDFOR

RETURN nRetval

PROCEDURE Destroy

CloseHandle(this.hAbortEvent)

ENDDEFINE

ENDTEXT

STRTOFILE(cstrVFPCode,"MyThreadFunc.prg")

COMPILE MyThreadFunc.prg

ERASE files.dbf && reinit

?"Starting Threads",SECONDS()

PUBLIC nThreadsAlive && Track # of threads still around

nThreadsAlive=3

PUBLIC oThreads

oThreads=CREATEOBJECT("ThreadManager")

oThreads.CreateThread("MyThreadFunc","c:\","ThreadDone(1)")

oThreads.CreateThread("MyThreadFunc","c:\Windows\","ThreadDone(2)")

oThreads.CreateThread("MyThreadFunc","c:\Windows\System\","ThreadDone(3)")

INKEY(.1) && idle a bit: lets see how many files we get, before we stop the threads

TRY

oThreads.SendMsgToStopThreads() && might have already been released

CATCH TO oEx

?oEx.message

ENDTRY

RETURN

PROCEDURE ThreadDone(nThread)

nThreadsAlive=nThreadsAlive-1

IF nThreadsAlive=0 && If all threads done

ACTIVATE screen && in case user activated a form

?"All threads done",SECONDS()

nDatasession =SET("Datasession")

SET DATASESSION TO 1

SELECT ThreadLog

FLOCK() && make sure we refresh results from other threads

LIST

SELECT 0

USE files

?TRANSFORM(RECCOUNT())+" files found "

SET DATASESSION TO (nDataSession)

RELEASE oThreads

ENDIF

RETURN

#define CREATE_SUSPENDED 0x00000004

#define INFINITE 0xFFFFFFFF

#define WAIT_TIMEOUT 258

#define ERROR_ALREADY_EXISTS 183

#define CLSCTX_INPROC_SERVER 1

#define CLSCTX_LOCAL_SERVER 4

#define VT_BSTR 8

DEFINE CLASS ThreadClass as session

hProcHeap =0

nThreads=0

DIMENSION hThreads[1] && Handle to each thread

DIMENSION hThreadIds[1] && ID for each thread

cThreadHandles="" && Handle to each thread as a string rep of an int array

PROCEDURE Init

DECLARE integer LoadLibrary IN WIN32API string

DECLARE integer FreeLibrary IN WIN32API integer

DECLARE integer GetProcAddress IN WIN32API integer hModule, string procname

DECLARE integer CreateThread IN WIN32API integer lpThreadAttributes, ;

integer dwStackSize, integer lpStartAddress, integer lpParameter, integer dwCreationFlags, integer @ lpThreadId

DECLARE integer ResumeThread IN WIN32API integer thrdHandle

DECLARE integer CloseHandle IN WIN32API integer Handle

DECLARE integer GetProcessHeap IN WIN32API

DECLARE integer HeapAlloc IN WIN32API integer hHeap, integer dwFlags, integer dwBytes

DECLARE integer HeapFree IN WIN32API integer hHeap, integer dwFlags, integer lpMem

DECLARE integer WaitForSingleObject IN WIN32API integer hHandle, integer dwMilliseconds

DECLARE integer WaitForMultipleObjects IN WIN32API integer nCount, string pHandles, integer bWaitAll, integer dwMsecs

DECLARE integer CLSIDFromProgID IN ole32 string lpszProgID, string @ strClSID

DECLARE integer CLSIDFromString IN ole32 string lpszProgID, string @ strClSID

DECLARE integer SysAllocString IN oleaut32 string wstr

DECLARE integer SysFreeString IN oleaut32 integer bstr

CREATE CURSOR memAllocs (memPtr i, AllocType c(1)) && track mem allocs that need to be freed: H=Heap,B=BSTR,L=Library

this.hProcHeap = GetProcessHeap()

PROCEDURE StartThreads(nThreads as Integer, ThreadCmd as String, ThreadProcParam as String,cStrIid as String )

this.nThreads = nThreads

cClsId=SPACE(16)

IF CLSIDFromProgID(STRCONV("t1.c1"+CHR(0),5),@cClsId)!= 0 && dual interface

?"Error: class not found"

RETURN

ENDIF

cIid=SPACE(16)

CLSIDFromString(STRCONV(cStrIid+CHR(0),5),@cIid)

nLocals = 30 && sufficiently large for local vars

sCode="" && generate machine code for thread procedure into a string

* sCode = sCode + CHR(0xcc) && int 3 DebugBreak() to attach a debugger

sCode = sCode + CHR(0x55) && push ebp

sCode = sCode + CHR(0x8b) + CHR(0xec) && mov ebp, esp

sCode = sCode + CHR(0x81) + CHR(0xec)+BINTOC(nLocals * 4, "4rs") && sub esp, nLocals

sCode = sCode + CHR(0x6a) + CHR(0x00) && push 0

sCode = sCode + this.CallDllFunction("CoInitialize", "ole32")

sCode = sCode + this.GenCodeAtPoint("BeforeStart")

sCode = sCode + CHR(0x8d) + CHR(0x45)+CHR(0xf0) && lea eax, [ebp-10h] && addr to put COM ptr

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + CHR(0xb8) + BINTOC(this.MakeStr(cIid),"4rs") && mov eax, str

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + CHR(0xb8) + BINTOC(CLSCTX_INPROC_SERVER+CLSCTX_LOCAL_SERVER,"4rs") && mov eax, val

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + CHR(0x6a) + CHR(0x00) && push 0

sCode = sCode + CHR(0xb8) + BINTOC(this.MakeStr(cClsId),"4rs") && mov eax, str

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + this.CallDllFunction("CoCreateInstance", "ole32")

sCode = sCode + this.GenCodeAtPoint("AfterCreating")

sCode = sCode + CHR(0x8d) + CHR(0x45)+CHR(0xe0) && lea eax, [ebp-20h] && local var to get the vtResult of the COM call

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + this.CallDllFunction("VariantInit", "oleaut32") && Initialize the vtResult

*call MyDoCmd via early binding. First push the parms

sCode = sCode + CHR(0x8d) + CHR(0x45)+CHR(0xe0) && lea eax, [ebp-20h] && pass the address of vtResult for return value

sCode = sCode + CHR(0x50) && push eax

*Now we need to push 3 empty variants, each of which is 4 DWORDS

sCode = sCode + CHR(0x33) + CHR(0xc0) && xor eax,eax

sCode = sCode + REPLICATE(CHR(0x50),12) && push eax 12 times

*2nd param is P2:

sCode = sCode + CHR(0x33) + CHR(0xc0) && xor eax,eax

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + CHR(0x8b) + CHR(0x45) + CHR(0x8) && mov eax,[ebp+8] && Form the P2 param as a Variant from the BSTR arg from the parent thread

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + CHR(0x33) + CHR(0xc0) && xor eax,eax

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + CHR(0xb8) + BINTOC(VT_BSTR,"4rs") && mov eax, VT_BSTR

sCode = sCode + CHR(0x50) && push eax

*1st param is the expr for VFP to Exec.

sCode = sCode + CHR(0xb8)+BINTOC(this.MakeStr(ThreadCmd,.t.,.t.),"4rs") && mov eax, cExpr (p2 is 2nd param to MyDoCmd)

sCode = sCode + CHR(0x50) && push eax

*Now make the call

sCode = sCode + CHR(0x8b) + CHR(0x45) + CHR(0xf0) && mov eax, [ebp-10h] && the COM ptr

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + CHR(0x8b) + CHR(0) && mov eax, [eax] && et the vTable

sCode = sCode + CHR(0xff) + CHR(0x50) + CHR(0x1c) && call [eax+1ch] && call indirect the function at 1ch in the vTable

sCode = sCode + this.GenCodeAtPoint("AfterCalling")

*Free the return value with VariantClear because it's ignored

sCode = sCode + CHR(0x8d) + CHR(0x45)+CHR(0xe0) && lea eax, [ebp-20h]

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + this.CallDllFunction("VariantClear", "oleaut32")

sCode = sCode + this.GenEndCode(.t.)

AdrCode=this.memAlloc(LEN(sCode),sCode) && allocate memory for the code

DIMENSION this.hThreads[nThreads]

this.cThreadHandles=""

FOR i = 1 TO nThreads

bstrArg=this.MakeStr(STRTRAN(ThreadProcParam,"%threadnum",TRANSFORM(i)),.t.,.t.)

dwThreadId=0

this.hThreads[i] = CreateThread(0,8192, AdrCode, bstrArg, CREATE_SUSPENDED, @dwThreadId) && create suspended

this.hThreadIds[i]=dwThreadId

this.cThreadHandles = this.cThreadHandles+BINTOC(this.hThreads[i],"4rs") && put the handles into a string rep of an int array

ResumeThread(this.hThreads[i]) && now start thread once all data is stored so no race condition

ENDFOR

PROCEDURE GenCodeAtPoint(nPoint as String) as String && derived classes can override to gen code to exec at various points

RETURN ""

PROCEDURE GenEndCode(fRelease as Boolean) as String && generate code to end thread

LOCAL sCode

sCode=""

IF fRelease && do we also release COM obj?

*ptr->Release()

sCode = sCode + CHR(0x8b) + CHR(0x45) + CHR(0xf0) && mov eax, [ebp-10h]

sCode = sCode + CHR(0x50) && push eax && push the THIS ptr

sCode = sCode + CHR(0x8b) + CHR(0) && mov eax, [eax] && get the vTable

sCode = sCode + CHR(0xff) + CHR(0x50) + CHR(0x8) && call [eax+8h]

ENDIF

sCode = sCode + this.GenCodeAtPoint("BeforeEnd")

sCode = sCode + this.CallDllFunction("CoUninitialize", "ole32")

sCode = sCode + CHR(0x33) + CHR(0xc0) && xor eax,eax && make ExitCodeThread= 0

sCode = sCode + CHR(0x8b) + CHR(0xe5) && mov esp, ebp

sCode = sCode + CHR(0x5d) && pop ebp

sCode = sCode + CHR(0xc2)+CHR(0x04)+CHR(0x00) && ret 4

RETURN sCode

PROCEDURE WaitForThreads(cExpr as String)

DO WHILE WaitForMultipleObjects(this.nThreads, this.cThreadHandles, 1, 500) = WAIT_TIMEOUT && wait msecs for the threads to finish

&cExpr && execute any passed in param while waiting

ENDDO

PROCEDURE MemAlloc(nSize as Integer, cStr as String) as Integer

LOCAL nAddr

nAddr = HeapAlloc(this.hProcHeap, 0, nSize) && allocate memory

ASSERT nAddr != 0 MESSAGE "Out of memory"

INSERT INTO memAllocs VALUES (nAddr,"H") && track them for freeing later

SYS(2600,nAddr, LEN(cStr),cStr) && copy the string into the mem

RETURN nAddr

PROCEDURE CallDllFunction(strExport as String, strDllName as String) as String

*Create a string of machine code that calls a function in a DLL. Parms should already be pushed

LOCAL nAddr as Integer, hModule as Integer

hModule = LoadLibrary(strDllName)

INSERT INTO memAllocs VALUES (hModule,"L") && track loads for freeing later

nAddr=GetProcAddress(hModule,strExport)

ASSERT nAddr != 0 MESSAGE "Error: Export not found "+ strExport+" "+ strDllName

RETURN CHR(0xb8)+BINTOC(nAddr,"4rs") + CHR(0xff) + CHR(0xd0) && mov eax, addr; call eax

PROCEDURE MakeStr(str as String, fConvertToUnicode as Logical, fMakeBstr as Logical) as Integer

* converts a string into a memory allocation and returns a pointer

LOCAL nRetval as Integer

IF fConvertToUnicode

str=STRCONV(str+CHR(0),5)

ELSE

str = str + CHR(0) && null terminate

ENDIF

IF fMakeBstr

nRetval= SysAllocString(str)

ASSERT nRetval != 0 MESSAGE "Out of memory"

INSERT INTO memAllocs VALUES (nRetval,"B") && track them for freeing later

ELSE

nRetval= this.MemAlloc(LEN(str),str)

ENDIF

RETURN nRetval

PROCEDURE Destroy

LOCAL i

* ?PROGRAM()

SELECT memAllocs

SCAN

DO CASE

CASE AllocType="B" && BSTR

SysFreeString(memPtr)

CASE AllocType="H" && Heap

HeapFree(this.hProcHeap,0,memPtr)

CASE AllocType="L" && LoadLibrary

FreeLibrary(memPtr)

ENDCASE

ENDSCAN

FOR i = 1 TO this.nThreads

CloseHandle(this.hThreads[i])

ENDFOR

ENDDEFINE

DEFINE CLASS ThreadClassEx as ThreadClass

cDoneCmd =""

PROCEDURE GenCodeAtPoint(sPoint as String) as String

LOCAL sCode,nPatch

sCode=""

DO CASE

CASE sPoint = "BeforeStart"

* sCode = sCode + CHR(0x6a) + CHR(0x00) && push 0

* sCode = sCode + this.CallDllFunction("MessageBeep", "user32") && MessageBeep(0)

CASE sPoint = "BeforeEnd"

* sCode = sCode + this.GenMessageBox("BeforeThreadEnd","Thread Proc")

CASE sPoint = "AfterCreating"

* sCode = sCode + CHR(0xcc) && int 3 DebugBreak() to attach a debugger

sCode = sCode + CHR(0x83) + CHR(0xf8) + CHR(0x00) && cmp eax, 0 && check return value

sCode = sCode + CHR(0x74)+CHR(0x00) && je nBytes && nBytes calc'd below. je= Jump if Equal

nPatch = LEN(sCode) && track the byte that needs patching

sCode = sCode + this.GenMessageBox("Error "+sPoint+" COM object","Thread Proc")

sCode = sCode + this.GenEndCode(.f.) && generate end thread code, without release

sCode=LEFT(sCode,nPatch-1) + CHR(LEN(sCode)-nPatch)+ SUBSTR(sCode,nPatch+1) && now fix up the jump location to jump around GenEndcode

CASE sPoint = "AfterCalling"

* sCode = sCode + CHR(0xcc) && int 3 DebugBreak() to attach a debugger

sCode = sCode + CHR(0x83) + CHR(0xf8) + CHR(0x00) && cmp eax, 0 && check return value

sCode = sCode + CHR(0x74)+CHR(0x00) && je nBytes && nBytes calc'd below. je= Jump if Equal

nPatch = LEN(sCode) && track the byte that needs patching

sCode = sCode + this.GenMessageBox("Error "+sPoint+" COM object","Thread Proc")

sCode = sCode + this.GenEndCode(.t.) && generate end thread code, with release

sCode=LEFT(sCode,nPatch-1) + CHR(LEN(sCode)-nPatch)+ SUBSTR(sCode,nPatch+1) && now fix up the jump location to jump around GenEndcode

OTHERWISE

ASSERT .f. MESSAGE "Unknown GenCodeCase "+sPoint

ENDCASE

RETURN sCode

PROCEDURE GenMessageBox(strMessage as String, strCaption as String) as String

LOCAL sCode

* MessageBox: call the Unicode (Wide char) version

sCode = CHR(0x6a) + CHR(0x00) && push 0

sCode = sCode + CHR(0xb8)+BINTOC(this.MakeStr(strCaption,.t.),"4rs") && mov eax, str

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + CHR(0xb8)+BINTOC(this.MakeStr(strMessage,.t.),"4rs") && mov eax, str

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + CHR(0x6a) + CHR(0x00) && push 0

sCode = sCode + this.CallDllFunction("MessageBoxW", "user32")

RETURN sCode

ENDDEFINE

DEFINE CLASS ThreadManager AS Session

nThreads = 0

nLiveThreads=0

hAbortEvent=0

DIMENSION aoThread[1]

PROCEDURE init

DECLARE integer CreateEvent IN WIN32API integer lpEventAttributes, integer bManualReset, integer bInitialState, string lpName

DECLARE integer GetLastError IN WIN32API

DECLARE integer SetEvent IN WIN32API integer

DECLARE integer ResetEvent IN WIN32API integer

DECLARE integer Sleep in WIN32API integer

this.hAbortEvent = CreateEvent(0,1,0,"VFPAbortThreadEvent")

IF this.hAbortEvent = 0

?"Creating event error:",GetLastError()

ELSE

IF GetLastError()=ERROR_ALREADY_EXISTS

ResetEvent(this.hAbortEvent)

ENDIF

PROCEDURE CreateThread(ThreadProc as String, ThreadProcParam as String,cDoneCmd as string)

IF VARTYPE(ThreadProc)='C' && with parms on constructor, create a single thread per class instance

DIMENSION this.aoThread[this.nThreads+1]

oThread=CREATEOBJECT("ThreadClassEx")

this.aoThread[this.nThreads+1]=oThread

cStrIid="{00020400-0000-0000-C000-000000000046}" && IID_IDispatch

IF VARTYPE(cDoneCmd)='C' && user specified a cmd to exec after thread done

oThread.cDoneCmd = cDoneCmd

BINDEVENT(_screen.HWnd, WM_USER, this,"ThreadAlmostFinishedEvent")

ENDIF

oThread.StartThreads(1, "do "+SYS(5)+CURDIR()+ThreadProc+" WITH p2",TRANSFORM(_screen.hWnd)+","+ThreadProcParam,cStrIid)

this.nLiveThreads=this.nLiveThreads+1

this.nThreads = this.nThreads+1 && increment as last step after threads created

ENDIF

PROCEDURE SendMsgToStopThreads

SetEvent(this.hAbortEvent)

PROCEDURE ThreadAlmostFinishedEvent(hWnd as Integer, Msg as Integer, wParam as Integer, lParam as Integer)

LOCAL i,hThread

FOR i = 1 TO this.nThreads && Which thread is almost finished?

IF TYPE("this.aoThread[i]")='O' AND lParam = this.aoThread[i].hThreadIds[1]

hThread = this.aoThread[i].hThreads[1]

cDoneCmd =this.aoThread[i].cDoneCmd

EXIT

ENDIF

ENDFOR

DO WHILE WaitForSingleObject(hThread,0)=WAIT_TIMEOUT && wait til it's totally done

Sleep(100)

ENDDO

this.aoThread[i]=0 && release the thread object

&cDoneCmd && Execute caller's done command

this.nLiveThreads=this.nLiveThreads-1

PROCEDURE destroy

*Danger: don't release threads if still alive! Watch out for race condition waiting for them to finish

DO WHILE this.nLiveThreads>0

?"Waiting for threads in destroy"

Sleep(1000)

ENDDO

UNBINDEVENTS(_screen.HWnd,WM_USER)

IF this.hAbortEvent>0

CloseHandle(this.hAbortEvent)

ENDIF

ENDDEFINE

posted by Calvin_Hsia | 10 Comments

Friday, May 19, 2006 12:53 PM

Meeting with some customers, manipulating SQL Server with Stored Procs

I met with some customers today from one company. They took time from their busy schedule to travel to Redmond to spend a couple days to address some SQL Server and Foxpro issues. It’s always a pleasure to meet with customers and learn about their real world needs.

Apparently they have a VFP application that their clients love. They switched their back end data to use SQL Server, and their clients immediately reported a performance decrease.

When they start their Fox app, the first form takes many seconds to show. We discussed various possibilities for the slowdown, and came up with some reasonable things to try to find the bottleneck. Upon startup, the VFP form was retrieving 62,000 records from SQL Server using a query with various parameters. When the data was in VFP native tables, the startup time was unnoticeable. We talked about how changing the back end data store can introduce or move bottlenecks, and some possible design changes. If the number of records was small, the startup was much faster, indicating that the bottleneck was not the creation of the VFP form.

We also discussed using SQL Server Stored Procedures vs remote views vs SQL Pass Through, and the various VFP Remote View and Connection properties, which could help speed up their form.

I mentioned that you can create SQL Stored procedures dynamically via VFP code, and that SPs can be made on a temporary basis: create one just for a few seconds.

Another topic was propagating schema updates. If the customer’s client requests the addition of a new field, or the changing of a field type, then the remote view definitions and the SQL Server tables need to be changed.

Over a dozen years ago, I faced similar issues while an independent consultant in Honolulu. The tables needed to be changed, meaning that the associated code needed to be updated. To solve this, I stored the table & field names and types into a single schema table. When the application starts up, the current environment is compared with the desired schema table. If there are no tables, they are created. If there are schema mismatches, the table structures can be altered. This process is fairly quick and can be done every time the application starts. This ensures no mismatches between code and data schema.

With SQL Server tables added to the mix, the same method can be used. To make it faster, the schema table can be uploaded to SQL server and an SP can be created to update the

environment.

The example below is modeled on the sample in SQL Server interpreter sample. It adds creating a stored procedure with a parameter, invoking that SP, removing that SP, dynamically adding a column

CLEAR ALL

CLEAR

SQLDISCONNECT(0) && close All connections

*cstr="driver=sql server;server=(local)\sqlexpress"

cstr="driver=sql server;server=(local)"

nh=SQLSTRINGCONNECT(cstr)

?"Handle =",nh

IF nh<0

?AERROR(aa)

LIST MEMORY LIKE aa

RETURN

ENDIF

IF SqlDoIt(nh,"use test")<0 && If we can't use the test database (alt: use sp_helpdb)

SqlDoIt(nh,"Create database test")

SqlDoIt(nh,"use test")

ENDIF

SET TEXTMERGE ON TO memvar myvar NOSHOW && put the following text into a variable called myvar

SQLTABLES(nh) && get a table of tables

SELECT * FROM sqlresult WHERE table_type="TABLE" AND table_name = "cust" INTO CURSOR foo

IF _tally>0

\DROP TABLE cust

ENDIF

\CREATE TABLE cust (name char(10),amount tinyint,tstamp datetime,myxml ntext)

FOR i = 1 TO 10

\INSERT INTO cust (name,amount,tstamp,myxml) VALUES ('test<<TRANSFORM(i)>>',

\\<<TRANSFORM(i)>>,'<<DATETIME()-i*86400>>',

\\'<MyTag MyAttr="val<<i>>">Mydata</MyTag>')

ENDFOR

\alter table cust add newcol char(10)

\update cust set newcol='foo'

\select * from cust

\!list off name,amount,tstamp,myxml

* \drop procedure mySProc

\create procedure mySProc @parm1 char(10) as select * from cust where name='test8' or name=@parm1

\!?"Exec my sproc"

\mySProc @parm1='test2'

\!list off name,newcol,amount,tstamp,myxml

\drop procedure mySProc

*!* \sp_tables

* \!brow last

*use master database, so test is not used anymore

\use master

\drop database test

\sp_helpdb

\!list PADR(name,20),db_size

SET TEXTMERGE to

n=ALINES(aa,myvar) && put the lines into an array

FOR i = 1 TO n && for each line

?"Exec line"+TRANSFORM(i),aa[i]

IF SqlDoIt(nh,aa[i])<0 && Execute it

?AERROR(aErrs)

LIST MEMORY LIKE aErrs

EXIT

ENDIF

ENDFOR

SQLDISCONNECT(0) && close All connections

RETURN

PROCEDURE SqlDoIt(nH as Integer, cCmd as String)

nRetval=0

IF LEFT(cCmd,1)='!' && use "!" for Fox commands

cCmd=SUBSTR(cCmd,2)

&cCmd && execute the command

ELSE

nRetval= SQLEXEC(nH,cCmd)

ENDIF

RETURN nRetval

posted by Calvin_Hsia | 1 Comments

Tuesday, May 16, 2006 11:00 AM

Create multiple threads from within your application

When I posted this Sample program to create multiple threads, I knew the inevitable follow-up question was “can I run my VFP code in separate threads?”. Sure enough, several people asked, citing various valid usage scenarios.

Below is a class that you can use to run your VFP code in multiple separate threads. It can create as many threads as you like, each of which is running VFP code. Because it is a multithreaded sample, it requires the multithreaded runtime, which is just a few megabytes.

The sample code uses the class by creating a routine called MyThreadFunc, which is a CPU intensive task that sums the integers from 1 to some large fixed number and then inserts the result into a table. This task is repeated a few times. The time is measured to call MyThreadFunc from N+1 different threads (including the main thread). That time is compared with calling the same code the same number of times, but only from the main thread.

On my dual processor machine (with hyperthreading on), with 10 threads, the performance was almost double the performance of a single thread, as expected. On my single processor laptop, the performance is roughly the same, with the single threaded slightly faster than the multithreaded, due to thread overhead.

If I change the task to be less CPU intensive and more shared resource intensive by making it update a single shared table multiple times, the performance gain decreases, due to contention for a single shared resource as expected.

The code requires that you have a multithreaded COM DLL built from this code: Blogs get 300 hits per hour: Visual FoxPro can count. The Ic1 interface and the MyDoCmd method are defined in that DLL.

This code really maxes out your CPU when running with many threads. In fact, while I had task man open, I saw the CPU usage at very low numbers for an instant when I expected it to be very high because Taskman didn’t get enough CPU to update its display!

Observe from the results table that various threads complete at various times, interweaving their results, meaning that in the middle of computation, the threads are swapped out.

What kind of performance numbers do you see?

Here’s how ThreeadClass works: it allocates memory for various items, such as GUIDs, strings, and the generated code. It generates machine code into a string, and calls CreateThread, pointing to that string as the Thread procedure to execute. The threads are stored in an array. CoCreateInstance is called to create an instance of the VFP COM object. That object’s MyDoCmd method is called via early binding through it’s vTable.

The vTable of the Ic1 interface (which inherits from IDispatch, which inherits from IUnknown) is expected to be mapped out like this:

0 QueryInterface IUnknown

1 AddRef IUnknown

2 Release IUnknown

3 GetTypeInfoCount IDispatch

4 GetTypeInfo IDispatch

5 GetIDsOfNames IDispatch

6 Invoke IDispatch

7 MyDoCmd Ic1

8 MyEval Ic1

For more on vTable layout see my Paper on Visual Foxpro and Advanced COM

MyDoCmd is entry #7. 7 * 4 bytes per pointer = 28, which is 1c in hex.

sCode = sCode + CHR(0xff) + CHR(0x50) + CHR(0x1c) && call [eax+1ch] && call indirect the function at 1ch in the vTable

Likewise, the Release is entry #2, so the offset is 8.

The preamble does a PUSH EBP, MOV EBP, ESP to set up a stack frame. At the end, there is a MOV ESP, EBP, POP EBP and RET 4 to release the frame. The stack frame means local variables can be accessed via a negative offset from EBP and any parameters with a positive offset. The RET 4 pops off the single 4 byte argument (bstrArg) that was passed in and returns, terminating the thread.

If your t1.dll is in a COM + application (as mine is on some machines), then you will need to specify your particular Guid for Ic1 (found in your t1.vbr file) instead of IDispatch. Then COM will know to marshall the rest of the vTable. In a COM+ application the ProcessIds will be different:

x=CREATEOBJECT("t1.c1")

?_vfp.ProcessId, x.MyEval("_vfp.ProcessId")

A COM+ app also might not have rights to write to the disk, and may not shut down the server when you expect: it might keep an instance around for quick activation. It also will probably have a different Current Directory, so may not find MyThreadProc.prg

All threads in the sample run the same code, but you can certainly make them run different code various ways. Also, the threads can be kept alive in a thread pool, perhaps waiting for more tasks to execute.

As an interesting exercise, try making the thread procedure just Sleep 10 seconds

IF .t. OR p2="Thread"

DECLARE integer Sleep IN WIN32API integer

Sleep(10000)

ENDIF

With 10 threads, the 11 calls to ThreadProc (including the one in the main thread), the Sleeps occur in parallel and it finishes in 10 seconds. In a single threaded app, it takes 110 seconds to execute them in series!

The machine code generated is similar to this pseudo C++ code which has no error checking

DWORD WINAPI ThreadProc(LPVOID dwParam)

{

IDispatch *ptrCOMObj;

VARIANT vtResult;

CoInitialize(0); // initialize COM

CoCreateInstance(cClsId,0, CLSCTX_INPROC_SERVER+CLSCTX_LOCAL_SERVER, &cIid, &ptrCOMObj);

VariantInit(&vtResult);

ptrComObj->MyDoCmd(bstrCmd("do d:\fox90\test\MyThreadFunc WITH p2"), dwParam as Variant,vtEmpty,vtEmpty,vtEmpty,&vtResult);

VariantClear(vtResult); //unused, but needs to be freed

ptrCOMObj->Release(); // release the COM server

CoUninitialize();

}

I used a C++ project in Visual Studio with inline ASM code and Show Disassembly to get the machine language bytes. My Intel Programmers Reference manual was also useful. The thread proc isn’t optimized, but it doesn’t have to be. Almost no time is spent there, compared with calling the COM server.

The VFP code (with minimal error checking):

CLEAR ALL

CLEAR

SET EXCLUSIVE OFF

SET SAFETY OFF

SET ASSERTS ON

CREATE TABLE ThreadLog (threadid i, timestamp t,misc c(50)) && A table into which each thread will insert results

USE ThreadLog && open shared

TEXT TO cstrVFPCode TEXTMERGE NOSHOW && generate the task to run: MyThreadFunc

PROCEDURE MyThreadFunc(p2) && p2 is the 2nd param to MyDoCmd

TRY && use exception handling

DECLARE integer GetCurrentThreadId in WIN32API

LOCAL i,j,k,nSum

FOR k = 1 TO 3 && calculate result 3 times per thread

nSum=0

FOR i = 1 TO 500000

nSum=nSum+i

ENDFOR

INSERT INTO <<DBF()>> VALUES (GetCurrentThreadId(), DATETIME(),TRANSFORM(p2)+":"+TRANSFORM(nSum))

ENDFOR

CATCH TO oex

INSERT INTO <<DBF()>> VALUES (GetCurrentThreadId(), DATETIME(),p2+" Error: "+oex.message)

ENDTRY

RETURN

ENDTEXT

STRTOFILE(cstrVFPCode,"MyThreadFunc.prg")

COMPILE MyThreadFunc.prg

nThreads=10 && WaitForMultipleObjects MAXIMUM_WAIT_OBJECTS = 64

nStart=SECONDS()

ox=CREATEOBJECT("ThreadClass")

cStrIid="{00020400-0000-0000-C000-000000000046}" && IID_IDispatch

* cStrIid="{3608114E-633A-44FF-8E51-1BBCF7225018}" && IID_Ic1 from your t1.vbr file.

ox.StartThreads(nThreads,"do "+SYS(5)+CURDIR()+"MyThreadFunc WITH p2","Thread: %threadnum",cStrIid)

?TRANSFORM(nThreads)+" threads created. Main thread calculating..."

MyThreadFunc("Main") && main thread will do calculation too, rather than just being idle

?"Main thread done: waiting for other threads"

ox.WaitForThreads("?'main thread waiting'") && wait til threads finish

?"Using "+TRANSFORM(nThreads)+" threads takes "+TRANSFORM(SECONDS()-nStart)+" seconds"

?"Now try single threaded:"

nStart=SECONDS()

FOR i = 1 TO nThreads+1 && add one for the main thread

MyThreadFunc("SingleThread")

ENDFOR

?"Single thread takes "+TRANSFORM(SECONDS()-nStart)+" seconds"

LOCATE && Go to the first record

BROWSE LAST NOWAIT && show the results

#define CREATE_SUSPENDED 0x00000004

#define INFINITE 0xFFFFFFFF

#define WAIT_TIMEOUT 258

#define CLSCTX_INPROC_SERVER 1

#define CLSCTX_LOCAL_SERVER 4

#define VT_BSTR 8

DEFINE CLASS ThreadClass as session

hProcHeap =0

nThreads=0

DIMENSION hThreads[1] && Handle to each thread

cThreadHandles="" && Handle to each thread as a string rep of an int array

PROCEDURE Init

DECLARE integer LoadLibrary IN WIN32API string

DECLARE integer FreeLibrary IN WIN32API integer

DECLARE integer GetProcAddress IN WIN32API integer hModule, string procname

DECLARE integer CreateThread IN WIN32API integer lpThreadAttributes, ;

integer dwStackSize, integer lpStartAddress, integer lpParameter, integer dwCreationFlags, integer @ lpThreadId

DECLARE integer ResumeThread IN WIN32API integer thrdHandle

DECLARE integer CloseHandle IN WIN32API integer Handle

DECLARE integer GetProcessHeap IN WIN32API

DECLARE integer HeapAlloc IN WIN32API integer hHeap, integer dwFlags, integer dwBytes

DECLARE integer HeapFree IN WIN32API integer hHeap, integer dwFlags, integer lpMem

DECLARE integer WaitForSingleObject IN WIN32API integer hHandle, integer dwMilliseconds

DECLARE integer WaitForMultipleObjects IN WIN32API integer nCount, string pHandles, integer bWaitAll, integer dwMsecs

DECLARE integer CLSIDFromProgID IN ole32 string lpszProgID, string @ strClSID

DECLARE integer CLSIDFromString IN ole32 string lpszProgID, string @ strClSID

DECLARE integer SysAllocString IN oleaut32 string wstr

DECLARE integer SysFreeString IN oleaut32 integer bstr

CREATE CURSOR memAllocs (memPtr i, AllocType c(1)) && track mem allocs that need to be freed: H=Heap,B=BSTR,L=Library

this.hProcHeap = GetProcessHeap()

PROCEDURE StartThreads(nThreads as Integer, ThreadCmd as String, ThreadProcParam as String,cStrIid as String )

this.nThreads = nThreads

cClsId=SPACE(16)

IF CLSIDFromProgID(STRCONV("t1.c1"+CHR(0),5),@cClsId)!= 0 && dual interface

?"Error: class not found"

RETURN

ENDIF

cIid=SPACE(16)

CLSIDFromString(STRCONV(cStrIid+CHR(0),5),@cIid)

nLocals = 30 && sufficiently large for local vars

sCode="" && generate machine code for thread procedure into a string

* sCode = sCode + CHR(0xcc) && int 3 DebugBreak() to attach a debugger

sCode = sCode + CHR(0x55) && push ebp

sCode = sCode + CHR(0x8b) + CHR(0xec) && mov ebp, esp

sCode = sCode + CHR(0x81) + CHR(0xec)+BINTOC(nLocals * 4, "4rs") && sub esp, nLocals

sCode = sCode + CHR(0x6a) + CHR(0x00) && push 0

sCode = sCode + this.CallDllFunction("CoInitialize", "ole32")

sCode = sCode + this.GenCodeAtPoint("BeforeStart")

sCode = sCode + CHR(0x8d) + CHR(0x45)+CHR(0xf0) && lea eax, [ebp-10h] && addr to put COM ptr

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + CHR(0xb8) + BINTOC(this.MakeStr(cIid),"4rs") && mov eax, str

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + CHR(0xb8) + BINTOC(CLSCTX_INPROC_SERVER+CLSCTX_LOCAL_SERVER,"4rs") && mov eax, val

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + CHR(0x6a) + CHR(0x00) && push 0

sCode = sCode + CHR(0xb8) + BINTOC(this.MakeStr(cClsId),"4rs") && mov eax, str

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + this.CallDllFunction("CoCreateInstance", "ole32")

sCode = sCode + this.GenCodeAtPoint("Creating")

sCode = sCode + CHR(0x8d) + CHR(0x45)+CHR(0xe0) && lea eax, [ebp-20h] && local var to get the vtResult of the COM call

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + this.CallDllFunction("VariantInit", "oleaut32") && Initialize the vtResult

*call MyDoCmd via early binding. First push the parms

sCode = sCode + CHR(0x8d) + CHR(0x45)+CHR(0xe0) && lea eax, [ebp-20h] && pass the address of vtResult for return value

sCode = sCode + CHR(0x50) && push eax

*Now we need to push 3 empty variants, each of which is 4 DWORDS

sCode = sCode + CHR(0x33) + CHR(0xc0) && xor eax,eax

sCode = sCode + REPLICATE(CHR(0x50),12) && push eax 12 times

*2nd param is P2:

sCode = sCode + CHR(0x33) + CHR(0xc0) && xor eax,eax

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + CHR(0x8b) + CHR(0x45) + CHR(0x8) && mov eax,[ebp+8] && Form the P2 param as a Variant from the BSTR arg from the parent thread

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + CHR(0x33) + CHR(0xc0) && xor eax,eax

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + CHR(0xb8) + BINTOC(VT_BSTR,"4rs") && mov eax, VT_BSTR

sCode = sCode + CHR(0x50) && push eax

*1st param is the expr for VFP to Exec.

sCode = sCode + CHR(0xb8)+BINTOC(this.MakeStr(ThreadCmd,.t.,.t.),"4rs") && mov eax, cExpr (p2 is 2nd param to MyDoCmd)

sCode = sCode + CHR(0x50) && push eax

*Now make the call

sCode = sCode + CHR(0x8b) + CHR(0x45) + CHR(0xf0) && mov eax, [ebp-10h] && the COM ptr

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + CHR(0x8b) + CHR(0) && mov eax, [eax] && et the vTable

sCode = sCode + CHR(0xff) + CHR(0x50) + CHR(0x1c) && call [eax+1ch] && call indirect the function at 1ch in the vTable

sCode = sCode + this.GenCodeAtPoint("Calling")

*Free the return value with VariantClear because it's ignored

sCode = sCode + CHR(0x8d) + CHR(0x45)+CHR(0xe0) && lea eax, [ebp-20h]

sCode = sCode + CHR(0x50) && push eax

sCode = sCode + this.CallDllFunction("VariantClear", "oleaut32")

sCode = sCode + this.GenEndCode(.t.)

AdrCode=this.memAlloc(LEN(sCode),sCode) && allocate memory for the code

DIMENSION this.hThreads[nThreads]

this.cThreadHandles=""

FOR i = 1 TO nThreads

bstrArg=this.MakeStr(STRTRAN(ThreadProcParam,"%threadnum",TRANSFORM(i)),.t.,.t.)

this.hThreads[i] = CreateThread(0,8192, AdrCode, bstrArg, 0, 0)

this.cThreadHandles = this.cThreadHandles+BINTOC(this.hThreads[i],"4rs") && put the handles into a string rep of an int array

ENDFOR

PROCEDURE GenCodeAtPoint(nPoint as String) as String && derived classes can override to gen code to exec at various points

RETURN ""

PROCEDURE GenEndCode(fRelease as Boolean) as String && generate code to end thread

LOCAL sCode

sCode=""

IF fRelease && do we also release COM obj?

*ptr->Release()

sCode = sCode + CHR(0x8b) + CHR(0x45) + CHR(0xf0) && mov eax, [ebp-10h]

sCode = sCode + CHR(0x50) && push eax && push the THIS ptr

sCode = sCode + CHR(0x8b) + CHR(0) && mov eax, [eax] && get the vTable

sCode = sCode + CHR(0xff) + CHR(0x50) + CHR(0x8) && call [eax+8h]

ENDIF

sCode = sCode + this.GenCodeAtPoint("BeforeEnd")

sCode = sCode + this.CallDllFunction("CoUninitialize", "ole32")

sCode = sCode + CHR(0x33) + CHR(0xc0) && xor eax,eax && make ExitCodeThread= 0

sCode = sCode + CHR(0x8b) + CHR(0xe5) && mov esp, ebp

sCode = sCode + CHR(0x5d) && pop ebp

sCode = sCode + CHR(0xc2)+CHR(0x04)+CHR(0x00) && ret 4

RETURN sCode

PROCEDURE WaitForThreads(cExpr as String)

DO WHILE WaitForMultipleObjects(this.nThreads, this.cThreadHandles, 1, 500) = WAIT_TIMEOUT && wait msecs for the threads to finish

&cExpr && execute any passed in param while waiting

ENDDO

FOR i = 1 TO this.nThreads

CloseHandle(this.hThreads[i])

ENDFOR

PROCEDURE MemAlloc(nSize as Integer, cStr as String) as Integer

LOCAL nAddr

nAddr = HeapAlloc(this.hProcHeap, 0, nSize) && allocate memory

ASSERT nAddr != 0 MESSAGE "Out of memory"

INSERT INTO memAllocs VALUES (nAddr,"H") && track them for freeing later

SYS(2600,nAddr, LEN(cStr),cStr) && copy the string into the mem

RETURN nAddr

PROCEDURE CallDllFunction(strExport as String, strDllName as String) as String

*Create a string of machine code that calls a function in a DLL. Parms should already be pushed

LOCAL nAddr as Integer, hModule as Integer

hModule = LoadLibrary(strDllName)

INSERT INTO memAllocs VALUES (hModule,"L") && track loads for freeing later

nAddr=GetProcAddress(hModule,strExport)

ASSERT nAddr != 0 MESSAGE "Error: Export not found "+ strExport+" "+ strDllName

RETURN CHR(0xb8)+BINTOC(nAddr,"4rs") + CHR(0xff) + CHR(0xd0) && mov eax, addr; call eax

PROCEDURE MakeStr(str as String, fConvertToUnicode as Logical, fMakeBstr as Logical) as Integer

* converts a string into a memory allocation and returns a pointer

LOCAL nRetval as Integer

IF fConvertToUnicode

str=STRCONV(str+CHR(0),5)

ELSE

str = str + CHR(0) && null terminate

ENDIF

IF fMakeBstr

nRetval= SysAllocString(str)

ASSERT nRetval != 0 MESSAGE "Out of memory"

INSERT INTO memAllocs VALUES (nRetval,"B") && track them for freeing later

ELSE

nRetval= this.MemAlloc(LEN(str),str)

ENDIF

RETURN nRetval

PROCEDURE Destroy

SELECT memAllocs

SCAN

DO CASE

CASE AllocType="B" && BSTR

SysFreeString(memPtr)

CASE AllocType="H" && Heap

HeapFree(this.hProcHeap,0,memPtr)

CASE AllocType="L" && LoadLibrary

FreeLibrary(memPtr)

ENDCASE

ENDSCAN

ENDDEFINE

posted by Calvin_Hsia | 14 Comments

Thursday, May 11, 2006 11:51 AM

Sample program to create multiple threads

I used the CreateThread call and the Heap functions to create a simple sample program that spawns a separate thread that displays a MessageBox

Try running it and you will see a MessageBox. However, unlike a normal MessageBox in your application, this one is on a separate thread, and thus the main thread can continue processing.

The code allocates some memory and writes some bytes of x86 machine code to execute. Those bytes simply put up the MessageBox and return.

The MessageBox strings need to be allocated and freed, and the strings and the code must not be freed until after the thread terminates by Returning.

CLEAR ALL

CLEAR

#define CREATE_SUSPENDED 0x00000004

#define INFINITE 0xFFFFFFFF

#define WAIT_TIMEOUT 258

DECLARE integer LoadLibrary IN WIN32API string

DECLARE integer FreeLibrary IN WIN32API integer

DECLARE integer GetProcAddress IN WIN32API integer hModule, string procname

DECLARE integer CreateThread IN WIN32API integer lpThreadAttributes, ;

integer dwStackSize, integer lpStartAddress, integer lpParameter, integer dwCreationFlags, integer @ lpThreadId

DECLARE integer ResumeThread IN WIN32API integer thrdHandle

DECLARE integer CloseHandle IN WIN32API integer Handle

DECLARE integer GetProcessHeap IN WIN32API

DECLARE integer HeapAlloc IN WIN32API integer hHeap, integer dwFlags, integer dwBytes

DECLARE integer HeapFree IN WIN32API integer hHeap, integer dwFlags, integer lpMem

DECLARE integer WaitForSingleObject IN WIN32API integer hHandle, integer dwMilliseconds

hModule = LoadLibrary("user32")

adrMessageBox=GetProcAddress(hModule,"MessageBoxA")

FreeLibrary(hModule)

hProcHeap = GetProcessHeap()

sCaption="This is a MessageBox running in a separate thread"+CHR(0) && null terminate string

adrCaption = HeapAlloc(hProcHeap, 0, LEN(sCaption)) && allocate memory for string

SYS(2600,adrCaption,LEN(sCaption),sCaption) && copy string into allocated mem

* int 3 = cc (Debug Breakpoint: attach a debugger dynamically)

* nop = 90

* push 0 = 6a 00

* push eax = 50

* push 0x12345678 = 68 78 56 34 12

* ret 4 = c2 04 00

* mov eax, esp = 8B c4

* mov eax, 0x12345678 = B8 78 56 34 12

* call eax = ff d0

sCode=""

*sCode = sCode + CHR(0xcc)

sCode = sCode + CHR(0x6a) + CHR(0x00) && push 0

sCode = sCode + CHR(0x68) + BINTOC(adrCaption,"4rs") && push the string caption

sCode = sCode + CHR(0x6a) + CHR(0x00) && push the hWnd

sCode = sCode + CHR(0xb8) + BINTOC(adrMessageBox,"4rs") && move eax, adrMessageBox

sCode = sCode + CHR(0xff) + CHR(0xd0) && call eax

sCode = sCode + CHR(0xc2)+CHR(0x04)+CHR(0x00) && ret 4

AdrCode=HeapAlloc(hProcHeap, 0, LEN(sCode)) && allocate memory for the code

SYS(2600,AdrCode, LEN(sCode), sCode) && copy the code into the string

dwThreadId =0

?"Starting thread count = ",GetThreadCount()

hThread = CreateThread(0,1024, AdrCode, 0, CREATE_SUSPENDED, @dwThreadId)

?"Thread handle = ",hThread

?"Thread ID = ", dwThreadID

ResumeThread(hThread) && Start the thread

i=0

DO WHILE WaitForSingleObject(hThread, 100) = WAIT_TIMEOUT && wait 100 msecs for the thread to finish

?i,"Current thread count",GetThreadCount()

i=i+1

ENDDO

?"Final thread count = ",GetThreadCount()

?"Close",CloseHandle(hThread)

HeapFree(hProcHeap, 0, AdrCode) && if the thread hasn't finished, we're releasing the executing code and it'll crash

HeapFree(hProcHeap, 0, adrCaption)

RETURN

PROCEDURE GetThreadCount as Integer

*Use WMI to get process information

objWMIService = GetObject("winmgmts:\\.\root\cimv2")

colItems = objWMIService.ExecQuery("Select * from Win32_Process where processid = "+TRANSFORM(_vfp.ProcessId))

For Each objItem in colItems

nRetval = objItem.ThreadCount

posted by Calvin_Hsia | 18 Comments

Wednesday, May 03, 2006 11:32 AM

What API calls reset GetLastError between Declare DLL calls in VFP8?

I received a comment on this post: Will GetLastError ever work properly in VFP8.0?. I was consistently getting GetLastError() values that were correct in both VFP8 and VFP9. The reader comment said that he was getting an unexpected value of 0 in VFP8 even though he was expecting a failure value with an invalid password.

I knew that the problem was at least one intervening Win32API call that was resetting the GetLastError() value.

So I opened up trusty Visual Studio debugger and put a breakpoint on the call to LogonUserA . It’s a little complicated breakpoint syntax that indicates the dll name and the decorated API name:

{,,advapi32.dll}_LogonUserA@24

I can see the GetLastError value in the debugger by putting this in the watch window:

*(int *)(@tib+0x34)

This can be gleaned from stepping into the assembly code for the GetLastError function.

BTW, offset 0x24 will show you the current thread ID (*(int *)(@tib+0x24)). For further info on Thread Information Block (TIB), see Matt Pietrek’s still pertinent 10 year old article on TIB

For the address of the GetLastError value, I just precede it with the Address Of operator:

&*(int *)(@tib+0x34)

which gives me a hex value. So I put a data breakpoint on when that value changes. (I also could have set a break point on SetLastError)

When I continued after the LogonUser call, sure enough a breakpoint occurred showing code that sets the last error to 1326, as expected.

D:\>net helpmsg 1326

Logon failure: unknown user name or bad password.

This is the call stack when the GetLastError was set to 1326. You can see the parameter 1326 in the call stack.

> ntdll.dll!RtlRestoreLastWin32Error(1326) Line 239 C

advapi32.dll!BaseSetLastNTError(-1073741715) Line 56 C

advapi32.dll!LogonUserCommonW(0x00185458, 0x00184820, 0x00184838, 4, 3, 0, 0x0012d7f4, 0x00000000, 0x00000000, 0x00000000, 0x00000000) Line 1350 C

advapi32.dll!LogonUserCommonA(0x01ad6c9c, 0x01acf974, 0x01acf5e4, 4, 0, 0, 0x0012d7f4, 0x00000000, 0x00000000, 0x00000000, 0x00000000) Line 917 + 0x26 C

advapi32.dll!LogonUserA(0x01ad6c9c, 0x01acf974, 0x01acf5e4, 4, 0, 0x0012d7f4) Line 981 C

I hit F5 to continue from LogonUser, and, as expected, I saw an API call that set the value to 0: This was a call to TlsGetValue

> kernel32.dll!TlsGetValue(16) Line 2303 C

MSCTF.dll!GetSYSTHREAD() Line 169 + 0x7 C++

MSCTF.dll!SysGetMsgProc(0, 1, 1244208) Line 2598 + 0xb C++

user32.dll!DispatchHookW(196608, 1, 1244208, 0x7472c2b8) Line 395 C

user32.dll!CallHookWithSEH(0x0012fc20, 0x0012fc30, 0x0012fc4c, 0) Line 64 + 0x11 C

user32.dll!__fnHkINLPMSG(0x0012fc20) Line 4150 C

ntdll.dll!_KiUserCallbackDispatcher@12() Line 157 Asm

user32.dll!NtUserPeekMessage(1244424, 0, 0, 0, 1) Line 3899 C

user32.dll!PeekMessageA(0x0012fd08, 0x00000000, 0, 0, 1) Line 668 + 0x16 C

The VFP process was looking for any Windows messages to be processed. Why does it do that?

Suppose you had an infinite loop in VFP code. Hitting a key causes a Windows message to be sent to VFP, but it won’t be processed if there’s an infinite loop occurring. So between execution of every VFP statement, VFP will check to see if there are any pending Windows Messages to be processed. You can disable this behavior by setting _VFP.AutoYield to 0. Then the PeekMessage doesn’t happen and the expected value of 1326 is returned in VFP8

Although this will prevent the PeekMessage from occurring, there can be other API calls occurring between the execution of VFP statements and thus you cannot rely on GetLastError in VFP8. VFP internally may need to allocate memory or read from disk.or update a window.

That’s why I modified GetLastError behavior in VFP9 to be reliable for Declare DLL calls.

To learn more about debugging, see Is a process hijacking your machine? and Very Advanced Debugging tips

More about Declare DLL: DECLARE DLL performance questions and More DECLARE DLL performance discussion

More about AutoYield: How does Task Manager determine if an Application is Not Responding?

posted by Calvin_Hsia | 0 Comments

Monday, May 01, 2006 10:20 AM

Edit and Continue in VFP can save you time

Sometimes it takes many steps to reproduce a problem. Perhaps you have to start an application, log in, navigate some forms, menus, etc. until you finally reach a breakpoint in your code. Then you see the problem, want to modify the code and retest. That means executing all those steps again. Or you may be developing a particular component of an application that takes many steps while to navigate to.

The latest version of VB.Net has a feature, called Edit and Continue, which allows you to modify code and execute the modified code, without restarting the application. (I believe this feature was gone for a version or two of VB: can somebody confirm?)

Of course, if you make what’s called a “rude” edit, then VB.Net cannot continue and the app must be rebuilt and restarted. For example, changing a method signature or interface.

I’ve been doing my own “edit and continue” for more than a decade in VFP.

First, if you don’t have to build an APP or EXE file to run your application while developing, then don’t. Many applications can be run by directly DOing the main PRG file or DO FORM the main form. You may have to fiddle with SET PATH TO so that the program can find its constituent parts. An alternative is to Exclude the file from the APP or EXE from the project manager. Once it’s inside an APP or EXE, then it becomes readonly and thus unmodifiable.

Then, take advantage of the fact that once a program is no longer on the VFP call stack, it can be modified. You might need to CLEAR PROGRAM, depending on your application, but the below example doesn’t require it.

Paste the code below into a PRG file and run it. When it reaches the breakpoint, step til you get to “x=2”. Test1 was executed.

Modify the code in Test1 to fix the “bug” by changing the text string it prints to “New version!”.

Now Set Next Statement back to the “x=1” line. The newly modified version of Test1 will be executed!

Design your applications so that you can exploit this feature and you can save lots of time.

Here’s another example of saving time by not building code into the end APP or EXE: in my VFP COM servers, I have no code actually bound into the server, which means I don’t have to rebuild the server to make changes. If it’s a web server, I don’t have to shut down/restart the server or the web application.

See Blogs get 300 hits per hour: Visual FoxPro can count.

CLEAR ALL

ERASE test1.*

SET TEXTMERGE ON TO test1.prg && generate a test program

\PROCEDURE Test1

\ ?"now we're in Test1"

\ RETURN

SET TEXTMERGE to

MODIFY COMMAND test1.prg nowait && open the program in the editor

DoSomething()

PROCEDURE DoSomething

SET STEP ON && hard coded breakpoint

x=1

test1() && execute the program

x=2 && when we step to here, modify test1.prg, then Set Next Statement back to the x=1 line

RETURN

posted by Calvin_Hsia | 3 Comments

Thursday, April 27, 2006 10:57 AM

More DECLARE DLL performance discussion

In this post DECLARE DLL performance questions I asked whether using the WIN32API keyword or the particular DLL file name would be faster. It turns out that Win32API is much faster, and Martin Jindra, Timo, and Fabio Lunardon answered correctly that with Win32API, VFP doesn’t have to deal with files at all, but rather just DLLs that are already loaded.

Instead of dealing with files, DECLARE DLL for a Win32API calls the much faster GetModuleHandle to find the handle for the already loaded DLL.

Fabio goes on to ask whether the “A” feature can be restricted to Win32API calls. However, this is very difficult, because the DLLs that comprise the Win32API are not constant from Windows version to Windows version. For example, the VFP GETDIR() function calls the SHBrowseForFolder API, which is implemented in Shell32.dll.

GETDIR("c:\Windows","Description","Window Caption",64)

The AddUrlToFavorites function is found in shdocvw.dll. The GDIPlus Win32API functions are found in GDIPlus.dll Also, not every Win32API DLL is loaded in every process.

posted by Calvin_Hsia | 3 Comments

Monday, April 24, 2006 3:14 PM

DECLARE DLL performance questions

I was writing a sample about DECLARE DLL to show some of its features which I implemented about 12 years ago, when I rediscovered an interesting performance issue.

The purpose of DECLARE DLL is to allow the user to call functions in a DLL directly. For example, most of the Win32 API lives in DLLs and thus being able to call the API directly is very powerful.

In order to use the function in a DLL, you needed to know its name and its parameter signature. For example, the GetWindowText function of the Windows API will return the text associated with a Window handle. If the Window handle is a normal user Window, it’s the title of the window. If it’s the Window handle of a button, then it’s the text on the button. GetWindowText takes 3 parameters: the Window Handle, a string buffer to place the answer, and the size of that buffer. It returns the length of the result put in the string buffer.

In order to use this API from VB or VFP, you would need to know that it lives in User32.dll in your Windows System directory (typically c:\windows\system32\user32.dll). Also, there are actually 2 versions of this API, as the windows SDK header file for this API (win32sdk\include\winuser.h) shows:

#ifdef UNICODE

#define GetWindowText GetWindowTextW

#else

#define GetWindowText GetWindowTextA

#endif // !UNICODE

In fact, there are 2 versions of most Win32 APIs that deal with strings: one for UNICODE (2 bytes per character) and one for non-UNICODE (double byte (1 or 2 bytes per character) and ANSI (1 byte per character). These header files are how the programmer (almost all were C/C++ developers in the old days) can use the Win32API.

To hide this Unicode complexity from the user, the header file has a conditional #define, so the user just has to write GetWindowText, and the #define macro expands it in the C compiler preprocessor

The UNICODE version appends a “W” and the non-UNICODE version appends a “A”.

That means the actual DLL does not export “GetWindowText”, but has 2 exports: “GetWindowTextA” and “GetWindowTextW”

You can see the two by typing this in a Visual Studio command prompt:

D:\>link /dump /exports c:\windows\system32\user32.dll | find /i "getwindowtext"

376 177 0000F002 GetWindowTextA

377 178 0001F1BE GetWindowTextLengthA

378 179 0000DC5F GetWindowTextLengthW

379 17A 0000BA08 GetWindowTextW

402 191 0000C057 InternalGetWindowText

So the user would have to declare GetWindowTextA rather than GetWindowText.

To hide this complexity from the every day user, VFP will try to see if the specified function exists in the DLL. If it doesn’t, a “A” is appended to the function name and the DLL is queried again.

Because of this trial and error approach, one would think that appending the “A” before calling the API would make a difference in performance.

Another complexity arises for Win32 API calls (but not for other DLLs). The user is required to know in which particular DLL of Windows the function resides. Back in the old days, it wasn’t quite as clear. With MSDN online now, it’s pretty easy to see at the bottom of the MSDN topic for the API. The DECLARE DLL command allows the user to just type “Win32API” instead of the DLL name, which means User32.dll, Gdi32.dll, Kernel32.dll , Advapi32.dll and Mpr.dll are searched (in that order).

So the question is which would be faster: specifying the particular DLL name directly, or using “Win32API”? How about specifying with or without the “A” ?

Calvin Hsia's WebLog

This Blog

Syndication

Search

Archives

Navigation

Post Categories

Customizing the Blog Crawler for different formats

How does EventHandler work? IConnectionPoint!

The VB version of the Blog Crawler

If your machine freezes, maybe you can reboot it gracefully from another machine

Use conditional build events to freshen zip files in Visual Studio

Error Reading File infinite loop if drive disabled while file open and Data Session window open

Webcrawl a blog to retrieve all entries locally: RSS on steroids

More Multithread capabilities: interthread synchronization, error checking

Meeting with some customers, manipulating SQL Server with Stored Procs

Create multiple threads from within your application

Sample program to create multiple threads

What API calls reset GetLastError between Declare DLL calls in VFP8?

Edit and Continue in VFP can save you time

More DECLARE DLL performance discussion

DECLARE DLL performance questions