program WebPageToText;
{-Sg}
uses
sysutils;
function system(s:pchar):integer ; cdecl external 'msvcrt.dll' name 'system';
type AOS=array of string;
var
g:ansistring;
defaultstring:ansistring = 'https://forum.lazarus.freepascal.org/index.php/topic,56287.0.html'; // set as default
kill:integer=1;
i:int32;
a:AOS;
procedure savefile(fname:string ;text:ansistring;killflag:integer);
label
kill;
Var
T:TextFile;
begin
if killflag<>0 then goto kill;
AssignFile(T,fname);
{$I-}
try
Rewrite(T);
Writeln(T,text);
finally
CloseFile(T);
{$I+}
end;
kill:
if killflag<>0 then erase(T);
end;
procedure runscript(filename:ansiString);
begin
system(pchar('cscript.exe /Nologo '+ filename) );
End;
procedure loadfiletoarray(filename:ansistring;var a:aos);
var
ret:ansistring;
f:textfile;
counter:integer;
begin
if (fileexists(filename)=false) then
begin
writeln(filename,' not found');
exit;
end;
counter:=0;
AssignFile(f,filename);
reset(f);
while not eof(f) do
begin
counter:=counter+1;
readln(f, ret);
end;
setlength(a,counter);
reset(f);
counter:=0;
while not eof(f) do
begin
counter:=counter+1;
readln(f, a[counter]);
end;
CloseFile(f);
end; {loadfile}
begin
g:=g+ 'Const TriStateTrue = -1 '+chr(10);
g:=g+ 'URL = InputBox("Enter (or paste) the URL to extract the Code "&vbcr&vbcr&_'+chr(10);
g:=g+ '"Exemple ""https://www.freebasic.net""","Extraction of Source text and html ","'+defaultstring+'")'+chr(10);
g:=g+ 'If URL = "" Then WScript.Quit'+chr(10);
g:=g+ 'Titre = "Extraction du Code Source de " & URL'+chr(10);
g:=g+ 'Set ie = CreateObject("InternetExplorer.Application")'+chr(10);
g:=g+ 'Set objFSO = CreateObject("Scripting.FileSystemObject")'+chr(10);
g:=g+ 'ie.Navigate(URL)'+chr(10);
g:=g+ 'ie.Visible=false'+chr(10);
g:=g+ 'DO WHILE ie.busy'+chr(10);
g:=g+ 'LOOP'+chr(10);
g:=g+ 'DataHTML = ie.document.documentElement.innerHTML'+chr(10);
g:=g+ 'DataTxt = ie.document.documentElement.innerText'+chr(10);
g:=g+ 'strFileHTML = "CodeSourceHTML.txt"'+chr(10);
g:=g+ 'strFileTxt = "CodeSourceTxt.txt"'+chr(10);
g:=g+ 'Set objHTMLFile = objFSO.OpenTextFile(strFileHTML,2,True, TriStateTrue)'+chr(10);
g:=g+ 'objHTMLFile.WriteLine(DataHTML)'+chr(10);
g:=g+ 'objHTMLFile.Close'+chr(10);
g:=g+ 'Set objTxtFile = objFSO.OpenTextFile(strFileTxt,2,True, TriStateTrue)'+chr(10);
g:=g+ 'objTxtFile.WriteLine(DataTxt)'+chr(10);
g:=g+ 'objTxtFile.Close'+chr(10);
g:=g+ 'ie.Quit'+chr(10);
g:=g+ 'Set ie=Nothing'+chr(10);
g:=g+ ' Ouvrir(strFileHTML)'+chr(10);
g:=g+ ' Ouvrir(strFileTxt)'+chr(10);
g:=g+ 'wscript.Quit'+chr(10);
g:=g+ 'Function Ouvrir(File)'+chr(10);
g:=g+ ' Set ws=CreateObject("wscript.shell")'+chr(10);
g:=g+ ' ws.run "Notepad.exe "& File,1,False'+chr(10);
g:=g+ 'end Function'+chr(10);
savefile('script.vbs',g,0) ;
runscript('script.vbs');
writeln('Press enter to continue . . .');
readln;
writeln;
loadfiletoarray('codesourcetxt.txt',a);
writeln('array size ',high(a));
//for i:=low(a) to high(a) do writeln(i,' ',a[i]);
writeln('A string (plucked from the array) = ','"',a[59],'"');
writeln;
writeln('Press enter to finish');
readln;
savefile('script.vbs','',kill);
end.