├── .gitignore ├── .gitmodules ├── BCrypt.pas ├── CHANGELOG.md ├── LICENSE ├── README.md ├── docs ├── bcrypt │ ├── bcrypt_default_cost.html │ ├── bcrypt_salt_len.html │ ├── blowfish_num_rounds.html │ ├── bsdbase64decodetable.html │ ├── bsdbase64encodetable.html │ ├── ehash-1.html │ ├── ehash-2.html │ ├── ehash-3.html │ ├── ehash-4.html │ ├── ehash-5.html │ ├── ehash-6.html │ ├── ehash.html │ ├── index-2.html │ ├── index-3.html │ ├── index-4.html │ ├── index-8.html │ ├── index.html │ ├── magictext.html │ ├── pboxorg.html │ ├── rtpasswordinformation-1.html │ ├── rtpasswordinformation-2.html │ ├── rtpasswordinformation-3.html │ ├── rtpasswordinformation-4.html │ ├── rtpasswordinformation-5.html │ ├── rtpasswordinformation-6.html │ ├── rtpasswordinformation.algo.html │ ├── rtpasswordinformation.algoname.html │ ├── rtpasswordinformation.bcrypthash.html │ ├── rtpasswordinformation.bcryptsalt.html │ ├── rtpasswordinformation.cost.html │ ├── rtpasswordinformation.html │ ├── sboxorg.html │ ├── tbcrypthash-1.html │ ├── tbcrypthash-2.html │ ├── tbcrypthash-3.html │ ├── tbcrypthash-4.html │ ├── tbcrypthash-5.html │ ├── tbcrypthash-6.html │ ├── tbcrypthash.create.html │ ├── tbcrypthash.createhash.html │ ├── tbcrypthash.destroy.html │ ├── tbcrypthash.hashgetinfo.html │ ├── tbcrypthash.html │ ├── tbcrypthash.needsrehash.html │ ├── tbcrypthash.verifyhash.html │ └── thashtypes.html ├── fpdoc.css ├── index-8.html ├── index-9.html ├── index.html ├── minus.png ├── plus.png └── tree.xml └── tests ├── BCryptHashTest.pas └── PHPBCryptTest.php /.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.ppu 3 | *~ 4 | .idea/ 5 | *.iml 6 | 7 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "renegade_random"] 2 | path = renegade_random 3 | url = https://github.com/renegadebbs/renegade_random.git 4 | [submodule "Renegade.Random"] 5 | path = Renegade.Random 6 | url = https://github.com/renegadebbs/Renegade.Random.git 7 | -------------------------------------------------------------------------------- /BCrypt.pas: -------------------------------------------------------------------------------- 1 | {** 2 | * 3 | * This file is part of the RenegadeBBS project. 4 | * 5 | * sikofitt 6 | * 7 | * For the full copyright and license information, 8 | * pleave view the LICENSE file that was distributed 9 | * with this source code. 10 | * 11 | *} 12 | unit BCrypt; 13 | {$mode objfpc}{$H+} 14 | {$CODEPAGE UTF-8} 15 | 16 | interface 17 | 18 | uses 19 | sysutils, 20 | classes 21 | ; 22 | 23 | 24 | 25 | const 26 | // bcrypt uses 128-bit (16-byte) salt 27 | BCRYPT_SALT_LEN = 16; 28 | BLOWFISH_NUM_ROUNDS = 16; 29 | BCRYPT_DEFAULT_COST = 12; 30 | 31 | PBoxOrg: array[0..17] of DWord = ( 32 | $243f6a88, $85a308d3, $13198a2e, $03707344, $a4093822, $299f31d0, $082efa98, 33 | $ec4e6c89, $452821e6, $38d01377, $be5466cf, $34e90c6c, $c0ac29b7, $c97c50dd, 34 | $3f84d5b5, $b5470917, $9216d5d9, $8979fb1b 35 | ); 36 | 37 | SBoxOrg: array[0..1023] of DWord = ( 38 | $d1310ba6, $98dfb5ac, $2ffd72db, $d01adfb7, $b8e1afed, $6a267e96, $ba7c9045, 39 | $f12c7f99, $24a19947, $b3916cf7, $0801f2e2, $858efc16, $636920d8, $71574e69, 40 | $a458fea3, $f4933d7e, $0d95748f, $728eb658, $718bcd58, $82154aee, $7b54a41d, 41 | $c25a59b5, $9c30d539, $2af26013, $c5d1b023, $286085f0, $ca417918, $b8db38ef, 42 | $8e79dcb0, $603a180e, $6c9e0e8b, $b01e8a3e, $d71577c1, $bd314b27, $78af2fda, 43 | $55605c60, $e65525f3, $aa55ab94, $57489862, $63e81440, $55ca396a, $2aab10b6, 44 | $b4cc5c34, $1141e8ce, $a15486af, $7c72e993, $b3ee1411, $636fbc2a, $2ba9c55d, 45 | $741831f6, $ce5c3e16, $9b87931e, $afd6ba33, $6c24cf5c, $7a325381, $28958677, 46 | $3b8f4898, $6b4bb9af, $c4bfe81b, $66282193, $61d809cc, $fb21a991, $487cac60, 47 | $5dec8032, $ef845d5d, $e98575b1, $dc262302, $eb651b88, $23893e81, $d396acc5, 48 | $0f6d6ff3, $83f44239, $2e0b4482, $a4842004, $69c8f04a, $9e1f9b5e, $21c66842, 49 | $f6e96c9a, $670c9c61, $abd388f0, $6a51a0d2, $d8542f68, $960fa728, $ab5133a3, 50 | $6eef0b6c, $137a3be4, $ba3bf050, $7efb2a98, $a1f1651d, $39af0176, $66ca593e, 51 | $82430e88, $8cee8619, $456f9fb4, $7d84a5c3, $3b8b5ebe, $e06f75d8, $85c12073, 52 | $401a449f, $56c16aa6, $4ed3aa62, $363f7706, $1bfedf72, $429b023d, $37d0d724, 53 | $d00a1248, $db0fead3, $49f1c09b, $075372c9, $80991b7b, $25d479d8, $f6e8def7, 54 | $e3fe501a, $b6794c3b, $976ce0bd, $04c006ba, $c1a94fb6, $409f60c4, $5e5c9ec2, 55 | $196a2463, $68fb6faf, $3e6c53b5, $1339b2eb, $3b52ec6f, $6dfc511f, $9b30952c, 56 | $cc814544, $af5ebd09, $bee3d004, $de334afd, $660f2807, $192e4bb3, $c0cba857, 57 | $45c8740f, $d20b5f39, $b9d3fbdb, $5579c0bd, $1a60320a, $d6a100c6, $402c7279, 58 | $679f25fe, $fb1fa3cc, $8ea5e9f8, $db3222f8, $3c7516df, $fd616b15, $2f501ec8, 59 | $ad0552ab, $323db5fa, $fd238760, $53317b48, $3e00df82, $9e5c57bb, $ca6f8ca0, 60 | $1a87562e, $df1769db, $d542a8f6, $287effc3, $ac6732c6, $8c4f5573, $695b27b0, 61 | $bbca58c8, $e1ffa35d, $b8f011a0, $10fa3d98, $fd2183b8, $4afcb56c, $2dd1d35b, 62 | $9a53e479, $b6f84565, $d28e49bc, $4bfb9790, $e1ddf2da, $a4cb7e33, $62fb1341, 63 | $cee4c6e8, $ef20cada, $36774c01, $d07e9efe, $2bf11fb4, $95dbda4d, $ae909198, 64 | $eaad8e71, $6b93d5a0, $d08ed1d0, $afc725e0, $8e3c5b2f, $8e7594b7, $8ff6e2fb, 65 | $f2122b64, $8888b812, $900df01c, $4fad5ea0, $688fc31c, $d1cff191, $b3a8c1ad, 66 | $2f2f2218, $be0e1777, $ea752dfe, $8b021fa1, $e5a0cc0f, $b56f74e8, $18acf3d6, 67 | $ce89e299, $b4a84fe0, $fd13e0b7, $7cc43b81, $d2ada8d9, $165fa266, $80957705, 68 | $93cc7314, $211a1477, $e6ad2065, $77b5fa86, $c75442f5, $fb9d35cf, $ebcdaf0c, 69 | $7b3e89a0, $d6411bd3, $ae1e7e49, $00250e2d, $2071b35e, $226800bb, $57b8e0af, 70 | $2464369b, $f009b91e, $5563911d, $59dfa6aa, $78c14389, $d95a537f, $207d5ba2, 71 | $02e5b9c5, $83260376, $6295cfa9, $11c81968, $4e734a41, $b3472dca, $7b14a94a, 72 | $1b510052, $9a532915, $d60f573f, $bc9bc6e4, $2b60a476, $81e67400, $08ba6fb5, 73 | $571be91f, $f296ec6b, $2a0dd915, $b6636521, $e7b9f9b6, $ff34052e, $c5855664, 74 | $53b02d5d, $a99f8fa1, $08ba4799, $6e85076a, $4b7a70e9, $b5b32944, $db75092e, 75 | $c4192623, $ad6ea6b0, $49a7df7d, $9cee60b8, $8fedb266, $ecaa8c71, $699a17ff, 76 | $5664526c, $c2b19ee1, $193602a5, $75094c29, $a0591340, $e4183a3e, $3f54989a, 77 | $5b429d65, $6b8fe4d6, $99f73fd6, $a1d29c07, $efe830f5, $4d2d38e6, $f0255dc1, 78 | $4cdd2086, $8470eb26, $6382e9c6, $021ecc5e, $09686b3f, $3ebaefc9, $3c971814, 79 | $6b6a70a1, $687f3584, $52a0e286, $b79c5305, $aa500737, $3e07841c, $7fdeae5c, 80 | $8e7d44ec, $5716f2b8, $b03ada37, $f0500c0d, $f01c1f04, $0200b3ff, $ae0cf51a, 81 | $3cb574b2, $25837a58, $dc0921bd, $d19113f9, $7ca92ff6, $94324773, $22f54701, 82 | $3ae5e581, $37c2dadc, $c8b57634, $9af3dda7, $a9446146, $0fd0030e, $ecc8c73e, 83 | $a4751e41, $e238cd99, $3bea0e2f, $3280bba1, $183eb331, $4e548b38, $4f6db908, 84 | $6f420d03, $f60a04bf, $2cb81290, $24977c79, $5679b072, $bcaf89af, $de9a771f, 85 | $d9930810, $b38bae12, $dccf3f2e, $5512721f, $2e6b7124, $501adde6, $9f84cd87, 86 | $7a584718, $7408da17, $bc9f9abc, $e94b7d8c, $ec7aec3a, $db851dfa, $63094366, 87 | $c464c3d2, $ef1c1847, $3215d908, $dd433b37, $24c2ba16, $12a14d43, $2a65c451, 88 | $50940002, $133ae4dd, $71dff89e, $10314e55, $81ac77d6, $5f11199b, $043556f1, 89 | $d7a3c76b, $3c11183b, $5924a509, $f28fe6ed, $97f1fbfa, $9ebabf2c, $1e153c6e, 90 | $86e34570, $eae96fb1, $860e5e0a, $5a3e2ab3, $771fe71c, $4e3d06fa, $2965dcb9, 91 | $99e71d0f, $803e89d6, $5266c825, $2e4cc978, $9c10b36a, $c6150eba, $94e2ea78, 92 | $a5fc3c53, $1e0a2df4, $f2f74ea7, $361d2b3d, $1939260f, $19c27960, $5223a708, 93 | $f71312b6, $ebadfe6e, $eac31f66, $e3bc4595, $a67bc883, $b17f37d1, $018cff28, 94 | $c332ddef, $be6c5aa5, $65582185, $68ab9802, $eecea50f, $db2f953b, $2aef7dad, 95 | $5b6e2f84, $1521b628, $29076170, $ecdd4775, $619f1510, $13cca830, $eb61bd96, 96 | $0334fe1e, $aa0363cf, $b5735c90, $4c70a239, $d59e9e0b, $cbaade14, $eecc86bc, 97 | $60622ca7, $9cab5cab, $b2f3846e, $648b1eaf, $19bdf0ca, $a02369b9, $655abb50, 98 | $40685a32, $3c2ab4b3, $319ee9d5, $c021b8f7, $9b540b19, $875fa099, $95f7997e, 99 | $623d7da8, $f837889a, $97e32d77, $11ed935f, $16681281, $0e358829, $c7e61fd6, 100 | $96dedfa1, $7858ba99, $57f584a5, $1b227263, $9b83c3ff, $1ac24696, $cdb30aeb, 101 | $532e3054, $8fd948e4, $6dbc3128, $58ebf2ef, $34c6ffea, $fe28ed61, $ee7c3c73, 102 | $5d4a14d9, $e864b7e3, $42105d14, $203e13e0, $45eee2b6, $a3aaabea, $db6c4f15, 103 | $facb4fd0, $c742f442, $ef6abbb5, $654f3b1d, $41cd2105, $d81e799e, $86854dc7, 104 | $e44b476a, $3d816250, $cf62a1f2, $5b8d2646, $fc8883a0, $c1c7b6a3, $7f1524c3, 105 | $69cb7492, $47848a0b, $5692b285, $095bbf00, $ad19489d, $1462b174, $23820e00, 106 | $58428d2a, $0c55f5ea, $1dadf43e, $233f7061, $3372f092, $8d937e41, $d65fecf1, 107 | $6c223bdb, $7cde3759, $cbee7460, $4085f2a7, $ce77326e, $a6078084, $19f8509e, 108 | $e8efd855, $61d99735, $a969a7aa, $c50c06c2, $5a04abfc, $800bcadc, $9e447a2e, 109 | $c3453484, $fdd56705, $0e1e9ec9, $db73dbd3, $105588cd, $675fda79, $e3674340, 110 | $c5c43465, $713e38d8, $3d28f89e, $f16dff20, $153e21e7, $8fb03d4a, $e6e39f2b, 111 | $db83adf7, $e93d5a68, $948140f7, $f64c261c, $94692934, $411520f7, $7602d4f7, 112 | $bcf46b2e, $d4a20068, $d4082471, $3320f46a, $43b7d4b7, $500061af, $1e39f62e, 113 | $97244546, $14214f74, $bf8b8840, $4d95fc1d, $96b591af, $70f4ddd3, $66a02f45, 114 | $bfbc09ec, $03bd9785, $7fac6dd0, $31cb8504, $96eb27b3, $55fd3941, $da2547e6, 115 | $abca0a9a, $28507825, $530429f4, $0a2c86da, $e9b66dfb, $68dc1462, $d7486900, 116 | $680ec0a4, $27a18dee, $4f3ffea2, $e887ad8c, $b58ce006, $7af4d6b6, $aace1e7c, 117 | $d3375fec, $ce78a399, $406b2a42, $20fe9e35, $d9f385b9, $ee39d7ab, $3b124e8b, 118 | $1dc9faf7, $4b6d1856, $26a36631, $eae397b2, $3a6efa74, $dd5b4332, $6841e7f7, 119 | $ca7820fb, $fb0af54e, $d8feb397, $454056ac, $ba489527, $55533a3a, $20838d87, 120 | $fe6ba9b7, $d096954b, $55a867bc, $a1159a58, $cca92963, $99e1db33, $a62a4a56, 121 | $3f3125f9, $5ef47e1c, $9029317c, $fdf8e802, $04272f70, $80bb155c, $05282ce3, 122 | $95c11548, $e4c66d22, $48c1133f, $c70f86dc, $07f9c9ee, $41041f0f, $404779a4, 123 | $5d886e17, $325f51eb, $d59bc0d1, $f2bcc18f, $41113564, $257b7834, $602a9c60, 124 | $dff8e8a3, $1f636c1b, $0e12b4c2, $02e1329e, $af664fd1, $cad18115, $6b2395e0, 125 | $333e92e1, $3b240b62, $eebeb922, $85b2a20e, $e6ba0d99, $de720c8c, $2da2f728, 126 | $d0127845, $95b794fd, $647d0862, $e7ccf5f0, $5449a36f, $877d48fa, $c39dfd27, 127 | $f33e8d1e, $0a476341, $992eff74, $3a6f6eab, $f4f8fd37, $a812dc60, $a1ebddf8, 128 | $991be14c, $db6e6b0d, $c67b5510, $6d672c37, $2765d43b, $dcd0e804, $f1290dc7, 129 | $cc00ffa3, $b5390f92, $690fed0b, $667b9ffb, $cedb7d9c, $a091cf0b, $d9155ea3, 130 | $bb132f88, $515bad24, $7b9479bf, $763bd6eb, $37392eb3, $cc115979, $8026e297, 131 | $f42e312d, $6842ada7, $c66a2b3b, $12754ccc, $782ef11c, $6a124237, $b79251e7, 132 | $06a1bbe6, $4bfb6350, $1a6b1018, $11caedfa, $3d25bdd8, $e2e1c3c9, $44421659, 133 | $0a121386, $d90cec6e, $d5abea2a, $64af674e, $da86a85f, $bebfe988, $64e4c3fe, 134 | $9dbc8057, $f0f7c086, $60787bf8, $6003604d, $d1fd8346, $f6381fb0, $7745ae04, 135 | $d736fccc, $83426b33, $f01eab71, $b0804187, $3c005e5f, $77a057be, $bde8ae24, 136 | $55464299, $bf582e61, $4e58f48f, $f2ddfda2, $f474ef38, $8789bdc2, $5366f9c3, 137 | $c8b38e74, $b475f255, $46fcd9b9, $7aeb2661, $8b1ddf84, $846a0e79, $915f95e2, 138 | $466e598e, $20b45770, $8cd55591, $c902de4c, $b90bace1, $bb8205d0, $11a86248, 139 | $7574a99e, $b77f19b6, $e0a9dc09, $662d09a1, $c4324633, $e85a1f02, $09f0be8c, 140 | $4a99a025, $1d6efe10, $1ab93d1d, $0ba5a4df, $a186f20f, $2868f169, $dcb7da83, 141 | $573906fe, $a1e2ce9b, $4fcd7f52, $50115e01, $a70683fa, $a002b5c4, $0de6d027, 142 | $9af88c27, $773f8641, $c3604c06, $61a806b5, $f0177a28, $c0f586e0, $006058aa, 143 | $30dc7d62, $11e69ed7, $2338ea63, $53c2dd94, $c2c21634, $bbcbee56, $90bcb6de, 144 | $ebfc7da1, $ce591d76, $6f05e409, $4b7c0188, $39720a3d, $7c927c24, $86e3725f, 145 | $724d9db9, $1ac15bb4, $d39eb8fc, $ed545578, $08fca5b5, $d83d7cd3, $4dad0fc4, 146 | $1e50ef5e, $b161e6f8, $a28514d9, $6c51133c, $6fd5c7e7, $56e14ec4, $362abfce, 147 | $ddc6c837, $d79a3234, $92638212, $670efa8e, $406000e0, $3a39ce37, $d3faf5cf, 148 | $abc27737, $5ac52d1b, $5cb0679e, $4fa33742, $d3822740, $99bc9bbe, $d5118e9d, 149 | $bf0f7315, $d62d1c7e, $c700c47b, $b78c1b6b, $21a19045, $b26eb1be, $6a366eb4, 150 | $5748ab2f, $bc946e79, $c6a376d2, $6549c2c8, $530ff8ee, $468dde7d, $d5730a1d, 151 | $4cd04dc6, $2939bbdb, $a9ba4650, $ac9526e8, $be5ee304, $a1fad5f0, $6a2d519a, 152 | $63ef8ce2, $9a86ee22, $c089c2b8, $43242ef6, $a51e03aa, $9cf2d0a4, $83c061ba, 153 | $9be96a4d, $8fe51550, $ba645bd6, $2826a2f9, $a73a3ae1, $4ba99586, $ef5562e9, 154 | $c72fefd3, $f752f7da, $3f046f69, $77fa0a59, $80e4a915, $87b08601, $9b09e6ad, 155 | $3b3ee593, $e990fd5a, $9e34d797, $2cf0b7d9, $022b8b51, $96d5ac3a, $017da67d, 156 | $d1cf3ed6, $7c7d2d28, $1f9f25cf, $adf2b89b, $5ad6b472, $5a88f54c, $e029ac71, 157 | $e019a5e6, $47b0acfd, $ed93fa9b, $e8d3c48d, $283b57cc, $f8d56629, $79132e28, 158 | $785f0191, $ed756055, $f7960e44, $e3d35e8c, $15056dd4, $88f46dba, $03a16125, 159 | $0564f0bd, $c3eb9e15, $3c9057a2, $97271aec, $a93a072a, $1b3f6d9b, $1e6321f5, 160 | $f59c66fb, $26dcf319, $7533d928, $b155fdf5, $03563482, $8aba3cbb, $28517711, 161 | $c20ad9f8, $abcc5167, $ccad925f, $4de81751, $3830dc8e, $379d5862, $9320f991, 162 | $ea7a90c2, $fb3e7bce, $5121ce64, $774fbe32, $a8b6e37e, $c3293d46, $48de5369, 163 | $6413e680, $a2ae0810, $dd6db224, $69852dfd, $09072166, $b39a460a, $6445c0dd, 164 | $586cdecf, $1c20c8ae, $5bbef7dd, $1b588d40, $ccd2017f, $6bb4e3bb, $dda26a7e, 165 | $3a59ff45, $3e350a44, $bcb4cdd5, $72eacea8, $fa6484bb, $8d6612ae, $bf3c6f47, 166 | $d29be463, $542f5d9e, $aec2771b, $f64e6370, $740e0d8d, $e75b1357, $f8721671, 167 | $af537d5d, $4040cb08, $4eb4e2cc, $34d2466a, $0115af84, $e1b00428, $95983a1d, 168 | $06b89fb4, $ce6ea048, $6f3f3b82, $3520ab82, $011a1d4b, $277227f8, $611560b1, 169 | $e7933fdc, $bb3a792b, $344525bd, $a08839e1, $51ce794b, $2f32c9b7, $a01fbac9, 170 | $e01cc87e, $bcc7d1f6, $cf0111c3, $a1e8aac7, $1a908749, $d44fbd9a, $d0dadecb, 171 | $d50ada38, $0339c32a, $c6913667, $8df9317c, $e0b12b4f, $f79e59b7, $43f5bb3a, 172 | $f2d519ff, $27d9459c, $bf97222c, $15e6fc2a, $0f91fc71, $9b941525, $fae59361, 173 | $ceb69ceb, $c2a86459, $12baa8d1, $b6c1075e, $e3056a0c, $10d25065, $cb03a442, 174 | $e0ec6e0e, $1698db3b, $4c98a0be, $3278e964, $9f1f9532, $e0d392df, $d3a0342b, 175 | $8971f21e, $1b0a7441, $4ba3348c, $c5be7120, $c37632d8, $df359f8d, $9b992f2e, 176 | $e60b6f47, $0fe3f11d, $e54cda54, $1edad891, $ce6279cf, $cd3e7e6f, $1618b166, 177 | $fd2c1d05, $848fd2c5, $f6fb2299, $f523f357, $a6327623, $93a83531, $56cccd02, 178 | $acf08162, $5a75ebb5, $6e163697, $88d273cc, $de966292, $81b949d0, $4c50901b, 179 | $71c65614, $e6c6c7bd, $327a140a, $45e1d006, $c3f27b9a, $c9aa53fd, $62a80f00, 180 | $bb25bfe2, $35bdd2f6, $71126905, $b2040222, $b6cbcf7c, $cd769c2b, $53113ec0, 181 | $1640e3d3, $38abbd60, $2547adf0, $ba38209c, $f746ce76, $77afa1c5, $20756060, 182 | $85cbfe4e, $8ae88dd8, $7aaaf9b0, $4cf9aa7e, $1948c25c, $02fb8a8c, $01c36ae4, 183 | $d6ebe1f9, $90d4f869, $a65cdea0, $3f09252d, $c208e69f, $b74e6132, $ce77e25b, 184 | $578fdfe3, $3ac372e6 185 | ); 186 | 187 | MagicText: array[0..5] of DWord = ( 188 | $4f727068, $65616e42, $65686f6c, $64657253, $63727944, $6f756274 189 | ); 190 | 191 | BsdBase64EncodeTable: array[0..63] of char = 192 | { 0:} './' + 193 | { 2:} 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' + 194 | {28:} 'abcdefghijklmnopqrstuvwxyz' + 195 | {54:} '0123456789'; 196 | 197 | BsdBase64DecodeTable: array[#0..#127] of integer = ( 198 | // ________________ 199 | { 0:} -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 200 | // ________________ 201 | { 16:} -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 202 | // ______________./ 203 | { 32:} -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 0, 1, 204 | // 0123456789______ 205 | { 48:} 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, -1, -1, -1, -1, -1, -1, 206 | // _ABCDEFGHIJKLMNO 207 | { 64:} -1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 208 | // PQRSTUVWXYZ_____ 209 | { 80:} 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, -1, -1, -1, -1, -1, 210 | // _abcdefghijklmno 211 | { 96:} -1, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 212 | // pqrstuvwxyz_____ 213 | {113:} 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, -1, -1, -1, -1, -1 214 | ); 215 | 216 | type 217 | THashTypes = (bcDefault, bcPHP, bcBSD, bcUnknown); 218 | RTPasswordInformation = Object 219 | Algo : THashTypes; 220 | Cost : Word; 221 | AlgoName, 222 | BCryptSalt, 223 | BCryptHash : AnsiString; 224 | end; 225 | UTF8String = type AnsiString(CP_UTF8); 226 | 227 | EHash = class(EArgumentException); 228 | 229 | TBCryptHash = class(TObject) 230 | private 231 | FSBox: array[0..1023] of DWord; 232 | FPBox: array[0..17] of DWord; 233 | function BsdBase64Encode(const RawByteData: TBytes; CharacterLength: Sizeint): AnsiString; 234 | function BsdBase64Decode(const EncodedString : AnsiString): TBytes; 235 | function Crypt(const Password : UTF8String; const Salt : AnsiString; Cost : Byte; HashType : THashTypes) : AnsiString; 236 | function CryptRaw(const HashKey, Salt: TBytes; Cost : Byte): TBytes; 237 | procedure EKSKey(const Salt, HashKey: TBytes); 238 | procedure Encipher(var lr: array of DWord; const offset: SizeInt); 239 | function FormatPasswordHash(const Salt, Hash: TBytes; Cost : Byte; HashType : THashTypes): AnsiString; 240 | function getRandomBlockFileName : AnsiString; 241 | procedure InitializeKey(); 242 | function isBSDAlphabet(CurrentCharacter : Char) : Boolean; 243 | function MakeSalt : TBytes; 244 | function MTRandomBytes(NumberOfBytes : SizeUInt) : AnsiString; 245 | procedure NKey(const HashKey: TBytes); 246 | function osHasRandomBlock : Boolean; 247 | function osHasURandomBlock : Boolean; 248 | function ResolveHashType(const HashType : AnsiString) : THashTypes; 249 | function StreamToWord(const RawByteData: TBytes; var offset: SizeInt): DWord; 250 | function UnixRandomBytes(NumberOfBytes : SizeUInt) : AnsiString; 251 | public 252 | constructor Create; overload; 253 | destructor Destroy; override; 254 | function CreateHash(const Password : UTF8String) : AnsiString; overload; 255 | function CreateHash(const Password : UTF8String; HashType : THashTypes) : AnsiString; overload; 256 | function CreateHash(const Password : UTF8String; HashType : THashTypes; Cost : Byte) : AnsiString; overload; 257 | function VerifyHash(const Password : UTF8STring; const Hash : AnsiString) : Boolean; 258 | function NeedsRehash(const BCryptHash : AnsiString) : Boolean; overload; 259 | function NeedsRehash(const BCryptHash : AnsiString; Cost : Byte) : Boolean; overload; 260 | function HashGetInfo(const Hash : AnsiString) : RTPasswordInformation; 261 | end; 262 | 263 | implementation 264 | 265 | Uses 266 | Math; // @Todo : Remove and use Renegade.Random 267 | 268 | constructor TBCryptHash.Create; 269 | begin 270 | 271 | inherited Create; 272 | end; 273 | 274 | destructor TBCryptHash.Destroy; 275 | begin 276 | inherited Destroy; 277 | end; 278 | 279 | function TBCryptHash.BsdBase64Decode(const EncodedString : AnsiString): TBytes; 280 | 281 | function Char64(Character: AnsiChar): Sizeint; 282 | begin 283 | if Ord(Character) > Length(BsdBase64DecodeTable) then 284 | begin 285 | Result := -1; 286 | end 287 | else begin 288 | Result := BsdBase64DecodeTable[Character]; 289 | end; 290 | end; { Char64 } 291 | 292 | procedure Append(Value: Byte); 293 | var 294 | i: SizeUint; 295 | begin 296 | i := Length(Result); 297 | SetLength(Result, i + 1); 298 | Result[i] := Value; 299 | end; { Append } 300 | 301 | var 302 | i, 303 | EncodedStringLength, 304 | c1, c2, c3, c4: Sizeint; 305 | 306 | begin 307 | SetLength(Result, 0); 308 | i := 1; 309 | EncodedStringLength := Length(EncodedString); 310 | while (i < EncodedStringLength) and (Length(Result) < BCRYPT_SALT_LEN) do 311 | begin 312 | c1 := Char64(EncodedString[i]); 313 | Inc(i); 314 | c2 := Char64(EncodedString[i]); 315 | Inc(i); 316 | if (c1 = -1) or (c2 = -1) then 317 | begin 318 | Exit; 319 | end; 320 | 321 | { 322 | Now we have at least one byte in c1|c2 323 | c1 = ..111111 324 | c2 = ..112222 325 | } 326 | Append((c1 shl 2) or ((c2 and $30) shr 4)); 327 | //If there's a 3rd character, then we can use c2|c3 to form the second byte 328 | if (i > EncodedStringLength) or (Length(Result) >= BCRYPT_SALT_LEN) then 329 | begin 330 | Break; 331 | end; 332 | 333 | c3 := Char64(EncodedString[i]); 334 | Inc(i); 335 | if (c3 = -1) then 336 | begin 337 | Exit; 338 | end; 339 | 340 | { 341 | Now we have the next byte in c2|c3 342 | c2 = ..112222 343 | c3 = ..222233 344 | } 345 | Append(((c2 and $0f) shl 4) or ((c3 and $3c) shr 2)); 346 | //If there's a 4th caracter, then we can use c3|c4 to form the third byte 347 | if (i > EncodedStringLength) or (Length(Result) >= BCRYPT_SALT_LEN) then 348 | begin 349 | Break; 350 | end; 351 | 352 | c4 := Char64(EncodedString[i]); 353 | Inc(i); 354 | if c4 = -1 then 355 | begin 356 | Exit; 357 | end; 358 | 359 | { 360 | Now we have the next byte in c3|c4 361 | c3 = ..222233 362 | c4 = ..333333 363 | } 364 | Append(((c3 and $03) shl 6) or c4); 365 | end; { While } 366 | end; { TBCryptHash.BsdBase64Decode } 367 | 368 | function TBCryptHash.BsdBase64Encode(const RawByteData: TBytes; CharacterLength: Sizeint): AnsiString; 369 | var 370 | i, 371 | b1, b2: SizeInt; 372 | begin 373 | Result := ''; 374 | if (CharacterLength <= 0) or (CharacterLength > Length(RawByteData)) then 375 | begin 376 | Exit; 377 | end; 378 | 379 | i := 0; 380 | while i < CharacterLength do 381 | begin 382 | b1 := RawByteData[i] and $ff; 383 | Inc(i); 384 | 385 | Result := Result + BsdBase64EncodeTable[(b1 shr 2) and $3f]; 386 | b1 := (b1 and $03) shl 4; 387 | if i >= CharacterLength then 388 | begin 389 | Result := Result + BsdBase64EncodeTable[b1 and $3f]; 390 | Exit; 391 | end; 392 | 393 | b2 := RawByteData[i] and $ff; 394 | Inc(i); 395 | b1 := b1 or ((b2 shr 4) and $0f); 396 | 397 | Result := Result + BsdBase64EncodeTable[b1 and $3f]; 398 | b1 := (b2 and $0f) shl 2; 399 | if i >= CharacterLength then 400 | begin 401 | Result := Result + BsdBase64EncodeTable[b1 and $3f]; 402 | Exit; 403 | end; 404 | 405 | b2 := RawByteData[i] and $ff; 406 | Inc(i); 407 | b1 := b1 or ((b2 shr 6) and $03); 408 | Result := Result + BsdBase64EncodeTable[b1 and $3f]; 409 | Result := Result + BsdBase64EncodeTable[b2 and $3f]; 410 | end; 411 | end; { TBCryptHash.BsdBase64Encode } 412 | 413 | function TBCryptHash.CryptRaw(const HashKey, Salt: TBytes; Cost : Byte): TBytes; 414 | var 415 | CryptData: array[0..5] of DWord; 416 | CryptLength: integer; 417 | BCryptRounds: DWord; 418 | i, j: SizeInt; 419 | begin 420 | Move(MagicText[0], CryptData[0], Sizeof(MagicText)); 421 | CryptLength := Length(CryptData); 422 | BCryptRounds := 1 shl Cost; 423 | InitializeKey(); 424 | EKSKey(Salt, HashKey); 425 | 426 | for i := 1 to BCryptRounds do 427 | begin 428 | NKey(HashKey); 429 | NKey(Salt); 430 | end; 431 | 432 | for i := 1 to 64 do 433 | begin 434 | for j := 0 to (CryptLength shr 1) - 1 do 435 | begin 436 | Encipher(CryptData, j shl 1); 437 | end; 438 | end; 439 | 440 | SetLength(Result, CryptLength * 4); 441 | j := 0; 442 | for i := 0 to CryptLength - 1 do 443 | begin 444 | Result[j] := (CryptData[i] shr 24) and $FF; 445 | Inc(j); 446 | Result[j] := (CryptData[i] shr 16) and $FF; 447 | Inc(j); 448 | Result[j] := (CryptData[i] shr 8) and $FF; 449 | Inc(j); 450 | Result[j] := CryptData[i] and $FF; 451 | Inc(j); 452 | end; 453 | end; { TBCryptHash.CryptRaw } 454 | 455 | procedure TBCryptHash.EKSKey(const Salt, HashKey: TBytes); 456 | var 457 | lr: array[0..1] of DWord; 458 | i, passwordOffset, saltOffset, PLen, SLen: SizeInt; 459 | begin 460 | passwordOffset := 0; 461 | saltOffset := 0; 462 | PLen := Length(FPBox); 463 | SLen := Length(FSBox); 464 | lr[0] := 0; 465 | lr[1] := 0; 466 | 467 | for i := 0 to PLen - 1 do 468 | begin 469 | FPBox[i] := FPBox[i] xor StreamToWord(HashKey, passwordOffset); 470 | end; 471 | for i := 0 to (PLen div 2) - 1 do 472 | begin 473 | lr[0] := lr[0] xor StreamToWord(Salt, saltOffset); 474 | lr[1] := lr[1] xor StreamToWord(Salt, saltOffset); 475 | Encipher(lr, 0); 476 | FPBox[2 * i] := lr[0]; 477 | FPBox[2 * i + 1] := lr[1]; 478 | end; 479 | for i := 0 to (SLen div 2) - 1 do 480 | begin 481 | lr[0] := lr[0] xor StreamToWord(Salt, saltOffset); 482 | lr[1] := lr[1] xor StreamToWord(Salt, saltOffset); 483 | Encipher(lr, 0); 484 | FSBox[2 * i] := lr[0]; 485 | FSBox[2 * i + 1] := lr[1]; 486 | end; 487 | end; { TBCryptHash.EKSKey } 488 | 489 | procedure TBCryptHash.Encipher(var lr: array of DWord; const offset: SizeInt); 490 | var 491 | i, n, block, r: DWord; 492 | begin 493 | block := lr[offset]; 494 | r := lr[offset + 1]; 495 | block := block xor FPBox[0]; 496 | i := 1; 497 | while i <= BLOWFISH_NUM_ROUNDS - 1 do 498 | begin 499 | n := FSBox[(block shr 24) and $FF]; 500 | n := DWord(n + FSBox[$100 or ((block shr 16) and $FF)]); 501 | n := n xor FSBox[$200 or ((block shr 8) and $FF)]; 502 | n := DWord(n + FSBox[$300 or (block and $FF)]); 503 | r := r xor (n xor FPBox[i]); 504 | Inc(i); 505 | 506 | n := FSBox[(r shr 24) and $FF]; 507 | n := DWord(n + FSBox[$100 or ((r shr 16) and $FF)]); 508 | n := n xor FSBox[$200 or ((r shr 8) and $FF)]; 509 | n := DWord(n + FSBox[$300 or (r and $FF)]); 510 | block := block xor (n xor FPBox[i]); 511 | Inc(i); 512 | end; 513 | lr[offset] := r xor FPBox[BLOWFISH_NUM_ROUNDS + 1]; 514 | lr[offset + 1] := block; 515 | end; 516 | 517 | function TBCryptHash.FormatPasswordHash(const Salt, Hash: TBytes; Cost : Byte; HashType : THashTypes): AnsiString; 518 | var 519 | SaltString: ansistring; 520 | HashString: ansistring; 521 | HashPrefix : AnsiString; 522 | begin 523 | case HashType of 524 | bcBSD : begin 525 | HashPrefix := '2a'; 526 | end; 527 | bcPHP,bcDefault : begin 528 | HashPrefix := '2y'; 529 | end; 530 | end; 531 | SaltString := BsdBase64Encode(Salt, Length(Salt)); 532 | HashString := BsdBase64Encode(Hash, Length(MagicText) * 4 - 1); 533 | Result := Format('$%s$%d$%s%s', [HashPrefix, Cost, SaltString, HashString]); 534 | end; 535 | 536 | function TBCryptHash.getRandomBlockFileName : AnsiString; 537 | var 538 | OSRandomBlockFileName : PAnsiString; 539 | begin 540 | OSRandomBlockFileName := NewStr(Space(12)); 541 | SetLength(OSRandomBlockFileName^, 12); 542 | if osHasURandomBlock then 543 | begin 544 | AssignStr(OSRandomBlockFileName, '/dev/urandom'); 545 | end 546 | else if osHasRandomBlock then 547 | begin 548 | AssignStr(OSRandomBlockFileName,'/dev/random'); 549 | end; 550 | Result := OSRandomBlockFileName^; 551 | DisposeStr(OSRandomBlockFileName); 552 | end; { TBCryptHash.getRandomBlockFileName } 553 | 554 | procedure TBCryptHash.InitializeKey(); 555 | begin 556 | Move(SBoxOrg, FSBox, Sizeof(FSBox)); 557 | Move(PBoxOrg, FPBox, Sizeof(FPBox)); 558 | end; { TBCryptHash.InitializeKey } 559 | 560 | function TBCryptHash.isBSDAlphabet(CurrentCharacter : Char) : Boolean; 561 | begin 562 | Result := CurrentCharacter in ['.','/','a'..'z', 'A'..'Z', '0'..'9']; 563 | end; { TBCryptHash.isBSDAlphabet } 564 | 565 | function TBCryptHash.MTRandomBytes(NumberOfBytes : SizeUInt) : AnsiString; 566 | var 567 | RandomByteString : AnsiString; 568 | Count : SizeUint; 569 | WorkingByte : sizeUInt; 570 | begin 571 | Count := 1; 572 | WorkingByte := 0; 573 | SetLength(RandomByteString, (NumberOfBytes * 2) +1); 574 | 575 | Randomize; 576 | while Count <= (NumberOfBytes * 2) do 577 | begin 578 | { ???: Replace this with internal Windows CryptGenRandom function 579 | when I get ahold of a Windows machine. } 580 | WorkingByte := WorkingByte or RandomRange(1000000, Maxint) xor RandomRange(10000, Maxint); 581 | RandomByteString[Count] := Chr(WorkingByte mod 256); 582 | Inc(Count); 583 | end; 584 | SetLength(RandomByteString, NumberOfBytes); 585 | Result := RandomByteString; 586 | end; { TBCryptHash.MTRandomBytes } 587 | 588 | procedure TBCryptHash.NKey(const HashKey: TBytes); 589 | var 590 | lr: array[0..1] of DWord; 591 | i, passwordOffset, PLen, SLen: SizeInt; 592 | begin 593 | passwordOffset := 0; 594 | PLen := Length(FPBox); 595 | SLen := Length(FSBox); 596 | lr[0] := 0; 597 | lr[1] := 0; 598 | 599 | for i := 0 to PLen - 1 do 600 | begin 601 | FPBox[i] := FPBox[i] xor StreamToWord(HashKey, passwordOffset); 602 | end; 603 | for i := 0 to (PLen div 2) - 1 do 604 | begin 605 | Encipher(lr, 0); 606 | FPBox[2 * i] := lr[0]; 607 | FPBox[2 * i + 1] := lr[1]; 608 | end; 609 | for i := 0 to (SLen div 2) - 1 do 610 | begin 611 | Encipher(lr, 0); 612 | FSBox[2 * i] := lr[0]; 613 | FSBox[2 * i + 1] := lr[1]; 614 | end; 615 | end; { TBCryptHash.NKey } 616 | 617 | function TBCryptHash.osHasRandomBlock : Boolean; 618 | begin 619 | osHasRandomBlock := FileExists('/dev/random'); 620 | end; { TBCryptHash.osHasRandomBlock } 621 | 622 | function TBCryptHash.osHasURandomBlock : Boolean; 623 | begin 624 | osHasURandomBlock := FileExists('/dev/urandom'); 625 | end; { TBCryptHash.osHasURandomBlock } 626 | 627 | function TBCryptHash.MakeSalt : TBytes; 628 | var 629 | ByteArray: TBytes; 630 | RandomTempString : AnsiString; 631 | i : SizeInt; 632 | begin 633 | SetLength(RandomTempString, 17); 634 | SetLength(ByteArray, 16); 635 | {$IFDEF UNIX} 636 | RandomTempString := UnixRandomBytes(BCRYPT_SALT_LEN); 637 | {$ELSE} 638 | Randomize; 639 | RandomTempString := MTRandomBytes(BCRYPT_SALT_LEN); 640 | {$ENDIF} 641 | i := 0; 642 | while i <= Length(RandomTempString) do 643 | begin 644 | ByteArray[i] := Ord(RandomTempString[i+1]); 645 | Inc(i); 646 | end; 647 | SetLength(ByteArray, 16); 648 | Result := ByteArray; 649 | end; 650 | 651 | function TBCryptHash.StreamToWord(const RawByteData: TBytes; var offset: SizeInt): DWord; 652 | var 653 | i: SizeInt; 654 | begin 655 | Result := 0; 656 | for i := 1 to 4 do 657 | begin 658 | Result := (Result shl 8) or (RawByteData[offset] and $FF); 659 | offset := (offset + 1) mod Length(RawByteData); 660 | end; 661 | end; { TBCryptHash.StreamToWord } 662 | 663 | function TBCryptHash.UnixRandomBytes(NumberOfBytes : SizeUInt) : AnsiString; 664 | var 665 | OSRandomBlockFileName : AnsiString; 666 | RandomFileStream : TFileStream; 667 | RandomFileBuffer : AnsiString; 668 | FileBytesRead : SizeUInt; 669 | begin 670 | SetLength(OSRandomBlockFileName, 13); 671 | OSRandomBlockFileName := getRandomBlockFileName; 672 | SetLength(RandomFileBuffer, (NumberOfBytes * 2)); 673 | try 674 | RandomFileStream := TFileStream.Create(OSRandomBlockFileName, fmOpenRead); 675 | RandomFileStream.Position := 0; 676 | FileBytesRead := 1; 677 | 678 | while FileBytesRead <= (NumberOfBytes * 2) do 679 | begin 680 | RandomFileStream.Read(RandomFileBuffer[FileBytesRead], 1); 681 | Inc(FileBytesRead); 682 | end; 683 | except 684 | on E:Exception do 685 | writeln('File : ', OSRandomBlockFileName, ' could not be read or written because: ', E.Message); 686 | end; 687 | 688 | SetLength(RandomFileBuffer, NumberOfBytes); 689 | RandomFileStream.Free; 690 | Result := RandomFileBuffer; 691 | end; { TBCryptHash.unixRandomBytes } 692 | 693 | function TBCryptHash.CreateHash(const Password : UTF8String) : AnsiString; overload; 694 | begin 695 | Result := CreateHash(Password, bcPHP, BCRYPT_DEFAULT_COST); 696 | end; 697 | function TBCryptHash.CreateHash(const Password : UTF8String; HashType : THashTypes) : AnsiString; overload; 698 | begin 699 | Result := CreateHash(Password, HashType, BCRYPT_DEFAULT_COST); 700 | end; { TBCryptHash.CreateHash } 701 | 702 | function TBCryptHash.CreateHash(const Password : UTF8String; HashType : THashTypes; Cost : Byte) : AnsiString; overload; 703 | var 704 | PasswordKey, 705 | SaltBytes, 706 | Hash : TBytes; 707 | begin 708 | if (Cost < 10) or (Cost > 30) then 709 | begin 710 | raise Exception.Create('Invalid value for cost. It must be between 10 and 30.'); 711 | end; 712 | SetLength(PasswordKey, Length(Password) + 1); 713 | Move(Password[1], PasswordKey[0], Length(Password)); 714 | PasswordKey[High(PasswordKey)] := 0; 715 | SaltBytes := MakeSalt; 716 | Hash := CryptRaw(PasswordKey, SaltBytes, Cost); 717 | Result := FormatPasswordHash(SaltBytes, Hash, Cost, HashType); 718 | end; { TBCryptHash.CreateHash } 719 | 720 | function TBCryptHash.Crypt(const Password : UTF8String; const Salt : AnsiString; Cost : Byte; HashType : THashTypes) : AnsiString; 721 | var 722 | PasswordKey, 723 | SaltBytes, 724 | Hash : TBytes; 725 | begin 726 | SetLength(PasswordKey, Length(Password) +1); 727 | Move(Password[1], PasswordKey[0], Length(Password)); 728 | PasswordKey[High(PasswordKey)] := 0; 729 | saltBytes := BsdBase64Decode(Salt); 730 | 731 | Hash := CryptRaw(PasswordKey, SaltBytes, Cost); 732 | Result := FormatPasswordHash(SaltBytes, Hash, Cost, HashType); 733 | end; 734 | 735 | function TBCryptHash.ResolveHashType(const HashType : AnsiString) : THashTypes; 736 | begin 737 | case HashType of 738 | '$2y$': begin 739 | Result := (bcPHP); 740 | end; 741 | '$2a$': begin 742 | Result := (bcBSD); 743 | end; 744 | else 745 | begin 746 | Result := (bcUnknown); 747 | end; 748 | end; 749 | end; 750 | 751 | function TBCryptHash.VerifyHash(const Password : UTF8String; const Hash : AnsiString) : Boolean; 752 | var 753 | WorkingBcryptHash, Salt : AnsiString; 754 | HashCounter, ResultStatus, BCryptCost : Byte; 755 | HashType : THashTypes; 756 | PasswordInfo :RTPasswordInformation; 757 | Begin 758 | ResultStatus := 0; 759 | try 760 | PasswordInfo := HashGetInfo(Hash); 761 | except 762 | on e: EHash do 763 | begin 764 | Result := False; 765 | Exit; 766 | end; 767 | end; 768 | with PasswordInfo do 769 | begin 770 | HashType := Algo; 771 | BCryptCost := Cost; 772 | Salt := BCryptSalt; 773 | end; 774 | WorkingBcryptHash := Crypt(Password, Salt, BCryptCost, HashType); 775 | if (Length(WorkingBcryptHash) < 60) or (Length(WorkingBcryptHash) > 60) then 776 | begin 777 | Result := False; 778 | Exit; 779 | end; 780 | if Length(Hash) <> Length(WorkingBcryptHash) then 781 | begin 782 | Result := False; 783 | Exit; 784 | end; 785 | for HashCounter := 1 to Length(Hash) do 786 | begin 787 | { From ext/standard/password.c php_password_verify line 244 788 | We're using this method instead of = in order to provide 789 | resistance towards timing attacks. This is a constant time 790 | equality check that will always check every byte of both 791 | values. } 792 | ResultStatus := ResultStatus or (ord(WorkingBcryptHash[HashCounter]) xor ord(Hash[HashCounter])); 793 | end; 794 | 795 | Result := (ResultStatus = 0); 796 | 797 | end; 798 | 799 | function TBCryptHash.NeedsRehash(const BCryptHash : AnsiString) : Boolean; overload; 800 | begin 801 | Result := NeedsRehash(BCryptHash, BCRYPT_DEFAULT_COST); 802 | end; 803 | 804 | function TBCryptHash.NeedsRehash(const BCryptHash : AnsiString; Cost : Byte) : Boolean; overload; 805 | var 806 | OldCost: Byte; 807 | begin 808 | OldCost := StrToInt(Copy(BCryptHash, 5, 2)); 809 | if OldCost <> Cost then 810 | begin 811 | Result := True; 812 | end else 813 | begin 814 | Result := False; 815 | end; 816 | end; 817 | 818 | function TBCryptHash.HashGetInfo(const Hash : AnsiString) : RTPasswordInformation; 819 | var 820 | PasswordInfo : RTPasswordInformation; 821 | BCryptCost : Byte; 822 | BCryptHash, 823 | BCryptSalt : AnsiString; 824 | HashType : THashTypes; 825 | begin 826 | if (Length(Hash) < 60) or (Length(Hash) > 60) then 827 | begin 828 | raise EHash.Create(Format(#10#13'Invalid hash %s'#10#13, [Hash])); 829 | Exit; 830 | end; 831 | HashType := ResolveHashType(Copy(Hash, 1, 4)); 832 | BCryptCost := StrToInt(Copy(Hash, 5, 2)); 833 | BCryptSalt := Copy(Hash, 8, 22); 834 | BCryptHash := Copy(Hash, 30, 60); 835 | 836 | PasswordInfo.Algo := HashType; 837 | PasswordInfo.Cost := BCryptCost; 838 | PasswordInfo.AlgoName := 'bcrypt'; 839 | PasswordInfo.BCryptSalt := BCryptSalt; 840 | PasswordInfo.BCryptHash := BCryptHash; 841 | 842 | Result := PasswordInfo; 843 | end; 844 | 845 | end. 846 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Change Log 2 | All notable changes to this project will be documented in this file. 3 | 4 | The format is based on [Keep a Changelog](http://keepachangelog.com/) 5 | and this project adheres to [Semantic Versioning](http://semver.org/). 6 | 7 | 8 | ## [0.1.0] - 2016-11-03 9 | 10 | ### Added 11 | - Changelog 12 | - Started using [semver](http://semver.org/) for versioning. 13 | 14 | ### Changed 15 | - Removed regex logic for getting the password's current salt, because come on. 16 | - Make use of object RTPasswordInformation to extract information from hash for verifing logic. 17 | 18 | 19 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2016 renegadebbs 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Free Pascal BCrypt 2 | 3 | Free Pascal [BCrypt](https://en.wikipedia.org/wiki/Bcrypt "BCrypt") implementation. 4 | 5 | This started because I wanted something that would be compatible with PHP's $2y$ BCrypt hashing. Ultimately there is no difference between the $2a$ algorithm and the $2y$ algorithm. Just the a, and y. But I didn't want to have a wrapper function that replaced the a with the y. 6 | 7 | If you try to verify a $2a$ password with PHP it will verify, but if you run the needs rehash function it will always say it needs a rehash. So I moved this to Free Pascal compatible class format. 8 | 9 | Tested with : 10 | * Free Pascal 11 | * 2.6.4 12 | * Linux 13 | * Gentoo, 2.2-Current-x64 14 | * Raspbian 15 | * 3.0.0 16 | * Linux 17 | * Gentoo, 2.2-Current-x64 18 | * FreeBSD 19 | * 12.0-CURRENT-x64 20 | * Windows 21 | * Windows 10-x64 22 | * 3.1.1 23 | * Linux 24 | * Gentoo, 2.2-Current-x64 25 | 26 | * PHP 27 | * 5.5.x 28 | * 5.5.38-pl0-gentoo 29 | * 5.6.x 30 | * 5.6.20-pl0-gentoo 31 | * 5.6.28-pl0-gentoo 32 | * 7.0.x 33 | * 7.0.6_rc1-pl0-gentoo 34 | * 7.0.13-pl0-gentoo 35 | * 7.x.x (dev) 36 | * 7.2.0-dev-x64 (ZTS) 10/31/2016, Gentoo 2.2 Current 37 | * 7.2.0-dev-x64 (ZTS) 11/02/2016, FreeBSD 12.0-CURRENT 38 | * HHVM 39 | * Soon 40 | 41 | ### Usage 42 | ```pascal 43 | BCrypt.CreateHash(Password); 44 | BCrypt.CreateHash(Password, HashType); 45 | BCrypt.CreateHash(Password, HashType, Cost); 46 | ``` 47 | Where 48 | * Password is the password to be hashed 49 | * HashType is one of bcPHP, bcBSD, or bcDefault, bcPHP is the default $2y$ 50 | * and Cost is a number between 10 and 30, default is 12. 51 | ```pascal 52 | var 53 | BCrypt : TBCryptHash; 54 | Hash : AnsiString; 55 | begin 56 | BCrypt := TBCryptHash.Create; 57 | Hash := BCrypt.CreateHash('password'); // PHP $2y$ hash with a cost of 12 58 | // or 59 | Hash := BCrypt.CreateHash('password', bcBSD); // BSD $2a$ hash with a cost of 12 60 | // or 61 | Hash := BCrypt.CreateHash('password', bcPHP, 14); // PHP hash, with a cost of 14 62 | Writeln(Hash); 63 | BCrypt.Free; 64 | end; 65 | ``` 66 | 67 | To verify 68 | ```pascal 69 | var 70 | BCrypt : TBCryptHash; 71 | Hash : AnsiString; 72 | Verify : Boolean; 73 | begin 74 | Hash := '$2y$12$GuC.Gk2YDsp8Yvga.IuSNOWM0fxEIsAEaWC1hqEI14Wa.7Ps3iYFq'; 75 | BCrypt := TBCryptHash.Create; 76 | Verify := BCrypt.VerifyHash('password', Hash); 77 | BCrypt.Free; 78 | end; 79 | ``` 80 | 81 | HashGetInfo - raises EHash exception if the hash is bad, ([too short](https://youtu.be/xT0Qb5ns7_A "too short"), too long); 82 | ```pascal 83 | var 84 | BCrypt : TBCryptHash; 85 | Hash : AnsiString; 86 | PasswordInfo : RTPasswordInformation; 87 | begin 88 | BCrypt := TBCryptHash.Create; 89 | Hash := '$2y$12$GuC.Gk2YDsp8Yvga.IuSNOWM0fxEIsAEaWC1hqEI14Wa.7Ps3iYFq'; 90 | PasswordInfo := BCrypt.HashGetInfo(Hash); 91 | with PasswordInfo do 92 | begin 93 | WriteLn('Algo : ', Algo); // bcPHP 94 | WriteLn('AlgoName : ', AlgoName); // bcrypt 95 | WriteLn('Cost : ', Cost); // 12 96 | WriteLn('Salt : ', BCryptSalt); // GuC.Gk2YDsp8Yvga.IuSNO 97 | WriteLn('Hash : ', BCryptHash); // WM0fxEIsAEaWC1hqEI14Wa.7Ps3iYFq 98 | end; 99 | 100 | Hash := '$2a$12$GuC.Gk2YDsp8Yvga.IuSNOWM0fxEIsAEaWC1hqEI14Wa.7Ps3iYFq'; 101 | PasswordInfo := BCrypt.HashGetInfo(Hash); 102 | with PasswordInfo do 103 | begin 104 | WriteLn('Algo : ', Algo); // bcBSD 105 | WriteLn('AlgoName : ', AlgoName); // bcrypt 106 | WriteLn('Cost : ', Cost); // 12 107 | WriteLn('Salt : ', BCryptSalt); // GuC.Gk2YDsp8Yvga.IuSNO 108 | WriteLn('Hash : ', BCryptHash); // WM0fxEIsAEaWC1hqEI14Wa.7Ps3iYFq 109 | end; 110 | BCrypt.Free; 111 | end; 112 | ``` 113 | NeedsRehash 114 | ```pascal 115 | var 116 | BCrypt : TBCryptHash; 117 | Hash : AnsiString; 118 | Rehash : Boolean; 119 | begin 120 | BCrypt := TBCryptHash.Create; 121 | Hash := '$2a$12$GuC.Gk2YDsp8Yvga.IuSNOWM0fxEIsAEaWC1hqEI14Wa.7Ps3iYFq'; 122 | Rehash := BCrypt.NeedsRehash(Hash); // false 123 | Rehash := BCrypt.NeedsRehash(Hash, 14); // true 124 | Hash := '$2y$14$GuC.Gk2YDsp8Yvga.IuSNOWM0fxEIsAEaWC1hqEI14Wa.7Ps3iYFq'; 125 | Rehash := BCrypt.NeedsRehash(Hash); // true 126 | Rehash := BCrypt.NeedsRehash(Hash, 14); // false 127 | BCrypt.Free; 128 | end; 129 | ``` 130 | ### Evolution 131 | This has had quite the evolution. 132 | 133 | [FreeBSD crypt.c](https://svnweb.freebsd.org/base/stable/10/lib/libcrypt/crypt.c?revision=273043&view=markup "FreeBSD crypt.c") 134 | 135 | [BCrypt for Delphi](https://github.com/JoseJimeniz/bcrypt-for-delphi "BCrypt for Delphi") 136 | 137 | [BCrypt for Delphi, Lazarus, FPC](https://github.com/PonyPC/BCrypt-for-delphi-lazarus-fpc "BCrypt for Delphi, Lazarus, FPC") 138 | 139 | [PHP password.c](https://github.com/php/php-src/blob/master/ext/standard/password.c "PHP password.c") For the verify logic. 140 | 141 | To here. 142 | -------------------------------------------------------------------------------- /docs/bcrypt/bcrypt_default_cost.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | BCRYPT_DEFAULT_COST 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

BCRYPT_DEFAULT_COST

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 15

20 | 21 | 22 | 23 | 24 |

const BCRYPT_DEFAULT_COST = 12;

25 | 26 | 27 | -------------------------------------------------------------------------------- /docs/bcrypt/bcrypt_salt_len.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | BCRYPT_SALT_LEN 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

BCRYPT_SALT_LEN

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 13

20 | 21 | 22 | 23 | 24 |

const BCRYPT_SALT_LEN = 16;

25 | 26 | 27 | -------------------------------------------------------------------------------- /docs/bcrypt/blowfish_num_rounds.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | BLOWFISH_NUM_ROUNDS 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

BLOWFISH_NUM_ROUNDS

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 14

20 | 21 | 22 | 23 | 24 |

const BLOWFISH_NUM_ROUNDS = 16;

25 | 26 | 27 | -------------------------------------------------------------------------------- /docs/bcrypt/bsdbase64decodetable.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | BsdBase64DecodeTable 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

BsdBase64DecodeTable

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 183

20 | 21 | 22 | 23 | 24 |

const BsdBase64DecodeTable: array [#0..#127] of Integer = (-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 0, 1, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, -1, -1, -1, -1, -1, -1, -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, -1, -1, -1, -1, -1, -1, 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, -1, -1, -1, -1, -1);

25 | 26 | 27 | -------------------------------------------------------------------------------- /docs/bcrypt/bsdbase64encodetable.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | BsdBase64EncodeTable 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

BsdBase64EncodeTable

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 177

20 | 21 | 22 | 23 | 24 |

const BsdBase64EncodeTable: array [0..63] of Char = './' + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' + 'abcdefghijklmnopqrstuvwxyz' + '0123456789';

25 | 26 | 27 | -------------------------------------------------------------------------------- /docs/bcrypt/ehash-1.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |

EHash

16 | 17 | 18 | -------------------------------------------------------------------------------- /docs/bcrypt/ehash-2.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 |
12 | 13 | 14 | -------------------------------------------------------------------------------- /docs/bcrypt/ehash-3.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |

EHash

16 | 17 | 18 | -------------------------------------------------------------------------------- /docs/bcrypt/ehash-4.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 |
12 | 13 | 14 | -------------------------------------------------------------------------------- /docs/bcrypt/ehash-5.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |

EHash

16 | 17 | 18 | -------------------------------------------------------------------------------- /docs/bcrypt/ehash-6.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 |
12 | 13 | 14 | -------------------------------------------------------------------------------- /docs/bcrypt/ehash.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | EHash 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

EHash

17 |

[Properties (by Name)] [Methods (by Name)] [Events (by Name)]

18 |

19 |

Declaration

20 |

Source position: BCrypt.pas line 212

21 | 22 | 23 | 24 | 25 |

type EHash = class(EArgumentException) ;

26 |

Inheritance

27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 |

EHash

|

EArgumentException

?

TObject

44 | 45 | 46 | -------------------------------------------------------------------------------- /docs/bcrypt/index-2.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Reference for unit 'BCrypt': Constants 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

Reference for unit 'BCrypt': Constants

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 |

BCRYPT_DEFAULT_COST

BCRYPT_SALT_LEN

BLOWFISH_NUM_ROUNDS

BsdBase64DecodeTable

BsdBase64EncodeTable

MagicText

PBoxOrg

SBoxOrg

43 | 44 | 45 | -------------------------------------------------------------------------------- /docs/bcrypt/index-3.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Reference for unit 'BCrypt': Types 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

Reference for unit 'BCrypt': Types

17 | 18 | 19 | 20 | 21 |

THashTypes

22 | 23 | 24 | -------------------------------------------------------------------------------- /docs/bcrypt/index-4.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Reference for unit 'BCrypt': Classes 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

Reference for unit 'BCrypt': Classes

17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 |

EHash

RTPasswordInformation

TBCryptHash

28 | 29 | 30 | -------------------------------------------------------------------------------- /docs/bcrypt/index-8.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Index of all identifiers in unit 'BCrypt' 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

Index of all identifiers in unit 'BCrypt'

17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 |
B E M P R S T 
28 |

B

29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 |
bcBSDBCRYPT_DEFAULT_COSTBLOWFISH_NUM_ROUNDS
bcDefaultBCRYPT_SALT_LENBsdBase64DecodeTable
bcPHPbcUnknownBsdBase64EncodeTable
46 |

E

47 | 48 | 49 | 50 | 51 | 52 | 53 |
EHash
54 |

M

55 | 56 | 57 | 58 | 59 | 60 | 61 |
MagicText
62 |

P

63 | 64 | 65 | 66 | 67 | 68 | 69 |
PBoxOrg
70 |

R

71 | 72 | 73 | 74 | 75 | 76 | 77 |
RTPasswordInformation
78 |

S

79 | 80 | 81 | 82 | 83 | 84 | 85 |
SBoxOrg
86 |

T

87 | 88 | 89 | 90 | 91 | 92 | 93 |
TBCryptHashTHashTypes
94 | 95 | 96 | -------------------------------------------------------------------------------- /docs/bcrypt/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Reference for unit 'BCrypt' 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

Reference for unit 'BCrypt'

17 |

18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 |

uses

  System,

  SysUtils,

  Classes;

32 | 33 | 34 | -------------------------------------------------------------------------------- /docs/bcrypt/magictext.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | MagicText 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

MagicText

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 173

20 | 21 | 22 | 23 | 24 |

const MagicText: array [0..5] of DWord = ($4f727068, $65616e42, $65686f6c, $64657253, $63727944, $6f756274);

25 | 26 | 27 | -------------------------------------------------------------------------------- /docs/bcrypt/pboxorg.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | PBoxOrg 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

PBoxOrg

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 17

20 | 21 | 22 | 23 | 24 |

const PBoxOrg: array [0..17] of DWord = ($243f6a88, $85a308d3, $13198a2e, $03707344, $a4093822, $299f31d0, $082efa98, $ec4e6c89, $452821e6, $38d01377, $be5466cf, $34e90c6c, $c0ac29b7, $c97c50dd, $3f84d5b5, $b5470917, $9216d5d9, $8979fb1b);

25 | 26 | 27 | -------------------------------------------------------------------------------- /docs/bcrypt/rtpasswordinformation-1.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |

RTPasswordInformation

16 | 17 | 18 | -------------------------------------------------------------------------------- /docs/bcrypt/rtpasswordinformation-2.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 |
12 | 13 | 14 | -------------------------------------------------------------------------------- /docs/bcrypt/rtpasswordinformation-3.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |

RTPasswordInformation

16 | 17 | 18 | -------------------------------------------------------------------------------- /docs/bcrypt/rtpasswordinformation-4.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 |
12 | 13 | 14 | -------------------------------------------------------------------------------- /docs/bcrypt/rtpasswordinformation-5.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |

RTPasswordInformation

16 | 17 | 18 | -------------------------------------------------------------------------------- /docs/bcrypt/rtpasswordinformation-6.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 |
12 | 13 | 14 | -------------------------------------------------------------------------------- /docs/bcrypt/rtpasswordinformation.algo.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | RTPasswordInformation.Algo 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

RTPasswordInformation.Algo

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 205

20 | 21 | 22 | 23 | 24 |

RTPasswordInformation.Algo : THashTypes;

25 | 26 | 27 | -------------------------------------------------------------------------------- /docs/bcrypt/rtpasswordinformation.algoname.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | RTPasswordInformation.AlgoName 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

RTPasswordInformation.AlgoName

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 209

20 | 21 | 22 | 23 | 24 |

RTPasswordInformation.AlgoName : AnsiString;

25 | 26 | 27 | -------------------------------------------------------------------------------- /docs/bcrypt/rtpasswordinformation.bcrypthash.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | RTPasswordInformation.BCryptHash 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

RTPasswordInformation.BCryptHash

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 209

20 | 21 | 22 | 23 | 24 |

RTPasswordInformation.BCryptHash : AnsiString;

25 | 26 | 27 | -------------------------------------------------------------------------------- /docs/bcrypt/rtpasswordinformation.bcryptsalt.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | RTPasswordInformation.BCryptSalt 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

RTPasswordInformation.BCryptSalt

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 209

20 | 21 | 22 | 23 | 24 |

RTPasswordInformation.BCryptSalt : AnsiString;

25 | 26 | 27 | -------------------------------------------------------------------------------- /docs/bcrypt/rtpasswordinformation.cost.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | RTPasswordInformation.Cost 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

RTPasswordInformation.Cost

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 206

20 | 21 | 22 | 23 | 24 |

RTPasswordInformation.Cost : Word;

25 | 26 | 27 | -------------------------------------------------------------------------------- /docs/bcrypt/rtpasswordinformation.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | RTPasswordInformation 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

RTPasswordInformation

17 |

[Properties (by Name)] [Methods (by Name)] [Events (by Name)]

18 |

19 |

Declaration

20 |

Source position: BCrypt.pas line 204

21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 |

type RTPasswordInformation = object end;

  Algo: THashTypes;

  Cost: Word;

  AlgoName: AnsiString;

  BCryptSalt: AnsiString;

  BCryptHash: AnsiString;

44 |

Inheritance

45 | 46 | 47 | 48 | 49 |

RTPasswordInformation

50 | 51 | 52 | -------------------------------------------------------------------------------- /docs/bcrypt/sboxorg.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | SBoxOrg 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

SBoxOrg

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 23

20 | 21 | 22 | 23 | 24 |

const SBoxOrg: array [0..1023] of DWord = ($d1310ba6, $98dfb5ac, $2ffd72db, $d01adfb7, $b8e1afed, $6a267e96, $ba7c9045, $f12c7f99, $24a19947, $b3916cf7, $0801f2e2, $858efc16, $636920d8, $71574e69, $a458fea3, $f4933d7e, $0d95748f, $728eb658, $718bcd58, $82154aee, $7b54a41d, $c25a59b5, $9c30d539, $2af26013, $c5d1b023, $286085f0, $ca417918, $b8db38ef, $8e79dcb0, $603a180e, $6c9e0e8b, $b01e8a3e, $d71577c1, $bd314b27, $78af2fda, $55605c60, $e65525f3, $aa55ab94, $57489862, $63e81440, $55ca396a, $2aab10b6, $b4cc5c34, $1141e8ce, $a15486af, $7c72e993, $b3ee1411, $636fbc2a, $2ba9c55d, $741831f6, $ce5c3e16, $9b87931e, $afd6ba33, $6c24cf5c, $7a325381, $28958677, $3b8f4898, $6b4bb9af, $c4bfe81b, $66282193, $61d809cc, $fb21a991, $487cac60, $5dec8032, $ef845d5d, $e98575b1, $dc262302, $eb651b88, $23893e81, $d396acc5, $0f6d6ff3, $83f44239, $2e0b4482, $a4842004, $69c8f04a, $9e1f9b5e, $21c66842, $f6e96c9a, $670c9c61, $abd388f0, $6a51a0d2, $d8542f68, $960fa728, $ab5133a3, $6eef0b6c, $137a3be4, $ba3bf050, $7efb2a98, $a1f1651d, $39af0176, $66ca593e, $82430e88, $8cee8619, $456f9fb4, $7d84a5c3, $3b8b5ebe, $e06f75d8, $85c12073, $401a449f, $56c16aa6, $4ed3aa62, $363f7706, $1bfedf72, $429b023d, $37d0d724, $d00a1248, $db0fead3, $49f1c09b, $075372c9, $80991b7b, $25d479d8, $f6e8def7, $e3fe501a, $b6794c3b, $976ce0bd, $04c006ba, $c1a94fb6, $409f60c4, $5e5c9ec2, $196a2463, $68fb6faf, $3e6c53b5, $1339b2eb, $3b52ec6f, $6dfc511f, $9b30952c, $cc814544, $af5ebd09, $bee3d004, $de334afd, $660f2807, $192e4bb3, $c0cba857, $45c8740f, $d20b5f39, $b9d3fbdb, $5579c0bd, $1a60320a, $d6a100c6, $402c7279, $679f25fe, $fb1fa3cc, $8ea5e9f8, $db3222f8, $3c7516df, $fd616b15, $2f501ec8, $ad0552ab, $323db5fa, $fd238760, $53317b48, $3e00df82, $9e5c57bb, $ca6f8ca0, $1a87562e, $df1769db, $d542a8f6, $287effc3, $ac6732c6, $8c4f5573, $695b27b0, $bbca58c8, $e1ffa35d, $b8f011a0, $10fa3d98, $fd2183b8, $4afcb56c, $2dd1d35b, $9a53e479, $b6f84565, $d28e49bc, $4bfb9790, $e1ddf2da, $a4cb7e33, $62fb1341, $cee4c6e8, $ef20cada, $36774c01, $d07e9efe, $2bf11fb4, $95dbda4d, $ae909198, $eaad8e71, $6b93d5a0, $d08ed1d0, $afc725e0, $8e3c5b2f, $8e7594b7, $8ff6e2fb, $f2122b64, $8888b812, $900df01c, $4fad5ea0, $688fc31c, $d1cff191, $b3a8c1ad, $2f2f2218, $be0e1777, $ea752dfe, $8b021fa1, $e5a0cc0f, $b56f74e8, $18acf3d6, $ce89e299, $b4a84fe0, $fd13e0b7, $7cc43b81, $d2ada8d9, $165fa266, $80957705, $93cc7314, $211a1477, $e6ad2065, $77b5fa86, $c75442f5, $fb9d35cf, $ebcdaf0c, $7b3e89a0, $d6411bd3, $ae1e7e49, $00250e2d, $2071b35e, $226800bb, $57b8e0af, $2464369b, $f009b91e, $5563911d, $59dfa6aa, $78c14389, $d95a537f, $207d5ba2, $02e5b9c5, $83260376, $6295cfa9, $11c81968, $4e734a41, $b3472dca, $7b14a94a, $1b510052, $9a532915, $d60f573f, $bc9bc6e4, $2b60a476, $81e67400, $08ba6fb5, $571be91f, $f296ec6b, $2a0dd915, $b6636521, $e7b9f9b6, $ff34052e, $c5855664, $53b02d5d, $a99f8fa1, $08ba4799, $6e85076a, $4b7a70e9, $b5b32944, $db75092e, $c4192623, $ad6ea6b0, $49a7df7d, $9cee60b8, $8fedb266, $ecaa8c71, $699a17ff, $5664526c, $c2b19ee1, $193602a5, $75094c29, $a0591340, $e4183a3e, $3f54989a, $5b429d65, $6b8fe4d6, $99f73fd6, $a1d29c07, $efe830f5, $4d2d38e6, $f0255dc1, $4cdd2086, $8470eb26, $6382e9c6, $021ecc5e, $09686b3f, $3ebaefc9, $3c971814, $6b6a70a1, $687f3584, $52a0e286, $b79c5305, $aa500737, $3e07841c, $7fdeae5c, $8e7d44ec, $5716f2b8, $b03ada37, $f0500c0d, $f01c1f04, $0200b3ff, $ae0cf51a, $3cb574b2, $25837a58, $dc0921bd, $d19113f9, $7ca92ff6, $94324773, $22f54701, $3ae5e581, $37c2dadc, $c8b57634, $9af3dda7, $a9446146, $0fd0030e, $ecc8c73e, $a4751e41, $e238cd99, $3bea0e2f, $3280bba1, $183eb331, $4e548b38, $4f6db908, $6f420d03, $f60a04bf, $2cb81290, $24977c79, $5679b072, $bcaf89af, $de9a771f, $d9930810, $b38bae12, $dccf3f2e, $5512721f, $2e6b7124, $501adde6, $9f84cd87, $7a584718, $7408da17, $bc9f9abc, $e94b7d8c, $ec7aec3a, $db851dfa, $63094366, $c464c3d2, $ef1c1847, $3215d908, $dd433b37, $24c2ba16, $12a14d43, $2a65c451, $50940002, $133ae4dd, $71dff89e, $10314e55, $81ac77d6, $5f11199b, $043556f1, $d7a3c76b, $3c11183b, $5924a509, $f28fe6ed, $97f1fbfa, $9ebabf2c, $1e153c6e, $86e34570, $eae96fb1, $860e5e0a, $5a3e2ab3, $771fe71c, $4e3d06fa, $2965dcb9, $99e71d0f, $803e89d6, $5266c825, $2e4cc978, $9c10b36a, $c6150eba, $94e2ea78, $a5fc3c53, $1e0a2df4, $f2f74ea7, $361d2b3d, $1939260f, $19c27960, $5223a708, $f71312b6, $ebadfe6e, $eac31f66, $e3bc4595, $a67bc883, $b17f37d1, $018cff28, $c332ddef, $be6c5aa5, $65582185, $68ab9802, $eecea50f, $db2f953b, $2aef7dad, $5b6e2f84, $1521b628, $29076170, $ecdd4775, $619f1510, $13cca830, $eb61bd96, $0334fe1e, $aa0363cf, $b5735c90, $4c70a239, $d59e9e0b, $cbaade14, $eecc86bc, $60622ca7, $9cab5cab, $b2f3846e, $648b1eaf, $19bdf0ca, $a02369b9, $655abb50, $40685a32, $3c2ab4b3, $319ee9d5, $c021b8f7, $9b540b19, $875fa099, $95f7997e, $623d7da8, $f837889a, $97e32d77, $11ed935f, $16681281, $0e358829, $c7e61fd6, $96dedfa1, $7858ba99, $57f584a5, $1b227263, $9b83c3ff, $1ac24696, $cdb30aeb, $532e3054, $8fd948e4, $6dbc3128, $58ebf2ef, $34c6ffea, $fe28ed61, $ee7c3c73, $5d4a14d9, $e864b7e3, $42105d14, $203e13e0, $45eee2b6, $a3aaabea, $db6c4f15, $facb4fd0, $c742f442, $ef6abbb5, $654f3b1d, $41cd2105, $d81e799e, $86854dc7, $e44b476a, $3d816250, $cf62a1f2, $5b8d2646, $fc8883a0, $c1c7b6a3, $7f1524c3, $69cb7492, $47848a0b, $5692b285, $095bbf00, $ad19489d, $1462b174, $23820e00, $58428d2a, $0c55f5ea, $1dadf43e, $233f7061, $3372f092, $8d937e41, $d65fecf1, $6c223bdb, $7cde3759, $cbee7460, $4085f2a7, $ce77326e, $a6078084, $19f8509e, $e8efd855, $61d99735, $a969a7aa, $c50c06c2, $5a04abfc, $800bcadc, $9e447a2e, $c3453484, $fdd56705, $0e1e9ec9, $db73dbd3, $105588cd, $675fda79, $e3674340, $c5c43465, $713e38d8, $3d28f89e, $f16dff20, $153e21e7, $8fb03d4a, $e6e39f2b, $db83adf7, $e93d5a68, $948140f7, $f64c261c, $94692934, $411520f7, $7602d4f7, $bcf46b2e, $d4a20068, $d4082471, $3320f46a, $43b7d4b7, $500061af, $1e39f62e, $97244546, $14214f74, $bf8b8840, $4d95fc1d, $96b591af, $70f4ddd3, $66a02f45, $bfbc09ec, $03bd9785, $7fac6dd0, $31cb8504, $96eb27b3, $55fd3941, $da2547e6, $abca0a9a, $28507825, $530429f4, $0a2c86da, $e9b66dfb, $68dc1462, $d7486900, $680ec0a4, $27a18dee, $4f3ffea2, $e887ad8c, $b58ce006, $7af4d6b6, $aace1e7c, $d3375fec, $ce78a399, $406b2a42, $20fe9e35, $d9f385b9, $ee39d7ab, $3b124e8b, $1dc9faf7, $4b6d1856, $26a36631, $eae397b2, $3a6efa74, $dd5b4332, $6841e7f7, $ca7820fb, $fb0af54e, $d8feb397, $454056ac, $ba489527, $55533a3a, $20838d87, $fe6ba9b7, $d096954b, $55a867bc, $a1159a58, $cca92963, $99e1db33, $a62a4a56, $3f3125f9, $5ef47e1c, $9029317c, $fdf8e802, $04272f70, $80bb155c, $05282ce3, $95c11548, $e4c66d22, $48c1133f, $c70f86dc, $07f9c9ee, $41041f0f, $404779a4, $5d886e17, $325f51eb, $d59bc0d1, $f2bcc18f, $41113564, $257b7834, $602a9c60, $dff8e8a3, $1f636c1b, $0e12b4c2, $02e1329e, $af664fd1, $cad18115, $6b2395e0, $333e92e1, $3b240b62, $eebeb922, $85b2a20e, $e6ba0d99, $de720c8c, $2da2f728, $d0127845, $95b794fd, $647d0862, $e7ccf5f0, $5449a36f, $877d48fa, $c39dfd27, $f33e8d1e, $0a476341, $992eff74, $3a6f6eab, $f4f8fd37, $a812dc60, $a1ebddf8, $991be14c, $db6e6b0d, $c67b5510, $6d672c37, $2765d43b, $dcd0e804, $f1290dc7, $cc00ffa3, $b5390f92, $690fed0b, $667b9ffb, $cedb7d9c, $a091cf0b, $d9155ea3, $bb132f88, $515bad24, $7b9479bf, $763bd6eb, $37392eb3, $cc115979, $8026e297, $f42e312d, $6842ada7, $c66a2b3b, $12754ccc, $782ef11c, $6a124237, $b79251e7, $06a1bbe6, $4bfb6350, $1a6b1018, $11caedfa, $3d25bdd8, $e2e1c3c9, $44421659, $0a121386, $d90cec6e, $d5abea2a, $64af674e, $da86a85f, $bebfe988, $64e4c3fe, $9dbc8057, $f0f7c086, $60787bf8, $6003604d, $d1fd8346, $f6381fb0, $7745ae04, $d736fccc, $83426b33, $f01eab71, $b0804187, $3c005e5f, $77a057be, $bde8ae24, $55464299, $bf582e61, $4e58f48f, $f2ddfda2, $f474ef38, $8789bdc2, $5366f9c3, $c8b38e74, $b475f255, $46fcd9b9, $7aeb2661, $8b1ddf84, $846a0e79, $915f95e2, $466e598e, $20b45770, $8cd55591, $c902de4c, $b90bace1, $bb8205d0, $11a86248, $7574a99e, $b77f19b6, $e0a9dc09, $662d09a1, $c4324633, $e85a1f02, $09f0be8c, $4a99a025, $1d6efe10, $1ab93d1d, $0ba5a4df, $a186f20f, $2868f169, $dcb7da83, $573906fe, $a1e2ce9b, $4fcd7f52, $50115e01, $a70683fa, $a002b5c4, $0de6d027, $9af88c27, $773f8641, $c3604c06, $61a806b5, $f0177a28, $c0f586e0, $006058aa, $30dc7d62, $11e69ed7, $2338ea63, $53c2dd94, $c2c21634, $bbcbee56, $90bcb6de, $ebfc7da1, $ce591d76, $6f05e409, $4b7c0188, $39720a3d, $7c927c24, $86e3725f, $724d9db9, $1ac15bb4, $d39eb8fc, $ed545578, $08fca5b5, $d83d7cd3, $4dad0fc4, $1e50ef5e, $b161e6f8, $a28514d9, $6c51133c, $6fd5c7e7, $56e14ec4, $362abfce, $ddc6c837, $d79a3234, $92638212, $670efa8e, $406000e0, $3a39ce37, $d3faf5cf, $abc27737, $5ac52d1b, $5cb0679e, $4fa33742, $d3822740, $99bc9bbe, $d5118e9d, $bf0f7315, $d62d1c7e, $c700c47b, $b78c1b6b, $21a19045, $b26eb1be, $6a366eb4, $5748ab2f, $bc946e79, $c6a376d2, $6549c2c8, $530ff8ee, $468dde7d, $d5730a1d, $4cd04dc6, $2939bbdb, $a9ba4650, $ac9526e8, $be5ee304, $a1fad5f0, $6a2d519a, $63ef8ce2, $9a86ee22, $c089c2b8, $43242ef6, $a51e03aa, $9cf2d0a4, $83c061ba, $9be96a4d, $8fe51550, $ba645bd6, $2826a2f9, $a73a3ae1, $4ba99586, $ef5562e9, $c72fefd3, $f752f7da, $3f046f69, $77fa0a59, $80e4a915, $87b08601, $9b09e6ad, $3b3ee593, $e990fd5a, $9e34d797, $2cf0b7d9, $022b8b51, $96d5ac3a, $017da67d, $d1cf3ed6, $7c7d2d28, $1f9f25cf, $adf2b89b, $5ad6b472, $5a88f54c, $e029ac71, $e019a5e6, $47b0acfd, $ed93fa9b, $e8d3c48d, $283b57cc, $f8d56629, $79132e28, $785f0191, $ed756055, $f7960e44, $e3d35e8c, $15056dd4, $88f46dba, $03a16125, $0564f0bd, $c3eb9e15, $3c9057a2, $97271aec, $a93a072a, $1b3f6d9b, $1e6321f5, $f59c66fb, $26dcf319, $7533d928, $b155fdf5, $03563482, $8aba3cbb, $28517711, $c20ad9f8, $abcc5167, $ccad925f, $4de81751, $3830dc8e, $379d5862, $9320f991, $ea7a90c2, $fb3e7bce, $5121ce64, $774fbe32, $a8b6e37e, $c3293d46, $48de5369, $6413e680, $a2ae0810, $dd6db224, $69852dfd, $09072166, $b39a460a, $6445c0dd, $586cdecf, $1c20c8ae, $5bbef7dd, $1b588d40, $ccd2017f, $6bb4e3bb, $dda26a7e, $3a59ff45, $3e350a44, $bcb4cdd5, $72eacea8, $fa6484bb, $8d6612ae, $bf3c6f47, $d29be463, $542f5d9e, $aec2771b, $f64e6370, $740e0d8d, $e75b1357, $f8721671, $af537d5d, $4040cb08, $4eb4e2cc, $34d2466a, $0115af84, $e1b00428, $95983a1d, $06b89fb4, $ce6ea048, $6f3f3b82, $3520ab82, $011a1d4b, $277227f8, $611560b1, $e7933fdc, $bb3a792b, $344525bd, $a08839e1, $51ce794b, $2f32c9b7, $a01fbac9, $e01cc87e, $bcc7d1f6, $cf0111c3, $a1e8aac7, $1a908749, $d44fbd9a, $d0dadecb, $d50ada38, $0339c32a, $c6913667, $8df9317c, $e0b12b4f, $f79e59b7, $43f5bb3a, $f2d519ff, $27d9459c, $bf97222c, $15e6fc2a, $0f91fc71, $9b941525, $fae59361, $ceb69ceb, $c2a86459, $12baa8d1, $b6c1075e, $e3056a0c, $10d25065, $cb03a442, $e0ec6e0e, $1698db3b, $4c98a0be, $3278e964, $9f1f9532, $e0d392df, $d3a0342b, $8971f21e, $1b0a7441, $4ba3348c, $c5be7120, $c37632d8, $df359f8d, $9b992f2e, $e60b6f47, $0fe3f11d, $e54cda54, $1edad891, $ce6279cf, $cd3e7e6f, $1618b166, $fd2c1d05, $848fd2c5, $f6fb2299, $f523f357, $a6327623, $93a83531, $56cccd02, $acf08162, $5a75ebb5, $6e163697, $88d273cc, $de966292, $81b949d0, $4c50901b, $71c65614, $e6c6c7bd, $327a140a, $45e1d006, $c3f27b9a, $c9aa53fd, $62a80f00, $bb25bfe2, $35bdd2f6, $71126905, $b2040222, $b6cbcf7c, $cd769c2b, $53113ec0, $1640e3d3, $38abbd60, $2547adf0, $ba38209c, $f746ce76, $77afa1c5, $20756060, $85cbfe4e, $8ae88dd8, $7aaaf9b0, $4cf9aa7e, $1948c25c, $02fb8a8c, $01c36ae4, $d6ebe1f9, $90d4f869, $a65cdea0, $3f09252d, $c208e69f, $b74e6132, $ce77e25b, $578fdfe3, $3ac372e6);

25 | 26 | 27 | -------------------------------------------------------------------------------- /docs/bcrypt/tbcrypthash-1.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |

TBCryptHash

16 | 17 | 18 | -------------------------------------------------------------------------------- /docs/bcrypt/tbcrypthash-2.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 |
12 | 13 | 14 | -------------------------------------------------------------------------------- /docs/bcrypt/tbcrypthash-3.html: -------------------------------------------------------------------------------- 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 |

TBCryptHash

 

Create

 

Destroy

 

CreateHash

 

VerifyHash

 

NeedsRehash

 

HashGetInfo

46 | 47 | 48 | -------------------------------------------------------------------------------- /docs/bcrypt/tbcrypthash-4.html: -------------------------------------------------------------------------------- 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 |

 

Create (TBCryptHash)

 

CreateHash (TBCryptHash)

 

Destroy (TBCryptHash)

 

HashGetInfo (TBCryptHash)

 

NeedsRehash (TBCryptHash)

 

VerifyHash (TBCryptHash)

42 | 43 | 44 | -------------------------------------------------------------------------------- /docs/bcrypt/tbcrypthash-5.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |

TBCryptHash

16 | 17 | 18 | -------------------------------------------------------------------------------- /docs/bcrypt/tbcrypthash-6.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 |
12 | 13 | 14 | -------------------------------------------------------------------------------- /docs/bcrypt/tbcrypthash.create.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | TBCryptHash.Create 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

TBCryptHash.Create

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 237

20 | 21 | 22 | 23 | 24 |

public constructor TBCryptHash.Create; overload;

25 | 26 | 27 | -------------------------------------------------------------------------------- /docs/bcrypt/tbcrypthash.createhash.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | TBCryptHash.CreateHash 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

TBCryptHash.CreateHash

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 239

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 |

public function TBCryptHash.CreateHash(

  const Password: AnsiString

):AnsiString; overload;

function TBCryptHash.CreateHash(

  const Password: AnsiString;

  HashType: THashTypes

):AnsiString; overload;

function TBCryptHash.CreateHash(

  const Password: AnsiString;

  HashType: THashTypes;

  Cost: Byte

):AnsiString; overload;

52 | 53 | 54 | -------------------------------------------------------------------------------- /docs/bcrypt/tbcrypthash.destroy.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | TBCryptHash.Destroy 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

TBCryptHash.Destroy

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 238

20 | 21 | 22 | 23 | 24 |

public destructor TBCryptHash.Destroy; override;

25 | 26 | 27 | -------------------------------------------------------------------------------- /docs/bcrypt/tbcrypthash.hashgetinfo.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | TBCryptHash.HashGetInfo 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

TBCryptHash.HashGetInfo

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 245

20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 |

public function TBCryptHash.HashGetInfo(

  const Hash: AnsiString

):RTPasswordInformation;

31 | 32 | 33 | -------------------------------------------------------------------------------- /docs/bcrypt/tbcrypthash.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | TBCryptHash 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

TBCryptHash

17 |

[Properties (by Name)] [Methods (by Name)] [Events (by Name)]

18 |

19 |

Declaration

20 |

Source position: BCrypt.pas line 214

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 |

type TBCryptHash = class(TObject) end;

public

  constructor Create; overload;

  destructor Destroy; override;

  function CreateHash();

  function VerifyHash();

  function NeedsRehash();

  function HashGetInfo();

50 |

Inheritance

51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 |

TBCryptHash

|

TObject

62 | 63 | 64 | -------------------------------------------------------------------------------- /docs/bcrypt/tbcrypthash.needsrehash.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | TBCryptHash.NeedsRehash 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

TBCryptHash.NeedsRehash

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 243

20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 |

public function TBCryptHash.NeedsRehash(

  const BCryptHash: AnsiString

):Boolean; overload;

function TBCryptHash.NeedsRehash(

  const BCryptHash: AnsiString;

  Cost: Byte

):Boolean; overload;

40 | 41 | 42 | -------------------------------------------------------------------------------- /docs/bcrypt/tbcrypthash.verifyhash.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | TBCryptHash.VerifyHash 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

TBCryptHash.VerifyHash

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 242

20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 |

public function TBCryptHash.VerifyHash(

  const Password: AnsiString;

  const Hash: AnsiString

):Boolean;

34 | 35 | 36 | -------------------------------------------------------------------------------- /docs/bcrypt/thashtypes.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | THashTypes 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Overview][Constants][Types][Classes][Index]Reference for unit 'BCrypt' (#TBCryptHash)
16 |

THashTypes

17 |

18 |

Declaration

19 |

Source position: BCrypt.pas line 203

20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 |

type THashTypes = (

  bcDefault,

  bcPHP,

  bcBSD,

  bcUnknown

);

40 | 41 | 42 | -------------------------------------------------------------------------------- /docs/fpdoc.css: -------------------------------------------------------------------------------- 1 | /* 2 | $Id: fpdoc.css,v 1.1 2003/03/17 23:03:20 michael Exp $ 3 | 4 | Default style sheet for FPDoc reference documentation 5 | by Sebastian Guenther, sg@freepascal.org 6 | 7 | Feel free to use this file as a template for your own style sheets. 8 | */ 9 | 10 | body { 11 | background: white 12 | } 13 | 14 | body, p, th, td, caption, h1, h2, h3, ul, ol, dl { 15 | color: black; 16 | font-family: sans-serif 17 | } 18 | 19 | tt, span.kw, pre { 20 | font-family: Courier, monospace 21 | } 22 | 23 | body, p, th, td, caption, ul, ol, dl, tt, span.kw, pre { 24 | font-size: 14px 25 | } 26 | 27 | A:link { 28 | color: blue 29 | } 30 | 31 | A:visited { 32 | color: darkblue 33 | } 34 | 35 | A:active { 36 | color: red 37 | } 38 | 39 | A { 40 | text-decoration: none 41 | } 42 | 43 | A:hover { 44 | text-decoration: underline 45 | } 46 | 47 | h1, h2, td.h2 { 48 | color: #005A9C 49 | } 50 | 51 | /* Especially for Netscape on Linux: */ 52 | h3, td.h3 { 53 | font-size: 12pt 54 | } 55 | 56 | /* source fragments */ 57 | span.code { 58 | white-space: nowrap 59 | } 60 | 61 | /* symbols in source fragments */ 62 | span.sym { 63 | color: darkred 64 | } 65 | 66 | /* keywords in source fragments */ 67 | span.kw { 68 | font-weight: bold 69 | } 70 | 71 | /* comments in source fragments */ 72 | span.cmt { 73 | color: darkcyan; 74 | font-style: italic 75 | } 76 | 77 | /* directives in source fragments */ 78 | span.dir { 79 | color: darkyellow; 80 | font-style: italic 81 | } 82 | 83 | /* numbers in source fragments */ 84 | span.num { 85 | color: darkmagenta 86 | } 87 | 88 | /* characters (#...) in source fragments */ 89 | span.chr { 90 | color: darkcyan 91 | } 92 | 93 | /* strings in source fragments */ 94 | span.str { 95 | color: blue 96 | } 97 | 98 | /* assembler passages in source fragments */ 99 | span.asm { 100 | color: green 101 | } 102 | 103 | 104 | td.pre { 105 | white-space: pre 106 | } 107 | 108 | p.cmt { 109 | color: gray 110 | } 111 | 112 | span.warning { 113 | color: red; 114 | font-weight: bold 115 | } 116 | 117 | /* !!!: How should we define this...? */ 118 | span.file { 119 | color: darkgreen 120 | } 121 | 122 | table.remark { 123 | background-color: #ffffc0; 124 | } 125 | 126 | table.bar { 127 | background-color: #a0c0ff; 128 | } 129 | 130 | span.bartitle { 131 | font-weight: bold; 132 | font-style: italic; 133 | color: darkblue 134 | } 135 | 136 | span.footer { 137 | font-style: italic; 138 | color: darkblue 139 | } 140 | 141 | /* definition list */ 142 | dl { 143 | border: 3px double #ccc; 144 | padding: 0.5em; 145 | } 146 | 147 | /* definition list: term */ 148 | dt { 149 | float: left; 150 | clear: left; 151 | width: auto; /* normally browsers default width of largest item */ 152 | padding-right: 20px; 153 | font-weight: bold; 154 | color: darkgreen; 155 | } 156 | 157 | /* definition list: description */ 158 | dd { 159 | margin: 0 0 0 110px; 160 | padding: 0 0 0.5em 0; 161 | } 162 | 163 | /* for browsers in standards compliance mode */ 164 | td p { 165 | margin: 0; 166 | } 167 | -------------------------------------------------------------------------------- /docs/index-8.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Index of all identifiers in package 'TBCryptHash' 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Index][Class hierarchy] (#TBCryptHash)
16 |

Index of all identifiers in package 'TBCryptHash'

17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 |
B E M P R S T 
28 |

B

29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 |
bcBSDBCRYPT_DEFAULT_COSTBsdBase64DecodeTable
bcDefaultBCRYPT_SALT_LENBsdBase64EncodeTable
bcPHPbcUnknown
BCryptBLOWFISH_NUM_ROUNDS
51 |

E

52 | 53 | 54 | 55 | 56 | 57 | 58 |
EHash
59 |

M

60 | 61 | 62 | 63 | 64 | 65 | 66 |
MagicText
67 |

P

68 | 69 | 70 | 71 | 72 | 73 | 74 |
PBoxOrg
75 |

R

76 | 77 | 78 | 79 | 80 | 81 | 82 |
RTPasswordInformation
83 |

S

84 | 85 | 86 | 87 | 88 | 89 | 90 |
SBoxOrg
91 |

T

92 | 93 | 94 | 95 | 96 | 97 | 98 |
TBCryptHashTHashTypes
99 | 100 | 101 | -------------------------------------------------------------------------------- /docs/index-9.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Class hierarchy 6 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 |
[Index][Class hierarchy] (#TBCryptHash)
21 |

Class hierarchy

22 | 28 | 29 | 30 | -------------------------------------------------------------------------------- /docs/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Reference for package 'TBCryptHash' 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
[Index][Class hierarchy] (#TBCryptHash)
16 |

Reference for package 'TBCryptHash'

17 |

18 |

Units

19 | 20 | 21 | 22 | 23 |

BCrypt

24 | 25 | 26 | -------------------------------------------------------------------------------- /docs/minus.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hiraethbbs/pascal_bcrypt/469aae80dc9622570272fdea5f1374d648386fdc/docs/minus.png -------------------------------------------------------------------------------- /docs/plus.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hiraethbbs/pascal_bcrypt/469aae80dc9622570272fdea5f1374d648386fdc/docs/plus.png -------------------------------------------------------------------------------- /docs/tree.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /tests/BCryptHashTest.pas: -------------------------------------------------------------------------------- 1 | Program BCryptHashTest; 2 | {$mode objfpc}{$H+} 3 | {$ASSERTIONS ON} 4 | {$UNITPATH ../} 5 | {$CODEPAGE UTF-8} 6 | 7 | uses BCrypt, Classes, SysUtils, Crt; 8 | const 9 | HashToMatch1 = '$2y$14$6m54yWmpJRWWVkUz9p7feOlfQvafHGwsWt9pYupeLr8DU5wKMv.wW'; 10 | HashToMatch2 = '$2y$16$d6eiNIIJPsVWtF.RCr.GUuCRs2hHFDB.0wPR.uK4kTi7KJvIO7k8e'; 11 | BSDHashToMatch = '$2a$14$6m54yWmpJRWWVkUz9p7feOlfQvafHGwsWt9pYupeLr8DU5wKMv.wW'; 12 | ShortHash = '$2y$14$6m54yWmpJRWWVkUz9p7feOlfQvafHGwsWt9pYupeLr8DU5wK'; 13 | LongHash = '$2y$14$6m54yWmpJRWWVkUz9p7feOlfQvafHGwsWt9pYupeLr8DU5wKMv.wWwKMvwKMv'; 14 | StaticPassword = 'password'; 15 | 16 | var 17 | TBCrypt : TBCryptHash; 18 | PasswordInfo : RTPasswordInformation; 19 | i, j, 20 | Assertions, 21 | FailedAssertions, 22 | PassedAssertions : Word; 23 | Passed : Boolean; 24 | 25 | UTF8TestString : UTF8String = 'Τη γλώσσα μου έδωσαν ελληνική'; 26 | UTF8TestHash : AnsiString = '$2y$12$RSxqgCt5T4qPXLM3AzKMCueMBZo6cc9o/bN4wqcX6KA6lZnOkqzTG'; 27 | UTF8PHPHash : AnsiString = '$2y$12$KrBUSn54WO5C/aw2H3imKurgsnrGq7PsrIZYXusaTNIO.27IGsmkG'; 28 | 29 | PasswordHashes : array [1..14] of AnsiString = ( 30 | '$2y$10$LCb3aOt8lAXSzNrEpQKDQO1zc2wCCQltrDwSEbb9JaUo4OKbphC3i', 31 | '$2y$11$H7TRTJZqQTzN5RCiwMOne.yjVxyKCd4GyLrBQzV91gK0T4XQeKTNa', 32 | '$2y$12$EL5tAZCoKb/kz4Q6WWCiw.DY1Ow/PcyE0w0Uo/SNjtnq7mePss/Yq', 33 | '$2y$13$ou4ZkaFPLILNkSLNINSw9uEARJOQQr8u02KbVuosBs3ULxpbEpjwS', 34 | '$2y$14$jvv79wTecdgfOjhefJL8B.ziJNvfqf.hR9IkUdEzgOVyqzgUDMnW.', 35 | '$2y$15$EdDG3DH94Yw5HWD8pHFpwuF6Bs/24cnf0c.H2UrhPeld4sl5.LPT.', 36 | '$2y$16$NjsYCIxFgM0KUfJ2N0tW1umTh4hUV696cEwVo8TM/grYdfbc4dwwu', 37 | // BSD 38 | '$2a$10$gd4l18fYW85l4he4zRD.seTuSA81Ku.Myqhdqp0LapOoGyHIe3okG', 39 | '$2a$11$sbCP6X5yYvjYe8EJt2H4wOGxiTT/JIXz.fCaVdLAXp58mEiXeQlrO', 40 | '$2a$12$hnT.LCI2PlLFDDI8lAi6G.Lmb5Q45pUIKk7Rabos9LNl8gqW4Z9gi', 41 | '$2a$13$UB99eDai2k5YrwAAbqxPreIStZiSszuRT0AZCP4hvavPSxUoC7DxW', 42 | '$2a$14$SDveEpfBff4N4FkpvQyxyu07EFhADHjk3lJkW3mV0/1x98xK28LKK', 43 | '$2a$15$7z9ZVYe16/s6NAXjWO2eyeCPR0tyUhI4PCj0LlJZ3XUR2NMrmO18y', 44 | '$2a$16$ZhJeznvMiClYg20vpSjPDOC79J5KKlaLmQAXuObWHl90G2D21NvKO'); 45 | 46 | PHPPasswordHashes : array [1..7] of AnsiString = ( 47 | '$2y$10$jRrQ51AeaJsJwNUw.QCDsOixDj.E0Vf2AG4tZdDmWqCSypmpFTr/q', 48 | '$2y$11$VEWaKBoOqoer/kjv3p/6SOa0SVTLRqH5huBsH7/6UlOvHI8f4zvvO', 49 | '$2y$12$hB6POF2QYZrkIx5a/CzB.OxvmJV9gy.93SPmOvwVySwukE1fJFgZm', 50 | '$2y$13$UWJNfSSzwYKeYyddhVYbNuyjYJx6ZZMGSLJnYcxiaFmYmPcTnJgxK', 51 | '$2y$14$FY/x2WRjTSB54IcSiRkz3u0mtyyNzeX/JQmxFxIyWrrc24JK3EuVK', 52 | '$2y$15$LE0.AEojI.2T6RadZVhc7eVsAkGsv0A2t0cKgWQBuAes86m.G036q', 53 | '$2y$16$yYy5GcoIgdd02DmUM3tfded5R5mv4K5QNG8QZDylGadokBdSL2WU6'); 54 | 55 | PasswordHashFailures : array [1..7] of AnsiString = ( 56 | '$2y$10$LCb3aOt8lAXSzNrEpQKDQO1zc2wCCQltrDwSEbb9JaUo4OKbph', 57 | '$2y$11$H7TRTJZqQTzN5RCiwMOne.yjVxyKCd4GyLrBQzV91gK0T4XQeKTNadr', 58 | '$2y$12$EL5tAZCoKb/kz4Q6WWCiw.DY1Ow/PcyE0w0Uo/SNjtnq7mePss/YQ', 59 | '$2y$13$ou4ZkaFPLILNkSLNINSw9uEARJOQQr8u02KbVuosBs3ULxpbEpjwt', 60 | '$2y$14$jvv79wTecdgfOjhefJL8B.ziJNvfqf.hR9IkUdEzgOVyqzgUDMn.W', 61 | '$2y$15$EdDG3DH94Yw5HWD8pHFpwuF6Bs/24cnf0c.H2UrhPeld4sl5.LP.', 62 | '$2y$16$NjsYCIxFgM0KUfJ2N0tW1umTh4hV696cEwVo8TM/gYdfbc4duwwd/'); 63 | 64 | begin 65 | 66 | TBCrypt := TBCryptHash.Create; 67 | 68 | Assertions := 0; 69 | FailedAssertions := 0; 70 | PassedAssertions := 0; 71 | 72 | WriteLn(#10#13'Testing Pascal Hashes ...'#10#13); 73 | for i := 1 to 14 do 74 | begin 75 | Write('Testing : ', PasswordHashes[i]); 76 | try 77 | Assert(TBCrypt.VerifyHash(StaticPassword, PasswordHashes[i]) = True, 'Should Be True'); 78 | Inc(Assertions); 79 | except 80 | on e: EAssertionFailed do 81 | begin 82 | WriteLn(' - Fail'); 83 | Inc(FailedAssertions); 84 | Continue; 85 | end; 86 | end; 87 | WriteLn(' - Pass'); 88 | Inc(PassedAssertions); 89 | if i = 7 then 90 | begin 91 | Writeln(#10#13'Testing BSD Hashes ...'#10#13); 92 | end; 93 | end; 94 | WriteLn(#10#13'Testing PHP Hashes ...'#10#13); 95 | for i := 1 to 7 do 96 | begin 97 | Write('Testing : ', PHPPasswordHashes[i]); 98 | try 99 | Assert(TBCrypt.VerifyHash(StaticPassword, PHPPasswordHashes[i]) = True, 'Should Be True'); 100 | Inc(Assertions); 101 | except 102 | on e: EAssertionFailed do 103 | begin 104 | WriteLn(' - Fail'); 105 | Inc(FailedAssertions); 106 | Continue; 107 | end; 108 | end; 109 | WriteLn(' - Pass'); 110 | Inc(PassedAssertions); 111 | end; 112 | WriteLn(#10#13'Testing UTF8 with ', UTF8TestString, ' ... '#10#13); 113 | Write('Testing : ', UTF8TestHash); 114 | try 115 | Assert(TBCrypt.VerifyHash(UTF8TestString, UTF8TestHash) = True, 'Should Be True'); 116 | Inc(Assertions); 117 | Inc(PassedAssertions); 118 | Writeln(' - Pass'); 119 | except 120 | on e: EAssertionFailed do 121 | begin 122 | WriteLn(' - Fail'); 123 | Inc(FailedAssertions); 124 | Dec(PassedAssertions); 125 | end; 126 | end; 127 | 128 | WriteLn(#10#13'Testing UTF8 PHP Hash with ', UTF8TestString, ' ... '#10#13); 129 | Write('Testing : ', UTF8PHPHash); 130 | try 131 | Assert(TBCrypt.VerifyHash(UTF8TestString, UTF8PHPHash) = True, 'Should Be True'); 132 | Inc(Assertions); 133 | Inc(PassedAssertions); 134 | Writeln(' - Pass'); 135 | except 136 | on e: EAssertionFailed do 137 | begin 138 | WriteLn(' - Fail'); 139 | Inc(FailedAssertions); 140 | Dec(PassedAssertions); 141 | end; 142 | end; 143 | 144 | WriteLn(#10#13'Testing Failures ...'#10#13); 145 | for i := 1 to 7 do 146 | begin 147 | Write('Testing : ', PasswordHashFailures[i]); 148 | try 149 | Assert(TBCrypt.VerifyHash(StaticPassword, PasswordHashFailures[i]) = False, 'Should Be False'); 150 | Inc(Assertions); 151 | except 152 | on e: EAssertionFailed do 153 | begin 154 | WriteLn(' - Fail'); 155 | Inc(FailedAssertions); 156 | Continue; 157 | end; 158 | end; 159 | WriteLn(' - Pass'); 160 | Inc(PassedAssertions); 161 | 162 | end; 163 | 164 | WriteLn(#10#13'Testing Rehash True ...'#10#13); 165 | for i := 1 to 7 do 166 | begin 167 | Write('Testing : ', PasswordHashes[i]); 168 | try 169 | Assert(TBCrypt.NeedsRehash(PasswordHashes[i], 17) = True, 'Should Be True'); 170 | Inc(Assertions); 171 | except 172 | on e: EAssertionFailed do 173 | begin 174 | WriteLn(' - Fail'); 175 | Inc(FailedAssertions); 176 | Continue; 177 | end; 178 | end; 179 | WriteLn(' - Pass'); 180 | Inc(PassedAssertions); 181 | end; 182 | 183 | WriteLn(#10#13'Testing Rehash False ...'#10#13); 184 | j := 10; 185 | for i := 1 to 7 do 186 | begin 187 | Write('Testing : ', PasswordHashes[i]); 188 | try 189 | Assert(TBCrypt.NeedsRehash(PasswordHashes[i], j) = False, 'Should Be False'); 190 | Inc(Assertions); 191 | except 192 | on e: EAssertionFailed do 193 | begin 194 | WriteLn(' - Fail'); 195 | Inc(FailedAssertions); 196 | Inc(j); 197 | Continue; 198 | end; 199 | end; 200 | WriteLn(' - Pass'); 201 | Inc(PassedAssertions); 202 | Inc(j); 203 | end; 204 | 205 | WriteLn(#10#13'Testing HashGetInfo on hash '#10#13, HashToMatch2, ' ...'#10#13); 206 | PasswordInfo := TBCrypt.HashGetInfo(HashToMatch2); 207 | Passed := True; 208 | With PasswordInfo do 209 | begin 210 | Writeln('Algo : ', Algo); 211 | try 212 | Assert(Algo = bcPHP); 213 | Inc(Assertions); 214 | except 215 | on e: EAssertionFailed do 216 | begin 217 | Inc(FailedAssertions); 218 | end; 219 | end; 220 | WriteLn('AlgoName : ', AlgoName); 221 | WriteLn('Cost : ', Cost); 222 | Write('Salt : ', BCryptSalt); 223 | try 224 | Assert(Length(BCryptSalt) = 22, 'Should Be True'); 225 | Inc(Assertions); 226 | except 227 | on e: EAssertionFailed do 228 | begin 229 | Passed := False; 230 | end; 231 | end; 232 | if Passed = False then 233 | begin 234 | Writeln(' Length - Fail'); 235 | Inc(FailedAssertions); 236 | end else 237 | begin 238 | Writeln(' Length - Pass'); 239 | Inc(PassedAssertions); 240 | end; 241 | Passed := True; 242 | Write('Hash : ', BCryptHash); 243 | try 244 | Assert(Length(BCryptHash) = 31, 'Should Be True'); 245 | Inc(Assertions); 246 | except 247 | on e: EAssertionFailed do 248 | begin 249 | Passed := False; 250 | end; 251 | end; 252 | if Passed = False then 253 | begin 254 | Writeln(' Length - Fail'); 255 | Inc(FailedAssertions); 256 | end else 257 | begin 258 | Writeln(' Length - Pass'); 259 | Inc(PassedAssertions); 260 | end; 261 | 262 | end; 263 | 264 | WriteLn(#10#13'Testing HashGetInfo on bsd hash '#10#13, BSDHashToMatch, ' ...'#10#13); 265 | PasswordInfo := TBCrypt.HashGetInfo(BSDHashToMatch); 266 | Passed := True; 267 | With PasswordInfo do 268 | begin 269 | Writeln('Algo : ', Algo); 270 | try 271 | Assert(Algo = bcBSD); 272 | Inc(Assertions); 273 | except 274 | on e: EAssertionFailed do 275 | begin 276 | Inc(FailedAssertions); 277 | end; 278 | end; 279 | WriteLn('AlgoName : ', AlgoName); 280 | WriteLn('Cost : ', Cost); 281 | Write('Salt : ', BCryptSalt); 282 | try 283 | Assert(Length(BCryptSalt) = 22, 'Should Be True'); 284 | Inc(Assertions); 285 | except 286 | on e: EAssertionFailed do 287 | begin 288 | Passed := False; 289 | end; 290 | end; 291 | if Passed = False then 292 | begin 293 | Writeln(' Length - Fail'); 294 | Inc(FailedAssertions); 295 | end else 296 | begin 297 | Writeln(' Length - Pass'); 298 | Inc(PassedAssertions); 299 | end; 300 | Passed := True; 301 | Write('Hash : ', BCryptHash); 302 | try 303 | Assert(Length(BCryptHash) = 31, 'Should Be True'); 304 | Inc(Assertions); 305 | except 306 | on e: EAssertionFailed do 307 | begin 308 | Passed := False; 309 | end; 310 | end; 311 | if Passed = False then 312 | begin 313 | Writeln(' Length - Fail'); 314 | Inc(FailedAssertions); 315 | end else 316 | begin 317 | Writeln(' Length - Pass'); 318 | Inc(PassedAssertions); 319 | end; 320 | 321 | end; 322 | 323 | Writeln(#10#13'Testing PasswordInfo with bad Hashes.'#10#13); 324 | Passed := False; 325 | try 326 | Write('Short Hash : ', ShortHash); 327 | PasswordInfo := TBCrypt.HashGetInfo(ShortHash); 328 | Inc(Assertions); 329 | except 330 | on e: EHash do 331 | begin 332 | Passed := True; 333 | end; 334 | end; 335 | if Passed = True then 336 | begin 337 | Writeln(' - Pass'); 338 | Inc(PassedAssertions); 339 | end else 340 | begin 341 | Writeln(' - Fail'); 342 | Inc(FailedAssertions); 343 | end; 344 | Passed := False; 345 | try 346 | Write('Long Hash : ', LongHash); 347 | PasswordInfo := TBCrypt.HashGetInfo(LongHash); 348 | Inc(Assertions); 349 | except 350 | on e: EHash do 351 | begin 352 | Passed := True; 353 | end; 354 | end; 355 | if Passed = True then 356 | begin 357 | Writeln(' - Pass'); 358 | Inc(PassedAssertions); 359 | end else 360 | begin 361 | Writeln(' - Fail'); 362 | Inc(FailedAssertions); 363 | end; 364 | 365 | Writeln(#10#13'Testing hashing ...'#10#13); 366 | Writeln(TBCrypt.CreateHash(StaticPassword)); 367 | Writeln(TBCrypt.CreateHash(StaticPassword, bcBSD)); 368 | Writeln(TBCrypt.CreateHash(StaticPassword, bcDefault)); 369 | Writeln(TBCrypt.CreateHash(StaticPassword, bcPHP)); 370 | Writeln(TBCrypt.CreateHash(StaticPassword, bcBSD, 14)); 371 | Writeln(TBCrypt.CreateHash(StaticPassword, bcDefault, 14)); 372 | Writeln(TBCrypt.CreateHash(StaticPassword, bcPHP, 14)); 373 | Writeln(#10#13); 374 | 375 | TBCrypt.Free; 376 | Writeln('Assertions : ', Assertions); 377 | Writeln('Passed Assertions : ', PassedAssertions); 378 | Writeln('Failed Assertions : ', FailedAssertions); 379 | Writeln; 380 | end. 381 | -------------------------------------------------------------------------------- /tests/PHPBCryptTest.php: -------------------------------------------------------------------------------- 1 | substr($pascalHash, 4, 2)] 82 | ), 83 | ' - Fail' 84 | ) 85 | ) { 86 | print ' - Pass' . PHP_EOL; 87 | } 88 | } 89 | print PHP_EOL; 90 | --------------------------------------------------------------------------------