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

 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, StringResources;

{$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;
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
  Pos := 0;
  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
      begin
        PShare(Items[I])^.User := nil;
        FreeShareItem(PShare(Items[I])); // メモリリーク対策
      end;
      //    T1 := GetTickCount;
      //    T2 := T1;
    end;
    Pos := 7;
    if Dirs <> nil then
      Dirs.Clear;
    inherited Clear;
    //  T3 := GetTickCount;
    Pos := 8;
    // Log(slOnline, Format(RS_Share_TimeToClear, [Num, T3 - Start_T, T1 - Start_T, T2 - T1, 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 // 比較結果が常にFalse？？
  else
    Result := PNapCmd(Dirs.Items[Rec^.Index])^.Cmd + Rec^.Name;
end;

procedure TShareList.DoReindex;
var
  I, J: Integer;
  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);
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.
