IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Langage Delphi Discussion :

Comment appeler une fonction DLL par un lien statique ?


Sujet :

Langage Delphi

  1. #1
    Membre habitué

    Homme Profil pro
    Informaticien retraité
    Inscrit en
    Mars 2010
    Messages
    287
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Essonne (Île de France)

    Informations professionnelles :
    Activité : Informaticien retraité
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Mars 2010
    Messages : 287
    Points : 164
    Points
    164
    Billets dans le blog
    1
    Par défaut Comment appeler une fonction DLL par un lien statique ?
    J'utilise Delphi 6 Personal Edition, sous W10 toutes mises à jour faites.

    J'ai écrit une DLL nommée KGF.dll contenant la fonction suivante:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    function TestScalableGraphic(aHandle: pinteger; aWidth, aHeight: integer): integer; stdcall; export;
    var
      canvas: TCanvas;
      SG: TScalableGraphic;
    begin
      result := -1;
      try
       SG := TScalableGraphic.CreateNew(aWidth,aHeight);
     
       SG.Draw(aHandle^,aWidth,aHeight);
       result := 0;
      except
      end;
    end;
    exports TestScalableGraphic;
    La définition de l'objet TScalableGraphic est irrélévante ici - dans mon cas, la fonction n'est même pas appelée...

    Dans un programme principal je veux appeler cette fonction. Dans la section Implementation, je la déclare comme suit:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
      function TestScalableGraphic(aHCanvas: pinteger; aWidth, aHeight: integer): integer; stdcall; external 'KGF.dll';
    Dans l'unique form de mon programme, j'ai un objet Image1 et un bouton Button1. Un click sur ce bouton appelle le code suivant:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    procedure TForm1.Button1Click(Sender: TObject);
    var
      res: integer;
      hCanvas: integer;
    begin
      hCanvas := Image1.Canvas.Handle;
      res := TestScalableGraphic(@hCanvas,Image1.Width,Image1.Height);
    end;
    Or, le programme se plante au lancement, avant même d'afficher la form principale, avec le message suivant:
    Nom : aa1.png
Affichages : 259
Taille : 16,2 Ko

    Si je mets la ligne
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
      res := TestScalableGraphic(@hCanvas,Image1.Width,Image1.Height);
    en commentaire, le programme démarre correctement.

    Où se situe mon erreur ? Merci de bien vouloir jeter un coup d'oeil...

    EDIT

    Encore plus mystérieux:
    J'ai extrait la fonction en question de la grande dll nommée KGF.dll (environ 1200 fonctions exportées) pour créer une mini-DLL du même nom contenant juste cette fonction.
    Et là, ça fonctionne !

    Si je charge ma fonction par un lien dynamique (LoadLibrary etc) à partir de la grande DLL initiale, ça fonctionne.

    Question: est-ce que le lien statique a une limitation du nombre de fonctions exportées ? Le message d'erreur pourrait faire penser à cela...

    Ci-joint un ZIP qui contient l'ensemble des deux projets (mini-DLL et programme de test).
    Fichiers attachés Fichiers attachés

  2. #2
    Expert éminent sénior
    Avatar de ShaiLeTroll
    Homme Profil pro
    Développeur C++\Delphi
    Inscrit en
    Juillet 2006
    Messages
    13 534
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Développeur C++\Delphi
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2006
    Messages : 13 534
    Points : 25 082
    Points
    25 082
    Par défaut
    Sans regarder le ZIP déjà je vois plein de défaut
    Surtout que le ZIP ne sert à rien si cela fonctionne sans problème, cela vient du code original de la grosse DLL si l'on comprend vos dire.

    Alors même si vous dites que c'est hors sujet de parler de TScalableGraphic, si tout le code est comme ça, c'est un désastre total
    Des constructions inutilement complexes

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    try
       SG := TScalableGraphic.CreateNew(aWidth,aHeight);
     
       SG.Draw(aHandle^,aWidth,aHeight);
       result := 0;
      except
      end;
    fuite mémoire et try except inexploité
    CreateNew, on a déjà dit que c'était une mauvais idée de nommé tes constructeurs CreateNew.
    Et le pinteger est inutile, une le type THandle pour échanger des Handles, HDC, HWND ...

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    function TestScalableGraphic(aHandle: THandle; aWidth, aHeight: integer): integer; stdcall; export;
    begin
      try
        with TScalableGraphic.Create(aWidth, aHeight) do 
        try
           Draw(aHandle, aWidth, aHeight);
     
          result := 0;
        finally
           Free();
        end;
      except
         result := -1;
      end;
    end;


    Vu le nombre de fonction dans une DLL windows, la limite doit être autre mais pour mes DLL, je ne pratique jamais la liaison statique, elle n'est fait qu'à la première utilisation et fonction par fonction, avec un code encaspulant les appels.
    En général, je fais une DLL parce que je veux substituer du code, un peu comme un Plugin.

    D'aileurs, votre DLL est partagée par combien d'exe ?
    Si votre DLL n'est utilisée que par un seul exe, c'est une construction inutile, une bibliothèque interne avec juste des uses aurait suffisant si il n'y a pas de volonté de partage de la DLL, sans compter que le partage de DLL implique de gérer des versions si plusieurs logiciels utilisent la même mais pas installer à la même version.

    EStringListError, faudrait regarder le code d'initialisation si une TStringList est utilisée dans la DLL
    Sous le déboggueur, affiche le journal d'évènement, tu verras le chargement de la DLL

    Par exemple, libeay32.dll contient 3500 fonctions, je l'utilise exclusivement en liaision dynamique via Indy et j'ajoute juste les déclarations des fonctions manquantes pour mon utilisation
    Exemple "PEM_read_bio_PUBKEY" n'existe pas dans IdSSLOpenSSLHeaders qui contient les déclarations de "libeay32.dll", je me suis greffé sur l'existant de Indy déjà utilisé dans le projet, j'utilise donc le pointer de la DLL déjà chargée et je récupère juste la fonction en plus dont j'ai besoin

    Tu devrais avec une DLL à 1200 fonctions procéder de la même façon, rien que pour gérer plus tard les versions de la DLL, tu peux ainsi dans le code appelant vérifier que la DLL est la bonne à utiliser et pas une version obsolète ou plus récente qui soit incompatible.


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    407
    408
    409
    410
    411
    412
    413
    414
    415
    416
    417
    418
    419
    420
    421
    422
    423
    424
    425
    426
    427
    428
    429
    430
    431
    432
    433
    434
    435
    436
    437
    438
    439
    440
    441
    442
    443
    444
    445
    446
    447
    448
    449
    450
    451
    452
    453
    454
    455
    456
    457
    458
    459
    460
    461
    462
    463
    464
    465
    466
    467
    468
    469
    470
    471
    472
    473
    474
    475
    476
    477
    478
    479
    480
    481
    482
    483
    484
    485
    486
    487
    488
    489
    490
    491
    492
    493
    494
    495
    496
    497
    498
    499
    500
    501
    502
    503
    504
    505
    506
    507
    508
    509
    510
    511
    512
    513
    514
    515
    516
    517
    518
    519
    520
    521
    522
    523
    524
    525
    526
    527
    528
    529
    530
    531
    532
    533
    534
    535
    536
    537
    538
    539
    540
    541
    542
    543
    544
    unit SLTOpenSslSignerTools;
     
    interface
     
    uses System.SysUtils,
      IdSSLOpenSSL, IdSSLOpenSSLHeaders, IdThreadSafe;
     
    type
      { Forward class declarations }
      TSLTPEMKeyLoader = class;
      TSLTPEMKey = class;
      TSLTSignatureVerificator = class;
      TSLTSignatureGenerator = class;
     
     
      { Exception class declarations }
      ESLTPEMKeyException = class(Exception);
      ESLTPEMKeyLoaderException = class(ESLTPEMKeyException);
      ESLTSignatureVerificatorException = class(ESLTPEMKeyException);
      ESLTSignatureGeneratorException = class(ESLTPEMKeyException);
     
     
      { TSLTPEMKeyLoader }
     
      TSLTPEMKeyLoader = class(TObject)
      private
        class var FOpenSSLSharedLibraryCryptoLoaded: TIdThreadSafeBoolean;
        class var FOpenSSLSharedLibraryCryptoFunctions: record
          PEM_read_bio_PUBKEY : function(bp: PBio; x: PPEVP_PKEY; cb: ppem_password_cb; u: pointer): PEVP_PKEY; cdecl;
        end;
      public
        type
          PPEMInput = PBIO; // Basic I/O - PEM = Privacy Enhanced eMail
          PPublicKey = PEVP_PKEY; // EVP = The Digital EnVeloPe library, provides a high-level interface to cryptographic functions.
          PPublicKeyRSA = PRSA;
          PPrivateKey = PEVP_PKEY; // EVP = The Digital EnVeloPe library, provides a high-level interface to cryptographic functions.
          PPrivateKeyRSA = PRSA;
      public
        class function InitOpenSSL(): Boolean;
        class procedure FinalizeOpenSSL();
     
        class function OpenPEM(const APEMContent: TBytes; out APEMInput: PPEMInput): Boolean;
        class procedure ClosePEM(var APEMInput: PPEMInput);
     
        class function OpenPublicKey(const APEMInput: PPEMInput; out APublicKey: PPublicKey): Boolean;
        class procedure ClosePublicKey(var APublicKey: PPublicKey);
     
        class function OpenPublicKeyRSA(const APublicKey: PPublicKey; out APublicKeyRSA: PPublicKeyRSA): Boolean;
        class procedure ClosePublicKeyRSA(var APublicKeyRSA: PPublicKeyRSA);
     
        class function OpenPrivateKey(const APEMInput: PPEMInput; const APWDContent: TBytes; out APrivateKey: PPrivateKey): Boolean;
        class procedure ClosePrivateKey(var APrivateKey: PPrivateKey);
     
        class function OpenPrivateKeyRSA(const APEMInput: PPEMInput; const APWDContent: TBytes; out APrivateKeyRSA: PPrivateKeyRSA): Boolean;
        class procedure ClosePrivateKeyRSA(var APrivateKeyRSA: PPrivateKeyRSA);
     
        class function CreatePWDPointer(const APWDContent: TBytes): PByte;
        class procedure FreePWDPointer(var APWDPointer: PByte);
     
        class function InDebugMode(): Boolean; inline;
        class procedure OutputDebugError(); inline;
      public
        class constructor Create();
        class destructor Destroy();
      end;
     
      { TSLTPEMKeySide }
     
      TSLTPEMKeySide = (ksPublic, ksPrivate);
     
      { TSLTPEMKey }
     
      TSLTPEMKey = class(TObject)
      private
        type
          TPublicKeyRec = record
            Key: TSLTPEMKeyLoader.PPublicKey;
            RSA: TSLTPEMKeyLoader.PPublicKeyRSA;
          end;
          TPrivateKeyRec = record
            Key: TSLTPEMKeyLoader.PPrivateKey;
          end;
          TKeyRec = record
            case Side: TSLTPEMKeySide of
              ksPublic: (PublicKey: TPublicKeyRec);
              ksPrivate: (PrivateKey: TPublicKeyRec);
          end;
     
      private
        FContent: TKeyRec;
      public
        constructor Create(const APEMContent: TBytes; ASide: TSLTPEMKeySide; const APWDContent: TBytes = nil);
        destructor Destroy(); override;
      end;
     
      { TSLTSignatureDigestMethod }
     
      TSLTSignatureDigestMethod = (sdmSha1, smdSha256);
     
      { TSLTSignatureVerificator }
     
      TSLTSignatureVerificator = class(TObject)
      public
        class function Verify(AKey: TSLTPEMKey; const AData: string; const ASignature: string; ADigestMethod: TSLTSignatureDigestMethod = sdmSha1): Boolean;
      end;
     
      { TSLTSignatureGenerator }
     
      TSLTSignatureGenerator = class(TObject)
      public
        class function Sign(AKey: TSLTPEMKey; const AData: string; out ASignature: string; ADigestMethod: TSLTSignatureDigestMethod = sdmSha1): Boolean;
      end;
     
     
    implementation
     
    uses Winapi.Windows, System.NetEncoding;
     
    { TSLTPEMKeyLoader }
     
    //------------------------------------------------------------------------------
    class constructor TSLTPEMKeyLoader.Create;
    begin
      FOpenSSLSharedLibraryCryptoLoaded := TIdThreadSafeBoolean.Create();
    end;
     
     
    //------------------------------------------------------------------------------
    class destructor TSLTPEMKeyLoader.Destroy();
    begin
      FinalizeOpenSSL();
     
      FreeAndNil(FOpenSSLSharedLibraryCryptoLoaded);
    end;
     
    //------------------------------------------------------------------------------
    class function TSLTPEMKeyLoader.InitOpenSSL(): Boolean;
    begin
      FOpenSSLSharedLibraryCryptoLoaded.Lock();
      try
        Result := FOpenSSLSharedLibraryCryptoLoaded.Value;
        if not Result then
        begin
          if IdSSLOpenSSL.LoadOpenSSLLibrary() then
          begin
            FOpenSSLSharedLibraryCryptoFunctions.PEM_read_bio_PUBKEY := GetProcAddress(IdSSLOpenSSLHeaders.GetCryptLibHandle, PChar('PEM_read_bio_PUBKEY'));
     
            Result := Assigned(FOpenSSLSharedLibraryCryptoFunctions.PEM_read_bio_PUBKEY);
          end;
     
          FOpenSSLSharedLibraryCryptoLoaded.Value := Result;
        end;
      finally
        FOpenSSLSharedLibraryCryptoLoaded.Unlock();
      end;
    end;
     
     
    //------------------------------------------------------------------------------
    class procedure TSLTPEMKeyLoader.FinalizeOpenSSL();
    begin
      FOpenSSLSharedLibraryCryptoFunctions.PEM_read_bio_PUBKEY := nil;
      FOpenSSLSharedLibraryCryptoLoaded.Value := False;
    end;
     
    //------------------------------------------------------------------------------
    class function TSLTPEMKeyLoader.InDebugMode(): Boolean;
    begin
    {$IFDEF DEBUG}
    {$WARN SYMBOL_PLATFORM OFF}
      Result := DebugHook <> 0;
    {$WARN SYMBOL_PLATFORM ON}
    {$ELSE DEBUG}
      Result := False;
    {$ENDIF DEBUG}
    end;
     
    //------------------------------------------------------------------------------
    class function TSLTPEMKeyLoader.OpenPEM(const APEMContent: TBytes; out APEMInput: PPEMInput): Boolean;
    begin
      APEMInput := IdSSLOpenSSLHeaders.BIO_new_mem_buf(APEMContent, Length(APEMContent));
      Result := Assigned(APEMInput);
    end;
     
    //------------------------------------------------------------------------------
    class procedure TSLTPEMKeyLoader.ClosePEM(var APEMInput: PPEMInput);
    begin
      if Assigned(APEMInput) then
      begin
        BIO_free(APEMInput);
        APEMInput := nil;
      end;
    end;
     
    //------------------------------------------------------------------------------
    class function TSLTPEMKeyLoader.OpenPublicKey(const APEMInput: PPEMInput; out APublicKey: PPublicKey): Boolean;
    begin
      // -----BEGIN PUBLIC KEY-----
      // ...
      // -----END PUBLIC KEY-----
     
      APublicKey := FOpenSSLSharedLibraryCryptoFunctions.PEM_read_bio_PUBKEY(APEMInput, nil, nil, nil);
      Result := Assigned(APublicKey);
     
      if not Result then
        OutputDebugError();
    end;
     
    //------------------------------------------------------------------------------
    class procedure TSLTPEMKeyLoader.ClosePublicKey(var APublicKey: PPublicKey);
    begin
      if Assigned(APublicKey) then
      begin
        IdSSLOpenSSLHeaders.EVP_PKEY_free(APublicKey);
        APublicKey := nil;
      end;
    end;
     
    //------------------------------------------------------------------------------
    class function TSLTPEMKeyLoader.OpenPublicKeyRSA(const APublicKey: PPublicKey; out APublicKeyRSA: PPublicKeyRSA): Boolean;
    begin
      APublicKeyRSA := IdSSLOpenSSLHeaders.EVP_PKEY_get1_RSA(APublicKey);
      Result := Assigned(APublicKeyRSA);
     
      if not Result then
        OutputDebugError();
    end;
     
    //------------------------------------------------------------------------------
    class procedure TSLTPEMKeyLoader.ClosePublicKeyRSA(var APublicKeyRSA: PPublicKeyRSA);
    begin
      if Assigned(APublicKeyRSA) then
      begin
        IdSSLOpenSSLHeaders.RSA_free(APublicKeyRSA);
        APublicKeyRSA := nil;
      end;
    end;
     
    //------------------------------------------------------------------------------
    class function TSLTPEMKeyLoader.OpenPrivateKey(const APEMInput: PPEMInput; const APWDContent: TBytes; out APrivateKey: PPrivateKey): Boolean;
    var
      u: PByte;
    begin
      // https://www.openssl.org/docs/man1.1.1/man3/PEM_read_bio_PrivateKey.html
      u := CreatePWDPointer(APWDContent);
      try
        // -----BEGIN ENCRYPTED PRIVATE KEY-----
        // ...
        // -----END ENCRYPTED PRIVATE KEY-----
     
        APrivateKey := IdSSLOpenSSLHeaders.PEM_read_bio_PrivateKey(APEMInput, nil, nil, u);
        Result := Assigned(APrivateKey);
     
        if not Result then
          OutputDebugError();
      finally
        FreePWDPointer(u);
      end;
    end;
     
    //------------------------------------------------------------------------------
    class procedure TSLTPEMKeyLoader.ClosePrivateKey(var APrivateKey: PPrivateKey);
    begin
      if Assigned(APrivateKey) then
      begin
        IdSSLOpenSSLHeaders.EVP_PKEY_free(APrivateKey);
        APrivateKey := nil;
      end;
    end;
     
    //------------------------------------------------------------------------------
    class function TSLTPEMKeyLoader.OpenPrivateKeyRSA(const APEMInput: PPEMInput; const APWDContent: TBytes; out APrivateKeyRSA: PPrivateKeyRSA): Boolean;
    var
      u: PByte;
    begin
      // https://www.openssl.org/docs/man1.1.1/man3/PEM_read_bio_RSAPrivateKey.html
      u := CreatePWDPointer(APWDContent);
      try
        // Ce n'est pas ce type de clé privée pour le moment
        // -----BEGIN RSA PRIVATE KEY-----
        // Proc-Type: 4,ENCRYPTED
        // DEK-Info: AES-128-CBC,...
        // ...
        // -----END RSA PRIVATE KEY-----
     
        APrivateKeyRSA := IdSSLOpenSSLHeaders.PEM_read_bio_RSAPrivateKey(APEMInput, nil, nil, u);
        Result := Assigned(APrivateKeyRSA);
     
        if not Result then
          OutputDebugError();
      finally
        FreePWDPointer(u);
      end;
    end;
     
    //------------------------------------------------------------------------------
    class procedure TSLTPEMKeyLoader.ClosePrivateKeyRSA(var APrivateKeyRSA: PPrivateKeyRSA);
    begin
      if Assigned(APrivateKeyRSA) then
      begin
        IdSSLOpenSSLHeaders.RSA_free(APrivateKeyRSA);
        APrivateKeyRSA := nil;
      end;
    end;
     
    //------------------------------------------------------------------------------
    class function TSLTPEMKeyLoader.CreatePWDPointer(const APWDContent: TBytes): PByte;
    var
      k: Integer;
    begin
      k := Length(APWDContent);
      if k > 0 then
      begin
        GetMem(Result, k + 1);
        Move(APWDContent[0], Result^, k);
        Result[k] := 0;
      end
      else
        Result := nil;
    end;
     
    //------------------------------------------------------------------------------
    class procedure TSLTPEMKeyLoader.FreePWDPointer(var APWDPointer: PByte);
    begin
      if Assigned(APWDPointer) then
      begin
        FreeMem(APWDPointer);
        APWDPointer := nil;
      end;
    end;
     
     
    //------------------------------------------------------------------------------
    class procedure TSLTPEMKeyLoader.OutputDebugError();
    var
      ErrorMsg: AnsiString;
    begin
      if InDebugMode() then
      begin
        SetLength(ErrorMsg, 255);
        IdSSLOpenSSLHeaders.ERR_error_string(IdSSLOpenSSLHeaders.ERR_get_error(), PAnsiChar(ErrorMsg));
        OutputDebugStringA(PAnsiChar(ErrorMsg));
      end;
    end;
     
     
    { TSLTPEMKey }
     
    //------------------------------------------------------------------------------
    constructor TSLTPEMKey.Create(const APEMContent: TBytes; ASide: TSLTPEMKeySide; const APWDContent: TBytes = nil);
    var
      PEMInput: TSLTPEMKeyLoader.PPEMInput;
      tmpKey: PEVP_PKEY;
      tmpRSA: PRSA;
    begin
      inherited Create();
     
      FContent.Side := ASide;
     
      // https://delphi.developpez.com/tutoriels/rsa/#LIV
      TSLTPEMKeyLoader.InitOpenSSL();
     
      (* Extraction de la Clé
       * PBIO_new_mem_buf pour ouvrir le binaire ici d'un contenu d'un fichier PEM
       * PPEM_read_bio_PUBKEY pour extraire la clé publique (fonction chargée manuellement)
       * PEVP_PKEY_get1_RSA pour vérifier que la clé publique est bien de type RSA
       * PBIO_free, EVP_PKEY_free, RSA_free sont respectivement les fonctions de libération pour chaque fonction ci-dessus
      *)
      if TSLTPEMKeyLoader.OpenPEM(APEMContent, PEMInput) then
      begin
        try
          case FContent.Side of
            ksPublic :
              if TSLTPEMKeyLoader.OpenPublicKey(PEMInput, tmpKey) then
              begin
                try
                  if TSLTPEMKeyLoader.OpenPublicKeyRSA(tmpKey, tmpRSA) then
                  begin
                    try
                      FContent.PublicKey.Key := tmpKey;
                      FContent.PublicKey.RSA := tmpRSA;
                      tmpKey := nil;
                      tmpRSA := nil;
                    finally
                      TSLTPEMKeyLoader.ClosePublicKeyRSA(tmpRSA);
                    end;
     
                  end
                  else
                    raise Exception.Create('RSA Public Key is not loaded !');
                finally
                  TSLTPEMKeyLoader.ClosePublicKey(tmpKey);
                end;
     
              end
              else
                raise Exception.Create('Public Key is not loaded !');
     
            ksPrivate :
              if TSLTPEMKeyLoader.OpenPrivateKey(PEMInput, APWDContent, tmpKey) then
              begin
                try
                  FContent.PrivateKey.Key := tmpKey;
                  tmpKey := nil;
                finally
                  TSLTPEMKeyLoader.ClosePrivateKey(tmpKey);
                end;
     
              end
              else
                raise Exception.Create('Private Key is not loaded !');
            end;
        finally
          TSLTPEMKeyLoader.ClosePEM(PEMInput);
        end;
      end
      else
        raise ESLTPEMKeyLoaderException.Create('PEM content buffer is not loaded !');
    end;
     
     
    //------------------------------------------------------------------------------
    destructor TSLTPEMKey.Destroy();
    begin
      case FContent.Side of
        ksPublic :
          begin
            TSLTPEMKeyLoader.ClosePublicKeyRSA(FContent.PublicKey.RSA);
            TSLTPEMKeyLoader.ClosePublicKey(FContent.PublicKey.Key);
          end;
     
        ksPrivate :
          begin
            TSLTPEMKeyLoader.ClosePrivateKey(FContent.PrivateKey.Key);
          end;
      end;
     
      inherited Destroy();
    end;
     
    { TSLTSignatureVerificator }
     
    //------------------------------------------------------------------------------
    class function TSLTSignatureVerificator.Verify(AKey: TSLTPEMKey; const AData: string; const ASignature: string; ADigestMethod: TSLTSignatureDigestMethod = sdmSha1): Boolean;
    var
      IOLayer: PBIO;
      EVPContext : pEVP_MD_CTX;
      MethodProc: PEVP_MD;
      LData: TBytes;
      LSignature: TBytes;
    begin
      (* Utilisation de la Clé et Verification de la Signature :
       * EVP_sha1() est la méthode utilisée en phase avec le PHP openssl_sign OPENSSL_ALGO_SHA1.
       * BIO_new pour ouvrir un espace de travail
       * BIO_get_md_ctx pour récupérer un contexte d'execution
       * EVP_DigestVerifyInit affecte au contexte en cours la méthode utilisé (sha1) et la clé issue de PEM_read_bio_PUBKEY
       * EVP_DigestVerifyUpdate affecte au contexte en cours la donnée qui a été utilisé comme $data  dans  openssl_sign .
         - Un débat sur l'encodage de cette chaine pose problème, en CS c'est ASCII mais je devine qu'il faut utiliser UTF8 à la place mais du coup c'est n'est plus iso-fonctionnalité
       * EVP_DigestVerifyFinal vérifie la signature &$signature issue de  openssl_sign en commençant comme en CS par récupérer le binaire à partir d'un décodage de Base64
       * BIO_reset, remet à zéro les valeurs transmises au contexte
       * BIO_free fermer l'espace de travail
       *)
     
      case ADigestMethod of
        sdmSha1: MethodProc := IdSSLOpenSSLHeaders.EVP_sha1;
        smdSha256: MethodProc := IdSSLOpenSSLHeaders.EVP_sha256;
      else
        raise ESLTSignatureVerificatorException.Create('Method not supported or not approuved.');
      end;
     
      IOLayer := IdSSLOpenSSLHeaders.BIO_new(IdSSLOpenSSLHeaders.BIO_f_md());
      try
        IdSSLOpenSSLHeaders.BIO_get_md_ctx(IOLayer, @EVPContext);
        try
          IdSSLOpenSSLHeaders.EVP_DigestVerifyInit(EVPContext, nil, MethodProc, nil, AKey.FContent.PublicKey.Key);
     
          LData := TEncoding.UTF8.GetBytes(AData); // ASCII en C# et corrigé en UTF8 pour être plus conforme au PHP
          IdSSLOpenSSLHeaders.EVP_DigestVerifyUpdate(EVPContext, @LData[0], Length(LData));
     
          // https://www.openssl.org/docs/man1.1.1/man3/EVP_DigestVerifyFinal.html
          // https://www.openssl.org/docs/man3.0/man3/EVP_DigestVerifyFinal.html
          LSignature := TNetEncoding.Base64.DecodeStringToBytes(ASignature);
          Result := LongBool(IdSSLOpenSSLHeaders.EVP_DigestVerifyFinal(EVPContext, PAnsiChar(@LSignature[0]), Length(LSignature)));
        finally
          IdSSLOpenSSLHeaders.BIO_reset(IOLayer);
        end;
      finally
        IdSSLOpenSSLHeaders.BIO_free(IOLayer);
      end;
    end;
     
    { TSLTSignatureGenerator }
     
    //------------------------------------------------------------------------------
    class function TSLTSignatureGenerator.Sign(AKey: TSLTPEMKey; const AData: string; out ASignature: string; ADigestMethod: TSLTSignatureDigestMethod = sdmSha1): Boolean;
    var
      IOLayer: PBIO;
      EVPContext : pEVP_MD_CTX;
      MethodProc: PEVP_MD;
      LData: TBytes;
      LSignature: TBytes;
      Len: SIZE_T;
    begin
      Result := False;
      case ADigestMethod of
        sdmSha1: MethodProc := IdSSLOpenSSLHeaders.EVP_sha1;
        smdSha256: MethodProc := IdSSLOpenSSLHeaders.EVP_sha256;
      else
        raise ESLTSignatureVerificatorException.Create('Method not supported or not approuved.');
      end;
     
      IOLayer := IdSSLOpenSSLHeaders.BIO_new(IdSSLOpenSSLHeaders.BIO_f_md());
      try
        // Normalement EVP_MD_CTX_new devrait créer le Contexte mais la DLL contient une fonction proche EVP_MD_CTX_create qui n'est pas déclaré dans IdSSLOpenSSLHeaders
        // Cet autre méthode fonctionne pour obtenir un nouveau contexte en utilisant un nouvel espace de travail complet.
        IdSSLOpenSSLHeaders.BIO_get_md_ctx(IOLayer, @EVPContext);
        try
          IdSSLOpenSSLHeaders.EVP_DigestSignInit(EVPContext, nil, MethodProc, nil, AKey.FContent.PrivateKey.Key);
     
          LData := TEncoding.UTF8.GetBytes(AData); // ASCII en C# et corrigé en UTF8 pour être plus conforme au PHP
          IdSSLOpenSSLHeaders.EVP_DigestSignUpdate(EVPContext, @LData[0], Length(LData));
     
          // https://www.openssl.org/docs/man1.1.1/man3/EVP_DigestSignFinal.html
          if LongBool(IdSSLOpenSSLHeaders.EVP_DigestSignFinal(EVPContext, nil, @Len)) then
          begin
            SetLength(LSignature, Len);
            Result := LongBool(IdSSLOpenSSLHeaders.EVP_DigestSignFinal(EVPContext, PAnsiChar(@LSignature[0]), @Len));
            if Result then
              with TBase64Encoding.Create(0) do
              try
                ASignature := EncodeBytesToString(LSignature);
              finally
                Free();
              end;
          end;
        finally
          IdSSLOpenSSLHeaders.BIO_reset(IOLayer); // EVP_MD_CTX_destroy
        end;
      finally
        IdSSLOpenSSLHeaders.BIO_free(IOLayer);
      end;
    end;
     
    end.
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

  3. #3
    Membre habitué

    Homme Profil pro
    Informaticien retraité
    Inscrit en
    Mars 2010
    Messages
    287
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Essonne (Île de France)

    Informations professionnelles :
    Activité : Informaticien retraité
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Mars 2010
    Messages : 287
    Points : 164
    Points
    164
    Billets dans le blog
    1
    Par défaut
    Ok, je vais suivre cette piste.

    Ma DLL est partagée par des centaines de programmes, et par des dizaines d'utilisateurs, juste pour info.
    La fonction présentée ici n'a évidemment aucun sens - elle est juste déstinée à tester une nouvelle fonctionnalité. D'où le codage un peu superficiel. Toutes les fonctions rendues accessibles aux utilisateurs utilisent évidemment une sécurisation par TRY...EXCEPT ainsi que d'autres sécurités (contrôle des paramètres etx).

  4. #4
    Expert éminent sénior
    Avatar de ShaiLeTroll
    Homme Profil pro
    Développeur C++\Delphi
    Inscrit en
    Juillet 2006
    Messages
    13 534
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Développeur C++\Delphi
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2006
    Messages : 13 534
    Points : 25 082
    Points
    25 082
    Par défaut
    Citation Envoyé par KlausGunther Voir le message
    Ma DLL est partagée par des centaines de programmes, et par des dizaines d'utilisateurs, juste pour info.
    J'étais parti et j'ai complété ma réponse pendant que tu la lisais, donc oui, si tes utilisateurs sont nombreux, insiste sur une utilisation dynamique et de gérer la version

    Si tu le peux, n'hésite pas à fournir un Wrapper de la DLL, en Delphi, en C++ ou dans un autre langage qui a ta préférence

    Pour les utilisateurs de la DLL, cela apporte un confort d'utilisation
    Pour toi, si tu modifie la DLL, tu peux modifier le Wrapper, sans impacter le code de tes utilisateurs.

    As-tu songé à utiliser des Interfaces, tu n'es pas obligé de faire une DLL COM pour avoir des Interfaces et des WideString, cela permettrait d'avoir un code plus simple à utiliser via des objets et pas des fonctions avec des tas de paramètre.
    C'est ce que j'ai fait en C++Builder.
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

  5. #5
    Membre habitué

    Homme Profil pro
    Informaticien retraité
    Inscrit en
    Mars 2010
    Messages
    287
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Essonne (Île de France)

    Informations professionnelles :
    Activité : Informaticien retraité
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Mars 2010
    Messages : 287
    Points : 164
    Points
    164
    Billets dans le blog
    1
    Par défaut
    Merci de tes conseils.

    Je ne sais encore rien des interfaces, mais je suis en train d'étudier cela, suite à la documentation très claire que ALWeber m'a communiquée.

    Le contexte d'utilisation de ma DLL est le suivant:
    - elle est conçue spécifiquement pour utilisation à partir d'un langage freeware, clône de Basic, nommé Panoramic (https://panoramic.1fr1.net/).
    - ce langage, bien que capable d'utiliser des DLLs, impose de très sévères restrictions à leur utilisation:
    1. une DLL doit être connectée via une commande DLL_ON (effectue un LOAD_LIBRARY de façon interne)
    2. une seule DLL peut être ouverte à chaque instant donné. Pour en ouvrir une autre, il faut fermer la précédente.
    3. seules des fonctions peuvent être appelées, pas des procédures
    4. toutes les fonctions appelées doivent être de type "integer"
    5. une fonction appelée peut avoir de 0 à 6 paramètres, pas plus
    6. chaque paramètre doit être de type "integer" (32 bits) et est passé par valeur. Pas de passage par référence.

    Pour pallier à ces restrictions, j'utilise souvent le passage d'une adresse d'une variable "integer" ce qui revient à un "pInteger" en Delphi. Et là, je peux changer la valeur, par exemple, mais également passer l'adresse d'un tableau, l'adresse d'un flottant ou d'un string (la fonction DLL reçoit alors une valeur qui correspond à un "pString" gue je peux gérer, en entrée et en sortie.

    Dans ce contexte, tu vois que ma DLL est en fait son propre wrapper autour des APIs de Windows que je rends accessibles, ou d'autres fonctionnalités comme des composants de mon cru (par exemple, une matrice vieuelle représentant un mini-tableur avec des possibilités similaires à Excel (paramétrage de l'aspect visuel et de la structure de données de chaque cellule, icônes ou checkbox dans certaines cellules, gestion des couleurs, polices, cadres, cellules/lignes/colonnes invisibles, formules de calcul automatiques comme dans Excel, et bien plus.

    Il s'agit vraiment de développements spécifiques étendant les limites u langage cible ou issus de demandes spécifiques des membres du forum. En aucun cas, l'ambition est de faire quelque chose de plus général, utilisable par d'autres langages. Quoique... en respectant les limitations indiquées ci-dessus, n'importe quel langage devrait pouvoir utiliser ces fonctions.

    Voici me mode d'emploi de mes fonctions, sous forme d'aide en ligne: http://klauspanoramic.infinityfreeap...aireIndex.html

  6. #6
    Expert éminent sénior
    Avatar de ShaiLeTroll
    Homme Profil pro
    Développeur C++\Delphi
    Inscrit en
    Juillet 2006
    Messages
    13 534
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Développeur C++\Delphi
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2006
    Messages : 13 534
    Points : 25 082
    Points
    25 082
    Par défaut
    Avec le contexte, c'est effectivement plus compréhensible, votre second lien est bloqué par mon AntiVirus, je n'irais donc pas voir.

    Attention avec le PString, si on peut la DLL peut lire la valeur, la modifier, c'est particulièrement risqué, Violation d'Accès, Opération de Pointeur Incorrecte par la suite.

    Du coup, en Panoramic, la DLL est toujours chargé dynamiquement, vous devriez donc vous collez dans ce contexte dans votre application de test.

    Vu le langage volontairement simplifié, l'utilisation d'Interface est hors sujet.
    D'ailleurs, le langage semble avoir été détourné de son utilisation initiale pour être un langage simple pour des non-programmeurs

    Et Panoramic ne serait pas développé en Delphi par un Français ?
    Pourquoi ne le contactez pour étendre nativement son langage ?
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

  7. #7
    Expert éminent sénior
    Avatar de Paul TOTH
    Homme Profil pro
    Freelance
    Inscrit en
    Novembre 2002
    Messages
    8 964
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Freelance
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Novembre 2002
    Messages : 8 964
    Points : 28 448
    Points
    28 448
    Par défaut
    ben le message d'erreur me semble clair non ? la DLL utilise une StringList dont elle lit l'élément 0 alors que celle-ci est vide...d'où l'erreur.
    Developpez.com: Mes articles, forum FlashPascal
    Entreprise: Execute SARL
    Le Store Excute Store

  8. #8
    Expert éminent sénior
    Avatar de ShaiLeTroll
    Homme Profil pro
    Développeur C++\Delphi
    Inscrit en
    Juillet 2006
    Messages
    13 534
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Développeur C++\Delphi
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2006
    Messages : 13 534
    Points : 25 082
    Points
    25 082
    Par défaut
    Ouais, c'est d'ailleurs la seule partie de ma réponse qui n'a pas semblé intéresser.

    Faudrait Déboguer la DLL, il faut dans le options de débogage mettre le programme hôte
    Ainsi cela permettra de voir l'Exception dans l'IDE
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

  9. #9
    Membre habitué

    Homme Profil pro
    Informaticien retraité
    Inscrit en
    Mars 2010
    Messages
    287
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Essonne (Île de France)

    Informations professionnelles :
    Activité : Informaticien retraité
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Mars 2010
    Messages : 287
    Points : 164
    Points
    164
    Billets dans le blog
    1
    Par défaut
    J'ai trouvé. En effet, en debuggant, j'ai trouvé une référence à une TSTringList vide... autant pour moi. Désolé de vous avoir importunés pour cela.

    Avec le contexte, c'est effectivement plus compréhensible, votre second lien est bloqué par mon AntiVirus, je n'irais donc pas voir.
    Je comprends. Mais c'est sans risque - juste une arborescence de pages HTML, sans Java Script et sans PHP, donnant une aide en ligne détaillée pour chaque fonction.

    Attention avec le PString, si on peut la DLL peut lire la valeur, la modifier, c'est particulièrement risqué, Violation d'Accès, Opération de Pointeur Incorrecte par la suite.
    Je le sais bien ! Si je dois modifier, je copie byte par byte jusqu'à rencontrer un byte 0 dans la destination et je m'arrête. Ca marche très bien.

    Du coup, en Panoramic, la DLL est toujours chargé dynamiquement, vous devriez donc vous collez dans ce contexte dans votre application de test.
    Je viens de le faire et ça marche très bien.

    Vu le langage volontairement simplifié, l'utilisation d'Interface est hors sujet.
    Je le pense aussi. Cependant, j'étudie en ce moment les interfaces que je ne connaissais pas, juste pour ma culture personnelle.

    D'ailleurs, le langage semble avoir été détourné de son utilisation initiale pour être un langage simple pour des non-programmeurs
    Exact. L'avantage, c'est qu'on peut générer des EXE sans coût, ni pour le développeur ni pour l'utilisateur final, que ce soit en usage personnel ou professionnel.

    Et Panoramic ne serait pas développé en Delphi par un Français ?
    Exact.

    Pourquoi ne le contactez pour étendre nativement son langage ?
    Ah, je voudrais bien ! C'est toujours me premier réflexe. Cependant, l'auteur crée cet outil dans son temps libre, pour le plaisir, en deors d'une charge professionnelle très prenante. Je fais donc ce que je peux, à mon niveau, pour aider les autres utilisateurs de ce langage sans étouffer son auteur de demandes parfois très specifiques. Pour ma part, je ne crains pas de faire des développements spécifiquement pour un membre du forum - ça pourra éventuellement servier plus tard à d'autres.

    Moi aussi, je fais ça dans mon temps libre, pour le plaisir. La différence, c'est que j'ai beaucoup plus de temps libre étant à la retraite depuis longtemps.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [Débutant] Appeler une fonction DLL C# depuis le C++ par API LOADLIBRARY
    Par yann458 dans le forum C#
    Réponses: 3
    Dernier message: 07/05/2013, 23h49
  2. Réponses: 2
    Dernier message: 13/03/2006, 13h54
  3. comment appeler une fonction JAVA en JAVASCRIPT ?
    Par heleneh dans le forum Servlets/JSP
    Réponses: 2
    Dernier message: 13/09/2005, 12h21
  4. comment appeler une fonction JAVA en JAVASCRIPT ?
    Par heleneh dans le forum Général JavaScript
    Réponses: 1
    Dernier message: 13/09/2005, 12h04
  5. Comment appeler une fonction JavaScript depuis Delphi ?
    Par Alfred12 dans le forum Web & réseau
    Réponses: 4
    Dernier message: 17/06/2005, 18h15

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo