myunits.pas

乐都SQL版传奇全套代码,绝对可编译

    // Delphi uses ESI, EDI, and EBX a lot,
    // so we must preserve them.
    push ESI
    push EDI
    push EBX
    // Get the address of sourceString[1]
    // and Add (StartPos-1).
    // We do this for the purpose of finding
    // the NEXT occurrence, rather than
    // always the first!
    mov EDI, aSourceString
    add EDI, StartPos
    Dec EDI
    // Get the address of aFindString.
    mov ESI, aFindString
    // Note how many bytes we need to
    // look through in aSourceString
    // to find aFindString.
    mov ECX, SourceLen
    // Get the first char of aFindString;
    // note how it is done outside of the
    // main loop, as it never changes!
    Mov  Al, [ESI]
    // Now the FindFirstCharacter loop!
    @ScaSB:
    // Get the value of the current
    // character in aSourceString.
    // This is equal to ah := EDI^, that
    // is what the [] are around [EDI].
    Mov  Ah, [EDI]
    // Compare this character with aDestString[1].
    cmp  Ah,Al
    // If they're not equal we don't
    // compare the strings.
    jne  @NextChar
    // If they're equal, obviously we do!
    @CompareStrings:
    // Put the length of aFindLen in EBX.
    mov  EBX, aFindLen
    // We DEC EBX to point to the end of
    // the string; that is, we don't want to
    // add 1 if aFindString is 1 in length!
    dec  EBX
    // add by ShengQuanhu
    // If EBX is zero, then we've successfully
    // compared each character; i.e. it's A MATCH!
    // It will be happened when aFindLen=1
    Jz @EndOfMatch
    //add end
//Here’s another optimization tip. People at this point usually PUSH ESI and
//so on and then POP ESI and so forth at the end–instead, I opted not to chan
//ge ESI and so on at all. This saves lots of pushing and popping!
    @CompareNext:
    // Get aFindString character +
    // aFindStringLength (the last char).
    mov  Al, [ESI+EBX]
    // Get aSourceString character (current
    // position + aFindStringLength).
    mov  Ah, [EDI+EBX]
    // Compare them.
    cmp  Al, Ah
    Jz   @Matches
    // If they don't match, we put the first char
    // of aFindString into Al again to continue
    // looking for the first character.
    Mov  Al, [ESI]
    Jmp  @NextChar
    @Matches:
    // If they match, we DEC EBX (point to
    // previous character to compare).
    Dec  EBX
    // If EBX <> 0 ("J"ump "N"ot "Z"ero), we
    // continue comparing strings.
    Jnz  @CompareNext
    //add by Shengquanhu
    @EndOfMatch:
    //add end
    // If EBX is zero, then we've successfully
    // compared each character; i.e. it's A MATCH!
    // Move the address of the *current*
    // character in EDI.
    // Note, we haven't altered EDI since
    // the first char was found.
    mov  EAX, EDI
    // This is an address, so subtract the
    // address of aSourceString[1] to get
    // an actual character position.
    sub  EAX, aSourceString
    // Inc EAX to make it 1-based,
    // rather than 0-based.
    inc  EAX
    // Put it into result.
    mov  Result, EAX
    // Finish this routine!
    jmp  @TheEnd
    @NextChar:
//This is where I jump to when I want to continue searching for the first char
//acter of aFindString in aSearchString:
    // Point EDI (aFindString[X]) to
    // the next character.
    Inc  EDI
    // Dec ECX tells us that we've checked
    // another character, and that we're
    // fast running out of string to check!
    dec  ECX
    // If EBX <> 0, then continue scanning
    // for the first character.
    jnz  @ScaSB
    // If EBX = 0, then move 0 into RESULT.
    mov  Result,0
    // Restore EBX, EDI, ESI for Delphi
    // to work correctly.
    // Note that they're POPped in the
    // opposite order they were PUSHed.
    @TheEnd:
    pop  EBX
    pop  EDI
    pop  ESI
  end;
end;

function FastPosNoCase(const aSourceString, aFindString: string; const
  aSourceLen, aFindLen, StartPos: Integer): Integer;
var
  SourceLen: Integer;
begin
  SourceLen := aSourceLen;
  SourceLen := SourceLen - aFindLen;
  if (StartPos - 1) > SourceLen then
  begin
    Result := 0;
    Exit;
  end;
  SourceLen := SourceLen - StartPos;
  SourceLen := SourceLen + 2;
  asm
    push ESI
    push EDI
    push EBX
    mov EDI, aSourceString
    add EDI, StartPos
    Dec EDI
    mov ESI, aFindString
    mov ECX, SourceLen
    Mov  Al, [ESI]
    // Make Al lowercase.
    and  Al, $df
    @ScaSB:
    Mov  Ah, [EDI]
    // Make Ah lowercase.
    and  Ah, $df
    cmp  Ah,Al
    jne  @NextChar
    @CompareStrings:
    mov  EBX, aFindLen
    dec  EBX
    //add by ShengQuanhu
    Jz   @EndOfMatch
    //add end
    @CompareNext:
    mov  Al, [ESI+EBX]
    mov  Ah, [EDI+EBX]
    // Make Al and Ah lowercase.
    and  Al, $df
    and  Ah, $df
    cmp  Al, Ah
    Jz   @Matches
    Mov  Al, [ESI]
    // Make Al lowercase.
    and  Al, $df
    Jmp  @NextChar
    @Matches:
    Dec  EBX
    Jnz  @CompareNext
    //add by Shengquanhu
    @EndOfMatch:
    //add end
    mov  EAX, EDI
    sub  EAX, aSourceString
    inc  EAX
    mov  Result, EAX
    jmp  @TheEnd
    @NextChar:
    Inc  EDI
    dec  ECX
    jnz  @ScaSB
    mov  Result,0
    @TheEnd:
    pop  EBX
    pop  EDI
    pop  ESI
  end;
end;

procedure DES(var Input; var Output; var Key; EnCrypt: Boolean);

const
  IP: array[1..64] of Byte = (58, 50, 42, 34, 26, 18, 10, 2,
    60, 52, 44, 36, 28, 20, 12, 4,
    62, 54, 46, 38, 30, 22, 14, 6,
    64, 56, 48, 40, 32, 24, 16, 8,
    57, 49, 41, 33, 25, 17, 9, 1,
    59, 51, 43, 35, 27, 19, 11, 3,
    61, 53, 45, 37, 29, 21, 13, 5,
    63, 55, 47, 39, 31, 23, 15, 7);
  InvIP: array[1..64] of Byte = (40, 8, 48, 16, 56, 24, 64, 32,
    39, 7, 47, 15, 55, 23, 63, 31,
    38, 6, 46, 14, 54, 22, 62, 30,
    37, 5, 45, 13, 53, 21, 61, 29,
    36, 4, 44, 12, 52, 20, 60, 28,
    35, 3, 43, 11, 51, 19, 59, 27,
    34, 2, 42, 10, 50, 18, 58, 26,
    33, 1, 41, 9, 49, 17, 57, 25);
  E: array[1..48] of Byte = (32, 1, 2, 3, 4, 5,
    4, 5, 6, 7, 8, 9,
    8, 9, 10, 11, 12, 13,
    12, 13, 14, 15, 16, 17,
    16, 17, 18, 19, 20, 21,
    20, 21, 22, 23, 24, 25,
    24, 25, 26, 27, 28, 29,
    28, 29, 30, 31, 32, 1);
  p: array[1..32] of Byte = (16, 7, 20, 21,
    29, 12, 28, 17,
    1, 15, 23, 26,
    5, 18, 31, 10,
    2, 8, 24, 14,
    32, 27, 3, 9,
    19, 13, 30, 6,
    22, 11, 4, 25);
  SBoxes: array[1..8, 0..3, 0..15] of Byte =
  (((14, 4, 13, 1, 2, 15, 11, 8, 3, 10, 6, 12, 5, 9, 0, 7),
    (0, 15, 7, 4, 14, 2, 13, 1, 10, 6, 12, 11, 9, 5, 3, 8),
    (4, 1, 14, 8, 13, 6, 2, 11, 15, 12, 9, 7, 3, 10, 5, 0),
    (15, 12, 8, 2, 4, 9, 1, 7, 5, 11, 3, 14, 10, 0, 6, 13)),

    ((15, 1, 8, 14, 6, 11, 3, 4, 9, 7, 2, 13, 12, 0, 5, 10),
    (3, 13, 4, 7, 15, 2, 8, 14, 12, 0, 1, 10, 6, 9, 11, 5),
    (0, 14, 7, 11, 10, 4, 13, 1, 5, 8, 12, 6, 9, 3, 2, 15),
    (13, 8, 10, 1, 3, 15, 4, 2, 11, 6, 7, 12, 0, 5, 14, 9)),

    ((10, 0, 9, 14, 6, 3, 15, 5, 1, 13, 12, 7, 11, 4, 2, 8),
    (13, 7, 0, 9, 3, 4, 6, 10, 2, 8, 5, 14, 12, 11, 15, 1),
    (13, 6, 4, 9, 8, 15, 3, 0, 11, 1, 2, 12, 5, 10, 14, 7),
    (1, 10, 13, 0, 6, 9, 8, 7, 4, 15, 14, 3, 11, 5, 2, 12)),

    ((7, 13, 14, 3, 0, 6, 9, 10, 1, 2, 8, 5, 11, 12, 4, 15),
    (13, 8, 11, 5, 6, 15, 0, 3, 4, 7, 2, 12, 1, 10, 14, 9),
    (10, 6, 9, 0, 12, 11, 7, 13, 15, 1, 3, 14, 5, 2, 8, 4),
    (3, 15, 0, 6, 10, 1, 13, 8, 9, 4, 5, 11, 12, 7, 2, 14)),

    ((2, 12, 4, 1, 7, 10, 11, 6, 8, 5, 3, 15, 13, 0, 14, 9),
    (14, 11, 2, 12, 4, 7, 13, 1, 5, 0, 15, 10, 3, 9, 8, 6),
    (4, 2, 1, 11, 10, 13, 7, 8, 15, 9, 12, 5, 6, 3, 0, 14),
    (11, 8, 12, 7, 1, 14, 2, 13, 6, 15, 0, 9, 10, 4, 5, 3)),

    ((12, 1, 10, 15, 9, 2, 6, 8, 0, 13, 3, 4, 14, 7, 5, 11),
    (10, 15, 4, 2, 7, 12, 9, 5, 6, 1, 13, 14, 0, 11, 3, 8),
    (9, 14, 15, 5, 2, 8, 12, 3, 7, 0, 4, 10, 1, 13, 11, 6),
    (4, 3, 2, 12, 9, 5, 15, 10, 11, 14, 1, 7, 6, 0, 8, 13)),

    ((4, 11, 2, 14, 15, 0, 8, 13, 3, 12, 9, 7, 5, 10, 6, 1),
    (13, 0, 11, 7, 4, 9, 1, 10, 14, 3, 5, 12, 2, 15, 8, 6),
    (1, 4, 11, 13, 12, 3, 7, 14, 10, 15, 6, 8, 0, 5, 9, 2),
    (6, 11, 13, 8, 1, 4, 10, 7, 9, 5, 0, 15, 14, 2, 3, 12)),

    ((13, 2, 8, 4, 6, 15, 11, 1, 10, 9, 3, 14, 5, 0, 12, 7),
    (1, 15, 13, 8, 10, 3, 7, 4, 12, 5, 6, 11, 0, 14, 9, 2),
    (7, 11, 4, 1, 9, 12, 14, 2, 0, 6, 10, 13, 15, 3, 5, 8),
    (2, 1, 14, 7, 4, 10, 8, 13, 15, 12, 9, 0, 3, 5, 6, 11)));

  PC_1: array[1..56] of Byte = (57, 49, 41, 33, 25, 17, 9,
    1, 58, 50, 42, 34, 26, 18,
    10, 2, 59, 51, 43, 35, 27,
    19, 11, 3, 60, 52, 44, 36,
    63, 55, 47, 39, 31, 23, 15,
    7, 62, 54, 46, 38, 30, 22,
    14, 6, 61, 53, 45, 37, 29,
    21, 13, 5, 28, 20, 12, 4);

  PC_2: array[1..48] of Byte = (14, 17, 11, 24, 1, 5,
    3, 28, 15, 6, 21, 10,
    23, 19, 12, 4, 26, 8,
    16, 7, 27, 20, 13, 2,
    41, 52, 31, 37, 47, 55,
    30, 40, 51, 45, 33, 48,
    44, 49, 39, 56, 34, 53,
    46, 42, 50, 36, 29, 32);

  ShiftTable: array[1..16] of Byte = (1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2,
    2, 1);

var
  InputValue: array[1..64] of Byte;
  OutputValue: array[1..64] of Byte;
  RoundKeys: array[1..16, 1..48] of Byte;
  l, r, FunctionResult: array[1..32] of Byte;
  c, d: array[1..28] of Byte;

  function GetBit(var data; Index: Byte): Byte;

  var
    Bits: array[0..7] of Byte absolute data;

  begin
    Dec(Index);
    if Bits[Index div 8] and (128 shr (Index mod 8)) > 0 then
      GetBit := 1
    else
      GetBit := 0;
  end; {GetBit}

  procedure SetBit(var data; Index, Value: Byte);

  var
    Bits: array[0..7] of Byte absolute data;
    Bit: Byte;

  begin
    Dec(Index);
    Bit := 128 shr (Index mod 8);
    case Value of
      0: Bits[Index div 8] := Bits[Index div 8] and (not Bit);
      1: Bits[Index div 8] := Bits[Index div 8] or Bit;
    end;
  end; {SetBit}

  procedure F(var FR, FK, Output);

  var
    r: array[1..48] of Byte absolute FR;
    k: array[1..48] of Byte absolute FK;
    Temp1: array[1..48] of Byte;
    Temp2: array[1..32] of Byte;
    n, H, i, j, row, Column: Integer;
    TotalOut: array[1..32] of Byte absolute Output;

  begin
    for n := 1 to 48 do
      Temp1[n] := r[E[n]] xor k[n];
    for n := 1 to 8 do
    begin
      i := (n - 1) * 6;
      j := (n - 1) * 4;
      row := Temp1[i + 1] * 2 + Temp1[i + 6];
      Column := Temp1[i + 2] * 8 + Temp1[i + 3] * 4 + Temp1[i + 4] * 2 + Temp1[i
        + 5];
      for H := 1 to 4 do
      begin
        case H of
          1: Temp2[j + H] := (SBoxes[n, row, Column] and 8) div 8;
          2: Temp2[j + H] := (SBoxes[n, row, Column] and 4) div 4;
          3: Temp2[j + H] := (SBoxes[n, row, Column] and 2) div 2;
          4: Temp2[j + H] := (SBoxes[n, row, Column] and 1);
        end;
      end;
    end;
    for n := 1 to 32 do
      TotalOut[n] := Temp2[p[n]];
  end; {F}

  procedure Shift(var SubKeyPart);

  var
    SKP: array[1..28] of Byte absolute SubKeyPart;
    n, b: Byte;

  begin
    b := SKP[1];
    for n := 1 to 27 do
      SKP[n] := SKP[n + 1];
    SKP[28] := b;
  end; {Shift}

  procedure SubKey(Round: Byte; var SubKey);

  var
    SK: array[1..48] of Byte absolute SubKey;
    n, b: Byte;

  begin
    for n := 1 to ShiftTable[Round] do
    begin
      Shift(c);
      Shift(d);
    end;
    for n := 1 to 48 do
    begin
      b := PC_2[n];
      if b <= 28 then
        SK[n] := c[b]
      else
        SK[n] := d[b - 28];
    end;
  end; {SubKey}

var
  n, i, b, Round: Byte;
  Outputje: array[1..64] of Byte;
  k: array[1..48] of Byte;
  fi: Text;

begin
  for n := 1 to 64 do
    InputValue[n] := GetBit(Input, n);
  for n := 1 to 28 do
  begin
    c[n] := GetBit(Key, PC_1[n]);
    d[n] := GetBit(Key, PC_1[n + 28]);
  end;
  for n := 1 to 16 do
    SubKey(n, RoundKeys[n]);
  for n := 1 to 64 do
    if n <= 32 then
      l[n] := InputValue[IP[n]]
    else
      r[n - 32] := InputValue[IP[n]];
  for Round := 1 to 16 do
  begin
    if EnCrypt then
      F(r, RoundKeys[Round], FunctionResult)
    else
      F(r, RoundKeys[17 - Round], FunctionResult);
    for n := 1 to 32 do
      FunctionResult[n] := FunctionResult[n] xor l[n];
    l := r;
    r := FunctionResult;
  end;
  for n := 1 to 64 do
  begin
    b := InvIP[n];
    if b <= 32 then
      OutputValue[n] := r[b]
    else
      OutputValue[n] := l[b - 32];
  end;
  for n := 1 to 64 do
    SetBit(Output, n, OutputValue[n]);
end;

function ReadStream(s: TStream; var Key; EnCrypt: Boolean): Boolean;
var
  Input, Output: array[0..7] of Byte;
  ReadCount, seekCount: Integer;
begin
  Result := False;
  try
    s.Seek(0, 0);
    ReadCount := s.Read(Input, 8);
    while (ReadCount = 8) do
    begin
      DES(Input, Output, Key, EnCrypt);
      s.Seek(-8, 1);
      s.Write(Output, 8);
      ReadCount := s.Read(Input, 8);
    end;
    Result := True;
  finally
    s.Seek(0, 0);
  end;

end;
initialization
Begin
 InitCRC32Tab($EFB8832D);
End;
end.