//
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 Indexprocedure 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 IndexProcedure TEditKeyFilter.OnlyNumbers(Sender: TObject; var Key: Char); Begin KeyPressOnlyNumbers(Key); End; {!~ Throws away all keys except 0-9} //Unit Description UnitIndex Master IndexProcedure 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 IndexProcedure TEditKeyFilter.OnlyAToZ(Sender: TObject; var Key: Char); Begin KeyPressOnlyAToZ(Key); End; //Unit Description UnitIndex Master IndexFunction 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 IndexFunction 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 IndexFunction 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 IndexFunction 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 Indexprocedure 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 Indexprocedure 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('Unit Description UnitIndex Master Index'+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: //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 IndexFunction 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 IndexFunction 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 IndexFunction 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 IndexProcedure 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. //