{******************************************************************}
{ AdslPrsr.pas                                                     }
{                                                                  }
{ Author    : A.Nasir Senturk                                      }
{ Home Page : http://www.shenturk.com                              }
{ Email     : shenturk@gmail.com                                   }
{                                                                  }
{ Date      : 27.12.2007                                           }
{                                                                  }
{ Sizden iki şey rica edicem:                                      }
{ 1. Lutfen bu baslik kismini kaldirmayiniz.                       }
{ 2. Mumkunse bagis yapiniz.                                       }
{ *****************************************************************}

unit AdslPrsr;

interface

uses MsHtml7, Urlmon, ActiveX, Windows, Messages, Classes, SysUtils, Variants,
  HtmlPrsr, ConstDef;

type
  TAdslParser = class(THtmlParser)
  private
    FServiceNo: WideString;
    FRecordDateTime: WideString;
    FIPAddress: WideString;
    FDisplayName: WideString;
    FUserName: WideString;
    FTableItems: array[0..MAX_ITEM - 1] of TTableItem;
    FErrorCode: Integer;
    FDataCount: Integer;
    FHtmlCollection: IHTMLElementCollection;
    function GetDownloads(Index: Integer): Double;
    function GetUploads(Index: Integer): Double;
    function GetMonths(Index: Integer): WideString;
    function GetYears(Index: Integer): WideString;
    function GetTableItem(Index: Integer): TTableItem;
    function GetLastDownload: Double;
    function GetLastUpload: Double;
    function GetLastMonth: WideString;
    function GetLastYear: WideString;
    procedure ParseHtmlTables;
    procedure ParseUserTable(HtmlTable: IHTMLTable);
    procedure ParseRecordTable(HtmlTable: IHTMLTable);
    procedure ParseQuotaTable(HtmlTable: IHTMLTable);
  public
    procedure Reset;
    procedure ParseHtmlPage(const FileName: WideString);
    property DisplayName: WideString read FDisplayName;
    property UserName: WideString read FUserName;
    property ServiceNo: WideString read FServiceNo;
    property RecordDateTime: WideString read FRecordDateTime;
    property IPAddress: WideString read FIPAddress;
    property Downloads[Index: Integer]: Double read GetDownloads;
    property Uploads[Index: Integer]: Double read GetUploads;
    property Years[Index: Integer]: WideString read GetYears;
    property Months[Index: Integer]: WideString read GetMonths;
    property Items[Index: Integer]: TTableItem read GetTableItem; default;
    property LastDownload: Double read GetLastDownload;
    property LastUpload: Double read GetLastUpload;
    property LastMonth: WideString read GetLastMonth;
    property LastYear: WideString read GetLastYear;
    property DataCount: Integer read FDataCount;
    property ErrorCode: Integer read FErrorCode;
  end;

implementation

uses StrUtils;

{ TAdslParser }

function TAdslParser.GetDownloads(Index: Integer): Double;
begin
  if (Index >= 0) or (Index < FDataCount) then
    Result := FTableItems[Index].Download
  else Result := 0.00;
end;

function TAdslParser.GetLastDownload: Double;
begin
  Result := Downloads[FDataCount - 1];
end;

function TAdslParser.GetLastMonth: WideString;
begin
  Result := Months[FDataCount - 1];
end;

function TAdslParser.GetLastUpload: Double;
begin
  Result := Uploads[FDataCount - 1];
end;

function TAdslParser.GetLastYear: WideString;
begin
  Result := Years[FDataCount - 1];
end;

function TAdslParser.GetMonths(Index: Integer): WideString;
begin
  if (Index >= 0) or (Index < FDataCount) then
    Result := FTableItems[Index].Month
  else Result := '';
end;

function TAdslParser.GetTableItem(Index: Integer): TTableItem;
begin
  if (Index >= 0) or (Index < FDataCount) then
    Result := FTableItems[Index];
end;

function TAdslParser.GetUploads(Index: Integer): Double;
begin
  if (Index >= 0) or (Index < FDataCount) then
    Result := FTableItems[Index].Upload
  else Result := 0.00;
end;

function TAdslParser.GetYears(Index: Integer): WideString;
begin
  if (Index >= 0) or (Index < FDataCount) then
    Result := FTableItems[Index].Year
  else Result := '';
end;

procedure TAdslParser.ParseHtmlPage(const FileName: WideString);
begin
  Reset;
  FHtmlCollection := LoadFromFile(FileName);
  if not Assigned(FHtmlCollection) then Exit;
  ParseHtmlTables;
end;

procedure TAdslParser.ParseHtmlTables;
var
  Index: Integer;
  HtmlTable: IHTMLTable;
  Dispatch: IDispatch;
  TableCount: Integer;
  Element: IHTMLElement;
begin
  if not Assigned(FHtmlCollection) then Exit;
  TableCount := 0;

  for Index := 0 to FHtmlCollection.length - 1 do
  begin
    Dispatch := FHtmlCollection.item(Index, 0);
    if Succeeded(Dispatch.QueryInterface(IHTMLTable, HtmlTable)) then
    begin
      if TableCount = 1 then begin
        ParseUserTable(HtmlTable);
      end
      else if TableCount = 2 then begin
        ParseRecordTable(HtmlTable);
      end;
      Element := HtmlTable as IHTMLElement;
      if SameText(Element.className, 'tblList') then
        ParseQuotaTable(HtmlTable);
      Inc(TableCount);
    end;
  end;

end;

procedure TAdslParser.ParseQuotaTable(HtmlTable: IHTMLTable);
var
  TableSection: IHTMLTableSection;
  Rows: IHTMLElementCollection;
  Row: IHTMLTableRow;
  Cells: IHTMLElementCollection;
  Cell: IHTMLTableCell;
  Element: IHTMLElement;
  Index: Integer;
  AnyText: WideString;
begin

  if not Assigned(HtmlTable) then Exit;
  if HtmlTable.tBodies.length = 0 then Exit;

  TableSection := HtmlTable.tBodies.item(0, 0) as IHTMLTableSection;
  Rows := TableSection.rows;
  for Index := 0 to Rows.length - 1 do
  begin

    if Index > MAX_ITEM - 1 then Break;

    Row := Rows.item(Index, 0) as IHTMLTableRow;
    Cells := Row.cells;
    if Cells.length > 3 then
    begin
      with FTableItems[Index] do
      begin

        Found := True;

        Cell := Cells.item(0, 0) as IHTMLTableCell;
        Element := Cell as IHTMLElement;
        Year := Element.innerText;

        Cell := Cells.item(1, 0) as IHTMLTableCell;
        Element := Cell as IHTMLElement;
        Month := Element.innerText;

        Cell := Cells.item(2, 0) as IHTMLTableCell;
        Element := Cell as IHTMLElement;
        AnyText := Element.innerText;
        AnyText := Copy(AnyText, 1, Pos(' ', AnyText) - 1);
        AnyText := Trim(AnyText);
        Upload := ConvertFloat(AnyText);

        Cell := Cells.item(3, 0) as IHTMLTableCell;
        Element := Cell as IHTMLElement;
        AnyText := Element.innerText;
        AnyText := Copy(AnyText, 1, Pos(' ', AnyText) - 1);
        AnyText := Trim(AnyText);
        Download := ConvertFloat(AnyText);

      end;

      Inc(FDataCount);
    end;
  end;

end;

procedure TAdslParser.ParseRecordTable(HtmlTable: IHTMLTable);
var
  Rows: IHTMLElementCollection;
  Row: IHTMLTableRow;
  Cells: IHTMLElementCollection;
  Cell: IHTMLTableCell;
  Element: IHTMLElement;
begin
  if not Assigned(HtmlTable) then Exit;
  Rows := HtmlTable.rows;
  if Rows.length > 1 then
  begin

    Row := Rows.item(0, 0) as IHTMLTableRow;
    Cells := Row.cells;
    if Cells.length > 1 then
    begin
      Cell := Cells.item(1, 0) as IHTMLTableCell;
      Element := Cell as IHTMLElement;
      FRecordDateTime := Element.innerText;
      FRecordDateTime := Trim(FRecordDateTime);
    end;

    Row := Rows.item(1, 0) as IHTMLTableRow;
    Cells := Row.cells;
    if Cells.length > 1 then
    begin
      Cell := Cells.item(1, 0) as IHTMLTableCell;
      Element := Cell as IHTMLElement;
      FIPAddress := Element.innerText;
      FIPAddress := Trim(FIPAddress);
    end;

  end;
end;

procedure TAdslParser.ParseUserTable(HtmlTable: IHTMLTable);
var
  Rows: IHTMLElementCollection;
  Row: IHTMLTableRow;
  Cells: IHTMLElementCollection;
  Cell: IHTMLTableCell;
  Element: IHTMLElement;
begin
  if not Assigned(HtmlTable) then Exit;
  Rows := HtmlTable.rows;
  if Rows.length >= 1 then
  begin
    Row := Rows.item(0, 0) as IHTMLTableRow;
    Cells := Row.cells;
    if Cells.length > 1 then
    begin

      Cell := Cells.item(0, 0) as IHTMLTableCell;
      Element := Cell as IHTMLElement;
      FDisplayName := Element.innerText;
      FUserName := Copy(FDisplayName, Pos('  ', FDisplayName) + 1, MaxInt);
      FUserName := Trim(FUserName);
      FDisplayName := Copy(FDisplayName, 1, Pos('  ', FDisplayName) - 1);
      FDisplayName := Trim(FDisplayName);

      Cell := Cells.item(1, 0) as IHTMLTableCell;
      Element := Cell as IHTMLElement;
      FServiceNo := Element.innerText;
      FServiceNo := Copy(FServiceNo, Pos(':', FServiceNo) + 1, MaxInt);
      FServiceNo := Trim(FServiceNo);
      
    end;
  end;
end;

procedure TAdslParser.Reset;
var
  Index: Integer;
begin
  FHtmlCollection := nil;
  FErrorCode := 0;
  FDataCount := 0;
  for Index := 0 to MAX_ITEM - 1 do
    FTableItems[Index].Found := False;
end;

end.