{*********************************************************

 SlavaNap source code.

 Copyright 2001,2002 by SlavaNap development team
 Released under GNU General Public License

 Latest version is available at
 http://www.slavanap.org

**********************************************************

 Unit: share

 Class for list of shared files

*********************************************************}
unit share;

interface

uses
 Windows, Classes2, SysUtils, stypes, constants, slavastrings, class_cmdlist,
 class_cmd2list;

{$I defines.pas}

const
 SHARED_AUDIO    = 0;
 SHARED_VIDEO    = 1;
 SHARED_TEXT     = 2;
 SHARED_IMAGE    = 3;
 SHARED_APP      = 4;
 SHARED_CD       = 5;
  // MP3 - sorted by bitrate - this way search is several times faster is bitrate is specified.
 SHARED_320      = 6;
 SHARED_256      = 7;
 SHARED_224      = 8;
 SHARED_192      = 9;
 SHARED_160      = 10;
 SHARED_128      = 11;
 SHARED_112      = 12;
 SHARED_64       = 13;
 SHARED_OTHER    = 14; // MP3 with other bitrate
 // same for firewalled users.
 SHARED_FW_AUDIO = 15;
 SHARED_FW_VIDEO = 16;
 SHARED_FW_TEXT  = 17;
 SHARED_FW_IMAGE = 18;
 SHARED_FW_APP   = 19;
 SHARED_FW_CD    = 20;
 SHARED_FW_320   = 21;
 SHARED_FW_256   = 22;
 SHARED_FW_224   = 23;
 SHARED_FW_192   = 24;
 SHARED_FW_160   = 25;
 SHARED_FW_128   = 26;
 SHARED_FW_112   = 27;
 SHARED_FW_64    = 28;
 SHARED_FW_OTHER = 29; // MP3 with other bitrate
 // totals
 SHARED_MAX   = 14;
 SHARED_OTHER_MAX = 5;
 SHARED_MP3_MIN = 6;
 SHARED_FIREWALL = 15; // increment for firewalled users
 SHARED_ARRAY = 30; // total number of SHARED_xxx constants
 SHARED_INVALID = 255;
 // mime types
 TYPE_MP3     = 0;
 TYPE_AUDIO   = 1;
 TYPE_VIDEO   = 2;
 TYPE_IMAGE   = 3;
 TYPE_APP     = 4;
 TYPE_CD      = 5;
 TYPE_TEXT    = 6;
 // totals
 TYPE_MAX     = 6;
 TYPE_INVALID = 255;
 // winmx data
 WINMX_BITRATE = 24;
 WINMX_FREQ    = 16000;
 WINMX_TIME    = 600;
 // frequency
 FREQ_16000    = 0;
 FREQ_22050    = 1;
 FREQ_24000    = 2;
 FREQ_32000    = 3;
 FREQ_44100    = 4;
 FREQ_48000    = 5;
 FREQ_TOTAL    = 6;

type
  PWordsArray = ^TWordsArray;
  TWordsArray = array[0..(MAX_FILE_KEYWORDS*2)-2] of Pointer;
  TShare = packed record
    name         : String; // full file name
    crc          : Word; // crc of full filename. used for faster file search.
    index        : Word; // index in folders list
    size         : Int64; // size in bytes
    options      : LongWord; // options bits
                   // bits 0..9 = bitrate (0..1023)
                   // bits 10..12 = frequency (FREQ_xxx constants)
                   // bits 13..26 = time (0..16383)
                   // bits 27..30 = number of keywords in array (0..15)
                   // bit  31 = 1 if file is shared
    keywords     : PWordsArray;
    user         : Pointer; // pointer to owner
  end;
  PShare = ^TShare;
  TShareList = class(TMyList)
    dirs         : TNapCmdList;
    reindex      : Boolean;
    constructor Create;
    destructor Destroy; override;
    // global functions
    function  Add(Value: TShare): PShare;
    function  AddEx(item: PShare): Integer;
    procedure Delete(index: Integer; delete_index: Boolean = true);
    procedure Clear; override;
    // searching
    function  FindRec(filename: String): PShare;
    function  FindFile(filename: String): Integer; overload;
    function  FindFile(index: Integer; shortname: String): Integer; overload;
    // folders handling
    procedure DecreaseIndex(n: Integer);
    procedure IncreaseIndex(n: Integer);
    function  AddFolder(folder: String): Integer;
    function  GetFileName(index: Integer): String;
    procedure DoReindex;
  end;
  // new structures
  TFileData = record
    // data to identify:
    share_filename:   String; // filename without directory
    share_dirname:    String; // directory part
    // data for internal indexing
    extension:   String; // extension without dot. lowercase.
    filename:    String; // filename without ext. lowercase
    subfolder:   String; // 2nd level directory. lowercase
    keywords_count: Integer; // number of keywords
    keywords:    Array[0..MAX_FILE_KEYWORDS-1] of String;
  end;

procedure AllocateKeywordsList(share: PShare; count: Integer);
procedure FreeKeywordsList(share: PShare);
function  CreateShareItem: PShare;
procedure FreeShareItem(item: PShare);
function  GetType(ext: String): Integer;
function  StrToType(str:String): Integer;
function  ID2Mime(id: Byte): Integer;
procedure SplitOption(value: LongWord; var bitrate: Word; var freq: LongWord; var time: Word; var num_keywords: Word; var isshared: Boolean);
function  SetOption(bitrate: Word; freq: LongWord; time: Word; num_keywords: Word; isshared: Boolean): LongWord;
function  opIsShared(value: LongWord): Boolean; overload;
procedure opIsShared(var value: LongWord; isshared: Boolean); overload;
function  opNumWords(value: LongWord): Word; overload;
procedure opNumWords(var value: LongWord; num_words: Word); overload;
function  opBitrate(value: LongWord): Word;


implementation

uses
 vars, thread, keywords, handler, share2;

{* * * * * TShareList * * * * *}

constructor TShareList.Create;
begin
 inherited Create;
 reindex:=false;
 dirs:=TNapCmdList.Create;
end;

destructor TShareList.Destroy;
begin
 Clear;
 if dirs<>nil then dirs.Free;
 dirs:=nil;
 inherited Destroy;
end;

function  TShareList.Add(Value: TShare):PShare;
var
 data: PShare;
 i, w: Integer;
begin
 data:=AllocMem(sizeof(TShare));
 with data^ do
 begin
  Pointer(name):=nil;
  name:=Value.name;
  crc:=Value.crc;
  size:=Value.size;
  options:=Value.options;
  user:=Value.user;
  index:=Value.index;
 end;
 w:=opNumWords(Value.options);
 if w>0 then
 begin
   AllocateKeywordsList(data,w);
   for i:=0 to (w*2)-1 do
    data^.keywords^[i]:=value.keywords^[i];
 end;
 inherited Add(data);
 IncreaseIndex(value.index);
 Result:=data;
end;

function  CreateShareItem: PShare;
var
 i: Integer;
begin
 result:=AllocMem(sizeof(TShare));
 Pointer(result^.name):=nil;
 result^.options:=0;
end;

function  TShareList.AddEx(item: PShare): Integer;
begin
 IncreaseIndex(item^.index);
 Result:=inherited Add(item);
end;

procedure TShareList.Delete(index: Integer; delete_index: Boolean = true);
var
 p: PShare;
begin
 if (Index<0) or (Index>=count) then exit;
 if delete_index then DecreaseIndex(PShare(Items[index])^.index);
 p:=Items[Index];
 if running then
  DeleteKeywordsItem(p);
 if opNumWords(p^.options)>0 then
  FreeKeywordsList(p);
 p^.name:='';
 FreeMem(p, sizeof(TShare));
 inherited Delete(index);
end;

procedure FreeShareItem(item: PShare);
begin
 if item=nil then exit;
 item^.name:='';
 if opNumWords(item^.options)>0 then
   FreeKeywordsList(item);
 FreeMem(item, sizeof(TShare));
end;

procedure TShareList.Clear;
var
 i,num,pos: Integer;
 start_t, t1,t2,t3: Cardinal;
begin
 try
  pos:=1;
  start_t:=GetTickCount;
  num:=count;
  pos:=2;
  if running then
  begin
    pos:=3;
    t1:=GetTickCount;
    while count>0 do
     Delete(count-1,false);
    pos:=5;
    t2:=GetTickCount;
  end
  else
  begin
    pos:=6;
    for i:=0 to count-1 do
     PShare(Items[i])^.user:=nil;
    t1:=GetTickCount;
    t2:=t1;
  end;
  pos:=7;
  if dirs<>nil then dirs.Clear;
  inherited Clear;
  t3:=GetTickCount;
  pos:=8;
// Log(slOnline,' Time to clear TShare with '+IntToStr(num)+' items: '+IntToStr(t3-start_t)+' (t1='+IntToStr(t1-start_t)+', t2='+IntToStr(t2-t1)+', t3='+IntToStr(t3-t2)+')',true);
  except
   DebugLog('Exception in TShareList.Clear (pos='+IntToStr(pos)+')');
 end;
end;

function  TShareList.FindRec(filename: String): PShare;
var
 i: Integer;
 name, folder: String;
 crc: Word;
begin
 Result:=nil;
 crc:=StringCRC(filename,false);
 SplitFileName(filename,folder,name);
 for i:=count-1 downto 0 do
  if PShare(Items[i])^.crc=crc then
   if PShare(Items[i])^.name=name then
   begin
    Result:=Items[i];
    exit;
   end;
 if (count>50) then
 begin
  {$I checksync.pas}
 end;
end;

function  TShareList.FindFile(filename: String): Integer;
var
 i: Integer;
 crc: Word;
 name, folder: String;
begin
 Result:=-1;
 SplitFileName(filename,folder,name);
 crc:=StringCRC(filename,false);
 for i:=count-1 downto 0 do
  if PShare(Items[i])^.crc=crc then
   if PShare(Items[i])^.name=name then
   begin
    Result:=i;
    exit;
   end;
 if (count>50) then
 begin
  {$I checksync.pas}
 end;
end;

function  TShareList.FindFile(index: Integer; shortname: String): Integer;
var
 i: Integer;
begin
 Result:=-1;
 if index=-1 then exit;
 for i:=count-1 downto 0 do
  if PShare(Items[i])^.index=index then
   if PShare(Items[i])^.name=shortname then
   begin
    Result:=i;
    exit;
   end;
 if (count>50) then
 begin
  {$I checksync.pas}
 end;
end;

procedure TShareList.DecreaseIndex(n: Integer);
var
 i: Integer;
 rec: PShare;
begin
 if n=-1 then exit;
 if dirs=nil then exit;
 i:=PNapCmd(dirs.Items[n])^.id;
 dec(PNapCmd(dirs.Items[n])^.id);
 if i<1 then
 begin
  dirs.Delete(n);
  for i:=0 to count-1 do
  begin
    rec:=Items[i];
    if rec^.index>n then
     dec(rec^.index);
  end;
 end;
end;

procedure TShareList.IncreaseIndex(n: Integer);
begin
 if n=-1 then exit;
 inc(PNapCmd(dirs.Items[n])^.id); 
end;

function TShareList.AddFolder(folder: String): Integer;
begin
 Result:=dirs.FindByCmd(folder, false);
 if Result=-1 then Result:=dirs.AddCmd(0, folder);
end;

function  TShareList.GetFileName(index: Integer): String;
var
 rec: PShare;
begin
 rec:=Items[index];
 if rec^.index=-1 then Result:=rec^.name
 else Result:=PNapCmd(dirs.Items[rec^.index])^.cmd+rec^.name;
end;

procedure TShareList.DoReindex;
var
 i,j: Integer;
 p: PShare;
 d: PNapCmd;
begin
 tmp_pos:=1608;
 reindex:=false;
 if dirs=nil then exit;
 tmp_pos:=1609;
 for i:=dirs.count-1 downto 0 do
 begin
   tmp_pos:=1610;
   d:=dirs.Items[i];
   if d^.id=0 then
   begin // delete useless item
     tmp_pos:=1611;
     dirs.Delete(i);
     for j:=0 to count-1 do
      if PShare(Items[j])^.index>=i then
       dec(PShare(Items[j])^.index);
   end;
 end;
 tmp_pos:=1612;
end;

// extra functions

procedure AllocateKeywordsList(share: PShare; count: Integer);
begin
 if count<>opNumWords(share^.options) then
 begin
   ReallocMem(share^.keywords, count * 2 * SizeOf(Pointer));
   opNumWords(share^.options,count);
 end;
end;

procedure FreeKeywordsList(share: PShare);
begin
 if opNumWords(share^.options)<1 then exit;
 FreeMem(share^.keywords, opNumWords(share^.options) * 2 * SizeOf(Pointer));
 opNumWords(share^.options,0);
end;

function GetType(ext: String): Integer;
begin
  Result:=TYPE_MAX+1;
  ext:=lowercase(ext);
  if Length(ext)<2 then exit;
  if ext[1]='.' then ext:=Copy(ext,2,Length(ext));
  if Length(ext)<2 then exit;
  if StrHash_FindString(ext_mp3_list,ext,false) then
  begin
    Result:=TYPE_MP3;
    exit;
  end;
  if StrHash_FindString(ext_audio_list,ext,false) then
  begin
    Result:=TYPE_AUDIO;
    exit;
  end;
  if StrHash_FindString(ext_video_list,ext,false) then
  begin
    Result:=TYPE_VIDEO;
    exit;
  end;
  if StrHash_FindString(ext_app_list,ext,false) then
  begin
    Result:=TYPE_APP;
    exit;
  end;
  if StrHash_FindString(ext_image_list,ext,false) then
  begin
    Result:=TYPE_IMAGE;
    exit;
  end;
  if StrHash_FindString(ext_cd_list,ext,false) then
  begin
    Result:=TYPE_CD;
    exit;
  end;
  if StrHash_FindString(ext_text_list,ext,false) then
  begin
    Result:=TYPE_TEXT;
    exit;
  end;
end;

function  StrToType(str:String): Integer;
begin
 str:=lowercase(str);
 Result:=TYPE_INVALID;
 if pos('mp3',str)<>0 then Result:=TYPE_MP3;
 if pos('audio',str)<>0 then Result:=TYPE_AUDIO;
 if pos('video',str)<>0 then Result:=TYPE_VIDEO;
 if pos('text',str)<>0 then Result:=TYPE_TEXT;
 if pos('image',str)<>0 then Result:=TYPE_IMAGE;
 if pos('app',str)<>0 then Result:=TYPE_APP;
 if pos('cd',str)<>0 then Result:=TYPE_CD;
end;

function  ID2Mime(id: Byte): Integer;
begin
 if id>=SHARED_FIREWALL then dec(id,SHARED_FIREWALL);
 case id of
   SHARED_AUDIO:  result:=TYPE_AUDIO;
   SHARED_VIDEO:  result:=TYPE_VIDEO;
   SHARED_TEXT:   result:=TYPE_TEXT;
   SHARED_IMAGE:  result:=TYPE_IMAGE;
   SHARED_APP:    result:=TYPE_APP;
   SHARED_CD:     result:=TYPE_CD;
   else           result:=TYPE_MP3;
 end;
end;

procedure SplitOption(value: LongWord; var bitrate: Word; var freq: LongWord; var time: Word; var num_keywords: Word; var isshared: Boolean);
var
 i: Integer;
begin
 bitrate:=value and 1023;
 case ((value shr 10) and 7) of
   FREQ_22050:    freq:=22050;
   FREQ_24000:    freq:=24000;
   FREQ_32000:    freq:=32000;
   FREQ_44100:    freq:=44100;
   else           freq:=16000;
 end;
 time:=(value shr 13) and 16383;
 num_keywords:=(value shr 27) and 15;
 isshared:=(value and $80000000)>0;
end;

function  SetOption(bitrate: Word; freq: LongWord; time: Word; num_keywords: Word; isshared: Boolean): LongWord;
begin
 case freq of
   22050:  result:=FREQ_22050;
   24000:  result:=FREQ_24000;
   32000:  result:=FREQ_32000;
   44100:  result:=FREQ_44100;
   else    result:=FREQ_16000;
 end;
 result:=(bitrate and 1023) or (result shl 10) or ((time and 16383) shl 13) or ((num_keywords and 15) shl 27);
 if isshared then
  result:=result or $80000000;
end;

function  opIsShared(value: LongWord): Boolean; overload;
begin
 result:=(value and $80000000)>0;
end;

procedure opIsShared(var value: LongWord; isshared: Boolean); overload;
begin
 value:=value and ($7FFFFFFF);
 if isshared then
  value:=value or $80000000;
end;

function  opNumWords(value: LongWord): Word; overload;
begin
 result:=(value shr 27) and 15;
end;

procedure opNumWords(var value: LongWord; num_words: Word); overload;
begin
//DebugLog('Changing opNumWords. num_words='+IntToStr(num_words),true);
//DebugLog(' old value='+IntToStr((value shr 27) and 15),true);
 value:=value and ($FFFFFFFF - (15 shl 27));
 value:=value or ((num_words and 15) shl 27);
//DebugLog(' new value='+IntToStr((value shr 27) and 15),true);
end;

function  opBitrate(value: LongWord): Word;
begin
 result:=value and 1023;
end;

end.
