login application VB / cryptage

Bonjour chers confrères je suis très heureux de faire partie de votre forum et j'espère apprendre beaucoup.Mon problème se situe à ce niveau.J'ai une application visual basic que je veux sécuriser par login et mot de passe au lancement.Pour cela j'ai crée un formulaire de création de login et mot de passe.Maintenant j'ai crée aussi un autre formulaire pour la connexion avec 2 champs login et mot de passe avec deux boutons anuler et OK.j'ai crée aussi des tables pour la gestion des utilisateurs et de leurs mots de passe.Maintenant ce que je voulais c'est le code qu'on devra mettre derrière le bouton OK pour que le programme vérifie la présence du login et du mot de passe entré afin de pouvoir accéder à l'application.Merci d'avance pour votre aide.

Bonjour,

Tu fais une requête (SELECT) sur ta table des users pour récupérer les infos sur l'utilisateur puis tu les compares avec ce qu'il a saisi.

Merci pour ta réponse pc75 je tacherai de faire ce que tu m'as conseillé, en fait ce que je ne maîtrise pas en fait c'est la syntaxe pour la requête select et aussi comment comparer ce qui a été écrit à ce qui est dans la base déjà.

salut

voici ce que j'ai comme example..

Code:

---

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

Private Sub cmdOk_Click()   Dim cnt As Integer Dim bTrouver As Boolean bTrouver = False If txtNom.Text = "" Then MsgBox "Vous devez entrer un nom d'usager.", vbOKOnly, AppTitle txtNom.SetFocus Exit Sub End If If txtMP.Text = "" Then MsgBox "Vous devez entrer un mot de passe.", vbOKOnly, AppTitle txtMP.SetFocus Exit Sub End If SQL = "Select * from Usager" Set rsUsager = New ADODB.Recordset rsUsager.ActiveConnection = cnConn 'connexction a BD rsUsager.CursorType = adOpenKeyset rsUsager.LockType = adLockOptimistic rsUsager.Source = SQL rsUsager.Open If rsUsager.EOF = False Then For cnt = 1 To rsUsager.RecordCount If txtNom.Text = rsUsager!NomUsager Then bTrouver = True Usager = txtNom.Text Exit For End If rsUsager.MoveNext Next cnt If bTrouver = False Then MsgBox "Nom d'usager invalide.", vbOKOnly, AppTitle txtNom.SetFocus txtNom.SelStart = 0 txtNom.SelLength = Len(txtNom.Text) rsUsager.Close Exit Sub Else If txtMP.Text = rsUsager!Pass Then Droit = rsUsager!DroitUsager MotPasse = rsUsager!Pass rsUsager.Close Exit Sub Else MsgBox "Mot de passe invalide.", vbOKOnly, AppTitle txtMP.SetFocus txtMP.SelStart = 0 txtMP.SelLength = Len(txtMP.Text) rsUsager.Close Exit Sub End If End If Else MsgBox "Aucun usager n'existe.", vbCritical, AppTitle rsUsager.Close Unload Me Exit Sub End If rsUsager.Close   End Sub

---

(Droit étant un droit usager genre 'administrateur' ou 'usager')

espérant que ca te guidera :wink:

suposant que ta table est User avec les champs login et password
et pour ton formulaire le textfiekd du login est TxtLogin et pour le mot de passe TxtPassword

tu met dans le code click sur ok

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21

dim rsTemp as new recordset dim sql as string sql ="select password from User where login='" & TxtLogin.text & "'" rsTemp.open sql,taconnection   if TxtLogin="" then msgbox "entrer un login valide" exit sub end if   if rsTemp.EOF then msgbox "Login introuvable" else if TxtPassword.text<>rsTemp(0) then msgbox "Mot de passe incorrect" else 'la tu met le code qui ouvre la fenetre princpale principal.show end if end if

---

c mieu que de faire une boucle
et c plus sur que de faire une requette de type

Code:

---

1 2 3

sql="select count(*) from user where login='" & TxtLogin.text & _ "' and password='" & TxtPassword & "'"

---

et apres comparé le nombre de lignes retournées avec 0
comme ça on évite les injections sql

Eviter de stocker les mots de passe en clair dans une base de donnée, ce n'est pas sécurisé.

Utiliser de préférence une fonction de cryptage non réversible.

Pour le controle il suffit de crypter le mot de passe saisie, et vérifier avec le mot de passe crypter dans le base.

tout à fait daccord avec M. Donat pour la sécurité.
dans mon example j'ai enlever la fonction de décryptage appelée dans un but de clarté.
il est évidemment bon de crypter certaines données dans une base, comme les mots de passe et certaines infos clients qui ne devraient être vue que par les administrateurs d'un système.
et pour ma part pour être encore plus sécure, je protège la bd par mot de passe.
:wink:

Tu peux meme aller encore plus loin, en faisant un MD5SUM de tes champs recalculé à chaque changement dans l'application comme ça la moindre modification d'une informations directement en base engendre un CheckSum faux et permet d'etre sur de la validité de l'information.

Merci les gars à propos de vos conseils concernant la sécurité des mots de passe eux même mais j'aimerais avoir plus de détails en ce qui concerne le cryptage de ces mots de passe dans ma base.merci d'avance.

j'ai une fonction MD5 que j'utilise pour Access par contre, je l'ai au bureau je pourrais te la copier-coller que Lundi.

Voila la fonction promise avec un peu de retard :P

Alors tu met ça dans une classe :

Fait attention aux droits appliqués pour ce code (décrit dedans).

Code:

---

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 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751

Option Compare Database Option Explicit   '******************************************************************************* ' MODULE: CMD5 ' FILENAME: C:\My Code\vb\md5\CMD5.cls ' AUTHOR: Phil Fresle ' CREATED: 16-Feb-2001 ' COPYRIGHT: Copyright 2001 Frez Systems Limited. All Rights Reserved. ' ' DESCRIPTION: ' Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm, ' as set out in the memo RFC1321. ' ' This class is used to generate an MD5 'digest' or 'signature' of a string. The ' MD5 algorithm is one of the industry standard methods for generating digital ' signatures. It is generically known as a digest, digital signature, one-way ' encryption, hash or checksum algorithm. A common use for MD5 is for password ' encryption as it is one-way in nature, that does not mean that your passwords ' are not free from a dictionary attack. If you are using the ' routine for passwords, you can make it a little more secure by concatenating ' some known random characters to the password before you generate the signature ' and on subsequent tests, so even if a hacker knows you are using MD5 for ' your passwords, the random characters will make it harder to dictionary attack. ' ' *** CAUTION *** ' See the comment attached to the MD5 method below regarding use on systems ' with different character sets. ' ' This is 'free' software with the following restrictions: ' ' You may not redistribute this code as a 'sample' or 'demo'. However, you are free ' to use the source code in your own code, but you may not claim that you created ' the sample code. It is expressly forbidden to sell or profit from this source code ' other than by the knowledge gained or the enhanced value added by your own code. ' ' Use of this software is also done so at your own risk. The code is supplied as ' is without warranty or guarantee of any kind. ' ' Should you wish to commission some derivative work based on this code provided ' here, or any consultancy work, please do not hesitate to contact us. ' ' Web Site: http://www.frez.co.uk ' E-mail: sales@frez.co.uk ' ' MODIFICATION HISTORY: ' 1.0 16-Feb-2001 ' Phil Fresle ' Initial Version '*******************************************************************************     Private Const BITS_TO_A_BYTE As Long = 8 Private Const BYTES_TO_A_WORD As Long = 4 Private Const BITS_TO_A_WORD As Long = BYTES_TO_A_WORD * BITS_TO_A_BYTE   Private m_lOnBits(0 To 30) As Long Private m_l2Power(0 To 30) As Long   '******************************************************************************* ' Class_Initialize (SUB) ' ' DESCRIPTION: ' We will usually get quicker results by preparing arrays of bit patterns and ' powers of 2 ahead of time instead of calculating them every time, unless of ' course the methods are only ever getting called once per instantiation of the ' class. '******************************************************************************* Private Sub Class_Initialize() ' Could have done this with a loop calculating each value, but simply ' assigning the values is quicker - BITS SET FROM RIGHT m_lOnBits(0) = 1 ' 00000000000000000000000000000001 m_lOnBits(1) = 3 ' 00000000000000000000000000000011 m_lOnBits(2) = 7 ' 00000000000000000000000000000111 m_lOnBits(3) = 15 ' 00000000000000000000000000001111 m_lOnBits(4) = 31 ' 00000000000000000000000000011111 m_lOnBits(5) = 63 ' 00000000000000000000000000111111 m_lOnBits(6) = 127 ' 00000000000000000000000001111111 m_lOnBits(7) = 255 ' 00000000000000000000000011111111 m_lOnBits(8) = 511 ' 00000000000000000000000111111111 m_lOnBits(9) = 1023 ' 00000000000000000000001111111111 m_lOnBits(10) = 2047 ' 00000000000000000000011111111111 m_lOnBits(11) = 4095 ' 00000000000000000000111111111111 m_lOnBits(12) = 8191 ' 00000000000000000001111111111111 m_lOnBits(13) = 16383 ' 00000000000000000011111111111111 m_lOnBits(14) = 32767 ' 00000000000000000111111111111111 m_lOnBits(15) = 65535 ' 00000000000000001111111111111111 m_lOnBits(16) = 131071 ' 00000000000000011111111111111111 m_lOnBits(17) = 262143 ' 00000000000000111111111111111111 m_lOnBits(18) = 524287 ' 00000000000001111111111111111111 m_lOnBits(19) = 1048575 ' 00000000000011111111111111111111 m_lOnBits(20) = 2097151 ' 00000000000111111111111111111111 m_lOnBits(21) = 4194303 ' 00000000001111111111111111111111 m_lOnBits(22) = 8388607 ' 00000000011111111111111111111111 m_lOnBits(23) = 16777215 ' 00000000111111111111111111111111 m_lOnBits(24) = 33554431 ' 00000001111111111111111111111111 m_lOnBits(25) = 67108863 ' 00000011111111111111111111111111 m_lOnBits(26) = 134217727 ' 00000111111111111111111111111111 m_lOnBits(27) = 268435455 ' 00001111111111111111111111111111 m_lOnBits(28) = 536870911 ' 00011111111111111111111111111111 m_lOnBits(29) = 1073741823 ' 00111111111111111111111111111111 m_lOnBits(30) = 2147483647 ' 01111111111111111111111111111111   ' Could have done this with a loop calculating each value, but simply ' assigning the values is quicker - POWERS OF 2 m_l2Power(0) = 1 ' 00000000000000000000000000000001 m_l2Power(1) = 2 ' 00000000000000000000000000000010 m_l2Power(2) = 4 ' 00000000000000000000000000000100 m_l2Power(3) = 8 ' 00000000000000000000000000001000 m_l2Power(4) = 16 ' 00000000000000000000000000010000 m_l2Power(5) = 32 ' 00000000000000000000000000100000 m_l2Power(6) = 64 ' 00000000000000000000000001000000 m_l2Power(7) = 128 ' 00000000000000000000000010000000 m_l2Power(8) = 256 ' 00000000000000000000000100000000 m_l2Power(9) = 512 ' 00000000000000000000001000000000 m_l2Power(10) = 1024 ' 00000000000000000000010000000000 m_l2Power(11) = 2048 ' 00000000000000000000100000000000 m_l2Power(12) = 4096 ' 00000000000000000001000000000000 m_l2Power(13) = 8192 ' 00000000000000000010000000000000 m_l2Power(14) = 16384 ' 00000000000000000100000000000000 m_l2Power(15) = 32768 ' 00000000000000001000000000000000 m_l2Power(16) = 65536 ' 00000000000000010000000000000000 m_l2Power(17) = 131072 ' 00000000000000100000000000000000 m_l2Power(18) = 262144 ' 00000000000001000000000000000000 m_l2Power(19) = 524288 ' 00000000000010000000000000000000 m_l2Power(20) = 1048576 ' 00000000000100000000000000000000 m_l2Power(21) = 2097152 ' 00000000001000000000000000000000 m_l2Power(22) = 4194304 ' 00000000010000000000000000000000 m_l2Power(23) = 8388608 ' 00000000100000000000000000000000 m_l2Power(24) = 16777216 ' 00000001000000000000000000000000 m_l2Power(25) = 33554432 ' 00000010000000000000000000000000 m_l2Power(26) = 67108864 ' 00000100000000000000000000000000 m_l2Power(27) = 134217728 ' 00001000000000000000000000000000 m_l2Power(28) = 268435456 ' 00010000000000000000000000000000 m_l2Power(29) = 536870912 ' 00100000000000000000000000000000 m_l2Power(30) = 1073741824 ' 01000000000000000000000000000000 End Sub   '******************************************************************************* ' LShift (FUNCTION) ' ' PARAMETERS: ' (In) - lValue - Long - The value to be shifted ' (In) - iShiftBits - Integer - The number of bits to shift the value by ' ' RETURN VALUE: ' Long - The shifted long integer ' ' DESCRIPTION: ' A left shift takes all the set binary bits and moves them left, in-filling ' with zeros in the vacated bits on the right. This function is equivalent to ' the << operator in Java and C++ '******************************************************************************* Private Function LShift(ByVal lValue As Long, _ ByVal iShiftBits As Integer) As Long ' NOTE: If you can guarantee that the Shift parameter will be in the ' range 1 to 30 you can safely strip of this first nested if structure for ' speed. ' ' A shift of zero is no shift at all. If iShiftBits = 0 Then LShift = lValue Exit Function   ' A shift of 31 will result in the right most bit becoming the left most ' bit and all other bits being cleared ElseIf iShiftBits = 31 Then If lValue And 1 Then LShift = &H80000000 Else LShift = 0 End If Exit Function   ' A shift of less than zero or more than 31 is undefined ElseIf iShiftBits < 0 Or iShiftBits > 31 Then err.Raise 6 End If   ' If the left most bit that remains will end up in the negative bit ' position (&H80000000) we would end up with an overflow if we took the ' standard route. We need to strip the left most bit and add it back ' afterwards. If (lValue And m_l2Power(31 - iShiftBits)) Then   ' (Value And OnBits(31 - (Shift + 1))) chops off the left most bits that ' we are shifting into, but also the left most bit we still want as this ' is going to end up in the negative bit marker position (&H80000000). ' After the multiplication/shift we Or the result with &H80000000 to ' turn the negative bit on. LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * _ m_l2Power(iShiftBits)) Or &H80000000   Else   ' (Value And OnBits(31-Shift)) chops off the left most bits that we are ' shifting into so we do not get an overflow error when we do the ' multiplication/shift LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * _ m_l2Power(iShiftBits))   End If End Function   '******************************************************************************* ' RShift (FUNCTION) ' ' PARAMETERS: ' (In) - lValue - Long - The value to be shifted ' (In) - iShiftBits - Integer - The number of bits to shift the value by ' ' RETURN VALUE: ' Long - The shifted long integer ' ' DESCRIPTION: ' The right shift of an unsigned long integer involves shifting all the set bits ' to the right and in-filling on the left with zeros. This function is ' equivalent to the >>> operator in Java or the >> operator in C++ when used on ' an unsigned long. '******************************************************************************* Private Function RShift(ByVal lValue As Long, _ ByVal iShiftBits As Integer) As Long   ' NOTE: If you can guarantee that the Shift parameter will be in the ' range 1 to 30 you can safely strip of this first nested if structure for ' speed. ' ' A shift of zero is no shift at all If iShiftBits = 0 Then RShift = lValue Exit Function   ' A shift of 31 will clear all bits and move the left most bit to the right ' most bit position ElseIf iShiftBits = 31 Then If lValue And &H80000000 Then RShift = 1 Else RShift = 0 End If Exit Function   ' A shift of less than zero or more than 31 is undefined ElseIf iShiftBits < 0 Or iShiftBits > 31 Then err.Raise 6 End If   ' We do not care about the top most bit or the final bit, the top most bit ' will be taken into account in the next stage, the final bit (whether it ' is an odd number or not) is being shifted into, so we do not give a jot ' about it RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)   ' If the top most bit (&H80000000) was set we need to do things differently ' as in a normal VB signed long integer the top most bit is used to indicate ' the sign of the number, when it is set it is a negative number, so just ' deviding by a factor of 2 as above would not work. ' NOTE: (lValue And &H80000000) is equivalent to (lValue < 0), you could ' get a very marginal speed improvement by changing the test to (lValue < 0) If (lValue And &H80000000) Then ' We take the value computed so far, and then add the left most negative ' bit after it has been shifted to the right the appropriate number of ' places RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1))) End If End Function   '******************************************************************************* ' RShiftSigned (FUNCTION) ' ' PARAMETERS: ' (In) - lValue - Long - ' (In) - iShiftBits - Integer - ' ' RETURN VALUE: ' Long - ' ' DESCRIPTION: ' The right shift of a signed long integer involves shifting all the set bits to ' the right and in-filling on the left with the sign bit (0 if positive, 1 if ' negative. This function is equivalent to the >> operator in Java or the >> ' operator in C++ when used on a signed long integer. Not used in this class, ' but included for completeness. '******************************************************************************* Private Function RShiftSigned(ByVal lValue As Long, _ ByVal iShiftBits As Integer) As Long   ' NOTE: If you can guarantee that the Shift parameter will be in the ' range 1 to 30 you can safely strip of this first nested if structure for ' speed. ' ' A shift of zero is no shift at all If iShiftBits = 0 Then RShiftSigned = lValue Exit Function   ' A shift of 31 will clear all bits if the left most bit was zero, and will ' set all bits if the left most bit was 1 (a negative indicator) ElseIf iShiftBits = 31 Then   ' NOTE: (lValue And &H80000000) is equivalent to (lValue < 0), you ' could get a very marginal speed improvement by changing the test to ' (lValue < 0) If (lValue And &H80000000) Then RShiftSigned = -1 Else RShiftSigned = 0 End If Exit Function   ' A shift of less than zero or more than 31 is undefined ElseIf iShiftBits < 0 Or iShiftBits > 31 Then err.Raise 6 End If   ' We get the same result by dividing by the appropriate power of 2 and ' rounding in the negative direction RShiftSigned = Int(lValue / m_l2Power(iShiftBits)) End Function   '******************************************************************************* ' RotateLeft (FUNCTION) ' ' PARAMETERS: ' (In) - lValue - Long - Value to act on ' (In) - iShiftBits - Integer - Bits to move by ' ' RETURN VALUE: ' Long - Result ' ' DESCRIPTION: ' Rotates the bits in a long integer to the left, those bits falling off the ' left edge are put back on the right edge '******************************************************************************* Private Function RotateLeft(ByVal lValue As Long, _ ByVal iShiftBits As Integer) As Long RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits)) End Function   '******************************************************************************* ' AddUnsigned (FUNCTION) ' ' PARAMETERS: ' (In) - lX - Long - First value ' (In) - lY - Long - Second value ' ' RETURN VALUE: ' Long - Result ' ' DESCRIPTION: ' Adds two potentially large unsigned numbers without overflowing '******************************************************************************* Private Function AddUnsigned(ByVal lX As Long, _ ByVal lY As Long) As Long Dim lX4 As Long Dim lY4 As Long Dim lX8 As Long Dim lY8 As Long Dim lResult As Long   lX8 = lX And &H80000000 lY8 = lY And &H80000000 lX4 = lX And &H40000000 lY4 = lY And &H40000000   lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)   If lX4 And lY4 Then lResult = lResult Xor &H80000000 Xor lX8 Xor lY8 ElseIf lX4 Or lY4 Then If lResult And &H40000000 Then lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8 Else lResult = lResult Xor &H40000000 Xor lX8 Xor lY8 End If Else lResult = lResult Xor lX8 Xor lY8 End If   AddUnsigned = lResult End Function   '******************************************************************************* ' F (FUNCTION) ' ' DESCRIPTION: ' MD5's F function '******************************************************************************* Private Function f(ByVal x As Long, _ ByVal y As Long, _ ByVal z As Long) As Long f = (x And y) Or ((Not x) And z) End Function   '******************************************************************************* ' G (FUNCTION) ' ' DESCRIPTION: ' MD5's G function '******************************************************************************* Private Function G(ByVal x As Long, _ ByVal y As Long, _ ByVal z As Long) As Long G = (x And z) Or (y And (Not z)) End Function   '******************************************************************************* ' H (FUNCTION) ' ' DESCRIPTION: ' MD5's H function '******************************************************************************* Private Function H(ByVal x As Long, _ ByVal y As Long, _ ByVal z As Long) As Long H = (x Xor y Xor z) End Function   '******************************************************************************* ' I (FUNCTION) ' ' DESCRIPTION: ' MD5's I function '******************************************************************************* Private Function i(ByVal x As Long, _ ByVal y As Long, _ ByVal z As Long) As Long i = (y Xor (x Or (Not z))) End Function   '******************************************************************************* ' FF (SUB) ' ' DESCRIPTION: ' MD5's FF procedure '******************************************************************************* Private Sub FF(a As Long, _ ByVal b As Long, _ ByVal c As Long, _ ByVal d As Long, _ ByVal x As Long, _ ByVal s As Long, _ ByVal ac As Long) a = AddUnsigned(a, AddUnsigned(AddUnsigned(f(b, c, d), x), ac)) a = RotateLeft(a, s) a = AddUnsigned(a, b) End Sub   '******************************************************************************* ' GG (SUB) ' ' DESCRIPTION: ' MD5's GG procedure '******************************************************************************* Private Sub GG(a As Long, _ ByVal b As Long, _ ByVal c As Long, _ ByVal d As Long, _ ByVal x As Long, _ ByVal s As Long, _ ByVal ac As Long) a = AddUnsigned(a, AddUnsigned(AddUnsigned(G(b, c, d), x), ac)) a = RotateLeft(a, s) a = AddUnsigned(a, b) End Sub   '******************************************************************************* ' HH (SUB) ' ' DESCRIPTION: ' MD5's HH procedure '******************************************************************************* Private Sub HH(a As Long, _ ByVal b As Long, _ ByVal c As Long, _ ByVal d As Long, _ ByVal x As Long, _ ByVal s As Long, _ ByVal ac As Long) a = AddUnsigned(a, AddUnsigned(AddUnsigned(H(b, c, d), x), ac)) a = RotateLeft(a, s) a = AddUnsigned(a, b) End Sub   '******************************************************************************* ' II (SUB) ' ' DESCRIPTION: ' MD5's II procedure '******************************************************************************* Private Sub II(a As Long, _ ByVal b As Long, _ ByVal c As Long, _ ByVal d As Long, _ ByVal x As Long, _ ByVal s As Long, _ ByVal ac As Long) a = AddUnsigned(a, AddUnsigned(AddUnsigned(i(b, c, d), x), ac)) a = RotateLeft(a, s) a = AddUnsigned(a, b) End Sub   '******************************************************************************* ' ConvertToWordArray (FUNCTION) ' ' PARAMETERS: ' (In/Out) - sMessage - String - String message ' ' RETURN VALUE: ' Long() - Converted message as long array ' ' DESCRIPTION: ' Takes the string message and puts it in a long array with padding according to ' the MD5 rules. '******************************************************************************* Private Function ConvertToWordArray(sMessage As String) As Long() Dim lMessageLength As Long Dim lNumberOfWords As Long Dim lWordArray() As Long Dim lBytePosition As Long Dim lByteCount As Long Dim lWordCount As Long   Const MODULUS_BITS As Long = 512 Const CONGRUENT_BITS As Long = 448   lMessageLength = Len(sMessage)   ' Get padded number of words. Message needs to be congruent to 448 bits, ' modulo 512 bits. If it is exactly congruent to 448 bits, modulo 512 bits ' it must still have another 512 bits added. 512 bits = 64 bytes ' (or 16 * 4 byte words), 448 bits = 56 bytes. This means lMessageSize must ' be a multiple of 16 (i.e. 16 * 4 (bytes) * 8 (bits)) lNumberOfWords = (((lMessageLength + _ ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ _ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * _ (MODULUS_BITS \ BITS_TO_A_WORD) ReDim lWordArray(lNumberOfWords - 1)   ' Combine each block of 4 bytes (ascii code of character) into one long ' value and store in the message. The high-order (most significant) bit of ' each byte is listed first. However, the low-order (least significant) byte ' is given first in each word. lBytePosition = 0 lByteCount = 0 Do Until lByteCount >= lMessageLength ' Each word is 4 bytes lWordCount = lByteCount \ BYTES_TO_A_WORD   ' The bytes are put in the word from the right most edge lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE lWordArray(lWordCount) = lWordArray(lWordCount) Or _ LShift(AscB(Mid(sMessage, lByteCount + 1, 1)), lBytePosition) lByteCount = lByteCount + 1 Loop   ' Terminate according to MD5 rules with a 1 bit, zeros and the length in ' bits stored in the last two words lWordCount = lByteCount \ BYTES_TO_A_WORD lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE   ' Add a terminating 1 bit, all the rest of the bits to the end of the ' word array will default to zero lWordArray(lWordCount) = lWordArray(lWordCount) Or _ LShift(&H80, lBytePosition)   ' We put the length of the message in bits into the last two words, to get ' the length in bits we need to multiply by 8 (or left shift 3). This left ' shifted value is put in the first word. Any bits shifted off the left edge ' need to be put in the second word, we can work out which bits by shifting ' right the length by 29 bits. lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3) lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)   ConvertToWordArray = lWordArray End Function   '******************************************************************************* ' WordToHex (FUNCTION) ' ' PARAMETERS: ' (In) - lValue - Long - Long value to convert ' ' RETURN VALUE: ' String - Hex value to return ' ' DESCRIPTION: ' Takes a long integer and due to the bytes reverse order it extracts the ' individual bytes and converts them to hex appending them for an overall hex ' value '******************************************************************************* Private Function WordToHex(ByVal lValue As Long) As String Dim lByte As Long Dim lCount As Long   For lCount = 0 To 3 lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And _ m_lOnBits(BITS_TO_A_BYTE - 1) WordToHex = WordToHex & Right("0" & Hex(lByte), 2) Next End Function   '******************************************************************************* ' MD5 (FUNCTION) ' ' PARAMETERS: ' (In/Out) - sMessage - String - String to be digested ' ' RETURN VALUE: ' String - The MD5 digest ' ' DESCRIPTION: ' This function takes a string message and generates an MD5 digest for it. ' sMessage can be up to the VB string length limit of 2^31 (approx. 2 billion) ' characters. ' ' NOTE: Due to the way in which the string is processed the routine assumes a ' single byte character set. VB passes unicode (2-byte) character strings, the ' ConvertToWordArray function uses on the first byte for each character. This ' has been done this way for ease of use, to make the routine truely portable ' you could accept a byte array instead, it would then be up to the calling ' routine to make sure that the byte array is generated from their string in ' a manner consistent with the string type. '******************************************************************************* Public Function md5(sMessage As String) As String Dim x() As Long Dim k As Long Dim AA As Long Dim BB As Long Dim cc As Long Dim DD As Long Dim a As Long Dim b As Long Dim c As Long Dim d As Long   Const S11 As Long = 7 Const S12 As Long = 12 Const S13 As Long = 17 Const S14 As Long = 22 Const S21 As Long = 5 Const S22 As Long = 9 Const S23 As Long = 14 Const S24 As Long = 20 Const S31 As Long = 4 Const S32 As Long = 11 Const S33 As Long = 16 Const S34 As Long = 23 Const S41 As Long = 6 Const S42 As Long = 10 Const S43 As Long = 15 Const S44 As Long = 21   ' Steps 1 and 2. Append padding bits and length and convert to words x = ConvertToWordArray(sMessage)   ' Step 3. Initialise a = &H67452301 b = &HEFCDAB89 c = &H98BADCFE d = &H10325476   ' Step 4. Process the message in 16-word blocks For k = 0 To UBound(x) Step 16 AA = a BB = b cc = c DD = d   ' The hex number on the end of each of the following procedure calls is ' an element from the 64 element table constructed with ' T(i) = Int(4294967296 * Abs(Sin(i))) where i is 1 to 64. ' ' However, for speed we don't want to calculate the value every time. FF a, b, c, d, x(k + 0), S11, &HD76AA478 FF d, a, b, c, x(k + 1), S12, &HE8C7B756 FF c, d, a, b, x(k + 2), S13, &H242070DB FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE FF a, b, c, d, x(k + 4), S11, &HF57C0FAF FF d, a, b, c, x(k + 5), S12, &H4787C62A FF c, d, a, b, x(k + 6), S13, &HA8304613 FF b, c, d, a, x(k + 7), S14, &HFD469501 FF a, b, c, d, x(k + 8), S11, &H698098D8 FF d, a, b, c, x(k + 9), S12, &H8B44F7AF FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1 FF b, c, d, a, x(k + 11), S14, &H895CD7BE FF a, b, c, d, x(k + 12), S11, &H6B901122 FF d, a, b, c, x(k + 13), S12, &HFD987193 FF c, d, a, b, x(k + 14), S13, &HA679438E FF b, c, d, a, x(k + 15), S14, &H49B40821   GG a, b, c, d, x(k + 1), S21, &HF61E2562 GG d, a, b, c, x(k + 6), S22, &HC040B340 GG c, d, a, b, x(k + 11), S23, &H265E5A51 GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA GG a, b, c, d, x(k + 5), S21, &HD62F105D GG d, a, b, c, x(k + 10), S22, &H2441453 GG c, d, a, b, x(k + 15), S23, &HD8A1E681 GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8 GG a, b, c, d, x(k + 9), S21, &H21E1CDE6 GG d, a, b, c, x(k + 14), S22, &HC33707D6 GG c, d, a, b, x(k + 3), S23, &HF4D50D87 GG b, c, d, a, x(k + 8), S24, &H455A14ED GG a, b, c, d, x(k + 13), S21, &HA9E3E905 GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8 GG c, d, a, b, x(k + 7), S23, &H676F02D9 GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A   HH a, b, c, d, x(k + 5), S31, &HFFFA3942 HH d, a, b, c, x(k + 8), S32, &H8771F681 HH c, d, a, b, x(k + 11), S33, &H6D9D6122 HH b, c, d, a, x(k + 14), S34, &HFDE5380C HH a, b, c, d, x(k + 1), S31, &HA4BEEA44 HH d, a, b, c, x(k + 4), S32, &H4BDECFA9 HH c, d, a, b, x(k + 7), S33, &HF6BB4B60 HH b, c, d, a, x(k + 10), S34, &HBEBFBC70 HH a, b, c, d, x(k + 13), S31, &H289B7EC6 HH d, a, b, c, x(k + 0), S32, &HEAA127FA HH c, d, a, b, x(k + 3), S33, &HD4EF3085 HH b, c, d, a, x(k + 6), S34, &H4881D05 HH a, b, c, d, x(k + 9), S31, &HD9D4D039 HH d, a, b, c, x(k + 12), S32, &HE6DB99E5 HH c, d, a, b, x(k + 15), S33, &H1FA27CF8 HH b, c, d, a, x(k + 2), S34, &HC4AC5665   II a, b, c, d, x(k + 0), S41, &HF4292244 II d, a, b, c, x(k + 7), S42, &H432AFF97 II c, d, a, b, x(k + 14), S43, &HAB9423A7 II b, c, d, a, x(k + 5), S44, &HFC93A039 II a, b, c, d, x(k + 12), S41, &H655B59C3 II d, a, b, c, x(k + 3), S42, &H8F0CCC92 II c, d, a, b, x(k + 10), S43, &HFFEFF47D II b, c, d, a, x(k + 1), S44, &H85845DD1 II a, b, c, d, x(k + 8), S41, &H6FA87E4F II d, a, b, c, x(k + 15), S42, &HFE2CE6E0 II c, d, a, b, x(k + 6), S43, &HA3014314 II b, c, d, a, x(k + 13), S44, &H4E0811A1 II a, b, c, d, x(k + 4), S41, &HF7537E82 II d, a, b, c, x(k + 11), S42, &HBD3AF235 II c, d, a, b, x(k + 2), S43, &H2AD7D2BB II b, c, d, a, x(k + 9), S44, &HEB86D391   a = AddUnsigned(a, AA) b = AddUnsigned(b, BB) c = AddUnsigned(c, cc) d = AddUnsigned(d, DD) Next   ' Step 5. Output the 128 bit digest md5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d)) End Function

---

Et l'appel ce fait simplement :

Code:

---

1 2 3 4

Dim cmd5 As New Classe_MD5   mot_de_passe_crypté=cmd5.md5(mot_de_passe_en_clair)

---

Merci monsieur Donat avec ce jyaux votre retard ne peut être que pardonné.J'ai recu la fonction et je vais l'essayer j'avoue qu'elle est efrayante mais c'est cela la programmation rien ne doit nous arrêter et tout doit être bien fait pour une satisfaction personnelle d'abord.Merci encore.

Je remonte un post qui commence à dater juste histoire de dire que ca marche nikel du premier coup, et également pour remercier Gaël Donat!

Incroyable qu'une fonction aussi utile ne soit pas disponible sans réimplémentation! 8O