I have tried the code below for sending fax:
uses
ComObj, ActiveX, FAXCOMEXLib_TLB;
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
JobIDs: OleVariant;
FaxServer: IFaxServer2;
FaxDocument: IFaxDocument2;
begin
try
FaxServer := CoFaxServer.Create;
FaxServer.Connect('');
FaxDocument := CoFaxDocument.Create;
FaxDocument.Body := 'd:\Document.pdf';
FaxDocument.DocumentName := 'Document name';
FaxDocument.Recipients.Add('+1 (425) 555-4567', 'Bill');
FaxDocument.Sender.Name := 'Bob';
FaxDocument.Sender.BillingCode := '23A54';
FaxDocument.Sender.Department := 'Accts Payable';
FaxDocument.Sender.FaxNumber := '+972 (4) 555-9070';
JobIDs := FaxDocument.ConnectedSubmit(FaxServer);
for I := VarArrayLowBound(JobIDs, 1) to VarArrayHighBound(JobIDs, 1) do
ShowMessage('Job ID: ' + VarArrayGet(JobIDs, [I]));
except
on E: EOleSysError do
ShowMessage(
Format('Sending of the fax failed! %s [%d]', [E.Message, E.ErrorCode])
);
end;
end;
What I was trying to do was get the job status for the fax sent. I have tried to add
var
FaxJobStatus: IFaxJobStatus;
.....
FaxJobStatus := CoFaxJobStatus.Create;
compiled the source code and found no error but after executing the code, it fails at
FaxJobStatus := CoFaxJobStatus.Create
saying "class not registered".
From the IFaxJobStatus documentation:
You do not create the FaxJobStatus object. It is received as part of a notification when you implement IFaxServerNotify::OnIncomingJobChanged or IFaxServerNotify::OnOutgoingJobChanged, which include a parameter of the type FaxJobStatus. When the event occurs and the implemented function is called, you receive this object containing the dynamic information.
So you have to register for the IFaxServerNotify.OnIncomingJobChanged or IFaxServerNotify.OnOutgoingJobChanged events. When the event is received, you get the FaxJobStatus object and can read its Status property.
Related
When a file is double-clicked, I want it to open in the running instance of my Firemonkey app. For the moment, I am just trying to get the code working in Win32 but ultimately I want similar behavior in OSX.
I have the following code in my .dpr. I found the part relating to the mutex on https://forums.embarcadero.com/message.jspa?messageID=873440 and it works fine in suppressing the opening of a second instance.
var
OneInstanceMutex: THandle = 0;
MessageManager: TMessageManager;
Message: TMessage;
function InstanceAlreadyExists(const MutexName: string): Boolean;
begin
Result := False;
// .. This mutex will be freed when the application closes!
OneInstanceMutex := CreateMutex (nil, FALSE, PChar(MutexName) );
if OneInstanceMutex <> 0 then
begin
if GetLastError() = ERROR_ALREADY_EXISTS then
begin
// Found another instance
Result := True;
end;
end
else
begin
if GetLastError() = ERROR_ACCESS_DENIED then
begin
// Found another instance
Result := True;
end;
end;
end;
begin
if InstanceAlreadyExists('MyApp.exe') then
begin
MessageManager := TMessageManager.DefaultManager;
Message := TMessage<UnicodeString>.Create(ParamStr(1));
MessageManager.SendMessage(nil, Message, True);
Exit;
end;
Application.Initialize;
In the main form, in the FormCreate event, I have
procedure TMyMainForm.FormCreate(Sender: TObject);
var
SubscriptionId: Integer;
MessageManager: TMessageManager;
begin
....
MessageManager := TMessageManager.DefaultManager;
SubscriptionId := MessageManager.SubscribeToMessage(TMessage<UnicodeString>,
procedure(const Sender: TObject; const M: TMessage)
begin
ShowMessage((M as TMessage<UnicodeString>).Value);
end);
// I'm expecting the above to show the filename to be opened
// but no message appears
....
end;
With one instance already running, when I double-clicking on a file, I'm expecting the line
ShowMessage((M as TMessage<UnicodeString>).Value);
to display the filename to be opened but no message appears.
BTW, I have correctly associated the file extension with my app so that the .dpr is receiving ParamStr(1). It's just that the broadcasting of this string to the already running instance isn't working.
I am trying to get a list of all outlook contacts using delphi.
I found a couple of examples, all seemed to be outdated or flawed.
Currently I have the following code, but when I excecute the command at runtime I get the below error:
Code:
procedure Tinvite_friends.BitBtn2Click(Sender: TObject);
const
olFolderContacts = $0000000A;
var
outlook, NameSpace, Contacts, Contact: OleVariant;
i: Integer;
begin
Try
outlook:=GetActiveOleObject('Outlook.Application');
Except
outlook:=CreateOleObject('Outlook.Application');
End;
NameSpace := outlook.GetNameSpace('MAPI');
Contacts := NameSpace.GetDefaultFolder(olFolderContacts);
for i := 1 to Contacts.Items.Count do
begin
Contact := Contacts.Items.Item(i);
{now you can read any property of contact. For example, full name and
email address}
ShowMessage(Contact.FullName + ' <' + Contact.Email1Address + '>');
end;
Outlook := UnAssigned;
end;
Error Message:
Project appname.exe raised exception class EOLeSysError with message 'Invalid class string'.
The project does not get passed the below code before throwing the error.
Try
outlook:=GetActiveOleObject('Outlook.Application');
Except
outlook:=CreateOleObject('Outlook.Application');
End;
Is there an effective way to get a list of all contacts from outlook imported to a memo for example?
Maybe it's case sensitivity? I test for outlook.application:
const
scxOutlookApp = 'outlook.application';
scxNameSpace = 'MAPI';
function TDataModuleSyncOutlook.ConnectToOutlook(AUserSMTP: String = ''): Boolean;
var
lRecipient,
lVar : OleVariant;
lLog,
lLoginSMTP: String;
begin
Result := false;
FWasCreated := False; // Breakpoint 'Ignore subsequent exceptions'
try
FOutlookApp := GetActiveOleObject(scxOutlookApp); // Application object
Result := True;
except
try
FOutlookApp := CreateOleObject(scxOutlookApp);
FWasCreated := True;
Result := True;
except
on E:Exception do TSyncLogger.LogError(E.Message);
end;
end;
if Result then // Breakpoint 'Handle subsequent exceptions'
begin
FNameSpace := FOutlookApp.GetNamespace(scxNameSpace);
// Solution from http://stackoverflow.com/questions/18053110/retrieve-outlook-logged-in-user-smtp-address-after-connecting-through-ole/
lLog := Format('Connected to Outlook; Application.DefaultProfilename: %s, Application.Name: %s, Application.Version: %s, NameSpace.CurrentProfileName: %s, NameSpace.ExchangeMailboxServerName: %s, NameSpace.Type: %s',
[FOutlookApp.DefaultProfileName,
FOutlookApp.Name,
FOutlookApp.Version,
FNameSpace.CurrentProfileName,
FNameSpace.ExchangeMailboxServerName,
FNameSpace.Type]);
TSyncLogger.LogDetail(lLog);
lVar := FOutlookApp.Session; // NameSpace object for the current session
if not VarIsClear(lVar) then lVar := lVar.CurrentUser; // Recipient object for the currently logged-on user
if not VarIsClear(lVar) then lVar := lVar.AddressEntry; // AddressEntry object for the recipient
if not VarIsClear(lVar) then lVar := lVar.GetExchangeUser; // Returns an ExchangeUser object that represents the AddressEntry
if not VarIsClear(lVar) then lVar := lVar.PrimarySmtpAddress; // String representing the SMTP address for the ExchangeUser
if not VarIsClear(lVar) then
begin
lLoginSMTP := FOutlookApp.Session.CurrentUser.AddressEntry.GetExchangeUser.PrimarySmtpAddress;
TSyncLogger.LogDetail('Primary Exchange SMTP address detected as: ' + lLoginSMTP);
end
else
begin
TSyncLogger.LogError(sErrNoExchangeAccount);
DisConnectFromOutlook;
Exit;
end;
if LowerCase(AUserSMTP) <> Lowercase(lLoginSMTP) then
begin // Open shared calendar if it's a different user
lRecipient := FNameSpace.CreateRecipient(AUserSMTP);
try
FCalendarFolder := FNameSpace.GetSharedDefaultFolder(lRecipient, olFolderCalendar);
lLog := Format('Logging in as different user (%s), created recipient for %s, GetSharedDefaultFolder folder path = %s',[AUserSMTP,lRecipient.Address,FCalendarFolder.FolderPath]);
TSyncLogger.LogAlways(lLog);
except
on E:Exception do
begin
Result := false;
TSyncLogger.LogError(Format(sErrOpenGedeeldeAgenda,[AUserSMTP]));
end;
end;
end
else // ... otherwise open default calendar folder
begin
FCalendarFolder := FNameSpace.GetDefaultFolder(olFolderCalendar);
TSyncLogger.LogDetail('Opened default calendar folder, folder path = ' + FCalendarFolder.FolderPath);
end;
end;
FOleInitialized := Result;
if Result then TSyncLogger.LogDetail('Connected to Outlook') else TSyncLogger.LogAlways('Connection to Outlook failed');
end;
Notes:
1. This opens the default calendar for any user, but you would not need to go that far (besides, your issue is earlier)
2. TSyncLogger is our logging handler
3. FOleInitialized, FWasCreated: Boolean; FOutlookApp, FNameSpace, FCalendarFolder: OleVariant; are some private properties we maintain
4. Essential to this code is that it first does a GetActiveOleObject to catch a running instance of Outlook; if that fails it does a CreateOleObject
I have 2 applications- Manager with this code:
procedure TForm1.CopyData(var Msg: TWMCopyData);
var sMsg: String;
begin
if IsIconic(Application.Handle) then Application.Restore;
sMsg := PWideChar(Msg.CopyDataStruct.lpData);
Caption := Caption+'#'+sMsg;
Msg.Result := 123;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
WM_MY_MESSAGE = WM_USER + 1;
var
h: HWND;
begin
Caption := 'X';
h := FindWindow('TForm1', 'Client');
if not IsWindow(h) then Exit;
Caption := Caption+'#';
SendMessage(h, WM_MY_MESSAGE, 123, 321);
end;
And Client with:
procedure TForm1.WndProc(var Message: TMessage);
const
WM_MY_MESSAGE = WM_USER + 1;
var DataStruct: CopyDataStruct;
S: String;
h: HWND;
begin
inherited;
if Message.Msg <> WM_MY_MESSAGE then Exit;
h := FindWindow('TForm1', 'Manager');
if not IsWindow(h) then Exit;
Message.Result := 123;
S := Edit2.Text + '#' + Edit1.Text;
DataStruct.dwData := 0;
DataStruct.cbData := 2*Length(S)+1;
DataStruct.lpData := PWideChar(S);
Caption := Caption + '#';
PostMessage(h, WM_CopyData, Form1.handle, integer(#DataStruct));
end;
The code works- but only once.
Manager sends 2 integers: 123 and 321 as a "wake up" message to the Client.
Client responds by sending contents of Edit1 + Edit2.
Then Manager gets this data and shows on its caption.
Why does it work only once? After I click Button1 again it does nothing.
As noted in comments, you must use SendMessage with WM_COPYDATA. The primary reason for this is that the message sender is responsible for cleaning up the resources used for the transfer. As noted in the documentation :
The receiving application should consider the data read-only. The lParam parameter is valid only during the processing of the message. The receiving application should not free the memory referenced by lParam. If the receiving application must access the data after SendMessage returns, it must copy the data into a local buffer.
The only way this can work is if the message sender waits for the receiver to process the message and return a result. Otherwise the sender cannot know when it is safe to release those resources.
PostMessage is asynchronous and returns immediately so this is simply not viable. SendMessage will block until the receiver processes the message and assigns a return value.
Here you are passing a pointer to a stack allocated (local variable) record #DataStruct. Further, you are also passing a pointer to a string which is a local variable. If you use PostMessage, this method will return immediately - the stack locations (for value types like the record) will become invalid and susceptible to being overwritten. The string lives on the heap but is reference counted and, in this case, will be freed when the method returns.
The solution is to always be sure to use SendMessage with WM_COPYDATA.
I have a working application that can access Outlook via COM and send, save or show emails I create inside this app.
What I want is all the settings of the account in Outlook getting applied on my mail too, so this means which mail-type (text, html or rich), custom fonts, signatures, and so on.
here a SSCCE (the the rest of the code is just some logging, and the form only contains the most neccessary controls):
...
strict private
FOutlook: _Application;
...
procedure TMainForm.ShowMailDlg(aModal: Boolean);
var
mail: _MailItem;
begin
Connect();
mail := FOutlook.CreateItem(olMailItem) as _MailItem;
mail.Recipients.Add(Trim(EdTo.Text));
mail.CC := Trim(EdCc.Text);
mail.Subject := Trim(EdSubject.Text);
mail.Body := EmailText.Lines.Text;
mail.SendUsingAccount := GetAccountForEmailAddress(Trim(EdFrom.Text));
//mail.Attachments.Add('Path1', olByValue, 1, 'Caption1');
//mail.Attachments.Add('Path2', olByValue, 2, 'Caption2');
mail.Display(aModal);
end;
procedure TMainForm.Connect;
begin
FOutlook := CreateOleObject('Outlook.Application') as _Application;
end;
function TMainForm.GetAccountForEmailAddress(const aSmtp: string): _Account;
var
accounts: _Accounts;
account: _Account;
i: Integer;
begin
accounts := FOutlook.Session.Accounts;
for i := 1 to accounts.Count do begin
account := accounts.Item(i);
if LowerCase(account.SmtpAddress) = LowerCase(aSmtp) then begin
Result := account;
Exit;
end;
end;
raise Exception.Create('No Account with SMTP address ' + aSmtp + ' found!');
end;
How can I get the MailItem to use all formatting-options from the chosen account?
I still haven't found a real solution, but here is a workaround.
The trick is to use the CreateItemFromTemplate-method, where your template contains all the settings. Oviously the user is required to create a template for this purpose, but it's a one-time-action which shoulnd't be too hard.
procedure TMainForm.DoMailAction(aAction: TMailAction);
var
mail: _MailItem;
folder: OleVariant;
begin
Connect();
folder := FOutlook.Session.GetDefaultFolder(olFolderDrafts);
mail := FOutlook.CreateItemFromTemplate('C:\\Users\\fkoch\\default.oft', folder) as _MailItem;
...
Additionally, the selected folder "Drafts" causes the signature getting attached to the mailbody, as long as the mailItem is manually send by the user in the mail-dialog (mail.display(False)). This doesn't happen when directly processed via mail.send() or mail.save().
I've found the solution now. I'v set the body the wrong way, thats why it didn't work.
procedure CreateMail(aMailInfo.TMailInfo)
var
...
insp: _Inspector;
editor: OleVariant;
begin
FMailItem := FOutlook.CreateItem(olMailItem) as _MailItem;
...
insp := FMailItem.GetInspector;
if (insp.EditorType = olEditorWord) then begin
editor := insp.WordEditor;
editor.Characters.item(1).InsertBefore(mailText);
end else begin
if FMailItem.BodyFormat = olFormatHTML then begin
regex := TRegEx.Create(cReplaceNewline);
FMailItem.HTMLBody := regex.Replace(mailText, '<br />');
end else
FMailItem.Body := mailText;
end;
...
end;
So I'm having this code that processes what the client sends on a pattern. If he sends 'getBENUds', the server sends the DataSet for this table back using the SaveToString method.
Then, this is sent to the client. (I'm using Synapse).
procedure TTCPSocketThrd.Execute;
var s: String;
strm: TMemoryStream;
ADO_CON: TADOConnection;
ADO_QUERY: TADOQuery;
DS_PROV: TDataSetProvider;
DS_CLIENT: TClientDataSet;
begin
CoInitialize(nil);
Sock := TTCPBlockSocket.Create;
try
Sock.Socket := CSock;
Sock.GetSins;
with Sock do
begin
repeat
if terminated then break;
s := RecvTerminated(60000,'|');
if s = 'getBENUds' then
begin
//ini ADO_CON
ADO_CON := TADOConnection.Create(Form1);
ADO_CON.ConnectionString := 'not for public';
ADO_CON.LoginPrompt := false;
ADO_CON.Provider := 'SQLOLEDB.1';
ADO_CON.Open;
//ini ADO_QUERY
ADO_QUERY := TADOQuery.Create(ADO_CON);
ADO_QUERY.Connection := ADO_CON;
//ini DS_PROV
DS_PROV := TDataSetProvider.Create(ADO_CON);
DS_PROV.DataSet := ADO_QUERY;
//ini DS_CLIENT
DS_CLIENT := TClientDataSet.Create(ADO_CON);
DS_CLIENT.ProviderName := 'DS_PROV';
//SQLQUERY Abfrage
ADO_QUERY.SQL.Clear;
ADO_QUERY.SQL.Add('SELECT * FROM BENU');
ADO_QUERY.Open;
//DSCLIENTDATASET bauen
strm := TMemoryStream.Create;
DS_CLIENT.Open;
DS_CLIENT.SaveToStream(strm);
end
else if s = 'getBESTEds' then
...
The line it says: DS_CLIENT.Open an exception is thrown:
An exception has been thrown: class EDatabaseError. Text: 'missing data-provider or data package'.
The data-provider has been set as can be seen above to 'DS_PROV', so it has to be the missing data package.
But shouldn't the ClientDataSet get its data from the DataSetProvider which in turn gets it from the ADOQuery that gets the data from the database?
This is as far as I get with my level of knowledge. I hope its not too difficult, because in my eyes, everything I did was correct.
Use
DS_CLIENT.SetProvider(DS_PROV);
or after DS_PROV creation: (at this time your component has really no name)
DS_PROV.name := 'DS_PROV';