⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 vmarray.pas

📁 < windos核心编程>>是经典中的经典,书中原代码是用delphi重新编写的.
💻 PAS
字号:
unit VMArray;

interface

uses Windows;

  // TopLevelExceptionFilter返回值含义
const
  EXCEPTION_EXECUTE_HANDLER = 1; // 已处理异常, 请结束程序, (不要显示出错对话框)
  EXCEPTION_CONTINUE_SEARCH = 0; // 未处理异常, 作默认处理, (通常显示出错对话框)
  EXCEPTION_CONTINUE_EXECUTION = -1; // 已修复问题, 线程按ContextRecord继续执行

  // 扩展了的异常帧(系统只使用前两个域)
type
  PExceptionRegistration = ^TExceptionRegistration;
  TExceptionRegistration = record
    PrevStruct: PExceptionRegistration; // 上一节点位置
    ExceptionHandler: Pointer;          // 异常回调地址
    ExceptionAddress: Pointer;          // except块地址
  end;

  // (虚拟内存+异常保护实现的)稀疏数组
type
  TVMArray = class(TObject)
  private
    m_pNext: TVMArray; // 下一个对象
    m_pArray: Pointer; // 数组首地址
    m_cbReserve: DWORD; // 数组尺寸(in bytes)
    m_dwTypeSize: DWORD; // 组员尺寸(in bytes)

  protected
    function OnAccessViolation(pvAddrTouched: Pointer; fAttemptedRead: BOOL; // 负责修复内存访问错误,可覆盖
      var pep: TExceptionPointers; fRetryUntilSuccessful: BOOL): LongInt; virtual;
      
  public
    constructor Create(dwTypeSize, dwReserveElements: DWORD);
    destructor Destroy(); override;

    class procedure RemoveCurrentThreadOtherSEH(); // 用作摘除SetExceptionHandler()增加的SEH回调
    function VMPointer(): Pointer; // 返回数组首地址

    function ExceptionFilter(var pep: TExceptionPointers; // 可在except块中作为"过滤器"函数调用,
      fRetryUntilSuccessful: BOOL = FALSE): LongInt;      // 若没有except块,将由顶层异常回调调用
  end;

implementation

type
  PfnTopLevelExceptionFilter = function (var pep: TExceptionPointers): LongInt; stdcall;

var
  sm_pHead: TVMArray = nil; // 第一个TVMArray对象地址
  sm_pfnUnhandledExceptionFilterPrev: PfnTopLevelExceptionFilter; // 以前的顶层异常回调

  // 顶层异常回调
function TopLevelExceptionFilter(var pep: TExceptionPointers): LongInt; stdcall;
var
  p: TVMArray;
begin
  Result := EXCEPTION_CONTINUE_SEARCH;

  // 我们只修复内存访问错误
  if (pep.ExceptionRecord.ExceptionCode = EXCEPTION_ACCESS_VIOLATION) then
  begin
    // 遍历TVMArray对象链表, 一一调用
    p := sm_pHead;
    while (p <> nil) do
    begin
      // 询问当前节点对象是否修复错误
      Result := p.ExceptionFilter(pep, TRUE);

      // 这个对象修复了问题, 停止循环
      if (Result <> EXCEPTION_CONTINUE_SEARCH) then Break;

      // 单链表上的下一个TVMArray对象
      p := p.m_pNext;

      // 注: 若均不处理则程序就会退出
    end;
  end;

  // 调用以前的顶层异常回调
  if (Result = EXCEPTION_CONTINUE_SEARCH) then
    Result := sm_pfnUnhandledExceptionFilterPrev(pep);
end;

  // 负责修复内存访问错误(被ExceptionFilter调用)
function TVMArray.OnAccessViolation(pvAddrTouched: Pointer; fAttemptedRead: BOOL;
  var pep: TExceptionPointers; fRetryUntilSuccessful: BOOL): LongInt;
var
  fCommittedStorage: BOOL;
begin
  repeat
    // 为出错地址提交物理内存
    fCommittedStorage := (VirtualAlloc(pvAddrTouched, m_dwTypeSize, MEM_COMMIT, PAGE_READWRITE) <> nil);

    // 分配内存失败, 通知用户
    if (not fCommittedStorage) and (fRetryUntilSuccessful) then
    begin
      MessageBox(0, 'Please close some other applications and Press OK.',
        'Insufficient Memory Available', MB_ICONWARNING or MB_OK);
    end;
  until (fCommittedStorage) or (not fRetryUntilSuccessful);

  // 1.分配成功, 从出错指令处继续执行
  // 2.分配失败, 让系统安静地关闭程序(or 跳至except块执行)
  if fCommittedStorage then
    Result := EXCEPTION_CONTINUE_EXECUTION
  else
    Result := EXCEPTION_EXECUTE_HANDLER;
end;

  // TVMArray对象初始化
constructor TVMArray.Create(dwTypeSize, dwReserveElements: DWORD);
begin
  // 第一个类建立时安装顶层异常回调
  if (sm_pHead = nil) then
    sm_pfnUnhandledExceptionFilterPrev := SetUnhandledExceptionFilter(@TopLevelExceptionFilter);

  // 将自己接到TVMArray对象链表表头
  m_pNext := sm_pHead;
  sm_pHead := Self;

  // 需要为数组保留的虚拟内存的长度
  m_dwTypeSize := dwTypeSize;
  m_cbReserve := m_dwTypeSize * dwReserveElements;

  // 为数组保留虚拟内存空间(不提交)
  m_pArray := VirtualAlloc(nil, m_cbReserve, MEM_RESERVE or MEM_TOP_DOWN, PAGE_READWRITE);

  // chASSERT(m_pArray <> NULL);
end;

  // TVMArray对象结束化
destructor TVMArray.Destroy();
var
  p: TVMArray;
begin
  // 释放数组对应的虚拟内存空间
  if (m_pArray <> nil) then VirtualFree(m_pArray, 0, MEM_RELEASE);

  // 从TVMArray对象链表摘除自己
  if (sm_pHead = Self) then
    sm_pHead := sm_pHead.m_pNext
  else begin
    p := sm_pHead;
    while (p.m_pNext <> nil) do
    begin
      if (p.m_pNext = Self) then
      begin
        p.m_pNext := p.m_pNext.m_pNext;
        Break;
      end;
      p := p.m_pNext;
    end;
  end; // END: else
end;

  // 返回数组首地址
function TVMArray.VMPointer(): Pointer;
begin
  Result := m_pArray;
end;

  // 摘除当前线程所有SEH节点, 慎用!
class procedure TVMArray.RemoveCurrentThreadOtherSEH();
asm
  // p := TEB.ExceptionList;
  MOV EDX, FS:[0]

  // if (p = $FFFFFFFF) then Exit;
  CMP EDX, -1
  JZ  @@QUIT

  // while (p.PrevStruct <> $FFFFFFFF) do p := p.PrevStruct;
@@LOOP:
  MOV EAX, EDX
  MOV EDX, [EAX].TExceptionRegistration.PrevStruct
  CMP EDX, -1
  JNZ @@LOOP

  // TEB.ExceptionList := p;
  MOV FS:[0], EAX

@@QUIT:
end;

  // 异常过滤函数(被TopLevelExceptionFilter或except块调用)
function TVMArray.ExceptionFilter(var pep: TExceptionPointers; fRetryUntilSuccessful: BOOL = FALSE): LongInt;
var
  pvAddrTouched: DWORD;
  fAttemptedRead: BOOL;
begin
  Result := EXCEPTION_CONTINUE_SEARCH;

  // 我们只修复内存访问错误
  if (pep.ExceptionRecord.ExceptionCode <> EXCEPTION_ACCESS_VIOLATION) then Exit;

  // 发生读写异常的内存地址
  pvAddrTouched := pep.ExceptionRecord.ExceptionInformation[1];

  // 导致异常的动作(读or写)
  fAttemptedRead := (pep.ExceptionRecord.ExceptionInformation[0] = 0);

  // 如果该地址在数组范围内
  if (DWORD(m_pArray) <= pvAddrTouched) and (DWORD(pvAddrTouched) < (DWORD(m_pArray) + m_cbReserve)) then
    Result := OnAccessViolation(Pointer(pvAddrTouched), fAttemptedRead, pep, fRetryUntilSuccessful);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -