delaylists.pas

由delphi实现的bt下载器示例程序

unit DelayLists;

interface

uses
  SysUtils, Classes, Windows;

const
  DELAY_RELEASE_TICK    =    5000;

type
  TDelayReleaseList = class(TThread)
  protected
    WaitEvent: Cardinal;         // 等待句柄
    Lst: TList;                  // 删除队列，Lst.Items[i] = 进入队列时间
                                 //           Lst.Items[i+1] = 需要删除的Obj
    Lock: TRTLCriticalSection;   // 同步锁，同步对Lst操作用
    procedure Execute; override;
  public
    constructor Create;
    procedure DFree(Obj: TObject);  // 添加obj到删除队列
    procedure Stop;                 // 终止线程（程序退出时自动执行）
  end;

procedure DelayRelease(Obj: TObject);

var
  DelayList: TDelayReleaseList;

implementation

procedure DelayRelease(Obj: TObject);
begin
  DelayList.DFree(Obj);
end;

{ TDelayReleaseList }

constructor TDelayReleaseList.Create;
begin
  InitializeCriticalSection(Lock);
  WaitEvent := CreateEvent(nil, false, false, nil);
  Lst := TList.Create;
  Inherited Create(false);
end;

procedure TDelayReleaseList.DFree(Obj: TObject);
begin
  if obj = nil then exit;
  try
    EnterCriticalSection(Lock);
    try
      // 添加到删除队列中
      Lst.Add(Pointer(GetTickCount));
      Lst.Add(Pointer(Obj));
    finally
      LeaveCriticalSection(Lock);
    end;
  except
  end;
end;

type
  TListRef = class
  private
    FList: PPointerList;
    FCount: Integer;
    FCapacity: Integer;
  end;

procedure TDelayReleaseList.Execute;
var
  b, e, c: Integer;
  Tick, T2: Cardinal;
  v: PPointerList;
  f: Boolean;
begin
  FreeOnTerminate := true;
  while not Terminated do
  try
    WaitForSingleObject(WaitEvent, DELAY_RELEASE_TICK);     // 每5秒检查一次队列
    if terminated then break;
    Tick := GetTickCount;
    T2 := Tick - DELAY_RELEASE_TICK;
    f := Tick < T2;                              // 是否已连续运行超过49.8天或系统启动还不到5秒的标记
    dec(Tick, DELAY_RELEASE_TICK);               // 释放队列中Tick时间之前的所有obj
    EnterCriticalSection(Lock);
    try
      b := 0;
      e := Lst.Count - 2;
      v := nil;
      if b <= e then
      begin
        // 快速定位队列中Tick时间前的所有项目
        if f or (cardinal(Lst.Items[b]) > cardinal(Lst.Items[e])) then  // tickcount归过0的情况下
          while b <= e do
          begin
            c := (b + e) shr 2 shl 1;
            if Integer(Tick) < Integer(Lst.Items[c]) then
              e := c - 2
            else b := c + 2;
          end
        else                     // 连续运行未超过49.8天，tickcount未归过0
          while b <= e do
          begin
            c := (b + e) shr 2 shl 1;
            if Tick < cardinal(Lst.Items[c]) then
              e := c - 2
            else b := c + 2;
          end;
        if b > 0 then
          // 将队列中所有Tick时间前的项目移到临时内存块在中并在队列里删除这些项
          if b < Lst.Count then
          begin
            GetMem(v, b * 4);
            Move(Lst.List^, v^, b * 4);
            with TListRef(Lst) do
            begin
              Move(FList[b], FList[0], (FCount - b) * 4);
              Dec(FCount, b);
            end;
          end
          else
            with TListRef(Lst) do
            begin
              v := FList;
              FList := nil;
              b := fcount;
              FCount := 0;
              FCapacity := 0;
            end
      end;
    finally
      LeaveCriticalSection(Lock);
    end;
    if b > 0 then
    begin
    // 删除临时内存中的所有项目
      c := 1;
      while c < b do
      begin
        try
          TObject(v[c]).Free;
        except
        end;
        inc(c, 2);
      end;
      freemem(v);
    end;
  except
  end;
  closehandle(WaitEvent);
  Lst.Free;
  deletecriticalsection(lock);
end;

procedure TDelayReleaseList.Stop;
begin
  try
    Terminate;
    SetEvent(WaitEvent);
  except
  end;
end;

initialization
  DelayList := TDelayReleaseList.Create;

finalization
  DelayList.Stop;

end.