If I understand correctly, TSendMail is supposed to use my installed email client. If I execute it on my virtual machine, it returns "true" and gives me the expected message that I need to install an email program.
However, if I run the program on my regular machine (on which Thunderbird is installed) TSendMail.execute returns "True", but Thunderbird doesn't get called. Here's my code:
procedure TfSendEmail.btnSendClick(Sender: TObject);
var
aNode: PVirtualNode;
Data: PRecipients;
i: integer;
begin
aNode := vstRecipients.GetFirst;
i := 0;
while (aNode <> nil) do
begin
Data := vstRecipients.GetNodeData(aNode);
Mail.Recipients.Add;
Mail.Recipients[i].DisplayName := Data.Name;
Mail.Recipients[i].Address := Data.Email;
inc(i);
aNode := vstRecipients.GetNext(aNode);
end;
Mail.Attachments.Assign(lbAttachments.Items);
Mail.Subject := edtSubject.Text;
Mail.Text.Assign(mmoMsgText.Lines);
if Mail.Execute then
begin
ShowMessage('Succeeded');
//ModalResult := mrOk;
end
else
MessageDlg('Sorry!. Could not send email.', mtError, [mbOK], 0);
end;
Using Delphi 10.2.3 on fully updated Win10 machines. Maybe my recipient assignment is faulty. Anyway, I can't find any complete usage examples, only the incomplete example on attachments from Embarcadero's wiki.
Related
I'm trying to implement UDP Hole Punching with Delphi with Indy and Firemonkey technology.
I have tried to follow this document: https://www.researchgate.net/publication/1959162_Peer-to-Peer_Communication_Across_Network_Address_Translators
The program seems to work but is NOT stable.
If I work on a system on the local intranet no problem.
If I work on an internet, it doesn't always work and I don't know why.
I have created two applications.
The first is server side.
Everytime all clients connect correctly to server.
The server registers the Local IP and Internet IP pairs in a variable (fPeers).
I created an IdUDPServer instance.
This is the “Connect push button” code:
procedure TForm1.B_ConnectClick(Sender: TObject);
var
vIdSocketHandle: TIdSocketHandle;
begin
if IdUDPServer.Active then
begin
IdUDPServer.Active := False;
B_Connect.Text := 'Connect';
end
else
begin
IdUDPServer.Bindings.Clear;
vIdSocketHandle := IdUDPServer.Bindings.Add;
vIdSocketHandle.IP := GStack.LocalAddress;
vIdSocketHandle.Port := E_POrt.Text.ToInteger;
IdUDPServer.Active := True;
B_Connect.Text := 'Disconnect';
end;
end;
During the IdUDPServerUDPRead event I capture the Local and Internet IP addresses of the clients that connect.
In the TStringLIST called fPeerIP I add the list of addresses.
procedure TForm1.IdUDPServerUDPRead(AThread: TIdUDPListenerThread;
const AData: TIdBytes; ABinding: TIdSocketHandle);
var vPair: string;
vData: string;
vString: string;
vLog: string;
begin
vPair := ABinding.PeerIP + ':'+ABinding.PeerPort.ToString;
vData := BytesToString(AData);
vLog := '';
if leftstr(vdata,7) = 'LOCALIP' then
begin
vString := vPair+#9+lsExtract(vData,2,',');
if fPeerIP.IndexOfName(vString) = -1 then
begin
fPeerIP.Add(vString);
M_Peers.Lines.Add(vString);
vLog := vLog + vString + #13#10;
IdUDPServer.Send(ABinding.PeerIP, ABinding.PeerPort, 'Peer aggiunto alla lista');
end;
end
else vLog := vData;
end;
On the client side, I created an IdUDPServer instance which, upon connection, sends a string to the server.
procedure TForm2.B_ConnectClick(Sender: TObject);
var vIdSocketHandle: TIdSocketHandle;
vLocalAddressList: TIdStackLocalAddressList;
vI: Integer;
vSendLIST: TStringLIST;
begin
if IdUDPServer.Active then
begin
Timer.Enabled := False;
IdUDPServer.Active := False;
B_Connect.Text := 'Connect';
M_Networks.Lines.Clear;
M_Debug.Lines.Clear;
LB_Peers.Items.Clear;
end
else
begin
try
vSendLIST := TStringLIST.Create;
IdUDPServer.Bindings.Clear;
vLocalAddressList := TIdStackLocalAddressList.Create;
GStack.GetLocalAddressList(vLocalAddressList);
M_Networks.Lines.Clear;
for vI := 0 to vLocalAddressList.Count-1 do
begin
if vLocalAddressList.Addresses[vI].IPVersion = id_IPV4 then
begin
M_Networks.Lines.Add(vLocalAddressList.Addresses[vI].IPAddress);
vSendLIST.Add(Format('LOCALIP,%s:%d',[vLocalAddressList.Addresses[vI].IPAddress,E_ClientPort.Text.ToInteger]));
end;
end;
vIdSocketHandle := IdUDPServer.Bindings.Add;
vIdSocketHandle.Port := E_ClientPort.Text.ToInteger;
vIdSocketHandle.IP := '0.0.0.0';
IdUDPServer.Active := True;
for vI := 0 to vSendLIST.Count-1 do
IdUDPServer.Send(E_Server.Text, E_Port.Text.ToInteger, vSendLIST[vI]);
B_Connect.Text := 'Disconnect';
if Assigned(vSendLIST) then FreeAndNil(vSendLIST);
finally
if Assigned(vLocalAddressList) then FreeAndnil(vLocalAddressList);
end;
end;
end;
Also on the client side, in the IdUDPServerUDPRead event I detect the list of Peers (function sent by the server) and send a "PING" to each connected peer.
I realize maybe I have given little information.
I'd like to know your opinion and possibly indicate to me if I made a mistake in the process that activates the Hole Punching.
Thanks in advance
LS
Your code is theoretically right and may work on some NAT routers but it will not work on the rest
I have been trying to achieve UDP Hole Punching for many years but it's really complicated,
you need to combine many NAT Traversal mechanisms together to make it work in the most cases
Reading about STUN, TURN and ICE mechanisms may help
I have a problem with taking MAC-addresses list in Windows XP from Inno Setup installer.
I'm trying to write some code (took it from Get MAC address in Inno Setup):
function GetMacAddressesList(out List: Array of String): Integer;
var
I: Integer;
WQLQuery: string;
WbemLocator: Variant;
WbemServices: Variant;
WbemObject: Variant;
WbemObjectSet: Variant;
begin
Result := 0;
WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
WbemServices := WbemLocator.ConnectServer('localhost', 'root\cimv2');
WQLQuery := 'Select * from Win32_NetworkAdapterConfiguration where IPEnabled=true';
WbemObjectSet := WbemServices.ExecQuery(WQLQuery);
if not VarIsNull(WbemObjectSet) and (WbemObjectSet.Count > 0) then
begin
Result := WbemObjectSet.Count;
SetArrayLength(List, WbemObjectSet.Count);
for I := 0 to WbemObjectSet.Count - 1 do
begin
WbemObject := WbemObjectSet.ItemIndex(I);
if not VarIsNull(WbemObject) then
begin
List[I] := WbemObject.MACAddress;
StringChange(List[i], ':', '');
StringChange(List[I], '-', '');
end;
end;
end;
end;
And I have a problem with ItemIndex method. It appears only in Windows Vista. How can I do this on XP? I really don't know, because every solution, that I have found in Internet doesn't work. May be because in Inno Setup libraries there is no such type as IEnumVariant and I can't iterate by SWbemObjectSet with for each obj in objset syntax...
I was also trying to get SWbemObject with Item method:
WbemObject := WbemObjectSet.Item('Win32_NetworkAdapterConfiguration.Index=' + IntToStr(I));
but it returns error
SWbemObjectSet: not found
Can anybody help me? Has this problem some solution?
Yes, you would have to implement the IEnumVariant. Not sure if that's possible with Pascal Script.
Use of the SWbemObjectSet.Item method is like this:
WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
WbemServices := WbemLocator.ConnectServer('localhost', 'root\cimv2');
WQLQuery := 'Select * from Win32_NetworkAdapterConfiguration';
WbemObjectSet := WbemServices.ExecQuery(WQLQuery);
if not VarIsNull(WbemObjectSet) then
begin
for I := 0 to WbemObjectSet.Count - 1 do
begin
WbemObject :=
WbemObjectSet.Item(Format('Win32_NetworkAdapterConfiguration=%d', [I]));
if WbemObject.IPEnabled then
begin
Log(WbemObject.MACAddress);
end;
end;
end;
But it seems that neither this approach works on Windows XP.
A possible workaround is to execute
wmic nicconfig get MACAddress
redirect to a file and read it.
See How to get an output of an Exec'ed program in Inno Setup?
How to get body texts of all e-mail messages from a certain IMAP mailbox in Delphi ? For example, from the INBOX mailbox ?
There are many ways to retrieve all body texts of all messages from the selected mailbox. I've used the one, where you iterate the mailbox and Retrieve every single message from the mailbox one by one. This way allows you to modify the code, so that you'll be able to break the loop when you need or e.g. replace Retrieve by RetrievePeek which won't mark the message as read on server like the first mentioned does. When the message is retrieved from server, all its parts are iterated and when it's the text part, its body is appended to a local S variable. After the iteration the S variable is added to the output BodyTexts string list. So, as the result you'll get string list collection where each item consists from the concatenated message's text part bodies and where each item means one message.
uses
IdIMAP4, IdSSLOpenSSL, IdText, IdMessage, IdExplicitTLSClientServerBase;
procedure GetGmailBodyTextParts(const UserName, Password: string;
BodyTexts: TStrings);
var
S: string;
MsgIndex: Integer;
MsgObject: TIdMessage;
PartIndex: Integer;
IMAPClient: TIdIMAP4;
OpenSSLHandler: TIdSSLIOHandlerSocketOpenSSL;
begin
BodyTexts.Clear;
IMAPClient := TIdIMAP4.Create(nil);
try
OpenSSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
try
OpenSSLHandler.SSLOptions.Method := sslvSSLv3;
IMAPClient.IOHandler := OpenSSLHandler;
IMAPClient.Host := 'imap.gmail.com';
IMAPClient.Port := 993;
IMAPClient.UseTLS := utUseImplicitTLS;
IMAPClient.Username := UserName;
IMAPClient.Password := Password;
IMAPClient.Connect;
try
if IMAPClient.SelectMailBox('INBOX') then
begin
BodyTexts.BeginUpdate;
try
for MsgIndex := 1 to IMAPClient.MailBox.TotalMsgs do
begin
MsgObject := TIdMessage.Create(nil);
try
S := '';
IMAPClient.Retrieve(MsgIndex, MsgObject);
MsgObject.MessageParts.CountParts;
if MsgObject.MessageParts.TextPartCount > 0 then
begin
for PartIndex := 0 to MsgObject.MessageParts.Count - 1 do
if MsgObject.MessageParts[PartIndex] is TIdText then
S := S + TIdText(MsgObject.MessageParts[PartIndex]).Body.Text;
BodyTexts.Add(S);
end
else
BodyTexts.Add(MsgObject.Body.Text);
finally
MsgObject.Free;
end;
end;
finally
BodyTexts.EndUpdate;
end;
end;
finally
IMAPClient.Disconnect;
end;
finally
OpenSSLHandler.Free;
end;
finally
IMAPClient.Free;
end;
end;
This code requires OpenSSL, so don't forget to put the libeay32.dll and ssleay32.dll libraries to a path visible to your project; you can download OpenSSL libraries for Indy in different versions and platforms from here.
Some years ago, we encountered problems where an administrator would install our application on a user's machine Our app would create registry entries at the time of install, but would then fail due to registry registry rights when a different user ran our application.
The code below was written by a predecessor. It seems to fixed the above problem. But recently, the code below itself began to fail gracefully, reporting a Windows error: "Failed Key" on the SetSecurityDescriptorDacl call.
This seems to happen on networked machines which have a corporate group policy in place. We suspect that the call to SetSecurityDescriptorDacl with nil may not legal on these machines, even if the user has admin rights.
This is not an area that we have any expertise in, so I'm hoping someone will have some ideas or an alternate code snippet that lets us circumvent this problem...
class function TQPWindowsRegistry.GiveEveryoneFullAccessToRegistryKey( const RootKey: HKey;
const RegPath : string;
out ErrorMsg : string): boolean;
var
Access : LongWord;
WinResult : LongWord;
SD : PSecurity_Descriptor;
LastError : DWORD;
Reg : TRegistry;
begin
Result := TRUE;
ErrorMsg := '';
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
begin
if TOOLS.UserHasAdminToken then
Access := KEY_ALL_ACCESS
else
Access := KEY_READ OR KEY_WRITE;
Reg := TRegistry.Create(Access);
try
Reg.RootKey := RootKey;
if NOT Reg.OpenKey(RegPath, TRUE) then
Exit;
GetMem(SD, SECURITY_DESCRIPTOR_MIN_LENGTH);
try
Result := InitializeSecurityDescriptor(SD, SECURITY_DESCRIPTOR_REVISION);
if Result then
Result := SetSecurityDescriptorDacl(SD, TRUE, NIL, FALSE); // Fails here!
if NOT Result then
begin
LastError := WINDOWS.GetLastError;
if NOT Result then
ErrorMsg := SYSUTILS.SysErrorMessage(LastError);
end
else
begin
WinResult := RegSetKeySecurity(Reg.CurrentKey, DACL_SECURITY_INFORMATION, SD);
Result := (WinResult = ERROR_SUCCESS);
ErrorMsg := SYSUTILS.SysErrorMessage(WinResult);
end;
finally
FreeMem(SD);
end;
Reg.CloseKey;
finally
FreeAndNIL(Reg);
end;
end;
end; {GiveEveryoneFullAccessToRegistryKey}
I'm trying to pass information between two of my applications in Delphi 2010.
I'm using a simplified version of code that I've used successfully in the past (simplified because I don't need the sender to know that the send has been successful) I've boiled down the send received to a pair of example applications, which in essence are as follows
Send
procedure TMF.SendString;
var
copyDataStruct: TCopyDataStruct;
s: AnsiString;
begin
s := ebFirm.Text;
copyDataStruct.cbData := 1 + length(s);
copyDataStruct.lpData := PAnsiChar(s);
SendData(copyDataStruct);
end;
procedure TMF.SendData(copyDataStruct: TCopyDataStruct);
var
rh: THandle;
res: integer;
begin
rh := FindWindow(PChar('TMF'), PChar('Get Phone'));
if rh = 0 then
begin
// Launch the target application
ShellExecute(Handle, 'open', GetPhone, nil, nil, SW_SHOWNORMAL);
// Give time for the application to launch
Sleep(3000);
SendData(copyDataStruct); // RECURSION!
end;
SendMessage(rh, WM_COPYDATA, Integer(Handle), Integer(#copyDataStruct));
end;
Receive Application
procedure TMF.WMCopyData(var Msg: TWMCopyData);
var
s : AnsiString;
begin
s := PAnsiChar(Msg.CopyDataStruct.lpData) ;
jobstatus.Panels[1].Text := s;
end;
The major difference between the working test applications and the application I am adding the code to is that there is a lot of extra activity going on in target application. Especially on startup.
Any suggestions on why the WMCopyData procedure seems not to be firing at all?
CHeers
Dan
There are a few problems with your code.
One, you are not assigning a unique ID to the message. The VCL, and various third-party components, also use WM_COPYDATA, so you have to make sure you are actually processing YOUR message and not SOMEONE ELSE'S message.
Two, you may not be waiting long enough for the second app to start. Instead of Sleep(), use ShellExecuteEx() with the SEE_MASK_WAITFORINPUTIDLE flag (or use CreateProcess() and WaitForInputIdle()).
Third, when starting the second app, your recursive logic is attempting to send the message a second time. If that happened to fail, you would launch a third app, and so on. You should take out the recursion altogether, you don't need it.
Try this:
var
GetPhoneMsg: DWORD = 0;
procedure TMF.SendString;
var
copyDataStruct: TCopyDataStruct;
s: AnsiString;
begin
if GetPhoneMsg = 0 then Exit;
s := ebFirm.Text;
copyDataStruct.dwData := GetPhoneMsg;
copyDataStruct.cbData := Length(s);
copyDataStruct.lpData := PAnsiChar(s);
SendData(copyDataStruct);
end;
procedure TMF.SendData(copyDataStruct: TCopyDataStruct);
var
rh: HWND;
si: TShellExecuteInfo;
res: Integer;
begin
rh := FindWindow(PChar('TMF'), PChar('Get Phone'));
if rh = 0 then
begin
// Launch the target application and give time to start
ZeroMemory(#si, SizeOf(si));
si.cbSize := SizeOf(si);
si.fMask := SEE_MASK_WAITFORINPUTIDLE;
si.hwnd := Handle;
si.lpVerb := 'open';
si.lpFile := GetPhone;
si.nShow := SW_SHOWNORMAL;
if not ShellExecuteEx(#si) then Exit;
rh := FindWindow(PChar('TMF'), PChar('Get Phone'));
if rh = 0 then Exit;
end;
SendMessage(rh, WM_COPYDATA, WParam(Handle), LParam(#copyDataStruct));
end;
initialization
GetPhoneMsg := RegisterWindowMessage('TMF_GetPhone');
Receive Application
var
GetPhoneMsg: DWORD = 0;
procedure TMF.WMCopyData(var Msg: TWMCopyData);
var
s : AnsiString;
begin
if (GetPhoneMsg <> 0) and (Msg.CopyDataStruct.dwData = GetPhoneMsg) then
begin
SetString(s, PAnsiChar(Msg.CopyDataStruct.lpData), Msg.CopyDataStruct.cbData);
jobstatus.Panels[1].Text := s;
end else
inherited;
end;
initialization
GetPhoneMsg := RegisterWindowMessage('TMF_GetPhone');
I think it is a good habit to add
copyDataStruct.dwData := Handle;
in procedure TMF.SendString; - if you don't have a custom identifier, putting the source HWND value will help debugging on the destination (you can check for this value in the other side, and therefore avoid misunderstand of broadcasted WMCOPY_DATA e.g. - yes, there should not be, but I've seen some!).
And
procedure WMCopyData(var Msg : TWMCopyData); message WM_COPYDATA;
in TMF client class definition, right?
There should be a missing exit or else after the nested SendData call:
procedure TMF.SendData(copyDataStruct: TCopyDataStruct);
(...)
Sleep(3000);
SendData(copyDataStruct);
end else
SendMessage(rh, WM_COPYDATA, NativeInt(Handle), NativeInt(#copyDataStruct));
end;
But this won't change much.
Check the rh := FindWindow() returned handle: is it the Handle of the TMF client form, or the Application.Handle?
It doesn't work anymore if you are using Windows 7.
If you are using it, check this page to see how to add an exception: http://msdn.microsoft.com/en-us/library/ms649011%28v=vs.85%29.aspx
I thought there was a problem with the (rh) handle being 0 when you call it, if the app needed to be started. But now I see that SendData calls itself recursively. I added a comment in the code for that, as it was non-obvious. But now there's another problem. The 2nd instance of SendData will have the right handle. But then you're going to pop out of that, back into the first instance where the handle is still 0, and then you WILL call SendMessage again, this time with a 0 handle. This probably is not the cause of your trouble, but it's unintended, unnecessary, and altogether bad. IMO, this is a case complicating things by trying to be too clever.