0

I have tried to get the following code to work in a 64 bit environment:

    unit RTFProcs1;
interface
uses
Windows, classes, comctrls, Messages, RichEdit, vcl.Dialogs, System.SysUtils, ad4Controls, Ad3RicheditDB;


Procedure AppendFromRichEdit(FromRch,ToRch: TAddictSpellRichEdit);

implementation
Type
  TEditStreamCallBack = function (dwCookie: Longint; pbBuff: PByte;
    cb: Longint; var pcb: Longint): DWORD_PTR; stdcall;
  TEditStream = packed record  //David Heffernan suggest this change
    dwCookie: DWORD_PTR;       //David Heffernan suggest this change
    dwError: Longint;
    pfnCallback: TEditStreamCallBack;
  end;

Procedure AppendFromRichEdit(FromRch,ToRch: TAddictSpellRichEdit); // Function to append rich edit text from source to Destination
var
  MyMemStream: TMemoryStream;
   rtfStream: TEditStream;
  function EditStreamReader(
    dwCookie: DWORD_PTR;  //David Heffernan suggested this change
    pBuff: Pointer;
    cb: LongInt;
    pcb: PLongInt): DWORD_PTR; stdcall;  //David Heffernan suggest this change
  begin
    result := $0000;
    try
      pcb^ := TStream(dwCookie).Read(pBuff^, cb) ;
    except
      result := $FFFF;
    end;
  end; (*EditStreamReader*)

begin
   MyMemStream := TMemoryStream.Create;
   FromRch.MaxLength := FromRch.MaxLength + MyMemStream.Size;
   ToRch.MaxLength := ToRch.MaxLength + MyMemStream.Size;
   try
    FromRch.Lines.SaveToStream(MyMemStream);
    MyMemStream.Position := 0;
    rtfStream.dwCookie := DWORD_PTR(MyMemStream) ;
    rtfStream.dwError := $0000;
    rtfStream.pfnCallback := @EditStreamReader;
    Try
      ToRch.Perform(EM_STREAMIN, SFF_SELECTION or SF_RTF,
         LPARAM(@rtfStream)
      ) ;
      if rtfStream.dwError <> $0000 then
        raise Exception.Create('Error Appending RTF Data');
    except
      On E: Exception do
       // do nothing      MsgBox(E.Message)
    end;
   finally
      MyMemStream.Free;
   end;
end;

This works fine in the 32 bit compiled version; without a problem. However, as soon as I compile to 64 bit it gives me an access error. I used the suggested variables that David Heffernan suggested, but still gives me an access error.

I have looked at David Heffernan's code that just copies Text from one RTF control to another:

This works when compiled in the 64 bit compiler, without a hitch.
What am I missing?

After @David Heffernan's comment on the callback and altered code I am still getting the access violation when the code is run in the 64 bit compiled version.

implementation
Type
  TEditStreamCallBack = function (dwCookie: DWORD_PTR; pbBuff: PByte;
    cb: Longint; var pcb: Longint): DWORD; stdcall;
  TEditStream = Packed record
    dwCookie: DWORD_PTR;
    dwError: Longint;
    pfnCallback: TEditStreamCallBack;
  end;

Procedure AppendFromRichEdit(FromRch,ToRch: TAddictSpellRichEdit); // Function to append rich edit text from source to Destination
var
  MyMemStream: TMemoryStream;
   rtfStream: TEditStream;
  function EditStreamReader(
    dwCookie: DWORD_PTR;
    pBuff: Pointer;
    cb: LongInt;
    pcb: PLongInt): DWORD; stdcall;
  begin
    result := $0000;
    try
      pcb^ := TStream(dwCookie).Read(pBuff^, cb) ;
    except
      result := $FFFF;
    end;
  end; (*EditStreamReader*)

begin
   MyMemStream := TMemoryStream.Create;
   FromRch.MaxLength := FromRch.MaxLength + MyMemStream.Size;
   ToRch.MaxLength := ToRch.MaxLength + MyMemStream.Size;
   try
    FromRch.Lines.SaveToStream(MyMemStream);
    MyMemStream.Position := 0;
    rtfStream.dwCookie := DWORD_PTR(MyMemStream) ;
    rtfStream.dwError := $0000;
    rtfStream.pfnCallback := @EditStreamReader;
    Try
      ToRch.Perform(EM_STREAMIN, SFF_SELECTION or SF_RTF,
         LPARAM(@rtfStream)
      ) ;
      if rtfStream.dwError <> $0000 then
        raise Exception.Create('Error Appending RTF Data');
    except
      On E: Exception do
       // do nothing      MsgBox(E.Message)
    end;
   finally
      MyMemStream.Free;
   end;
end;

Any assistance will be grateful.

This is what the issue finally boiled down to: you can't use a "nested" function within the procedure. So the code that works in the 64 bit world:

unit RTFProcs1;
interface
uses
  Windows, classes, comctrls, Messages, RichEdit, vcl.Dialogs, System.SysUtils, ad4Controls, Ad3RicheditDB;


Procedure AppendFromRichEdit(FromRch,ToRch: TAddictSpellRichEdit);

implementation
Type
  TEditStreamCallBack = function (dwCookie: DWORD_PTR; pbBuff: PByte;
    cb: Longint; var pcb: Longint): DWORD; stdcall;
  TEditStream = Packed record
    dwCookie: DWORD_PTR;
    dwError: Longint;
    pfnCallback: TEditStreamCallBack;
  end;

//This function must sit outside of the procedure code
function EditStreamReader(
    dwCookie: DWORD_PTR;
    pBuff: Pointer;
    cb: LongInt;
    pcb: PLongInt): DWORD; stdcall;
  begin
    result := $0000;
    try
      pcb^ := TStream(dwCookie).Read(pBuff^, cb) ;
    except
      result := $FFFF;
    end;
  end; (*EditStreamReader*)

Procedure AppendFromRichEdit(FromRch,ToRch: TAddictSpellRichEdit); // Function to append rich edit text from source to Destination
var
  MyMemStream: TMemoryStream;
   rtfStream: TEditStream;

begin
   MyMemStream := TMemoryStream.Create;
   FromRch.MaxLength := FromRch.MaxLength + MyMemStream.Size;
   ToRch.MaxLength := ToRch.MaxLength + MyMemStream.Size;
   try
    FromRch.Lines.SaveToStream(MyMemStream);
    MyMemStream.Position := 0;
    rtfStream.dwCookie := DWORD_PTR(MyMemStream) ;
    rtfStream.dwError := $0000;
    rtfStream.pfnCallback := @EditStreamReader;
    Try
      ToRch.Perform(EM_STREAMIN, SFF_SELECTION or SF_RTF,
         LPARAM(@rtfStream)
      ) ;
      if rtfStream.dwError <> $0000 then
        raise Exception.Create('Error Appending RTF Data');
    except
      On E: Exception do
       // do nothing      MsgBox(E.Message)
    end;
   finally
      MyMemStream.Free;
   end;
end;

Thanks to @DavidHeffernan for his wisdom!! Very grateful.

Regards TomD

Tom Dalton
  • 21
  • 4
  • That `packed` looks suspicious to me, I wouldn't expect that at all. Also, `dwCookie` in `TEditStreamCallBack` should be `DWORD_PTR`. I'd definitely review the documentation and the header files to make sure the declarations are correct. `TEditStreamCallBack` looks better in the second block of code. But interesting to see packed in that second block. – David Heffernan Jun 20 '22 at 17:33
  • I think that this is correct `TEditStreamCallBack = function(dwCookie: DWORD_PTR; pbBuff: PByte; cb: Longint; var pcb: Longint): DWORD; stdcall;` from reading https://learn.microsoft.com/en-us/windows/win32/api/richedit/nc-richedit-editstreamcallback – David Heffernan Jun 20 '22 at 17:38
  • The C# reference source has `public delegate int EditStreamCallback(IntPtr dwCookie, IntPtr buf, int cb, out int transferred); [StructLayout(LayoutKind.Sequential)] public class EDITSTREAM { public IntPtr dwCookie = IntPtr.Zero; public int dwError = 0; public EditStreamCallback pfnCallback = null; }` which suggests that the record is not packed. – David Heffernan Jun 20 '22 at 17:42
  • The header file `richedit.h` has this at the top `#ifdef _WIN32 #include #elif !defined(RC_INVOKED) #pragma pack(4) #endif` and this suggests the record should have alignment of 4. That would be `{$ALIGN 4}` in Delphi. – David Heffernan Jun 20 '22 at 17:46
  • @DavidHeffernan thanks for your input. In the 64 bit compiled code I am still getting the ACCESS Error. – Tom Dalton Jun 21 '22 at 07:20
  • You haven't said what changes you made – David Heffernan Jun 21 '22 at 07:25
  • Oh wait. You can't use a nested function as a callback. That makes this a dupe. – David Heffernan Jun 21 '22 at 07:26
  • Note that I also enabled typed address operator and then the compiler would reject your code with a type mismatch error. Compilation errors always preferable to runtime errors. – David Heffernan Jun 21 '22 at 07:28
  • 1
    Hi @DavidHeffernan, yes you are quite correct the issue is the nested function within the Procedure! You had commented on this in another post (thanks) and what I did was copied the function out side the procedure and now it work without the access violation. Yay. – Tom Dalton Jun 21 '22 at 08:05

0 Answers0