Блог

Я написал DLL на Free Pascal и хочу вызвать ее в Excel. Я был бы признателен, если кто-нибудь сможет мне помочь.

Моя бесплатная библиотека DLL Pascal для тестирования

 procedure chess(var number : single);stdcall;
begin
    WriteLn(output,'Wir testen die Zahl: ', number);
end;

exports
       chess;
begin
end. 
  

В Excel у меня есть следующий код VBA

 Private Declare PtrSafe Sub chess Lib "D:FSLTMProjektTestWBCLModul_lib.dll" (ByVal Number As Single)
  

Когда я вызываю DLL в VBA с Call chess(TSim) помощью Excel, происходит сбой и самозакрывается.
Последние пару дней я не могу понять, почему, и теперь это становится действительно неприятным.
Надеюсь, кто-нибудь сможет мне помочь.

Заранее спасибо.

Редактировать:

Код библиотеки DLL на языке Pascal:

 library CLM_WEAdynModell;
{$mode objfpc}{$H }

uses
    CLM_GlobalVariables, CLM_LoadCalc, CLM_Initialization;
   
type
    IOA = array[1..150] of single; 

procedure callTModel(var IOArray : IOA); stdcall; 
begin
     getInputValues(IOArray);
     defineModel;
     calcSecForces;
     writeOutputValues(IOArray);
     writeLogFile(IOArray);
end; 

exports
       callTModel;
begin
end.
  

Код VBA:

 Option Explicit 
Private Declare PtrSafe Sub callTModel Lib "D:FSLTMProjektTestWBCLM_WEAdynModell.dll" (ByRef IOArray() As Single)

Private Sub CB_RUN_Click()

Dim ValID, TStep, INLimit, aIndex, bIndex, ActSensor, VisNmax, OUTLimit, i As Integer
Dim TSim, TMax As Single
Dim IOArray(149) As Single

With ActiveSheet

TStep = 0
ValID = 0
INLimit = 9   
VisNmax = 20  

ActSensor = .Range("NoSensor").Value   1
OUTLimit = .Range("OUTLimit")
TSim = 0
TMax = .Range("TMax")

    ThisWorkbook.Worksheets("IstRes").Range("A4:IV8000").ClearContents
 
Application.ScreenUpdating = False

 Do While TSim < TMax
    TSim = .Range("TSim")
    
    aIndex = (4   TStep) 'Zeilenindex für Source Array
    For i = 1 To INLimit
     bIndex = (1   i)     ' Spaltenindex für Source Array
      
     If (i < 10) Then IOArray(24   i) = ThisWorkbook.Worksheets("SourceData").Cells(aIndex, bIndex).Value
     bIndex = bIndex   INLimit
     If (i < 10) Then IOArray(39   i) = ThisWorkbook.Worksheets("SourceData").Cells(aIndex, bIndex).Value
     bIndex = bIndex   INLimit
     If (i < 4) Then IOArray(7   i) = ThisWorkbook.Worksheets("SourceData").Cells(aIndex, bIndex).Value
     bIndex = bIndex   3
     If (i < 4) Then IOArray(19   i) = ThisWorkbook.Worksheets("SourceData").Cells(aIndex, bIndex).Value
          
    Next i
    
    IOArray(101) = OUTLimit
    
    Call callTModel(IOArray)
    
    
    aIndex = (4   TStep) 'Zeilenindex für Target Array
    ThisWorkbook.Worksheets("IstRes").Cells(aIndex, 1).Value = ThisWorkbook.Worksheets("SourceData").Cells(aIndex, 1).Value
    For i = 1 To OUTLimit
     bIndex = (1   i)     ' Spaltenindex für Source Array
     ThisWorkbook.Worksheets("IstRes").Cells(aIndex, bIndex).Value = IOArray(101   i)
    Next i
 
    Application.ScreenUpdating = True
     If TStep < VisNmax Then
      .Cells(9   TStep, 3).Value = ThisWorkbook.Worksheets("SollRes").Cells(aIndex, ActSensor).Value
      .Cells(9   TStep, 4).Value = ThisWorkbook.Worksheets("IstRes").Cells(aIndex, ActSensor).Value
     Else
      For i = 1 To (VisNmax - 1)
       .Cells(8   i, 3).Value = .Cells(9   i, 3).Value
       .Cells(8   i, 4).Value = .Cells(9   i, 4).Value
      Next i
      .Cells(8   VisNmax, 3).Value = ThisWorkbook.Worksheets("SollRes").Cells(aIndex, ActSensor).Value
      .Cells(8   VisNmax, 4).Value = ThisWorkbook.Worksheets("IstRes").Cells(aIndex, ActSensor).Value
     End If
    
    TStep = TStep   1
    .Range("TStep") = TStep
   
    Call ScrUpdateEnableNoFlicker
    
    Application.ScreenUpdating = False
    
 Loop ' Ende DoWhile TSim <= TMax


End With ' ActiveSheet
'Application.ScreenUpdating = True


End Sub
  

Вот пример передачи аргумента массива между VBA и Delphi. Функции Delphi вычисляют сумму элементов массива. Чтобы использовать массивы произвольной длины, аргумент объявляется как указатель (первая функция) с включенной математикой указателя или открытый массив (второй).

Вызов VBA будет иметь в обоих случаях два аргумента. SumOfArrayElements1 требуется указатель на первый элемент массива и количество элементов. Для единственного аргумента открытого массива SumOfArrayElements2 также требуется два аргумента в VBA: тот же указатель на первый элемент и последний индекс. Учитывая, что первый индекс всегда равен 0 в Delphi для открытого массива, последний индекс равен длине массива минус один.

Delphi:

 library calc;

{$POINTERMATH ON}

type preal = ^real;

function SumOfArrayElements1(a: preal; n: integer): real;
var i: integer;
begin
    Result := 0;
    for i := 0 to n - 1 do
        Result := Result   a[i]
end;

function SumOfArrayElements2(a: array of real): real;
var i: integer;
begin
    Result := 0;
    for i := Low(a) to High(a) do
        Result := Result   a[i]
end;

exports
    SumOfArrayElements1, SumOfArrayElements2;
end.
  

VBA

 Option Explicit
Option Base 1
Declare PtrSafe Function SumOfArrayElements1 Lib "calc" (ByRef X As Double, ByVal N As Long) As Double
Declare PtrSafe Function SumOfArrayElements2 Lib "calc" (ByRef X As Double, ByVal N As Long) As Double
Sub Test()
    Dim A() As Double, I As Long, N As Long
    N = 100
    ReDim A(N)
    ChDrive ThisWorkbook.Path
    ChDir ThisWorkbook.Path
    For I = 1 To N
        A(I) = I
    Next I
    Debug.Print SumOfArrayElements1(A(1), N)
    Debug.Print SumOfArrayElements2(A(1), N - 1)
End Sub
  

Примечание: ChDrive / ChDir в VBA необходим для VBA для поиска библиотеки DLL, если она хранится в том же каталоге, что и файл Excel.