C Dll indeki Callback Nasıl Çevrilir? (Çözüldü)

[erkankurtaga]

typedef void (*onDeviceStatusChangedCallback) (terminal_status param);
DLL_EXPORT int AR_set_device_status_changed_cb(const char *terminal_no, onDeviceStatusChangedCallback cb);

Yukarıdaki kod bir C dll inin header dosyasından. Ben de bu kodları Delphi ye aşağıdaki gibi çevirdim.

TonDeviceStatusChangedCallback = procedure(param:TTerminalStatus) of object;

function AR_set_device_status_changed_cb(HInst:THandle; const TerminalNo: pAnsiChar; onDeviceStatusChangedCallback:TonDeviceStatusChangedCallback): LongInt;
var
 MyFunct: function (const TerminalNo: pAnsiChar; onDeviceStatusChangedCallback:TonDeviceStatusChangedCallback): LongInt; cdecl;
begin
 Result := 0;

 MyFunct:=GetProcAddress(HInst,'AR_set_device_status_changed_cb');
 if Assigned(MyFunct) then
   Result := MyFunct(TerminalNo,onDeviceStatusChangedCallback);
end;

Aynı soruyu stackowerflow a da sordum : How to convert c/c++ callback functon to delphi
Stackowerflow da cevap var. Yalnız oradakileri de uyguladım. Ama accesslerden yine kurtulamadım. Bir çıkış yolu arıyorum. yardım eder misiniz?
Yukarıdaki c örneği için örnek kullanım:

void status_cb (terminal_status param)
{
   fprintf(stderr, "Terminal No: %s\n", param.terminal_no);
   fprintf(stderr, "Device Status: %d\n", param.status);

   if (param.status == DEVICE_STATUS_DISCONNECTED) {
       fprintf(stderr, "Cihaz Cradle Üzerinden Kaldırıldı\n");
   }
   else if (param.status == DEVICE_STATUS_PAIRED) {
       fprintf(stderr, "Cihaz Cradle Üzerine Konuldu\n");
   }
}

int main (int argc, char *argv[])
{
   int rc;

   if (parse_test_cmdline_and_start(argc, argv, TEST_INFO) < 0) {
       return 1;
   }

   onDeviceStatusChangedCallback cb = &status_cb;
   rc = AR_set_device_status_changed_cb (options.serial, cb);
   if (rc != AR_SUCCESS) {
       fprintf(stderr, "Error: %d => %s\n", rc, AR_strerror(rc));
   }
   sleep(60);

   return 0;
}

[Tuğrul HELVACI]

(14-12-2017, Saat: 14:20)erkankurtaga Adlı Kullanıcıdan Alıntı:

typedef void (*onDeviceStatusChangedCallback) (terminal_status param);


DLL_EXPORT int AR_set_device_status_changed_cb(const char *terminal_no, onDeviceStatusChangedCallback cb);

Yukarıdaki kod bir C dll inin header dosyasından. Ben de bu kodları Delphi ye aşağıdaki gibi çevirdim.

TonDeviceStatusChangedCallback = procedure(param:TTerminalStatus) of object;

function AR_set_device_status_changed_cb(HInst:THandle; const TerminalNoAnsiChar; onDeviceStatusChangedCallback:TonDeviceStatusChangedCallback): LongInt;
var
 MyFunct: function (const TerminalNoAnsiChar; onDeviceStatusChangedCallback:TonDeviceStatusChangedCallback): LongInt; cdecl;
begin
 Result := 0;

 MyFunct:=GetProcAddress(HInst,'AR_set_device_status_changed_cb');
 if Assigned(MyFunct) then
   Result := MyFunct(TerminalNo,onDeviceStatusChangedCallback);
end;

Aynı soruyu stackowerflow a da sordum : How to convert c/c++ callback functon to delphi
Stackowerflow da cevap var. Yalnız oradakileri de uyguladım. Ama accesslerden yine kurtulamadım. Bir çıkış yolu arıyorum. yardım eder misiniz?
Yukarıdaki c örneği için örnek kullanım:

void status_cb (terminal_status param)
{
   fprintf(stderr, "Terminal No: %s\n", param.terminal_no);
   fprintf(stderr, "Device Status: %d\n", param.status);

   if (param.status == DEVICE_STATUS_DISCONNECTED) {
       fprintf(stderr, "Cihaz Cradle Üzerinden Kaldırıldı\n");
   }
   else if (param.status == DEVICE_STATUS_PAIRED) {
       fprintf(stderr, "Cihaz Cradle Üzerine Konuldu\n");
   }
}

int main (int argc, char *argv[])
{
   int rc;

   if (parse_test_cmdline_and_start(argc, argv, TEST_INFO) < 0) {
       return 1;
   }

   onDeviceStatusChangedCallback cb = &status_cb;
   rc = AR_set_device_status_changed_cb (options.serial, cb);
   if (rc != AR_SUCCESS) {
       fprintf(stderr, "Error: %d => %s\n", rc, AR_strerror(rc));
   }
   sleep(60);

   return 0;
}

Size, uygun tanımları vermişler. Nerede sorun yaşıyorsunuz anlamadım ?

[erkankurtaga]

(14-12-2017, Saat: 14:30)Tuğrul HELVACI Adlı Kullanıcıdan Alıntı:

(14-12-2017, Saat: 14:20)erkankurtaga Adlı Kullanıcıdan Alıntı:

typedef void (*onDeviceStatusChangedCallback) (terminal_status param);


DLL_EXPORT int AR_set_device_status_changed_cb(const char *terminal_no, onDeviceStatusChangedCallback cb);

Yukarıdaki kod bir C dll inin header dosyasından. Ben de bu kodları Delphi ye aşağıdaki gibi çevirdim.

TonDeviceStatusChangedCallback = procedure(param:TTerminalStatus) of object;

function AR_set_device_status_changed_cb(HInst:THandle; const TerminalNoAnsiChar; onDeviceStatusChangedCallback:TonDeviceStatusChangedCallback): LongInt;
var
 MyFunct: function (const TerminalNoAnsiChar; onDeviceStatusChangedCallback:TonDeviceStatusChangedCallback): LongInt; cdecl;
begin
 Result := 0;

 MyFunct:=GetProcAddress(HInst,'AR_set_device_status_changed_cb');
 if Assigned(MyFunct) then
   Result := MyFunct(TerminalNo,onDeviceStatusChangedCallback);
end;

Aynı soruyu stackowerflow a da sordum : How to convert c/c++ callback functon to delphi
Stackowerflow da cevap var. Yalnız oradakileri de uyguladım. Ama accesslerden yine kurtulamadım. Bir çıkış yolu arıyorum. yardım eder misiniz?
Yukarıdaki c örneği için örnek kullanım:

void status_cb (terminal_status param)
{
   fprintf(stderr, "Terminal No: %s\n", param.terminal_no);
   fprintf(stderr, "Device Status: %d\n", param.status);

   if (param.status == DEVICE_STATUS_DISCONNECTED) {
       fprintf(stderr, "Cihaz Cradle Üzerinden Kaldırıldı\n");
   }
   else if (param.status == DEVICE_STATUS_PAIRED) {
       fprintf(stderr, "Cihaz Cradle Üzerine Konuldu\n");
   }
}

int main (int argc, char *argv[])
{
   int rc;

   if (parse_test_cmdline_and_start(argc, argv, TEST_INFO) < 0) {
       return 1;
   }

   onDeviceStatusChangedCallback cb = &status_cb;
   rc = AR_set_device_status_changed_cb (options.serial, cb);
   if (rc != AR_SUCCESS) {
       fprintf(stderr, "Error: %d => %s\n", rc, AR_strerror(rc));
   }
   sleep(60);

   return 0;
}

Size, uygun tanımları vermişler. Nerede sorun yaşıyorsunuz anlamadım ?

Orada anlatılanların hepsini denedim. özellikle ikinci yöntemi daha çok denedim.

type
  TPaymentResultEvent = procedure(AResult: Integer) of object;

var
 gOnPaymentResult: TPaymentResultEvent;

procedure myPaymentResultCallback(AResult: Integer); cdecl;
begin
 if Assigned(gOnPaymentResult) then
   gOnPaymentResult(AResult);
end;

function ARPaymentItemCredit(HInst: THandle; const TerminalNo: PAnsiChar;
 const Description: PAnsiChar; Amount: Double; CurrencyID: Integer;
 ReceiptID: Integer; onPaymentResult: TPaymentResultEvent): Integer;
type
 TPaymentResultCallback = procedure(AResult: Integer); cdecl;
var
 MyFunct: function(const TerminalNo: PAnsiChar; const Description: PAnsiChar;
   Amount: Double; CurrencyID: Integer; ReceiptID: Integer;
   onPaymentResult: TPaymentResultCallback): Integer; cdecl;
begin
 @MyFunct := GetProcAddress(HInst, 'AR_payment_item_credit');
 if Assigned(MyFunct) then
 begin
   gOnPaymentResult := onPaymentResult;
   Result := MyFunct(TerminalNo, Description, Amount, CurrencyID, ReceiptID, @myPaymentResultCallback)
 end
 else
   Result := 0;
end;

Yalnız "myPaymentResultCallback" fonksiyonuna gelince fonksiyonu çalıştırmadan daha "begin" de access uyarısı veriyor.
İlk yöntemi de deneyince callback fonksiyonunu parametre olarak gönderince fonksiyon parametresi istiyor. İşin içinden çıkamadım açıkçası.

[Tuğrul HELVACI]

Çok basitçe ve sadece; C/C++ header'ından size lazım olan metodların isimlerini ve tanımlarını buraya atarsanız çok daha kolay olacak. Fazlası ile karışık yazıyorsunuz. Access hatasından kastınız da Access Violation sanırım. Herneyse, gereken tanımları buraya yazarsanız ondan sonra bakalım. (Gördüğüm kadarı ile iki ayrı metod kullanıyorsunuz)

[erkankurtaga]

(14-12-2017, Saat: 15:10)Tuğrul HELVACI Adlı Kullanıcıdan Alıntı: Çok basitçe ve sadece; C/C++ header'ından size lazım olan metodların isimlerini ve tanımlarını buraya atarsanız çok daha kolay olacak. Fazlası ile karışık yazıyorsunuz. Access hatasından kastınız da Access Violation sanırım. Herneyse, gereken tanımları buraya yazarsanız ondan sonra bakalım. (Gördüğüm kadarı ile iki ayrı metod kullanıyorsunuz)

Haklısınız iki ayrı metod. Buraya farklı oraya farklı methodlar attım. Bir tanesini çözebilirsek bu konuyu da öğrenmiş olacağım. Karışık olduğu için özür dilerim. Düzeltmek gerekirse eğer;

/*Callback tanımı*/
typedef void (*onDeviceStatusChangedCallback) (terminal_status param);

/*DLL fonksiyonu*/
DLL_EXPORT int AR_set_device_status_changed_cb(const char *terminal_no, onDeviceStatusChangedCallback cb);

Örnek Kullanım:

void status_cb (terminal_status param)
{
    fprintf(stderr, "Terminal No: %s\n", param.terminal_no);
    fprintf(stderr, "Device Status: %d\n", param.status);

    if (param.status == DEVICE_STATUS_DISCONNECTED) {
        fprintf(stderr, "Cihaz Cradle Üzerinden Kaldırıldı\n");
    }
    else if (param.status == DEVICE_STATUS_PAIRED) {
        fprintf(stderr, "Cihaz Cradle Üzerine Konuldu\n");
    }
}

int main (int argc, char *argv[])
{
    int rc;

    if (parse_test_cmdline_and_start(argc, argv, TEST_INFO) < 0) {
        return 1;
    }

    onDeviceStatusChangedCallback cb = &status_cb;
    rc = AR_set_device_status_changed_cb (options.serial, cb);
    if (rc != AR_SUCCESS) {
        fprintf(stderr, "Error: %d => %s\n", rc, AR_strerror(rc));
    }
    sleep(60);

    return 0;
}

Yukarıdaki c dll fonksiyon tanımlarına göre yaptıklarım;

{DLL Wrapper}


type
    TDeviceStatusChangedEvent = procedure(param:TTerminalStatus) of object;

var
    EDeviceStatusChangedEvent:TDeviceStatusChangedEvent;

procedure RunDeviceStatusChangedCB(param:TTerminalStatus);

function AR_set_device_status_changed_cb(HInst:THandle; const TerminalNoAnsiChar;
  onDeviceStatusChangedCallback:TDeviceStatusChangedEvent): LongInt;

implementation

procedure RunDeviceStatusChangedCB(param:TTerminalStatus);
begin
    if not Assigned(EDeviceStatusChangedEvent) then
    EDeviceStatusChangedEvent(param);
end;

function AR_set_device_status_changed_cb(HInst:THandle; const TerminalNoAnsiChar;
  onDeviceStatusChangedCallback:TDeviceStatusChangedEvent): LongInt;
type
    TDeviceStatusChangedCallBack = procedure(param:TTerminalStatus);cdecl;
var
    MyFunct: function (const TerminalNoAnsiChar; onDeviceStatusChangedCallback:TDeviceStatusChangedCallBack): LongInt; cdecl;
begin
    Result := 0;
 
    @MyFunct:=GetProcAddress(HInst,'AR_set_device_status_changed_cb');
    if Assigned(MyFunct) then 
    begin
       EDeviceStatusChanged := onDeviceStatusChangedCallback;
       Result := MyFunct(TerminalNo,@RunDeviceStatusChangedCB);
    end;
end;


{DLL Wrapper son}

/*Kullanım örneği*/

procedure TForm2.DeviceStatusChanged(param:TTerminalStatus);
begin
  DeviceWait:=False;

  case param.DeviceStatus of
     DEVICE_STATUS_DISCONNECTED:begin
                                  DeviceOK:=False;
                                  AddMemo('Cihaz Cradle Üzerinden Kaldırıldı',True);
                                end;
        DEVICE_STATUS_CONNECTED,
           DEVICE_STATUS_PAIRED:begin
                                  DeviceOK:=True;
                                  AddMemo('Cihaz Bağlı');
                                end;
              DEVICE_STATUS_ALL,
          DEVICE_STATUS_UNKNOWN,
    DEVICE_STATUS_NOTREGISTERED:begin
                                  DeviceOK:=False;
                                  AddMemo('Cihaz Bağlı Değil',True);
                                end;
  end;
end;

procedure TForm2.RegisterDeviceStatusCallBack;
begin
  try
    SetCihazBilgi;
    rc := AR_set_device_status_changed_cb (DllHInst,SP(dtermno),DeviceStatusChanged);
    DeviceWait := rc = AR_SUCCESS;
  except
    DeviceWait := False;
  end;

  while DeviceWait and (DeviceOK=false) do Delay(100);
end;

Acess Violation Hatasına düşen Kısım RunDeviceStatusChangedCB fonksiyonu. Fonksiyon çalışmadan "Access Violation"  hatası veriyor.

[Tuğrul HELVACI]

Aşağı yukarı aşağıdaki gibi bir yol izlemeniz gerekiyor:

type
  Terminal_Status = Integer; // ??? Bunun ne olduğunu bilmiyoruz, bizimle paylaşmamışsınız.

 TDeviceStatusChangedCallback = procedure(AParam : Terminal_Status); cdecl;
 TARSetDeviceStatusChangedCbFunc = function (terminal_no : PAnsiChar; ACallback : TDeviceStatusChangedCallback) : Integer; cdecl;

implementation

procedure MyCallBack(AParam : Terminal_Status);
begin
 // Burada sizin callback kodlarınız çalışacak..
end;

procedure Load;
var
 ARSetDeviceStatusChangedCbFunc : TARSetDeviceStatusChangedCbFunc;
 ALibHandle : THandle;
begin
 ALibHandle := LoadLibrary('?????.dll');

 @ARSetDeviceStatusChangedCbFunc := GetProcAddress(ALibHandle, 'AR_set_device_status_changed_cb');

 if @ARSetDeviceStatusChangedCbFunc <> nil then
 begin
   ARSetDeviceStatusChangedCbFunc(PAnsiChar('Birşey'), @MyCallBack);
 end;
end;

[erkankurtaga]

(14-12-2017, Saat: 16:03)Tuğrul HELVACI Adlı Kullanıcıdan Alıntı: Aşağı yukarı aşağıdaki gibi bir yol izlemeniz gerekiyor:

type
  Terminal_Status = Integer; // ??? Bunun ne olduğunu bilmiyoruz, bizimle paylaşmamışsınız.

 TDeviceStatusChangedCallback = procedure(AParam : Terminal_Status); cdecl;
 TARSetDeviceStatusChangedCbFunc = function (terminal_no : PAnsiChar; ACallback : TDeviceStatusChangedCallback) : Integer; cdecl;

implementation

procedure MyCallBack(AParam : Terminal_Status);
begin
 // Burada sizin callback kodlarınız çalışacak..
end;

procedure Load;
var
 ARSetDeviceStatusChangedCbFunc : TARSetDeviceStatusChangedCbFunc;
 ALibHandle : THandle;
begin
 ALibHandle := LoadLibrary('?????.dll');

 @ARSetDeviceStatusChangedCbFunc := GetProcAddress(ALibHandle, 'AR_set_device_status_changed_cb');

 if @ARSetDeviceStatusChangedCbFunc <> nil then
 begin
   ARSetDeviceStatusChangedCbFunc(PAnsiChar('Birşey'), @MyCallBack);
 end;
end;

Teşekkür ederim. Bahsettiğiniz şekilde de denedim.Derleyici MyCallBack için "Variable required" hatası döndürüyor.

[erkankurtaga]

@Tuğrul HELVACI Hocam çok ilginiz için teşekkürler. Bu sorunun cevabı dediğiniz gibi stackoverflow da ilgili konuda verilmişti. Ben dikkatsizlik sonucu çözümü göremedim. Boş yere vaktinizi aldım. Hakkınızı helal edin. Sorunum şuymuş.

procedure RunDeviceStatusChangedCB(param:TTerminalStatus);

 fonksiyonu

RunDeviceStatusChangedCB(param:TTerminalStatus);cdecl;

 
olması gerekiyormuş. Biraz geç oldu ama yoğunluktan yazamadım. Bu sorunun cevabı burda :  How to convert c/c++ callback functon to delphi

[Tuğrul HELVACI]

(20-12-2017, Saat: 13:29)erkankurtaga Adlı Kullanıcıdan Alıntı: @Tuğrul HELVACI Hocam çok ilginiz için teşekkürler. Bu sorunun cevabı dediğiniz gibi stackoverflow da ilgili konuda verilmişti. Ben dikkatsizlik sonucu çözümü göremedim. Boş yere vaktinizi aldım. Hakkınızı helal edin. Sorunum şuymuş.

procedure RunDeviceStatusChangedCB(param:TTerminalStatus);

 fonksiyonu

RunDeviceStatusChangedCB(param:TTerminalStatus);cdecl;

 
olması gerekiyormuş. Biraz geç oldu ama yoğunluktan yazamadım. Bu sorunun cevabı burda :  How to convert c/c++ callback functon to delphi

Rica ederim, helal olsun. Önemli olan, sorununuzu halletmiş olmanız.

[ismailkocacan]

Konu aslında fonksiyon çağırım düzeni, yani fonksiyon parametrelerinin hangilerinin stack ve/veya CPU register'da tahsis edilişi ile ilgili.

C dilinde fonksiyonlar varsayılan olarak cdecl direktifini kullanır.Bunun anlamı fonksiyon parametrelerinin tamamı stack'de tutulur.
Delphi'de fonksiyonlar varsayılan olarak Register direktifini kullanır.Bunun anlamı fonksiyon parametrelerinin 3 tanesine kadarı CPU register'larda tutulurken diğerleri stack'de tutulur.
Delphi'deki Register direktifinin karşılığı C dilinde __fastcall'dır.

Bahsettiklerimi gözlemlemek adına, Delphi'de yazdığınız fonksiyonlara breakpoint koyup CPU ekranından kontrol edebilirsiniz.
Daha detaylı bilgi için dokümana gözatabilirsiniz.