btutils.pas

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

begin
  with TListRef(self) do
  begin
    pi := @FCount;
    pi^ := 0;
    while (len > 0) and (p^ in ['0'..'9']) do
    begin
      pi^ := pi^ * 10 + byte(p^) - byte('0');
      inc(p);
      dec(len);
    end;
    if p^ = 'e' then
    begin
      inc(p);
      dec(len);
    end;
  end;
end;

function TBencodeInt.Bencode: string;
var
  pi: PInt64;
begin
  with TListRef(self) do
  begin
    pi := @FCount;
    result := 'i'+inttostr(pi^)+'e';
  end;
end;

function TBencodeInt.GetInt: Int64;
begin
  with TListRef(self) do
    result := PInt64(@FCount)^;
end;

procedure TBencodeInt.SetInt(const Value: Int64);
begin
  with TListRef(Self) do
    PInt64(@FCount)^ := value;
end;

{ TBencodeStr }

procedure TBencodeStr.Clear;
begin
  with TListRef(Self) do
  begin
    string(FList) := '';
    FCount := 0;
    FCapacity := 0;
  end;
end;

procedure TBencodeStr.Bdecode(var p: PChar; var Len: Integer);
var
  s: string;
  l: Integer;
begin
  clear;
  l := 0;
  while (len > 0) and (p^ in ['0'..'9']) do
  begin
    l := l * 10 + byte(p^) - byte('0');
    inc(p);
    dec(len);
  end;
  if (len>0) and (p^ = ':') then
  begin
    inc(p);
    dec(len);
    setlength(s, l);
    if l > 0 then
      system.Move(p^, s[1], l);
    inc(p, l);
    dec(len, l);
    TListRef(Self).FList := pointer(s);
    integer(s) := 0;
  end;
end;

function TBencodeStr.Bencode: string;
begin
  with TListRef(self) do
    result := inttostr(length(string(flist)))+':'+string(flist);
end;

function TBencodeStr.GetStr: string;
begin
  with TListRef(self) do
    result := string(flist);
end;

procedure TBencodeStr.SetStr(const Value: string);
begin
  with TListRef(self) do
    string(flist) := value;
end;

{ TBencodeItem }

procedure TBencodeItem.Clear;
begin
  with TListRef(Self) do
  begin
    TBencodeData(FCount).Free;
    inherited;
  end;
end;

procedure TBencodeItem.Bdecode(var p: PChar; var Len: Integer);
begin
  inherited;
  if Len > 0 then
    with TListRef(self) do
      case p^ of
        '0'..'9':
        begin
          FCount := Integer(TBencodeStr.Create);
          TBencodeStr(FCount).Bdecode(p, len);
        end;
        'i':
        begin
          inc(p);
          dec(len);
          fcount := integer(TBencodeInt.Create);
          TBencodeInt(FCount).Bdecode(p, len);
        end;
        'l':
        begin
          inc(p);
          dec(len);
          fcount := integer(TBencodeList.Create);
          TBencodeList(fcount).Bdecode(p, len);
        end;
        'd':
        begin
          inc(p);
          dec(len);
          fcount := integer(TBencodeDict.Create);
          TBencodeDict(fcount).Bdecode(p, len);
        end;
        'e':
        begin
          inc(p);
          dec(len);
        end;
    end;
end;

function TBencodeItem.Bencode: string;
begin
  with TListRef(self) do
    result := inherited Bencode + TBencodeData(FCount).Bencode;
end;

function TBencodeItem.GetItem: TBencodeData;
begin
  with TListRef(self) do
    result := TBencodeData(fcount);
end;

function TBencodeItem.GetName: string;
begin
  result := inherited Values;
end;

procedure TBencodeItem.SetItem(const Value: TBencodeData);
begin
  with TListRef(self) do
  begin
    if FCount <> 0 then
      TBencodeData(FCount).Free;
    FCount := Integer(Value);
  end;
end;

procedure TBencodeItem.SetName(const Value: string);
begin
  inherited Values := Value;
end;

function TBencodeItem.GetDictValue: TBencodeDict;
var
  d: TBencodeData;
begin
  d := Values;
  if d is TBencodeDict then result := TBencodeDict(d)
  else result := nil;
end;

function TBencodeItem.GetIntValue: Int64;
var
  d: TBencodeData;
begin
  d := Values;
  if d is TBencodeInt then
    result := TBencodeInt(d).Values
  else result := 0;
end;

function TBencodeItem.GetListValue: TBencodeList;
var
  d: TBencodeData;
begin
  d := values;
  if d is TBencodeList then result := TBencodeList(d)
  else result := nil;
end;

function TBencodeItem.GetStrValue: string;
var
  d: TBencodeData;
begin
  d := values;
  if d is TBencodeStr then result := TBencodeStr(d).Values
  else result := '';
end;

{ TBencodeList }

procedure TBencodeList.Clear;
var
  i: Integer;
begin
  for i := 0 to count - 1 do
    TBencodeData(Items[i]).Free;
  inherited;
end;

procedure TBencodeList.Bdecode(var p: PChar; var Len: Integer);
var
  d: TBencodeData;
begin
  clear;
  while (len > 0) do
    case p^ of
      '0'..'9':
      begin
        d := TBencodeStr.Create;
        d.Bdecode(p, len);
        add(pointer(d));
      end;
      'i':
      begin
        inc(p);
        dec(len);
        d := TBencodeInt.Create;
        d.Bdecode(p, len);
        add(pointer(d));
      end;
      'l':
      begin
        inc(p);
        dec(len);
        d := TBencodeList.Create;
        d.Bdecode(p, len);
        add(pointer(d));
      end;
      'd':
      begin
        inc(p);
        dec(len);
        d := TBencodeDict.Create;
        d.Bdecode(p, len);
        add(pointer(d));
      end;
      'e':
      begin
        inc(p);
        dec(len);
        break;
      end;
    else
      inc(p);
      dec(len);
    end;
end;

function TBencodeList.Bencode: string;
var
  i: Integer;
begin
  result := 'l';
  for i := 0 to count - 1 do
    result := result + TBencodeData(Items[i]).Bencode;
  result := result + 'e';
end;

function TBencodeList.GetList(Index: Integer): TBencodeData;
begin
  result := nil;
  if (Index>=0) and (Index < Count) then
    result := TBencodeData(Items[Index]);
end;

procedure TBencodeList.SetList(Index: Integer; const Value: TBencodeData);
begin
  if (Index>=0) and (Index < Count) then
  begin
    if Items[Index] <> nil then
      TBencodeData(Items[Index]).Free;
    Items[Index] := Value;
  end;
end;

function TBencodeList.GetDictValue(Index: Integer): TBencodeDict;
var
  d: TBencodeData;
begin
  d := Values[Index];
  if d is TBencodeDict then result := TBencodeDict(d)
  else result := nil;
end;

function TBencodeList.GetIntValue(Index: Integer): Int64;
var
  d: TBencodeData;
begin
  d := values[Index];
  if d is TBencodeInt then result := TBencodeInt(d).Values
  else result := 0;
end;

function TBencodeList.GetListValue(Index: Integer): TBencodeList;
var
  d: TBencodeData;
begin
  d := Values[Index];
  if d is TBencodeList then result := TBencodeList(d)
  else result := nil;
end;

function TBencodeList.GetStrValue(Index: Integer): string;
var
  d: TBencodeData;
begin
  d := values[Index];
  if d is TBencodeStr then result := TBencodeStr(d).Values
  else result := '';
end;

function TBencodeList.AddInt(Value: Int64): Integer;
var
  dt: TBencodeInt;
begin
  dt := TBencodeInt.Create;
  dt.Values := Value;
  result := Add(pointer(dt));
end;

function TBencodeList.AddStr(Value: string): Integer;
var
  dt: TBencodeStr;
begin
  dt := TBencodeStr.Create;
  dt.Values := Value;
  result := add(pointer(dt));
end;

function TBencodeList.AddDict: Integer;
var
  dt: TBencodeDict;
begin
  dt := TBencodeDict.Create;
  result := add(pointer(dt));
end;

function TBencodeList.AddList: Integer;
var
  dt: TBencodeList;
begin
  dt := TBencodeList.Create;
  result := add(pointer(dt));
end;

function TBencodeList.AddDictDirect(Value: TBencodeDict): Integer;
begin
  if assigned(value) then
    result := add(pointer(value))
  else result := -1;
end;

function TBencodeList.AddListDirect(Value: TBencodeList): Integer;
begin
  if assigned(value) then
    result := add(pointer(value))
  else result := -1;
end;

{ TBencodeDict }

procedure TBencodeDict.Clear;
var
  i: Integer;
begin
  for i := 0 to count - 1 do
    TBencodeItem(Items[i]).Free;
  inherited;
end;

procedure TBencodeDict.Bdecode(var p: PChar; var Len: Integer);
var
  d: TBencodeItem;
begin
  clear;
  while (Len > 0) do
    case p^ of
      '0'..'9':
      begin
        d := TBencodeItem.Create;
        d.Bdecode(p, len);
        Add(Pointer(d));
      end;
      'e':
      begin
        inc(p);
        dec(len);
        break;
      end;
    else
      inc(p);
      dec(len);
    end;
end;

function TBencodeDict.Bencode: string;
var
  i: Integer;
begin
  result := 'd';
  for i := 0 to count - 1 do
    result := result + TBencodeItem(Items[i]).Bencode;
  result := result + 'e';
end;

function TBencodeDict.GetDict(AName: string): TBencodeItem;
var
  n: Integer;
begin
  result := nil;
  n := finditem(aname);
  if n >= 0 then
    result := TBencodeItem(Items[n]);
end;

procedure TBencodeDict.SetDict(AName: string; const Value: TBencodeItem);
var
  n: Integer;
begin
  n := finditem(aname);
  if n >= 0 then
    Items[n] := pointer(Value);
end;

function TBencodeDict.FindItem(AName: string): Integer;
begin
  result := count - 1;
  while result >= 0 do
    if TBencodeItem(Items[result]).Name = AName then
      break
    else dec(result);
end;

function TBencodeDict.AddDict(AName: string): TBencodeDict;
var
  Itm: TBencodeItem;
begin
  Result := TBencodeDict.Create;
  Itm := TBencodeItem.Create;
  Itm.Name := Aname;
  Itm.Values := Result;
  Add(pointer(Itm));
end;

function TBencodeDict.AddDictDirect(AName: string;
  Value: TBencodeDict): TBencodeItem;
begin
  result := nil;
  if assigned(value) then
  begin
    result := TBencodeItem.Create;
    result.Name := AName;
    result.Values := Value;
    Add(Pointer(result));
  end;
end;

function TBencodeDict.AddInt(AName: string; Value: Int64): TBencodeItem;
var
  dt: TBencodeInt;
begin
  dt := TBencodeInt.Create;
  dt.Values := Value;
  result := TBencodeItem.Create;
  Result.Name := AName;
  result.Values := dt;
  Add(pointer(result));
end;

function TBencodeDict.AddList(AName: string): TBencodeList;
var
  Itm: TBencodeItem;
begin
  result := TBencodeList.Create;
  Itm := TBencodeItem.Create;
  Itm.Name := AName;
  Itm.Values := Result;
  Add(pointer(itm));
end;

function TBencodeDict.AddListDirect(AName: string;
  Value: TBencodeList): TBencodeItem;
begin
  result := nil;
  if assigned(value) then
  begin
    result := TBencodeItem.Create;
    result.Name := AName;
    result.Values := Value;
    Add(pointer(result));
  end;
end;

function TBencodeDict.AddStr(AName, Value: string): TBencodeItem;
var
  dt: TBencodeStr;
begin
  dt := TBencodeStr.Create;
  dt.Values := Value;
  result := TBencodeItem.Create;
  result.Name := AName;
  result.Values := dt;