Все знают, что в fpc можно динамически импортировать функции из библиотек. Но мало кто может сделать это реально динамически в run-time, т.е. во время выполнения, как это делают некоторые скриптовые языки. Для языка си есть библиотека ffi, которая позволяет такое реализовать, для паскаля же даже примеров нет как это реализовать.
Методом проб и ошибок, подглядываний у си и т.д., получились вот такие классы - TDynCall и TDynRecord, которые поддерживают 2 вида вызова - cdecl и stdcall. Если кто сделает fastcall буду рад (мне лень, и он не стандартизирован).
Возможности модуля:
- Импорт функций во время выполнения, в том числе и из dll, so и т.д.
- Поддержка таких типов как integer, byte, char, boolean, pansichar, pwidechar, pointer, double, single, word, shortint
- Возможность передавать out, var параметры в функцию
- TDynRecord - класс для эмуляции рекорда во время выполнение с выравниванием в 4 байта (это важный параметр), он поддерживает также все описанные типы
- Возвращение результата, кроме рекорда поддерживает все типы (в том числе и double)
- Совместим с fpc и delphi, тестил пока только под windows x86 (для 64бит скорее надо что-то переделывать).
* Последние версии fpc не требуют у меня вставки {$ASMMODE INTEL}, может быть это ставится в настройках.
Класс TDynCall.
- Код: Выделить всё
type
TDynCall = class(TObject)
protected
FuncPtr: Pointer;
StackSize: Longint;
ParamCount: Integer;
Blocks: Array[0..100] of PushParam;
function Resize(const IncSize: Integer): Pointer; inline;
public
Return: ReturnParam;
Method: TCallMethod;
ReturnType: TCallVarType;
procedure Clear;
procedure PushLongInt(const I: Longint);
procedure PushPtr(const P: Pointer);
procedure PushWord(const W: Word);
procedure PushDouble(const D: Double);
procedure PushSingle(const S: Single);
procedure PushByte(const B: Byte);
procedure PushBool(const B: Boolean);
procedure PushChar(const C: AnsiChar);
procedure PushVar(var X);
procedure PushPAnsiChar(const PA: PAnsiChar);
procedure PushPWideChar(const PW: PWideChar);
procedure PushRecord(const Rec: TDynRecord);
procedure SetFunc(aFunc: Pointer);
procedure Call;
constructor Create;
destructor Destroy; override;
end;
Методы и свойства
- Method: TCallMethod - способ вызова cdecl или stdcall (по-умолчанию установлен в cdecl).
- ReturnType - тип возвращаемого значения, если ничего не возвращает устанавливаем в cvtVoid.
- Return - собственно сам результат функции записывается в этот рекорд.
- SetFunc(aFunc: Pointer) - устанавливаем ссылку на функцию
- Push* - запись параметров функции на стек
- Clear - очистка параметров в стеке
- Call - вызов функции
Класс TDynRecord.
Класс эмулирует record запись, в си это struct. Важно, не используете packed records - он их не поддерживает, только рекорды с выравниванием в 4 байта.
- Код: Выделить всё
TDynRecord = class(TObject)
protected
Align: Integer;
procedure WriteItem;
procedure WriteConst(const V; const Size: Integer);
public
Seek: Integer;
Size: Integer;
Data: PByteArray;
procedure WriteInt(const I: Longint);
procedure WriteDouble(const D: Double);
procedure WriteSingle(const S: Single);
procedure WriteByte(const B: Byte);
procedure WriteChar(const C: AnsiChar);
procedure WriteBool(const B: Boolean);
procedure WriteWord(const W: Word);
procedure WritePtr(const P: Pointer);
procedure WritePAChar(const P: PAnsiChar);
procedure WritePWChar(const P: PWideChar);
procedure Clear;
constructor Create(aAling: Integer = PtrSize); overload;
constructor Create(Vals: array of TVarRec; aAling: Integer = PtrSize); overload;
destructor Destroy; override;
end;
Тут все просто, пишем значения в порядке объявления переменных в рекорде, только учитывая тип!
Примеры использования:
1. Рекорды в параметрах
- Код: Выделить всё
type
PMy = ^TMy;
TMy = record
x,y: integer;
w: double;
end;
function test(const R: TMy): integer; cdecl;
begin
Result := Trunc( R.x + R.y + R.w );
end;
procedure TfmMain.BitBtn1Click(Sender: TObject);
var
C: TDynCall;
R: TDynRecord;
begin
R := TDynRecord.Create();
R.WriteInt(20); // .x = 20
R.WriteInt(40); // .y = 40
R.WriteDouble(50.55); // .w = 50.55
// R := TDynRecord.Create([20,40,50.55]); // или так
C := TDynCall.Create;
C.Method := cmCdecl; // cdecl вызов
C.ReturnType := cvtInteger; // функция возвращает Longint
C.SetFunc(@test); // задаем вызываемую функцию
C.PushRecord(R); // помещаем рекорд в стек
C.Call; // вызываем
ShowMessage(IntToStr(C.Return.lval));
C.Free;
R.Free;
end;
Тут даже не важно, вы можете также передавать PMy, т.е. ссылочный тип, в этом случае код останется тот же.
2. Var параметр у функции
- Код: Выделить всё
procedure test2(var x: integer); stdcall;
begin
X := X + 7520;
end;
procedure TfmMain.BitBtn1Click(Sender: TObject);
var
C: TDynCall;
my: integer;
begin
my := 30;
C := TDynCall.Create;
C.Method := cmStdcall; // stdcall вызов
C.ReturnType := cvtVoid; // функция ничего не возвращает
C.SetFunc(@test2); // задаем вызываемую функцию
C.PushVar(my); // помещаем переменную в стек
C.Call; // вызываем
ShowMessage(IntToStr(my)); // выведет 7550, my := 30 + 7520
C.Free;
end;
Грубо говоря переменная передается как Pointer.
Где скачать класс: Тут http://code.google.com/p/orionphp/source/browse/trunk/libs/ori_DynCall.pas
Он не имеет никаких зависимостей.
P.S. Модификатор const никак не влияет на функциональность класса.
