Find which DLLs in your system are rebased


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]

Comments (6)

  1. Try running this code: PUBLIC xx xx= CREATEOBJECT ("MyClass") quit &amp;&amp; quit Foxpro DEFINE CLASS

  2. Herman Tan says:

    Hi Calvin,

    When I tried the code, there is an error in the code: USE jumps AGAIN IN 0 ORDER 1 ALIAS jumpdefs

    The error: Jumps.DBF not found

    Anyway, it’s not a big deal. Thanks for This really COOL stuff! I’ve seen some VB code that embedded Assembly code. However I never thought to use the same technique in VFP, because there is no VFP function to call the address.

    I’ve read several articles from you that using the same technique. From what I see, we can use EnumChildWindows() (or similar Win32API) to substitute the call function, am I getting it right? If so, are there any side effect that I should consider about?

    Thank you

  3. Calvin_Hsia says:

    Hi Herman,

    I fixed the error: I accidentally posted the unfixed version.

    Yes: EnumChildWindows is fine to call your ASM code.

    Thanks for your feedback!

  4. Herman Tan says:

    Hi Calvin,

    Ah..so it’s fine! Thanks for the prompt reply and thank you very much for this great articles!

  5. 9dGood idea.9k I compleatly disagree with last post .  tsy

    <a href="http://skuper.ru">паркетная доска</a> 0e

Skip to main content