1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179: 180: 181: 182: 183: 184: 185: 186: 187: 188: 189: 190: 191: 192: 193: 194: 195: 196: 197: 198: 199: 200: 201: 202: 203: 204: 205: 206: 207: 208: 209: 210: 211: 212: 213: 214: 215: 216: 217: 218: 219: 220: 221: 222: 223: 224: 225: 226: 227: 228: 229: 230: 231: 232: 233: 234: 235: 236: 237: 238: 239: 240: 241: 242: 243: 244: 245: 246: 247: 248: 249: 250: 251: 252: 253: 254: 255: 256: 257: 258: 259: 260: 261: 262: 263: 264: 265: 266: 267: 268: 269: 270: 271: 272: 273: 274: 275: 276: 277: 278: 279: 280: 281: 282: 283: 284: 285: 286: 287: 288: 289: 290: 291: 292: 293: 294: 295: 296: 297: 298: 299: 300: 301: 302: 303: 304: 305: 306: 307: 308: 309: 310: 311: 312: 313: 314: 315: 316: 317: 318: 319: 320: 321: 322: 323: 324: 325: 326: 327: 328: 329: 330: 331: 332: 333: 334: 335: 336: 337: 338: 339: 340: 341: 342: 343: 344: 345: 346: 347: 348: 349: 350: 351: 352: 353: 354: 355: 356: 357: 358: 359: 360: 361: 362: 363: 364: 365: 366: 367: 368: 369: 370: 371: 372: 373: 374: 375: 376: 377: 378: 379: 380: 381: 382: 383: 384: 385: 386: 387: 388: 389: 390: 391: 392: 393: 394: 395: 396: 397: 398: 399: 400: 401: 402: 403: 404: 405: 406: 407: 408: 409: 410: 411: 412: 413: 414: 415: 416: 417: 418: 419: 420: 421: 422: 423: 424: 425: 426: 427: 428: 429: 430: 431: 432: 433: 434: 435: 436: 437: 438: 439: 440: 441: 442: 443: 444: 445: 446: 447: 448: 449: 450: 451: 452: 453: 454: 455: 456: 457: 458: 459: 460: 461: 462: 463: 464: 465: 466: 467: 468: 469: 470: 471: 472: 473: 474: 475: 476: 477: 478: 479: 480: 481: 482: 483: 484: 485: 486: 487: 488: 489: 490: 491: 492: 493: 494: 495: 496: 497: 498: 499: 500: 501: 502: 503: 504: 505: 506: 507: 508: 509: 510: 511: 512: 513: 514: 515: 516: 517: 518: 519: 520: 521: 522: 523: 524: 525: 526: 527: 528: 529: 530: 531: 532: 533: 534: 535: 536: 537: 538: 539: 540: 541: 542: 543: 544: 545: 546: 547: 548: 549: 550: 551: 552: 553: 554: 555: 556: 557: 558: 559: 560: 561: 562: 563: 564: 565: 566: 567: 568: 569: 570: 571: 572: 573: 574: 575: 576: 577: 578: 579: 580: 581: 582: 583: 584: 585: 586: 587: 588: 589: 590: 591: 592: 593: 594: 595: 596: 597: 598: 599: 600: 601: 602: 603: 604: 605: 606: 607: 608: 609: 610: 611: 612: 613: 614: 615: 616: 617: 618: 619: 620: 621: 622: 623: 624: 625: 626: 627: 628: 629: 630: 631: 632: 633: 634:
| {$DEFINE DEBUG} {$B-}
unit fastwild;
interface
uses Windows;
type TWildcardFunction = function(Str: PChar): boolean; register;
function CompileWildcardFunction(Pattern: AnsiString): TWildcardFunction; procedure FreeWildCardFunction(WildcardFunction: TWildcardFunction);
implementation
{$IFDEF DEBUG} var WildcardFunctionCount: integer = 0; {$ENDIF}
function CompileWildcardFunction(Pattern: AnsiString): TWildcardFunction; type TFixup = record CodeAddr: DWORD; IsData: boolean; case integer of 1: (DataAddr: integer); 2: (Typ: integer); end; TFixups = array of TFixup; const DEADBEEF = #$EF#$BE#$AD#$DE;
PUSHESI = #$56; PUSHEDI = #$57; POPESI = #$5E; POPEDI = #$5F; MOVESIEAX = #$89#$C6; COMPAREBYTE = #$80#$3E; INCESI = #$46; DECESI = #$4E; COMPAREDWORD = #$81#$3E; COMPAREWORD = #$66 + COMPAREDWORD; ADDESI4 = #$83#$C6#$04; ADDESI2 = #$83#$C6#$02; MOVEDIDB = #$BF + DEADBEEF; MOVECXIMM32 = #$B9; LEAEAXESI1 = #$8D#$46#$01; REPZCMPSB = #$F3#$A6; JNZFALSE = #$0F#$85 + DEADBEEF; JZFALSE = #$0F#$84 + DEADBEEF; JBFALSE = #$0F#$82 + DEADBEEF; JNBFALSE = #$0F#$83 + DEADBEEF; CMOVNZEDIEAX = #$0F#$45#$F0; JNZE3 = #$75#$E3; JNZF0 = #$75#$F0; JNZEE = #$75#$EE; JNZED = #$75#$ED; JBF6 = #$72#$F6; JNBF6 = #$73#$F6; CMPESI18 = #$80#$7E#$FF; CMPESI132 = #$81#$7E#$FF; CMPESI116 = #$66 + CMPESI132; XOREAXEAX = #$31#$C0; LODSB = #$AC; BTRMEAX = #$0F#$A3#$05 + DEADBEEF; MOVEDXESI = #$89#$F2; MOVESIEDX = #$89#$D6; INCEDX = #$42; RETTRUE = #$B0#$01#$C3; RETFALSE = #$31#$C0#$C3; PREFIX = PUSHESI + PUSHEDI + MOVESIEAX; SUFFIX = POPEDI + POPESI + RETTRUE + POPEDI + POPESI + RETFALSE;
RETURNFALSE = 0; FIXUPJUMP = 1; var Code, Data: AnsiString; Fixups: TFixups; p: PAnsiChar; DataAddress: Pointer; RetFalseAddr: integer; dummy: dword absolute dataAddress; FixupAddr: PDWORD; FixupAddrI: PInteger absolute FixupAddr;
function AddData(const s: string): integer; overload; begin Result := Length(Data); Data := Data + s; end;
function AddData(const s; length: integer): integer; overload; begin Result := System.Length(Data); SetLength(Data, System.Length(Data) + length); Move(s, Data[Result+1], length); end;
procedure AddFixup(ACodeAddr: integer; AIsData: boolean; AParam: DWORD); begin SetLength(Fixups, Length(Fixups)+1); with Fixups[high(Fixups)] do begin CodeAddr := length(Code) + ACodeAddr; IsData := AIsData; DataAddr := AParam; end; end;
procedure EmitDW(d: dword); begin SetLength(Code, Length(Code)+4); PDWORD(@Code[Length(Code)-3])^ := d; end;
procedure EmitW(w: word); begin SetLength(Code, Length(Code)+2); PWORD(@Code[Length(Code)-1])^ := w; end;
procedure JumpAddress(codeAddr: integer; jumpAddr: integer); begin PDWord(@Code[Length(Code)+codeAddr+1])^ := jumpAddr; AddFixup(codeAddr, false, FIXUPJUMP); end;
procedure CreateSetCode(jumpTo: integer = -1); var mode: byte; charAddr: dword;
chars: set of char; char1: char;
negation: boolean; begin negation := p^ = '!'; if negation then inc(p); mode := 0; case p^ of '\': if not ((p+1)^ in ['*', '+']) then dec(p); '*': mode := 1; '+': mode := 2; else dec(p); end; inc(p);
chars := []; while not (p^ in [#0, ']']) do begin if p^ = '\' then inc(p);
if p^ <> #0 then begin char1 := p^; if (p+1)^ = '-' then begin inc(p, 2); if p^ in [#0, ']'] then chars := chars + [char1, '-'] else begin if p^ = '\' then inc(p); if p^ = #0 then chars := chars + [char1..'\'] else begin if char1 > p^ then chars := chars + [char1, '-', p^] else chars := chars + [char1..p^]; inc(p); end; end; end else begin chars := chars + [char1]; inc(p); end; end; end; if p^ = ']' then inc(p);
if negation then chars := chars + [#0];
charAddr := AddData(chars, sizeof(chars)); Code := Code + XOREAXEAX + LODSB + BTRMEAX; AddFixup(-4, true, charAddr); if mode = 1 then begin if negation then Code := Code + JNBF6 + DECESI else Code := Code + JBF6 + DECESI; end else begin if negation then Code := Code + JBFALSE else Code := Code + JNBFALSE;
if jumpTo > -1 then JumpAddress(-4, jumpTo) else AddFixup(-4, false, RETURNFALSE);
if mode = 2 then begin Code := Code + LODSB + BTRMEAX; AddFixup(-4, true, charAddr); if negation then Code := Code + JNBF6 + DECESI else Code := Code + JBF6 + DECESI; end; end;
if (p^ = #0) then begin Code := Code + COMPAREBYTE + #00 + JNZFALSE;
if jumpTo > -1 then JumpAddress(-4, jumpTo) else AddFixup(-4, false, RETURNFALSE); end; end;
procedure CreateStringCode(Str: string; jumpTo: integer = -1); begin case Length(Str) of 1: begin Code := Code + COMPAREBYTE + Str[1] + JNZFALSE; if jumpTo > -1 then JumpAddress(-4, jumpTo) else AddFixup(-4, false, RETURNFALSE); Code := Code + INCESI; end; 2: begin Code := Code + COMPAREWORD; EmitW(pword(@Str[1])^); Code := Code + JNZFALSE; if jumpTo > -1 then JumpAddress(-4, jumpTo) else AddFixup(-4, false, RETURNFALSE); Code := Code + ADDESI2; end; 4: begin Code := Code + COMPAREDWORD; EmitDW(pdword(@Str[1])^); Code := Code + JNZFALSE; if jumpTo > -1 then JumpAddress(-4, jumpTo) else AddFixup(-4, false, RETURNFALSE); Code := Code + ADDESI4; end; else Code := Code + MOVEDIDB + MOVECXIMM32; AddFixup(-5, true, AddData(Str)); EmitDW(Length(Str)); Code := Code + REPZCMPSB + JNZFALSE; if jumpTo > -1 then JumpAddress(-4, jumpTo) else AddFixup(-4, false, RETURNFALSE); end; end;
function ReadNextPart: string; begin result := '';
if p^ = '\' then begin inc(p); if p^ <> #0 then begin result := result + p^; inc(p); end; end;
while not (p^ in [#0, '*', '?', '[']) do begin result := result + p^; inc(p); if p^ = '\' then begin inc(p); if p^ <> #0 then begin result := result + p^; inc(p); end; end; end; if p^ = #0 then Result := Result + p^; end;
procedure FlushBuffer(Asterisk: boolean; const Buffer: string); var start: integer; begin if ((Length(Buffer) > 0) and (Buffer[1] <> #0)) or (Asterisk and (Buffer <> #0)) then begin case Asterisk of true: begin start := -1; if p^ in ['[', '?'] then begin Code := Code + MOVEDXESI; start := Length(code); Code := Code + MOVESIEDX; Code := Code + INCEDX;
end;
Code := Code + COMPAREBYTE + #00 + JZFALSE; AddFixup(-4, false, RETURNFALSE); case Length(Buffer) of 0: ; 1: Code := Code + INCESI + CMPESI18 + Buffer[1] + JNZF0; 2: begin Code := Code + INCESI + CMPESI116; EmitW(PWord(@Buffer[1])^); Code := Code + JNZEE; end; 4: begin Code := Code + INCESI + CMPESI132; EmitDW(PDWord(@Buffer[1])^); Code := Code + JNZED; end; else Code := Code + MOVEDIDB; AddFixup(-4, true, AddData(Buffer)); Code := Code + LEAEAXESI1 + MOVECXIMM32; EmitDW(Length(Buffer)); Code := Code + REPZCMPSB + CMOVNZEDIEAX + JNZE3; end;
if start >= 0 then begin while not (p^ in [#0, '*']) do begin case p^ of '?': begin inc(p); Code := Code + COMPAREBYTE + #00 + JZFALSE + INCESI; AddFixup(-5, false, RETURNFALSE); if p^ = #0 then begin Code := Code + COMPAREBYTE + #00 + JNZFALSE; JumpAddress(-4, start); end; end; '[': begin Inc(p); CreateSetCode(start); end; '\': CreateStringCode(ReadNextPart, start); else CreateStringCode(ReadNextPart, start); end; end; end; end; false: CreateStringCode(Buffer); end; end; end;
var i: integer; QC: integer; Asterisk: boolean; begin Code := PREFIX; p := PChar(Pattern);
if p^ = #0 then begin Code := Code + COMPAREBYTE + #00 + JNZFALSE; AddFixup(-4, false, RETURNFALSE); end else while p^ <> #0 do begin case p^ of '?', '*': begin asterisk := p^ = '*'; inc(p); if asterisk then QC := -1 else QC := 0; while p^ in ['?', '*'] do begin if p^ = '*' then asterisk := true else inc(QC); inc(p); end; for i := 0 to QC do begin Code := Code + COMPAREBYTE + #00 + JZFALSE + INCESI; AddFixup(-5, false, RETURNFALSE); end; if (p^ = #0) and not asterisk then begin Code := Code + COMPAREBYTE + #00 + JNZFALSE; AddFixup(-4, false, RETURNFALSE); end; if asterisk then FlushBuffer(true, ReadNextPart); end; '[': begin inc(p); CreateSetCode; end; '\': FlushBuffer(false, ReadNextPart); else FlushBuffer(false, ReadNextPart); end; end; Code := Code + SUFFIX; @Result := VirtualAlloc(nil, Length(Code) + Length(Data), MEM_COMMIT, PAGE_READWRITE);
if @Result <> nil then begin Move(Code[1], PDWORD(Result)^, Length(Code)); DataAddress := Pointer(DWORD(@Result)+DWORD(Length(Code))); RetFalseAddr := (DWORD(DataAddress)-9) - DWORD(@Result); Move(Data[1], PDWORD(DataAddress)^, Length(Data)); for i := 0 to High(Fixups) do begin FixupAddr := PDWORD(DWORD(@Result) + Fixups[i].CodeAddr); case Fixups[i].IsData of true: FixupAddr^ := DWORD(DataAddress) + DWORD(Fixups[i].DataAddr); false: case Fixups[i].Typ of RETURNFALSE: FixupAddrI^ := RetFalseAddr - integer(Fixups[i].CodeAddr); FIXUPJUMP: FixupAddrI^ := FixupAddrI^ - integer(Fixups[i].CodeAddr) - 4; end; end; end; {$IFDEF DEBUG} inc(WildcardFunctionCount); {$ENDIF} end;
VirtualProtect(Pointer(Result), Length(Code) + Length(Data), PAGE_EXECUTE, dummy); end;
procedure FreeWildCardFunction(WildcardFunction: TWildcardFunction); {$IFDEF D2005}{$IFNDEF DEBUG}inline;{$ENDIF}{$ENDIF} begin VirtualFree(@WildcardFunction, 0, MEM_RELEASE); {$IFDEF DEBUG} dec(WildcardFunctionCount); {$ENDIF} end;
initialization
finalization {$IFDEF DEBUG} if WildcardFunctionCount > 0 then MessageBox(0, '[fastwild.pas] Memory leak detected', 'Possible memory leak', MB_ICONERROR); {$ENDIF} end. |