//Advanced Delphi Systems Code: ads_Intnet
Unit Ads_IntNet;

{Copyright(c)1998 Advanced Delphi Systems

 Richard Maley
 Advanced Delphi Systems
 12613 Maidens Bower Drive
 Potomac, MD 20854 USA
 phone 301-840-1554
 maley@advdelphisys.com
 maley@compuserve.com
 maley@cpcug.org}

(*
UnitIndex Master Index Implementation Section Download Units
Description: ads_Intnet.pas
This unit contains the following routines.

Internet_GetURLsFromCachePages   InternetCopyURLToFile   InternetGetBaseURL   InternetIsUrl   NMHttp_GetURLToFile   NMHttp_IsUrl   NMHttp_PostURLToFile   NMHttp_URLToFileDetail   PurgeInternetCache   TEditKeyFilter.OnlyAToZ   TEditKeyFilter.OnlyNumbers   TEditKeyFilter.OnlyNumbersAbsolute   TForm1.SpeedButton2Click_1   TForm1.SpeedButton2Click_2   TPanel_Cmp_Sec_ads.ResizeShadowLabel 

*)
Interface

Uses
  SysUtils, ExtCtrls, Classes, NMHttp, Buttons, Forms, StdCtrls, Ads_Strg,
  WinProcs, WinTypes, Wininet, Dialogs, Ads_Date, Ads_File, FileCtrl;

{!~ Copies an internet URL to a file.  Returns True
if successful, False otherwise.  The source URL can
be a remote http address or it can be a local file.}
Function InternetCopyURLToFile(
  SourceURL    : String;
  DestFile     : String;
  ShowMessages : Boolean;
  StatusPanel  : TPanel
  ): Boolean;

{!~ Returns the Base URL of a URL address.  The source
URL can be a remote http address or it can be a local
file.}
Function InternetGetBaseURL(URL : String): String;

{!~ Tests for the existence of a URL.  True is returned
if the URL exists and False otherwise.  The source URL
can be a remote http address or it can be a local file.}
Function InternetIsUrl(URL : String): Boolean;

{!~
INTERNET_GETURLSFROMCACHEPAGES

The purpose of this procedure is to extract URL information from
web pages stored in the Temporary Internet Files Directory.

The URL's gathered by this procedure are stored in a new HTML page given
by the OutputFile argument.

This procedure needs a working directory designated
by the WorkingDirectoryName argument.  This working directory should
be for the exclusive use of this procedure because all files in the
directory are deleted at the beginning of the process.

The location of the Temporary Internet Files Directory is provided by
the TemporaryInternetDirectory argument.

A number of boolean options are provided in this procedure:
  SortByLabels           : Sort the Results by the Unit Description UnitIndex Master Index
procedure TPanel_Cmp_Sec_ads.ResizeShadowLabel(
  Sender     : TObject);
Var
  PH, PW : Integer;
  LH, LW : Integer;
begin
  PH := TPanel(Sender).Height;
  PW := TPanel(Sender).Width;
  LH := TLabel(Controls[0]).Height;
  LW := TLabel(Controls[0]).Width;
  TLabel(Controls[0]).Top  := ((PH-LH) div 2)-3;
  TLabel(Controls[0]).Left := ((Pw-Lw) div 2)-3;
end;

Type
  TEditKeyFilter = Class(TEdit)
  Published
    {!~ Throws away all keys except 0-9,-,+,.}
    Procedure OnlyNumbers(Sender: TObject; var Key: Char);

    {!~ Throws away all keys except 0-9}
    Procedure OnlyNumbersAbsolute(Sender: TObject; var Key: Char);

    {!~ Throws away all keys except a-z and A-Z}
    Procedure OnlyAToZ(Sender: TObject; var Key: Char);

  End;

{!~ Throws away all keys except 0-9,-,+,.}
//
Unit Description UnitIndex Master Index
Procedure TEditKeyFilter.OnlyNumbers(Sender: TObject; var Key: Char);
Begin
  KeyPressOnlyNumbers(Key);
End;

{!~ Throws away all keys except 0-9}
//
Unit Description UnitIndex Master Index
Procedure TEditKeyFilter.OnlyNumbersAbsolute(Sender: TObject; var Key: Char);
Begin
  KeyPressOnlyNumbersAbsolute(Key);
End;

{!~ Throws away all keys except a-z and A-Z}
//
Unit Description UnitIndex Master Index
Procedure TEditKeyFilter.OnlyAToZ(Sender: TObject; var Key: Char);
Begin
  KeyPressOnlyAToZ(Key);
End;

//
Unit Description UnitIndex Master Index
Function NMHttp_URLToFileDetail(
  NMHttp       : TNMHttp;
  SourceURL    : String;
  Parameters   : String;
  DestFile     : String;
  Button_Stop  : TSpeedButton
  ): Boolean;
Var
  BodyFile_SL             : TStringList;
  BodyFile                : String;
begin
  Try
    Button_Stop.Enabled   := True;
    BodyFile              := DestFile;
    NMHttp.InputFileMode  := False;
    NMHttp.OutputFileMode := False;
    NMHttp.Header         := 'Header.Txt';
    NMHttp.Body           := BodyFile;
    NMHttp.ReportLevel    := 2;
    With NMHttp.HeaderInfo do
    Begin
      Cookie           := '';
      LocalMailAddress := '';
      LocalProgram     := '';
      Referer          := '';
      UserID           := '';
      Password         := '';
    End;

    If (Parameters = '') Then
    Begin
      NMHttp.Get(SourceURL);
    End
    Else
    Begin
      NMHttp.Post(SourceURL,Parameters);
    End;

    BodyFile_SL := TStringList.Create();
    Try
      BodyFile_SL.Clear;
      BodyFile_SL.Add(NMHttp.Body);
      BodyFile_SL.SaveToFile(BodyFile);
    Finally
      BodyFile_SL.Free;
    End;
    Result := True;
  Except
    Result := False;
  End;
  Button_Stop.Enabled := False;
end;

{!~ Copies an internet URL to a file.  Returns True
if successful, False otherwise.  The source URL can
be a remote http address or it can be a local file.}
//
Unit Description UnitIndex Master Index
Function InternetCopyURLToFile(
  SourceURL    : String;
  DestFile     : String;
  ShowMessages : Boolean;
  StatusPanel  : TPanel
  ): Boolean;
const MAX_PATH         = 600;
var
  hStdOut         : THandle;
  OutDir          : String;
  OutFile         : String;
{  Msg             : String;}{zzz}
  // Start Embedded Functions in CopyURL
  Function InternetLoadRate(
    StartTime : TDateTime;
    iBytes    : integer
    ): integer;
  Var
    iStartSecond : integer;
    iSeconds     : integer;
    Hour         : word;
    Min          : word;
    Sec          : word;
    MSec         : word;
  Begin
    DecodeTime( StartTime, Hour, Min, Sec, MSec );
    iStartSecond := Sec + Min * 60 + Hour * 360;

    DecodeTime( Now, Hour, Min, Sec, MSec );
    iSeconds := ( Sec + Min * 60 + Hour * 360 ) - iStartSecond;

    If ( Trunc( Now - StartTime ) > 0 ) Then
    Begin
      iSeconds := iSeconds + Trunc( Now - StartTime ) * 24 * 60 * 60;
    End;

    If ( iSeconds > 0 ) Then
    Begin
      Result := iBytes div iSeconds;
    End
    Else
    Begin
      Result := 0;
    End;
  end;

  Function InternetGetFile(
    Source_Handle   : HINTERNET;
    DestFile_Handle : THandle;
    ShowMessages    : Boolean;
    StatusPanel     : TPanel
    ): Boolean;
  const FILE_SMALL_BUFFER =  4096;
  const RETRY_READ        =    10;
  Var
    iRetry          : integer;
    bOk             : bool;
    StartTime       : TDateTime;
    EndTime         : TDateTime;
    iWriteFileTotal : integer;
    iWriteFileCount : integer;
    iReadFileCount  : integer;
    SmallBuffer     : array [ 1..FILE_SMALL_BUFFER ] of char;
    Msg             : String;
  Begin
    Result := False;
    Try
      iWriteFileTotal := 0;
      StartTime := Now;
      Repeat
      Begin
        If (StatusPanel <> nil) Then
        Begin
          StatusPanel.Caption :=
            IntToStr(iWriteFileTotal)+
            ' bytes transferred ... (' +
            IntToStr(InternetLoadRate( StartTime, iWriteFileTotal ))+
            ' bytes/sec)';
          StatusPanel.Refresh;
        End;
        iRetry := 0;
        Repeat
        Begin
          iReadFileCount := 0;
          bOk :=
            InternetReadFile(
              Source_Handle,
              @SmallBuffer,
              FILE_SMALL_BUFFER,
              Cardinal(iReadFileCount));
          Inc( iRetry );
        End;
        Until ((iReadFileCount <> 0) or (bOk) or (iRetry = RETRY_READ));

        If (iReadFileCount > 0) Then
        Begin
          iWriteFileCount := 0;
          bOk :=
            WriteFile(
              DestFile_Handle,
              SmallBuffer,
              iReadFileCount,
              Cardinal(iWriteFileCount),
              nil);
          bOk := (bOk) and (iReadFileCount = iWriteFileCount);
          If (bOk) Then
          Begin
            iWriteFileTotal := iWriteFileTotal + iWriteFileCount;
          End
          Else
          Begin
            iReadFileCount := 0;
            Msg := 'Error writing to the output file.';
            If (StatusPanel <> nil) Then
            Begin
              StatusPanel.Caption := Msg;
              StatusPanel.Refresh;
            End;
            If ShowMessages Then
            Begin
              ShowMessage(Msg);
            End;
            Exit;
          End;
        End
        Else
        Begin
          If (not bOk) Then
          Begin
            Msg := 'Error reading the data.';
            If (StatusPanel <> nil) Then
            Begin
              StatusPanel.Caption := Msg;
              StatusPanel.Refresh;
            End;
            If ShowMessages Then ShowMessage(Msg);
            Exit;
          End;
        End;
      End;
      Until (iReadFileCount = 0);
      EndTime := now();
      If (StatusPanel <> nil) Then
      Begin
        StatusPanel.Caption :=
          '('+
          FormatFloat(
            '###,###,##0',
            TimeDeltaInSeconds(
               StartTime,
               EndTime))+
          ' seconds)';
        StatusPanel.Refresh;
      End;

      Result := True;
    Except
      Result := False;
    End;
  end;

  Function InternetFetchFile(
    hSession     : HINTERNET;
    SourceURL    : string;
    DestFile     : string;
    hStdOut      : THandle;
    ShowMessages : Boolean;
    RevealDest   : Boolean;
    StatusPanel  : TPanel
    ): Boolean;
  Var
    Source_Handle   : HINTERNET;
    DestFile_Handle : THandle;
    Msg             : String;
  Begin
    Result := False;
    Try
      Msg := 'Opening "'+SourceURL+'"';
      If (StatusPanel <> nil) Then
      Begin
        StatusPanel.Caption := Msg;
        StatusPanel.Refresh;
      End;
      Source_Handle :=
        InternetOpenUrl(
          hSession,
          PChar(SourceURL),
          nil,
          Cardinal(-1),
          INTERNET_FLAG_DONT_CACHE or
          INTERNET_FLAG_RAW_DATA,
          0);

      If (Source_Handle <> nil) Then
      Begin
        If (DestFile = '') Then
        Begin
          DestFile_Handle := hStdOut;
          If RevealDest Then
          Begin
            Msg := 'Output directed to default';
          End
          Else
          Begin
            Msg := 'Output initiated';
          End;
          If (StatusPanel <> nil) Then
          Begin
            StatusPanel.Caption := Msg;
            StatusPanel.Refresh;
          End;
        End
        Else
        Begin
          If RevealDest Then
          Begin
            Msg := 'Creating "'+DestFile+'"';
          End
          Else
          Begin
            Msg := 'Output initiated';
          End;
          If (StatusPanel <> nil) Then
          Begin
            StatusPanel.Caption := Msg;
            StatusPanel.Refresh;
          End;
          DestFile_Handle :=
            CreateFile(
              PChar(DestFile),
              GENERIC_WRITE,
              FILE_SHARE_READ,
              nil,
              CREATE_NEW,
              FILE_FLAG_WRITE_THROUGH or
              FILE_FLAG_SEQUENTIAL_SCAN,
              0 );
        End;

        If (DestFile_Handle <> INVALID_HANDLE_VALUE ) Then
        Begin
          Msg := 'Starting Download';
          If (StatusPanel <> nil) Then
          Begin
            StatusPanel.Caption := Msg;
            StatusPanel.Refresh;
          End;
          InternetGetFile(
            Source_Handle,
            DestFile_Handle,
            ShowMessages,
            StatusPanel);
          If (DestFile_Handle <> hStdOut ) Then
          Begin
            CloseHandle(DestFile_Handle);
          End;
        End
        Else
        Begin
          Msg := 'Output Failed!!! Closing "'+SourceURL+'"';
          If (StatusPanel <> nil) Then
          Begin
            StatusPanel.Caption := Msg;
            StatusPanel.Refresh;
          End;
          If ShowMessages Then
          Begin
            ShowMessage(Msg);
          End;
          InternetCloseHandle(Source_Handle);
          Exit;
        End;
      End
      Else
      Begin
        Msg := 'URL could not be opened';
        If (StatusPanel <> nil) Then
        Begin
          StatusPanel.Caption := Msg;
          StatusPanel.Refresh;
        End;
        If ShowMessages Then
        Begin
          ShowMessage(Msg);
        End;
        Exit;
      End;
      Result := True;
    Except
      Result := False;
    End;
  End;

  Function InternetCreateSession(
    SourceUrl    : string;
    DestFile     : string;
    sCaller      : string;
    hStdOut      : THandle;
    ShowMessages : Boolean;
    StatusPanel  : TPanel
    ): Boolean;
  Var
    hSession : HINTERNET;
    Msg      : String;
  Begin
    Result := False;
    Try
      Msg := 'Opening Internet Session "'+ sCaller+'"';
      If (StatusPanel <> nil) Then
      Begin
        StatusPanel.Caption := Msg;
        StatusPanel.Refresh;
      End;
      hSession :=
        InternetOpen(
          PChar(sCaller),
          LOCAL_INTERNET_ACCESS,
          nil,
          PChar(INTERNET_INVALID_PORT_NUMBER),
          INTERNET_FLAG_DONT_CACHE );
      If (hSession <> nil) Then
      Begin
        Msg := 'Done "'+ sCaller+'" ';
        If InternetFetchFile(
          hSession,
          SourceURL,
          DestFile,
          hStdOut,
          ShowMessages,
          False,
          StatusPanel) Then
        Begin
          If (StatusPanel <> nil) Then
          Begin
            StatusPanel.Caption := Msg + StatusPanel.Caption;
            StatusPanel.Refresh;
          End;
          InternetCloseHandle( hSession );
        End
        Else
        Begin
          If (StatusPanel <> nil) Then
          Begin
            StatusPanel.Caption := Msg + StatusPanel.Caption;
            StatusPanel.Refresh;
          End;
          InternetCloseHandle( hSession );
          Exit;
        End;
      End
      Else
      Begin
        Msg := 'Internet session not opened. Process Aborted!';
        If (StatusPanel <> nil) Then
        Begin
          StatusPanel.Caption := Msg;
          StatusPanel.Refresh;
        End;
        If ShowMessages Then
        Begin
          ShowMessage(Msg);
        End;
        Exit;
      End;
      Result := True;
    Except
      Result := False;
    End;
  End;
  // End Embedded Functions in CopyURL
Begin
  Result := False;
  Try
    {Check the input parameters}
    If SourceUrl = '' Then
    Begin
      If ShowMessages Then
      Begin
        ShowMessage('No Source URL was provided. Process Aborted!');
      End;
      Exit;
    End;
    If DestFile = '' Then
    Begin
      If ShowMessages Then
      Begin
        ShowMessage('No Destination File was provided. Process Aborted!');
      End;
      Exit;
    End;

    If (Length(SourceUrl) > INTERNET_MAX_URL_LENGTH ) Then
    Begin
      If ShowMessages Then
      Begin
        ShowMessage(
          'URL is longer than '+
          IntToStr(INTERNET_MAX_URL_LENGTH)+
          '. Process Aborted!');
      End;
      Exit;
    End;
    If FileExists(OutFile) Then SysUtils.DeleteFile(OutFile);
    OutDir := FilePath(DestFile);
    OutFile:= ExtractFileName(DestFile);
    If Not DirectoryExists(OutDir) Then
    Begin
      If ShowMessages Then
      Begin
        ShowMessage('Output Path = '+OutDir);
        ShowMessage('The Output directory does not exist. Process Aborted!');
      End;
      Exit;
    End;

    If Length(DestFile) > 255 Then
    Begin
      If ShowMessages Then
      Begin
        ShowMessage('The Output File and Path are too long. Process Aborted!');
      End;
      Exit;
    End;

    hStdOut := GetStdHandle( STD_OUTPUT_HANDLE );
    Result := InternetCreateSession(
                SourceURL,
                DestFile,
                SourceURL,
                hStdOut,
                ShowMessages,
                StatusPanel);
    If Not Result Then
    Begin
      If (StatusPanel <> nil) Then
      Begin
        StatusPanel.Caption := '';
        StatusPanel.Refresh;
      End;
    End;
  Except
    Result := False;
  End;
End;

{!~ Returns the Base URL of a URL address.  The source
URL can be a remote http address or it can be a local
file.}
//
Unit Description UnitIndex Master Index
Function InternetGetBaseURL(URL : String): String;
Var
  URLString      : ShortString;
  {StringToPeriod : ShortString;}{zzz}
  i{,L}{zzz}            : Integer;
  PeriodPos      : Integer;
  C              : Char;
  ShouldBreak    : Boolean;
  ParseMin       : Integer;
Begin
  Result := '';
  If Not InternetIsUrl(URL) Then Exit;
  If FileExists(URL) Then
  Begin
    Result := FilePath(URL);
    Exit;
  End;
  If Length(URL) > 255 Then
  Begin
    Result := URL;
    Exit;
  End;
  If SubStr(URL,Length(URL),1) = '/' Then
  Begin
    Result := URL;
    Exit
  End;
  URLString := ShortString(URL);
  PeriodPos := Pos('.',SubStr(URLString,Length(URLString)-6,7));
  {L := Length(URLString);}{zzz}
  ParseMin := 8;
  If UpperCase(SubStr(URL,1,7)) = 'HTTP://' Then ParseMin := 8;
  If UpperCase(SubStr(URL,1,6)) = 'FTP://'  Then ParseMin := 7;

  If PeriodPos > 0 Then
  Begin
    For i := (Length(URLString)-6 + PeriodPos - 2) DownTo ParseMin Do
    Begin
      ShouldBreak := False;
      C := URLString[i];
      Case C of
      '.' : ShouldBreak := True;
      '/' : ShouldBreak := True;
      '~' : ShouldBreak := True;
      '-' : ShouldBreak := True;
      End;
      If ShouldBreak Then
      Begin
        Result := SubStr(URLString,1,i);
        Exit;
      End;
    End;
  End;
  Result := URL+'/';
End;

{!~ Tests for the existence of a URL.  True is returned
if the URL exists and False otherwise.  The source URL
can be a remote http address or it can be a local file.}
//
Unit Description UnitIndex Master Index
Function InternetIsUrl(URL : String): Boolean;
Var
  hSession      : HINTERNET;
  Source_Handle : HINTERNET;
  Avail         : Integer;
Begin
  Try
    If FileExists(URL) Then
    Begin
      Result := True;
      Exit;
    End;
  Except
  End;
  hSession      := nil;
  Source_Handle := nil;
  Try
    Try
      hSession :=
        InternetOpen(
          PChar('nil'),
          LOCAL_INTERNET_ACCESS,
          nil,
          PChar(INTERNET_INVALID_PORT_NUMBER),
          INTERNET_FLAG_DONT_CACHE );
      If (hSession <> nil) Then
      Begin
        Source_Handle :=
          InternetOpenUrl(
            hSession,
            PChar(URL),
            nil,
            Cardinal(-1),
            INTERNET_FLAG_DONT_CACHE or
            INTERNET_FLAG_RAW_DATA,
            0);
        If (Source_Handle <> nil) Then
        Begin
          Try
            Avail := -1;
            InternetQueryDataAvailable(
              Source_Handle,
              Cardinal(Avail),
              0,
              0);
            If Avail > 42 Then
            Begin
              Result := True;
            End
            Else
            Begin
              Result := False;
            End;
          Except
            Result := False;
          End;
        End
        Else
        Begin
          Result := False;
        End;
      End
      Else
      Begin
        Result := False;
      End;
    Except
      Result := False;
    End;
  Finally
    InternetCloseHandle( hSession );
    InternetCloseHandle(Source_Handle);
  End;
End;

{!~
INTERNET_GETURLSFROMCACHEPAGES

The purpose of this procedure is to extract URL information from
web pages stored in the Temporary Internet Files Directory.

The URL's gathered by this procedure are stored in a new HTML page given
by the OutputFile argument.

This procedure needs a working directory designated
by the WorkingDirectoryName argument.  This working directory should
be for the exclusive use of this procedure because all files in the
directory are deleted at the beginning of the process.

The location of the Temporary Internet Files Directory is provided by
the TemporaryInternetDirectory argument.

A number of boolean options are provided in this procedure:
  SortByLabels           : Sort the Results by the Unit Description UnitIndex Master Index
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  Internet_GetURLsFromCachePages(
    Edit1.Text,                       //TemporaryInternetDirectory : String;
    GlobalExecutablePath+Edit2.Text,  //WorkingDirectoryName       : String;
    Edit3.Text,                       //OutputFile                 : String;
    CheckBox1.Checked,                //SortByLabels               : Boolean;
    CheckBox2.Checked,                //EliminateDuplicates        : Boolean;
    CheckBox3.Checked,                //DiscardRelativePaths       : Boolean;
    CheckBox4.Checked,                //EmptyCacheWhenDone         : Boolean;
    Memo1.Lines);                     //EliminateURLsContaining    : TStrings);
end;
}
//
Unit Description UnitIndex Master Index
procedure Internet_GetURLsFromCachePages(
  TemporaryInternetDirectory : String;
  WorkingDirectoryName       : String;
  OutputFile                 : String;
  SortByLabels               : Boolean;
  EliminateDuplicates        : Boolean;
  DiscardRelativePaths       : Boolean;
  EmptyCacheWhenDone         : Boolean;
  EliminateURLsContaining    : TStrings);
Var
  T          : TStringList;
  U          : TStringList;
  D          : TStringList;
  i,j,c,p    : Integer;
  ToFile     : String;
  FromFile   : String;
  BeginTag   : String;
  EndTag     : String;
  Containing : String;
  S          : String;
begin
  T := TStringList.Create();
  U := TStringList.Create();
  D := TStringList.Create();
  Try
    If TemporaryInternetDirectory = '' Then
    Begin
      ShowMessage('The Web Cache Directory needs to be provided!');
      Exit;
    End;
    If Not DirectoryExists(TemporaryInternetDirectory) Then
    Begin
      ShowMessage('The Web Cache Directory is invalid!');
      Exit;
    End;
    If OutputFile = '' Then
    Begin
      ShowMessage('The Output File need to be provided!');
      Exit;
    End;

    If Not DirectoryExists(ExtractFileDir(OutputFile)) Then
    Begin
      ShowMessage('The Output File Directory is invalid!');
      Exit;
    End;

    If Copy(TemporaryInternetDirectory,Length(TemporaryInternetDirectory),1) <> '\' Then
    Begin
      TemporaryInternetDirectory := TemporaryInternetDirectory + '\';
    End;

    //Get SubDirectories Under The Temporary Internet Directory
    FilesInDirDetail(
      D,                    //FileList    : TStrings;
      TemporaryInternetDirectory,           //Directory   : String;
      '*.*',                //Mask        : String;
      True,                 //Intersection: Boolean;
      False,                //IsReadOnly  : Boolean;
      True,                 //IsHidden    : Boolean;
      False,                //IsSystem    : Boolean;
      False,                //IsVolumeID  : Boolean;
      True,                 //IsDirectory : Boolean;
      False,                //IsArchive   : Boolean;
      False,                //IsNormal    : Boolean;
      False);               //InclDotFiles: Boolean): Boolean;

    T.Clear;

    If Copy(WorkingDirectoryName,Length(WorkingDirectoryName),1) <> '\' Then
    Begin
      WorkingDirectoryName := WorkingDirectoryName + '\';
    End;

    If Not DirectoryExists(WorkingDirectoryName) Then
       ForceDirectories(WorkingDirectoryName);
    //Empty the Working Directory
    T.Clear;
    FilesInDirDetail(
      T,                    //FileList    : TStrings;
      WorkingDirectoryName, //Directory   : String;
      '*.*',                //Mask        : String;
      False,                //Intersection: Boolean;
      False,                //IsReadOnly  : Boolean;
      False,                //IsHidden    : Boolean;
      False,                //IsSystem    : Boolean;
      False,                //IsVolumeID  : Boolean;
      False,                //IsDirectory : Boolean;
      False,                //IsArchive   : Boolean;
      True,                 //IsNormal    : Boolean;
      False);                //InclDotFiles: Boolean): Boolean;
    For i := 0 To T.Count - 1 Do
    Begin
      SysUtils.DeleteFile(WorkingDirectoryName+T[i]);
    End;

    //Get Files From SubDirectories Under The Temporary Internet Directory
    For c:= 0 To D.Count - 1 Do
    Begin
      T.Clear;
      {!~ Populates a TStrings FileList with the files meeting selected
      file attribute criteria in a directory.  The mask argument is a
      standard DOS file argument like '*.*.  The InclDotFiles argument
      allows the user to exclude the system files "." and ".." by
      setting the value to False.  If the Intersection argument is set
      to true then the result will reflect only those files that satisfy
      all attribute criteria.  If Intersection is set to false then the
      result will be a union of files that meet any of the criteria.}
      S := TemporaryInternetDirectory+D[c]+'\';
      FilesInDirDetail(
        T,                    //FileList    : TStrings;
        S,                    //Directory   : String;
        '*.htm*',             //Mask        : String;
        False,                //Intersection: Boolean;
        False,                //IsReadOnly  : Boolean;
        False,                //IsHidden    : Boolean;
        False,                //IsSystem    : Boolean;
        False,                //IsVolumeID  : Boolean;
        False,                //IsDirectory : Boolean;
        False,                //IsArchive   : Boolean;
        True,                 //IsNormal    : Boolean;
        False);               //InclDotFiles: Boolean): Boolean;
      For i := 0 To T.Count - 1 Do
      Begin
        FromFile := TemporaryInternetDirectory+D[c]+'\'+T[i];
        ToFile   :=
          WorkingDirectoryName+
          FileNextNumberName(WorkingDirectoryName,'*.*')+
          '.htm';
        CopyFile(FromFile, ToFile);
      End;
    End;

    T.Clear;
    {!~ Populates a TStrings FileList with the files meeting selected
    file attribute criteria in a directory.  The mask argument is a
    standard DOS file argument like '*.*.  The InclDotFiles argument
    allows the user to exclude the system files "." and ".." by
    setting the value to False.  If the Intersection argument is set
    to true then the result will reflect only those files that satisfy
    all attribute criteria.  If Intersection is set to false then the
    result will be a union of files that meet any of the criteria.}
    FilesInDirDetail(
      T,                    //FileList    : TStrings;
      WorkingDirectoryName, //Directory   : String;
      '*.*',                //Mask        : String;
      False,                //Intersection: Boolean;
      False,                //IsReadOnly  : Boolean;
      False,                //IsHidden    : Boolean;
      False,                //IsSystem    : Boolean;
      False,                //IsVolumeID  : Boolean;
      False,                //IsDirectory : Boolean;
      False,                //IsArchive   : Boolean;
      True,                 //IsNormal    : Boolean;
      False);                //InclDotFiles: Boolean): Boolean;
    For i := 0 To T.Count - 1 Do
    Begin
      U.Clear;
      U.LoadFromFile(WorkingDirectoryName+T[i]);
      S := U.Text;
      S := String_LineFeed_Format(S);
      S :=
        String_Replace(
          #13+#10,           //OldSubString : String;
          '',                //NewSubString : String;
          S);                //SourceString : String): String;
      U.SetText(PChar(S));
      T.Append(U.Text);
    End;

    //Capture Raw URL Information
    U.Clear;
    BeginTag   := '';
    Containing := '';
    {!~ All matches are added to the Stringlist.}
    String_GrepAllToStringList(
      T.Text,               //Source                  : String;   //The input string
      BeginTag,             //StartTag                : String;   //The start tag
      EndTag,               //EndTag                  : String;   //The end tag
      Containing,           //Containing              : String;   //A match must contain this string
      U,                    //Var StringList          : TStringList;   //A List of Matches
      False,                //CaseSensitiveTags       : Boolean;  //True if tags are casesensitive
      True);                //CaseSensitiveContaining : Boolean   //True if Containing string is casesensitive
                            //): Boolean;                         //True if a match was found

    U.Sorted := True;
    U.Sorted := False;

    //Eliminate Partial Paths If Required
    T.Clear;
    If DiscardRelativePaths Then
    Begin
      For I := 0 To U.Count - 1 Do
      Begin
        If Pos('HTTP://',UpperCase(U[i])) > 0 Then T.Add('
  • '+BeginTag+U[i]+EndTag+'
  • '); End; End; U.Clear; U.Assign(T); //Eliminate Duplicates If Required T.Clear; If EliminateDuplicates Then Begin T.Duplicates := dupIgnore; For I := 0 To U.Count - 1 Do Begin T.Add(U[i]); End; T.Duplicates := dupAccept; End; U.Clear; U.Assign(T); //Eliminate everything but URL's T.Clear; For i := 0 To U.Count - 1 Do Begin Trim(U[i]); If UpperCase(Copy(U[i],1,4)) = '
  • ' Then T.Add(U[i]); End; U.Clear; U.Assign(T); For j := 0 To EliminateURLsContaining.Count - 1 Do Begin T.Clear; For i := 0 To U.Count - 1 Do Begin Trim(U[i]); If Pos(UpperCase(EliminateURLsContaining[j]),UpperCase(U[i])) < 1 Then T.Add(U[i]); End; U.Clear; U.Assign(T); End; If SortByLabels Then Begin T.Clear; T.Sorted := True; If EliminateDuplicates Then Begin T.Duplicates := dupIgnore; End Else Begin T.Duplicates := dupAccept; End; For i := 0 To U.Count - 1 Do Begin S := String_Reverse(U[i]); p := Pos(UpperCase('>il/<>a/<'),S); S := Copy(S,P+10,Length(S)-10); p := Pos('>',S); S := Copy(S,1,p-1); S := Trim(s); S := String_Reverse(S); S := StringPad(S,' ',150,True); S := S + U[i]; Try T.Add(S); Except End; End; U.Clear; U.Assign(T); T.Sorted := False; T.Duplicates := dupAccept; For i := 0 To U.Count - 1 Do Begin U[i] := Copy(U[i],151,Length(U[i])-150); End; End; T.Clear; T.Add(''); T.Add(''); T.Add('
      '); T.Append(U.Text); T.Add('
    '); T.Add(''); T.Add(''); T.SaveToFile(OutputFile); If EmptyCacheWhenDone Then Begin Internet_EmptyCacheDirectories(TemporaryInternetDirectory); End; Finally T.Free; U.Free; D.Free; End; end; { Example: //
  • Unit Description UnitIndex Master Index
    procedure TForm1.SpeedButton2Click(Sender: TObject);
    begin
      Internet_GetURLsFromCachePages(
        Edit1.Text,                       //TemporaryInternetDirectory : String;
        GlobalExecutablePath+Edit2.Text,  //WorkingDirectoryName       : String;
        Edit3.Text,                       //OutputFile                 : String;
        CheckBox1.Checked,                //SortByLabels               : Boolean;
        CheckBox2.Checked,                //EliminateDuplicates        : Boolean;
        CheckBox3.Checked,                //DiscardRelativePaths       : Boolean;
        CheckBox4.Checked,                //EmptyCacheWhenDone         : Boolean;
        Memo1.Lines);                     //EliminateURLsContaining    : TStrings);
    end;
    }
    
    {!~
    NMHTTP_GETURLTOFILE
    
    This utility assumes you have the NetMasters FastNet
    internet components.  The FastNet components can be purchased
    from NetMasters at http://www.netmastersllc.com.
    
    This utility copies a URL to file.
    
    }
    //
    Unit Description UnitIndex Master Index
    Function NMHttp_GetURLToFile(
      NMHttp       : TNMHttp;
      SourceURL    : String;
      DestFile     : String;
      Button_Stop  : TSpeedButton
      ): Boolean;
    begin
      Result :=
        NMHttp_URLToFileDetail(
          NMHttp,
          SourceURL,
          '',
          DestFile,
          Button_Stop
          );
    end;
    
    {!~
    NMHTTP_ISURL
    
    This utility assumes you have the NetMasters FastNet
    internet components.  The FastNet components can be purchased
    from NetMasters at http://www.netmastersllc.com.
    
    This utility tests the existance of a URL.  If the URL exists
    True is returned, otherwise False.
    
    }
    //
    Unit Description UnitIndex Master Index
    Function NMHttp_IsUrl(NMHttp: TNMHttp; URLString: String): Boolean;
    Begin
      Try
        If FileExists(URLString) Then
        Begin
          Result := True;
          Exit;
        End;
      Except
      End;
      Try
        NMHttp.Head(URLString);
        Result := True;
      Except
        Result := False;
      End;
    End;
    
    {!~
    NMHttp_PostURLToFile
    
    This utility assumes you have the NetMasters FastNet
    internet components.  The FastNet components can be purchased
    from NetMasters at http://www.netmastersllc.com.
    
    This utility copies a URL to file using http post.
    
    }
    //
    Unit Description UnitIndex Master Index
    Function NMHttp_PostURLToFile(
      NMHttp       : TNMHttp;
      SourceURL    : String;
      Parameters   : String;
      DestFile     : String;
      Button_Stop  : TSpeedButton
      ): Boolean;
    begin
      Result :=
        NMHttp_URLToFileDetail(
          NMHttp,
          SourceURL,
          Parameters,
          DestFile,
          Button_Stop
          );
    end;
    
    {!~ Purges files from the internet cache}
    //
    Unit Description UnitIndex Master Index
    Procedure PurgeInternetCache(
      MainForm   : TForm;
      WinDir     : String;
      IntTempDir : String);
    Var
      CacheNum   : Integer;
      c,i        : Integer;
      CurCache   : String;
      FileString : String;
      FileList   : TFileListBox;
      StringList : TStringList;
      CacheDir   : String;
    Begin
      FileList   := TFileListBox.Create(nil);
      FileList.Height := 1;
      FileList.Width  := 1;
      FileList.Parent := MainForm;
      StringList := TStringList.Create();
      Try
        CacheNum := 4;
        For c := 1 To CacheNum Do
        Begin
          CurCache := 'Cache'+ IntToStr(c);
          CacheDir := WinDir+'\'+IntTempDir+'\'+CurCache;
          FileList.Directory := CacheDir;
          FileList.Mask := '*.*';
          StringList.Clear;
          StringList.Assign(FileList.Items);
          For i := 0 To StringList.Count - 1 Do
          Begin
            FileString := CacheDir+'\'+StringList[i];
            SetFileAttributes(
              PChar(FileString),
              FILE_ATTRIBUTE_NORMAL);
            DeleteFile(PChar(FileString));
          End;
        End;
      Finally
        FileList.Free;
        StringList.Free;
      End;
    End;
    
    End.
    //