I have a FDQuery that feeds data to a grid.
When the user clicks on a column I want the grid to order on that column.
Because I want to be able to sort on multiple columns, I cannot use the autosort option of the grid.
I tried the following code in my proof of concept.
However it does not work.
procedure TForm31.JvDBGrid1TitleBtnClick(Sender: TObject; ACol: Integer;
Field: TField);
const
sDesc = 1;
sASC = 2;
sNone = 0;
var
i: integer;
SortClause: string;
AField: TField;
AIndex: TFDIndex;
begin
case Field.Tag of
sDesc: Field.Tag:= sASC;
sASC: Field.Tag:= sNone;
sNone: Field.Tag:= sDesc;
end;
SortClause:= '';
FDQuery1.Indexes.BeginUpdate;
try
FDQuery1.Indexes.Clear;
for i:= 0 to JvDBGrid1.Columns.Count - 1 do begin
AField:= JvDBGrid1.Columns[i].Field;
if AField.Tag <> sNone then begin
AIndex:= FDQuery1.Indexes.Add;
AIndex.Name:= AField.FieldName;
AIndex.Fields:= AField.FieldName;
//AIndex.Options:= [soNoCase, soNullFirst, soDescNullLast, soDescending, soUnique, soPrimary, soNoSymbols]
case AField.Tag of
sDESC: AIndex.Options:= [soDescNullLast];
sASC: AIndex.Options:= [];
end;
AIndex.Active:= true;
end;
end;
finally
FDQuery1.Indexes.EndUpdate;
FDQuery1.Refresh;
end;
end;
It does not matter whether the Query already has an order by clause or not.
What am I doing wrong?
P.S. I'd rather not resort to constructing a custom order by clause but I know that's an option.
I think you may be missing a step, namely setting the FDQuery's IndexName to the name of the added index. Apparently. setting the added index's Active property is insufficient.
The following works fine for me against the MS Sql Server pubs database Authors table:
procedure TForm1.AddFDIndex;
var
AIndex : TFDIndex;
begin
AIndex := FDQuery1.Indexes.Add;
AIndex.Name := 'ByCityThenlname';
AIndex.Fields := 'city;au_lname';
AIndex.Active := True;
FDQuery1.IndexName := AIndex.Name;
end;
Btw, I'm not sure what your code is supposed to do if more than one column is tagged to be included in the index, but I'll leave that to you ;=)
I would like to list all the files that windows has indexed using its Windows Indexing Service.
Specified file extensions are acceptable.
For instance: I am working an a software which presents user media such as photos and videos. I am currently using the following custom procedure to find the files myself:
function FindAllFiles_Safe(aDirectory, aFilter: string; aIncludeSubDirs: boolean): string;
{$IFDEF DCC}
var TD: TDirectory;
SO: TSearchOption;
DF: TStringDynArray;
i: integer;
sl: TStringList;
MaskArray: TStringDynArray;
Predicate: TDirectory.TFilterPredicate;
{$ENDIF}
begin
{$IFDEF FPC}
result:=FindAllFiles(aDirectory,aFilter,aIncludeSubDirs).text;
{$ENDIF}
{$IFDEF DCC}
MaskArray := SplitString(aFilter, ';');
if aIncludeSubDirs=true then SO:=TSearchOption.soAllDirectories;
Predicate :=
function(const Path: string; const SearchRec: TSearchRec): Boolean
var Mask: string;
begin
for Mask in MaskArray do
if MatchesMask(SearchRec.Name, Mask) then
exit(True);
exit(False);
end;
//DF:=TD.GetFiles(aDirectory, Predicate, SO);
DF:=TD.GetFiles(aDirectory, SO, Predicate);
if length(DF)=0 then exit;
sl:=TStringList.Create;
for i := 0 to length(DF)-1 do sl.Add(DF[i]);
result:=sl.Text;
sl.Free;
{$ENDIF}
end;
Is there a way to access files that Windows has already indexed?
I'd like to take advantage of Windows Indexing Service to quickly retrieve files, rather then wasting resources if Windows already has done it before.
One of the ways to query the index of the Windows Search is use ADO and the Query Syntax (AQS) and SQL.
Try this sample code (off course you can improve the SQL sentence to filter and speed up the results)
{$APPTYPE CONSOLE}
{$R *.res}
uses
ADOInt,
SysUtils,
ActiveX,
ComObj,
Variants;
procedure QuerySystemIndex;
var
Connection : _Connection;
RecordSet: _RecordSet;
v: Variant;
begin;
OleCheck(CoCreateInstance(CLASS_Connection, nil, CLSCTX_ALL, IID__Connection, Connection));
OleCheck(CoCreateInstance(CLASS_RecordSet, nil, CLSCTX_ALL, IID__RecordSet, RecordSet));
Connection.CursorLocation := adUseClient;
Connection.Open('Provider=Search.CollatorDSO;Extended Properties=''Application=Windows'';', '', '', adConnectUnspecified);
Recordset.Open('SELECT Top 5 System.ItemPathDisplay FROM SYSTEMINDEX', Connection, adOpenForwardOnly, adLockReadOnly, adCmdText);
Recordset.MoveFirst;
v:='System.ItemPathDisplay';
while not Recordset.EOF do
begin
Writeln(Recordset.Fields.Item[v].Value);
Recordset.MoveNext();
end;
end;
begin
try
CoInitialize(nil);
try
QuerySystemIndex;
finally
CoUninitialize;
end;
except
on E:EOleException do
Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
Writeln('Press Enter to exit');
Readln;
end.
You can found alternatives ways to access the Search Index on the MSDN documentation.
There is an API for Windows Search (previously known as Windows Desktop Search).
However, whilst the Windows Search API is undoubtedly enormously powerful, I think for simply locating files based on file extension (or even other constituent elements in the file name) the Windows Search API is likely to prove prohibitively complex and provide negligible benefit, unless you are dealing with a truly extraordinary number of files.
What I'm trying to do is to get the list of fields in a class without an instance... for example:
TAClass=class
a_: Integer;
b_: Integer;
constructor (a,b Integer);
end;
I'm not being able to get the fieldTable from the VMT:
ovmt: PVmt;
ftable: PVmtFieldTable;
finfo: PVmtFieldEntry;
ovmt:=PVmt(TAClass);
ftable := ovmt^.vfieldtable
finfo := ftable^.fields[0]
this way I'm not gettig the list of fields
any help is welcome,
thanks in advance
Afaik the field tables in classic delphi and FPC only work for published fields. Published fields must be class fields (value types like integer must go via properties). Newer Delphi's also allow RTTI for non published fields, but that works differently (different untis), and FPC doesn't support that yet.
I hacked together a small demonstration example since the help for typinfo seems to be light on examples. Note the tpersistent derivation.
{$mode delphi}
uses typinfo,classes;
type
TAClass=class(Tpersistent)
a: tstringlist;
b: tlist;
end;
var
ovmt: PVmt;
FieldTable: PVMTFieldTable;
PVMTFieldEntry;
i: longint;
begin
ovmt := PVmt(TAClass);
while ovmt <> nil do
begin
FieldTable := PVMTFieldTable(ovmt^.vFieldTable);
if FieldTable <> nil then
begin
FieldInfo := #FieldTable^.Fields[0];
for i := 0 to FieldTable^.Count - 1 do
begin
writeln(fieldinfo^.name);
FieldInfo := PvmtFieldEntry(PByte(#FieldInfo^.Name) + 1 + Length(FieldInfo^.Name));
end;
end;
{ Try again with the parent class type }
ovmt:=ovmt^.vParent;
end;
end.
I need to create stored procedure into oracle from delphi with TQuery.
But the SQL.text is difficult to uunderstand.
Is there any way to store direct text as pl/SQL with out quotes?
'create or replace '+
'function WholeTableRecovery(i_tablname IN varchar) return varchar '+
'as '+
Is it possible with resource file
Thanks in advance
Since you are using Delphi 2010 in the tags (I have no Delphi 7 here to test), a comfortable method would be storing the SQLs in separate textfiles, together with a RC file containing the directives for the resource compiler.
The RC files will contain the names of the resource you want to use together with the filenames containing the SQLs you want to store. The content for the example would look like this:
My_First_Speaking_ResourceName RCDATA "MyFirstSQL.sql"
My_Second_Speaking_ResourceName RCDATA "MySecondSQL.sql"
There is no need to call BRCC32 directly if you include the resource containing RC and resulting RES :
{$R 'MySQLResources.res' 'resources\MySQLResources.rc'}
You might wrap the usage of TResourceStream for your convenience, the way shown in the example would use Strings you might also work with the stream directly as mentioned by TLama MyQuery.SQL.LoadFromStream(rs);
implementation
{$R *.dfm}
{$R 'MySQLResources.res' 'resources\MySQLResources.rc'}
function LoadSqlResource(resourceName: string): string;
var
rs: TResourceStream;
sl: TStringList;
s : string;
begin
sl := TStringList.Create;
try
rs := TResourceStream.Create(hinstance, resourceName, RT_RCDATA);
try
rs.Position := 0;
sl.LoadFromStream(rs);
Result := sl.Text;
finally
rs.Free;
end;
finally
sl.Free;
end;
end;
procedure CallOneSql(Q:TADOQuery;ResourceName:String);
begin
Q.SQL.Text := LoadSqlResource('My_First_Speaking_ResourceName');
Q.ExecSQL;
end;
With a call like CallOneSql(MyQuery,'My_First_Speaking_ResourceName');
Make sure to create the project, not just compile if you made changes on the RC or the SQL files.
I have a room with 60 computers/devices (40 computers and 20 oscilloscopes Windows CE based) and I would like to know which and every one is alive using ping. First I wrote a standard ping (see here Delphi Indy Ping Error 10040), which is working fine now but takes ages when most computers are offline.
So what I am trying to do is to write a MultiThread Ping but I am quite struggling with it. I have seen only very few examples over the internet and no one was matching my needs, that's why I try to write it myself.
I use XE2 and Indy 10 and the form is only constitued of a memo and a button.
unit Main;
interface
uses
Winapi.Windows, System.SysUtils, System.Classes, Vcl.Forms,
IdIcmpClient, IdGlobal, Vcl.StdCtrls, Vcl.Controls;
type
TMainForm = class(TForm)
Memo1: TMemo;
ButtonStartPing: TButton;
procedure ButtonStartPingClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TMyPingThread = class(TThread)
private
fIndex : integer;
fIdIcmpClient: TIdIcmpClient;
procedure doOnPingReply;
protected
procedure Execute; override;
public
constructor Create(index: integer);
end;
var
MainForm: TMainForm;
ThreadCOunt : integer;
implementation
{$R *.dfm}
constructor TMyPingThread.Create(index: integer);
begin
inherited Create(false);
fIndex := index;
fIdIcmpClient := TIdIcmpClient.Create(nil);
fIdIcmpClient.ReceiveTimeout := 200;
fIdIcmpClient.PacketSize := 24;
fIdIcmpClient.Protocol := 1;
fIdIcmpClient.IPVersion := Id_IPv4;
//first computer is at adresse 211
fIdIcmpClient.Host := '128.178.26.'+inttostr(211+index-1);
self.FreeOnTerminate := true;
end;
procedure TMyPingThread.doOnPingReply;
begin
MainForm.Memo1.lines.add(inttostr(findex)+' '+fIdIcmpClient.ReplyStatus.Msg);
dec(ThreadCount);
if ThreadCount = 0 then
MainForm.Memo1.lines.add('--- End ---');
end;
procedure TMyPingThread.Execute;
begin
inherited;
try
fIdIcmpClient.Ping('',findex);
except
end;
while not Terminated do
begin
if fIdIcmpClient.ReplyStatus.SequenceId = findex then Terminate;
end;
Synchronize(doOnPingReply);
fIdIcmpClient.Free;
end;
procedure TMainForm.ButtonStartPingClick(Sender: TObject);
var
i: integer;
myPing : TMyPingThread;
begin
Memo1.Lines.Clear;
ThreadCount := 0;
for i := 1 to 40 do
begin
inc(ThreadCount);
myPing := TMyPingThread.Create(i);
//sleep(10);
end;
end;
end.
My problem is that it "seems" to work when I uncomment the "sleep(10)", and "seems" not to be working without it. This for sure means I am missing a point in the threading I have written.
In other words. When Sleep(10) is in the code. Every time I clicked the button to get to check the connections the result was correct.
Without the sleep(10), it is working "most" of the time but some times the result is wrong giving me a ping echo on offline computers and no ping echo on online computer, as is the ping reply was not assigned to the correct thread.
Any comment or help is welcome.
----- EDIT / IMPORTANT -----
As a general follow up of this question, #Darian Miller started a Google Code project here https://code.google.com/p/delphi-stackoverflow/ which is a working basis. I mark his answer as the "accepted answer" but users should refer to this open source project (all the credit belongs to him) as it will surely be extended and updated in the future.
The root problem is that pings are connectionless traffic. If you have multiple TIdIcmpClient objects pinging the network at the same time, one TIdIcmpClient instance can receive a reply that actually belongs to another TIdIcmpClient instance. You are trying to account for that in your thread loop, by checking SequenceId values, but you are not taking into account that TIdIcmpClient already does that same check internally. It reads network replies in a loop until it receives the reply it is expecting, or until the ReceiveTimeout occurs. If it receives a reply it is not expecting, it simply discards that reply. So, if one TIdIcmpClient instance discards a reply that another TIdIcmpClient instance was expecting, that reply will not get processed by your code, and that other TIdIcmpClient will likely receive another TIdIcmpClient's reply instead, and so on. By adding the Sleep(), you are decreasing (but not eliminating) the chances that pings will overlap each other.
For what you are attempting to do, you won't be able to use TIdIcmpClient as-is to have multiple pings running in parallel, sorry. It is simply not designed for that. There is no way for it to differentiate reply data the way you need it. You will have to serialize your threads so only one thread can call TIdIcmpClient.Ping() at a time.
If serializing the pings is not an option for you, you can try copying portions of TIdIcmpClient's source code into your own code. Have 41 threads running - 40 device threads and 1 response thread. Create a single socket that all of the threads share. Have each device thread prepare and send its individual ping request to the network using that socket. Then have the response thread continuously reading replies from that same socket and routing them back to the appropriate device thread for processing. This is a bit more work, but it will give you the multiple-ping parallelism you are looking for.
If you don't want to go to all that trouble, an alternative is to just use a third-party app that already supports pinging multiple machines at the same time, like FREEPing.
Remy explained the problems... I've wanted to do this in Indy for a while so I posted a possible solution that I just put together to a new Google Code project instead of having a long comment here. It's a first-stab sort of thing, let me know if you have some changes to integrate:
https://code.google.com/p/delphi-vault/
This code has two ways to Ping...multi-threaded clients as in your example, or with a simple callback procedure. Written for Indy10 and later versions of Delphi.
Your code would end up using a TThreadedPing descendant defining a SynchronizedResponse method:
TMyPingThread = class(TThreadedPing)
protected
procedure SynchronizedResponse(const ReplyStatus:TReplyStatus); override;
end;
And to fire off some client threads, the code becomes something like:
procedure TfrmThreadedPingSample.butStartPingClick(Sender: TObject);
begin
TMyPingThread.Create('www.google.com');
TMyPingThread.Create('127.0.0.1');
TMyPingThread.Create('www.shouldnotresolvetoanythingatall.com');
TMyPingThread.Create('127.0.0.1');
TMyPingThread.Create('www.microsoft.com');
TMyPingThread.Create('127.0.0.1');
end;
The threaded response is called in a synchronized method:
procedure TMyPingThread.SynchronizedResponse(const ReplyStatus:TReplyStatus);
begin
frmThreadedPingSample.Memo1.Lines.Add(TPingClient.FormatStandardResponse(ReplyStatus));
end;
I did not try your code, so that is all hypothetical, but i think you messed the threads and got classic race condition. I restate my advice to use AsyncCalls or OmniThreadLibrary - they are much simpler and would save you few attempts at "shooting your own foot".
Threads are made to minimize main-thread load. Thread constructor should do minimal work of remembering parameters. Personally i'd moved idICMP creation into .Execute method. If for any reason it would want to create its internal synchronization objects, like window and message queue or signal or whatever, i'd like it to happen already in a new spawned thread.
There is no sense for "inherited;" in .Execute. Better remove it.
Silencing all exceptions is bad style. You probably have errors - but have no way to know about them. You should propagate them to main thread and display them. OTL and AC help you in that, while for tThread you have to do it manually. How to Handle Exceptions thrown in AsyncCalls function without calling .Sync?
Exception logic is flawed. There is no point to have a loop if exception thrown - if no succesful Ping was set - then why waiting for response ? You loop should go within same try-except frame as issuing ping.
Your doOnPingReply executes AFTER fIdIcmpClient.Free yet accesses fIdIcmpClient's internals. Tried changing .Free for FreeAndNil ?
That is a classic mistake of using dead pointer after freeing it.
The correct approach would be to:
5.1. either free the object in doOnPingReply
5.2. or copy all relevant data from doOnPingReply to TThread's private member vars before calling both Synchronize and idICMP.Free (and only use those vars in doOnPingReply )
5.3. only do fIdIcmpClient.Free inside TMyThread.BeforeDestruction or TMyThread.Destroy. Afterall, if you chosen to create the object in constructor - then you should free it in the matching language construct - destructor.
Since you do not keep references to the thread objects - that While not Terminated loop seems redundant. Just make usual forever-loop and call break.
The aforementioned loop is CPU-hungry, it is like spin-loop. Please call Sleep(0); or Yield(); inside loop to give other threads better chance to do their work. Don't work agaisnt OS scheduler here - you are not in a speed-critical path, no reason to make spinlock here.
Overall, i consider:
4 and 5 as critical bugs for you
1 and 3 as a potential gotcha maybe influencing or maybe not. You'd better 'play safe' rather than doing risky things and investigating if they would work or not.
2 and 7 - bad style, 2 regarding language and 7 regarding platform
6 either you have plans to extend your app, or you broke YAGNI principle, dunno.
Sticking with complex TThread instead of OTL or AsyncCalls - strategic errors. Don't you put rooks on your runway, use simple tools.
Funny, this is example of the bug that FreeAndNil could expose and make obvious, while FreeAndNil-haters are claiming it "conceals" bugs.
// This is my communication unit witch works well, no need to know its work but your
// ask is in the TPingThread class.
UNIT UComm;
INTERFACE
USES
Windows, Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls, Forms, Dialogs,
StdCtrls,IdIcmpClient, ComCtrls, DB, abcwav, SyncObjs, IdStack, IdException,
IdTCPServer, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdContext,
UDM, UCommon;
TYPE
TNetworkState = (nsNone, nsLAN, nsNoLAN, nsNet, nsNoNet);
TDialerStatus = (dsNone, dsConnected, dsDisconnected, dsNotSync);
{ TBaseThread }
TBaseThread = Class(TThread)
Private
FEvent : THandle;
FEventOwned : Boolean;
Procedure ThreadTerminate(Sender: TObject); Virtual;
Public
Constructor Create(AEventName: String);
Property EventOwned: Boolean Read FEventOwned;
End;
.
.
.
{ TPingThread }
TPingThread = Class(TBaseThread)
Private
FReply : Boolean;
FTimeOut : Integer;
FcmpClient : TIdIcmpClient;
Procedure ReplyEvent(Sender: TComponent; Const AReplyStatus: TReplyStatus);
Protected
Procedure Execute; Override;
Procedure ThreadTerminate(Sender: TObject); Override;
Public
Constructor Create(AHostIP, AEventName: String; ATimeOut: Integer);
Property Reply: Boolean Read FReply;
End;
.
.
.
{ =============================================================================== }
IMPLEMENTATION
{$R *.dfm}
USES
TypInfo, WinSock, IdGlobal, UCounter, UGlobalInstance, URemoteDesktop;
{IdGlobal: For RawToBytes function 10/07/2013 04:18 }
{ TBaseThread }
//---------------------------------------------------------
Constructor TBaseThread.Create(AEventName: String);
Begin
SetLastError(NO_ERROR);
FEvent := CreateEvent(Nil, False, False, PChar(AEventName));
If GetLastError = ERROR_ALREADY_EXISTS
Then Begin
CloseHandle(FEvent);
FEventOwned := False;
End
Else If FEvent <> 0 Then
Begin
FEventOwned := True;
Inherited Create(True);
FreeOnTerminate := True;
OnTerminate := ThreadTerminate;
End;
End;
//---------------------------------------------------------
Procedure TBaseThread.ThreadTerminate(Sender: TObject);
Begin
CloseHandle(FEvent);
End;
{ TLANThread }
.
.
.
{ TPingThread }
//---------------------------------------------------------
Constructor TPingThread.Create(AHostIP: String; AEventName: String; ATimeOut: Integer);
Begin
Inherited Create(AEventName);
If Not EventOwned Then Exit;
FTimeOut := ATimeOut;
FcmpClient := TIdIcmpClient.Create(Nil);
With FcmpClient Do
Begin
Host := AHostIP;
ReceiveTimeOut := ATimeOut;
OnReply := ReplyEvent;
End;
End;
//---------------------------------------------------------
Procedure TPingThread.Execute;
Begin
Try
FcmpClient.Ping;
FReply := FReply And (WaitForSingleObject(FEvent, FTimeOut) = WAIT_OBJECT_0);
Except
FReply := False;
End;
End;
//---------------------------------------------------------
Procedure TPingThread.ReplyEvent(Sender: TComponent; Const AReplyStatus: TReplyStatus);
Begin
With AReplyStatus Do
FReply := (ReplyStatusType = rsEcho) And (BytesReceived <> 0);
SetEvent(FEvent);
End;
//---------------------------------------------------------
Procedure TPingThread.ThreadTerminate(Sender: TObject);
Begin
FreeAndNil(FcmpClient);
Inherited;
End;
{ TNetThread }
.
.
.