You can use CreateToolhelp32Snapshot and its family of functions to enumerate the running processes on your machine, including the modules loaded by each process

 

My prior post (DLL Image base addresses are the same in XP, different on Vista) described how Dlls are loaded and how some can be rebased, causing more memory use and a decrease in performance.

 

The code in Create your own Flip Task Bar with live thumbnails using Vista Desktop Window Manager DWM includes a reusable class called CEnumWIndows which inherits from another reusable class CAsmLib.

 

CAsmLib contains some basic utility routines to generate assembly code that can be executed. Specifically, it includes a routine to call an export from a DLL given the function and DLL names, and some routines to handle string manipulation and memory allocation.

 

CEnumWindows generates Asm code that can be called.

 

On Vista, the CThumb class (inherits from CEnumWindows) creates live thumbnails on a form. The Vista code is commented out below.

 

On Win XP, the CModules class (inherits from CEnumWindows) calls some of the CreateToolhelp32Snapshot functions to identify running processes and their modules.

 

It’s used to run a few SQL queries to create a few cursors that can be examined.

  • hWnds: a list of all windows currently created along with their titles, if any.
  • ModuleCount: A list of all modules currently loaded into all processes along with how many times they’re loaded: kernel32.dll is loaded into each process.
  • MultiReloc: list those modules that are loaded at different base addresses: this means that they the loader has to fixup addresses in them and that they take more memory due to dirty write pages.

 

 

On my Win XP machine, I had 58 processes with 1510 modules  and 44 total rebases. Normaliz.Dll (Unicode Normalization DLL) is rebased to 8 different addresses in 8 processes.

 

On my tablet with Win XP, 90 processes with 2199 modules and 98 total rebases. nbmatip.dll is rebased 17 times in 17 processes, and xpsp2res.dll 13 times in 25 processes!

 

On one of my Vista machines, (running as Admin so as to get Admin processes)  60 processes and 1264 modules with only  4 total modules rebased.

 

Of course, a better comparison between machines would be to have the same processes running on them.

 

 

Now the challenge: write a program that finds all the available virtual address space from each process and see if there’s enough room to rebase the multireloc DLLs to improve performance! Each process has 4 gigs of address space (of which the lower 2 gigs are available (unless you’re using Physical Address Extension (PAE) or the /3GB switch in boot.ini). You have the information required: tables of processes, modules, their image size and default base address.

 

 

 

See also:

Write your own Task Manager

Find all statically linked libraries required before your process can start

How to log application API calls using import module addresses

What external code does your EXE depend on?

 

Under the Hood: Optimizing DLL Load Time Performance -- MSDN Magazine ...

 

 

SET SAFETY OFF

CLEAR ALL

CLEAR

MODIFY COMMAND PROGRAM() NOWAIT

 

PUBLIC oForm

#iF .f.

      oForm=CREATEOBJECT("CThumbForm")    && the DWM thumbs for Vista: see

                                                && http://blogs.msdn.com/calvin_hsia/archive/2007/05/05/create-your-own-flip-task-bar-with-live-thumbnails-using-vista-desktop-window-manager-dwm.aspx

#ELSE

      oForm=CREATEOBJECT("cModules")

      SELECT hWnd,title,hwnds.pid,file from hwnds INNER JOIN procs ON hwnds.pid = procs.pid ORDER BY hwnds.pid INTO CURSOR hWnds

      BROWSE LAST NOWAIT

      SELECT FILE,baseaddress,count(*) from modules GROUP BY file,baseaddress INTO cursor ModuleCount

      BROWSE LAST NOWAIT

      SELECT file,count(*) as nRebases from ModuleCount GROUP BY file HAVING nRebases > 1 INTO CURSOR multireloc

      BROWSE LAST NOWAIT

      CALCULATE SUM(nRebases) TO nTotalRebases

      ?"Total # of processes = ",RECCOUNT("procs")

      ?"Total # of modules = " , RECCOUNT("modules")

      ?"Total # of Rebases = ",nTotalRebases

 

 

#define TH32CS_SNAPHEAPLIST 0x00000001

#define TH32CS_SNAPPROCESS  0x00000002

#define TH32CS_SNAPTHREAD   0x00000004

#define TH32CS_SNAPMODULE   0x00000008

#define TH32CS_SNAPMODULE32 0x00000010

#define TH32CS_SNAPALL      (TH32CS_SNAPHEAPLIST | TH32CS_SNAPPROCESS | TH32CS_SNAPTHREAD | TH32CS_SNAPMODULE)

#define TH32CS_INHERIT      0x80000000

#define INVALID_HANDLE_VALUE -1

 

DEFINE CLASS CModules as CEnumWindows

      PROCEDURE Init

            DODEFAULT()

            DECLARE integer CreateToolhelp32Snapshot IN WIN32API integer dwFlags, integer pid

            DECLARE integer CloseHandle IN WIN32API integer handle

            DECLARE integer Process32First IN WIN32API integer hSnap, string @ pe32

            DECLARE integer Process32Next IN WIN32API integer hSnap, string @ pe32

            DECLARE integer Module32First IN WIN32API integer hSnap, string @ me32

            DECLARE integer Module32Next IN WIN32API integer hSnap, string @ me32

 

            CREATE CURSOR procs (pid n, file c(100), ParentPid n, ThreadCount n)

            CREATE CURSOR modules (pid n, file c(100), baseaddress c(12),size n)

 

            this.GetProcesses()

      PROTECTED PROCEDURE GetProcesses()

            LOCAL fContinue,hSnapProc,dwSize,pe32,nPid,cFile

            hSnapProc=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS ,0)

            IF hSnapProc != INVALID_HANDLE_VALUE

                  dwSize= 10*4+260

                  pe32 = SPACE(dwSize)

                  fContinue =Process32First(hSnapProc,@pe32)

                  DO WHILE fContinue>0

                        nPid=CTOBIN(SUBSTR(pe32,2*4+1,4),"4rs")

                        nThreads=CTOBIN(SUBSTR(pe32,5*4+1,4),"4rs")

                        nParentPid=CTOBIN(SUBSTR(pe32,6*4+1,4),"4rs")

                        cFile=SUBSTR(pe32,10*4-4+1)

                        cFile=JUSTSTEM(LEFT(cFile,AT(CHR(0),cFile)-1))

                        INSERT INTO procs (pid,file,ParentPid, ThreadCount) VALUES (nPid,cFile,nParentPid,nThreads)

*                       ?nPid,nThreads,nParentPid,LEFT(cFile,20)

                        IF nPid >0  && indicates do current process, and we don't want to do it twice

                              this.GetModules(nPid)

                        ENDIF

                        pe32 = SPACE(dwSize)

                        fContinue=Process32Next(hSnapProc,@pe32)

                  ENDDO

                  CloseHandle(hSnapProc)

            ENDIF

*           INDEX ON pid TAG pid    && if you want it a little faster

      PROTECTED PROCEDURE GetModules(npid as Integer)

            LOCAL fContinue,hSnapMod,dwSize,me32,cFile

            hSnapMod=CreateToolhelp32Snapshot(TH32CS_SNAPMODULE ,npid)

            IF hSnapMod != INVALID_HANDLE_VALUE

                  dwSize= 8*4 + 255 + 1 + 260   && see TlHelp32.h

                  me32 = SPACE(dwSize)

                  fContinue =Module32First(hSnapMod,@me32)

                  DO WHILE fContinue>0

*                       nPid=CTOBIN(SUBSTR(me32,2*4+1,4),"4rs")

                        cFile=SUBSTR(me32,9*4-4+1)

                        cFile=LEFT(cFile,AT(CHR(0),cFile)-1)

                        nBase=CTOBIN(SUBSTR(me32,5*4+1,4),"4rs")

                        nSize=CTOBIN(SUBSTR(me32,6*4+1,4),"4rs")

           

*                       ?nPid,TRANSFORM(nBase,"@0x"),TRANSFORM(nSize,"@0x"),cFile

                        INSERT INTO modules (pid,file,baseaddress,size) VALUES (nPid,cFile,TRANSFORM(nBase,"@0x"),nSize)

                        me32 = SPACE(dwSize)

                        fContinue=Module32Next(hSnapMod,@me32)

                  ENDDO

                  CloseHandle(hSnapMod)

            ENDIF

           

ENDDEFINE

 

#ENDIF

 

     

#define WS_VISIBLE 0x10000000

#define WS_BORDER 0x00800000

 

DEFINE CLASS CThumbForm as Form

      ShowWindow=2      && Top Level

      width=SYSMETRIC(1)  && entire width of display

      height=100

      MinButton=.f.     && don't allow minimize for us

      nThumbs=0   && number of thumbs currently on form

      fDWM = .f.  && are we running under Vista Desktop Window Management?

      nThumbWidth=400   && size of thumb to draw

      nThumbHeight=this.nThumbWidth * SYSMETRIC(2)/SYSMETRIC(1)   && same aspect ratio as desktop

      ADD OBJECT cmdQuit as CommandButton WITH Caption="\<Quit",cancel=.t.

      ADD OBJECT cmdRefresh as CommandButton WITH Caption="\<Refresh",left=120

      ADD OBJECT oSlider as cSlider WITH left=250

      ADD OBJECT oTimer as Timer WITH interval=2000 && millisecs

      PROCEDURE oTimer.Timer

            thisform.GetHWnds("NewTopLevel")

            SELECT hWnd,Title FROM NewTopLevel WHERE hWnd NOT in (SELECT hWnd FROM TopLevel) UNION ;

                  SELECT hWnd,Title FROM TopLevel WHERE hWnd NOT in (SELECT hWnd FROM NewTopLevel) ;

                  INTO CURSOR temp

            IF _Tally>0 && a new window was created or destroyed

                  thisform.GetThumbNails()      && ToDo: optimize for only the change

            ENDIF

      PROCEDURE cmdRefresh.Click

            thisform.GetThumbNails()

      PROCEDURE cmdQuit.Click

            thisform.release

      PROCEDURE Init

            SET TALK OFF

            IF VAL(OS(3))>=6  && runnning under Vista. Check for Desktop Composition enabled

                  DECLARE integer DwmIsCompositionEnabled IN dwmapi integer @ dwEnabled

                  dwEnabled=0

                  IF DwmIsCompositionEnabled(@dwEnabled) = 0 AND dwEnabled>0

                        this.fDWM = .t.

                  ENDIF

            ENDIF

            IF this.fDWM

                  DECLARE integer DwmRegisterThumbnail IN dwmapi integer hwndDest, integer  hwndSrc, integer @ nThumbnailId

                  DECLARE integer DwmUnregisterThumbnail IN dwmapi integer nThumbnailId

                  DECLARE integer DwmQueryThumbnailSourceSize IN dwmapi integer nThumbnailId, string @pSize

                 DECLARE integer DwmUpdateThumbnailProperties IN dwmapi integer hThumbnailId, string  @ ptnProperties

                  DECLARE integer SetForegroundWindow IN WIN32API integer

                  DECLARE integer GetWindowPlacement IN WIN32API integer hWnd, string @ pPlacement

                  DECLARE integer SetWindowPlacement IN WIN32API integer hWnd, string @ pPlacement

                 

                  this.Visible=1

*                 this.GetThumbNails()    && Resize will call GetThumbNails

            ELSE

                  NEWOBJECT("CEnumWindows")     && call the class that creates the cursor of hWnds

                  LOCATE      && go to the top of the cursor

                  BROWSE LAST NOWAIT

                  RETURN .f.  && don't create form

            ENDIF

      PROCEDURE Resize

            this.GetThumbNails()

      PROCEDURE GetHWnds(DestCursor as string)

            NEWOBJECT("CEnumWindows")     && call the class that creates the cursor of hWnds

            SELECT * FROM hwnds WHERE BITAND(style,WS_VISIBLE+WS_BORDER) = WS_VISIBLE+WS_BORDER AND ;

                  hWnd != thisform.HWnd ;

                  INTO CURSOR (DestCursor)      && Only those hWnds which are visible and have a border

            RETURN _tally

      PROCEDURE GetThumbNails

            LOCAL cStr,oLbl,cName,x,y,oi

            thisform.LockScreen= .T.

            FOR indx = 1 TO thisform.nThumbs

                  cName="im"+PADL(indx,3,"0")   && im001, im002...

                  thisform.RemoveObject(cName)

                  IF TYPE("thisForm."+cName+"lbl")="O"

                        thisform.RemoveObject(cName+"lbl")

                  ENDIF

            ENDFOR

            thisform.nThumbs=this.GetHWnds("TopLevel")

            INDEX on hwnd TAG hwnd

            nRatio = thisform.oSlider.Value/thisform.oSlider.max

            x = 0

            y = 20

            indx=1

            SCAN

                  cName="im"+PADL(indx,3,"0")   && im001, im002...

                  thisform.AddObject(cName,"CThumb")

                  cStr="Thisform."+cName

                  oi = EVALUATE(cStr)

                  oi.Height = this.nThumbHeight * nRatio

                  oi.Width = this.nThumbWidth * nRatio

                  oi.Left = x

                  oi.Top = y

                  oi.visible=1

                  oi.RegThumb(hWnd,ALLTRIM(title))

                  indx=indx+1

                  x = x +  this.nThumbWidth* nRatio

                  IF x +  this.nThumbWidth* nRatio > thisform.Width

                        x=0

                        y = y + this.nThumbHeight* nRatio+20

                  ENDIF

            ENDSCAN

            thisform.LockScreen= .f.

ENDDEFINE

 

DEFINE CLASS cSlider AS Olecontrol

      OleClass="mscomctllib.slider.2"

      PROCEDURE Init

            this.min=1

            this.max=100

            this.value=INT(this.max/5)

            this.SmallChange=INT(this.max/50)

            this.LargeChange=INT(this.max/5)

      PROCEDURE Change  && when the slider value changes

            thisform.GetThumbNails()

ENDDEFINE

 

 

#define GWL_STYLE 0xfffffff0

#define WS_MINIMIZE 0x20000000

#define SW_RESTORE 9

#define DWM_TNP_RECTDESTINATION 1

#define DWM_TNP_RECTSOURCE 2

#define DWM_TNP_OPACITY 4

#define DWM_TNP_VISIBLE 8

#define DWM_TNP_SOURCECLIENTAREAONLY 0x10

 

 

DEFINE CLASS CThumb as CommandButton

      nThumbId = 0

      style=1 && invisible

      enabled=.t.

      hWnd=0

      PROCEDURE click   && user clicked on thumbnail: let's activate it

            IF BITAND(GetWindowLong(this.hWnd,GWL_STYLE), WS_MINIMIZE) > 0    && if window is minimized

                  pPlacement=BINTOC(11*4,"4rs") + SPACE(10*4)     && 11 4 byte words

                  IF GetWindowPlacement(this.hWnd, @pPlacement) > 0

                        pPlacement = LEFT(pPlacement,2*4) + BINTOC(SW_RESTORE,"4rs")+SUBSTR(pPlacement,13)  && Restore it

                        SetWindowPlacement(this.hWnd, @pPlacement)

                  ENDIF

            ENDIF

            SetForegroundWindow(this.hWnd)

      PROCEDURE RegThumb(hWnd as Integer,cTitle as String)

            LOCAL cStr,oLbl,cName

            nResult=0

            this.hWnd=hWnd

            IF DwmRegisterThumbnail(thisform.hWnd, m.hWnd, @nResult ) = 0 AND nResult > 0

                  this.nThumbId = nResult

                  cName=this.Name+"lbl"   && iml001002lbl

                  cStr="thisform."+cName

                  thisform.AddObject(cName,"Label")

                  oLbl=EVALUATE(cStr)

                  WITH oLbl as Label

                        .Top=this.Top+this.Height

                        .Left = this.Left

                        .Width = MAX(this.Width-10,0)

                        .Height = 20

                        .Caption=cTitle

                        .Visible=1

                  ENDWITH

                 

*                 @this.Left,this.top+this.Height say cTitle

                  cStr=SPACE(8)

*!*                     ?"TSize",DwmQueryThumbnailSourceSize(nResult, @cStr)  && gets the size of the Source window

*!*                     ?CTOBIN(LEFT(cStr,4),"4rs"),CTOBIN(RIGHT(cStr,4),"4rs")

                  dwFlags= DWM_TNP_RECTDESTINATION + DWM_TNP_OPACITY + DWM_TNP_VISIBLE

                  nOpacity = 255    && can make the thumbnails glass

                  fVisible= 1 && make the thumb visible?

                  fSourceClientAreaOnly = 0     && just client area of source thumbnail?

                  rDest= ;

                        BINTOC(this.Left,"4rs") + ;

                        BINTOC(this.Top,"4rs") + ;

                        BINTOC(this.Left + this.Width,"4rs") + ;

                        BINTOC(this.Top+this.Height,"4rs") && where to render the thumbnail

                  rSrc= ;

                        BINTOC(0,"4rs") + ;

                        BINTOC(0,"4rs") + ;

                        BINTOC(0,"4rs") + ;

                        BINTOC(0,"4rs")   && rSrc: region of thumbnail to render. We'll use the whole src image

                  cProps = ;

                        BINTOC(dwFlags,"4rs") + ;

                        rDest + ;

                        rSrc + ;

                        CHR(nOpacity) + ;

                        BINTOC(fVisible,"4rs") + ;

                        BINTOC(fSourceClientAreaOnly,"4rs")

                  hr  =DwmUpdateThumbnailProperties(nResult, @ cProps)

            ENDIF

      PROCEDURE destroy

            IF this.nThumbId > 0

                  DwmUnregisterThumbnail(this.nThumbId)

            ENDIF

ENDDEFINE

 

DEFINE CLASS CEnumWindows AS CAsmLib

 

      PROCEDURE Init

            DODEFAULT() && call parent class Init

            DECLARE integer GetWindowText IN WIN32API integer,  string @, integer

            DECLARE integer GetWindowLong IN WIN32API integer, integer

            DECLARE integer GetWindowThreadProcessId IN WIN32API integer hWnd, integer @ pid

            DECLARE integer EnumChildWindows IN WIN32API integer hWnd, integer lpEnumProc, integer lParam

 

            CREATE cursor HWnds (hWnd i, title c(100), style i,pid n)

            this.CreateEnumWindowCode("INSERT INTO HWnds (hWnd) VALUES (%d)") && use this cmd to insert a record into the cursor

            SELECT hWnds      && Now scan through the cursor and get the window titles and styles

            SCAN

                  cText=SPACE(100)

                  nLen=GetWindowText(hWnd,@cText,LEN(cText))      && Get the title of the window

                  mPid=0

                  GetWindowThreadProcessId(hWnd,@mpid)      && Get the window's ProcessID

                  REPLACE title WITH LEFT(cText,nLen) ,style WITH GetWindowLong(hWnd,GWL_STYLE),pid WITH mPid

            ENDSCAN

      PROTECTED PROCEDURE CreateEnumWindowCode(cCmd as String)

            *This simple code doesn't need jumps, but included anyway for general usefulness for branching code

            CREATE CURSOR jumps (cLabel c(20),cFlag c(1),sCodePos i)    && cFlag="D" defined, "R", reference

            INDEX on cLabel+cFlag TAG cLabel

            nLocals=0x60      && enough space for local vars

            sCode=""

            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("MessageBeep", "user32")     && MessageBeep(0)

 

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

 

            *swprintf(ebp-a0h, 0x30,cCmd,hWnd)  && replace the "%d" with the hWnd: "INSERT INTO HWnds (hWnd) VALUES (%d)"

            sCode = sCode + CHR(0x8b) + CHR(0x45) + CHR(0x08)     && mov eax, [ebp+8]     && get the hWnd

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

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

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

            sCode = sCode + CHR(0x8d) + CHR(0x45)+CHR(0xa0) && lea eax, [ebp-a0h]   && addr to put swprintf result

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

            sCode = sCode + this.CallDllFunction("swprintf", "msvcrt")  && swprintf(ebp-a0h, 0x30,cCmd,hWnd)

            sCode = sCode + CHR(0x83)+ CHR(0xc4)+ CHR(0xc) && add esp, 0ch   pop 3*4 _cdecl args

           

            *SysAllocString() This string for each window,so it must be freed with SysFreeString below

            sCode = sCode + CHR(0x8d) + CHR(0x45)+CHR(0xa0) && lea eax, [ebp-a0h]   && addr of swprintf result

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

            sCode = sCode + this.CallDllFunction("SysAllocString", "oleaut32")      && SysAllocString

 

            *_vfp.DoCmd()

            sCode = sCode + CHR(0x89) + CHR(0x45) + CHR(0xf0)     && mov [ebp-10h], eax   ; save the bstr so we can free it

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

            sCode = sCode + CHR(0xb8) + BINTOC(SYS(3095,_vfp),"4rs")    && mov eax, the IDispatch for _VFP

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

           

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

            sCode = sCode + CHR(0x05) + BINTOC(0x84,"4rs")  && add eax, 84h   the function at 84h in the vTable, which is DoCmd

            sCode = sCode + CHR(0xff) + CHR(0x10)&& call  [eax] && call indirect

            sCode = sCode + CHR(0x83) + CHR(0xf8) + CHR(0x00)     && cmp eax, 0     && if hr = SUCCESS

            * jne FailedDoCmd

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

            INSERT INTO jumps values ("FailedDoCmd","R",LEN(sCode))     && refer to a label to jump to at this pos

 

            *else { //FailedDoCmd

                  INSERT INTO jumps values ("FailedDoCmd","D",LEN(sCode))     && define a label at this pos

 

            * now free the bstr

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

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

            sCode = sCode + this.CallDllFunction("SysFreeString", "oleaut32") && vswprintf(ebp-a0h, 0x30,cCmd,hWnd)

           

 

 

            sCode = sCode + CHR(0xb8) + BINTOC(1,"4rs")     && mov eax, 1     && return 1 so Enum continues

*           sCode = sCode + CHR(0x33) + CHR(0xc0)     && xor eax,eax    && make return value 0 so won't enum any more windows

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

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

            sCode = sCode + CHR(0xc2)+CHR(0x08)+CHR(0x00)   && ret 8    && EnumChildProc has 2 parms:  pop 2 args=8 bytes

 

            USE DBF("jumps") AGAIN IN 0 ORDER 1 ALIAS jumpdefs

            SCAN FOR cFlag="R"      && look for all references

                  =SEEK(jumps.cLabel+"D","jumpdefs")

                  sCode=LEFT(sCode,jumps.sCodePos-1)+CHR(jumpdefs.sCodePos - jumps.sCodePos) + SUBSTR(sCode,jumps.sCodePos+1) && now fix up the jump location to jump to the definition

            ENDSCAN

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

            EnumChildWindows(0,AdrCode,0) && EnumChildWindows needs a callback function. We'll give it our code.Added benefit: Win32 Exception handling of Declare dll

            USE IN jumpdefs

            USE IN jumps           

           

ENDDEFINE

 

 

DEFINE CLASS CAsmLib as Custom      && utility to help generate ASM code

      hProcHeap =0

      PROCEDURE Init

            SET ASSERTS ON

            DECLARE integer LoadLibrary IN WIN32API string

            DECLARE integer FreeLibrary IN WIN32API integer

            DECLARE integer GetProcAddress IN WIN32API integer hModule, string procname

            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 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 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,nSel

            nSel=SELECT()

            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

            USE

            SELECT (nSel)

ENDDEFINE

 

 

End of code

[8/6/07: changed CREATE CURSOR jumps to CREATE TABLE jumps]