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.
Related
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);
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.
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.
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".
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