Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/Trip.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.8 - (show annotations) (download) (as text)
Tue Nov 24 13:41:50 2009 UTC (14 years, 4 months ago) by h677
Branch: MAIN
CVS Tags: v1_62_0_803
Changes since 1.7: +1 -1 lines
File MIME type: text/x-pascal
生キー指定で、19桁以上が拡張領域なのに、11桁以上になっていた不具合の修正

1 unit Trip;
2
3 {!
4 \file Trip.pas
5 \brief ??????????????
6
7 http://ghanyan.monazilla.org/trip.html
8 ?????????潟????????Щ罎????????????????障??????
9 }
10 interface
11
12 uses
13 SHA1Unit, UBase64, SysUtils, MojuUtils;
14
15 type
16 CryptBlock = record
17 b_data : array [0..63] of char;
18 end;
19 PCryptBlock = ^CryptBlock;
20
21 CryptOrdering = record
22 o_data : array [0..63] of char;
23 end;
24
25 CryptData = record
26 Key : CryptBlock;
27 EP : ^CryptOrdering;
28 end;
29
30 {!
31 \brief ??????????????
32 \param pw ???????????鴻???若??
33 \return ??????????????????
34 }
35 function get_2ch_trip(
36 const pw : PChar
37 ) : string;
38
39 {!
40 \brief ?????????????????荀???alt??????
41 \parm pw salt?????????????鴻???若??
42 \param salt ????????salt???主??????? (array[0..2] of char)
43 }
44 procedure get_salt(
45 const pw : PChar;
46 salt : PChar
47 );
48
49 const
50 kCryptInitialTr : CryptOrdering = ( o_data: (
51 #58,#50,#42,#34,#26,#18,#10, #2,#60,#52,#44,#36,#28,#20,#12, #4,
52 #62,#54,#46,#38,#30,#22,#14, #6,#64,#56,#48,#40,#32,#24,#16, #8,
53 #57,#49,#41,#33,#25,#17, #9, #1,#59,#51,#43,#35,#27,#19,#11, #3,
54 #61,#53,#45,#37,#29,#21,#13, #5,#63,#55,#47,#39,#31,#23,#15, #7
55 ) );
56
57 kCryptFinalTr : CryptOrdering = ( o_data: (
58 #40, #8,#48,#16,#56,#24,#64,#32,#39, #7,#47,#15,#55,#23,#63,#31,
59 #38, #6,#46,#14,#54,#22,#62,#30,#37, #5,#45,#13,#53,#21,#61,#29,
60 #36, #4,#44,#12,#52,#20,#60,#28,#35, #3,#43,#11,#51,#19,#59,#27,
61 #34, #2,#42,#10,#50,#18,#58,#26,#33, #1,#41, #9,#49,#17,#57,#25
62 ) );
63
64 kCryptSwap : CryptOrdering = ( o_data: (
65 #33,#34,#35,#36,#37,#38,#39,#40,#41,#42,#43,#44,#45,#46,#47,#48,
66 #49,#50,#51,#52,#53,#54,#55,#56,#57,#58,#59,#60,#61,#62,#63,#64,
67 #1, #2, #3, #4, #5, #6, #7, #8, #9,#10,#11,#12,#13,#14,#15,#16,
68 #17,#18,#19,#20,#21,#22,#23,#24,#25,#26,#27,#28,#29,#30,#31,#32
69 ) );
70
71 kCryptKeyTr1 : CryptOrdering = ( o_data: (
72 #57, #49, #41, #33, #25, #17, #9, #1, #58, #50, #42, #34, #26, #18,
73 #10, #2, #59, #51, #43, #35, #27, #19, #11, #3, #60, #52, #44, #36,
74 #63, #55, #47, #39, #31, #23, #15, #7, #62, #54, #46, #38, #30, #22,
75 #14, #6, #61, #53, #45, #37, #29, #21, #13, #5, #28, #20, #12, #4,
76 #0, #0, #0, #0, #0, #0, #0, #0
77 ) );
78
79 kCryptKeyTr2 : CryptOrdering = ( o_data: (
80 #14,#17,#11,#24, #1, #5, #3,#28,#15, #6,#21,#10,
81 #23,#19,#12, #4,#26, #8,#16, #7,#27,#20,#13, #2,
82 #41,#52,#31,#37,#47,#55,#30,#40,#51,#45,#33,#48,
83 #44,#49,#39,#56,#34,#53,#46,#42,#50,#36,#29,#32,
84 #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
85 #0, #0, #0, #0
86 ) );
87
88 kCryptEtr : CryptOrdering = ( o_data: (
89 #32, #1, #2, #3, #4, #5, #4, #5, #6, #7, #8, #9,
90 #8, #9,#10,#11,#12,#13,#12,#13,#14,#15,#16,#17,
91 #16,#17,#18,#19,#20,#21,#20,#21,#22,#23,#24,#25,
92 #24,#25,#26,#27,#28,#29,#28,#29,#30,#31,#32, #1,
93 #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
94 #0, #0, #0, #0
95 ) );
96
97 kCryptPtr : CryptOrdering = ( o_data: (
98 #16, #7,#20,#21,#29,#12,#28,#17, #1,#15,#23,#26, #5,#18,#31,#10,
99 #2, #8,#24,#14,#32,#27, #3, #9,#19,#13,#30, #6,#22,#11, #4,#25,
100 #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
101 #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0
102 ) );
103
104 kCryptS_boxes : array [ 0..7, 0..63 ] of Char = (
105 ( #14, #4,#13, #1, #2,#15,#11, #8, #3,#10, #6,#12, #5, #9, #0, #7,
106 #0,#15, #7, #4,#14, #2,#13, #1,#10, #6,#12,#11, #9, #5, #3, #8,
107 #4, #1,#14, #8,#13, #6, #2,#11,#15,#12, #9, #7, #3,#10, #5, #0,
108 #15,#12, #8, #2, #4, #9, #1, #7, #5,#11, #3,#14,#10, #0, #6,#13
109 ),
110
111 ( #15, #1, #8,#14, #6,#11, #3, #4, #9, #7, #2,#13,#12, #0, #5,#10,
112 #3,#13, #4, #7,#15, #2, #8,#14,#12, #0, #1,#10, #6, #9,#11, #5,
113 #0,#14, #7,#11,#10, #4,#13, #1, #5, #8,#12, #6, #9, #3, #2,#15,
114 #13, #8,#10, #1, #3,#15, #4, #2,#11, #6, #7,#12, #0, #5,#14, #9
115 ),
116
117 ( #10, #0, #9,#14, #6, #3,#15, #5, #1,#13,#12, #7,#11, #4, #2, #8,
118 #13, #7, #0, #9, #3, #4, #6,#10, #2, #8, #5,#14,#12,#11,#15, #1,
119 #13, #6, #4, #9, #8,#15, #3, #0,#11, #1, #2,#12, #5,#10,#14, #7,
120 #1,#10,#13, #0, #6, #9, #8, #7, #4,#15,#14, #3,#11, #5, #2,#12
121 ),
122
123 ( #7,#13,#14, #3, #0, #6, #9,#10, #1, #2, #8, #5,#11,#12, #4,#15,
124 #13, #8,#11, #5, #6,#15, #0, #3, #4, #7, #2,#12, #1,#10,#14, #9,
125 #10, #6, #9, #0,#12,#11, #7,#13,#15, #1, #3,#14, #5, #2, #8, #4,
126 #3,#15, #0, #6,#10, #1,#13, #8, #9, #4, #5,#11,#12, #7, #2,#14
127 ),
128
129 ( #2,#12, #4, #1, #7,#10,#11, #6, #8, #5, #3,#15,#13, #0,#14, #9,
130 #14,#11, #2,#12, #4, #7,#13, #1, #5, #0,#15,#10, #3, #9, #8, #6,
131 #4, #2, #1,#11,#10,#13, #7, #8,#15, #9,#12, #5, #6, #3, #0,#14,
132 #11, #8,#12, #7, #1,#14, #2,#13, #6,#15, #0, #9,#10, #4, #5, #3
133 ),
134
135 ( #12, #1,#10,#15, #9, #2, #6, #8, #0,#13, #3, #4,#14, #7, #5,#11,
136 #10,#15, #4, #2, #7,#12, #9, #5, #6, #1,#13,#14, #0,#11, #3, #8,
137 #9,#14,#15, #5, #2, #8,#12, #3, #7, #0, #4,#10, #1,#13,#11, #6,
138 #4, #3, #2,#12, #9, #5,#15,#10,#11,#14, #1, #7, #6, #0, #8,#13
139 ),
140
141 ( #4,#11, #2,#14,#15, #0, #8,#13, #3,#12, #9, #7, #5,#10, #6, #1,
142 #13, #0,#11, #7, #4, #9, #1,#10,#14, #3, #5,#12, #2,#15, #8, #6,
143 #1, #4,#11,#13,#12, #3, #7,#14,#10,#15, #6, #8, #0, #5, #9, #2,
144 #6,#11,#13, #8, #1, #4,#10, #7, #9, #5, #0,#15,#14, #2, #3,#12
145 ),
146
147 ( #13, #2, #8, #4, #6,#15,#11, #1,#10, #9, #3,#14, #5, #0,#12, #7,
148 #1,#15,#13, #8,#10, #3, #7, #4,#12, #5, #6,#11, #0,#14, #9, #2,
149 #7,#11, #4, #1, #9,#12,#14, #2, #0, #6,#10,#13,#15, #3, #5, #8,
150 #2, #1,#14, #7, #4,#10, #8,#13,#15,#12, #9, #0, #3, #5, #6,#11
151 )
152 );
153
154 kCryptRots : array [ 0..15 ] of Integer = (
155 1,1,2,2,2,2,2,2,1,2,2,2,2,2,2,1
156 );
157
158 implementation
159
160 procedure transpose(
161 var data : CryptBlock;
162 var t : CryptOrdering;
163 n : Integer
164 );
165 var
166 x : CryptBlock;
167 begin
168 x := data;
169
170 while n > 0 do
171 begin
172 Dec( n );
173 data.b_data[ n ] := x.b_data[ Integer( t.o_data[ n ] ) - 1 ];
174 end;
175 end;
176
177 procedure rotate(
178 var key : CryptBlock
179 );
180 var
181 p : PChar;
182 ep : PChar;
183 data0, data28 : Char;
184 begin
185
186 p := key.b_data;
187 ep := @(key.b_data[ 55 ]);
188 data0 := key.b_data[ 0 ];
189 data28 := key.b_data[ 28 ];
190
191 while p < ep do
192 begin
193 Inc( p );
194 p[ -1 ] := p^;
195 end;
196 key.b_data[ 27 ] := data0;
197 key.b_data[ 55 ] := data28;
198
199 end;
200
201 procedure f(
202 i : Integer;
203 var key : CryptBlock;
204 var a : CryptBlock;
205 var x : CryptBlock;
206 var data : CryptData
207 );
208 var
209 e, ikey, y : CryptBlock;
210 k : Integer;
211 p, q, r : PChar;
212
213 xb, ir : Integer;
214
215 temp : CryptOrdering;
216 begin
217
218 e := a;
219 transpose( e, data.EP^, 48 );
220 for k := kCryptRots[ i ] downto 1
221 do rotate( key );
222 ikey := key;
223 temp := kCryptKeyTr2; transpose( ikey, temp, 48 );
224 p := @(y.b_data[ 48 ]);
225 q := @(e.b_data[ 48 ]);
226 r := @(ikey.b_data[ 48 ]);
227 while p > y.b_data do
228 begin
229 Dec( p );
230 Dec( q );
231 Dec( r );
232 p^ := Char( Integer( q^ ) xor Integer( r^ ) );
233 end;
234 q := x.b_data;
235 for k := 0 to 7 do
236 begin
237 ir := Integer( p^ ) shl 5; Inc( p );
238 ir := ir + Integer( p^ ) shl 3; Inc( p );
239 ir := ir + Integer( p^ ) shl 2; Inc( p );
240 ir := ir + Integer( p^ ) shl 1; Inc( p );
241 ir := ir + Integer( p^ ); Inc( p );
242 ir := ir + Integer( p^ ) shl 4; Inc( p );
243
244 xb := Integer( kCryptS_Boxes[ k, ir ] );
245
246 q^ := Char( (xb shr 3) and 1 ); Inc( q );
247 q^ := Char( (xb shr 2) and 1 ); Inc( q );
248 q^ := Char( (xb shr 1) and 1 ); Inc( q );
249 q^ := Char( xb and 1 ); Inc( q );
250 end;
251 temp := kCryptPtr; transpose( x, temp, 32 );
252
253 end;
254
255 procedure setkey_r(
256 k : PChar;
257 var data : CryptData
258 );
259 var
260 temp : CryptOrdering;
261 begin
262
263 Move( Pointer( k )^, data.Key.b_data, SizeOf(CryptBlock) );
264 temp := kCryptKeyTr1; transpose( data.Key, temp, 56 );
265
266 end;
267
268 procedure encrypt_r(
269 blck : PChar;
270 edflag : Integer;
271 var data : CryptData
272 );
273 var
274 key : PCryptBlock;
275 p : PCryptBlock;
276 i : Integer;
277
278 j : Integer;
279 k : Integer;
280 b, x : CryptBlock;
281
282 temp : CryptOrdering;
283 begin
284
285 key := @data.Key;
286 p := PCryptBlock( blck );
287
288 temp := kCryptInitialTr;transpose( p^, temp, 64 );
289 for i := 15 downto 0 do
290 begin
291 if edflag <> 0 then
292 j := i
293 else
294 j := 15 - i;
295
296 b := p^;
297 for k := 31 downto 0
298 do p^.b_data[ k ] := b.b_data[ k + 32 ];
299 f( j, key^, p^, x, data );
300 for k := 31 downto 0
301 do p^.b_data[ k + 32 ] := Char( Integer( b.b_data[ k ] ) xor Integer( x.b_data[ k ] ) );
302 end;
303 temp := kCryptSwap; transpose( p^, temp, 64 );
304 temp := kCryptFinalTr; transpose( p^, temp, 64 );
305
306 end;
307
308 function crypt_r(
309 pw : PChar;
310 salt : PChar;
311 var data : CryptData
312 ) : string;
313 var
314 pwb : array [0..65] of char;
315 cp : PChar;
316 ret : array [0..15] of char;
317 p : PChar;
318 new_etr : CryptOrdering;
319 i : Integer;
320
321 j : Integer;
322 c : Char;
323 t : Integer;
324 temp : Integer;
325 begin
326
327 p := pwb;
328 data.EP := @kCryptEtr;
329 while (pw^ <> #0) and (p < pwb + 64) do
330 begin
331 j := 7;
332
333 while j > 0 do
334 begin
335 Dec( j );
336 p^ := Char( (Integer(pw^) shr j) and 1 );
337 Inc( p );
338 end;
339 //Dec( j );
340
341 Inc( pw );
342 p^ := #0;
343 Inc( p );
344 end;
345 while (p < pwb + 64) do
346 begin
347 p^ := #0;
348 Inc( p );
349 end;
350
351 p := pwb;
352 setKey_r( p, data );
353
354 while (p < pwb + 66) do
355 begin
356 p^ := #0;
357 Inc( p );
358 end;
359
360 new_etr := kCryptEtr;
361 data.EP := @new_etr;
362 if (salt[ 0 ] = #0) and (salt[ 1 ] = #0) then
363 salt := '**#0';
364 for i := 0 to 1 do
365 begin
366 c := salt^;
367 Inc( salt );
368
369 ret[ i ] := c;
370 if c > 'Z' then
371 c := Char( Integer(c) - (6 + 7 + Integer('.')) )
372 else if c > '9' then
373 c := Char( Integer(c) - (7 + Integer('.')) )
374 else
375 c := Char( (Integer(c) - Integer('.')) and $ff );
376
377 for j := 0 to 5 do
378 begin
379 if ((Integer(c) shr j) and 1) <> 0 then
380 begin
381 t := 6 * i + j;
382 temp := Integer( new_etr.o_data[ t ] );
383 new_etr.o_data[ t ] := new_etr.o_data[ t + 24 ];
384 new_etr.o_data[ t + 24 ] := Char( temp );
385 end;
386 end;
387 end;
388
389 if ret[ 1 ] = #0 then
390 ret[ 1 ] := ret[ 0 ];
391
392 for i := 0 to 24 do
393 encrypt_r( pwb, 0, data );
394 data.EP := @kCryptEtr;
395
396 p := pwb;
397 cp := ret + 2;
398 while p < pwb + 66 do
399 begin
400 c := #0;
401 j := 6;
402
403 while j > 0 do
404 begin
405 Dec( j );
406 c := Char( (Integer(c) shl 1) or Integer(p^) );
407 Inc( p );
408 end;
409 //Dec( j );
410 c := Char( Integer(c) + Integer('.') );
411 if c > '9' then
412 c := Char( Integer(c) + 7 );
413 if c > 'Z' then
414 c := Char( Integer(c) + 6 );
415 cp^ := c;
416 Inc( cp );
417 end;
418 cp^ := #0;
419 Result := ret;
420
421 end;
422
423 procedure get_pw_salt(
424 const pw : PChar;
425 var convpw : String;
426 const salt : PChar
427 );
428 var
429 i : integer;
430 begin
431 // ^([0-9A-Fa-f]{16})([./0-9A-Za-z]{0,2})$
432 if (Length(pw) >= 17) or (Length(pw) <= 19) then begin
433 // ???守????
434 for i := 0 to 7 do begin
435 if (Pos(pw[2*i + 0 + 1], '0123456789abcdefABCDEF') > 0) and
436 (Pos(pw[2*i + 1 + 1], '0123456789abcdefABCDEF') > 0) then begin
437 convpw := convpw +
438 Char(StrToInt( 'x' + pw[2*i + 0 + 1] ) shl 4 + StrToInt( 'x' + pw[2*i + 1 + 1] ));
439 end else begin
440 convpw := '';
441 Break;
442 end;
443 end;
444
445 if (Length(convpw) = 8) then begin
446 if (Length(pw) = 19) then begin
447 if (Pos(pw[17], './0123456789abcdefABCDEF') > 0) and
448 (Pos(pw[18], './0123456789abcdefABCDEF') > 0) then begin
449 salt[ 0 ] := pw[17];
450 salt[ 1 ] := pw[18];
451 salt[ 2 ] := #0;
452 end else begin
453 convpw := '';
454 end;
455 end else if (Length(pw) = 18) then begin
456 if (Pos(pw[17], './0123456789abcdefABCDEF') > 0) then begin
457 salt[ 0 ] := pw[17];
458 salt[ 1 ] := '.';
459 salt[ 2 ] := #0;
460 end else begin
461 convpw := '';
462 end;
463 end else begin
464 salt[ 0 ] := '.';
465 salt[ 1 ] := '.';
466 salt[ 2 ] := #0;
467 end;
468 end;
469 end;
470 end;
471
472 function get_2ch_trip(
473 const pw : PChar
474 ) : string;
475 var
476 s : CryptData;
477 salt : array [0..2] of char;
478 digest : TSHA1Digest;
479 convpw : String;
480 begin
481 Result := '';
482 if pw[ 0 ] = #0 then
483 begin
484 Exit;
485 end;
486 // 11罅??障?с???ф?劫?
487 if (Length(pw) <= 11) then begin
488 get_salt( pw, salt );
489 Result := Copy( crypt_r( pw, salt, s ), 4, 100 );
490 end else begin
491 // ?井?劫?????????
492 if pw[ 0 ] = '$' then begin
493 // 絨??ャ???≦宍??/span>
494 Result := '???';
495 end else begin
496 convpw := '';
497 // ?????惹?劫?
498 if pw[ 0 ] = '#' then begin
499 get_pw_salt(pw, convpw, salt);
500 end;
501 if (pw[ 0 ] = '#') and (Length(pw) >= 20) then begin
502 // 絨??ャ???≦宍??/span>
503 Result := '???';
504 end else if Length(convpw) = 8 then begin
505 Result := Copy( crypt_r( PChar(convpw), salt, s ), 4, 100 );
506 end else begin
507 // ?井?劫?
508 StringHashSHA1(digest, pw);
509 Result := Copy(HogeBase64Encode(digest), 0, 12);
510 Result := MojuUtils.CustomStringReplace(Result, '+', '.');
511 end;
512 end;
513 end;
514 end;
515
516 procedure get_salt(
517 const pw : PChar;
518 salt : PChar
519 );
520 var
521 i, len : Integer;
522 begin
523 salt[ 0 ] := #0;
524
525 if pw[ 1 ] <> #0 then
526 begin
527 if pw[ 2 ] <> #0 then
528 len := 2
529 else
530 len := 1;
531 for i := 0 to len - 1 do
532 begin
533 if ('.' <= pw[ i + 1 ]) and (pw[ i + 1 ] <= 'z' ) then
534 salt[ i ] := pw[ i + 1 ]
535 else
536 salt[ i ] := '.';
537
538 if Pos ( salt[ i ], ':;<=>?@' ) > 0 then begin
539 salt[ i ] := Char( Integer( salt[ i ] ) + 7 );
540 end else if Pos( salt[ i ], '[\\]^_`' ) > 0 then begin
541 salt[ i ] := Char( Integer( salt[ i ] ) + 6 );
542 end;
543 end;
544 if len = 1 then
545 salt[ 1 ] := 'H';
546 salt[ 2 ] := #0;
547 end else begin
548 salt[ 0 ] := 'H';
549 salt[ 1 ] := '.';
550 end;
551 end;
552
553 end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26