My form contains a TIdSMTP, TIdMessage, TOpenDialog, SSL Handlers, and other visual components. I also have buttons for sending and attaching the different files.
procedure TForm1.Button1Click(Sender: TObject);
begin
email_connecter_TIdSMTP.Host := entered_host_TEdit.Text;
email_connecter_TIdSMTP.Username := entered_username_TEdit.Text;
email_connecter_TIdSMTP.Password := entered_password_TEdit.Text;
message_parts_TIdMessage.Clear();
message_parts_TIdMessage.Recipients.EMailAddresses := to_sender_email_TEdit.Text;
message_parts_TIdMessage.Subject := email_subject_TEdit.Text;
message_parts_TIdMessage.Body.Text := email_body_message_TMemo.Text;
email_connecter_TIdSMTP.Connect();
email_connecter_TIdSMTP.Send(message_parts_TIdMessage);
email_connecter_TIdSMTP.Disconnect();
end;
procedure TForm1.Button3Click(Sender: TObject);
var t:textfile;
s:string;
selected_file:string;
attatchment_message: TIdMessageBuilderHtml;
begin
selected_file := '';
try
attatchment_finder_TOpenDialog.InitialDir := 'C:\Documents';
attatchment_finder_TOpenDialog.Filter := 'All files (*.*)|*.*';
if attatchment_finder_TOpenDialog.Execute(Handle) then
selected_file := attatchment_finder_TOpenDialog.FileName;
if selected_file <>'' then
attatchment_message := TIdMessageBuilderHtml.Create;
attatchment_message.HtmlContentTransfer := 'quoted-printable';
memo_attachment_box_TMemo.Lines.Add(selected_file);
attatchment_message.Attachments.Add(selected_file);
attatchment_message.FillMessage(message_parts_TIdMessage);
finally
attatchment_finder_TOpenDialog.Free;
end;
end;
end.
What am I doing wrong when adding my selected file? How can I make it so that I can send any file type?
When I click send on my program it adds the file directory text to my memo box but it doesn't actually attach the file onto my TIdMessage component.
thank you!
The code you have shown clears the entire TIdMessage just before sending it, wiping out any attachments that Button3Click() may have added beforehand.
In fact, Button3Click() shouldn't be doing anything with the TIdMessage directly at all. That responsibility belongs solely in Button1Click() when it is populating the TIdMessage after clearing it.
Also, you are not using TIdMessageBuilderHtml correctly. You should be using its PlainText or HTML property (depending on what kind of text you are sending) instead of setting the TIdMessage.Body directly. Without that, FillMessage() doesn't set the TIdMessage.ContentType correctly. If you are sending plain text instead of HTML, you should be using TIdMessageBuilderPlain instead.
Try something more like this:
procedure TForm1.Button1Click(Sender: TObject);
var
email_builder: TIdMessageBuilderPlain;
I: integer;
begin
email_connecter_TIdSMTP.Host := entered_host_TEdit.Text;
email_connecter_TIdSMTP.Username := entered_username_TEdit.Text;
email_connecter_TIdSMTP.Password := entered_password_TEdit.Text;
message_parts_TIdMessage.Clear;
message_parts_TIdMessage.Recipients.EMailAddresses := to_sender_email_TEdit.Text;
message_parts_TIdMessage.Subject := email_subject_TEdit.Text;
email_builder := TIdMessageBuilderPlain.Create;
try
email_builder.PlainText.Assign(email_body_message_TMemo.Lines);
email_builder.PlainTextContentTransfer := 'quoted-printable';
for I := 0 to memo_attachment_box_TMemo.Lines.Count-1 do
email_builder.Attachments.Add(memo_attachment_box_TMemo.Lines[I]);
email_builder.FillMessage(message_parts_TIdMessage);
finally
email_builder.Free;
end;
email_connecter_TIdSMTP.Connect;
try
email_connecter_TIdSMTP.Send(message_parts_TIdMessage);
finally
email_connecter_TIdSMTP.Disconnect;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
attatchment_finder_TOpenDialog.InitialDir := 'C:\Documents';
attatchment_finder_TOpenDialog.Filter := 'All files (*.*)|*.*';
if attatchment_finder_TOpenDialog.Execute(Handle) then
begin
memo_attachment_box_TMemo.Lines.Add(attatchment_finder_TOpenDialog.FileName);
// or, if ofAllowMultiSelect is enabled:
// memo_attachment_box_TMemo.Lines.AddStrings(attatchment_finder_TOpenDialog.Files);
end;
end;
I have a TAction.OnExecute event handler triggered from my main form,
FormPrincipal, which opens other Forms.
procedure TFormPrincipal.AbreFormBancoExecute(Sender: TObject);
begin
Formbanco := Tformbanco.Create(self);
Formbanco.Parent := PanelCorpo;
Formbanco.Align := alclient;
Formbanco.BorderIcons := [];
Formbanco.Show;
Formbanco.BorderStyle := bsNone;
Formbanco.SetFocus;
end;
Once I'll have several forms, how to know which one is opened and how to close it, before triggering OnExecute to open another Form?
=========== Finally it is Working as I expected =======
The main form is form1 from which I call form2 and form3. In form1 I have a panel1 which is parent of form2 and form3. See form1 code :
...
var
Form1: TForm1;
implementation
{$R *.dfm}
uses unit2, unit3;
procedure Tform1.CloseActiveForm (Formname : string);
// Free memory allocated to the current form , set it to nil
// I'll have to find a better way to perform FreeanNil without
// use many IFs command
begin
if Formname = 'form2' then FreeAndnil(Form2) else
if Formname = 'form3' then FreeandNil(Form3);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CloseActiveForm(Edit1.Text); //Edit1 has the current active form name
if form2 = nil then
begin
Application.CreateForm(Tform2,Form2);
Form2.Parent := Panel1;
Form2.Align := alclient;
Form2.Show;
Form2.BorderStyle := bsnone;
Form2.SetFocus;
Form2.OnActivate(Sender); //Method Show blocks Activate event
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
CloseActiveForm(Edit1.Text); //Edit1 has the current active form name
if form3 = nil then
begin
Application.CreateForm(Tform3,Form3);
Form3.Parent := Panel1;
Form3.Align := alclient;
Form3.Show;
Form3.BorderStyle := bsnone;
Form3.SetFocus;
Form3.OnActivate(Sender); //Method Show blocks Activate event
end;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
Edit1.Text := Screen.ActiveForm.Name;
end;
end.
2) Code in form2 and form3 (consider form3 is identical)
...
var
Form2: TForm2;
implementation
{$R *.dfm}
uses unit1;
procedure TForm2.Button1Click(Sender: TObject);
begin
Edit2.Text := Screen.ActiveForm.Name;
end;
procedure TForm2.FormActivate(Sender: TObject);
begin
setfocus;
Edit1.Text := Form2.Name;
Form1.Edit1.Text := Form2.Name; //set form name
// the property Screen.ActiveForm.Name if used here, will always presents
// form1 name (main form) because this form2 is set to a parent panel
// in form1
end;
end.
Destroy the form if it exist and create a new instance of it.
procedure TFormPrincipal.AbreFormBancoExecute(Sender: TObject);
procedure CreateFormbanco;
begin
Formbanco := TFormbanco.Create(self);
Formbanco.Parent := PanelCorpo;
Formbanco.Align := alclient;
Formbanco.BorderIcons := [];
Formbanco.BorderStyle := bsNone;
Formbanco.Show;
Formbanco.SetFocus;
Formbanco.OnDestroy := FormDestroyEvent;
end;
begin
if not Assigned(Formbanco) then
begin
CreateFormbanco;
end
else
begin
Formbanco.Destroy;
CreateFormbanco;
end;
procedure TFormPrincipal.FormDestroyEvent(Sender: TObject);
begin
Formbanco := nil;
end;
This code will check if Formbanco existed, if so it will destroy it and create a new instance of it otherwise it will create a new one.
Edit: create different forms and use the code above, just change Formbanco and TFormbanco to their respected new form name.
Iam using Delphi 5 and Indy 10 recently downloaded from fulgan.
The access violation error occurres when the supplied credentials are incorrect. Authenticate function seems to produce the error.
It is also impossible to get past the access violation error, resulting in program shutting down without any warning.
Here is an example code:
procedure TForm1.Button2Click(Sender: TObject);
var IDSMTP1: TIdSMTP;
Idmessage1: TIDMessage;
IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
begin
IDSMTP1 := TIdSMTP.Create;
IdSSLIOHandlerSocketOpenSSL1 := TIdSSLIOHandlerSocketOpenSSL.Create;
try
with IDSMTP1 do begin
Host := 'smtp.gmail.com';
Port := 465;
Username := 'email#gmail.com';
Password := 'password';
AuthType := satDefault;
IdSSLIOHandlerSocketOpenSSL1.SSLOptions.SSLVersions := [sslvTLSv1];
IOHandler := IdSSLIOHandlerSocketOpenSSL1;
UseTLS := utUseRequireTLS;
end;
Idmessage1 := TIDMessage.Create;
try
with Idmessage1 do begin
Subject := 'test';
From.Address := 'email#gmail.com';
From.Name := 'testname';
Recipients.EMailAddresses := 'email#gmail.com';
end;
with IDSMTP1 do begin
if not Connected then
Connect;
try
Authenticate;
Send(IdMessage1);
except
end;
Disconnect;
end;
finally
Idmessage1.Free;
end;
finally
IDSMTP1.Free;
IdSSLIOHandlerSocketOpenSSL1.Free;
end;
end;
Thank you in advance.
I'm trying to update a manufacturer in Prestashop through the REST interface. So far I've been able to GET the information, but when I try to PUT, I Always get an HTTP 500 error.
try
Memo1.Text := '<prestashop><manufacturer><id><![CDATA[804]]></id><name><![CDATA[DisneyLand]]></name></manufacturer></prestashop>';
RESTRequest1.Params.Clear;
//authentication does not work with PUT, use token as suffix....
RESTClient1.Authenticator := nil; //SimpleAuthenticator1;//
//SimpleAuthenticator1.UserNameKey := 'ws_key';
//SimpleAuthenticator1.UserName := 'HEREIGOESTHETOKEN';
RESTRequest1.Resource := 'manufacturers';
RESTRequest1.ResourceSuffix := '?ws_key=HEREIGOESTHETOKEN';
RESTRequest1.Method := rmPut; //update
RESTClient1.BaseURL := 'http://localhost/prestashop/api';
RESTRequest1.Params.AddItem('id', '804' ,pkGETorPOST , [], ctTEXT_PLAIN);
RESTRequest1.Params.AddItem('putXml', Memo1.Text,
pkGETorPOST , [], ctAPPLICATION_X_WWW_FORM_URLENCODED);
RESTRequest1.Execute;
Memo1.Lines.Clear;
Memo1.Lines.Add(RESTResponse1.Content);
except
on E : Exception do
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('Exception class name = '+E.ClassName);
Memo1.Lines.Add('Exception message = '+E.Message);
end;
end;
I've tried the other TRESTRequestParameterKind posibilities, but no avail.
Anyone tried this before?
UPDATE : After monitoring my network with Wireshark, i noticed that if I use the TSimpleauthenticater component anywhere before, the xml is always appended with the ws_key value, resulting in a 500 server error. This happens even if I clear all the SimpleAuthenticator settings and set the Clients authenticator to nil.
I also had to set the content type to ctTEXT_XML iso ctAPPLICATION_X_WWW_FORM_URLENCODED when specifying th xml in the body.
Following code works :
procedure TForm1.BtnNewMfgClick(Sender: TObject); //new
var
aNode, aCNode, aCCNode : IXMLNode;
i,j : integer;
aXml : string;
begin
RESTRequest1.Params.Clear;
RESTClient1.Authenticator := nil;
SimpleAuthenticator1.UserNameKey := '';
SimpleAuthenticator1.UserName := '';
RESTClient1.BaseURL := 'http://localhost/prestashop/api';
RESTRequest1.Resource := 'manufacturers';
RESTRequest1.ResourceSuffix := '?schema=blank&ws_key=HEREGOESMYKEY';
RESTRequest1.Method := rmGet;
RESTRequest1.Execute;
aXml := RESTResponse1.Content;
XMLDocument1.LoadFromXML(aXml);
aNode := XMLDocument1.ChildNodes.FindNode('prestashop');
if assigned(aNode)
then begin
for i := 0 to aNode.ChildNodes.Count-1 do
begin
aCNode := aNode.ChildNodes.Get(i);
for j := 0 to aCNode.ChildNodes.Count-1 do
begin
aCCNode := aCNode.ChildNodes.Get(j);
if aCCNode.NodeName = 'id' then aCCNode.NodeValue := ''; //cannot pass id at create
if aCCNode.NodeName = 'active' then aCCNode.NodeValue := '1' ;
if aCCNode.NodeName = 'name' then aCCNode.NodeValue := 'New Brand';
end;
end;
end;
XmlDocument1.SaveToXML(aXml);
RESTRequest1.ClearBody;
RESTRequest1.AddBody(aXml, ctTEXT_XML);
RESTRequest1.ResourceSuffix := '?ws_key=HEREGOESMYKEY';
RESTRequest1.Method := rmPost;
RESTRequest1.Execute;
//new id is returned in the contents XML id tag
Memo1.Lines.Clear;
Memo1.Lines.Add(RESTResponse1.Content);
end;
Although this works in test, I'm investigating it further, because in production it has to work over https:// so the key is not exposed...
In short : Simpleauthenticator only works for GET and DELETE. Once used, PUT and POST will never work.
On the server side, text is entered into a memobox. This text is then sent to the Server side using this code:
var
ftmpstr :String;
buf :array[0..255] of char;
msize, nyites :dword;
i :Integer;
..
Command := Socket.ReceiveText;
if split(Command,'|', 0) = 'IBATCH' then
begin
ftmpstr := IBat.Memo1.Text;
nyites := 1;
msize := length(ftmpstr);
Server.Socket.Connections[ListView1.Selected.Index].SendText(IntToStr(msize));
while msize>255 do
begin
for i := 0 to 255 do
buf[i] := ftmpstr[nyites+i];
Server.Socket.Connections[Form1.ListView1.Selected.Index].SendBuf(buf,256);
dec(msize,256);
inc(nyites,256);
end;
if msize>0 then
begin
for i := 0 to msize-1 do
buf[i] := ftmpstr[nyites+i];
Server.Socket.Connections[Form1.ListView1.Selected.Index].SendBuf(buf,msize);
end;
end;
Code on the Server side:
Socket.SendText('IBATCH');
ftmpstr:='';
mbytesleft := strtoint(Socket.ReceiveText);
SetLength(ftmpstr,mbytesleft);
nyites:=1;
while mbytesleft>255 do
begin
Socket.ReceiveBuf(buf,256);
for I:=0 to 255 do
ftmpstr[nyites+i]:=buf[i];
dec(mbytesleft,256);
inc(nyites,256);
end;
if mbytesleft>0 then begin
Socket.ReceiveBuf(buf,mbytesleft);
for I:=0 to mbytesleft-1 do
ftmpstr[nyites+i]:=buf[i];
end;
nfile:=TempDir+IntToStr(GetTickCount)+'.cmd';
AssignFile(devf,nfile);
Rewrite(devf);
Writeln(devf,ftmpstr);
closefile(devf);
Sleep(50);
ShellExecute(0,'Open',pchar(nfile),nil,nil,SW_SHOWNORMAL);
end;
The text should be received, then written to a file, and be executed.
I did however find the code online and modify it to work with TServerSocket and TClientSocket components. I created a successful connection between the client and server, but the above code just doesn't want to work. Maybe someone with more expertise could help me get this working.
Any help would be greatly appreciated.
Your code has no structured protocol to it. TCP is a stream of raw bytes, and you are sending everything as strings (and not doing a very good job of it - no error handling, no partial send/receive handling, etc). You need to delimit your fields/messages from one another. Then the receiver can look for those delimiters. You would have to read everything from the socket into an intermediate buffer, checking the buffer for a message terminator, and then extract only completed messages and process them as needed.
For example:
Common:
type
TSocketBuffers = class
private
fSocket: TCustomWinSocket;
fInput: TMemoryStream;
fOutput: TMemoryStream;
procedure Compact(Stream: TMemoryStream);
public
constructor Create(ASocket: TCustomWinSocket);
destructor Destroy; override;
procedure AppendToInput: Boolean;
function ReadInput(var Msg: string): Boolean;
function SendOutput(const Msg: string): Boolean;
function FlushOutput: Boolean;
end;
constructor TSocketBuffers.Create(ASocket: TCustomWinSocket);
begin
inherited Create;
fSocket := ASocket;
fInput := TMemoryStream.Create;
fOutput := TMemoryStream.Create;
end;
destructor TSocketBuffers.Destroy;
begin
fInput.Free;
fOutput.Free;
inherited;
end;
procedure TSocketBuffers.Compact(Stream: TMemoryStream);
begin
if Stream.Position < Stream.Size then
begin
Move(Pointer(Longint(Stream.Memory) + Stream.Position)^, Stream.Memory^, Stream.Size - Stream.Position);
Stream.Size := Stream.Position;
Stream.Position := 0;
end else begin
Stream.Clear;
end;
end;
function TSocketBuffers.AppendToInput: Boolean;
var
buf: array[0..255] of Byte;
nBuf: Integer;
begin
nBuf := fSocket.ReceiveBuf(buf[0], sizeof(buf));
if nBuf > 0 then
begin
fInput.Seek(0, soEnd);
fInput.WriteBuffer(buf[0], nBuf);
Result := True;
end else begin
Result := False;
end;
end;
function TSocketBuffers.ReadInput(var Msg: string): Boolean;
var
b: Byte;
tmp: string;
needed: Integer;
begin
Result := False;
Msg := '';
fInput.Position := 0;
while fInput.Position < fInput.Size do
begin
fInput.ReadBuffer(b, 1);
if b = Ord('|') then
begin
SetString(tmp, PAnsiChar(fInput.Memory), fInput.Position-1);
needed := StrToInt(tmp);
if needed > 0 then
begin
if (fInput.Size - fInput.Position) < Int64(needed) then
Exit;
SetLength(Msg, needed);
fInput.ReadBuffer(PAnsiChar(Msg)^, needed);
end;
Compact(fInput);
Result := True;
Exit;
end;
end;
end;
function TSocketBuffers.SendOutput(const Msg: string): Boolean;
var
tmp: AnsiString;
nSent: Integer;
begin
Result := True;
tmp := IntToStr(Length(Msg)) + '|' + Msg;
if fOutput.Size = 0 then
begin
repeat
nSent := fSocket.SendBuf(PAnsiChar(tmp)^, Length(tmp));
if nSent < 0 then
begin
if WSAGetLastError() <> WSAEWOULDBLOCK then
begin
Result := True;
Exit;
end;
Break;
end;
Delete(tmp, 1, nSent);
until tmp = '';
end;
if tmp <> '' then
begin
fOutput.Seek(0, soEnd);
fOutput.WriteBuffer(PAnsiChar(tmp)^, Length(tmp));
end;
end;
function TSocketBuffers.FlushOutput: Boolean;
var
buf: array[0..255] of Byte;
nBuf, nSent: Integer;
begin
Result := True;
fOutput.Position := 0;
while fOutput.Position < fOutput.Size do
begin
nBuf := fOutput.Read(buf[0], sizeof(buf));
nSent := fSocket.SendBuf(buf[0], nBuf);
if nSent < 0 then
begin
if WSAGetLastError() <> WSAEWOULDBLOCK then
begin
fOutput.Seek(-nBuf, soCurrent);
Result := False;
end;
Break;
end;
end;
if fOutput.Position > 0 then
Compact(fOutput);
end;
Server:
procedure TForm1.ServerSocketConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Socket.Data := TSocketBuffers.Create(Socket);
end;
procedure TForm1.ServerSocketDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
TSocketBuffers(Socket.Data).Free;
end;
procedure TForm1.ServerSocketRead(Sender: TObject; Socket: TCustomWinSocket);
var
bufs: TSocketBuffers;
Command: string;
begin
bufs := TSocketBuffers(Socket.Data);
if not bufs.AppendToInput then Exit;
while bufs.ReadInput(Command) do
begin
if split(Command, '|', 0) = 'IBATCH' then
bufs.SendOutput(IBat.Memo1.Text);
end;
end;
procedure TForm1.ServerSocketWrite(Sender: TObject; Socket: TCustomWinSocket);
begin
TSocketBuffers(Socket.Data).FlushOutput;
end;
Client:
bufs := TSocketBuffers.Create(Client.Socket);
...
// this is assuming TClientSocekt is set to blocking mode
// otherwise you have to use the OnRead and OnWrite events...
if bufs.SendOutput('IBATCH') then
begin
while bufs.AppendToInput do
begin
if bufs.ReadInput(ftmpstr) then
begin
nfile := TempDir+IntToStr(GetTickCount) + '.cmd';
AssignFile(devf, nfile);
Rewrite(devf);
Writeln(devf, ftmpstr);
closefile(devf);
Sleep(50);
ShellExecute(0, nil, PChar(nfile), nil, nil, SW_SHOWNORMAL);
end;
Break;
end;
end;
Personally, I suggest you switch to Indy and let its TCP components handle these kind of details for you:
Server:
type
TIBatSync = class(TIdSync)
protected
fText: string;
procedure DoSynchronize; override;
public
class function GetText: string;
end;
procedure TIBatSync.DoSynchronize;
begin
fText := Form1.IBat.Memo1.Text;
end;
class function TIBatSync.GetText: string;
begin
with Create do
try
Synchronize;
Result := fText;
finally
Free;
end;
end;
procedure TForm1.IdTCPServerExecue(AContext: TIdContext);
var
Command, tmp: string;
begin
tmp := AContext.Connection.IOHandler.ReadLn('|');
Command := AContext.Connection.IOHandler.ReadString(StrToInt(tmp));
if split(Command, '|', 0) = 'IBATCH' then
begin
tmp := TIBatSync.GetText;
AContext.Connection.IOHandler.Write(Length(tmp) + '|' + tmp);
end;
end;
Client:
Client.IOHandler.Write('6|IBATCH');
ftmpstr := Client.IOHandler.ReadLn('|');
ftmpstr := Client.IOHandler.ReadString(StrToInt(ftmpstr));
nfile := TempDir+IntToStr(GetTickCount) + '.cmd';
AssignFile(devf, nfile);
Rewrite(devf);
Writeln(devf, ftmpstr);
closefile(devf);
Sleep(50);
ShellExecute(0, nil, PChar(nfile), nil, nil, SW_SHOWNORMAL);