I have two mailboxes in MS Outlook. I need to get mail from one of them. How to select a specific mailbox? I have Office 365 installed. Something needs to be set in Logon ('', '', true, true); ?
My code
zOutlook := TOutlookApplication.Create(nil);
try
zOutlook.ConnectKind := ckNewInstance;
try
zOutlook.Connect;
try
zNameSpace := zOutlook.GetNamespace('MAPI');
zNameSpace.Logon('', '', true, true);
try
zInbox := zNameSpace.GetDefaultFolder(olFolderInbox);
zInboxUnread := zInbox.Items.Restrict('[Unread]=true');
FCodeSite.Send('zInboxUnread.Count ' + IntToStr(zInboxUnread.Count));
for i := 1 to zInboxUnread.Count do
begin
//..
end;
finally
zNameSpace.Logoff;
end;
finally
zOutlook.Disconnect;
end;
except
on E: SysUtils.Exception do
begin
FCodeSite.SendError(E.Message);
end;
end;
finally
zOutlook.Free;
end;
Loop though the Namespace.Stores collection and call Store.GetDEefaultFolder(olFolderInbox) instead of NameSpace.GetDefaultFolder.
You might want to look at the Store.ExchangeStoreType property to make sure you only process primary Exchange mailboxes.
I have fixed your code.
The idea is to iterate the folders at two levels: the mailboxes and the folders in the mailboxes.
Tested with Oultook 2019. Should work with other versions as well.
procedure TForm1.Button1Click(Sender: TObject);
var
zOutlook : TOutlookApplication;
zNameSpace : _NameSpace;
zInbox : MAPIFolder;
zFolder : MAPIFolder;
zInboxUnread : _Items;
I : Integer;
Found : Boolean;
MailBoxName : String;
InboxName : String;
begin
MailBoxName := 'francois.piette#company.com';
InboxName := 'Boîte de réception';
zOutlook := TOutlookApplication.Create(nil);
try
zOutlook.ConnectKind := ckNewInstance;
try
zOutlook.Connect;
try
zNameSpace := zOutlook.GetNamespace('MAPI');
zNameSpace.Logon('', '', true, true);
try
Found := FALSE;
for I := 1 to zNameSpace.Folders.Count do begin
zFolder := zNameSpace.Folders.Item(I);
if SameText(zFolder.Name, MailBoxName) then begin
Found := TRUE;
break;
end;
end;
if not Found then
Exit;
Found := FALSE;
for I := 1 to zFolder.Folders.Count do begin
zInbox := zFolder.Folders.Item(I);
if SameText(zInbox.Name, InboxName) then begin
Found := TRUE;
break;
end;
end;
if not Found then
Exit;
zInboxUnread := zInbox.Items.Restrict('[Unread]=true');
for i := 1 to zInboxUnread.Count do begin
//..
end;
finally
zNameSpace.Logoff;
end;
finally
zOutlook.Disconnect;
end;
except
on E: System.SysUtils.Exception do begin
Memo1.Lines.Add(E.Message);
end;
end;
finally
zOutlook.Free;
end;
end;
I am trying to transform my delphi project from VCL to ActiveX. I have issues with a client thread. Here is my client thread type:
type
TClientThread = class(TThread)
private
Command: string;
procedure HandleInput;
protected
procedure Execute; override;
end;
And here is the implementation:
procedure TClientThread.HandleInput;
begin
activext.ProcessCommands(Command);
Command := '';
end;
procedure Tactivextest.ProcessCommands(Command: string);
var
Params: array [1 .. 10] of String;
ParamsCount, P: Integer;
PackedParams: TPackedParams;
PStr: String;
IdBytes: TIdBytes;
Ms: TMemoryStream;
ReceiveParams, ReceiveStream: Boolean;
Size: Int64;
begin
Ms := TMemoryStream.Create;
ReceiveParams := False;
ReceiveStream := False;
if Command[1] = '1' then // command with params
begin
Command := Copy(Command, 2, Length(Command));
ReceiveParams := True;
end
else if Command[1] = '2' then // command + memorystream
begin
Command := Copy(Command, 2, Length(Command));
ReceiveStream := True;
Ms.Position := 0;
end
else if Command[1] = '3' then // command with params + memorystream
begin
Command := Copy(Command, 2, Length(Command));
ReceiveParams := True;
ReceiveStream := True;
end;
if ReceiveParams then // params incomming
begin
TCPClient.Socket.ReadBytes(IdBytes, SizeOf(PackedParams), False);
BytesToRaw(IdBytes, PackedParams, SizeOf(PackedParams));
ParamsCount := 0;
repeat
Inc(ParamsCount);
P := Pos(Sep, String(PackedParams.Params));
Params[ParamsCount] := Copy(String(PackedParams.Params), 1, P - 1);
Delete(PackedParams.Params, 1, P + 4);
until PackedParams.Params = '';
end;
if ReceiveStream then // stream incomming
begin
Size := TCPClient.Socket.ReadInt64;
TCPClient.Socket.ReadStream(Ms, Size, False);
Ms.Position := 0;
end;
if Command = 'SIMPLEMESSAGE' then
begin
MessageDlg(Params[1], mtInformation, [mbOk], 0);
end;
if Command = 'INVALIDPASSWORD' then
begin
TCPClient.Disconnect;
MessageDlg('Invalid password!', mtError, [mbOk], 0);
end;
if Command = 'SENDYOURINFO' then // succesfully loged in
begin
UniqueID := StrToInt(Params[1]);
Panel1.Caption := 'connect ' + namewithicon + ')';
PStr := namewithicon + Sep;
SendCommandWithParams(TCPClient, 'TAKEMYINFO', PStr);
end;
if Command = 'DISCONNECTED' then
begin
if TCPClient.Connected then
TCPClient.Disconnect;
end;
if Command = 'TEXTMESSAGE' then
begin
memo1.Lines.Add(Params[1] + ' : ' + Params[2] )
end;
end;
procedure TClientThread.Execute;
begin
inherited;
while not Terminated do
begin
if not activext.TCPClient.Connected then
Terminate
else
begin
if activext.TCPClient.Connected then
Command := activext.TCPClient.Socket.ReadLn('', 5);
if Command <> '' then
Synchronize(HandleInput);
end;
end;
end;
initialization
TActiveFormFactory.Create(
ComServer,
TActiveFormControl,
Tactivextest,
Class_activextest,
0,
'',
OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
tmApartment);
end.
And here is how I start the client thread with Indy's TCP OnConnected event:
procedure Tactivextest.TCPClientConnected(Sender: TObject);
begin
ClientThread := TClientThread.Create(True);
ClientThread.Start;
SendCommandWithParams(TCPClient, 'LOGIN', namewithicon + Sep);
end;
And here is how I connect to the server on the Form's OnCreate event:
begin
if not TCPClient.Connected then
begin
TCPClient.Host := 'localhost';
TCPClient.Port := 31000;
try
TCPClient.Connect;
except
on E: Exception do
begin
MessageDlg('Cannot connect to server!', mtInformation, [mbOk], 0);
Application.Terminate;
end;
end;
end
else
begin
SendCommand(TCPClient, 'DISCONNECTED');
if TCPClient.Connected then
TCPClient.Disconnect;
end;
end;
send commands
procedure Tactivextest.SendBuffer(TCPClient: TIdTCPClient; Buffer: TIdBytes;
BufferSize: Cardinal);
begin
if not TCPClient.Connected then
Exit;
TCPClient.Socket.WriteLn('AUDIO');
TCPClient.Socket.Write(BufferSize);
TCPClient.Socket.Write(Buffer, BufferSize);
end;
procedure Tactivextest.SendCommand(TCPClient: TIdTCPClient; Command: string);
begin
if not TCPClient.Connected then
Exit;
TCPClient.Socket.WriteLn(Command);
end;
procedure Tactivextest.SendCommandWithParams(TCPClient: TIdTCPClient;
Command, Params: String);
var
PackedParams: TPackedParams;
begin
if not TCPClient.Connected then
Exit;
TCPClient.Socket.WriteLn('1' + Command);
PackedParams.Params := ShortString(Params);
TCPClient.Socket.Write(RawToBytes(PackedParams, SizeOf(PackedParams)));
end;
procedure Tactivextest.SendStream(TCPClient: TIdTCPClient; Ms: TMemoryStream);
begin
if not TCPClient.Connected then
Exit;
Ms.Position := 0;
with TCPClient.Socket do
begin
Write(Ms.Size);
WriteBufferOpen;
Write(Ms, 0);
WriteBufferClose;
end;
end;
procedure Tactivextest.SendCommandAndStream(TCPClient: TIdTCPClient; Command: String;
Ms: TMemoryStream);
begin
if not TCPClient.Connected then
Exit;
TCPClient.Socket.WriteLn('2' + Command);
Ms.Position := 0;
with TCPClient.Socket do
begin
Write(Ms.Size);
WriteBufferOpen;
Write(Ms, 0);
WriteBufferClose;
end;
end;
procedure Tactivextest.SendCommandWithParamsAndStream(TCPClient: TIdTCPClient;
Command, Params: String; Ms: TMemoryStream);
var
PackedParams: TPackedParams;
begin
if not TCPClient.Connected then
Exit;
SendCommand(TCPClient, '3' + Command);
PackedParams.Params := ShortString(Params);
TCPClient.Socket.Write(RawToBytes(PackedParams, SizeOf(PackedParams)));
Ms.Position := 0;
with TCPClient.Socket do
begin
Write(Ms.Size);
WriteBufferOpen;
Write(Ms, 0);
WriteBufferClose;
end;
end;
I am able to connect to the server, but the client thread cannot be started same as VCL so I am unable to call SendCommands() as I have been disconnected because I cannot use client thread inside ActiveX. I have searched for many days about how to solve, and I cannot find a solution to this problem. I know ActiveX is dead, but this is for education purposes.
It is not possible for TIdTCPClient.OnConnected to not be triggered if Connect() is successful, so the client thread has to be getting created. And if Start() is not raising an exception, then the thread will start running.
However, a major problem with your thread code is that HandleInput() is being run in the context of the main thread via TThread.Synchronize(), which DOES NOT work in a DLL (ActiveX or otherwise) without extra cooperation of the main thread of the hosting EXE. HandleInput() should not be synchronized at all, but then once you fix that, ProcessCommands() is doing things that are not thread-safe (using MessageDlg(), and accessing Panel1 and Memo1 directly), which do need to be synchronized.
So, you need to re-write your thread logic to avoid these pitfalls. Try something more like this:
type
TClientThread = class(TThread)
protected
procedure Execute; override;
end;
procedure TClientThread.Execute;
begin
activext.SendCommandWithParams(activext.TCPClient, 'LOGIN', activext.namewithicon + activext.Sep);
while (not Terminated) and activext.TCPClient.Connected do
begin
Command := activext.TCPClient.Socket.ReadLn('', 5);
if Command <> '' then
activext.ProcessCommands(Command);
end;
end;
type
Tactivextest = class(TActiveForm)
TCPClient: TIdTCPClient;
...
private
...
LineToAdd: string;
procedure UpdatePanel;
procedure AddLineToMemo;
...
end;
procedure Tactivextest.FormCreate(Sender: TObject);
begin
TCPClient.Host := 'localhost';
TCPClient.Port := 31000;
try
TCPClient.Connect;
except
on E: Exception do
begin
MessageBox(0, 'Cannot connect to server!', 'Error', MB_OK);
raise;
end;
end;
end;
// TTimer OnTimer event handler
procedure Tactivextest.Timer1Timer(Sender: TObject);
begin
// needed for TThread.Synchronize() to work in a DLL...
CheckSynchronize;
end;
procedure Tactivextest.TCPClientConnected(Sender: TObject);
begin
ClientThread := TClientThread.Create(False);
end;
procedure Tactivextest.UpdatePanel;
begin
Panel1.Caption := 'connect ' + namewithicon + ')';
end;
procedure Tactivextest.AddLineToMemo;
begin
Memo1.Lines.Add(LineToAdd);
end;
procedure Tactivextest.ProcessCommands(Command: string);
var
Params: array [1 .. 10] of String;
ParamsCount, P: Integer;
PackedParams: TPackedParams;
IdBytes: TIdBytes;
Ms: TMemoryStream;
ReceiveParams, ReceiveStream: Boolean;
Size: Int64;
begin
ReceiveParams := False;
ReceiveStream := False;
Ms := TMemoryStream.Create;
try
case Command[1] of
'1': // command with params
begin
Command := Copy(Command, 2, MaxInt);
ReceiveParams := True;
end;
'2': // command + stream
begin
Command := Copy(Command, 2, MaxInt);
ReceiveStream := True;
end;
'3': // command with params + stream
begin
Command := Copy(Command, 2, MaxInt);
ReceiveParams := True;
ReceiveStream := True;
end;
end;
if ReceiveParams then // params incoming
begin
TCPClient.Socket.ReadBytes(IdBytes, SizeOf(PackedParams), False);
BytesToRaw(IdBytes, PackedParams, SizeOf(PackedParams));
ParamsCount := 0;
repeat
Inc(ParamsCount);
P := Pos(Sep, String(PackedParams.Params));
Params[ParamsCount] := Copy(String(PackedParams.Params), 1, P - 1);
Delete(PackedParams.Params, 1, P + 4);
until (PackedParams.Params = '') or (ParamsCount = 10);
end;
if ReceiveStream then // stream incoming
begin
Size := TCPClient.Socket.ReadInt64;
if Size > 0 then
begin
TCPClient.Socket.ReadStream(Ms, Size, False);
Ms.Position := 0;
end;
end;
if Command = 'SIMPLEMESSAGE' then
begin
MessageBox(0, PChar(Params[1]), 'Message', MB_OK);
end
else if Command = 'INVALIDPASSWORD' then
begin
TCPClient.Disconnect;
MessageBox(0, 'Invalid password!', 'Error', MB_OK);
end
else if Command = 'SENDYOURINFO' then // successfully logged in
begin
UniqueID := StrToInt(Params[1]);
TThread.Synchronize(nil, UpdatePanel);
SendCommandWithParams(TCPClient, 'TAKEMYINFO', namewithicon + Sep);
end
else if Command = 'DISCONNECTED' then
begin
TCPClient.Disconnect;
end
else if Command = 'TEXTMESSAGE' then
begin
LineToAdd := Params[1] + ' : ' + Params[2];
TThread.Synchronize(nil, AddLineToMemo);
end;
finally
Ms.Free;
end;
end;
initialization
TActiveFormFactory.Create(
ComServer,
TActiveFormControl,
Tactivextest,
Class_activextest,
0,
'',
OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
tmApartment);
end.
I've a sample ISAPI module hosts on IIS7 on Windows Vista Ultimate in Virtual Machine. According to the IIS 7.0 Editions and Windows, the simultaneous request execution limit is ten for Windows Vista Ultimate. I write a sample application for testing the IIS7 simultaneous request execution limit:
procedure TForm1.Button1Click(Sender: TObject);
const c_Max = 20;
var P: TProc<string>;
o: TThread;
i: integer;
A: array of TThread;
begin
P :=
procedure(aValue: string)
begin
Memo1.Lines.Add(aValue);
end;
SetLength(A, c_Max);
for i := Low(A) to High(A) do begin
o := TMyThread.Create(P, edHostName.Text, Format('test%d', [i + 1]), True);
o.FreeOnTerminate := True;
A[i] := o;
end;
for o in A do
o.Start;
end;
constructor TMyThread.Create(const aMethod: TProc<string>; const aHostName,
aValue: string; const aCreateSuspended: boolean);
begin
inherited Create(aCreateSuspended);
FMethod := aMethod;
FHostName := aHostName;
FValue := aValue;
end;
procedure TMyThread.Execute;
var C: TSQLConnection;
o: TServerMethods1Client;
S: string;
begin
C := TSQLConnection.Create(nil);
C.DriverName := 'DataSnap';
C.LoginPrompt := False;
with C.Params do begin
Clear;
Values[TDBXPropertyNames.DriverUnit] := 'Data.DBXDataSnap';
Values[TDBXPropertyNames.HostName] := FHostName;
Values[TDBXPropertyNames.Port] := IntToStr(80);
Values[TDBXPropertyNames.CommunicationProtocol] := 'http';
Values[TDBXPropertyNames.URLPath] := 'MyISAPI/MyISAPI.dll';
end;
S := Format('%d=', [ThreadID]);
try
try
C.Open;
o := TServerMethods1Client.Create(C.DBXConnection);
try
S := S.Format('%s%s', [S, o.EchoString(FValue)]);
finally
o.Free;
end;
except
on E: Exception do
S := S.Format('%s%s', [S, E.Message]);
end;
finally
Synchronize(
procedure
begin
FMethod(S);
end
);
C.Free;
end;
end;
When i click the Button1, the Memo1 displays 20 lines of string (ThreadID=Result of EchoString), even though i change the constant variable c_Max to 500, i still can't get any line of string (ThreadID=Exception message) displays on Memo1. My question is how to test IIS7 simultaneous request execution limit?
I have an SOAP service that I generated from an outside source that is giving me some errors. I would like to capture the XML being sent to the SOAP service before it is actually sent and have found a couple mentions of doing an OnBeforeExecute on the RIO but am not sure how to implement this. I do not normally use Delphi, just maintaining this legacy program so the more detail the better!
Here is the generated API/SOAP code (the RIO_OnBeforeExecute is what I tried to put in but it complains about incompatible types: method pointer and regular procedure):
ExpressSoap = interface(IInvokable)
['{83D77575-DBDE-3A05-D048-60B2F6BCDFE6}']
function HealthCheck(const credentials: Credentials; const application: Application): Response; stdcall;
end;
function GetExpressSoap(UseWSDL: Boolean=System.False; Addr: string=''; HTTPRIO: THTTPRIO = nil): ExpressSoap;
procedure RIO_BeforeExecute(const MethodName: string; var SOAPRequest: WideString);
implementation
function GetExpressSoap(UseWSDL: Boolean; Addr: string; HTTPRIO: THTTPRIO): ExpressSoap;
const
defWSDL = 'https://certtransaction.elementexpress.com/express.asmx?wsdl';
defURL = 'https://certtransaction.elementexpress.com/express.asmx';
defSvc = 'Express';
defPrt = 'ExpressSoap';
var
RIO: THTTPRIO;
begin
RIO.OnBeforeExecute := RIO_BeforeExecute;
Result := nil;
if (Addr = '') then
begin
if UseWSDL then
Addr := defWSDL
else
Addr := defURL;
end;
if HTTPRIO = nil then
RIO := THTTPRIO.Create(nil)
else
RIO := HTTPRIO;
try
Result := (RIO as ExpressSoap);
if UseWSDL then
begin
RIO.WSDLLocation := Addr;
RIO.Service := defSvc;
RIO.Port := defPrt;
end else
RIO.URL := Addr;
finally
if (Result = nil) and (HTTPRIO = nil) then
RIO.Free;
end;
end;
procedure RIO_BeforeExecute(const MethodName: string; var SOAPRequest: WideString);
begin
MessageDlg('Hello', mtConfirmation, [mbOK] ,0);
end;
Here is the code that is calling the HealthCheck method (the cEPS_* items are constants defined earlier in the code):
procedure TForm1.Button1Click(Sender: TObject);
var
Headers : ISOAPHeaders;
aResult: c_ExpressPSAPI.Response;
begin
try
FEPS_SoapService := c_ExpressPSAPI.GetExpressSoap();
FEPS_Headers := (FEPS_SoapService as ISOAPHeaders);
FEPS_Application := c_ExpressPSAPI.Application.Create();
FEPS_Application.ApplicationID := cEPS_ApplicationID;
FEPS_Application.ApplicationName := cEPS_ApplicationName;
FEPS_Credentials := c_ExpressPSAPI.Credentials.Create();
FEPS_Credentials.AccountID := cEPS_AccountID;
FEPS_Credentials.AccountToken := cEPS_AccountToken;
FEPS_Credentials.AcceptorID := cEPS_AcceptorID;
FEPS_Credentials.NewAccountToken := '';
aResult := c_ExpressPSAPI.Response.Create;
aResult := FEPS_SoapService.HealthCheck(FEPS_Credentials, FEPS_Application);
except
on E : ERemotableException do
ShowMessage(E.ClassName + ' error raised, with message : ' + E.FaultDetail + ' :: '
+ E.Message);
end;
end;
I was able to get this working and am posting the answer in case someone else finds this question.
To begin with I had to add a THTTPRIO (named HTTPRIO1) component to my form and then setup the OnBeforeExecute event on that component (named HTTPRIO1BeforeExecute). Once done I passed the HTTPRIO1 object to the GetExpressSOAP method which tied in the OnBeforeExecute method:
FEPS_SoapService := c_ExpressPSAPI.GetExpressSoap(System.False, '', HTTPRIO1);
I could then use the OnBeforeExecute like such:
procedure TForm1.HTTPRIO1BeforeExecute(const MethodName: string;
var SOAPRequest: WideString);
var
tmpString: TStringList;
begin
try
Memo1.Lines.Append(SOAPRequest);
except
on ER : ERemotableException do
ShowMessage(ER.ClassName + ' error raised, with message : ' + ER.FaultDetail);
on E : Exception do
ShowMessage(E.ClassName + ' error raised, with message : ' + E.Message);
end;
end;
I'm working on a component installer (only for Delphi XE2) and I would like to detect if the Delphi XE2 IDE is running. How would you detect it?
P.S. I know about the TAppBuilder window class name, but I need to detect also the IDE version.
These are the steps to determine if the Delphi XE2 is running
1) First Read the location of the the bds.exe file from the App entry in the \Software\Embarcadero\BDS\9.0 registry key which can be located in the HKEY_CURRENT_USER or HKEY_LOCAL_MACHINE Root key.
2) Then using the CreateToolhelp32Snapshot function you can check if exist a exe with the same name running.
3) Finally using the PID of the last processed entry you can resolve the full file path of the Exe (using the GetModuleFileNameEx function) and then compare the names again.
Check this sample code
{$APPTYPE CONSOLE}
{$R *.res}
uses
Registry,
PsAPI,
TlHelp32,
Windows,
SysUtils;
function ProcessFileName(dwProcessId: DWORD): string;
var
hModule: Cardinal;
begin
Result := '';
hModule := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, dwProcessId);
if hModule <> 0 then
try
SetLength(Result, MAX_PATH);
if GetModuleFileNameEx(hModule, 0, PChar(Result), MAX_PATH) > 0 then
SetLength(Result, StrLen(PChar(Result)))
else
Result := '';
finally
CloseHandle(hModule);
end;
end;
function IsAppRunning(const FileName: string): boolean;
var
hSnapshot : Cardinal;
EntryParentProc: TProcessEntry32;
begin
Result := False;
hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if hSnapshot = INVALID_HANDLE_VALUE then
exit;
try
EntryParentProc.dwSize := SizeOf(EntryParentProc);
if Process32First(hSnapshot, EntryParentProc) then
repeat
if CompareText(ExtractFileName(FileName), EntryParentProc.szExeFile) = 0 then
if CompareText(ProcessFileName(EntryParentProc.th32ProcessID), FileName) = 0 then
begin
Result := True;
break;
end;
until not Process32Next(hSnapshot, EntryParentProc);
finally
CloseHandle(hSnapshot);
end;
end;
function RegReadStr(const RegPath, RegValue: string; var Str: string;
const RootKey: HKEY): boolean;
var
Reg: TRegistry;
begin
try
Reg := TRegistry.Create;
try
Reg.RootKey := RootKey;
Result := Reg.OpenKey(RegPath, True);
if Result then
Str := Reg.ReadString(RegValue);
finally
Reg.Free;
end;
except
Result := False;
end;
end;
function RegKeyExists(const RegPath: string; const RootKey: HKEY): boolean;
var
Reg: TRegistry;
begin
try
Reg := TRegistry.Create;
try
Reg.RootKey := RootKey;
Result := Reg.KeyExists(RegPath);
finally
Reg.Free;
end;
except
Result := False;
end;
end;
function GetDelphiXE2LocationExeName: string;
Const
Key = '\Software\Embarcadero\BDS\9.0';
begin
Result:='';
if RegKeyExists(Key, HKEY_CURRENT_USER) then
begin
RegReadStr(Key, 'App', Result, HKEY_CURRENT_USER);
exit;
end;
if RegKeyExists(Key, HKEY_LOCAL_MACHINE) then
RegReadStr(Key, 'App', Result, HKEY_LOCAL_MACHINE);
end;
Var
Bds : String;
begin
try
Bds:=GetDelphiXE2LocationExeName;
if Bds<>'' then
begin
if IsAppRunning(Bds) then
Writeln('The Delphi XE2 IDE Is running')
else
Writeln('The Delphi XE2 IDE Is not running')
end
else
Writeln('The Delphi XE2 IDE Is was not found');
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
Addtional resources.
Detecting installed delphi versions
Check DebugHook <> 0.
The down side is that currently if your app is built with packages, DebugHook will return 0.
But normally this is would be a very elegant and simple test. Works great in D2009, I just noticed that it has the package dependency bug in XE2 (http://qc.embarcadero.com/wc/qcmain.aspx?d=105365).