How to save an email attachment to file - delphi

I would to save an email attachment to a file using a TIdImap4 object of Indy Ver.10.
I get the UID of the email, then I use this code:
lMsg := TIdMessage.Create(Self);
lImap.UIDRetrieveStructure(lUid, lMsg);
lMsg.MessageParts.CountParts;
if lMsg.MessageParts.AttachmentCount > 0 then
for lJ := 0 to lMsg.MessageParts.Count - 1 do
if (lMsg.MessageParts[lJ] is TIdAttachment) and
SameText(lMsg.MessageParts[lJ].Name, 'MyAttachment') then
lImap.UidRetrievePartToFile(lUid, lJ, lDimAllegato, lFileName, Trim(lMsg.MessageParts[lJ].ContentTransfer))
This worked until lMsg.MessageParts[lJ].ContentType = 'Text/Plain' and
lMsg.MessageParts[lJ].ContentTransfer = '7bit', now UidRetrievePartToFile() returns False and no file is created. I suppose because
lMsg.MessageParts[lJ].ContentType = 'application/octet-stream' and
lMsg.MessageParts[lJ].ContentTransfer = 'base64'.
I'm not skilled on this topic, what I need to change in code in order to save this type of attachment?
I also tried with: TIdAttachment(lMsg.MessageParts[lJ]).SaveToFile(lFileName)
and similar, but the file created was always empty.

Using UIDRetrieveStructure() with a TIdMessage is going to fill the TIdMessage.MessageParts with a lot of TIdttachment objects, never any TIdText objects, and not all of the objects are going to represent actual attachments. You are using the TIdAttachment indexes as the APartNum parameter of UIDRetrievePartToFile(), which might not be accurate.
And you can't use TIdAttachment.SaveToFile() when using UIDRetreiveStructure(), because no actual data has been downloaded, only the structure of the email, which then allows you to download the data for the specific elements you want.
I suggest you use the other overloaded version of UIDRetrieveStructure() that fills a TIdImapMessageParts instead. Amongst other things, TIdImapMessagePart gives you an exact ImapPartNumber that you can then give to UIDRetrievePartToFile() (as well as the ContentTransferEncoding):
lParts := TIdImapMessageParts.Create(nil);
try
lImap.UIDRetrieveStructure(lUid, lParts);
for lJ := 0 to lParts.Count - 1 do
begin
if (lParts[lJ] is the desired attachment) then
begin
lImap.UidRetrievePartToFile(lUid, lParts[lJ].ImapPartNumber, lDimAllegato, lFileName, lParts[lJ].ContentTransferEncoding);
end;
end;
finally
lParts.Free;
end;

Related

Inserting name into database, getting korean signs as output

Trying to insert simple xml file with one row in IIB with simple message flow into Oracle XE DB. Message flow works fine and inserts data into database, but data written in db is different from starting data. For example, as I'm trying to insert my name "Dino" I'd get Korean/Japanese/Chinese signs in return.
I've tried changing XML formats thinking there might be problem, but I suppose it has to do with encoding.
Input:
Output in DB:
This is how my compute node looks like:
CREATE COMPUTE MODULE SimpleDB_mf_Compute
CREATE FUNCTION Main() RETURNS BOOLEAN
BEGIN
CALL CopyMessageHeaders();
-- CALL CopyEntireMessage();
INSERT INTO Database.dkralj.emp VALUES(InputRoot.XMLNSC.emp.name);
SET OutputRoot.XMLNSC.DBINSERT.STATUS='SUCCESS';
RETURN TRUE;
END;
CREATE PROCEDURE CopyMessageHeaders() BEGIN
DECLARE I INTEGER 1;
DECLARE J INTEGER;
SET J = CARDINALITY(InputRoot.*[]);
WHILE I < J DO
SET OutputRoot.*[I] = InputRoot.*[I];
SET I = I + 1;
END WHILE;
END;
CREATE PROCEDURE CopyEntireMessage() BEGIN
SET OutputRoot = InputRoot;
END;
END MODULE;
Looking at the IBM documentation for the INSERT statement in ESQL it might be worth trying.
INSERT INTO Database.dkralj(NAME) VALUES(InputRoot.XMLNSC.emp.name);
If weird things are still happening then I'd try a string constant to avoid any issues with character coding in the input message.
INSERT INTO Database.dkralj(NAME) VALUES('TheEmpValue');
Before this statement in your code
SET OutputRoot.XMLNSC.DBINSERT.STATUS='SUCCESS';
You should check for success or otherwise by using the inbuilt SQLSTATE, SQLCODE, SQLERRORTEXT to check the result of your call.
IF NOT ((SQLCODE = 0) OR (SQLSTATE = '01000' AND SQLNATIVEERROR = 8153)) THEN
-- Do something about the error.
-- The check of SQLSTATE and SQLNATIVEERROR covers warnings
-- The 8153 is for Microsoft SQL Server other databases may use a different value
END IF;
Also check the codepages aka CodedCharSetId of the source system data, the message in IIB and the default codepage of the database.
Use mqsicvp MYBROKER -n ODBC_DB_NAME to get other details about the connection you need to use -n to get the details.
Use something like DBeaver to add some data. Have a look at the datatype specified for the field.
As per your comment below and my response here is an example of a PASSTHRU statement. Note the use of the ? to avoid SQL Injection.
PASSTHRU('SELECT RTRIM(A.EMPLID) AS EMPLID,
RTRIM(A.ADDRESS_TYPE) AS ADDRESS_TYPE,
RTRIM(A.ADDR_TYPE_DESCR) AS ADDR_TYPE_DESCR,
CAST(RTRIM(A.EFFDT) AS DATE) AS EFFDT,
RTRIM(A.EFF_STATUS) AS EFF_STATUS,
RTRIM(A.ADDRESS1) AS ADDRESS1,
RTRIM(A.ADDRESS2) AS ADDRESS2,
RTRIM(A.ADDRESS3) AS ADDRESS3,
RTRIM(A.ADDRESS4) AS ADDRESS4,
RTRIM(A.CITY) AS CITY,
RTRIM(A.STATE) AS STATE,
RTRIM(A.POSTAL) AS POSTAL
FROM ADDRESS_VW AS A
WHERE UPPER(A.EMPLID) = ?') VALUES(AggrRef.EmployeeID)

Delphi - Soap array item value

I am writing a SOAP webservice client (which is provided by others). I have imported WSDL and called request, servise respondes an XML like below. I can reach (DeliveryNumberList array's item DeliveryNumber) DeliveryNumber's PackingSlipNo and VendorAccount attributes but i need to reach DeliveryNumber's value (008740774). In the class file (which Delphi generated from WSDL) there is no option to reach this value. Someone have any idea?
<ns1:Results>
<ns1:Result>
<ns1:Status>true</ns1:Status>
<ns1:Message>Başarılı</ns1:Message>
<ns1:VendorAccount/>
<ns1:DeliveryNumberList>
<ns1:DeliveryNumber PackingSlipNo="X100327233" VendorAccount="0002230728">008740774</ns1:DeliveryNumber>
</ns1:DeliveryNumberList>
</ns1:Result>
</ns1:Results>
If you are able to extract the value of VendorAccount, it should be possible to extract also the value of DeliveryNumber.
May be you could show some code how you extract the value of VendorAccount.
PS: can not add comment because not enough reputation, therefore posting as answer
Here is some code that extracts the value from a XML:
myXML.LoadFromFile(FileOpen.FileName);
memo1.Lines.Add('LocalName:'+myXML.DocumentElement.LocalName);
nrChildNodes := myXML.DocumentElement.ChildNodes.Count;
memo1.Lines.Add('ChildNodes:'+inttostr(nrChildNodes) );
aNode := myXML.DocumentElement.ChildNodes[0].ChildNodes.FindNode('DeliveryNumberList');
if aNode <> nil then
begin
memo1.Lines.Add('aNode.LocalName:'+aNode.LocalName);
memo1.Lines.Add('DeliveryNumber='+aNode.ChildValues['DeliveryNumber']);
end
else memo1.Lines.Add('aNode = nil');

TDelphiTwain component, corrupts delphi form (dfm file)

I have downloaded opensource delphi twain component (TDelphiTwain).
The interesting thing is, that when placed and saved on the form it creates bad dfm entry for itself.
object DelphiTwain: TDelphiTwain
OnSourceDisable = DelphiTwainSourceDisable
OnSourceSetupFileXfer = DelphiTwainSourceSetupFileXfer
TransferMode = ttmMemory
SourceCount = 0
Info.MajorVersion = 1
Info.MinorVersion = 0
Info.Language = tlDanish
Info.CountryCode = 1
Info.Groups = [tgControl, tgImage, tgAudio, MinorVersion]
Info.VersionInfo = 'Application name'
Info.Manufacturer = 'Application manufacturer'
Info.ProductFamily = 'App product family'
Info.ProductName = 'App product name'
LibraryLoaded = False
SourceManagerLoaded = False
Left = 520
Top = 136
end
The problem is with the line:
Info.Groups = [tgControl, tgImage, tgAudio, MinorVersion]
There are only three possible elements:
tgControl, tgImage and tgAudio
It adds MinorVersion everytime I Save the form.
When the app is run I get the error that there is invalid property for Info.Groups.
When i rmeove the bad part manually and without leaving dfm file the app starts ok.
I looked in the internet and there was one inquire regarding these strange issue, unfortunately it hasn't been resolved.
I think that there is some sort of memory corruption. In the post in teh internet, strange signs were displayed ...
Has anyone worked with that component or could give me some hint how this could be fixed?
The error seems to be in TTwainIdentity.GetGroups where result is not initialized. You can try to change the code by replacing
Include(Result, tgControl);
with
Result := [tgControl];
You have to recompile the package to make this change work inside the IDE.
I don't know the component, but I think the problem lies in the TTwainIdentity.GetGroups method. It starts like this:
begin
Include(Result, tgControl);
This means that it assumes that Result is initialized to an empty set. However, Result may contain garbage, and not necessarily an empty set. Change this method to look like this:
function TTwainIdentity.GetGroups(): TTwainGroups;
{Convert from Structure.SupportedGroups to TTwainGroups}
begin
Result := [tgControl];
if DG_IMAGE AND Structure.SupportedGroups <> 0 then
Include(Result, tgImage);
if DG_AUDIO AND Structure.SupportedGroups <> 0 then
Include(Result, tgAudio);
end;
Some result types will not throw a compiler warning about not being initialized, but that doesn't mean they are empty. Same goes, for instance, for strings.
See also: http://qc.embarcadero.com/wc/qcmain.aspx?d=894
But still, it is odd that this happens. Apparently, Delphi tries to find the name of the given item in the set and accidentally finds the name of another property. It seems to me that quite some checks in writing the dfm are missing if this happens. :)

Delphi: ResolveToDataset issue

I am using a TClientDataset with the following options for the provider:
ResolveToDataSet = True
Options = [poPropogateChanges, poUseQuoteChar]
UpdateMode = upWhereKeyOnly
AfterUpdateRecord = DataSetProvider1AfterUpdateRecord
The provider is connected to a TIBCQuery which manages the generator for the NO_INVOICE key.
On AfterUpdateRecord the following code is done (as found in many places in groups to really propagate the key change when posting to the database)
DeltaDS.FieldByName(ClientDataSet1NO_INVOICE.FieldName).NewValue
:= SourceDS.FieldByName(ClientDataSet1NO_INVOICE.FieldName).NewValue
The following code is then used to add a record:
ClientDataSet1.Params[0].AsInteger := -1;
ClientDataSet1.Open;
ClientDataSet1.Edit;
ClientDataSet1NO_INVOICE.AsInteger := -1;
ClientDataSet1NO_STORE.AsInteger := 1;
ClientDataSet1.Post;
ClientDataSet1.ApplyUpdates(-1);
If I call ClientDataSet1.Refresh after the ApplyUpdate, the underlying TIBCQuery is reopened with the original param of -1 and not with the new key... even if the ClientDataSet1NO_INVOICE.AsInteger shows up the new value assigned after merging records...
The use of Refresh here is only to simplify this example... The problems happens when we insert a record, apply updates and edit the record again.
Do I miss something with the usage of the ResolveToDataset option or should I explicitly reopen the query with the new param?
I never had this problem before when using ResolveToDataset = False on other projects...

External App: Check if an Outlook Folder exists

SOLUTION BELOW
I've been looking all over the net to find a solution for this, but it seems quite hard to get an answer for this in Delphi...
Skip this if you're familiar with Outlook
Some explanation before:
The Contacts Folder in Outlook is organized like a foldertree in Windows. The Contacts are stored in the Contacts Folder itself or within subfolders.
My Code does add Contacts from an external Database into the Outlook contacts Database. To prevent double entries the programm is supposed to check all contacts and see if it can find an 'older' version of the contact entry and update it, or if not, create a new one.
Therefore I wrote a recursion which loops through the folders and checks the contacts.
Within a folder you can get the subfolder by (besides Next, Previous and Last)
Contacts:= Contacts.Folders.Getfirst
//The now selected Folder is the first subfolder within the previous selected one
If I am trying to get any property of this Subfolder like 'Items.Count' or anything else, an error occurs because this folder doesn't exist.
Therefore I want to check if the Folder exists or not, and skip to loop through this subfolder because otherwise the loop would break here and the program stops.
Skip until here if you're familiar with Outlook workings
THE PROBLEM:
In Debugger this Contacts/Folder Variable (an OleVariant, Pointer to the now selected Folder) contains values similar to this: '$0074974C'.
If there is no subfolder this value returns '$00000000'. This seems to be a pointer.
How should I check if a folder exists or not?
const
olFolderContacts = $0000000A;
var
outlook, NameSpace, Contact, ContactsRoot, Contacts: OleVariant;
begin
Outlook := CreateOleObject('Outlook.Application');
NameSpace := Outlook.GetNameSpace('MAPI');
ContactsRoot := NameSpace.GetDefaultFolder(olFolderContacts);
Contacts:= ContactsRoot;
//We're now in the Contacts Folder
Contacts:= Contacts.folders.getfirst;
//First Subfolder
What didn't work:
Check if
Contacts = '$00000000' (As string)
Contacts = '$00000000' (As OleVariant)
var
val:TVarRec;
code:
val:=Contacts;
string(Contacts.VWideChar) = '$00000000'
var
vntNothing: OLEVariant;
code:
TVarData(vntNothing).VType := varDispatch;
TVarData(vntNothing).VDispatch := Nil;
Contacts = vntNothing
Contacts = unassigned
...
...
In VBA this problem has a simple solution
if Contacts = Nothing
But there is no 'Nothing' in Delphi...
Ideas?
You could first check the count on the Folders collection:
if Contacts.Folders.Count = 0 then
or
Contacts := Contacts.Folders.GetFirst;
if VarIsClear(Contacts) then
You could try this:
if IUnknown(Contacts) = nil then
//
var
x: string;
in code:
x:= format('%p%',[Pointer(TVarData(contacts).VDispatch)]);
if x = '00000000' then
'New Contact'
else
'open folder and search within this one'
Co-worker had the solution.. Thanks for your time :)

Resources