File: bencode.pas

package info (click to toggle)
transgui 5.0.1-5.1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 3,792 kB
  • sloc: pascal: 40,152; makefile: 2,294; cs: 347; perl: 347; lisp: 347; sh: 84
file content (309 lines) | stat: -rw-r--r-- 7,336 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
unit BEncode;

interface

uses
  Classes, Contnrs, SysUtils;

type
  TBEncodedFormat = (befEmpty, befString, befInteger, befList, befDictionary);

  TBEncodedData = class(TObject)
  public
    Header: AnsiString;
    Data: TObject; // actually TBEncoded
    destructor Destroy; override;
    constructor Create(bData: TObject);
  end;

  { TBEncodedDataList }

  TBEncodedDataList = class(TObjectList)
  protected
    function GetItems(Index: Integer): TBEncodedData;
    procedure SetItems(Index: Integer; AClass: TBEncodedData);
  public
    function FindElement(Header: AnsiString; RaiseException: boolean = True): TObject;
    function Add(AClass: TBEncodedData): Integer;
    function Extract(Item: TBEncodedData): TBEncodedData;
    function Remove(AClass: TBEncodedData): Integer;
    function IndexOf(AClass: TBEncodedData): Integer;
    function First: TBEncodedData;
    function Last: TBEncodedData;
    procedure Insert(Index: Integer; AClass: TBEncodedData);
    property Items[Index: Integer]: TBEncodedData read GetItems write SetItems;
      default;
  end;

  TBEncoded = class(TObject)
  private
    FFormat: TBEncodedFormat;
    procedure SetFormat(Format: TBEncodedFormat);
  public
    StringData: AnsiString;
    IntegerData: int64;
    ListData: TBEncodedDataList;
    property Format: TBEncodedFormat read FFormat write SetFormat;
    class procedure Encode(Encoded: TObject; var Output: AnsiString);
    destructor Destroy; override;
    constructor Create(Stream: TStream);
  end;

implementation

destructor TBEncodedData.Destroy;
begin
  Data.Free;

  inherited Destroy;
end;

constructor TBEncodedData.Create(bData: TObject);
begin
  inherited Create;

  Self.Data := bData;
end;

destructor TBEncoded.Destroy;
begin
  if ListData <> nil then
    ListData.Free;

  inherited Destroy;
end;

constructor TBEncoded.Create(Stream: TStream);

  procedure InvalidInput;
  begin
    raise Exception.Create('Invalid torrent file.');
  end;

  function GetString(Buffer: AnsiString): AnsiString;
  var
    X: char;
    lngth:Integer;
  begin
    // loop until we come across it
    repeat
      Stream.ReadBuffer(X, 1);
      if not ((X in ['0'..'9']) or (x = ':')) then
        InvalidInput;
      if X = ':' then
      begin
        if Buffer = '' then
          InvalidInput;
        if Length(Buffer) > 6 then
          InvalidInput;
        lngth:=StrToInt(Buffer);
        SetLength(Result, lngth);
        Stream.ReadBuffer(Result[1], lngth);
        Break;
      end
      else
        Buffer := Buffer + X;
    until False;
  end;

var
  X: char;
  Buffer: AnsiString;
  Data: TBEncodedData;
  Encoded: TBEncoded;

begin
  inherited Create;

  // get first character to determine the format of the proceeding data
  Stream.ReadBuffer(X, 1);

  // is it an integer?
  if X = 'i' then
  begin
    // yes it is, let's read until we come across e
    Buffer := '';
    repeat
      Stream.ReadBuffer(X, 1);
      if not ((X in ['0'..'9']) or (X = 'e')) then
        InvalidInput;
      if X = 'e' then
      begin
        if Buffer = '' then
          InvalidInput
        else
        begin
          Format := befInteger;
          IntegerData := StrToInt64(Buffer);
          Break;
        end;
      end
      else
        Buffer := Buffer + X;
    until False;
  end
  // is it a list?
  else if X = 'l' then
  begin
    // its a list
    Format := befList;

    // loop until we come across e
    repeat
      // have a peek around and see if theres an e
      Stream.ReadBuffer(X, 1);
      // is it an e?
      if X = 'e' then
        Break;
      // otherwise move the cursor back
      Stream.Seek(-1, soFromCurrent);
      // create the element
      Encoded := TBEncoded.Create(Stream);
      // add it to the list
      ListData.Add(TBEncodedData.Create(Encoded));
    until False;
  end
  // is it a dictionary?
  else if X = 'd' then
  begin
    // its a dictionary :>
    Format := befDictionary;

    // loop until we come across e
    repeat
      // have a peek around and see if theres an e
      Stream.ReadBuffer(X, 1);
      // is it an e?
      if X = 'e' then
        Break;
      // if it isnt an e it has to be numerical!
      if not (X in ['0'..'9']) then
      begin
        InvalidInput;
      end;
      // now read the string data
      Buffer := GetString(AnsiString(X));

      // create the element
      Encoded := TBEncoded.Create(Stream);
      // create the data element
      Data := TBEncodedData.Create(Encoded);
      Data.Header := Buffer;
      // add it to the list
      ListData.Add(Data);
    until False;
  end
  // is it a string?
  else if X in ['0'..'9'] then
  begin
    StringData := GetString(AnsiString(X));
    Format := befString;
  end
  else
    InvalidInput;
end;

class procedure TBEncoded.Encode(Encoded: TObject; var Output: AnsiString);
var
  i: integer;
begin
  with TBEncoded(Encoded) do
  begin
    // what type of member is it?
    case Format of
      befString: Output := Output + IntToStr(Length(StringData)) + ':' +
        StringData;
      befInteger: Output := Output + 'i' + IntToStr(IntegerData) + 'e';
      befList:
      begin
        Output := Output + 'l';
        for i := 0 to ListData.Count - 1 do
          Encode(TBEncoded(ListData[i].Data), Output);
        Output := Output + 'e';
      end;
      befDictionary:
      begin
        Output := Output + 'd';
        for i := 0 to ListData.Count - 1 do
        begin
          Output := Output + IntToStr(Length(ListData[i].Header)) + ':' +
            ListData[i].Header;
          Encode(TBEncoded(ListData[i].Data), Output);
        end;
        Output := Output + 'e';
      end;
    end;
  end;
end;

procedure TBEncoded.SetFormat(Format: TBEncodedFormat);
begin
  if Format in [befList, befDictionary] then
    ListData := TBEncodedDataList.Create;
  FFormat := Format;
end;

function TBEncodedDataList.FindElement(Header: AnsiString; RaiseException: boolean): TObject;
var
  i: integer;
begin
  Header := LowerCase(Header);
  for i := 0 to Count - 1 do
    if LowerCase(Items[i].Header) = Header then
    begin
      Result := Items[i].Data;
      Exit;
    end;

  if RaiseException then
    raise Exception.CreateFmt('Element ''%s'' not found.', [Header])
  else
    Result:=nil;
end;

function TBEncodedDataList.Add(AClass: TBEncodedData): Integer;
begin
  Result := inherited Add(AClass);
end;

function TBEncodedDataList.Extract(Item: TBEncodedData): TBEncodedData;
begin
  Result := TBEncodedData(inherited Extract(Item));
end;

function TBEncodedDataList.First: TBEncodedData;
begin
  Result := TBEncodedData(inherited First);
end;

function TBEncodedDataList.GetItems(Index: Integer): TBEncodedData;
begin
  Result := TBEncodedData(inherited Items[Index]);
end;

function TBEncodedDataList.IndexOf(AClass: TBEncodedData): Integer;
begin
  Result := inherited IndexOf(AClass);
end;

procedure TBEncodedDataList.Insert(Index: Integer; AClass: TBEncodedData);
begin
  inherited Insert(Index, AClass);
end;

function TBEncodedDataList.Last: TBEncodedData;
begin
  Result := TBEncodedData(inherited First);
end;

function TBEncodedDataList.Remove(AClass: TBEncodedData): Integer;
begin
  Result := inherited Remove(AClass);
end;

procedure TBEncodedDataList.SetItems(Index: Integer; AClass: TBEncodedData);
begin
  inherited Items[Index] := AClass;
end;

end.