qmm.dpr

快速字符串处理原代码!直接操作内存,功能非常强大!

        JL      @@ut
        MOV     EBX,$FFFFFFFF
        MOV     ESI,ECX
        MOV     EDI,$0000001F
        AND     ECX,EDI
        AND     ESI,$FFFFFFE0
        SUB     EDI,ECX
        SHR     ESI,5
        MOV     ECX,EDI
        MOV     EDI,EBX
        SHR     EDI,CL
        MOV     ECX,EDX
        AND     EDX,$FFFFFFE0
        AND     ECX,$0000001F
        SHR     EDX,5
        SHL     EBX,CL
        NOT     EDI
        NOT     EBX
        SUB     ESI,EDX
        JE      @@xx
        AND     [EAX+EDX*4],EBX
        INC     EDX
        DEC     ESI
        JE      @@ne
        XOR     EBX,EBX
@@lp:   MOV     [EAX+EDX*4],EBX
        INC     EDX
        DEC     ESI
        JNE     @@lp
@@xx:   OR      EDI,EBX
@@ne:   AND     [EAX+EDX*4],EDI
        POP     EBX
        POP     ESI
        POP     EDI
        RET
@@ut:   SUB     ECX,EDX
        JS      @@qt
@@uk:   BTR     [EAX],EDX
        INC     EDX
        DEC     ECX
        JNS     @@uk
@@qt:   POP     EBX
        POP     ESI
        POP     EDI
end;

function QMemDecommitOverstock: Integer;
label
  99;
var
  E: PEntryPoint;
  L,R: Integer;
begin
  if IntQMemIsInstalled then
  begin
    try
      EnterCriticalSection(lpCriticalSection);
      E := ListLeft;
      while E <> nil do
      begin
        if E^.Space shr 17 > 0 then
        begin
          L := (E^.Address+$FFFF-StartAddr) shr 16;
          R := (E^.Address+E^.Space-$10000-StartAddr) shr 16;
          L := IntSetBitScanForward(Pointer(StartAddr),L,R);
          if L >= 0 then
          begin
            R := IntSetBitScanReverse(Pointer(StartAddr),L,R);
            if not VirtualFree(Pointer(StartAddr+LongWord(L) shl 16),
              LongWord(R-L+1) shl 16, MEM_DECOMMIT) then
            begin
              Result := -1;
              goto 99;
            end;
            IntResetBits(Pointer(StartAddr),L,R);
          end;
        end;
        E := E^.AdrRight;
      end;
      Result := 0;
    99:
    finally
      LeaveCriticalSection(lpCriticalSection);
    end;
  end else
    Result := -1;
end;

function QMemSize(P: Pointer): Integer;
begin
  Dec(LongWord(P),4);
  if (LongWord(P)>=SpaceBegin) and
      (PLongWord(P)^+LongWord(P)<=LongWord(EFreeArr)) then
    Result := PInteger(P)^-4
  else
    Result := -1;
end;

function QMemTotalAddrSpace: Integer;
begin
  if IntQMemIsInstalled then
    Result := LongWord(EFreeArr)-StartAddr
  else
    Result := -1;
end;

const
  BitTable: array[0..255] of Byte =
    (0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,
     1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,
     1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,
     2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,
     1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,
     2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,
     2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,
     3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,4,5,5,6,5,6,6,7,5,6,6,7,6,7,7,8);

function IntCountOfSetBits(P: Pointer; L: Cardinal): Cardinal;
asm
        PUSH    EBX
        PUSH    ESI
        MOV     EBX,EAX
        XOR     EAX,EAX
        SUB     EDX,2
        JS      @@nx
@@lp:   MOVZX   ECX,BYTE PTR [EBX+EDX]
        MOVZX   ESI,BYTE PTR [EBX+EDX+1]
        MOVZX   ECX,BYTE PTR [ECX+BitTable]
        ADD     EAX,ECX
        MOVZX   ESI,BYTE PTR [ESI+BitTable]
        ADD     EAX,ESI
        SUB     EDX,2
        JNS     @@lp
@@nx:   INC     EDX
        JZ      @@qt2
        POP     ESI
        POP     EBX
        RET
@@qt2:  MOVZX   ECX,BYTE PTR [EBX]
        MOVZX   ECX,BYTE PTR [ECX+BitTable]
        ADD     EAX,ECX
        POP     ESI
        POP     EBX
end;

function IntCountOfFreeBits(P: Pointer; L: Cardinal): Cardinal;
asm
        PUSH    EDX
        CALL    IntCountOfSetBits
        NEG     EAX
        POP     EDX
        LEA     EAX,[EAX+EDX*8]
end;

function QMemTotalCommitted: Integer;
begin
  if IntQMemIsInstalled then
  begin
    try
      EnterCriticalSection(lpCriticalSection);
      Result := IntCountOfSetBits(Pointer(StartAddr),
        (LongWord(EFreeArr)-StartAddr) shr 19) shl 16;
    finally
      LeaveCriticalSection(lpCriticalSection);
    end;
  end else
    Result := -1;
end;

function QMemTotalUncommitted: Integer;
begin
  if IntQMemIsInstalled then
  begin
    try
      EnterCriticalSection(lpCriticalSection);
      Result := IntCountOfFreeBits(Pointer(StartAddr),
        (LongWord(EFreeArr)-StartAddr) shr 19) shl 16;
    finally
      LeaveCriticalSection(lpCriticalSection);
    end;
  end else
    Result := -1;
end;

function QMemTotalAllocated: Integer;
var
  E: PEntryPoint;
begin
  if IntQMemIsInstalled then
  begin
    try
      EnterCriticalSection(lpCriticalSection);
      Result := LongWord(EFreeArr)-SpaceBegin;
      E := ListLeft;
      while E <> nil do
      begin
        Dec(Result,E^.Space);
        E := E^.AdrRight;
      end;
    finally
      LeaveCriticalSection(lpCriticalSection);
    end;
  end else
    Result := -1;
end;

function QMemTotalFree: Integer;
var
  E: PEntryPoint;
begin
  if IntQMemIsInstalled then
  begin
    try
      EnterCriticalSection(lpCriticalSection);
      Result := 0;
      E := ListLeft;
      while E <> nil do
      begin
        Inc(Result,E^.Space);
        E := E^.AdrRight;
      end;
    finally
      LeaveCriticalSection(lpCriticalSection);
    end;
  end else
    Result := -1;
end;

function QMemMaxFreeBlock: Integer;
var
  E: PEntryPoint;
begin
  if IntQMemIsInstalled then
  begin
    try
      EnterCriticalSection(lpCriticalSection);
      Result := 0;
      E := ListLeft;
      while E <> nil do
      begin
        if E^.Space > LongWord(Result) then
          Result := E^.Space;
        E := E^.AdrRight;
      end;
    finally
      LeaveCriticalSection(lpCriticalSection);
    end;
  end else
    Result := -1;
end;

function QMemCountOfFreeBlocks: Integer;
begin
  if IntQMemIsInstalled then
  begin
    try
      EnterCriticalSection(lpCriticalSection);
      Result := MaxECount-EFreeCount;
    finally
      LeaveCriticalSection(lpCriticalSection);
    end;
  end else
    Result := -1;
end;

function QMemOverhead: Integer;
begin
  if IntQMemIsInstalled then
    Result := MaxECount*28
  else
    Result := -1;
end;

function QMemGetHeapStatus: TQMemHeapStatus;
var
  E: PEntryPoint;
  X1,X2: LongWord;
begin
  if IntQMemIsInstalled then
    try
      EnterCriticalSection(lpCriticalSection);
      with Result do
      begin
        TotalAddrSpace := LongWord(EFreeArr)-StartAddr;
        TotalCommitted := IntCountOfSetBits(Pointer(StartAddr),
          TotalAddrSpace shr 19) shl 16;
        TotalUncommitted := TotalAddrSpace - TotalCommitted;
        X1 := 0;
        X2 := 0;
        E := ListLeft;
        while E <> nil do
        begin
          Inc(X1,E^.Space);
          if E^.Space > X2 then
            X2 := E^.Space;
          E := E^.AdrRight;
        end;
        TotalFree := X1;
        TotalAllocated := LongWord(EFreeArr)-SpaceBegin-X1;
        MaxFreeBlock := X2;
        CountOfFreeBlocks := MaxECount-EFreeCount;
        Overhead := MaxECount*28;;
      end;
    finally
      LeaveCriticalSection(lpCriticalSection);
    end
  else
    with Result do
    begin
      TotalAddrSpace := 0;
      TotalCommitted := 0;
      TotalUncommitted := 0;
      TotalAllocated := 0;
      TotalFree := 0;
      MaxFreeBlock := 0;
      CountOfFreeBlocks := 0;
      Overhead := 0;
    end;
end;

function QMemIsInstalled: Boolean;
begin
  Result := IntQMemIsInstalled;
end;

exports
  ExtGetMem,
  ExtFreeMem,
  ExtReallocMem,
  QMemDecommitOverstock,
  QMemSize,
  QMemTotalAddrSpace,
  QMemTotalCommitted,
  QMemTotalUncommitted,
  QMemTotalAllocated,
  QMemTotalFree,
  QMemMaxFreeBlock,
  QMemCountOfFreeBlocks,
  QMemOverhead,
  QMemGetHeapStatus,
  QMemIsInstalled;

procedure IntFillLong(Value: LongWord; P: Pointer; Count: Cardinal);
asm
        XCHG    EDI,EDX
        REP     STOSD
        MOV     EDI,EDX
end;

procedure QMemInstall(InitialSize, MaximumSize: Integer);
var
  L: LongWord;
  E: PEntryPoint;
  P: PLongWord;
begin
  if (not IntQMemIsInstalled) and (MaximumSize>0) then
  begin
    Inc(MaximumSize,$7FFFF);
    MaximumSize := MaximumSize and $FFF80000;
    L := MaxECount*28;
    StartAddr := LongWord(VirtualAlloc(nil, L+LongWord(MaximumSize),
      MEM_RESERVE or MEM_TOP_DOWN, PAGE_READWRITE));
    if StartAddr = 0 then
      Exit;
    EFreeArr := Pointer(StartAddr+LongWord(MaximumSize));
    if VirtualAlloc(EFreeArr, L, MEM_COMMIT, PAGE_READWRITE) = nil then
    begin
      VirtualFree(Pointer(StartAddr),0,MEM_RELEASE);
      Exit;
    end;
    EFreeCount := MaxECount;
    E := Pointer(LongWord(EFreeArr)+LongWord(MaxECount) shl 2);
    P := @EFreeArr^[EFreeCount];
    for L := 1 to EFreeCount do
    begin
      P^ := LongWord(E);
      Inc(E);
      Dec(P);
    end;
    if InitialSize < $10000 then
      InitialSize := $10000
    else if InitialSize > MaximumSize then
      InitialSize := MaximumSize
    else
    begin
      Inc(InitialSize,$FFFF);
      InitialSize := InitialSize and $FFFF0000;
    end;
    if VirtualAlloc(Pointer(StartAddr), InitialSize, MEM_COMMIT,
      PAGE_READWRITE) = nil then
    begin
      VirtualFree(Pointer(StartAddr),0,MEM_RELEASE);
      Exit;
    end;
    L := LongWord(MaximumSize) shr 19;
    IntFillLong(0,Pointer(StartAddr),(L+3) shr 2);
    IntSetBits(Pointer(StartAddr),0,InitialSize shr 16 - 1);
    SpaceBegin := (L+35) and $FFFFFFE0 - 4;
    Inc(SpaceBegin,StartAddr);
    Dec(EFreeCount);
    E := EFreeArr^[EFreeCount];
    ListLeft := E;
    ListRight := E;
    with E^ do
    begin
      Address := SpaceBegin;
      Space := LongWord(EFreeArr)-SpaceBegin;
      AdrLeft := nil;
      AdrRight := nil;
      SpLeft := nil;
      SpRight := nil;
    end;
    InitializeCriticalSection(lpCriticalSection);
    IntFillLong(0,@SizeTable,31);
    IntQMemIsInstalled := True;
  end;
end;

procedure DLLMain(dwReason: LongWord);
begin
  if (dwReason=DLL_PROCESS_DETACH) and IntQMemIsInstalled then
  begin
    IntQMemIsInstalled := False;
    DeleteCriticalSection(lpCriticalSection);
    VirtualFree(Pointer(StartAddr), 0, MEM_RELEASE);
  end;
end;

begin
  IntQMemIsInstalled := False;
  QMemInstall(65536,268435456);
  DLLProc := @DLLMain;
end.