how SendMailMAPI is adjusted to support multiple file attachments - delphi

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

Related

How to load TTreeView items from database along with its items image index

I have saved my TreeView inside my DataBase by using the next :
var
BlobField :TField;
Query:TADOQuery;
Stream:TStream;
...
try
Query.SQL.Text := 'Select TOP(1) * From MyTable';
DBQueryConnect(Query); // I used this Procedure to connect the Query to the database
try
Query.First;
Query.Edit;
try
BlobField := Query.FieldByName('MyField') as TField;
Stream := Query.CreateBlobStream(BlobField, bmWrite);
try
MyTreeView.SaveToStream(Stream,TEncoding.UTF8);
finally
Stream.Free;
end;
Query.Post;
except
Query.Cancel;
raise;
end;
finally
Query.Close;
end;
finally
Query.Free;
end;
end;
and I loaded back the TTreeView form the DataBase by using the next :
...
var
Query:TADOQuery;
Stream:TStream;
begin
Query:=TADOQuery.Create(Self);
try
Query.SQL.Add('Select * From MyTable') ;
DBQueryConnect(Query);
Query.First;
Stream:=Query.CreateBlobStream(Query.FieldByName('MyField'), bmread);
MyTreeView.LoadFromStream(Stream);
Stream.Free;
finally
Query.Free;
end;
how can I retrive the imageindex for my TreeView items from the saved data ..
Thank you .
Perharps we can modify exsisting SaveTreeToStream and LoadTreeFromStream like this :
function GetBufStart(Buffer,idxSeparator: string; var Level,ImageIndex: Integer): string;
var
Pos: Integer;
sidx:String;
begin
Pos := 1;
Level := 0;
ImageIndex := -1;
while (CharInSet(Buffer[Pos], [' ', #9])) do
begin
Inc(Pos);
Inc(Level);
end;
Result := Copy(Buffer, Pos, Length(Buffer) - Pos + 1);
//Check Image Index
pos:=System.SysUtils.AnsiPos(idxSeparator,Result);
if Pos>0 then begin
sidx:=copy(result,Pos + Length(idxSeparator), length(result) - Pos + 1);
ImageIndex := StrToIntDef(sidx,-1);
Result := Copy(Result, 1, Pos - 1);
end;
end;
procedure LoadTreeFromStream(Nodes:TTreeNodes; Stream:TStream; Encoding:TEncoding; idxSeparator:String='|||');
var
List: TStringList;
ANode, NextNode: TTreeNode;
ALevel, i, ImageIndex: Integer;
CurrStr: string;
begin
List := TStringList.Create;
Nodes.BeginUpdate;
try
try
Nodes.Clear;
List.LoadFromStream(Stream, Encoding);
ANode := nil;
for i := 0 to List.Count - 1 do
begin
CurrStr := GetBufStart(PChar(List[i]), idxSeparator, ALevel, ImageIndex);
if ANode = nil then
ANode := Nodes.AddChild(nil, CurrStr)
else if ANode.Level = ALevel then
ANode := Nodes.AddChild(ANode.Parent, CurrStr)
else if ANode.Level = (ALevel - 1) then
ANode := Nodes.AddChild(ANode, CurrStr)
else if ANode.Level > ALevel then
begin
NextNode := ANode.Parent;
while NextNode.Level > ALevel do
NextNode := NextNode.Parent;
ANode := Nodes.AddChild(NextNode.Parent, CurrStr);
end
else raise Exception.CreateFmt('Invalid level (%d) for item "%s"', [ALevel, CurrStr]);
ANode.ImageIndex:=ImageIndex;
end;
finally
Nodes.EndUpdate;
List.Free;
end;
except
Nodes.Owner.Invalidate; // force repaint on exception
raise;
end;
end;
procedure SaveTreeToStream(Nodes:TTreeNodes; Stream:Tstream; Encoding:TEncoding; idxSeparator:String='|||');
const
TabChar = #9;
EndOfLine = #13#10;
var
I: Integer;
ANode: TTreeNode;
NodeStr: TStringBuilder;
Buffer, Preamble: TBytes;
begin
if Nodes.Count > 0 then
begin
if Encoding = nil then
Encoding := TEncoding.Default;
//Buffer := Encoding.GetBytes('');
Preamble := Encoding.GetPreamble;
if Length(Preamble) > 0 then
Stream.WriteBuffer(Preamble{$IFNDEF CLR}[0]{$ENDIF}, Length(Preamble));
NodeStr := TStringBuilder.Create(1024);
try
ANode := Nodes[0];
while ANode <> nil do
begin
NodeStr.Length := 0;
for I := 0 to ANode.Level - 1 do
NodeStr.Append(TabChar);
NodeStr.Append(ANode.Text);
NodeStr.Append(idxSeparator);
NodeStr.Append(ANode.ImageIndex);
NodeStr.Append(EndOfLine);
Buffer := Encoding.GetBytes(NodeStr.ToString);
Stream.Write(Buffer{$IFNDEF CLR}[0]{$ENDIF}, Length(Buffer));
ANode := ANode.GetNext;
end;
finally
NodeStr.Free;
end;
end;
end;
You can replace
MyTreeView.SaveToStream(Stream,TEncoding.UTF8);
with
SaveTreeToStream(MyTreeView.Items,Stream,TEncoding.UTF8);
and MyTreeView.LoadFromStream(Stream); with LoadTreeFromStream(MyTreeView.Items,Stream,TEncoding.UTF8);

RIO Delphi error

I have made several application where I use SOAP, but this one is giving me an error I haven't seen before.
Here is function in the WSDL that was created in Delphi.
function GetueSoapServerPortType(UseWSDL: Boolean=System.False; Addr: string=''; HTTPRIO: THTTPRIO = nil): ueSoapServerPortType;
implementation
uses System.SysUtils;
function GetueSoapServerPortType(UseWSDL: Boolean; Addr: string; HTTPRIO: THTTPRIO): ueSoapServerPortType;
const
defWSDL = 'https://sandbox.usaepay.com/soap/gate/1412E031/usaepay.wsdl';
defURL = 'https://sandbox.usaepay.com/soap/gate/1412E031';
defSvc = 'usaepayService';
defPrt = 'ueSoapServerPort';
var
RIO: THTTPRIO;
begin
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 ueSoapServerPortType);
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;
Here is my function:
function TEWBModule1.ProcessCreditcard(card,Exp,cvv, Amount, name: String): Boolean;
var
NewToken: usaepay.ueSecurityToken;
tran: usaepay.TransactionRequestObject;
response: usaepay.TransactionResponse;
Wclient: usaepay.ueSoapServerPortType;
CData: usaepay.CreditcardData;
CDetails: usaepay.TransactionDetail;
NewAmount: Double;
RIO: TRIO;
begin
try
NewAmount := StrToFloat(Amount);
NewToken := usaepay.ueSecurityToken.Create;
NewToken := CreateToken(MasterTbl.FieldByName('Merchantnum').AsString, MasterTbl.FieldByName('Mlogin').AsString);
tran := usaepay.TransactionRequestObject.Create;
CData:= usaepay.CreditcardData.Create;
CDetails:= usaepay.TransactionDetail.Create;
CData.CardNumber := card;
CData.CardExpiration := Exp;
CData.CardCode := cvv;
CDetails.Amount := NewAmount;
CDetails.AllowPartialAuth := False;
CDetails.Description := 'Web Payment';
tran.Command := 'sale';
Wclient := GetueSoapServerPortType(False,'');
RIO := (Wclient as IRIOAccess).RIO;
if RIO is THTTPRIO then
begin
THTTPRIO(RIO).HTTPWebNode.ConnectTimeout := 1000 * 30;
THTTPRIO(RIO).HTTPWebNode.SendTimeout := 1000 * 15;
THTTPRIO(RIO).HTTPWebNode.ReceiveTimeout := 1000 * 60;
end;
response := usaepay.TransactionResponse.Create;
response := Wclient.runTransaction(NewToken,tran);
if response.ResultCode = 'A' then
begin
result := True;
end
else if response.ResultCode = 'D' then
begin
//Declined response.error;
end
else
begin
// error response.error;
end;
finally
NewToken.Free;
tran.Free;
Cdata.Free;
CDetails.Free;
response.Free;
end;
end;
Here is where I get the error:
response := Wclient.runTransaction(NewToken,tran);
The error is:
Project myapp.exe raised exception class ESOAPDomConvertError with message 'Conversion from class TRIO.QueryInterface$1093$ActRec to SOAP is not supported - SOAP classes must derive from TRemotable.
Could this be that the md5 token is wrong or this something else?
Here is how I create the token:
function TEWBModule1.CreateToken(Key, Pin: String): usaepay.ueSecurityToken;
var
Token: usaepay.ueSecurityToken;
PinH: usaepay.ueHash;
PreHasValue: String;
begin
Token := usaepay.ueSecurityToken.Create;
Token.SourceKey := Key;
Token.ClientIP := '127.0.0.1';
PinH := usaepay.ueHash.Create;
PinH.Seed := '5678';
PinH.Type_ := 'md5';
PreHasValue := Token.SourceKey + PinH.Seed + Pin;
PinH.HashValue := MD5String(PreHasValue);
Result := Token;
Token.Free;
PinH.Free;
end;
function TEWBModule1.MD5String(myStr: String): String;
var
HashMessageDigest: TIdHashMessageDigest5;
begin
HashMessageDigest := nil;
Try
HashMessageDigest := TIdHashMessageDigest5.Create;
Result := IdGlobal.IndyLowerCase(HashMessageDigest.HashStringASHex(myStr));
Finally
HashMessageDigest.Free;
End;
end;
Here is my take on the ProcessCreditcard function. I have added comments to lines I have added and to lines that should be deleted.
function TEWBModule1.ProcessCreditcard(card,Exp,cvv, Amount, name: String): Boolean;
var
NewToken: usaepay.ueSecurityToken;
tran: usaepay.TransactionRequestObject;
response: usaepay.TransactionResponse;
Wclient: usaepay.ueSoapServerPortType;
CData: usaepay.CreditcardData;
CDetails: usaepay.TransactionDetail;
NewAmount: Double;
RIO: TRIO;
begin
NewToken := nil; //New line
tran := nil; //New line
Response := nil; //New line
try
NewAmount := StrToFloat(Amount);
//NewToken := usaepay.ueSecurityToken.Create; //This line would result in a memory leak
NewToken := CreateToken(MasterTbl.FieldByName('Merchantnum').AsString, MasterTbl.FieldByName('Mlogin').AsString);
tran := usaepay.TransactionRequestObject.Create;
tran.Command := 'sale';
CData:= usaepay.CreditcardData.Create;
tran.CreditCardData:=CData; //New line
CDetails:= usaepay.TransactionDetail.Create;
tran.Details:=CDetails; //New line
CData.CardNumber := card;
CData.CardExpiration := Exp;
CData.CardCode := cvv;
CDetails.Amount := NewAmount;
CDetails.AllowPartialAuth := False;
CDetails.Description := 'Web Payment';
Wclient := GetueSoapServerPortType(False,'');
RIO := (Wclient as IRIOAccess).RIO;
if RIO is THTTPRIO then
begin
THTTPRIO(RIO).HTTPWebNode.ConnectTimeout := 1000 * 30;
THTTPRIO(RIO).HTTPWebNode.SendTimeout := 1000 * 15;
THTTPRIO(RIO).HTTPWebNode.ReceiveTimeout := 1000 * 60;
end;
//response := usaepay.TransactionResponse.Create; //This line would result in a memory leak
response := Wclient.runTransaction(NewToken,tran);
if response.ResultCode = 'A' then
begin
result := True;
end
else if response.ResultCode = 'D' then
begin
//Declined response.error;
end
else
begin
// error response.error;
end;
finally
NewToken.Free;
tran.Free;
//Cdata.Free; //This object is destroyed by TransactionRequestObject
//CDetails.Free; //This object is destroyed by TransactionRequestObject
response.Free;
end;
end;
I can see some errors in CreateToken. It is a mistake to free the return value (token). I guess there is a line missing Token.PinHash:=PinH. Also it is a mistake to free PinH. Try something like this
function TEWBModule1.CreateToken(Key, Pin: String): usaepay.ueSecurityToken;
var
Token: usaepay.ueSecurityToken;
PinH: usaepay.ueHash;
PreHasValue: String;
begin
Token := usaepay.ueSecurityToken.Create;
Token.SourceKey := Key;
Token.ClientIP := '127.0.0.1';
PinH := usaepay.ueHash.Create;
PinH.Seed := '5678';
PinH.Type_ := 'md5';
PreHasValue := Token.SourceKey + PinH.Seed + Pin;
PinH.HashValue := MD5String(PreHasValue);
Token.PinHash:=PinH;
Result := Token;
end;

Can TNEF be avoided using MAPI?

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.

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.

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".

Resources