tspyutil.pas

分析torrent的东西是拿别人的

unit TSpyUtil;

{$WARN SYMBOL_PLATFORM OFF}
{$WARN SYMBOL_DEPRECATED OFF}
{$WARN UNIT_PLATFORM OFF}

interface

uses
  Windows, SysUtils, Contnrs, Classes, Hashes, BCode, StrUtils, ComCtrls,
  Math, ImgList, Forms;

const
  Printable: String = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz`~!@#$%^&*()-_=+[]{}\|;:''"<>,./? ';
  URLSafe: String = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-_;:,./';
  SaveAsCacheFileName: String = '.bittorrent-saveas-cache';
  CacheFileExtension: String = '.btc';
  hexchars: array[0..15] of Char = '0123456789abcdef';
  inifilename: String = 'torrentspy.ini';

type
  TTSIcon = (tsiDict = 0, tsiList, tsiNum, tsiString, tsiInfo, tsiWarning, tsiError, tsiUnknown, tsiNo, tsiYes);
  TSWebMode = (tswmNone = 0, tswmDownloads, tswmUpdate);
  TPathType = ( ptFile, ptDirectory );
  procedure MakeRawTree(obj: TObject; tree: TTreeView; node: TTreeNode);
  procedure Split(s: String; l: TStringList; d: String);
  function MakeFileList(Path: String; Files: TObjectList; PathLength: Integer): Int64;
  function UnixTime(): Int64;
  function UnixTimeToStr(ut: Int64): String;
  function TimeDeltaToStr(d: Extended): String;
  function IsValidAnnounceURL(URL: String): Boolean;
  function URLEncode(s: String): String;
  function FindUserHome(): String;
  function FindSaveAsCache(): String;
  function LoadPathFromSaveAsCache(CacheFileName: String; BinaryHash: String): String;
  procedure SavePathToSaveAsCache(CacheFileName: String; BinaryHash: String; Path: String);
  function bin2hex(s: String; m: Integer = 999): String;
  function hex2bin(s: String; m: Integer = 999): String;

implementation

function bin2hex(s: String; m: Integer = 999): String;
var
  i, j, k, l : Integer;
  r: Array of Char;
begin
  l := Length(s);
  if(m < l) then l := m;
  SetLength(r,l * 2);
  for i := 1 to l do begin
    j := Ord(s[i]);
    k := (i - 1) * 2;
    r[k] := hexchars[j div 16];
    r[k+1] := hexchars[j mod 16];
  end;
  Result := String(r);
end;

function hex2bin(s: String; m: Integer = 999): String;
var
  i, j, k, l : Integer;
  r : Array of Char;
begin
  l := Length(s);
  if(m < l) then l := m;
  l := l div 2;
  SetLength(r,l);
  for i := 0 to l - 1 do begin
    j := Pos(s[(2*i)+1],hexchars) - 1;
    k := Pos(s[(2*i)+2],hexchars) - 1;
    r[i] := Chr((16 * j) + k);
  end;
  Result := String(r);
end;

procedure Split(s: String; l: TStringList; d: String);
var
  i, ld: Integer;
  t: String;
begin
  ld := Length(d);
  i := Pos(d,s);
  while (i > 0) do begin
    if (i > 1) then begin
      t := MidStr(s,1,i-1);
      l.Add(t);
    end;
    s := MidStr(s,i+ld,Length(s));
    i := Pos(d,s);
  end;
  if (Length(s) > 0) then l.Add(s);
end;

function MakeFileList(Path: String; Files: TObjectList; PathLength: Integer): Int64;
var
  F: TSearchRec;
  LookFor, Name: String;
  IsDir: Boolean;
  l, s: Int64;
  NewFile: TObjectHash;
begin
  l := 0;
  if FileExists(Path) then begin
    IsDir := False;
    LookFor := Path
  end else if DirectoryExists(Path) then begin
    LookFor := Path + '*';
    IsDir := True;
  end else IsDir := False;
  if (FindFirst(LookFor, faAnyFile, F) = 0) then begin
    repeat
      if IsDir then Name := Path + F.Name else Name := Path;
      if ((F.Attr And faDirectory) <> 0) then begin // is a directory
        if (F.Name[1] <> '.') then l := l + MakeFileList(IncludeTrailingPathDelimiter(Name), Files, PathLength);
      end else begin
        s := (Int64(F.FindData.nFileSizeHigh) shl 32) or F.FindData.nFileSizeLow;
        NewFile := TObjectHash.Create();
        NewFile['length'] := TInt64.Create(s);
        NewFile['path'] := TString.Create(Copy(Name, PathLength, Length(Name)));
        NewFile['_'] := TString.Create(Name);
        Files.Add(NewFile);
        l := l + s;
      end;
    until (FindNext(F) <> 0);
    FindClose(F);
  end;
  Result := l;
end;

function UnixTime(): Int64;
var
  TZ: TTimeZoneInformation;
  Res: DWORD;
  d: TDateTime;
  dp, tp: Int64;
begin
  Res := GetTimeZoneInformation(TZ);
  d := Now();
  if (Res = TIME_ZONE_ID_INVALID) then RaiseLastWin32Error;
  if (Res = TIME_ZONE_ID_STANDARD) then d := d + ((TZ.Bias+TZ.StandardBias) / (24*60)) else d := d + ((TZ.Bias+TZ.DaylightBias) / (24*60));
  dp := Trunc(d);
  tp := Trunc((d - dp) * SecsPerDay);
  Result := ((dp-UnixDateDelta)*SecsPerDay) + tp;
end;

function UnixTimeToStr(ut: Int64): String;
var
  TZ: TTimeZoneInformation;
  Res: DWORD;
  d: TDateTime;
begin
  if (ut = 0) then Result := '' else begin
    d := Int64(UnixDateDelta) + (ut / (24*60*60));
    { calculate bias }
    Res := GetTimeZoneInformation(TZ);
    If (Res = TIME_ZONE_ID_INVALID) Then RaiseLastWin32Error;
    If (Res = TIME_ZONE_ID_STANDARD) Then Begin
      d := d - ((TZ.Bias+TZ.StandardBias) / (24*60));
      Result := DateTimeToStr(d);
    End
    Else Begin
      d := d - ((TZ.Bias+TZ.DaylightBias) / (24*60));
      Result := DateTimeToStr(d);
    End;
  End;
end;

function TimeDeltaToStr(d: Extended): String;
var
  h, m, s: Extended;
begin
  h := Trunc(d * 24);
  d := (d * 24) - h;
  m := Trunc(d * 60);
  d := (d * 60) - m;
  s := Round(d * 60);
  Result := FormatFloat('00',h) + ':' + FormatFloat('00',m) + ':' + FormatFloat('00',s)
end;

function IsValidAnnounceURL(URL: String): Boolean;
var
  Proto: String;
  Server: String;
  Path: String;
  w: Integer;
  t: String;
begin
  w := Pos('://',URL);
  if w = 0 then Result := False
  else begin
    Proto := LowerCase(Copy(URL,1,w-1));
    if (Proto <> 'http') and (Proto <> 'https') then Result := False  // Only allow HTTP-based protocols
    else begin
      t := Copy(URL,w+3,Length(URL)-w-2);
      w := Pos('/',t);  // Remove the path/query info
      if w = 0 then Result := False
      else begin
        Server := Copy(t,1,w-1);
        Path := Copy(t,w,Length(t)-w+1);
        w := Pos('@',Server); // Remove any authentication info
        if w > 0 then Server := Copy(Server,w+1,Length(Server)-w);
        w := Pos('.',Server);  // This may cause problems with intranet hostnames, but that's too much of a niche to worry about
        if w = 0 then Result := False
        else Result := True;
      end;
    end;
  end;
end;

procedure MakeRawTree(obj: TObject; tree: TTreeView; node: TTreeNode);
var
  i, j, n, o: Integer;
  l: TObjectList;
  h: TObjectHash;
  c: TTreeNode;
  k, m: String;
  b: Boolean;
  sl: TStringList;
begin
  if(obj is TObjectList) then begin
    l := obj as TObjectList;
    node.Text := node.Text + ' [' + IntToStr(l.Count) + ']';
    node.ImageIndex := TImageIndex(tsiList);
    for i := 0 to l.Count - 1 do begin
      c := tree.Items.AddChild(node, '');
      MakeRawTree(l[i], tree, c);
    end;
  end else if(obj is TObjectHash) then begin
    h := obj as TObjectHash;
    node.ImageIndex := TImageIndex(tsiDict);
    n := 0;
    sl := TStringList.Create();
    h.Restart();
    while (h.Next) do sl.Add(h.CurrentKey);
    sl.Sort();
    for o := 0 to sl.Count - 1  do begin
      k := sl[o];
      if(LeftStr(k, 1) <> '_') then begin
        b := True;
        i := 1;
        j := Min(64,Length(k));
        while(b and (i <= j)) do begin
          if(Pos(k[i],Printable) = 0) then b := False;
          i := i + 1;
        end;
        if(b) then m := k else m := '0x' + bin2hex(k,32);
        c := tree.Items.AddChild(node, m);
        MakeRawTree(h[k], tree, c);
        n := n + 1;
      end;
    end;
    FreeAndNil(sl);
    node.Text := node.Text + ' {' + IntToStr(n) + '}';
  end else if(obj is TString) then begin
    m := (obj as TString).Value;
    n := Length(m);
    node.ImageIndex := TImageIndex(tsiString);
    b := True;
    i := 1;
    j := Min(64,Length(m));
    while(b and (i <= j)) do begin
      if(Pos(m[i],Printable) = 0) then b := False;
      i := i + 1;
    end;
    if(not b) then m := '0x' + bin2hex(m,32);
    if(Length(m) > 64) then begin
      m := LeftStr(m,64) + '...';
    end;
    node.Text := node.Text + '(' + IntToStr(n) + ') = "' + m + '"';
  end else if(obj is TInt64) then begin
    node.ImageIndex := TImageIndex(tsiNum);
    node.SelectedIndex := TImageIndex(tsiNum);
    node.Text := node.Text + ' = ' + IntToStr((obj as TInt64).Value);
  end;
  node.SelectedIndex := node.ImageIndex;
  node.Expanded := True;
end;

function URLEncode(s: String): String;
var
  r: String;
  i: Integer;
  c: Char;
begin
  r := '';
  for i := 1 to Length(s) do begin
    c := s[i];
    if Pos(c,URLSafe) > 0 then r := r + c else r := r + '%' + bin2hex(c);
  end;
  Result := r;
end;

function FindUserHome(): String;
var
  userdir, UserHome: String;
begin
  userdir := GetEnvironmentVariable('HOME');
  if (userdir <> '') and (DirectoryExists(userdir)) then UserHome := userdir
  else begin
    userdir := GetEnvironmentVariable('APPDATA');
    if (userdir <> '') and (DirectoryExists(userdir)) then UserHome := userdir
    else begin
      userdir := GetEnvironmentVariable('HOMEPATH');
      if (userdir <> '') and (DirectoryExists(userdir)) then UserHome := userdir
      else begin
        userdir := GetEnvironmentVariable('USERPROFILE');
        if (userdir <> '') and (DirectoryExists(userdir)) then UserHome := userdir
        else begin
          UserHome := ExtractFilePath(Application.ExeName);
        end;
      end;
    end;
  end;
  Result := UserHome;
end;

function FindSaveAsCache(): String;
// Try to find the saveas cache that the experimental client uses
var
  UserHome: String;
begin
  UserHome := FindUserHome();
  if(UserHome <> '') then Result := IncludeTrailingPathDelimiter(UserHome) + SaveAsCacheFileName
  else Result := '';
end;

function LoadPathFromSaveAsCache(CacheFileName: String; BinaryHash: String): String;
var
  r: String;
  f: TFileStream;
  root: TObjectHash;
begin
  r := '';
  if(FileExists(CacheFileName)) then begin
    try
      try
        f := TFileStream.Create(CacheFileName,fmOpenRead);
        root := bdecodeStream(f) as TObjectHash;
        if root.Exists(BinaryHash) then begin
          if root[BinaryHash] is TString then begin
            r := (root[BinaryHash] as TString).Value;
          end;
        end;
      finally
        FreeAndNil(f);
      end;
    except
    end;
  end;
  Result := r;
end;

procedure SavePathToSaveAsCache(CacheFileName: String; BinaryHash: String; Path: String);
var
  root: TObjectHash;
  f: TFileStream;
begin
  root := Nil;
  if(FileExists(CacheFileName)) then begin
    try
      try
        f := TFileStream.Create(CacheFileName,fmOpenRead);
        root := bdecodeStream(f) as TObjectHash;
      finally
        FreeAndNil(f);
      end;
    except
    end;
  end;
  if (root = Nil) then root := TObjectHash.Create();
  root[BinaryHash] := TString.Create(ExcludeTrailingPathDelimiter(Path));
  try
    try
      f := TFileStream.Create(CacheFileName,fmOpenWrite or fmShareExclusive or fmCreate);
      bencodeStream(root, f);
    finally
      FreeAndNil(f);
    end;
  except
  end;
  FreeAndNil(root);
end;

end.