I am having a problem parsing a WordPress Feed using the XMLDocument component. When reading the feed, I get a parsing error on line 52. I see the single quote in the word won't is being changed to Wasnx92t. But that shouldn't cause a problem since it is being converted.
The XML feed can be found here: https://minttoreport.com/feed/
procedure TMainForm.RefreshNews(Sender: TObject);
var
s: string;
sl: TStringList;
StartItemNode : IXMLNode;
ANode : IXMLNode;
STitle, sDesc, sLink : WideString;
begin
sl := TStringList.Create;
sl.text := OnlineRegForm.GetUrlContent('https://minttoreport.com/feed/');
sl.SaveToFile(ReportFolder+'news.xml');
XMLDocument1.FileName := ReportFolder+'news.xml';
XMLDocument1.Active := true;
StartItemNode := XMLDocument1.DocumentElement.ChildNodes.First.ChildNodes.FindNode('item') ;
ANode := StartItemNode;
STitle := ANode.ChildNodes['title'].Text;
sLink := ANode.ChildNodes['link'].Text;
sDesc := ANode.ChildNodes['description'].Text;
WebBrowser2.LoadFromStrings('<h4><a href="'+sLink+'" '+ sTitle+'"</a></h4>"','');
Showmessage('<h4><a href="'+sLink+'" '+ sTitle+'"</a></h4>"');
This is a WordPress, latest release, from https://minttoreport.com/feed
I get the error on when I activate the XMLDocument component.
I'm not sure if this is a Delphi 10.3 bug, but I fixed the problem just by setting the
XML property to the contents of the file rather than using the FileName property.
Same results in the IDE. So here is the changed code:
procedure TMainForm.RefreshNews(Sender: TObject);
var
s: string;
sl: TStringList;
StartItemNode : IXMLNode;
ANode : IXMLNode;
STitle, sDesc, sLink : WideString;
begin
sl := TStringList.Create;
sl.text := OnlineRegForm.GetUrlContent('https://minttoreport.com/feed/');
//sl.SaveToFile(ReportFolder+'news.xml');
//XMLDocument1.FileName := ReportFolder+'news.xml';
XMLDocument1.XML.Text := sl.Text;
XMLDocument1.Active := true;
StartItemNode := XMLDocument1.DocumentElement.ChildNodes.First.ChildNodes.FindNode('item') ;
ANode := StartItemNode;
// repeat
STitle := ANode.ChildNodes['title'].Text;
sLink := ANode.ChildNodes['link'].Text;
sDesc := ANode.ChildNodes['description'].Text;
WebBrowser2.LoadFromStrings('<h4><a href="'+sLink+'" '+ sTitle+'"</a></h4>"','');
Showmessage('<h4><a href="'+sLink+'" '+ sTitle+'"</a></h4>"');
Related
I need help, please. I can connect to Gmail and I can receive emails.
What I can't do is to save attachments. I think that it is a setting problem? I have IdAttachment and IdAttachmentFile in my uses clause. I tried all sorts of ContentType settings, but nothing seams to work.
if (IdMessage1.MessageParts.Items[i] is TIdAttachment) then
begin
with (IdMessage1.MessageParts.Items[i] as TIdAttachment) do
begin
SaveToFile('C:\test123.txt');
end;
end;
Here is my code:
procedure TForm1.Button1Click(Sender: TObject);
var
i, j: Integer;
IdSSLIOHandlerSocket: TIdSSLIOHandlerSocketOpenSSL;
bodytext: string;
s: string;
n: string;
mailcount : integer;
TMP: string;
begin
IdSSLIOHandlerSocket := TIdSSLIOHandlerSocketOpenSSL.Create(Self);
idpop31.IOHandler := IdSSLIOHandlerSocket;
idpop31.UseTLS := utUseImplicitTLS;
IdPOP31.Host := 'pop.gmail.com';
IdPOP31.Port := 995;
IdPOP31.UseTLS := utUseImplicitTLS;
IdPOP31.Username := 'name#gmail.com';
IdPOP31.Password := 'xxxxx';
IdPOP31.Connect;
Mailcount:= idpop31.checkmessages;
For i:= 1 to mailcount do
Begin
Idmessage1.clear;
Idpop31.retrieveheader (i,idmessage1);
TMP:= idmessage1.subject;
Mailzeug.lines. Add (TMP);
Idpop31.retrieve (i,idmessage1);
TMP:= idmessage1.body.Text;
Mailzeug.lines. Add (TMP);
if (IdMessage1.MessageParts.Items[i] is TIdAttachment) then
begin
TIdAttachment(IdMessage1.MessageParts.Items[i]).SaveToFile(TIdAttachment(IdMessage1.MessageParts.Items[I]).Filename);
end;
end;
Idpop31.disconnect;
end;
You are using the wrong index value with the IdMessage1.MessageParts.Items[] property, that is why you are getting an "out of range" error. You are using the email's (1-based) index within the mailbox as-if it were a (0-based) attachment index within the email.
You need a 2nd loop to iterate the MessageParts collection of each email that is downloaded, eg:
procedure TForm1.Button1Click(Sender: TObject);
var
i, j: Integer;
IdSSLIOHandlerSocket: TIdSSLIOHandlerSocketOpenSSL;
BodyText: string;
MailCount : integer;
part: TIdMessagePart;
begin
IdSSLIOHandlerSocket := TIdSSLIOHandlerSocketOpenSSL.Create(Self);
IdPOP31.IOHandler := IdSSLIOHandlerSocket;
IdPOP31.Host := 'pop.gmail.com';
IdPOP31.Port := 995;
IdPOP31.UseTLS := utUseImplicitTLS;
IdPOP31.Username := 'name#gmail.com';
IdPOP31.Password := 'xxxxx';
IdPOP31.Connect;
try
MailCount := IdPOP31.CheckMessages;
for i := 1 to MailCount do
begin
IdMessage1.Clear;
IdPOP31.Retrieve(i, IdMessage1);
Mailzeug.Lines.Add(IdMessage1.Subject);
BodyText := IdMessage1.Body.Text;
Mailzeug.Lines.Add(BodyText);
for j := 0 to IdMessage1.MessagePart.Count-1 do
begin
part := IdMessage1.MessageParts.Items[j];
if (part is TIdAttachment) then
begin
TIdAttachment(part).SaveToFile(TIdAttachment(part).Filename);
end;
end;
end;
finally
IdPOP31.Disconnect;
end;
end;
Thanks to the below functions, I am succesfully retrieving, from a Word document stored locally (synced with the Server through OneDrive), its Server properties (those which are stored as SharePoint columns), all this without Ole automation. The functions' structure is:
Since the Word document is a zipped file, unzip the file where such properties are stored.
Extract the contents of the file into a string.
Load the string into an XML document.
Feed the field names and their contents into a StringList.
``
function WordGetServerProperties (FName:string):TStringList;
var
s,ss:string;
i,ii:integer;
St:TStringList;
XML:IXMLDocument;
N,NN: IXMLNode;
begin
s:=ExtractZipToStr(FName,'customXml/item1.xml',ExtractFilePath(FName));
if StrContains('<p:properties',s)=False then
s:=ExtractZipToStr(FName,'customXml/item2.xml',ExtractFilePath(FName));
if StrContains('<p:properties',s)=False then
s:=ExtractZipToStr(FName,'customXml/item3.xml',ExtractFilePath(FName));
XML:=NewXMLDocument;
St:=TStringList.Create;
XML.Active := True;
XML.LoadFromXML(s);
N:=xml.DocumentElement;
try
for i := 0 to N.ChildNodes.Count -1 do
begin
if N.ChildNodes[i].NodeName = 'documentManagement' then
begin
NN:=N.ChildNodes[i];
for ii := 0 to NN.ChildNodes.Count -1 do
begin
ss:=AnsiReplaceStr(NN.ChildNodes[ii].NodeName,'_x0020_',' ');
if ss='SharedWithUsers' then continue;
ss:=ss+'='+NN.ChildNodes[ii].Text;
st.Add(ss)
end;
end;
end;
finally
XML.Active := False;
end;
Result:=st;
end;
function ExtractZipToStr(const ZipFileName: string; const ZippedFileName, ExtractedFileName: string): widestring;
var
ZipFile: TZipFile;
F,s:string;
i:integer;
Exists:Boolean;
LStream: TStream;
FStream:TFileStream;
LocalHeader: TZipHeader;
begin
Exists:=False;
ZipFile := TZipFile.Create;
LStream := TStream.Create;
try
try
ZipFile.Open(ZipFileName,zmRead);
except on EZipException do begin Result:='noprops'; ZipFile.Close; ZipFile.Free; LStream.Free; exit; end; end;
for i := 0 to ZipFile.FileCount - 1 do
begin
F:= ZipFile.FileNames[i];
if F='docProps/custom.xml' then begin Exists:=True; system.Break; end;
end;
if exists=True then
begin
ZipFile.Read(ZippedFileName, LStream, LocalHeader);
LStream.Position:=0;
Result:=StreamToString(LStream);
end
else Result:='noprops';
finally
ZipFile.Close;
ZipFile.Free;
LStream.Free;
end;
end;
function StreamToString(aStream: TStream): widestring;
var
SS: TStringStream;
begin
if aStream <> nil then
begin
SS := TStringStream.Create('');
try
SS.CopyFrom(aStream, 0);
Result := SS.DataString;
finally
SS.Free;
end;
end else
begin
Result := '';
end;
end;
This is relatively fast but as not as much as I would like. Hopefully I have shown that (being amateur at this) I am at the end of my wits. Would you see any way to either improve or utterly replace these routines by something more efficient?
i need some help with my procedure. I want to save some strings in a stringlist which is created in another procedure. How can i do this?
I wrote a comment at the right place to understand it better.
procedure GetIniNamesWithoutExt(IniPfade: TStringList);
var
i, suchPunkt: integer;
ini: TIniFile;
Modul, fullFileName, IniName: String;
begin
try
for i := 0 to IniPfade.Count-1 do
begin
fullFileName := IniPfade.Strings[i];
Modul := ExtractFileName(fullFileName); // Dateiname aktueller Ini + .Ini Endung
suchPunkt := Pos('.', Modul);
IniName := Copy(Modul, 1, suchPunkt-1); // Aktueller Modulname ohne ini Endung
// Here should be the Code for saving the String "IniName" to a StringList which is created in procedure a. Procedure a calls the procedure GetIniNamesWithoutExt.
end;
finally
end;
end;
How about
procedure GetIniNamesWithoutExt(IniPfade, Module: TStrings);
var
i, suchPunkt: integer;
ini: TIniFile;
Modul, fullFileName, IniName: String;
begin
Module.BeginUpdate;
try
for i := 0 to IniPfade.Count-1 do
begin
fullFileName := IniPfade.Strings[i];
Modul := ExtractFileName(fullFileName); // Dateiname aktueller Ini + .Ini Endung
suchPunkt := Pos('.', Modul);
IniName := Copy(Modul, 1, suchPunkt-1); // Aktueller Modulname ohne ini Endung
Module.Add(IniName);
end;
finally
Module.EndUpdate;
end;
end;
and from procedure A:
procedure A;
var
Module: TStringList;
begin
Module := TStringList.Create;
try
GetIniNamesWithoutExt(IniPfade , Module);
// Do Whatever you want with "Module"
finally
Module.Free;
end;
end;
I want to display a treeview with all the registry information in it ( i.e all the subkeys ). I have put together the following Fn to do the same. But i am getting the info of only one Key, not all. What is missing in my code ?
function TForm1.DisplayKeys(TreeNode : TTreeNode;KeyToSearch:String):String;
var
i: Integer;
RootKey : Integer;
NewTreeNode : TTreeNode;
str : TStringList;
// str2: TStringList;
begin
i:=0;
if reg.OpenKey(KeyToSearch,False) then
begin
str:=nil;
str:=TStringList.create;
reg.GetKeyNames(str);
//For all SubKeys
for i:=0 to str.Count-1 do
begin
NewTreeNode:=TreeView1.Items.AddChild(TreeNode, Str.Strings[i]);
if reg.HasSubKeys then
begin
DisplayKeys(NewTreeNode,Str.Strings[i]);
end;
end;
end;
the call to the Function is
procedure TForm1.FormCreate(Sender: TObject);
begin
reg:=nil;
reg:=TRegistry.create;
str2:=nil;
str2:=TStringList.create;
reg.RootKey:=HKEY_CURRENT_CONFIG;
TreeView1.Items.BeginUpdate; //prevents screen repaint every time node is added
DisplayKeys(nil,''); // call to fn here
TreeView1.Items.EndUpdate; // Nodes now have valid indexes
end;
Note that i am not getting any error, just that info is incomplete
Some problems:
You are using OpenKey which attempts to open the key with write access. Instead you should use OpenKeyReadOnly. If you really do mean to write to those keys then you will have to run elevated as an administrator.
You are failing to close the keys once you have finished with them.
More seriously, your use of relative registry keys is not sufficient. I believe you will need to pass around the full path to the key. I wrote a little demo console app to show what I mean:
program RegistryEnumerator;
{$APPTYPE CONSOLE}
uses
Classes, Windows, Registry;
var
Registry: TRegistry;
procedure DisplayKeys(const Key: string; const Depth: Integer);
var
i: Integer;
SubKeys: TStringList;
begin
if Registry.OpenKeyReadOnly(Key) then begin
Try
SubKeys := TStringList.Create;
Try
Registry.GetKeyNames(SubKeys);
for i := 0 to SubKeys.Count-1 do begin
Writeln(StringOfChar(' ', Depth*2) + SubKeys[i]);
DisplayKeys(Key + '\' + SubKeys[i], Depth+1);
end;
Finally
SubKeys.Free;
End;
Finally
Registry.CloseKey;
End;
end;
end;
begin
Registry := TRegistry.Create;
Try
Registry.RootKey := HKEY_CURRENT_CONFIG;
DisplayKeys('', 0);
Readln;
Finally
Registry.Free;
End;
end.
try this :-
procedure TForm1.Button1Click(Sender: TObject);
begin
TreeView1.Items.Clear;
path := Edit1.Text;
// reg.RootKey := HKEY_LOCAL_MACHINE ;
TreeView1.Items.BeginUpdate;
drawtreeview(nil, path);
TreeView1.Items.EndUpdate;
end;
procedure TForm1.drawtreeview( node: TTreeNode; name: string);
var
i: Integer;
NewTreeNode: TTreeNode;
str, str2 : TStringList;
reg : TRegistry;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
i := 0;
if reg.OpenKeyReadOnly(name) then
begin
str := TStringList.create;
reg.GetKeyNames(str);
for i := 0 to str.Count - 1 do
begin
NewTreeNode := TreeView1.Items.AddChild(node, str.Strings[i]);
if reg.HasSubKeys then
begin
drawtreeview(NewTreeNode, name + '\' + str.Strings[i]);
end
else
ShowMessage('no sub keys');
end;
end;
reg.CloseKey;
reg.Free;
end;
How can I get all installed components in TStrings?
I think this code work only within packages:
uses TypInfo, ToolIntf, Exptintf;
procedure GetComponentNames(lst: TStrings);
var
i, k: Integer;
CRef: TClass;
strName: ShortString;
begin
lst.Clear;
for i := 0 to ToolServices.GetModuleCount-1 do
begin
for k := 0 to ToolServices.GetComponentCount(i)-1 do
begin
CRef := TClass(GetClass(ToolServices.GetComponentName(i, k)));
while CRef <> nil do
begin
strName := CRef.ClassName;
if lst.IndexOf(strName) = -1 then
lst.Add(strName);
if str <> 'TComponent' then
CRef := CRef.ClassParent
else
CRef := nil;
end;
end;
end;
end;
Or:
uses ToolsApi;
{....}
var
a, i: Integer;
begin
with (BorlandIDEServices as IOTAPackageServices) do
begin
for a := 0 to GetPackageCount - 1 do
begin
for i := 0 to GetComponentCount(a) - 1 do
begin
{get each component name with GetComponentName(a, i);}
// DoSomething
end;
end;
end;
end;
Thanks for help.
This example doesn't use the OpenAPI, it uses the Registry. It works but it also lists non-visual components amongst other hidden items.
procedure GetComponentNames(lst: TStrings);
var
i, j, iPos: Integer;
Reg: TRegistry;
sComponent: String;
slValues, slData: TStrings;
begin
Reg := TRegistry.Create;
slValues := TStringList.Create;
slData := TStringList.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
Reg.OpenKey('Software\Borland\Delphi\6.0\Palette', False); // Change reg key where appropriate
Reg.GetValueNames(slValues);
for i := 0 to Pred(slValues.Count) do
begin
lst.Append(slValues[i]);
lst.Append('----------');
slData.Delimiter := ';';
slData.DelimitedText := Reg.ReadString(slValues[i]);
for j := 0 to Pred(slData.Count) do
begin
sComponent := slData[j];
iPos := Pos('.', sComponent);
if (iPos > 0) then
Delete(sComponent, 1, iPos);
lst.Append(sComponent);
end;
end;
finally
slData.Free;
slValues.Free;
Reg.Free;
end; {try..finally}
end;
I'm not saying this is ideal but it does give you a list and a headstart.