Can TNEF be avoided using MAPI? - delphi

I am using this code to send emails through MAPI using Delphi.
A few users who use Microsoft mailing software report that the receipants receive emails with an attachment WinMail.dat. I know that this is an issue with Microsoft Exchange/Outlook and can be corrected by disabling RTF/TNEF. (I don't know for sure because I do not use Microsoft mailing software).
My question is, if I can tell the mailing software to not use TNEF using the MAPI.
function SendEMailUsingMAPI(const Subject, Body, FileName, SenderName, SenderEMail, RecipientName, RecipientEMail: string): Integer;
var
Message: TMapiMessage;
lpSender, lpRecipient: TMapiRecipDesc;
FileAttach: TMapiFileDesc;
SM: TFNMapiSendMail;
MAPIModule: HModule;
FileType: TMapiFileTagExt;
begin
// Source: http://www.stackoverflow.com/questions/1234623/how-to-send-a-mapi-email-with-an-attachment-to-a-fax-recipient
// Modified
FillChar(Message,SizeOf(Message),0);
if (Subject <> '') then begin
Message.lpszSubject := PChar(Subject);
end;
if (Body <> '') then begin
Message.lpszNoteText := PChar(Body);
end;
if (SenderEmail <> '') then
begin
lpSender.ulRecipClass := MAPI_ORIG;
if (SenderName = '') then begin
lpSender.lpszName := PChar(SenderEMail);
end
else begin
lpSender.lpszName := PChar(SenderName);
end;
lpSender.lpszAddress := PChar('smtp:'+SenderEmail);
lpSender.ulReserved := 0;
lpSender.ulEIDSize := 0;
lpSender.lpEntryID := nil;
Message.lpOriginator := #lpSender;
end;
if (RecipientEmail <> '') then
begin
lpRecipient.ulRecipClass := MAPI_TO;
if (RecipientName = '') then begin
lpRecipient.lpszName := PChar(RecipientEMail);
end
else begin
lpRecipient.lpszName := PChar(RecipientName);
end;
lpRecipient.lpszAddress := PChar('smtp:'+RecipientEmail);
lpRecipient.ulReserved := 0;
lpRecipient.ulEIDSize := 0;
lpRecipient.lpEntryID := nil;
Message.nRecipCount := 1;
Message.lpRecips := #lpRecipient;
end
else begin
Message.lpRecips := nil;
end;
if (FileName = '') then begin
Message.nFileCount := 0;
Message.lpFiles := nil;
end
else begin
FillChar(FileAttach,SizeOf(FileAttach),0);
FileAttach.nPosition := Cardinal($FFFFFFFF);
FileAttach.lpszPathName := PChar(FileName);
FileType.ulReserved := 0;
FileType.cbEncoding := 0;
FileType.cbTag := 0;
FileType.lpTag := nil;
FileType.lpEncoding := nil;
FileAttach.lpFileType := #FileType;
Message.nFileCount := 1;
Message.lpFiles := #FileAttach;
end;
MAPIModule := LoadLibrary(PChar(MAPIDLL));
if MAPIModule = 0 then begin
Result := -1;
end
else begin
try
#SM := GetProcAddress(MAPIModule,'MAPISendMail');
if #SM <> nil then begin
Result := SM(0,Application.Handle,Message,
MAPI_DIALOG or MAPI_LOGON_UI,0);
end
else begin
Result := 1;
end;
finally
FreeLibrary(MAPIModule);
end;
end;
if Result <> 0 then begin
raise Exception.CreateFmt('Error sending eMail (%d)', [Result]);
end;
end;

Not in Simple MAPI. If you were using Outlook Object Model or Extended MAPI, you could set a special MAPI property on the message before sending it to disable TNEF format.

Related

The outlook send dialog doesn't show

I have a delphi 6 application wich uses mapi to open the outlook send dialog
with attachment.
This works on my PC and also on other clients PC.
I have now 2 clients where the send dialog isn't opening. I don't even get a
Error message. The clients have a W7 PC and outlook 2013.
I've tried Fixmapi, but this doesn't help.
Outlook is working fine and Via explorer the send dialogue is working fine.
I just tried MAPI and it worked for me, with thunderbird, and outlook 2013.
I did get a FIXMAPI dialog and then I got the new outlook email window, same as ever.
If you have a problem only on specific machines, then that's not a programming question, it's a windows question. Be sure to use the Control Panel to look at what default programs you have selected, including which is the default MAPI mail program.
program MapiSample;
uses
{Vcl.}Forms,
Windows,
SysUtils,
{Vcl.}Dialogs,
{WinApi.}MAPI;
type
LPSTR = PAnsiChar;
PSTR = PChar;
function SendMailMAPI(const Subject, Body, FileName, SenderName, SenderEMail,
RecepientName, RecepientEMail: AnsiString) : Integer;
var
message: TMapiMessage;
lpSender,
lpRecepient: TMapiRecipDesc;
FileAttach: TMapiFileDesc;
SM: TFNMapiSendMail;
MAPIModule: HModule;
begin
FillChar(message, SizeOf(message), 0);
with message do
begin
if (Subject<>'') then
begin
lpszSubject := LPSTR(Subject)
end;
if (Body<>'') then
begin
lpszNoteText := LPSTR(Body)
end;
if (SenderEMail<>'') then
begin
lpSender.ulRecipClass := MAPI_ORIG;
if (SenderName='') then
begin
lpSender.lpszName := LPSTR(SenderEMail)
end
else
begin
lpSender.lpszName := LPSTR(SenderName)
end;
lpSender.lpszAddress := LPSTR('SMTP:'+SenderEMail);
lpSender.ulReserved := 0;
lpSender.ulEIDSize := 0;
lpSender.lpEntryID := nil;
lpOriginator := #lpSender;
end;
if (RecepientEMail<>'') then
begin
lpRecepient.ulRecipClass := MAPI_TO;
if (RecepientName='') then
begin
lpRecepient.lpszName := LPSTR(RecepientEMail)
end
else
begin
lpRecepient.lpszName := LPSTR(RecepientName)
end;
lpRecepient.lpszAddress := LPSTR('SMTP:'+RecepientEMail);
lpRecepient.ulReserved := 0;
lpRecepient.ulEIDSize := 0;
lpRecepient.lpEntryID := nil;
nRecipCount := 1;
lpRecips := #lpRecepient;
end
else
begin
lpRecips := nil
end;
if (FileName='') then
begin
nFileCount := 0;
lpFiles := nil;
end
else
begin
FillChar(FileAttach, SizeOf(FileAttach), 0);
FileAttach.nPosition := Cardinal($FFFFFFFF);
FileAttach.lpszPathName := LPSTR(FileName);
nFileCount := 1;
lpFiles := #FileAttach;
end;
end;
MAPIModule := LoadLibrary(PSTR(MAPIDLL));
if MAPIModule=0 then
begin
Result := -1
end
else
begin
try
#SM := GetProcAddress(MAPIModule, 'MAPISendMail');
if #SM<>nil then
begin
Result := SM(0, Application.Handle, message, MAPI_DIALOG or
MAPI_LOGON_UI, 0);
end
else
begin
Result := 1
end;
finally
FreeLibrary(MAPIModule);
end;
end;
if Result<>0 then
begin
MessageDlg('Error sending mail ('+IntToStr(Result)+').', mtError, [mbOk],
0)
end;
end;
begin
SendMailMapi('test','test','','My Name', 'sender#sender.com', 'Your Name', 'receiver#something.com');
end.

Access violation at form display in deserialization in Delphi

I wrote the following code by serialization and a deserialization of forms and their contents to Delphi
unit SerAndDeser;
interface
uses Classes,MainForm,ListOfTables,DataOfTable,SerialForms,sysutils,ActiveX, DatabaseClasses, UnloadProcs;
procedure Ser();
procedure Deser();
function GetGUID(): string;
function DeleteSymbols(inputstr : string) : string;
implementation
function GetGUID(): string;
var
GUID : TGUID;
begin
Result := '';
if CoCreateGuid(GUID) = 0 then
Result := GUIDToString(GUID);
Result := StringReplace(Result, '{', '', []);
Result := StringReplace(Result, '}', '', []);
Result := StringReplace(Result, '-', '', [rfReplaceAll]);
end;
function DeleteSymbols(inputstr : string): string;
begin
Result := '';
Result := StringReplace(inputstr, '-', '', [rfReplaceAll]);
Result := StringReplace(Result, ' ', '', [rfReplaceAll]);
Result := StringReplace(Result, '\', '', [rfReplaceAll]);
Result := StringReplace(Result, '/', '', [rfReplaceAll]);
end;
procedure Ser();
var mForm : MainFormInfo;
tForm : TableFormInfo;
lForm : ListFormInfo;
tempFmtable : TfmTableData;
i,j : integer;
MyFileStream : TFileStream;
MyMemoryStream : TMemoryStream;
field : TableFieldInfo;
begin
try
mForm := nil;
mForm := MainFormInfo.Create(
nil,
MainWindow.Left,
MainWindow.Top,
MainWindow.Height,
MainWindow.Width,
MainWindow.partofconnectstring,
MainWindow.dbname,
MainWindow.dbfilename);
mForm.Name := 'MainWindow';
//table forms
try
tForm := nil;
field := nil;
for i := 0 to MainWindow.ComponentCount - 1 do
if (MainWindow.Components[i] is TfmTableData) then
begin
tempFmtable := MainWindow.Components[i] as TfmTableData;
tForm := TableFormInfo.Create(
mForm,
tempFmtable.Left,
tempFmtable.Top,
tempFmtable.Height,
tempFmtable.Width,
tempFmtable.tname);
tForm.Name := tempFmtable.Name;
//fields
for j := 0 to tempFmtable.DBGrid1.Columns.Count - 1 do
begin
field := nil;
field := TableFieldInfo.Create(
tForm,
tempFmtable.DBGrid1.Columns[j].FieldName,
tempFmtable.DBGrid1.Columns[j].Title.Caption,
tempFmtable.DBGrid1.Columns[j].Index,
tempFmtable.DBGrid1.Columns[j].Visible);
field.Name := DeleteSymbols(tempFmtable.DBGrid1.Columns[j].FieldName);{tempFmtable.DBGrid1.Columns[j].FieldName} {+ GetGUID;}
end;
//
end;
except
field.Free;
tForm.Free;
end;
//
//List form
try
lForm := nil;
lForm := ListFormInfo.Create(
mForm,
fmListOfTables.Left,
fmListOfTables.Top,
fmListOfTables.Height,
fmListOfTables.Width);
lForm.Name := 'fmListOfTables';
except
lForm.Free;
end;
//
//save
MyFileStream := nil;
MyMemoryStream := nil;
MyFileStream := TFileStream.Create('test.txt', fmCreate);
MyMemoryStream := TMemoryStream.Create;
MyMemoryStream.WriteComponent(mForm);
MyMemoryStream.Position := 0;
ObjectBinaryToText(MyMemoryStream,MyFileStream);
MainWindow.Panel1.DockManager.SaveToStream(MyFileStream);
//
finally
mForm.Free;
MyFileStream.Free;
MyMemoryStream.Free;
end;
end;
procedure Deser();
var mForm : MainFormInfo;
tForm : TableFormInfo;
lForm : ListFormInfo;
tempFmtable : TfmTableData;
i,j : integer;
MyFileStream : TFileStream;
MyMemoryStream : TMemoryStream;
table : TTableSpec;
descr : string;
field : TableFieldInfo;
begin
try
//destroy environment
i := 0;
while (i <= MainWindow.ComponentCount - 1) do
begin
if MainWindow.Components[i] is TfmTableData then
try
tempFmTable := nil;
tempFmTable := MainWindow.Components[i] as TfmTableData;
tempFmTable.IBQuery1.Close;
tempFmtable.Free;
except
tempFmTable.Free;
end
else
inc(i);
end;
fmListOfTables.Free;
DBSchema.Free;
//
//read
mForm := nil;
MyFileStream := nil;
MyMemoryStream := nil;
mForm := MainFormInfo.Create(nil, -1, -1, -1, -1, MainWindow.partofconnectstring, MainWindow.dbname, MainWindow.dbfilename);
MyFileStream := TFileStream.Create('test.txt', fmOpenRead);
MyMemoryStream := TMemoryStream.Create;
ObjectTextToBinary(MyFileStream,MyMemoryStream);
MyMemoryStream.Position := 0;
MyMemoryStream.ReadComponent(mForm);
//
//go
UnloadProcs.ConnectToDatabase(MainWindow.partofconnectstring, MainWindow.SQLConnection1);
//UnloadProcs.CreateObjs(MainWindow.SQLConnection1, MainForm.DBSchema);
//fmListOfTables.Show;
MainWindow.Left := mForm.LeftValue;
MainWindow.Top := mForm.TopValue;
MainWindow.Height := mForm.HeightValue;
MainWindow.Width := mForm.WidthValue;
//list
i := 0;
while i <= mForm.ComponentCount - 1 do
begin
if mForm.Components[i] is ListFormInfo then
try
lForm := nil;
lForm := mForm.Components[i] as ListFormInfo;
fmListOfTables.Left := lForm.LeftValue;
fmListOfTables.Top := lForm.TopValue;
fmListOfTables.Height := lForm.HeightValue;
fmListOfTables.Width := lForm.WidthValue;
fmListOfTables.Show;
inc(i);
finally
lForm.Free;
end
else
inc(i);
end;
//
//fmListOfTables.Show;
//tables
for j := 0 to mForm.ComponentCount - 1 do
if mForm.Components[j] is TableFormInfo then
try
table := nil;
tempFmtable := nil;
tForm := nil;
tForm := mForm.Components[j] as TableFormInfo;
table := TTableSpec(DBSchema.Tables.FindComponent(tForm.Table));
tempFmtable := TfmTableData.Create(MainWindow);
tempFmtable.Name := tForm.Name;
tempFmtable.tname := tForm.Table;
//tempFmtable.Caption := Utf8ToAnsi(table.Description);
tempFmtable.Left := tForm.LeftValue;
tempFmtable.Top := tForm.TopValue;
tempFmtable.Height := tForm.HeightValue;
tempFmtable.Width := tForm.WidthValue;
tempFmtable.IBQuery1.SQL.Add('select * from ' + table.Name);
tempFmtable.IBQuery1.Open;
i := 0;
while i <= tForm.ComponentCount - 1 do
if tForm.Components[i] is TableFieldInfo then
begin
field := nil;
field := tForm.Components[i] as TableFieldInfo;
tempFmtable.DBGrid1.Columns[i].FieldName := field.FieldNameValue;
tempFmtable.DBGrid1.Columns[i].Title.Caption := field.DescriptionValue;
tempFmtable.DBGrid1.Columns[i].Index := field.IndexValue;
tempFmtable.DBGrid1.Columns[i].Visible := field.VisibleValue;
//tempFmtable.CheckListBox1.Items.Add(field.Description);
//tempFmtable.CheckListBox1.Checked[i] := field.Visible;
inc(i);
end
else
inc(i);
{for i := 0 to table.Fields.ComponentCount - 1 do
begin
descr := Utf8ToAnsi(((table.Fields.Components[i]) as TFieldSpec).Description);
tempFmtable.CheckListBox1.Items.Add(descr);
tempFmtable.DBGrid1.Columns[i].Title.Caption := descr;
tempFmtable.CheckListBox1.Checked[i] := true;
end; }
tempFmtable.Show;
except
tempFmtable.Free;
tForm.Free;
table.Free;
end;
//
//dock
MainWindow.Panel1.DockManager.BeginUpdate;
MainWindow.Panel1.DockManager.LoadFromStream(MyFileStream);
MainWindow.Panel1.DockManager.ResetBounds(TRUE);
MainWindow.Panel1.DockManager.EndUpdate;
//
finally
MyFileStream.Free;
MyMemoryStream.Free;
end;
end;
end.
When debugging I found out that gives out 'access violation at address' exception at line
fmListOfTables.Show;
in the following block of a code from a code is higher
i := 0;
while i <= mForm.ComponentCount - 1 do
begin
if mForm.Components[i] is ListFormInfo then
try
lForm := nil;
lForm := mForm.Components[i] as ListFormInfo;
fmListOfTables.Left := lForm.LeftValue;
fmListOfTables.Top := lForm.TopValue;
fmListOfTables.Height := lForm.HeightValue;
fmListOfTables.Width := lForm.WidthValue;
fmListOfTables.Show;
inc(i);
finally
lForm.Free;
end
else
inc(i);
end;
After exception origin the line of illumination moves for the line
function TCustomForm.IsFormSizeStored: Boolean;
begin
Result := AutoScroll or (HorzScrollBar.Range <> 0) or (VertScrollBar.Range <> 0);
end;
from the module in Vcl.Forms. Help to eliminate an error.
You have this line of code:
fmListOfTables.Free;
followed by this:
fmListOfTables.Left := lForm.LeftValue;
fmListOfTables.Top := lForm.TopValue;
fmListOfTables.Height := lForm.HeightValue;
fmListOfTables.Width := lForm.WidthValue;
fmListOfTables.Show;
And in between you do not assign anything to fmListOfTables.
What this means is that fmListOfTables does not refer to a valid object. And so you can expect runtime errors.

Access violation at sql query in deserialization in Delphi

I wrote the following code by serialization and a deserialization of forms and their contents to Delphi
unit SerAndDeser;
interface
uses Classes,MainForm,ListOfTables,DataOfTable,SerialForms,sysutils,ActiveX, DatabaseClasses, UnloadProcs;
procedure Ser();
procedure Deser();
function GetGUID(): string;
function DeleteSymbols(inputstr : string) : string;
implementation
function GetGUID(): string;
var
GUID : TGUID;
begin
Result := '';
if CoCreateGuid(GUID) = 0 then
Result := GUIDToString(GUID);
Result := StringReplace(Result, '{', '', []);
Result := StringReplace(Result, '}', '', []);
Result := StringReplace(Result, '-', '', [rfReplaceAll]);
end;
function DeleteSymbols(inputstr : string): string;
begin
Result := '';
Result := StringReplace(inputstr, '-', '', [rfReplaceAll]);
Result := StringReplace(Result, ' ', '', [rfReplaceAll]);
Result := StringReplace(Result, '\', '', [rfReplaceAll]);
Result := StringReplace(Result, '/', '', [rfReplaceAll]);
end;
procedure Ser();
var mForm : MainFormInfo;
tForm : TableFormInfo;
lForm : ListFormInfo;
tempFmtable : TfmTableData;
i,j : integer;
MyFileStream : TFileStream;
MyMemoryStream : TMemoryStream;
field : TableFieldInfo;
begin
try
mForm := nil;
mForm := MainFormInfo.Create(
nil,
MainWindow.Left,
MainWindow.Top,
MainWindow.Height,
MainWindow.Width,
MainWindow.partofconnectstring,
MainWindow.dbname,
MainWindow.dbfilename);
mForm.Name := 'MainWindow';
//table forms
try
tForm := nil;
field := nil;
for i := 0 to MainWindow.ComponentCount - 1 do
if (MainWindow.Components[i] is TfmTableData) then
begin
tempFmtable := MainWindow.Components[i] as TfmTableData;
tForm := TableFormInfo.Create(
mForm,
tempFmtable.Left,
tempFmtable.Top,
tempFmtable.Height,
tempFmtable.Width,
tempFmtable.tname);
tForm.Name := tempFmtable.Name;
//fields
for j := 0 to tempFmtable.DBGrid1.Columns.Count - 1 do
begin
field := nil;
field := TableFieldInfo.Create(
tForm,
tempFmtable.DBGrid1.Columns[j].FieldName,
tempFmtable.DBGrid1.Columns[j].Title.Caption,
tempFmtable.DBGrid1.Columns[j].Index,
tempFmtable.DBGrid1.Columns[j].Visible);
field.Name := DeleteSymbols(tempFmtable.DBGrid1.Columns[j].FieldName);{tempFmtable.DBGrid1.Columns[j].FieldName} {+ GetGUID;}
end;
//
end;
except
field.Free;
tForm.Free;
end;
//
//List form
try
lForm := nil;
lForm := ListFormInfo.Create(
mForm,
fmListOfTables.Left,
fmListOfTables.Top,
fmListOfTables.Height,
fmListOfTables.Width);
lForm.Name := 'fmListOfTables';
except
lForm.Free;
end;
//
//save
MyFileStream := nil;
MyMemoryStream := nil;
MyFileStream := TFileStream.Create('test.txt', fmCreate);
MyMemoryStream := TMemoryStream.Create;
MyMemoryStream.WriteComponent(mForm);
MyMemoryStream.Position := 0;
ObjectBinaryToText(MyMemoryStream,MyFileStream);
MainWindow.Panel1.DockManager.SaveToStream(MyFileStream);
//
finally
mForm.Free;
MyFileStream.Free;
MyMemoryStream.Free;
end;
end;
procedure Deser();
var mForm : MainFormInfo;
tForm : TableFormInfo;
lForm : ListFormInfo;
tempFmtable : TfmTableData;
i,j : integer;
MyFileStream : TFileStream;
MyMemoryStream : TMemoryStream;
table : TTableSpec;
descr : string;
field : TableFieldInfo;
begin
try
//destroy environment
i := 0;
while (i <= MainWindow.ComponentCount - 1) do
begin
if MainWindow.Components[i] is TfmTableData then
try
tempFmTable := nil;
tempFmTable := MainWindow.Components[i] as TfmTableData;
tempFmTable.IBQuery1.Close;
tempFmtable.Free;
except
tempFmTable.Free;
end
else
inc(i);
end;
fmListOfTables.Free;
DBSchema.Free;
//
//read
mForm := nil;
MyFileStream := nil;
MyMemoryStream := nil;
mForm := MainFormInfo.Create(nil, -1, -1, -1, -1, MainWindow.partofconnectstring, MainWindow.dbname, MainWindow.dbfilename);
MyFileStream := TFileStream.Create('test.txt', fmOpenRead);
MyMemoryStream := TMemoryStream.Create;
ObjectTextToBinary(MyFileStream,MyMemoryStream);
MyMemoryStream.Position := 0;
MyMemoryStream.ReadComponent(mForm);
//
//go
UnloadProcs.ConnectToDatabase(MainWindow.partofconnectstring, MainWindow.SQLConnection1);
//UnloadProcs.CreateObjs(MainWindow.SQLConnection1, MainForm.DBSchema);
//fmListOfTables.Show;
MainWindow.Left := mForm.LeftValue;
MainWindow.Top := mForm.TopValue;
MainWindow.Height := mForm.HeightValue;
MainWindow.Width := mForm.WidthValue;
//list
i := 0;
while i <= mForm.ComponentCount - 1 do
begin
if mForm.Components[i] is ListFormInfo then
try
lForm := nil;
lForm := mForm.Components[i] as ListFormInfo;
fmListOfTables.Left := lForm.LeftValue;
fmListOfTables.Top := lForm.TopValue;
fmListOfTables.Height := lForm.HeightValue;
fmListOfTables.Width := lForm.WidthValue;
fmListOfTables.Show;
inc(i);
finally
lForm.Free;
end
else
inc(i);
end;
//
//fmListOfTables.Show;
//tables
for j := 0 to mForm.ComponentCount - 1 do
if mForm.Components[j] is TableFormInfo then
try
table := nil;
tempFmtable := nil;
tForm := nil;
tForm := mForm.Components[j] as TableFormInfo;
table := TTableSpec(DBSchema.Tables.FindComponent(tForm.Table));
tempFmtable := TfmTableData.Create(MainWindow);
tempFmtable.Name := tForm.Name;
tempFmtable.tname := tForm.Table;
//tempFmtable.Caption := Utf8ToAnsi(table.Description);
tempFmtable.Left := tForm.LeftValue;
tempFmtable.Top := tForm.TopValue;
tempFmtable.Height := tForm.HeightValue;
tempFmtable.Width := tForm.WidthValue;
tempFmTable.IBQuery1.SQL.Clear;
tempFmtable.IBQuery1.SQL.Add('select * from ' + table.Name);
tempFmtable.IBQuery1.Open;
i := 0;
while i <= tForm.ComponentCount - 1 do
if tForm.Components[i] is TableFieldInfo then
begin
field := nil;
field := tForm.Components[i] as TableFieldInfo;
tempFmtable.DBGrid1.Columns[i].FieldName := field.FieldNameValue;
tempFmtable.DBGrid1.Columns[i].Title.Caption := field.DescriptionValue;
tempFmtable.DBGrid1.Columns[i].Index := field.IndexValue;
tempFmtable.DBGrid1.Columns[i].Visible := field.VisibleValue;
//tempFmtable.CheckListBox1.Items.Add(field.Description);
//tempFmtable.CheckListBox1.Checked[i] := field.Visible;
inc(i);
end
else
inc(i);
{for i := 0 to table.Fields.ComponentCount - 1 do
begin
descr := Utf8ToAnsi(((table.Fields.Components[i]) as TFieldSpec).Description);
tempFmtable.CheckListBox1.Items.Add(descr);
tempFmtable.DBGrid1.Columns[i].Title.Caption := descr;
tempFmtable.CheckListBox1.Checked[i] := true;
end; }
tempFmtable.Show;
except
tempFmtable.Free;
tForm.Free;
table.Free;
end;
//
//dock
MainWindow.Panel1.DockManager.BeginUpdate;
MainWindow.Panel1.DockManager.LoadFromStream(MyFileStream);
MainWindow.Panel1.DockManager.ResetBounds(TRUE);
MainWindow.Panel1.DockManager.EndUpdate;
//
finally
MyFileStream.Free;
MyMemoryStream.Free;
end;
end;
end.
When debugging I found out that gives out
'Project GUI.exe raised exception class $C0000005 with message 'access violation at 0x00821dae: read of address 0x00000044'.
exception at line
tempFmtable.IBQuery1.SQL.Add('select * from ' + table.Name);
in the following block of a code from a code is higher
//tables
for j := 0 to mForm.ComponentCount - 1 do
if mForm.Components[j] is TableFormInfo then
try
table := nil;
tempFmtable := nil;
tForm := nil;
tForm := mForm.Components[j] as TableFormInfo;
table := TTableSpec(DBSchema.Tables.FindComponent(tForm.Table));
tempFmtable := TfmTableData.Create(MainWindow);
tempFmtable.Name := tForm.Name;
tempFmtable.tname := tForm.Table;
//tempFmtable.Caption := Utf8ToAnsi(table.Description);
tempFmtable.Left := tForm.LeftValue;
tempFmtable.Top := tForm.TopValue;
tempFmtable.Height := tForm.HeightValue;
tempFmtable.Width := tForm.WidthValue;
tempFmTable.IBQuery1.SQL.Clear;
tempFmtable.IBQuery1.SQL.Add('select * from ' + table.Name);
tempFmtable.IBQuery1.Open;
i := 0;
while i <= tForm.ComponentCount - 1 do
if tForm.Components[i] is TableFieldInfo then
begin
field := nil;
//tempFmtable.Show;
field := tForm.Components[i] as TableFieldInfo;
tempFmtable.DBGrid1.Columns[i].FieldName := field.FieldNameValue;
tempFmtable.DBGrid1.Columns[i].Title.Caption := field.DescriptionValue;
tempFmtable.DBGrid1.Columns[i].Index := field.IndexValue;
tempFmtable.DBGrid1.Columns[i].Visible := field.VisibleValue;
//tempFmtable.CheckListBox1.Items.Add(field.Description);
//tempFmtable.CheckListBox1.Checked[i] := field.Visible;
//tempFmtable.Show;
inc(i);
end
else
inc(i);
{for i := 0 to table.Fields.ComponentCount - 1 do
begin
descr := Utf8ToAnsi(((table.Fields.Components[i]) as TFieldSpec).Description);
tempFmtable.CheckListBox1.Items.Add(descr);
tempFmtable.DBGrid1.Columns[i].Title.Caption := descr;
tempFmtable.CheckListBox1.Checked[i] := true;
end; }
tempFmtable.Show;
except
tempFmtable.Free;
tForm.Free;
table.Free;
end;
The line that fails is:
tempFmtable.IBQuery1.SQL.Add('select * from ' + table.Name);
Before this line runs you assigned table like this:
table := TTableSpec(DBSchema.Tables.FindComponent(tForm.Table));
It would seem that FindComponent returned nil.
As I'm sure you know, you have to have a valid object instance in order to call methods, access fields and properties etc. Your code should check for this condition and respond accordingly.
You can see all this quite readily in the debugger. The debugger will break on that line and when you inspect the variables it will tell you that table is nil. Then you have to look at the code and work out why. I recommend that you spend some time improving your debugging skills and learning how to use the tools available.

Why does SendMailMAPI rename file attachments to shorter ones?

I use the following emailing function with Eudora. For some reason the attachment file name is renamed to be something else. How can I make sure the attachment file name remains intact?
function SendMailMAPI(const Subject, Body, FileName, SenderName, SenderEMail,
RecepientName, RecepientEMail: String) : Integer;
var
message: TMapiMessage;
lpSender,
lpRecepient: TMapiRecipDesc;
FileAttach: TMapiFileDesc;
SM: TFNMapiSendMail;
MAPIModule: HModule;
begin
FillChar(message, SizeOf(message), 0);
with message do
begin
if (Subject<>'') then
begin
lpszSubject := PChar(Subject)
end;
if (Body<>'') then
begin
lpszNoteText := PChar(Body)
end;
if (SenderEMail<>'') then
begin
lpSender.ulRecipClass := MAPI_ORIG;
if (SenderName='') then
begin
lpSender.lpszName := PChar(SenderEMail)
end
else
begin
lpSender.lpszName := PChar(SenderName)
end;
lpSender.lpszAddress := PChar('SMTP:'+SenderEMail);
lpSender.ulReserved := 0;
lpSender.ulEIDSize := 0;
lpSender.lpEntryID := nil;
lpOriginator := #lpSender;
end;
if (RecepientEMail<>'') then
begin
lpRecepient.ulRecipClass := MAPI_TO;
if (RecepientName='') then
begin
lpRecepient.lpszName := PChar(RecepientEMail)
end
else
begin
lpRecepient.lpszName := PChar(RecepientName)
end;
lpRecepient.lpszAddress := PChar('SMTP:'+RecepientEMail);
lpRecepient.ulReserved := 0;
lpRecepient.ulEIDSize := 0;
lpRecepient.lpEntryID := nil;
nRecipCount := 1;
lpRecips := #lpRecepient;
end
else
begin
lpRecips := nil
end;
if (FileName='') then
begin
nFileCount := 0;
lpFiles := nil;
end
else
begin
FillChar(FileAttach, SizeOf(FileAttach), 0);
FileAttach.nPosition := Cardinal($FFFFFFFF);
FileAttach.lpszPathName := PChar(FileName);
nFileCount := 1;
lpFiles := #FileAttach;
end;
end;
MAPIModule := LoadLibrary(PChar(MAPIDLL));
if MAPIModule=0 then
begin
Result := -1
end
else
begin
try
#SM := GetProcAddress(MAPIModule, 'MAPISendMail');
if #SM<>nil then
begin
Result := SM(0, Application.Handle, message, MAPI_DIALOG or
MAPI_LOGON_UI, 0);
end
else
begin
Result := 1
end;
finally
FreeLibrary(MAPIModule);
end;
end;
if Result<>0 then
begin
MessageDlg('Error sending mail ('+IntToStr(Result)+').', mtError, [mbOk],
0)
end;
You have to set FileAttach.lpszFileName to the name you want your recipient to see. If you don't do that an attachment like "C:\Document And Settings\MyUser\Local Settings\Temp\Hello.pdf" will look like "C__DOCUME~1_MyUser_LOCALS~1_Temp_Hello.pdf" to the recipient (this is probably different per e-mailclient ).
So set FileAttach.lpszPathName to contain only the filename:
begin
FillChar(FileAttach, SizeOf(FileAttach), 0);
FileAttach.nPosition := Cardinal($FFFFFFFF);
FileAttach.lpszPathName := PChar(FileName);
FileAttach.lpszFileName := PChar(ExtractFileName(FileName)); //add this
nFileCount := 1;
lpFiles := #FileAttach;
end;
The recipient will now see an attachment with the name "Hello.pdf" instead of "C__DOCUME~1_MyUser_LOCALS~1_Temp_Hello.pdf".

how SendMailMAPI is adjusted to support multiple file attachments

I have this code that sends just one attachment by time, how can I adjust this code to send 1-2 attachments?
function SendMailMAPI(const Subject, Body, FileName, SenderName, SenderEMail,
RecepientName, RecepientEMail: String) : Integer;
var
message: TMapiMessage;
lpSender,
lpRecepient: TMapiRecipDesc;
FileAttach: TMapiFileDesc;
SM: TFNMapiSendMail;
MAPIModule: HModule;
begin
FillChar(message, SizeOf(message), 0);
with message do
begin
if (Subject<>'') then
begin
lpszSubject := PChar(Subject)
end;
if (Body<>'') then
begin
lpszNoteText := PChar(Body)
end;
if (SenderEMail<>'') then
begin
lpSender.ulRecipClass := MAPI_ORIG;
if (SenderName='') then
begin
lpSender.lpszName := PChar(SenderEMail)
end
else
begin
lpSender.lpszName := PChar(SenderName)
end;
lpSender.lpszAddress := PChar('SMTP:'+SenderEMail);
lpSender.ulReserved := 0;
lpSender.ulEIDSize := 0;
lpSender.lpEntryID := nil;
lpOriginator := #lpSender;
end;
if (RecepientEMail<>'') then
begin
lpRecepient.ulRecipClass := MAPI_TO;
if (RecepientName='') then
begin
lpRecepient.lpszName := PChar(RecepientEMail)
end
else
begin
lpRecepient.lpszName := PChar(RecepientName)
end;
lpRecepient.lpszAddress := PChar('SMTP:'+RecepientEMail);
lpRecepient.ulReserved := 0;
lpRecepient.ulEIDSize := 0;
lpRecepient.lpEntryID := nil;
nRecipCount := 1;
lpRecips := #lpRecepient;
end
else
begin
lpRecips := nil
end;
if (FileName='') then
begin
nFileCount := 0;
lpFiles := nil;
end
else
begin
FillChar(FileAttach, SizeOf(FileAttach), 0);
FileAttach.nPosition := Cardinal($FFFFFFFF);
FileAttach.lpszPathName := PChar(FileName);
nFileCount := 1;
lpFiles := #FileAttach;
end;
end;
MAPIModule := LoadLibrary(PChar(MAPIDLL));
if MAPIModule=0 then
begin
Result := -1
end
else
begin
try
#SM := GetProcAddress(MAPIModule, 'MAPISendMail');
if #SM<>nil then
begin
Result := SM(0, Application.Handle, message, MAPI_DIALOG or
MAPI_LOGON_UI, 0);
end
else
begin
Result := 1
end;
finally
FreeLibrary(MAPIModule);
end;
end;
if Result<>0 then
begin
MessageDlg('Error sending mail ('+IntToStr(Result)+').', mtError, [mbOk],
0)
end;
end;
You can arrange your code to pass file names as an open array parameter and similarly construct a "MapiFileDesc"s array to pass to MAPISendMail.
//function SendMailMAPI(const Subject, Body, FileName, SenderName, SenderEMail,
// RecepientName, RecepientEMail: String) : Integer;
function SendMailMAPI(const Subject, Body, SenderName, SenderEMail,
RecepientName, RecepientEMail: String; FileNames: array of string) : Integer;
var
...
// FileAttach: TMapiFileDesc;
FileAttachments: array of TMapiFileDesc;
FileAttach: PMapiFileDesc;
i: Integer;
...
begin
...
...
begin
lpRecips := nil
end;
// if (FileName='') then
// begin
// ...
// ...
// lpFiles := #FileAttach;
// end;
nFileCount := High(FileNames) + 1;
SetLength(FileAttachments, nFileCount);
if nFileCount > 0 then
lpFiles := #FileAttachments[0];
for i := 0 to High(FileNames) do
begin
FileAttach := #FileAttachments[i];
FillChar(FileAttach^, SizeOf(FileAttach^), 0);
FileAttach.nPosition := $FFFFFFFF;
FileAttach.lpszPathName := PChar(FileNames[i]);
end;
end;
...
...
Brian Frost explained here

Resources