Drag & Drop Component Suite: Drop files and if path isn't exists get data from file - file

I use the Drag and Drop Component Suite for Delphi.
I try to create a drag & drop area which accepts files (ie, from Windows Explorer) and data (ie, from Outlook attachments). So, I use the demo (CombatTargetDemo) to learn how it works, and after this I create a wrapper class which creates a TDropComboTarget object:
constructor TDragAndDrop.Create( vpntOwner: TWinControl);
begin
fpntDragAndDrop := TDropComboTarget.Create(vpntOwner);
fpntDragAndDrop.Name := 'DropComboTarget_'+vpntOwner.Name;
fpntDragAndDrop.DragTypes := [dtCopy, dtLink];
fpntDragAndDrop.OnDrop := DropFiles;
fpntDragAndDrop.Target := vpntOwner;
fpntDragAndDrop.Formats := [mfFile, mfData];
end;
procedure TDragAndDrop.DropFiles(Sender: TObject; ShiftState: TShiftState; Point: TPoint; var Effect: Integer);
var
intCnt: Integer;
pntStream: TStream;
strFileName: String;
strDragAndDropFile: String;
begin
try
fstlDroppedFilePaths.Clear;
fstlDroppedFilePaths.Assign(fpntDragAndDrop.Files);
for intCnt := 0 to fpntDragAndDrop.Data.Count-1 do begin
strFileName := fpntDragAndDrop.Data.Names[intCnt];
if (strFileName = '') then begin
strFileName := IntToStr(intCnt)+'_'+FormatDateTime('yyyymmddhhnnss', Now())+'.dat';
end;
strDragAndDropFile := GetDragAndDropSavePath+strFileName;
pntStream := TFileStream.Create(strDragAndDropFile, fmCreate);
try
pntStream.CopyFrom(fpntDragAndDrop.Data[intCnt], fpntDragAndDrop.Data[intCnt].Size);
finally
pntStream.Free;
end;
if FileExists(strDragAndDropFile, false) then begin
fstlDroppedFilePaths.Add(strDragAndDropFile);
end;
end;
except
end;
end;
First of all, the code works.
If I drop a Windows Explorer file on the area:
fpntDragAndDrop.Files.Count is 1 (contains the path+name from file)
fpntDragAndDrop.Data.Count is 1 (contains the file as a stream)
If I drop a file from Outlook on the area:
fpntDragAndDrop.Files.Count is 0 (contains nothing)
fpntDragAndDrop.Data.Count is 1 (contains the file as a stream)
Now my problem:
If I drop very large files from Windows Explorer, the component does the following:
Read the file header and add an item to fpntDragAndDrop.Files
Create a TMemoryStream and try to load the data from the file into the stream
Step 1 is perfect, but on step 2 I get an exception because of insufficient memory.
My solution:
I want that the component does Step 1. If Step 1 gives a result, then the component should skip Step 2. After this, the variables in the DropFiles procedure should have the following values:
If I drop a Windows Explorer file on the area:
fpntDragAndDrop.Files.Count is 1 (contaims the path+name from the file)
fpntDragAndDrop.Data.Count is 0 (No memory stream is loaded)
If I drop a file from Outlook on the area:
fpntDragAndDrop.Files.Count is 0 (comtains nothing)
fpntDragAndDrop.Data.Count is 1 (contains the file as a stream)
Does somebody have an idea? Or maybe the component has a setting for that?

I'm not overly familiar with this suite, but just browsing through its source, I think you can use the OnAcceptFormat event to reject formats you don't want on a per-drop basis.
So, even though you have enabled drops of mfData doesn't mean you have to actually accept a dropped stream (TDataStreamDataFormat) if a file path (TFileDataFormat or TFileMapDataFormat) is available. So, query the fpntDragAndDrop.DataObject to see what formats it actually holds, such as by passing it to the HasValidFormats() method of the various formats in the fpntDragAndDrop.DataFormats property.
For example:
fpntDragAndDrop.OnAcceptFormat := AcceptStreams;
...
procedure TDragAndDrop.AcceptStreams(Sender: TObject;
const DataFormat: TCustomDataFormat; var Accept: boolean);
var
Fmt: TCustomDataFormat;
i: Integer;
begin
if DataFormat is TDataStreamDataFormat then
begin
// FYI, TFileDataFormat should be in DataFormats[0],
// and TFileMapDataFormat should be in DataFormats[5],
// if you want to avoid this loop...
for i := 0 to fpntDragAndDrop.DataFormats.Count-1 do
begin
Fmt := fpntDragAndDrop.DataFormats[i];
if (Fmt <> DataFormat) and ((Fmt is TFileDataFormat) or (Fmt is TFileMapDataFormat)) then
begin
if Fmt.HasValidFormats(fpntDragAndDrop.DataObject) then
begin
Accept := False;
Exit;
end;
end;
end;
end;
Accept := True; // should already be True by default...
end;

Related

How to overwrite INI file

I have this code which saves the location of Objects in an ini file but when I try to overwrite an already saved file, it doesn't delete the data currently in the file.
I have a popup which asks the user if they want to overwrite but it doesn't clear the whole file, how can I change it so it does?
procedure TForm1.SaveFile(Sender: TObject);
var
Dialog : TSaveDialog;
begin
Dialog := TSaveDialog.Create(self);
try
//dialog properties go here
Dialog.Filter := 'Title (*.ini)|*.ini';
Dialog.Options := Dialog.Options + [ofOverwritePrompt];
if Dialog.Execute then
begin
//any saving procedures go here if required
ShowMessage('File saved: ' + Dialog.FileName);
end
else
ShowMessage('Save file was cancelled');
finally
Dialog.Free;
end;
end;
The following procedure saves the objects to the file itself:
procedure TForm1.Save(const FileName: string);
var
Ini: TMemIniFile;
I: Integer;
procedure WhatYouAreSaving(Object: TButton);
var
Section: string;
begin
Section := 'Object'
//Properties you want to save go here
end;
begin
Ini := TMemIniFile.Create(FileName);
////For reference, the answer provided would go here
try
WhatYouAreSaving(Object);
Ini.UpdateFile;
finally
Ini.Free;
end;
end;
To clear the contents of the ini-file, call Ini.Clear after Ini := TMemIniFile.Create(FileName);
Erases all data from the INI file in memory.
Call Clear to erase all data from the INI file that is currently buffered in memory. All sections, keys, and values are erased.
To erase a section in the ini-file, use TMemIniFile.EraseSection.

Inno Setup - Create a dynamic list of components/types from external source (file or folder contents)

I have a batch file (setting changer) that uses xcopy to list specific files formats in a specific folder, then allows me to type in one of the names and the script uses that name to copy that file to another location.
First xcopy creates a copy of the original as a backup (rolling backup only 1 copy) then does the file copy (extension is fixed in batch only body of filename needed This works great BUT I would love to try and do this in Inno Setup for a nice clean GUI.
I would like to populate the list of components/types from this list of files found in a specific fixed folder. Or even create an ini file with those names in (extra step but maybe better control). Main problem that might prevent this from being possible is not knowing how many entries it would be an array. If only 1 entry or file only 1 option (1 or a) if 4 then user can select 1 of 4 (a, b, c or d). I would extract the file name to create the name/description.
then on completion the same task as my batch would happen, backup (easy always the same name like start.ini) then copy the file e.g. example1.ini and overwrite start.ini
ini might be most flexible as I can imagine later adding new sections to change the actions performed.
Is this possible or stretching this program too far. No rush as my batch works for now but the less typing and manual steps the better for continued use.
I found an example to list contents to a dialog window but I could not figure how to use this to populate components. TLama - List all files in a directory
You cannot create the components dynamically on runtime (you can on compile-time).
But it's not difficult to implement a custom dynamic components-like page using the CreateCustomPage and the TNewCheckListBox.
Then in the CurStepChanged(ssInstall) you process the selected files/components as your need.
[Code]
const
SourcePath = 'C:\somepath';
var
CustomSelectTasksPage: TWizardPage;
ComponentsList: TNewCheckListBox;
procedure InitializeWizard();
var
FindRec: TFindRec;
SelectComponentsLabel: TNewStaticText;
begin
CustomSelectTasksPage :=
CreateCustomPage(
wpSelectComponents, SetupMessage(msgWizardSelectComponents),
SetupMessage(msgSelectComponentsDesc));
SelectComponentsLabel := TNewStaticText.Create(WizardForm);
SelectComponentsLabel.Parent := CustomSelectTasksPage.Surface;
SelectComponentsLabel.Top := 0;
SelectComponentsLabel.Left := 0;
SelectComponentsLabel.Width := CustomSelectTasksPage.Surface.Width;
SelectComponentsLabel.AutoSize := False;
SelectComponentsLabel.ShowAccelChar := False;
SelectComponentsLabel.WordWrap := True;
SelectComponentsLabel.Caption := SetupMessage(msgSelectComponentsLabel2);
WizardForm.AdjustLabelHeight(SelectComponentsLabel);
ComponentsList := TNewCheckListBox.Create(WizardForm);
ComponentsList.Parent := CustomSelectTasksPage.Surface;
ComponentsList.Top :=
SelectComponentsLabel.Top + SelectComponentsLabel.Height + ScaleY(8);
ComponentsList.Left := 0;
ComponentsList.Width := CustomSelectTasksPage.Surface.Width;
ComponentsList.Height := CustomSelectTasksPage.Surface.Height - ComponentsList.Top;
if FindFirst(ExpandConstant(AddBackslash(SourcePath) + '*.dat'), FindRec) then
begin
try
repeat
ComponentsList.AddCheckBox(FindRec.Name, '', 0, False, True, False, False, nil);
until not FindNext(FindRec);
finally
FindClose(FindRec);
end;
end;
end;
procedure CurStepChanged(CurStep: TSetupStep);
var
I: Integer;
FileName: string;
SourceFilePath: string;
TargetFilePath: string;
begin
if CurStep = ssInstall then
begin
for I := 0 to ComponentsList.Items.Count - 1 do
begin
if ComponentsList.Checked[I] then
begin
FileName := ComponentsList.Items[I];
SourceFilePath := AddBackslash(SourcePath) + FileName;
TargetFilePath := AddBackslash(ExpandConstant('{app}')) + FileName;
if FileCopy(SourceFilePath, TargetFilePath, False) then
begin
Log(Format('Installed "%s".', [FileName]));
end
else
begin
Log(Format('Failed to install "%s".', [FileName]));
end;
end;
end;
end;
end;

What is the proper way to dynamically create and call a stored procedure in Delphi using FireDac?

I am relatively new to FireDAC. I want to be able to call a stored procedure "on the fly", dynamically. So far I have the following:
function TForm21.ExecuteStoredProc(aSPName: string; aParams: TADParams): Boolean;
var
LSP: TADStoredProc;
i: Integer;
begin
LSP := TADStoredProc.Create(nil);
try
LSP.Connection := ADConnection1;
LSP.StoredProcName := aSPName;
LSP.Prepare;
for i := 0 to aParams.Count - 1 do
begin
LSP.Params[i].Value := aParams[i].Value;
end;
LSP.ExecProc;
finally
LSP.Free;
end;
Result := True;
end;
I call it with
procedure TForm21.Button1Click(Sender: TObject);
var
LParams: TADParams;
begin
LParams := TADParams.Create;
LParams.Add.Value := 612;
LParams.Add.Value := '2008';
ExecuteStoredProc('HDMTEST.dbo.spARCHIVE_HISTORY_DATA', LParams);
end;
However, the stored procedure fails to execute. That is, the code runs fine, no error message is shown, but the stored procedure doesn't run.
Further info -- it runs fine if I drop a component and set up the params in code.
Anyone have any idea what I am missing?
Seeing as this q has been left unanswered for a while, I thought I'd try to get the code working without using the clues from the comments and found it not quite as easy as I'd imagined.
I immediately got stuck with the SP params. I found this
http://docwiki.embarcadero.com/RADStudio/XE5/en/TFDQuery,_TFDStoredProc_and_TFDUpdateSQL_Questions
which says
"If you have difficulties with manual definition of parameters,
populate the Params collection automatically and check how the
parameters are defined. Then compare that to your code. "
but I couldn't find a way of "automatically" populating the Params. I asked on the EMBA
FireDac newsgroup and the FD author, Dimitry Arefiev, kindly explained that
you can do that by checking that the FetchOptions include fiMeta, and then clearing and setting the FDStoredProc's StoredProcName.
Using a StoredProc in the pubs demo database on my SqlServer defined as follows:
create procedure test(#ANumber int, #AName varchar(20))
as
begin
select
#ANumber * 2 as "Number",
#AName + #AName as "Name"
end
I changed a couple of sections of the OP's code like this
[...]
LSP.Params.Clear;
LSP.StoredProcName := '';
LSP.FetchOptions.Items := LSP.FetchOptions.Items + [fiMeta];
LSP.StoredProcName := aSPName;
LSP.Prepare;
Assert(LSP.ParamCount > 0);
for i := 0 to aParams.Count - 1 do
begin
LSP.Params.ParamByName(aParams[i].Name).Value := aParams[i].Value;
end;
[...]
procedure TForm21.Button1Click(Sender: TObject);
var
LParams: TFDParams;
Param : TFDParam;
begin
LParams := TFDParams.Create;
Param := LParams.Add;
Param.Name := '#ANumber';
Param.Value := 612;
Param := LParams.Add;
Param.Name := '#AName';
Param.Value := '2008';
ExecuteStoredProc('test', LParams);
end;
and it worked fine.
The OP mentions in the q he'd first had the problem that the SP failed to execute
but that he'd found that it worked if he "[dropped] a component and set up the params in code" so I thought I'd include here a console application where of course necessarily everything is done in code. This wasn't difficult, but the time it took me to get the Uses clause right is my main reason for posting this as an answer, for future reference. W/o the correct uses, you get errors complaining about various class factories being missing.
Console app (created and tested in XE6):
program ConsoleStoredProcProject3;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, FireDac.DApt, FireDAC.Stan.Def, FireDAC.Stan.ASync,
FireDAC.Stan.Param, FireDAC.Stan.Option, FireDAC.Comp.Client,
FireDAC.Phys.MSSQL, VCL.ClipBrd;
procedure TestSP;
var
Connection : TFDConnection;
StoredProc : TFDStoredProc;
Param : TFDParam;
begin
Connection := TFDConnection.Create(Nil);
Connection.DriverName := 'MSSQL';
Connection.Params.Values['Server'] := // your server name'';
Connection.Params.Values['Database'] := 'pubs';
Connection.Params.Values['user_name'] := 'user'; // adjust to suit
Connection.Params.Values['password'] := 'password'; // ditto
Connection.LoginPrompt := False;
Connection.Connected := True;
StoredProc := TFDStoredProc.Create(Nil);
StoredProc.Connection := Connection;
StoredProc.FetchOptions.Items := StoredProc.FetchOptions.Items + [fiMeta];
StoredProc.StoredProcName := 'test';
StoredProc.Prepare;
Param := StoredProc.Params.ParamByName('#ANumber');
Param.Value := 333;
Param := StoredProc.Params.ParamByName('#AName');
Param.Value := 'A';
StoredProc.Active := True;
WriteLn(StoredProc.FieldByName('Number').AsInteger);
WriteLn(StoredProc.FieldByName('Name').AsString);
ReadLn;
end;
begin
try
TestSP;
except
on E: Exception do
Clipboard.AsText := E.Message;
end;
end.

Pulling Text From a Memo Box Line by Line

I need to go through a ton of data that is stored in a paradox table within a Memo field. I need to process this data line by line and process each line.
How can I tell Delphi to fetch each line in the memo field one by one?
Could I use #13#10 as a delimiter?
Assuming that what is in the memo field uses #13#10 as the line separator then I would use a TStringList, and the very useful Text property to split the memo field text into separate lines:
var
StringList: TStringList;
Line: string;
.....
StringList.Text := MemoFieldText;
for Line in StringList do
Process(Line);
Even if your memo field uses Unix linefeeds then this code will interpret the memo field correctly.
It depends on how the field is actually declared in Paradox. If it's a TMemoField, it's pretty easy:
var
SL: TStringList;
Line: string;
begin
SL := TStringList.Create;
try
SL.Text := YourMemoField.GetAsString;
for Line in SL do
// Process each line of text using `Line`
finally
SL.Free;
end;
end;
If it's a TBlobField, it's a little more complicated. You need to read the memo field using a TBlobStream, and load the content of that stream into a TStringList:
// For Delphi versions that support it:
procedure LoadBlobToStringList(const DS: TDataSet; const FieldName: string;
const SL: TStringList);
var
Stream: TStream;
begin
Assert(Assigned(SL), 'Create the stringlist for LoadBlobToStringList!');
SL.Clear;
Stream := DS.CreateBlobStream(DS.FieldByName(FieldName), bmRead);
try
SL.LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
// For older Delphi versions that do not have TDataSet.CreateBlobStream
procedure LoadBlobToStringList(const DS: TDataSet; const TheField: TField;
const SL: TStringList);
var
BlobStr: TBlobStream;
begin
Assert(Assigned(SL), 'Create the stringlist for LoadBlobToStringList!');
SL.Clear;
BlobStr := TBlobStream.Create(DS.FieldByName(TheField), bmRead);
try
SL.LoadFromStream(BlobStr);
finally
BlobStr.Free;
end;
end;
// Use it
var
SL: TStringList;
Line: string;
begin
SL := TStringList.Create;
LoadBlobToStringList(YourTable, YourMemoFieldName, SL);
for Line in SL do
// Process each Line, which will be the individual line in the blob field
// Alternatively, for earlier Delphi versions that don't support for..in
// declare an integer variable `i`
for i := 0 to SL.Count - 1 do
begin
Line := SL[i];
// process line of text using Line
end;
end;

Delphi TeeChart only showing one record from dataset

Using Delphi Steema TeeChart component, if I link a BarSeries to a dataset using the user interface, it shows up fine, but if I do it using code (which I need to), it's only showing one bar, even when I have several records in the database. What am I doing wrong?
Code:
var
i:Integer;
Bar:TBarSeries;
begin
ADataSet.Close;
ADataSet.LoadFromDataSet(mtbl);
ADataSet.Active := true;
ADataSet.First;
ASource.DataSet := ADataSet;
Bar := TBarSeries.Create(AChart);
Bar.Assign(Series2);
Bar.ParentChart := AChart;
Bar.DataSource := ASource;
Bar.XLabelsSource := 'Date';
Bar.YValues.ValueSource := 'Load';
for i := 0 to AChart.SeriesCount - 1 do
begin
AChart.Series[i].CheckDataSource;
end;
ADataSet is a DevExpress MemData (TdxMemData). When I run the program, the X axis is only showing one bar, the first record in the dataset, even though I have 4 records in the dataset.
This code works for me (using an Access database with fields ID and Height, I dropped a TDBChart, TADODataSet, and a TButton on a form):
procedure TForm1.Button1Click(Sender: TObject);
var
Bar : TBarSeries;
begin
ADODataSet1.Close;
ADODataSet1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;...';
Bar := TBarSeries.Create(DBChart1);
DBChart1.AddSeries(Bar);
Bar.ParentChart := DBChart1;
Bar.DataSource := ADODataSet1;
Bar.XLabelsSource := 'ID';
Bar.YValues.ValueSource := 'Height';
ADODataSet1.Active := true;
end;
Note that the Datasource should be a TTable, TQuery, or TDataSet (not a TDataSource - go figure!).
Hope this helps.
TChart refreshes the query each time you set
ADataSet.Active := true;
so, move this command to the end of your block (e.g. after you've set up the series properties).

Resources