unit ShareUnit;

interface

uses
  Unicode, XMLTag, Classes, SysUtils;

type
  TBuildShareListThread = class(TThread)
  private
  protected
    procedure Execute; override;
  public
    constructor Create; overload;
    destructor Destroy; override;
  end;

var
  ShareListBuilding: Boolean;
  ShareListFileName: string;
  ShareListTmpFileName: string;
  ShareDirCount: Integer;
  ShareFileCount: Integer;
  ShareFileSzize: Int64;
  curBSLThread: TBuildShareListThread;

function GetShareDirs: TWideStrings;
procedure SaveShareDirs(List: TWideStrings);
procedure BuildShareList;


implementation

uses XMLParser, Session, PrefController;

function SlashSep(const Path, S: string): string;
begin
  if AnsiLastChar(Path)^ <> '\' then
    Result := Path + '\' + S
  else
    Result := Path + S;
end;

function GetShareDirs: TWideStrings;
var
  Parser: TXMLTagParser;
  fn: string;
  Tag: TXMLTag;
  Tags: TXMLTagList;
  i: integer;
begin
  Result := TWideStringList.Create;
  Parser := TXMLTagParser.Create;
  fn := getUserDir + 'shares.xml';
  Parser.ParseFile(fn);
  if Parser.Count > 0 then
    with Parser.popTag do
    begin
      Tag := GetFirstTag('user_' + MainSession.Username);
      if Tag = nil then
        exit;
      Tags := tag.ChildTags;
      for i := 0 to tags.Count - 1 do
        if tags.Tags[i].Name = 'path' then
          Result.Add(tags.Tags[i].Data);
    end;
  Parser.Free;
end;

procedure SaveShareDirs(List: TWideStrings);
var
  Parser: TXMLTagParser;
  XML: TXMLTag;
  Tag: TXMLTag;
  i: integer;
  fn: string;
  fs: TStringList;
begin
  Parser := TXMLTagParser.Create;
  fn := getUserDir + 'shares.xml';
  Parser.ParseFile(fn);
  if Parser.Count > 0 then
    XML := Parser.popTag
  else
    XML := TXMLTag.Create('AnyQ_Sharedirs');
  Parser.Free;

  with XML do
  begin
    Tag := GetFirstTag('user_' + MainSession.Username);
    if Tag = nil then
      Tag := AddTag('user_' + MainSession.Username);
    Tag.ClearTags;
  end;

  for i := 0 to List.Count - 1 do
    Tag.AddBasicTag('path', List[i]);

  fs := TStringList.Create;
  fs.Text := UTF8Encode(XML.xml);
  fs.SaveToFile(fn);
  fs.Free();
  Xml.Free;
end;

procedure BuildShareList;
var
  XML: TXMLTag;
  Dirs: TWideStrings;
  i: Integer;
  fs: TStringList;
  procedure BuildList(Root: TXMLTag; ParentDir, DirName: widestring);
  var
    Status: Integer;
    SearchRec: TSearchRec;
  begin
    if not ShareListBuilding then
      abort;
    Root := Root.AddTag('DIR');
    Root.setAttribute('name', DirName);
    if ParentDir <> '' then
      DirName := SlashSep(ParentDir, DirName);
    with Root do
    begin
      try
        Status := FindFirst(SlashSep(DirName, '*.*'), faDirectory, SearchRec);
        while Status = 0 do
        begin
          if (SearchRec.Attr and faDirectory = faDirectory) then
            if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
            begin
              BuildList(ROOT, DirName, SearchRec.Name);
            end;

          Status := FindNext(SearchRec);
        end;
      finally
        FindClose(SearchRec);
      end;

      try
        Status := FindFirst(SlashSep(DirName, '*.*'), faArchive, SearchRec);
        while Status = 0 do
        begin
          if (SearchRec.Attr and faArchive = faArchive) then
            with AddTag('FILE') do
            begin
              setAttribute('name', SearchRec.Name);
              setAttribute('size', inttostr(SearchRec.Size));
            end;
          inc(ShareFileCount);
          ShareFileSzize := ShareFileSzize + SearchRec.Size;
          Status := FindNext(SearchRec);
        end;
      finally
        FindClose(SearchRec);
      end;
    end;
  end;
begin
  if ShareListBuilding then
    exit;
  ShareListBuilding := true;
  try
    XML := TXMLTag.Create('AnyQ_ShareList_' + MainSession.Username);
    Dirs := GetShareDirs;

    ShareDirCount := Dirs.Count;
    ShareFileCount := 0;
    ShareFileSzize := 0;

    for i := 0 to Dirs.Count - 1 do
      if DirectoryExists(Dirs[i]) then
      begin
        BuildList(XML, '', Dirs[i]);
      end;

    Dirs.Free;

    ShareListFileName := getUserDir + MainSession.Username + '_sharelist.xml';
    fs := TStringList.Create;
    fs.Text := UTF8Encode(XML.xml);
    fs.SaveToFile(ShareListFileName);

    fs.Free();
    XML.Free;
  finally
    ShareListBuilding := false;
  end;
end;

{ TBuildShareListThread }

constructor TBuildShareListThread.Create;
begin
  while curBSLThread <> nil do
  begin
    ShareListBuilding := false;
    sleep(50);
  end;
  inherited Create(False);
  FreeOnTerminate := True;
  curBSLThread := self;
end;

destructor TBuildShareListThread.Destroy;
begin
  curBSLThread := nil;
  inherited;
end;

procedure TBuildShareListThread.Execute;
begin
  while ShareListBuilding do
    sleep(100);
  BuildShareList;
end;

initialization
  ShareListBuilding := false;
  ShareListFileName := getUserDir + 'sharelist.xml';
  ShareListTmpFileName := getUserDir + 'TMP.xml';
  ShareDirCount := 0;
  ShareFileCount := 0;
  ShareFileSzize := 0;
end.
