Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Why does this code fail when declaring TMemoryStream locally but works when globally declared?

The following function takes the selected text in a Richedit control, writes to a TMemoryStream inside a callback function and then returns as a plain text string the raw rtf code.

var
  MS: TMemoryStream; // declared globally and works.

implementation

function GetSelectedRTFCode(RichEdit: TRichedit): string;

  function RichEditCallBack(dwCookie: Longint; pbBuff: PByte;
    CB: Longint; var pCB: Pointer): Longint; stdcall;
  begin
    MS.WriteBuffer(pbBuff^, CB);
    Result := CB;
  end;

var
  EditStream: TEditStream;
  SL: TStringList;
begin
  MS := TMemoryStream.Create;
  try
    EditStream.dwCookie     := SF_RTF or SFF_SELECTION;
    EditStream.dwError      := 0;
    EditStream.pfnCallback  := @RichEditCallBack;
    Richedit.Perform(EM_StreamOut, SF_RTF or SFF_SELECTION, DWord(@EditStream));
    MS.Seek(0, soBeginning);

    SL := TStringList.Create;
    try
      SL.LoadFromStream(MS);
      Result := SL.Text;
    finally
      SL.Free;
    end;
  finally
    MS.Free;
  end;
end;

The above works as expected without any errors.

However, I try to avoid globally declared variables when possible and keep them local to the procedure or function that needs it, but for some reason declaring MS: TMemoryStream; inside the GetSelectedRTFCode function fails with Priviliged Instruction and Access Violation errors.

So with that in mind, and the only change below been MS: TMemoryStream; declared locally fails:

function GetSelectedRTFCode(RichEdit: TRichedit): string;
var
  MS: TMemoryStream; // declare here instead of globally but fails.

  function RichEditCallBack(dwCookie: Longint; pbBuff: PByte;
    CB: Longint; var pCB: Pointer): Longint; stdcall;
  begin
    MS.WriteBuffer(pbBuff^, CB);
    Result := CB;
  end;

var
  EditStream: TEditStream;
  SL: TStringList;
begin
  MS := TMemoryStream.Create;
  try
    EditStream.dwCookie     := SF_RTF or SFF_SELECTION;
    EditStream.dwError      := 0;
    EditStream.pfnCallback  := @RichEditCallBack;
    Richedit.Perform(EM_StreamOut, SF_RTF or SFF_SELECTION, DWord(@EditStream));
    MS.Seek(0, soBeginning);

    SL := TStringList.Create;
    try
      SL.LoadFromStream(MS);
      Result := SL.Text;
    finally
      SL.Free;
    end;
  finally
    MS.Free;
  end;
end;

Why would declaring the memory stream variable globally work, but fail when declared locally?

like image 786
Craig Avatar asked Mar 17 '15 12:03

Craig


1 Answers

The problem is that your use of a nested function as a callback is wrong. By a chance of implementation using a nested function in that way works for the 32 bit compiler, so long as the nested function does not refer to any local variables of surrounding functions.

However, as soon as the nested function refers to any such local variables, then an extra hidden parameter must be passed so that the nested function can gain access to the surrounding functions stack frames. And for the 64 bit compiler, a hidden extra parameter is always passed.

You'll find lots of examples on the web where people demonstrate passing nested functions as callbacks. But all of these examples break the documented rules of the language:

Nested procedures and functions (routines declared within other routines) cannot be used as procedural values, nor can predefined procedures and functions.

What you must do is stop using nested functions for callbacks. You need to declare the callback function as having global scope. Pass the memory stream via the dwCookie member of the EDITSTREAM struct.

// This compiles now, but the callback implementation is wrong, see below

function RichEditCallBack(dwCookie: DWORD_PTR; pbBuff: PByte;
  CB: Longint; var pCB: Longint): Longint; stdcall;
var
  MS: TMemoryStream;
begin
  MS := TMemoryStream(dwCookie);
  MS.WriteBuffer(pbBuff^, CB);
  Result := CB;
end;

function GetSelectedRTFCode(RichEdit: TRichedit): string;
var
  MS: TMemoryStream;
  EditStream: TEditStream;
  SL: TStringList;
begin
  MS := TMemoryStream.Create;
  try
    EditStream.dwCookie     := DWORD_PTR(MS);
    EditStream.dwError      := 0;
    EditStream.pfnCallback  := RichEditCallBack;
    Richedit.Perform(EM_StreamOut, SF_RTF or SFF_SELECTION, LPARAM(@EditStream));
    MS.Seek(0, soBeginning);

    SL := TStringList.Create;
    try
      SL.LoadFromStream(MS);
      Result := SL.Text;
    finally
      SL.Free;
    end;
  finally
    MS.Free;
  end;
end;

Note in particular that I have not used the @ operator to get the callback function's address. Using the @ operator on a function results in a suppression of type checking. Had you not used the @ operator, then the compiler would have been able to tell you your mistakes.

The compiler would have said:

[dcc32 Error] E2094 Local procedure/function 'RichEditCallBack' assigned to 
procedure variable

And note also that your code declares the type of the final parameter incorrectly. It's a reference parameter of type Longint. Again, the compiler can report this, and does report this, unless you have used @ to obtain the function address.

This second error leads on to the implementation of the callback. It is incorrect. The return value indicates success. A value of zero is used to indicate success, any other value indicates failure. The number of bytes written must be returned via the final parameter. Your callback should look like this:

function RichEditCallBack(dwCookie: DWORD_PTR; pbBuff: PByte;
  CB: Longint; var CBWritten: Longint): Longint; stdcall;
var
  MS: TMemoryStream;
begin
  MS := TMemoryStream(dwCookie);
  CBWritten := MS.Write(pbBuff^, CB);
  Result := IfThen(CB = CBWritten, 0, 1);
end;
like image 132
David Heffernan Avatar answered Oct 19 '22 12:10

David Heffernan