Utilizamos cookies propias y de terceros. [Más información sobre las cookies].
Política de cookies
Proyecto AjpdSoft

· Inicio
· Buscar
· Contactar
· Cookies
· Descargas
· Foros
· Historia
· Nosotros
· Temas
· Top 10
· Trucos
· Tutoriales
· Wiki
Obtener el Historial de Internet y vaciar carpeta Historial - Delphi
Lenguaje de programación Borland Delphi

Con este código podrá obtener los datos de la carpeta Historial (páginas web visitadas por el usuario actual del PC) y vaciar dicha carpeta. Para ello necesitará un formulario (TForm), un TStringGrid con 5 columnas y dos botones (TButton), uno llamado "RetrieveBtn" y otro llamado "ClearBtn". El código fuente completo:


unit UnidadMenuPrincipal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, activex, Grids, StdCtrls, Comobj, ExtCtrls;

//Historial
const
  STATURL_QUERYFLAG_ISCACHED = $00010000;
  STATURL_QUERYFLAG_NOURL = $00020000;
  STATURL_QUERYFLAG_NOTITLE = $00040000;
  STATURL_QUERYFLAG_TOPLEVEL = $00080000;

  STATURLFLAG_ISCACHED = $00000001;
  STATURLFLAG_ISTOPLEVEL = $00000002;

  IID_IEnumStatUrl: TGUID = (D1: $3C374A42; D2: $BAE4; D3: $11CF; D4: ($BF, $7D, $00, $AA, $00, $69, $46, $EE));
  IID_IUrlHistoryStg: TGUID = (D1: $3C374A41; D2: $BAE4; D3: $11CF; D4: ($BF, $7D, $00, $AA, $00, $69, $46, $EE));
  IID_IUrlHistoryStg2: TGUID = (D1: $AFA0DC11; D2: $C313; D3: $831A; D4: ($83, $1A, $00, $C0, $4F, $D5, $AE, $38));
  IID_IUrlHistoryNotify: TGUID = (D1: $BC40BEC1; D2: $C493; D3: $11D0; D4: ($83, $1B, $00, $C0, $4F, $D5, $AE, $38));

  SID_IEnumStatUrl = '{3C374A42-BAE4-11CF-BF7D-00AA006946EE}';
  SID_IUrlHistoryStg = '{3C374A41-BAE4-11CF-BF7D-00AA006946EE}';
  SID_IUrlHistoryStg2 = '{AFA0DC11-C313-11d0-831A-00C04FD5AE38}';
  SID_IURLHistoryNotify = '{BC40BEC1-C493-11d0-831B-00C04FD5AE38}';
  CLSID_CUrlHistory: TGUID = '{3C374A40-BAE4-11CF-BF7D-00AA006946EE}';

type
  STATURL = record
    cbSize: DWORD;
    pwcsUrl: DWORD;
    pwcsTitle: DWORD;
    ftLastVisited: FILETIME;
    ftLastUpdated: FILETIME;
    ftExpires: FILETIME;
    dwFlags: DWORD;
  end;

  IEnumSTATURL = interface(IUnknown)
  ['{3C374A42-BAE4-11CF-BF7D-00AA006946EE}']
  function Next(celt: Integer; out elt; pceltFetched: PLongint): HRESULT; stdcall;
  function Skip(celt: Longint): HRESULT; stdcall;
  function Reset: HResult; stdcall;
  function Clone(out ppenum: IEnumSTATURL): HResult; stdcall;
  function SetFilter(poszFilter: PWideChar; dwFlags: DWORD): HResult; stdcall;
end;

  IUrlHistoryStg = interface(IUnknown)
    ['{3C374A41-BAE4-11CF-BF7D-00AA006946EE}']
    function AddUrl(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer): HResult; stdcall;
    function DeleteUrl(pocsUrl: PWideChar; dwFlags: Integer): HResult; stdcall;
    function QueryUrl(pocsUrl: PWideChar; dwFlags: Integer; var lpSTATURL: STATURL): HResult; stdcall;
    function BindToObject(pocsUrl: PWideChar; var riid: TIID; out ppvOut: Pointer): HResult; stdcall;
    function EnumUrls(out ppenum: IEnumSTATURL): HResult; stdcall;
  end;

  IUrlHistoryStg2 = interface(IUrlHistoryStg)
    ['{AFA0DC11-C313-11D0-831A-00C04FD5AE38}']
    function AddUrlAndNotify(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer;
    fWriteHistory: Integer; var poctNotify: Pointer;
    const punkISFolder: IUnknown): HResult; stdcall;
    function ClearHistory: HResult; stdcall;
  end;

  IUrlHistoryNotify = interface(IOleCommandTarget)
    ['{BC40BEC1-C493-11d0-831B-00C04FD5AE38}']
  end;

//fin historial

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Panel1: TPanel;
    ClearBtn: TButton;
    RetrieveBtn: TButton;
    procedure RetrieveBtnClick(Sender: TObject);
    procedure ClearBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  I: IUrlHistoryStg2;

implementation

{$R *.dfm}

function FileTimeToDt(Ft: TFileTime): TDateTime;
var
  l: Integer;
  lft: TFileTime;
begin
  FileTimeToLocalFiletime(Ft, lft);
  if FileTimeToDosDateTime(lft, Longrec(l).Hi, Longrec(l).Lo) then
    result := FiledateToDatetime(l)
  else
    result := 0;
end;


procedure TForm1.RetrieveBtnClick(Sender: TObject);
var
  r: Staturl;
  Enum: IEnumStatUrl;
  X: Integer;
  Row: Integer;
begin
  StringGrid1.Cells[0, 0] := 'Última visita';
  StringGrid1.Cells[1, 0] := 'Título';
  StringGrid1.Cells[2, 0] := 'Dirección';
  StringGrid1.Cells[3, 0] := 'Última actualización';
  StringGrid1.Cells[4, 0] := 'Expira';
  Row := 0;
  I := CreateComObject(ClsId_CUrlHistory) as IUrlHistoryStg2;
  I.EnumUrls(Enum);
  Enum.SetFilter('http://', 0);
  while enum.next(1, r, @X) = S_OK do
  begin
    Inc(Row);
    StringGrid1.RowCount := Row + 1;
    Stringgrid1.Cells[0, Row] := DateTimeToStr(FileTimeToDt(r.ftLastVisited));
    Stringgrid1.Cells[1, Row] := PWidechar(Pointer(r.pwcsTitle));
    Stringgrid1.Cells[2, Row] := PWidechar(Pointer(r.pwcsUrl));
    Stringgrid1.Cells[3, Row] := DateTimeToStr(FileTimeToDt(r.ftLastUpdated));
    Stringgrid1.Cells[4, Row] := DateTimeToStr(FileTimeToDt(r.ftExpires));
  end;
end;

procedure TForm1.ClearBtnClick(Sender: TObject);
begin
  if MessageDlg('¿Desea eliminar el Historial de Internet?',
      mtConfirmation, [mbyes, mbno], 0) = mryes then
  begin
    I.ClearHistory;
    Application.ProcessMessages;
    RetrieveBtnClick(nil);
  end;
end;

end.




Publicado el: 2004-06-09

Visita nuestro nuevo sitio web con programas y contenidos actualizados: Proyecto A