Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/YofUtils.pas

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


Revision 1.10 - (show annotations) (download) (as text)
Sat Oct 9 15:06:19 2004 UTC (19 years, 6 months ago) by yoffy
Branch: MAIN
CVS Tags: v1_59_0_771, v1_59_0_770, v1_59_0_773, v1_59_0_772, v1_59_0_775, v1_59_0_774, v1_59_0_777, v1_59_0_776, v1_56_0_715, v1_59_0_778, v1_63_1_819, v1_57_0_737, v1_62_0_812, v1_57_0_735, v1_57_0_734, v1_57_0_733, v1_57_0_732, v1_57_0_731, v1_57_0_730, v1_50_2_606, v1_51_0_612, v1_50_0_581, v1_50_0_580, v1_50_0_587, v1_50_0_586, v1_57_0_739, v1_57_0_738, v1_59_1_765, v1_51_1_639, v1_53_0_671, v1_50_0_595, v1_60_0_788, v1_60_0_789, v1_54_0_677, v1_54_0_676, v1_50_0_572, v1_58_0_748, marged-Bb50, v1_58_0_745, v1_60_0_781, v1_60_0_782, v1_58_0_746, v1_60_0_784, v1_54_0_678, v1_60_0_786, v1_60_0_787, v1_56_0_707, v1_59_0_767, v1_56_0_705, v1_56_0_704, v1_56_0_703, v1_56_0_702, v1_56_0_701, v1_56_0_700, v1_59_1_778, v1_51_0_626, v1_57_0_723, b51, v1_52_1_658, v1_51_0_622, v1_59_0_768, v1_59_0_769, v1_50_0_598, v1_57_0_725, v1_57_0_726, v1_57_0_727, v1_57_0_720, v1_57_0_722, v1_57_1_744, v1_50_0_590, bv1_49_0_564, v1_50_0_593, v1_57_0_728, v1_57_0_729, v1_50_0_596, bv1_49_0_563, v1_52_0_646, v1_50_0_557, v1_57_0_736, v1_50_0_585, v1_51_0_611, v1_51_0_620, v1_52_0_644, v1_58_0_752, v1_58_0_750, v1_58_0_751, v1_58_0_756, v1_58_0_757, v1_58_0_754, v1_58_0_755, v1_58_0_759, v1_52_0_643, v1_57_0_719, v1_57_0_718, v1_56_0_716, v1_54_0_687, v1_56_0_710, v1_56_0_711, v1_56_1_717, v1_56_1_716, v1_51_0_634, v1_51_0_635, v1_51_0_636, v1_51_0_637, v1_54_0_688, v1_54_0_689, v1_51_0_632, v1_51_0_633, v1_50_0_603, v1_54_0_684, v1_50_0_582, v1_54_0_685, v1_53_0_664, v1_61_0_796, v1_61_0_797, v1_61_0_795, v1_52_0_647, v1_61_0_798, v1_61_0_799, v1_50_0_604, v1_51_0_638, v1_52_0_648, v1_53_0_661, v1_53_0_663, v1_53_0_662, v1_53_0_665, v1_53_0_667, v1_53_0_666, v1_53_0_669, v1_53_0_668, v1_55_0_692, v1_55_0_693, v1_55_0_696, v1_55_0_697, v1_55_0_694, v1_55_0_695, merged-remodeling, v1_50_0_577, v1_52_0_645, v1_52_0_651, v1_54_1_691, v1_52_0_650, v1_56_2_724, v1_50_0_606, v1_56_2_722, v1_50_0_588, v1_52_0_652, v1_55_1_697, v1_52_0_642, v1_52_0_654, v1_51_0_616, v1_56_0_714, v1_51_0_614, v1_51_0_615, v1_53_0_672, v1_51_0_613, v1_53_0_670, v1_63_0_818, v1_63_0_817, v1_63_0_816, v1_63_0_815, v1_51_1_640, v1_54_0_686, v1_51_0_618, v1_51_0_619, bv1_49_0_565, v1_54_0_680, v1_54_0_681, v1_62_0_805, v1_62_0_804, v1_62_0_807, v1_62_0_806, b50, v1_56_0_712, v1_62_0_803, v1_62_0_802, v1_56_0_713, v1_62_0_809, v1_50_0_574, v1_54_0_682, v1_50_0_584, v_step1, v1_56_0_721, v1_50_0_573, v1_50_0_600, v1_51_0_630, v1_50_0_571, v1_54_0_683, v1_51_0_631, v1_60_0_780, v1_60_0_779, v1_62_0_810, v1_62_0_811, v1_58_0_747, v1_60_0_783, root-of-draw, v1_50_0_576, v1_54_0_679, v1_59_2_785, marged_bRESPOPUP, v1_50_2_604, v1_50_0_578, v1_54_0_675, v1_51_0_628, v1_50_0_579, v1_51_0_617, root-of-Bb50, root-of-Bb51, v1_56_0_706, root-of-remodel, root-of-Bb53, v1_50_0_594, v1_52_1_657, v1_54_0_674, v1_52_0_660, v1_60_1_793, v1_50_0_602, v1_51_0_629, v1_54_0_690, v1_51_0_627, v1_50_0_601, v1_58_0_763, v1_58_0_762, v1_58_0_761, v1_58_0_760, v1_51_0_625, v1_62_1_813, v1_51_0_623, v1_57_2_749, v1_50_0_605, v1_57_0_742, v1_57_0_743, v1_57_0_740, v1_57_0_741, v1_52_0_655, v1_56_0_709, v1_57_0_744, v1_52_0_656, v1_56_0_708, v1_52_0_649, v1_61_0_800, v1_53_1_673, v1_50_0_599, v1_56_0_699, v1_56_0_698, v1_50_0_561, v1_51_0_624, v1_51_1_641, v1_51_0_621, v1_60_0_793, v1_60_0_792, v1_60_0_791, v1_60_0_790, v1_60_2_794, v1_61_1_801, HEAD
Branch point for: Bb57, Bb56, Bb55, Bb53, Bb52, Bb51, Bb62, Bb63, Bb60, Bb61, remodeling, Bb59, Bb58, Bb50, bRESPOPUP, bListSU, Bb54, Bdraw
Changes since 1.9: +103 -25 lines
File MIME type: text/x-pascal
- 右回転シフトを行う ror 関数の追加。
- string の 4 byte ハッシュを計算する GetStringHash 関数の追加。
- TMappedFile が書きこみ許可にして開けなかったバグを修正。

1 unit YofUtils;
2
3 {!
4 \file YofUtils.pas
5 \brief HttpApp ???????若?潟????????????∽??/span>
6
7 $Id$
8 }
9 interface
10
11 //==================================================
12 uses
13 //==================================================
14
15 Classes, SysUtils,
16 Windows;
17
18 {!
19 \brief ExtractHttpFields ???????若??/span>
20 \warning ????????????撮????????? chrWhite ??????????????????????絵???鐚?鐚?
21 }
22 procedure ExtractHttpFields(
23 const chrSep : TSysCharSet;
24 const chrWhite : TSysCharSet;
25 const strValue : string;
26 var strResult : TStringList;
27 unknownFlag : boolean = false
28 );
29
30 function HtmlEncode(
31 const strValue : string
32 ) : string;
33
34 function HtmlDecode(
35 const strValue : string
36 ) : string;
37
38 function HttpEncode(
39 const strValue : string
40 ) : string;
41
42 function HttpDecode(
43 const strValue : string
44 ) : string;
45
46 {!
47 \brief MachiesMask ???????若??/span>
48 \warning ????????????撮????????? [] ??篏帥?c??罩h?茵?憗??????????????????????絵???鐚?鐚?
49 }
50 function MatchesMask(
51 const filename, mask : string
52 ) : boolean;
53
54 //! ?<?帥???c?????帥??罩h?茵?憝?宴??????????????????舟??
55 function RegExpEncode(
56 const text : string
57 ) : string;
58
59 {!
60 \brief 茵?ず?<???祉?若?吾???翫就
61 \param msg 茵?ず?????<???祉?若??/span>
62 \param elements 臀????茯?
63
64 msg ??賢??舟??????????茯?? '^???#39; ?ц;??????
65 elements ???壕??????c????茯??????????障????<br>
66
67 <pre><code>
68 elements := IntToStr( 10 ) + #10 + 'hoge';
69 m := MessageStyle(
70 '^0 ??????^1????臀?????障??????',
71 elements );
72 </code></pre>
73
74 ?у?阪???????? m ????10 ??????hoge????臀?????障???????????????障????
75 }
76 function MessageStyle(
77 const msg : string;
78 const elements : string
79 ) : string; overload;
80
81 function MessageStyle(
82 const msg : string;
83 const elements : TStringList
84 ) : string; overload;
85
86 {!
87 \brief ?喝??荵≪?激????
88 \param v ??荵≪??????/span>
89 \param n ??荵≪????????/span>
90 \return Longword( (v shl (32 - n)) or (v shr n) ) ????/span>
91 }
92 function ror( v, n : Longword ) : Longword; register;
93
94 {!
95 \brief ??絖?????????激?ュ?ゃ??荐?膊?
96 \param s ??絖???
97 \return ????激?ュ? ( 4 byte )
98 \warning 紊????ゃ???? 4 byte ??軒??????????????
99 ?????ゃ???阪????????絖??????♂??????????障????
100 ?潟?潟??????????莎激????????篋?????????????荐?菴違???帥?????????????
101
102 ?????∽?違??????ゃ???激????絖????? 4 byte ??軒???障????<br>
103 ????????с??'abcdefgh' ? 'efghabcd' ???????ゃ????????????????????膈???
104 紊?絨????????????????????????障????
105 }
106 function GetStringHash( const s : string ) : Longword;
107
108 type
109 //! Mode ?ゃ??????????
110 EMappedFileModeError = class( Exception );
111 //! ???????潟?違??け??
112 EMappedFileMappingError = class( Exception );
113
114 //! ?<?≪???????????祉???<?ゃ? ??????/span>
115 TMappedFile = class( TObject )
116 private
117 FFileHandle : THandle;
118 FMappingHandle : THandle;
119 FSize : Int64;
120 FViewAddress : Pointer;
121 public
122 {!
123 \brief ?<?≪?????????????<?ゃ???????
124 \param filePath ??????<?ゃ????????/span>
125 \param mode fmOpenRead (??????????) ?障??? fmOpenReadWrite
126 \param maximumSize ???若?吾?泣?ゃ?冴????? (0 ?????上???????<?ゃ???泣?ゃ??
127 }
128 constructor Create(
129 const filePath : string;
130 mode : Longword = fmOpenRead;
131 maximumSize : Int64 = 0 );
132 destructor Destroy; override;
133
134 //! ?泣?ゃ?冴????
135 property Size : Int64 read FSize;
136 //! ?≪?????鴻????
137 property Memory : Pointer read FViewAddress;
138 end;
139
140 //==================================================
141 const
142 //==================================================
143 kYofKanji : TSysCharSet = [#$80..#$A0, #$E0..#$ff];
144
145 //==================================================
146 implementation
147 //==================================================
148
149 uses MojuUtils;
150
151 procedure ExtractHttpFields(
152 const chrSep : TSysCharSet;
153 const chrWhite : TSysCharSet;
154 const strValue : string;
155 var strResult : TStringList;
156 unknownFlag : boolean = false
157 );
158 var
159 last, p, strLen : Integer;
160 begin
161
162 strLen := Length( strValue );
163 p := 1;
164 last := 1;
165
166 while p <= strLen do
167 begin
168
169 if strValue[ p ] in chrSep then
170 begin
171 strResult.Add( Copy( strValue, last, p - last ) );
172 last := p + 1;
173 end;
174
175 p := p + 1;
176
177 end;
178
179 if last <> p then
180 strResult.Add( Copy( strValue, last, strLen - last + 1 ) );
181
182 end;
183
184 function HtmlEncode(
185 const strValue : string
186 ) : string;
187 var
188 i : Integer;
189 strLen : Integer;
190 strResult : string;
191 begin
192
193 strLen := Length( strValue );
194 i := 1;
195
196 while i <= strLen do
197 begin
198
199 case strValue[ i ] of
200 '&':
201 begin
202 strResult := strResult + '&amp;';
203 end;
204 '<':
205 begin
206 strResult := strResult + '&lt;';
207 end;
208 '>':
209 begin
210 strResult := strResult + '&gt;';
211 end;
212 '"':
213 begin
214 strResult := strResult + '&quot;';
215 end;
216 else
217 begin
218 if strValue[ i ] in kYofKanji then
219 begin
220 strResult := strResult + strValue[ i ];
221 Inc( i );
222 end;
223 strResult := strResult + strValue[ i ];
224 end;
225 end;
226
227 i := i + 1;
228
229 end;
230
231 Result := strResult;
232
233 end;
234
235 function HtmlDecode(
236 const strValue : string
237 ) : string;
238 var
239 strResult : string;
240 begin
241
242 strResult := StringReplace( strValue, '&lt;', '<', [rfReplaceAll] );
243 strResult := StringReplace( strResult, '&gt;', '>', [rfReplaceAll] );
244 strResult := StringReplace( strResult, '&quot;', '"', [rfReplaceAll] );
245 strResult := StringReplace( strResult, '&amp;', '&', [rfReplaceAll] );
246
247 Result := strResult;
248
249 end;
250
251 function HttpEncode(
252 const strValue : string
253 ) : string;
254 var
255 i : Integer;
256 strLen : Integer;
257 strResult : string;
258 b : Integer;
259 const
260 kHexCode : array [0..15] of char = (
261 '0', '1', '2', '3', '4', '5', '6', '7',
262 '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' );
263 begin
264
265 strLen := Length( strValue );
266 i := 1;
267
268 while i <= strLen do
269 begin
270
271 case strValue[ i ] of
272 '0' .. '9', 'a' .. 'z', 'A' .. 'Z', '*', '-', '.', '@', '_':
273 begin
274 strResult := strResult + strValue[ i ];
275 end;
276 else
277 begin
278 b := Integer( strValue[ i ] );
279 strResult := strResult + '%'
280 + kHexCode[ b div $10 ]
281 + kHexCode[ b mod $10 ];
282 end;
283 end;
284
285 i := i + 1;
286
287 end;
288
289 Result := strResult;
290
291 end;
292
293 function toupper(
294 ch : Longword
295 ) : Byte; Register;
296 asm
297 mov ecx, eax // ecx = (ch - 'a')
298 sub cl, 'a'
299 cmp ecx, 26 // edx = ecx < 26 (絨??絖???????????????)
300 sbb edx, edx
301 and edx, $20 // edx &= 0x20 (絨??絖????? 0x20)
302 xor eax, edx // eax ^= edx
303 end;
304
305 function HttpDecode(
306 const strValue : string
307 ) : string;
308 var
309 i : Integer;
310 strLen : Integer;
311 strResult : string;
312 b : Integer;
313 begin
314
315 strLen := Length( strValue );
316 i := 1;
317
318 while i <= strLen do
319 begin
320
321 if '%' = strValue[ i ] then begin
322 Inc( i );
323 if strValue[ i ] in ['a' .. 'z', 'A' .. 'Z'] then
324 b := (toupper( Longword( strValue[ i ] ) ) - 55) shl 4
325 else
326 b := (Byte( strValue[ i ] ) - Byte( '0' )) shl 4;
327 Inc( i );
328 if strValue[ i ] in ['a' .. 'z', 'A' .. 'Z'] then
329 b := b or (toupper( Longword( strValue[ i ] ) ) - 55)
330 else
331 b := b or (Byte( strValue[ i ] ) - Byte( '0' ));
332
333 strResult := strResult + Char( Byte( b ) );
334 end else begin
335 strResult := strResult + strValue[ i ];
336 end;
337
338 Inc( i );
339
340 end;
341
342 Result := strResult;
343
344 end;
345
346 function MatchesMask(
347 const filename, mask : string
348 ) : boolean;
349 var
350 pName, pMask : Integer;
351 ptrName, ptrMask : PChar;
352 nameLen, maskLen : Integer;
353 chrUpMask : char;
354 delimiterPos : Integer;
355 begin
356
357 nameLen := Length( filename );
358 maskLen := Length( mask );
359 ptrName := PChar( filename );
360 ptrMask := PChar( mask );
361 pName := 0;
362 pMask := 0;
363 delimiterPos := Pos( '\', string( ptrName + pName ) );
364 while delimiterPos > 0 do
365 begin
366 pName := pName + delimiterPos;
367 delimiterPos := Pos( '\', string( ptrName + pName ) );
368 end;
369
370 while (pMask < maskLen) and (pName < nameLen) do
371 begin
372
373 case ptrMask[ pMask ] of
374 '?':
375 begin
376 // ??? 1 絖????????????
377 end;
378 '*':
379 begin
380 pMask := pMask + 1;
381 // mask ??莎井?祉?????c????腟?篋?
382 if pMask >= maskLen then
383 begin
384 Result := true;
385 exit;
386 end;
387
388 // * ???????絖????ャ???障?ч??違??
389 chrUpMask := upcase( ptrMask[ pMask ] );
390 while chrUpMask <> UpCase( ptrName[ pName ] ) do
391 begin
392 pName := pName + 1;
393 if pName >= nameLen then
394 begin
395 Result := true;
396 exit;
397 end;
398 end;
399
400 // * ???????絖???荀??ゃ?????????c????腟?篋?
401 if chrUpMask <> UpCase( ptrName[ pName ] ) then
402 begin
403 Result := false;
404 exit;
405 end;
406
407 pName := pName + 1;
408 pMask := pMask + 1;
409 end;
410 else
411 begin
412 // ??? 1 ??絖??????c????腟?篋?
413 if UpCase( ptrMask[ pMask ] ) <> UpCase( ptrName[ pName ] ) then
414 begin
415 Result := false;
416 exit;
417 end;
418
419 end;
420 end;
421
422 // 罨<????絖???/span>
423 pName := pName + 1;
424 pMask := pMask + 1;
425
426 end;
427
428 if (pMask >= maskLen) and (pName >= nameLen) then
429 Result := true
430 else
431 Result := false;
432
433 end;
434
435 function RegExpEncode(
436 const text : string
437 ) : string;
438 var
439 strResult : string;
440 begin
441
442 strResult := StringReplace( text, '\', '\\', [rfReplaceAll] );
443 strResult := StringReplace( strResult, '[', '\[', [rfReplaceAll] );
444 strResult := StringReplace( strResult, ']', '\]', [rfReplaceAll] );
445 strResult := StringReplace( strResult, '(', '\(', [rfReplaceAll] );
446 strResult := StringReplace( strResult, ')', '\)', [rfReplaceAll] );
447 strResult := StringReplace( strResult, '[', '\[', [rfReplaceAll] );
448 strResult := StringReplace( strResult, ']', '\]', [rfReplaceAll] );
449 strResult := StringReplace( strResult, '*', '\*', [rfReplaceAll] );
450 strResult := StringReplace( strResult, '?', '\?', [rfReplaceAll] );
451 strResult := StringReplace( strResult, '.', '\.', [rfReplaceAll] );
452 strResult := StringReplace( strResult, '+', '\+', [rfReplaceAll] );
453 strResult := StringReplace( strResult, '|', '\|', [rfReplaceAll] );
454 strResult := StringReplace( strResult, '^', '\^', [rfReplaceAll] );
455 strResult := StringReplace( strResult, '$', '\$', [rfReplaceAll] );
456
457 Result := strResult;
458
459 end;
460
461 function MessageStyle(
462 const msg : string;
463 const elements : string
464 ) : string;
465 var
466 list : TStringList;
467 begin
468
469 list := TStringList.Create;
470 try
471 list.Text := elements;
472 Result := MessageStyle( msg, list );
473 finally
474 list.Free;
475 end;
476
477 end;
478
479 function MessageStyle(
480 const msg : string;
481 const elements : TStringList
482 ) : string;
483 var
484 i : Integer;
485 begin
486
487 Result := msg;
488 for i := elements.Count - 1 downto 0 do
489 Result := CustomStringReplace( Result, '^' + IntToStr( i ), elements[ i ], false );
490
491 end;
492
493 //==============================
494 // ror
495 //==============================
496 function ror( v, n : Longword ) : Longword; register;
497 asm
498 mov cl, dl
499 ror eax, cl
500 end;
501
502 //==============================
503 // GetStringHash
504 //==============================
505 function GetStringHash( const s : string ) : Longword;
506 var
507 l : Integer;
508 v : Longword;
509 p, tail : PChar;
510 begin
511
512 l := Length( s );
513 p := PChar( s );
514 v := $87654321;
515 tail := p + (l and $fffffffc);
516 while p < tail do begin
517 v := PDword( p )^ + (v shl 2) * ($10000 - v);
518 p := p + 4;
519 end;
520 tail := PChar( s ) + l;
521 while p < tail do begin
522 v := PByte( p )^ + (v shl 2) * ($10000 - v);
523 Inc( p );
524 end;
525
526 Result := v xor ((v shl 2) * ($10000 - v));
527
528 end;
529
530 { TMappedFile }
531
532 constructor TMappedFile.Create(
533 const filePath : string;
534 mode : Longword = fmOpenRead;
535 maximumSize : Int64 = 0 );
536 var
537 dwFileDesiredAccess : DWORD;
538 flProtect : DWORD;
539 dwViewDesiredAccess : DWORD;
540 begin
541
542 case mode of
543 fmOpenRead:
544 begin
545 dwFileDesiredAccess := GENERIC_READ;
546 flProtect := PAGE_READONLY;
547 dwViewDesiredAccess := FILE_MAP_READ;
548 end;
549
550 fmOpenReadWrite:
551 begin
552 dwFileDesiredAccess := GENERIC_READ or GENERIC_WRITE;
553 flProtect := PAGE_READWRITE;
554 dwViewDesiredAccess := FILE_MAP_WRITE;
555 end;
556
557 else
558 raise EMappedFileModeError.Create( '???<?ゃ?????若???潟???≪?若????筝?罩c?с????' );
559 end;
560
561 FFileHandle := CreateFile(
562 PChar( filePath ), dwFileDesiredAccess, 0, nil, OPEN_ALWAYS,
563 FILE_ATTRIBUTE_NORMAL, 0 );
564 if FFileHandle = INVALID_HANDLE_VALUE then
565 raise EFOpenError.Create( '???<?ゃ???????若???潟??け?????障??????' );
566
567 FSize := GetFileSize( FFileHandle, nil );
568 if FSize < maximumSize then
569 FSize := maximumSize;
570
571 FMappingHandle := CreateFileMapping(
572 FFileHandle, nil, flProtect,
573 DWORD( (maximumSize shr 32) and $ffffffff ),
574 DWORD( maximumSize and $ffffffff ),
575 nil );
576 if FFileHandle = INVALID_HANDLE_VALUE then
577 raise EMappedFileMappingError.Create( '???<?ゃ???????????潟?違??け?????障??????' );
578
579 FViewAddress := MapViewOfFile( FMappingHandle, dwViewDesiredAccess, 0, 0, 0 );
580 if FViewAddress = nil then
581 raise EMappedFileMappingError.Create( '???<?ゃ???????????潟?違??け?????障??????' );
582
583 end;
584
585 destructor TMappedFile.Destroy;
586 begin
587
588 UnmapViewOfFile( FViewAddress );
589 CloseHandle( FMappingHandle );
590 CloseHandle( FFileHandle );
591
592 end;
593
594 end.

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