Private Declare Unicode Function GetPadeg Lib "PadegUC.dll" Alias "GetFIOPadegFSAS" (ByVal pFIO As String, ByVal nPadeg As Integer, ByVal pResult As String, ByRef nLen As Integer) As Integer

' Функция получения рода (пола) по отчетву
' Параметры: pMiddleName    - отчество
' Значение:  1 - мужской
'            0 - женский
'           -1 - невозможно определить

Private Declare Function GetSex Lib "PadegUC.dll" _
  (ByVal pMiddleName As String) As Integer

Public Function MakeSex(ByVal cMiddleName As String) As String
Dim tmpS As String
MakeSex = GetSex(StrConv(cMiddleName, vbUnicode)) ' с переводом ASC - Unicode
tmpS = StrConv(tmpS, vbFromUnicode) ' перевод в Unicode - ASC

End Function

Private Declare Function GetSex Lib "PadegUC.dll" _
  (ByVal pMiddleName As String) As Integer

Public Function MakeSex(ByVal pMiddleName As String) As String
  MakeSex = GetSex(pMiddleName)
End Function

#include <QLibrary>
#include <QDebug>

typedef int (__stdcall *LPFNGetFIOPadegAS)(wchar_t *, wchar_t *, wchar_t *, int, wchar_t *, int &);
typedef int (__stdcall *LPFNGetAppointmentPadeg)(wchar_t *, int, wchar_t *, int &);

LPFNGetFIOPadegAS GetFIOPadegAS = 0;
LPFNGetAppointmentPadeg GetAppointmentPadeg = 0;

void loadLib()
{
    QLibrary myLib("PadegUC.dll");
    GetFIOPadegAS = (LPFNGetFIOPadegAS) myLib.resolve("GetFIOPadegAS");
    GetAppointmentPadeg = (LPFNGetAppointmentPadeg) myLib.resolve("GetAppointmentPadeg");
    if (!GetFIOPadegAS || !GetAppointmentPadeg) {
        qDebug() << __FILE__ << __LINE__ << myLib.isLoaded() << myLib.errorString();
        return;
    }
}

QString getFIOPadeg(QString lastName, QString firstName, QString middleName, int padeg)
{
    if (!GetFIOPadegAS)
        return QString();
    QString res;
    int errorCode;
    int resLength = lastName.length() + firstName.length() + middleName.length() + 100;
    wchar_t *wLastName = new wchar_t[lastName.length() + 1]; //для 0 в конце
    wchar_t *wFirstNameW = new wchar_t[firstName.length() + 1];
    wchar_t *wMiddleNameW = new wchar_t[middleName.length() + 1];
    wchar_t *wResult = new wchar_t[resLength];

    lastName.toWCharArray(wLastName);
    wLastName[lastName.length()] = 0; //если не поставить будут проблемы у GetFIOPadegAS

    firstName.toWCharArray(wFirstNameW);
    wFirstNameW[firstName.length()] = 0;

    middleName.toWCharArray(wMiddleNameW);
    wMiddleNameW[middleName.length()] = 0;

    errorCode = GetFIOPadegAS(wLastName,
                    wFirstNameW,
                    wMiddleNameW,
                    padeg,
                    wResult,
                    resLength);

    res = QString::fromWCharArray(wResult, resLength);
    delete[] wLastName;
    delete[] wFirstNameW;
    delete[] wMiddleNameW;
    delete[] wResult;
    return res;
}

int main(int, char**)
{
    loadLib();
    qDebug() << getFIOPadeg(QString::fromUtf8("Иванов"), QString::fromUtf8("Иван"), QString::fromUtf8("Иванович"), 5);  //если файлы исходников в UTF-8
    return 0;
}

Type TMyPartsFIO
     pLastName As String
     pFirstName As String
     pMiddleName As String
     nLastName As Long
     nFirstName As Long
     nMiddleName As Long
End Type

Public Sub MakeGetFIOParts(ByVal cFIO As String, ByRef cLastName As String, ByRef cFirstName As String, ByRef cMiddleName As String)
Dim RetVal As Integer
Dim PartsFIO As TMyPartsFIO

   With PartsFIO
     ' устанавливаем размеры буферов (можно и другие значения
     ' главное, чтобы они были достаточными для результатов
     .nLastName = 50  
     .nFirstName = 50  
     .nMiddleName = 50
     ' выделяем память под строки
     .pLastName = String(.nLastName, 0)
     .pFirstName = String(.nFirstName, 0)
     .pMiddleName = String(.nMiddleName, 0)
   End With

   If Len(cFIO) = 1 Then Exit Sub

   RetVal = GetPartsFIO(cFIO, PartsFIO)

   If RetVal <> 0 Then MsgBox "ПарсингФИОнеудался "& "(" & RetVal & ")"

   cLastName = Mid(PartsFIO.pLastName, 1, PartsFIO.nLastName)
   cFirstName = Mid(PartsFIO.pFirstName, 1,  PartsFIO.nFirstName)
   cMiddleName = Mid(PartsFIO.pMiddleName, 1, PartsFIO.nMiddleName)
EndSub

Type TMyPartsFIO
    pLastName As String
    pFirstName As String
    pMiddleName As String
    nLastName As Long
    nFirstName As Long
    nMiddleName As Long
End Type

Private Declare Function GetPartsFIO Lib "Padeg.dll" Alias "GetFIOParts" _
  (ByVal pFIO As String, ByRef pResult As TMyPartsFIO) As Integer

Public Sub MakeGetFIOParts(ByVal cFIO As String, ByRef cLastName As String, ByRef cFirstName As String, ByRef cMiddleName As String)
Dim RetVal As Integer
Dim PartsFIO As TMyPartsFIO

  If Len(cFIO) = 1 Then Exit Sub

  RetVal = GetPartsFIO(cFIO, PartsFIO)


  If RetVal <> 0 Then MsgBox "ПарсингФИОнеудался "& "(" & RetVal & ")"
  cLastName = Mid(PartsFIO.pLastName, 1, Len(PartsFIO.pLastName))
  cFirstName = Mid(PartsFIO.pFirstName, 1, Len(PartsFIO.pFirstName))
  cMiddleName = Mid(PartsFIO.pMiddleName, 1, Len(PartsFIO.pMiddleName))
EndSub

' Макросы преобразования выделенного ФИО в соответствующий падеж

Public Sub ФамИнициалы()
Dim F As String, I As String, O As String
Call MakeGetFIOParts(Selection, F, I, O)
Selection.TypeText (Selection)
EndSub

typedef int (__stdcall *LPFNGetFIOPadegAS)
      (unsigned char *,unsigned char *, unsigned char *, int, unsigned char *, int &);
    LPFNGetFIOPadegAS lpfnGetFIOPadegAS;

    QLibrary lib("PadegUC32.dll");
    lpfnGetFIOPadegAS = (LPFNGetFIOPadegAS) lib.resolve("GetFIOPadegAS");
    // и для примера возьмем известного русского
    char *cpLastName, *cpFirstName, *cpMiddleName;
    char cResult[200]; // буфер для результата
    cpLastName="Иванов";
    cpFirstName="Иван";
    cpMiddleName="Иванович";
    int iLen=200;
    // указываем фамилию, имя, отчество, падеж и куда поместить результат
    int iParam=lpfnGetFIOPadegAS((unsigned char *)cpLastName,
              (unsigned char *)cpFirstName,
              (unsigned char *)cpMiddleName,
              6,
              (unsigned char *)cResult,
              iLen);

    qDebug() << cResult;
    qDebug() << iParam;

Иванов
0

                  Type PPartsFIO
                       pLastName As String
                       pFirstName As String
                       pMiddleName As String
                       nLastName As Long
                       nFirstName As Long
                       nMiddleName As Long
                  End Type
    
     Private Declare Function GetFIOParts Lib "j:\!!!!!!!!Excel\CreateWordDocuments2\CreateWordDocuments\x32\PadegUC.dll" _
         (ByVal pFIO As String, Parts As PPartsFIO) As Integer

Public Function GetFIOParts_My(ByVal cFIO As String, ByVal Num As Integer) As String
    Dim PartsFIO As PPartsFIO
    Dim RetVal As Integer
    PartsFIO.pLastName = String(10000, 0)
    PartsFIO.pFirstName = String(10000, 0)
    PartsFIO.pMiddleName = String(10000, 0)
    PartsFIO.nLastName = 10000
    PartsFIO.nFirstName = 10000
    PartsFIO.nMiddleName = 10000
  
    RetVal = GetFIOParts(StrConv(cFIO, vbUnicode), PartsFIO)
    Dim tmpS As String
    Select Case Num
        Case 1
            tmpS = PartsFIO.pLastName
        Case 2
            tmpS = PartsFIO.pFirstName
        Case 3
            tmpS = PartsFIO.pMiddleName
        Case 4
            tmpS = PartsFIO.nLastName
        Case 5
            tmpS = PartsFIO.nFirstName
        Case 6
            tmpS = PartsFIO.nMiddleName
        Case Else
            tmpS = StrConv(cFIO, vbUnicode)
   End Select
      
   GetFIOParts_My = Left(StrConv(tmpS, vbFromUnicode), 10000)
    
End Function

                  Type PPartsFIO
                      pLastName As String
                      pFirstName As String
                      pMiddleName As String
                      nLastName As Long
                      nFirstName As Long
                      nMiddleName As Long
                  End Type

     Private Declare Function GetFIOParts Lib "PadegUC.dll" _
         (ByVal pFIO As String, Parts As PPartsFIO) As Integer



Public Function MakePadegGetFIOParts(ByVal cFIO As String) As String
   Dim aaaa As PPartsFIO
   Dim aa As Integer
   aa = GetFIOParts(cFIO, aaaa)
   MakePadegGetFIOParts = aaaa
End Function

#If VBA7 Then
    Private Declare PtrSafe Function GetFIOPadegFSAS Lib "PadegUC.dll" _
        (ByVal pFIO As String, ByVal nPadeg As Long, ByVal pResult As String, ByRef nLen As Long) As Integer

    Private Declare PtrSafe Function GetNominativePadeg Lib "PadegUC.dll" _
        (ByVal pFIO As String, ByVal pResult As String, ByRef nLen As Long) As Integer
  
    Private Declare PtrSafe Function GetAppointmentPadeg Lib "PadegUC.dll" _
        (ByVal pAppointment As String, ByVal nPadeg As Long, ByVal pResult As String, ByRef nLen As Long) As Integer
#Else
    Private Declare Function GetFIOPadegFSAS Lib "PadegUC.dll" _
        (ByVal pFIO As String, ByVal nPadeg As Long, ByVal pResult As String, ByRef nLen As Long) As Integer

    Private Declare Function GetNominativePadeg Lib "PadegUC.dll" _
        (ByVal pFIO As String, ByVal pResult As String, ByRef nLen As Long) As Integer
  
    Private Declare Function GetAppointmentPadeg Lib "PadegUC.dll" _
        (ByVal pAppointment As String, ByVal nPadeg As Long, ByVal pResult As String, ByRef nLen As Long) As Integer
#End If

' Функция преобразования cFIO в падеж nPadeg
Public Function MakePadeg(ByVal cFIO As String, ByVal nPadeg As Long) As String
Dim tmpS As String
Dim nLen As Long
Dim RetVal As Integer
  If Len(cFIO) = 1 Then Exit Function
  nLen = 255
  tmpS = String(nLen, 0)
  RetVal = GetFIOPadegFSAS(StrConv(cFIO, vbUnicode), nPadeg, tmpS, nLen)
  'If RetVal = -1 Then MsgBox "Недопустимое значение падежа - " & "(" & nPadeg & ")", , "Склонение ФИО"
  MakePadeg = Left(StrConv(tmpS, vbFromUnicode), nLen)
End Function

' Функция преобразования sAppointment в падеж nPadeg
Public Function MakeAppointment(ByVal sAppointment As String, ByVal nPadeg As Long) As String
Dim tmpS As String
Dim nLen As Long
Dim RetVal As Integer
  If Len(sAppointment) < 3 Then Exit Function
  nLen = 10000
  tmpS = String(nLen, 0)
  RetVal = GetAppointmentPadeg(StrConv(sAppointment, vbUnicode), nPadeg, tmpS, nLen)
  If RetVal = -1 Then MsgBox "Недопустимое значение падежа - " & "(" & nPadeg & ")", , "Склонение должности"
  MakeAppointment = Left(StrConv(tmpS, vbFromUnicode), nLen)
End Function

  DECLARE EXTERNAL FUNCTION GET_FIO_PADEG_FSAS
  CSTRING(100),
  INTEGER
  RETURNS CSTRING(100)
  ENTRY_POINT 'GetFIOPadegFSAS'
  MODULE_NAME 'PadegUC';

  select p.name, get_fio_padeg_fsas(p.name, 2)
  from person where p.id = 1000

  DECLARE EXTERNAL FUNCTION GET_FIO_PADEG_FSAS
  CSTRING(100),
  INTEGER
  RETURNS CSTRING(100)
  ENTRY_POINT 'GetFIOPadegFSAS'
  MODULE_NAME 'Padeg';

  select p.name, get_fio_padeg_fsas(p.name, 2)
  from person where p.id = 1000

Private Declare Function GetPadeg Lib "PadegUC.dll" Alias "GetFIOPadegFSAS" _
  (ByVal pFIO As String, ByVal nPadeg As Long, ByVal pResult As String, ByRef nLen As Long) As Integer

unit Unit2;

interface

uses
  Windows, Forms, Controls, StdCtrls, Classes, SysUtils;

type
  TForm2 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DllHandle : HMODULE;
  GetFIOPadeg   : function (pLastName, pFirstName, pMiddleName: PChar;
                           bSex: Boolean; nPadeg: LongInt; pResult: PChar;
                           var nLen: LongInt): Integer; stdcall;

  Form2: TForm2;
  Sex:boolean;
  nLen:LongInt;
  pResult:PChar;
  pVar:integer;
  FPadeg:Boolean;
  Fio,nName,SName:string;

implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
   Fio:='Пупкин';
   nName:='Иван';
   SName:='Иванович';
end;

procedure TForm2.FormShow(Sender: TObject);
begin
   Label1.Caption:=Fio;
   Label2.Caption:=nName;
   Label3.Caption:=SName;
   Sex:=True;
   if Assigned(GetFIOPadeg) then
     begin
       nLen := Length(FIO)+10;
       pResult:=StrAlloc(nLen);
       try
          pVar:=GetFIOPadeg(PChar(Fio),'','',Sex,3, pResult, nLen);
          Label4.Caption:=pResult;
       finally
          StrDispose(pResult);
       end;
       nLen := Length(nName)+10;
       pResult:=StrAlloc(nLen);
       try
         GetFIOPadeg('',PChar(nName),'',Sex,3, pResult, nLen);
         Label5.Caption:=pResult;
       finally
          StrDispose(pResult);
       end;
       nLen := Length(sName)+10;
       pResult:=StrAlloc(nLen);
       try
         GetFIOPadeg('','',PChar(SName),Sex,3, pResult, nLen);
         Label6.Caption:=pResult;
       finally
          StrDispose(pResult);
       end;
     end;
   if Sex then
     Label7.Caption:='Муж.'
   else
     Label7.Caption:='Жен.';
end;

initialization
  DllHandle := LoadLibrary('padeg.dll');
  FPadeg:=True;
  if DllHandle <> 0 then
    Begin
      @GetFIOPadeg := GetProcAddress(DllHandle, 'GetFIOPadeg');
    end
  else
    FPadeg:=False;
finalization
  FreeLibrary(DllHandle);
end.
end.

Memo1.Lines.Add('The CodePage of "GetFIOPadeg" is: ' +  IntToStr(StringCodePage(GetFIOPadeg('Иванов','Иван','Иванович',True,2))));

The CodePage of "GetFIOPadeg" is: 1200

Memo1.Lines.Add(GetFIOPadeg('Иванов','Иван','Иванович',True,2));

implementation

type
  PPartsFIO = ^TPartsFIO;
  TPartsFIO = record
    pLastName, pFirstName, pMiddleName : PChar;
    nLastName, nFirstName, nMiddleName : LongInt;
  end;

function GetFIOParts(pFIO:PChar; Parts: PPartsFIO): Integer; stdcall;
                     external 'padeg.dll' Name 'GetFIOParts';

procedure TForm1.Button1Click(Sender: TObject);
var
  Parts      : TPartsFIO;
  CallResult : Integer;
begin
  with Parts do begin
    try
      nLastName := 50;  // размер передаваемого буфера под результат
      nFirstName := 50;
      nMiddleName := 50;
      pLastName := StrAlloc(nLastName); // выделение памяти
      pFirstName := StrAlloc(nFirstName);
      pMiddleName := StrAlloc(nMiddleName);

      CallResult := GetFIOParts(PChar(Edit1.Text), @Parts);

      if CallResult = 0 then begin
        Label1.Caption := StrPas(pLastName);
        Label2.Caption := StrPas(pFirstName);
        Label3.Caption := StrPas(pMiddleName);
      end
      else Label1.Caption := IntToStr(CallResult); // вывод кода ошибки

    finally
      StrDispose(pLastName);  // освобождение памяти
      StrDispose(pFirstName);
      StrDispose(pMiddleName);
    end;
  end;
end;

S := AnsiUpperCase(Copy(S, 1, Pos(' ', S)-1)) + Copy(S, Pos(' ', S), Length(S));

function NominAsMale(F: String): String;
const
  IOMale : array[1..6] of String = (
    'Иван Иванович',   'Ивана Ивановича',   'Ивану Ивановичу',
    'Ивана Ивановича', 'Иваном Ивановичем', 'Иване Ивановиче');
var
  S1, S2, S3, S4 : String;
  i, j           : Integer;
begin
  Result := '';
  for i:=1 to 6 do begin
    S1 := F + ' ' + IOMale[i];
    S2 := GetNominative(S1);
    for j:=1 to 6 do begin
      S3 := GetFIOFromStr(S2,'м',j);
      if (S1 = S3) then begin
        S4 := ExtractWord(1, S2, [' ']);
        if Pos(S4 + ' ', Result) = 0 then Result := S4 + ' ' + Result;
      end;
    end;
  end;
  Result := ExtractWord(1, Result, [' ']);
end;

function NominAsFemale(F: String): String;
const
  IOFemale : array[1..6] of String = (
    'Ивана Ивановна', 'Иваны Ивановны',   'Иване Ивановне',
    'Ивану Ивановну', 'Иваной Ивановной', 'Иване Ивановне');
var
  S1, S2, S3, S4 : String;
  i, j           : Integer;
begin
  Result := '';
  for i:=1 to 6 do begin
    S1 := F + ' ' + IOFemale[i];
    S2 := GetNominative(S1);
    for j:=1 to 6 do begin
      S3 := GetFIOFromStr(S2,'ж',j);
      if (S1 = S3) then begin
        S4 := ExtractWord(1, S2, [' ']);
        if Pos(S4 + ' ', Result) = 0 then Result := S4 + ' ' + Result;
      end;
    end;
  end;
  Result := ExtractWord(1, Result, [' ']);
end;

function NominFromShort(F: array of String): String;
var
  i     : Integer;
  Match : Boolean;
begin
  Result := '';
  Match := True;
  for i:=0 to High(F)-1 do
    if NominAsMale(F[i]) <> NominAsMale(F[i+1]) then Match := False;
  if Match then begin
    Result := NominAsMale(F[0]);
    Exit;
  end;

  Match := True;
  for i:=0 to High(F)-1 do
    if NominAsFemale(F[i]) <> NominAsFemale(F[i+1]) then Match := False;
  if Match then Result := NominAsFemale(F[0])
           else Result := '';
end;

procedure TForm1.Button1Click(Sender: TObject);
var S1, S2 : String;
begin
  S1 := ExtractWord(1, Edit1.Text, [' ']);
  S2 := ExtractWord(2, Edit1.Text, [' ']);

  Edit2.Text := NominFromShort([S1, S2]);
end;

        [StructLayout(LayoutKind.Sequential)]
        private struct FIOParts
        {
            public IntPtr pSurname;
            public IntPtr pName;
            public IntPtr pPatronimic;
            public Int32 lenSurname;
            public Int32 lenName;
            public Int32 lenPatronimic;

            public FIOParts(int maxResultStringBufSize)
            {
                pSurname = Marshal.AllocHGlobal(maxResultStringBufSize);
                pName = Marshal.AllocHGlobal(maxResultStringBufSize);
                pPatronimic = Marshal.AllocHGlobal(maxResultStringBufSize);

                lenSurname = lenName = lenPatronimic = maxResultStringBufSize;
            }

            public void Free()
            {
                Marshal.FreeHGlobal(pSurname);
                Marshal.FreeHGlobal(pPatronimic);
                Marshal.FreeHGlobal(pName);
            }
        }

[StructLayout(LayoutKind.Sequential)]
        private struct FIOParts
        {
            public Int32 lenName;
            public Int32 lenPatronimic;
            public Int32 lenSurname;
            public IntPtr pName;
            public IntPtr pPatronimic;
            public IntPtr pSurname;


            public FIOParts(int maxResultStringBufSize)
            {
                pSurname = Marshal.AllocHGlobal(maxResultStringBufSize);
                pName = Marshal.AllocHGlobal(maxResultStringBufSize);
                pPatronimic = Marshal.AllocHGlobal(maxResultStringBufSize);

                lenSurname = lenName = lenPatronimic = maxResultStringBufSize;
            }

            public void Free()
            {
                Marshal.FreeHGlobal(pPatronimic);
                Marshal.FreeHGlobal(pName);
                Marshal.FreeHGlobal(pSurname);
            }
        }

[StructLayout(LayoutKind.Sequential)]
        private struct FIOParts
        {
            public IntPtr pName;
            public IntPtr pPatronimic;
            public IntPtr pSurname;
            public Int32 lenName;
            public Int32 lenPatronimic;
            public Int32 lenSurname;

            public FIOParts(int maxResultStringBufSize)
            {
                pSurname = Marshal.AllocHGlobal(maxResultStringBufSize);
                pName = Marshal.AllocHGlobal(maxResultStringBufSize);
                pPatronimic = Marshal.AllocHGlobal(maxResultStringBufSize);

                lenSurname = lenName = lenPatronimic = maxResultStringBufSize;
            }

            public void Free()
            {
                Marshal.FreeHGlobal(pPatronimic);
                Marshal.FreeHGlobal(pName);
                Marshal.FreeHGlobal(pSurname);
            }
        }