=========> Urgent Urgent Urgent <========= log visited web site

hi
i want source code for log all visited web site in a Workstation
LVL 1
mahdiparakAsked:
Who is Participating?
 
Russell LibbyConnect With a Mentor Software Engineer, Advisory Commented:

This is from an old PAQ I worked on, assuming you are dealing with IE. If so, the code allows you to get all the visited urls, (and cookies, etc) that are currently in the history.

Regards,
Russell

Example usage (form, memo control, and a button)

procedure TForm1.Button1Click(Sender: TObject);
var  dwIndex:       Integer;
begin

  with TUrlCache.Create do
  begin
     GetEntries(utUrl, Memo1.Lines);
     MessageBox(0, 'Click ok to load cookies', nil, MB_OK);
     GetEntries(utCookie, Memo1.Lines);
     MessageBox(0, 'Click ok to load visited sites', nil, MB_OK);
     GetEntries(utVisited, Memo1.Lines);
     MessageBox(0, 'Click ok to load all urls', nil, MB_OK);
     GetEntries(utAll, Memo1.Lines);
     // Clear all urls if OK is clicked
     if (MessageBox(0, 'Click ok to clear cache', nil, MB_OKCANCEL) = ID_OK) then Clear;
     // Free object
     Free;
  end;

end;





Source:

--------------------
unit UrlCache;

interface

uses
  Windows, SysUtils, Classes, WinInet;

const
  DEF_URLSIZE       =  512;  // Average url size. This is used because the structure
                             // for the url entry will always be greater than 80 bytes,
                             // but in general, will be less than 512 bytes. This allows
                             // a balance between allocating too much memory, and having to
                             // perform a realloc on every enumeration call.

type
  TUrlEntryType     =  (utAll, utUrl, utCookie, utVisited);
  TUrlCache         =  class(TObject)
  private
     // Private declarations
     FList:         TList;
     procedure      ClearList;
  protected
     // Protected declarations
     function       GetUrlEntry(Index: Integer): TInternetCacheEntryInfo;
     function       GetCount: Integer;
     procedure      Load;
  public
     // Public declarations
     constructor    Create;
     destructor     Destroy; override;
     procedure      Delete(Index: Integer);
     procedure      Refresh;
     procedure      GetEntries(EntryType: TUrlEntryType; List: TStrings);
     procedure      Clear;
     property       Count: Integer read GetCount;
     property       UrlEntry[Index: Integer]: TInternetCacheEntryInfo read GetUrlEntry; default;
  end;

implementation

procedure TUrlCache.GetEntries(EntryType: TUrlEntryType; List: TStrings);
var  dwIndex:       Integer;
begin

  // Check list
  if Assigned(List) then
  begin
     // Clear list
     List.Clear;
     // Walk all items
     for dwIndex:=0 to Pred(FList.Count) do
     begin
        // Get the specified entry types
        case EntryType of
           // Url sites
           utUrl       :
           begin
              // Not visited: or cookies:
              if (StrLIComp('cookie:', PInternetCacheEntryInfo(FList[dwIndex])^.lpszSourceUrlName, 7) <> 0) and
                 (StrLIComp('visited:', PInternetCacheEntryInfo(FList[dwIndex])^.lpszSourceUrlName, 8) <> 0) then
              begin
                 List.Add(PInternetCacheEntryInfo(FList[dwIndex])^.lpszSourceUrlName);
              end;
           end;
           // Add "cookies:" entries
           utCookie    :
           begin
              if (StrLIComp('cookie:', PInternetCacheEntryInfo(FList[dwIndex])^.lpszSourceUrlName, 7) = 0) then
              begin
                 List.Add(PInternetCacheEntryInfo(FList[dwIndex])^.lpszSourceUrlName);
              end;
           end;
           // Add "visited:" entries
           utVisited   :
           begin
              if (StrLIComp('visited:', PInternetCacheEntryInfo(FList[dwIndex])^.lpszSourceUrlName, 8) = 0) then
              begin
                 List.Add(PInternetCacheEntryInfo(FList[dwIndex])^.lpszSourceUrlName);
              end;
           end;
        else
           // Add the entry
           List.Add(PInternetCacheEntryInfo(FList[dwIndex])^.lpszSourceUrlName);
        end;
     end;
  end;

end;

function TUrlCache.GetCount: Integer;
begin

  // Return entry count
  result:=FList.Count;

end;

procedure TUrlCache.ClearList;
var  dwIndex:       Integer;
begin

  // Free all entries and clear the list
  for dwIndex:=Pred(FList.Count) downto 0 do
  begin
     // Free memory
     FreeMem(FList[dwIndex]);
  end;

  // Clear the list
  FList.Clear;

end;

function TUrlCache.GetUrlEntry(Index: Integer): TInternetCacheEntryInfo;
begin

  // Return the requested entry
  result:=PInternetCacheEntryInfo(FList[Index])^;

end;

procedure TUrlCache.Delete(Index: Integer);
begin

  // Remove from cache
  if DeleteUrlCacheEntry(PInternetCacheEntryInfo(FList[Index]).lpszSourceUrlName) then
  begin
     // Free memory
     FreeMem(FList[Index]);
     // Remove from list
       FList.Delete(Index);
  end;

end;

procedure TUrlCache.Refresh;
begin

  // Just call load
  Load;

end;

procedure TUrlCache.Load;
var  lpCacheEntry:  PInternetCacheEntryInfo;
     hFind:         THandle;
     dwSize:        DWORD;
     bEnum:         Boolean;
begin

  // Allocate memory for the find
  dwSize:=DEF_URLSIZE;
  lpCacheEntry:=AllocMem(dwSize);

  // Find first
  hFind:=FindFirstUrlCacheEntry(nil, lpCacheEntry^, dwSize);
  if (hFind = 0) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
  begin
     // Reallocate for required size
     ReAllocMem(lpCacheEntry, dwSize);
     // Perform find again
     hFind:=FindFirstUrlCacheEntry(nil, lpCacheEntry^, dwSize);
  end;

  // Set enum state
  bEnum:=(hFind <> 0);

  // Perform find first/next enumeration
  if bEnum then
  begin
     // Find has started
     while bEnum do
     begin
        // Add entry to list
        FList.Add(lpCacheEntry);
        // Nil the pointer
        lpCacheEntry:=nil;
        // Allocate for find next
        dwSize:=DEF_URLSIZE;
        lpCacheEntry:=AllocMem(dwSize);
        // Find next
        if not(FindNextUrlCacheEntry(hFind, lpCacheEntry^, dwSize)) then
        begin
           // Buffer too small, or no more items?
           if (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
           begin
              // Reallocate for required size
              ReAllocMem(lpCacheEntry, dwSize);
              // Perform find next again
              bEnum:=FindNextUrlCacheEntry(hFind, lpCacheEntry^, dwSize);
           end
           else
              // Done enumeration
              bEnum:=False;
        end
        else
           // Enumerate
           bEnum:=True;
     end;
     // Close the enumeration
     FindCloseUrlCache(hFind);
  end;

  // If entry is assigned then free memory
  if Assigned(lpCacheEntry) then FreeMem(lpCacheEntry);

end;

procedure TUrlCache.Clear;
var  dwIndex:       Integer;
begin

  // This will delete all entries from the cache
  for dwIndex:=Pred(FList.Count) downto 0 do
  begin
     // Remove from cache
     if DeleteUrlCacheEntry(PInternetCacheEntryInfo(FList[dwIndex]).lpszSourceUrlName) then
     begin
        // Free memory
        FreeMem(FList[dwIndex]);
        // Remove from list
        FList.Delete(dwIndex);
     end;
  end;
  if FList.Count > 0 then
     beep;
end;

constructor TUrlCache.Create;
begin

  // Perform inherited
  inherited Create;

  // Create list
  FList:=TList.Create;

  // Load the list
  Load;

end;

destructor TUrlCache.Destroy;
begin

  // Clear all entries from the list
  try
     ClearList;
  finally
     // Free the list
     FList.Free;
  end;

  // Perform inherited
  inherited Destroy;

end;

end.
0
 
insomniac92Commented:
what OS / browser?
0
 
mahdiparakAuthor Commented:
excellent Rllibby
very thanks
0
 
mahdiparakAuthor Commented:
ok
not use again.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.