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
