[fpc-pascal] Re: assign code to a method

Angel Montesinos montesin at uv.es
Tue Feb 22 21:24:23 CET 2011


> Many thanks, Andrew. I intend to apply this to my old programs in 32
> bit Windows. I'll tell you about the outcome.

Below you will see a console application for testing your suggestions 
or better my understanding of them. The results are (in Windows XP 64 
bits Pro):

    1. When Data Execution Prevention (DEP) is enforced, the program 
fails.

    2. When DEP is enforced only for essential Windows programs, the 
program functions (that is, it writes the value of pi). But if
one uncomments the commented line of code, that is  makes
    codeFunction:= '',
the program fails.


What may be happening here?

Many thanks






-- 
montesin at uv dot es


{--------------begins code for console app------------------}

program Test_VirtualAlloc;

{$APPTYPE CONSOLE}

uses
   SysUtils, Types, Windows;

type

   PCodeBlock= ^CodeBlock;
   CodeBlock = record
     size: DWord;
     code: Pointer;
   end;

   RealFunction = function(const X : array of Extended) : Extended;

   TOpCodeFunctionExtended = class(TObject)
   private
     functionCode : AnsiString; {the function opCode sequence}
   public
     F : function(const X : array of Extended) : Extended;
     FBlock: PCodeBlock;
     constructor Create;
     destructor Destroy; override;
   end;

   var
     theF: TOpCodeFunctionExtended;
     rslt: Extended;
     linetxt: AnsiString;


   constructor TOpCodeFunctionExtended.Create;
   var
     len: Integer;
   begin
     inherited;

     {execution of this puts pi in the register st(0) of FPU}
     functionCode:= #$55  +       {push ebp}
                    #$8B#$EC +    {mov ebp, esp}
                    #$D9#$EB +    {fldpi}
                    #$C9     +    {leave}
                    #$C3;         {ret}

     len:= Length(functionCode);

     FBlock:= VirtualAlloc(nil, len + SizeOf(codeBlock), MEM_COMMIT, 
PAGE_EXECUTE_READWRITE);
     Move(functionCode, PChar(FBlock^.code), len);
     FBlock.size:= len;

     @F := FBlock^.code;   {assignation of code to the function}

     //functionCode:= '';  {if this is uncommented, program fails}
   end;

   destructor TOpCodeFunctionExtended.Destroy;
   begin
     if FBlock <> nil then begin
       VirtualFree(FBlock, 0, MEM_RELEASE);
       FBlock:= nil;
     end;
     theF.Free;
     inherited
   end;


begin
   theF:= TOpCodeFunctionExtended.Create;
   Writeln('Enter a character. For exiting, enter an ''x''');
   Writeln;
   try
     repeat
       readln(linetxt);
       if linetxt <> 'x'  then begin
         rslt:= theF.F([]);
         writeln(FloatToStrF(rslt, ffFixed, 18, 18));
       end;
     until linetxt = 'x';
   except on exception do
     ;
   end;
end.

{--------------ends code for console app------------------}




More information about the fpc-pascal mailing list