Импорт из С dll на Дельфи

[netrino]

Ну, если я понял верно, то С-шная ф-ция принимает ссылку на существующую структуру и заполняет её. То есть

function qbox_GetLocation(var qb_loc: QBoxLocBtn): Integer; cdecl; external QBoxDLLFile;

А в вызывающей программе:

procedure ...
var
   QB : QBoxLocBtn;
begin
...
qbox_GetLocation(QB);
...
QB.name...

Саму структуру изменить на:

  QBoxLocBtn = record // packed здесь не надо
    id        : Integer;
    bcnt      : Integer;
    flag      : Integer;
    tag       : Integer;
		  				     
    define    : array [ 0 .. DEFINE_SIZE ] of Char; // массив
    name     : array [ 0 .. NAME_SIZE ] of Char;   // Название локации (кнопки)
    script     : array [ 0 .. SCRIPT_SIZE ] of Char;   // Скрипт локации (кнопки)
end;

Может я где-то ошибся, пусть меня поправят те, кто использует Delphi =)
И кстати, что значит макрос QBOX_API? Скорее всего в нём указан тип вызова, так что стоит к нему присмотреться )

[apromix]

Попробовал так сделать - не работает. Выбивает ошибку. Видимо нужно через указатели.

[netrino]

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

Попробовал так сделать - не работает. Выбивает ошибку. Видимо нужно через указатели.

Нет не нужно. Какую ошибку выбивает? Очевидно, что ф-ция ожидает ссылку на структуру. Она не будет создавать новую структуру и возвращать её, она намеревается заполнять ту, которую ей передают.

Для проверки написал такое(C++):

#include <Windows.h>

struct TESTSTRUCT {
	int N;
	int Id;
	char name[30];
};

extern "C" __declspec(dllexport) int Fn(TESTSTRUCT& ts)
{
	ts.N  = 100;
	ts.Id = 200;
	lstrcpy(ts.name, "Hello, World!");

	return 0;
}

int __stdcall DllMain(HMODULE, DWORD, void*)
{
	return true;
}

(FPC в режиме совместимости с Delphi):

program Import;

type
   TESTSTRUCT = record
      N, Id : Integer;
      name  : array [0 .. 30] of char;
   end;

var
   Ts : TESTSTRUCT;

function Fn(var ts : TESTSTRUCT) : Integer; cdecl; external 'Test.dll';

begin
   Fn(Ts);
   WriteLn('N = ', Ts.N);
   WriteLn('Id = ', Ts.Id);
   WriteLn('name = ', String(Ts.name));

   ReadLn;

end.

Всё отработало как положено.

...

Кстати, ещё вопрос, в C++-ом исходнике у экспорта функции стоит extern "C"? Как вообще выглядит имя функции в таблице экспорта dll?

[apromix]

Ну вот как я изменил:

unit untQBoxImportFromDLL;

interface

const
  NAME_SIZE     = 128;			// Ограничение на размер имён
  DEFINE_SIZE   = 2048;		// Ограничение на размер описаний
  SCRIPT_SIZE   = 4096;		// Ограничение на размер скриптов

type
//  PQBoxLocBtn = ^QBoxLocBtn;
  QBoxLocBtn = {packed} record
    id        : Integer; // ID кнопки для GetButton(), локации для GetLocation()
    bcnt      : Integer; // GetLocation() возвращает кол-во кнопок для данной локации;
    flag      : Integer; // GetButton() возвращает flag (if flag==1, then button - visible)
    tag       : Integer; // AddLocation(), AddButton():
		  				           //	if tag == 1 then <есть скрипт>
                         //	if tag == 0 then <нет скрипта>
    define    : array [ 0 .. DEFINE_SIZE ] of Char; // массив
    name      : array [ 0 .. NAME_SIZE ]   of Char; // Название локации (кнопки)
    script    : array [ 0 .. SCRIPT_SIZE ] of Char; // Скрипт локации (кнопки)

{
    define    : PChar;   // Описание локации(кнопки)
    name      : PChar;   // Название локации (кнопки)
    script    : PChar;   // Скрипт локации (кнопки)
}
  end;

const QBoxDLLFile = 'QBox.dll';

function qbox_Init: Integer; stdcall; external QBoxDLLFile;
procedure qbox_Quit; stdcall; external QBoxDLLFile;

function qbox_LoadQuest(const fname: PChar): Integer; stdcall; external QBoxDLLFile;

//-------------- Функции управления содержанием -------------------
function qbox_GetLocation(var qb_loc: {P}QBoxLocBtn): Integer; cdecl; external QBoxDLLFile;
function qbox_GetLocCnt: Integer; stdcall; external QBoxDLLFile;


function qbox_GetButCnt(lid: Integer): Integer; stdcall; external QBoxDLLFile;

function qbox_GetVersion: PChar; stdcall; external QBoxDLLFile;
function qbox_GetAuthors: PChar; stdcall; external QBoxDLLFile;

implementation

end.

В проге:

procedure TfrmQBoxMain.Init1Click(Sender: TObject);
var
//  QA: PQBoxLocBtn;
  QA: QBoxLocBtn;
begin
  qbox_Init;
  qbox_LoadQuest(PChar('Island.qbf'));
//  New(QA);
//  QA^.name := PChar('SERG');
//  ShowMessage('GetLocation: ' + IntToStr(qbox_GetLocation(QA)));
//  ShowMessage(StrPas(QA^.name));
  qbox_GetLocation(QA);
  ShowMessage(StrPas(QA.define));
//  Dispose(QA);
end;

Выдает ошибку после завершения программы: ...access violation...

Прикрепил либу, на всякий случай, с пояснениями и заг. файлом .h
Что я не так делаю?

[netrino]

Вот так должно быть правильно:

const
   NAME_SIZE   = 127;
   DEFINE_SIZE = 2047;
   SCRIPT_SIZE = 4095;

type
   QBoxLocBtn = record
      id, bcnt  : Integer;
      flag, tag : Integer;
      define    : Array [ 0 .. DEFINE_SIZE ] of Char;
      name      : Array [ 0 .. NAME_SIZE   ] of Char;
      script    : Array [ 0 .. SCRIPT_SIZE ] of Char;
   end;

function qbox_GetLocation(var QBoxLocBtn) : Integer; cdecl; external 'QBox.dll';

во всяком случае у меня ничего не вылетело и создался файл QBox_dll.log, и уж точно не моей программой

[JTG]

А вызывать - qbox_GetLocation(@QA);

[netrino]

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

А вызывать - qbox_GetLocation(@QA);

Нет, вызывать qbox_GetLocation(QA);
Там же var стоит

[apromix]

Пробовал и так, и сяк. Все вроде должно работать, но при завершении вызывает (как и вызывало раньше ) ошибку. И это главная проблема. И вот еще что: один раз показывает текст нормально, другой раз - короткий набор из нескольких символов (видно не попал указатель в нужное место, так кажется ). Испытал в Д-3, Д-7SE и Д-10 - везде одинаковая проблема (думал, в версию Дельфи закралась ошибка, потому так и происходит).

Вот весь исходник прикреплен, может опять что-то накосолапил?

[JTG]

function qbox_GetLocation(var qb_loc: QBoxLocBtn) : Integer; stdcall; external QBoxDLLFile;
и ZeroMemory(@QA, sizeOf(QA)); перед qbox_Init;





Вообще, в лучших традициях сишного кода, нужно так

Type
   PQBoxLocBtn = ^TQBoxLocBtn;
   TQBoxLocBtn   = record
      id, bcnt  : Integer;
      flag, tag : Integer;
      define    : Array [ 0 .. DEFINE_SIZE ] of Char;
      name      : Array [ 0 .. NAME_SIZE   ] of Char;
      script    : Array [ 0 .. SCRIPT_SIZE ] of Char;
   end;

function qbox_GetLocation(qb_loc: PQBoxLocBtn) : Integer; stdcall; external QBoxDLLFile;

procedure TfrmQBoxMain.Init1Click(Sender: TObject);
var
  QA: PQBoxLocBtn;
begin
  New(QA);
  ZeroMemory(QA, sizeOf(TQBoxLocBtn));
  qbox_Init;
  qbox_LoadQuest(PChar('Island.qbf'));
  qbox_GetLocation(QA);
  ShowMessage(QA.define);
  qbox_Quit;
  Dispose(QA);
end;

но если с указателями не хочется возится, то, наверное, можно и переменную передавать

[apromix]

Да, все работает значительно лучше и понятнее Это меня радует. Огромное спасибо Пепел Феникса, JTG и netrino! Вы очень помогли разобраться. Но почему программа сама завершает работу, слетает? В среде еще показывает ошибку ...system exception... Без Дельфи просто завершает работу. Беру в скобки try, но ничего не помогает.

Дело в том, что если я пишу так:

//  ShowMessage(QA.define);
  RE.Text := QA.define; // RE - это RichEdit

то программа моментально завершает работу. Текст даже не увидеть. Как с этой проблемой справиться?