Avatar billede ruma1974 Nybegynder
01. februar 2004 - 23:27 Der er 1 løsning

Sende en string fra et dll projekt

Hej,

Jeg skal have sendt en string fra et dll projekt. Jeg har forsøgt mig med Borrisholt's fastmemshare. Det virker i første omgang men så får jeg access violation at xxxxx når jeg lukker programmet og grå hår.

unit FastShareMem;

(*
* Shared Memory Allocator for Delphi DLL's
* Version: 1.2
*
* Features:
*  no runtime dll required.
*  no performance degradation.
*
* Usage:
*  Must be the FIRST UNIT listed in the project file's USES section
*  for BOTH DLL AND EXE projects. If you install a memory manager for
*  leak detection, it should be listed immediately after this unit.
*
* Author: Jens Borrisholt
*  Thanx to Jesper Hermansen for the idea !!!
*)

interface

implementation
uses Windows, SysUtils;

const
  SignatureBytes1 = $BABE01234567FEED;
  SignatureBytes2 = $F00D76543210B00B;
  iPagesBound = 15;

type
  TMemMgrPack = record
    RefCount: Integer; //Reference Count of the MemMgr
    Signature1: int64;
    MemMgr: TMemoryManager;
    Signature2: int64;
  end;
  pMemMgrPack = ^TMemMgrPack;

procedure ValidatePack(p: pMemMgrPack);
var
  pid: DWORD;
begin
  // use pid for additional safety;
  p^.RefCount := 1;
  pid := GetCurrentProcessId;
  p^.Signature1 := SignatureBytes1 xor pid;
  p^.Signature2 := SignatureBytes2 xor pid;
end;

function IsPackValid(p: pMemMgrPack): boolean;
var
  pid: DWORD;
begin
  pid := GetCurrentProcessId;
  Result := (p^.Signature1 = SignatureBytes1 xor pid) and  (p^.Signature2 = SignatureBytes2 xor pid);
end;

var
  SYSTEMINFO : TSYSTEMINFO;
  OldMemMgr: TMemoryManager;
  Requested, Allocated: pMemMgrPack;
  iPages: integer;

initialization
  GetSystemInfo(SYSTEMINFO);
  iPages := 0;

  //next, fixed by Aimingoo
  repeat
    Requested := SYSTEMINFO.lpMaximumApplicationAddress;
    Requested := pointer((DWORD(Requested) div $10000) * $10000); // align on start of last full 64k page
    dec(integer(Requested), iPages * $10000);
    Requested := pointer((DWORD(Requested) div SYSTEMINFO.dwPageSize) * SYSTEMINFO.dwPageSize); // align on start of last full 64k page
    Allocated := VirtualAlloc(Requested, SYSTEMINFO.dwPageSize, MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE);

    //find a free memory block or a valid MemMgr
    if (Allocated <> nil) then
      if (Requested = Allocated) then
        Break
      else
    else if IsPackValid(Requested) then
      Break;

    inc(iPages);
  until iPages > iPagesBound;

  if Allocated <> nil then
  begin
    if Requested <> Allocated then
    begin
      MessageBox(0, 'Shared Memory Allocator setup failed: Address was relocated.', 'FastShareMem', 0);
      Halt;
    end;

    GetMemoryManager(Allocated^.MemMgr);
    ValidatePack(Allocated);
  end
  else
  begin
    if not IsPackValid(Requested) then
    begin
      MessageBox(0, 'Shared Memory Allocator setup failed: Address already reserved.', 'FastShareMem', 0);
      Halt;
    end;

    GetMemoryManager(OldMemMgr);
    SetMemoryManager(Requested^.MemMgr);
    inc(Requested^.RefCount);
  end;

finalization
  // fix Reference Count
  dec(Requested^.RefCount);

  // restore MemMgr to Old, only for DLL or other model
  if Allocated = nil then
    SetMemoryManager(OldMemMgr)
  else if Requested^.RefCount > 0 then
    TerminateProcess(GetCurrentProcess, 0);

  (* cleanup *)
  if Requested^.RefCount = 0 then
    VirtualFree(Allocated, 0, MEM_DECOMMIT or MEM_RELEASE)
end.

unit Test;

interface

uses
  Fastsharemem, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, stdCtrls;

type
    Massrecordtype=record
    Mass:real;
    int:real
    end;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

function Sqr(mass:array of massrecordtype):string;far;external 'Dllsqr.dll';
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
massL:array of massrecordtype;
begin
setlength(massL,2);
massL[0].Mass:=234.2;
massL[1].Mass:=234.2;
massL[0].int:=234.2;
massL[1].int:=234.2;
edit1.Text:=(sqr(massL));
end;

end.

library DLLsqr;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }


uses
  Fastsharemem,
  SysUtils,
  Classes;
type
    Massrecordtype=record
    Mass:real;
    int:real
    end;

{$R *.res}
function Sqr(spec:array of massrecordtype):string;export;
var
I:integer;
mass:real;
begin
mass:=0;
for I:=0 to length(spec)-1 do
    begin
    mass:=mass+spec[I].Mass;
    end;
Sqr:=floattostr(mass);
end;
exports
  Sqr;
begin
end.


mvh,

Rune
Avatar billede ruma1974 Nybegynder
02. februar 2004 - 23:46 #1
lukker
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester