Передать процедуры и функции из одной DLL в другую

[Alter]

Есть dll, назовем A, в ней определенные функции и процедуры. Программа, основная, загружает и инициализирует и присваивает к своим переменным то, что есть в dll A. Их будет использовать кроме программы и другие подключаемые к программе dll, как можно это сделать, без вреда программе? И например, при передачи процедур и функций, они есть только внутри самой программы, из программы в DLL, к ним нужна приписка stdcall?

Demo:

unit Dem;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Typess, StdCtrls;

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

var
  Form1: TForm1;
  App :string;
   // OS version
  WinH :THandle;
  WinTyp :TWinTyp;
  WinTypStr :TWinTypStr;
  procedure InitOSDll;
  procedure DeInitOSDll;
   // -

implementation

{$R *.dfm}

procedure InitOSDll;
begin
 @WinTyp := nil;
 @WinTypStr := nil;
 if not FileExists(App + DLLOSver) then Exit;
 WinH := LoadLibrary(DLLOSver);
 If WinH <> 0 then
 begin
   @WinTyp := GetProcAddress(WinH, PrcGetWinTyp);
   if @WinTyp = nil then
   begin
     DeInitOSDll;
     Exit;
   end;
   @WinTypStr := GetProcAddress(WinH, PrcGetWinTypStr);
   if @WinTypStr = nil then
   begin
     DeInitOSDll;
     Exit;
   end;
 end;
end;

procedure DeInitOSDll;
begin
 FreeLibrary(WinH);
 @WinTyp := nil;
 @WinTypStr := nil;
end;  

procedure TForm1.FormCreate(Sender: TObject);
begin
 App := IncludeTrailingBackslash(ExtractFilePath(ParamStr(0)));
 InitOSDll;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 DeInitOSDll;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin // Тест
 if (@WinTyp = nil)or(@WinTypStr = nil) then Exit;
 Button1.Enabled := False;
  try
 Edit1.Text := Format('%d', [Ord(WinTyp)]);
 Edit2.Text := StrPas(WinTypStr);
  finally
 Button1.Enabled := True;
  end;
end;

end.

unit Typess;

interface

const
   // OS
  DLLOSver = 'TestB.dll';
  PrcGetWinTyp = 'GetWinTyp';
  PrcGetWinTypStr = 'GetWinTypStr';
   //

type
   // OS
  TWinVersion = (wvUnknown, wv95,wv98,wvME,wvNT3,wvNT4,wvW2K,wvXP,wv2003,
                 wvVista);
  TWinTyp = function:TWinVersion;
  TWinTypStr = function:PChar;
   //

implementation

end.

[Alter]

Вроде как правильно сделал, AV не вылетало, данные верно давало. Гуру поглядите, на всякий случай, все ли нормально. Может еще кому то пригодится.

[mss]

все ли нормально

Далеко не нормально.
Грубая ошибка налицо:

function GetWinInfo:PChar; stdcall;
var
  s :string;
begin
 S := Format('%s[index:%d] (%s)', [GetWinTypeStr, Ord(GetWinType), BitToStr[Is64BitWin]]);
 Result := PChar(S); // по завершению выполнения ф-ции переменная s перестанет существовать, память выделенная под нее будет автоматически освобождена,  поэтому возвращенный ф-цией указатель будет указывать в никуда.
end;

[Alter]

Сообщение от mss

Далеко не нормально.
Грубая ошибка налицо:

function GetWinInfo:PChar; stdcall;
var
  s :string;
begin
 S := Format('%s[index:%d] (%s)', [GetWinTypeStr, Ord(GetWinType), BitToStr[Is64BitWin]]);
 Result := PChar(S); // по завершению выполнения ф-ции переменная s 
// перестанет существовать, память выделенная под нее будет 
// автоматически освобождена,  поэтому возвращенный ф-цией 
//указатель будет указывать в никуда.
end;

Что можно в этом случае сделать? Как бы вы сделали?

[Stilet]

Как бы вы сделали?

Я бы через GetMem зарезервировал память, в нее напихал бы содержимое этой строки,и уже указатель на эту зарезервированную память возвращал бы.

[mss]

Я бы через GetMem

Нельзя GetMem использовать.
Вызывающий библ.ф-цию код не знает и не обязан знать ничего о конкретном менеджере памяти, выделевшем блок под возвращаемую строку. Т.е. освободить этот блок вызывающий код не сможет при необходимости, а если dll будет выгружена, то и того хуже - код, получивший адрес строкового блока из dll, рискует схлопотать AV.

Идеальное решение - вызывающий код САМ должен выделить блок памяти нужного размера и передать параметром адрес и размер этого блока. Если же параметром передается nil, вызываемая ф-ция возвращает размер блока, необходимого для размещения строки. Именно такое решение фигурирует очень часто во многих WinAPI-вызовах.

[Stilet]

Т.е. освободить этот блок вызывающий код не сможет при необходимости

Значит сама ДЛЛ должна запоминать сколько и чего она запросила, а при выігрузке очищать мусор. Хотя конечно насчет

вызывающий код САМ должен выделить блок памяти

я согласен - надежнее, но мало ли,вдруг старина Альтер пишет плагин для использования в других разработках, и не хочет перекладывать на плечи народа заботу о распределении памяти

[Alter]

Вариант 2

function GetWinInfo:PChar; stdcall;
var
  s :string;
begin
 S := Format('%s[index:%d] (%s)', [GetWinTypeStr, Ord(GetWinType), BitToStr[Is64BitWin]]) + #0;
// Result := PChar(S);
 Result := StrPCopy(@S[1], S);
end;

Как этот?
mss, так и не увидел от вас конкретного примера, только вокруг, да около.

[mss]

Как этот?

Хрен редьки не слаще.
Ты хоть задумался что происходит при StrPCopy ?

не увидел от вас конкретного примера, только вокруг, да около

Я обязан "конкретнопримерить" ?)
Может в самую пору на время бросить слепые писательские потуги и углубиться в штудирование справочников и документации по этой теме ?

Alter
Профессионал

Уж не знаю где ты там "профессионал", но эта ошибка весьма характерна для дилетанта.

function GetWinInfo(Str: PAnsiChar): Integer; stdcall;
var
  s : AnsiString;
begin 
  s := Format('%s[index:%d] (%s)', [GetWinTypeStr, Ord(GetWinType), BitToStr[Is64BitWin]]);
 Result := Length(s) + 1; 
 if Assigned(Str) then
   CopyMemory(Str, PAnsiChar(s)^, Result);
end;

[Пепел Феникса]

Уж не знаю где ты там "профессионал", но эта ошибка весьма характерна для дилетанта.

mss, считал вас умнее, и думал что знаете что это выдается форумом автоматически, а не человек пишет сам себе.

Alter, держи один из вариантов:

function GetMemory(Size:Integer):pointer;
begin
 GetMem(Result,Size);
end;

procedure FreeMemory(Ptr:Pointer);
begin
 FreeMem(Ptr);
end;

function GetStr(s:string):PChar;
begin
 Result:=GetMem((Length(s)+1)*SizeOf(Char));
 Result[Length(s)]:=#0;
 CopyMemory(Result,@s[1],Length(s)*SizeOf(Char));
end;

function GetWinInfo:PChar; stdcall;
var
  s :string;
begin
 S := Format('%s[index:%d] (%s)', [GetWinTypeStr, Ord(GetWinType), BitToStr[Is64BitWin]]);
 Result := GetStr(s);
end;

потом просто надо будет вызвать FreeMemory из основного модуля приложения, чтоб освободить память.(не забудьте к ним stdcall и экспортировать)

function GetWinInfo(Str: PAnsiChar): Integer; stdcall;
var
  s : AnsiString;
begin 
  s := Format('%s[index:%d] (%s)', [GetWinTypeStr, Ord(GetWinType), BitToStr[Is64BitWin]]);
 Result := Length(s) + 1; 
 if Assigned(Str) then
   CopyMemory(Str, PAnsiChar(s)^, Result);
end;

какую бомбу то заложили...тут надо было б тогда сказать, что строго сначало вызывать для определения нужного количества памяти, а потом уже для дела с этой самой памятью.