I have a function which works on reading data from a file like :
procedure ReadDatafromFile (const aFilename : String; aparameterList : TList );
var aIniFile : TInifile;
begin
aIniFile :=TInifile.create(aFilename);
data1 := ReadInteger(......);
.....
....
end;
Now the contents of this file exists at a different location in my program as a StringList. I would like to reuse the existing code, and I would like to program it in a way like:
...
MydataStringList.SaveToFile('c:\temp\tempfile.txt');
ReadDatafromFile( MydataStringList, myparameterList);
...
Is there any smart solution to reuse the existing function and create an overloaded version which is accepting the StringList as a parameter?
That is doable:
procedure ReadDataFromStrings(aFileStrings: TStrings; aParameterList: TList);
overload;
begin
if aParameterList <> nil then
// Add aFileStrings to aParameterList
end;
procedure ReadDataFromFile(const aFileName: TFileName; aParameterList: TList);
overload;
var
Strings: TStringList;
begin
Strings := TStringList.Create;
try
Strings.LoadFromFile(aFileName);
ReadDataFromStrings(Strings, aParameterList);
finally
Strings.Free;
end;
end;
Instead of creating this local Strings variable, you could also use the already present global MydataStringList variable, whichever suits your needs.
Related
This may very well have been asked many times before but, if so, I cannot for the life of me find the answer. So I apologise in advance if this is the case.
I have this object in a Delphi unit. I'm collating a list of employers from one source which are of type TEmployerData as below.
Once I've collated a list of employers, I will then collect employee and payslips data from other sources which belong to each individual employer.
unit EmployerObjUnit;
interface
uses
Classes, SysUtils, Variants,Types, Generics.Collections, Generics.Defaults, EmployeeObjUnit, PayObjUnit;
type
TEmployerData = class
private
FErID: string;
FErName: string;
FErAccsRef: string;
FErPAYE: string;
FErAddr1: string;
FErAddr2: string;
FErAddr3: string;
FErAddr4: string;
FErPostCd: string;
FErPath: string;
FErEesList: TObjectList<TFPSEmployee>;
FErPayList: TObjectList<TFPSPayment>;
FErYears: TStringList;
procedure SetErID (const Value: string);
procedure SetErName (const Value: string);
procedure SetErAccsRef (const Value: string);
procedure SetErPAYE (const Value: string);
procedure SetErAddr1 (const Value: string);
procedure SetErAddr2 (const Value: string);
procedure SetErAddr3 (const Value: string);
procedure SetErAddr4 (const Value: string);
procedure SetErPostCd (const Value: string);
procedure SetErPath (const Value: string);
constructor Create; overload;
published
property ErID:string read FErID write SetErID;
property ErName:string read FErName write SetErName;
property ErAccsRef:string read FErAccsRef write SetErAccsRef;
property ErPAYE:string read FErPAYE write SetErPAYE;
property ErAddr1:string read FErAddr1 write SetErAddr1;
property ErAddr2:string read FErAddr2 write SetErAddr2;
property ErAddr3:string read FErAddr3 write SetErAddr3;
property ErAddr4:string read FErAddr4 write SetErAddr4;
property ErPostCd:string read FErPostCd write SetErPostCd;
property ErPath: string read FErPath write SetErPath;
property ErEesList: TObjectList<TFPSEmployee> read FErEesList;
property ErPayList: TObjectList<TFPSPayment> read FErPayList;
property ErYears: TStringList read FErYears;
public
procedure AddEmployee(const FPSEmployee: TFPSEmployee);
procedure AddPayslip(const FPSPayslip: TFPSPayment);
procedure AddYear(const Year: string);
end;
All well and dandy so far.
I want to store the employee and payslip data in the ErEEsList and ErPayList ObjectLists, and the relevant years these relate to in the ErYears StringList.
The rest of the class code is:
constructor TEmployerData.Create;
begin
inherited;
FErEesList:=TObjectList<TFPSEmployee>.Create(True);
FErPayList:=TObjectList<TFPSPayment>.Create(True);
FErYears:=TStringList.Create;
end;
procedure TEmployerData.SetErAccsRef(const Value: string);
begin
// all the other setters are in here
end;
procedure TEmployerData.AddEmployee(const FPSEmployee: TFPSEmployee);
var
IsDupe: Boolean;
i: integer;
begin
if FErEesList.Count=0 then
FErEesList.Add(FPSEmployee)
else
begin
IsDupe:=False;
for i := 0 to FErEesList.Count-1 do
begin
if (FErEesList[i].PayID=FPSEmployee.PayID)
AND (FErEesList[i].AccountsRef=FPSEmployee.AccountsRef)
AND (FErEesList[i].TaxYear=FPSEmployee.TaxYear) then
IsDupe:=True;
end;
if IsDupe=False then
FErEesList.Add(FPSEmployee);
if IsDupe=True then
FPSEmployee.Free;
end;
FErEesList.Sort(TComparer<TFPSEmployee>.Construct(
function(const A, B :TFPSEmployee): integer
begin
if A.TaxYear=B.TaxYear then
Result:=0
else if A.TaxYear<B.TaxYear then
Result:=-1
else
Result:=1;
end
));
end;
procedure TEmployerData.AddPayslip(const FPSPayslip: TFPSPayment);
begin
FErPayList.Add(FPSPayslip);
FErPayList.Sort(TComparer<TFPSPayment>.Construct(
function(const A, B :TFPSPayment): integer
begin
if A.TaxYear=B.TaxYear then
Result:=0
else if A.TaxYear<B.TaxYear then
Result:=-1
else
Result:=1;
end
));
end;
procedure TEmployerData.AddYear(const Year: string);
var
i: integer;
GotYr: Boolean;
begin
GotYr:=False;
if FErYears.Count=0 then
FErYears.Add(Year)
else
begin
for i := 0 to FErYears.Count-1 do
begin
if Year=FErYears[i] then
GotYr:=True;
end;
if GotYr=False then
FErYears.Add(Year);
end;
end;
end.
Now, I can collate my list of employers without issue. I can get the information I need for each employee and payslip, BUT when I try to write anything using AddEmployee() or AddYear(), I keep getting Access Violation errors (not even got as far as AddPayslip() yet!). Unfortunately, I'm not fluent enough to figure out why.
The above class is used in one Form unit.
ErsObjList: TObjectList<TEmployerData>;
The above is declared in the Private section of the form unit.
It is created when the form is created. It is freed when the form closes.
Then this is used to fill ErsObjList.
procedure TGetXMLForm.Button1Click(Sender: TObject);
var
//more XML variables
ANode, BNode, CNode: IXMLNode;
NumDir: string;
Employer: TEmployerData;
begin
ErStream:=TFileStream.Create('Employer List.xml', fmOpenRead);
// load of xml setup
try
if Length(XList)>0 then
begin
for i := 0 to Length(XList)-1 do
begin
SetLength(FPSList, 0);
FPSList:=TDirectory.GetFiles(XList[i], 'FPS*.xml', TSearchOption.soAllDirectories);
try
if Length(FPSList)>0 then
begin
// scan through ErListXML for the corresponding number
ErNodes:=ErListXML.DocumentElement.ChildNodes;
if ErNodes.Count>0 then
begin
for x:= 0 to Ernodes.Count-1 do
begin
ANode:=ErNodes[x].ChildNodes.FindNode('Number');
if StrToInt(ANode.Text)=StrToInt(NumDir) then
begin
// create an employer obj from ErListXML
Employer:=TEmployerData.Create;
Employer.ErID:=ANode.Text;
Employer.ErName:=ErNodes[x].ChildNodes.FindNode('Name').Text;
// and so on until
Employer.ErPath:=XList[i];
ErsObjList.Add(Employer);
end;
end;
end;
end;
except
ShowMessage('Exception class name :- '+E.ClassName);
Exit;
end;
end;
end;
ErListXML.Free;
except
ShowMessage('Error reading Employer List xml file');
end;
end;
Button1 gets my employer data from a source, and builds an ObjectList (ErsObjList) without issue.
Then I use this when Button2 is clicked:
procedure TGetXMLForm.Button2Click(Sender: TObject);
var
i: integer;
FPSStream: TStream;
begin
for i := 0 to ErsObjList.Count-1 do
begin
GetPayDetails(ErsObjList[i]);
WriteData;
end;
end;
Which in turn triggers a fuller version of this (I've just removed some basic code for readability - nothing which would affect the issue):
procedure TGetXMLForm.GetRTIDetails(const Employer: TEmployerData);
var
FpsList: TStringDynArray;
// other items
TaxYear: string;
Employee: TFPSEmployee;
Payslip: TFPSPayment;
DateConInf: TFormatSettings;
TaxCd: string;
begin
SetLength(FpsList, 0);
FpsList:=TDirectory.GetFiles(Employer.ErPath, 'FPS*.xml', TSearchOption.soAllDirectories);
if Length(FpsList)>0 then
begin
try
for i := 0 to Length(FpsList)-1 do
begin
// loading some data from XML files
TaxYear:=CNode.ChildNodes.FindNode('RelatedYear').Text;
Employer.AddYear(TaxYear);
// my code then triggers an AV in the "AddYear" procedure
This where it goes wrong.
It does call the procedure AddYear() with the correct value for TaxYear.
It does not flag up any compilation errors.
I would appreciate any help.
edited
For all the code I was trying to cycle through the answer should have been very obvious. But as I said I'm not experienced enough to know.
The TEmployerData class constructor was declared in the wrong place so these
FErEesList: TObjectList<TFPSEmployee>;
FErPayList: TObjectList<TFPSPayment>;
FErYears: TStringList;
were not being initialised correctly when an Employer object was being created. This then caused the runtime AVs.
I am using an in-memory TClientDataSet with a TStringField column which contains folders path (Delphi 7).
When I create an index on this column the order is not what I am looking for.
As an example I get :
c:\foo
c:\fôo\a
c:\foo\b
when I would like this order :
c:\foo
c:\foo\b
c:\fôo\a
So I searched a way to use my own compare field function.
Based on this RRUZ answer How to change the implementation (detour) of an externally declared function I tried the following :
type
TClientDataSetHelper = class(DBClient.TClientDataSet);
...
MyCDS : TClientDataSet;
...
// My custom compare field function
function FldCmpHack
(
iFldType : LongWord;
pFld1 : Pointer;
pFld2 : Pointer;
iUnits1 : LongWord;
iUnits2 : LongWord
): Integer; stdcall;
begin
// Just to test
Result := -1;
end;
...
---RRUZ code here---
...
procedure HookDataCompare;
begin
HookProc
(
(MyCDs as TClientDataSetHelper).DSBase.FldCmp, <== do not compile !!!
#FldCmpHack,
FldCmpBackup
);
end;
When I try to compile I get an error (MyCDs as TClientDataSetHelper).DSBase.FldCmp : not enough actual parameters
I do not understand why this does not compile. Could you please help me ?
Is it even possible to "detour" IDSBase.FldCmp in DSIntf.pas ? Am i totally wrong ?
Thank you
EDIT
Finally, thanks to Dsm answer, I transformed the TStringFieldcolumn into a TVarBytesField in order to avoid doubling the buffer. Plus, when a TVarBytesField is indexed the order is based on the bytes value so I get the order I want. For having all child folders after a parent folder and before the next parent folder (c:\foo.new after c:\foo\b), I patched TVarBytesFieldlike this :
TVarBytesField = class(DB.TVarBytesField)
protected
function GetAsString: string; override;
procedure GetText(var Text: string; DisplayText: Boolean); override;
procedure SetAsString(const Value: string); override;
end;
function TVarBytesField.GetAsString: string;
var
vBuffer : PAnsiChar;
vTaille : WORD;
vTexte : PAnsiChar;
vI : WORD;
begin
Result := '';
GetMem(vBuffer, DataSize);
try
if GetData(vBuffer) then
begin
vTaille := PWORD(vBuffer)^;
vTexte := vBuffer + 2;
SetLength(Result, vTaille);
for vI := 1 to vTaille do
begin
if vTexte^ = #2 then
begin
Result[vI] := '\';
end
else
begin
Result[vI] := vTexte^;
end;
Inc(vTexte);
end;
end;
finally
FreeMem(vBuffer);
end;
end;
procedure TVarBytesField.GetText(var Text: string; DisplayText: Boolean);
begin
Text := GetAsString;
end;
procedure TVarBytesField.SetAsString(const Value: string);
var
vBuffer : PAnsiChar;
vTaille : WORD;
vTexte : PAnsiChar;
vI : WORD;
begin
vBuffer := AllocMem(DataSize);
try
vTaille := WORD(Length(Value));
PWORD(vBuffer)^ := vTaille;
vTexte := vBuffer + 2;
for vI := 1 to vTaille do
begin
if Value[vI] = '\' then
begin
vTexte^ := #2
end
else
begin
vTexte^ := Value[vI];
end;
Inc(vTexte);
end;
SetData(vBuffer);
finally
FreeMem(vBuffer);
end;
end;
The message is telling you that FldCmp is a function, and it is expecting you to execute it, but it has not got enough parameters. I am sure that you already realised that and probably already tried to get the address of the function with the # (like you do for FldCmpHack) and found that that does not work.
The reason for that is, I am afraid, that FldCmp is not a normal function. DSBase is actually an interface, which will have been assigned (looking at the source code) by a class factory. What you actually need is the real function itself and for that you need the real object that the class factory creates. And I am sorry, but I can't see any realistic way of doing that.
However, the DSBase field is only created if it has not been assigned, so you could, in theory, create your own IDSBase interface object, which is the way this type of problem is meant to be handled. That is a lot of work, though, unless you know class that the class factory produces and can descend from that.
A sneakier alternative is to override the Translate property and create some sort of hash (perhaps by translating the ASCII codes to their HEX values) so that the database keeps them in the right order
TClientDataSetHelper = class(TClientDataSet)
public
function Translate(Src, Dest: PAnsiChar; ToOem: Boolean): Integer; override;
end;
I want to get info_hash of *.torrent file using Delphi.
Tried this BEncode decorder.
But it gives crazy characters when decode.
Any other working BEncode decoder in Delphi? Or anything I'm doing wrong?
This is my code:
procedure TForm.Button1Click(Sender: TObject);
var
be: TBEncoded;
fs: tfilestream;
op: string;
begin
fs := tfilestream.Create('xx.torrent', fmOpenReadWrite);
be := TBEncoded.Create(fs);
be.Encode(be.ListData.Items[0].Data, op);
showmessage(op);
be.Encode(be.ListData.FindElement('info'), op);
showmessage(op);
end;
I've just tried this decoder, it's working normally. You didn't need to use Encode procedure, its purpose (as seen from name) is to encode elements back to BEncode. That's test program that shows torrent information in TMemo:
procedure ShowDecoded(be: TBEncoded; indent: string='');
var i: Integer;
begin
with form1.Memo1.Lines do
case be.Format of
befstring: Add(indent+be.StringData);
befInteger: Add(indent+IntToStr(be.IntegerData));
befList: begin
Add(indent+'list');
for i:=0 to be.ListData.Count-1 do
ShowDecoded(be.ListData.Items[i].Data as TBEncoded,indent+' ');
Add(indent+'end of list');
end;
befDictionary: begin
Add(indent+'dict');
for i:=0 to be.ListData.Count-1 do begin
Add(indent+' '+be.ListData.Items[i].Header+'=');
ShowDecoded(be.listData.Items[i].Data as TBEncoded,indent+' ');
end;
Add(indent+'end of dict');
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var fs: TFileStream;
be: TBEncoded;
i: Integer;
begin
if OpenDialog1.Execute then begin
fs:=TFileStream.Create(OpenDialog1.FileName,fmOpenRead);
try
be:=TBEncoded.Create(fs);
ShowDecoded(be);
be.Free;
finally
fs.Free;
end;
end;
end;
That's test result:
dict
created by=
uTorrent/3.4.3
creation date=
1439626950
encoding=
UTF-8
info=
dict
length=
1345178
name=
Алябьев А., Лист Ф. - Соловей - 1987.pdf
piece length=
16384
pieces=
)Lo.Î ’üXí»IÙçsáôt£ˆb›hŒˆ*Ð誺š¤/N7’`0âÓ†nË5&T€:V•Ìפ¯9¤Ý:¦J©Ï|Œ•A¥,¼R¯þ:H:X&…¢<¸º"2îV-vÀÖˆD†¨¬ß‰ƒ,ümjà?éÛoe¬r£{¨¾]•4òØžhô†›¼AØBeJÕÌ4³·Œ‹¶ËAG— f„\pa
end of dict
end of dict
I'd make some changes to BEncode unit, there is mess in there: raising empty exceptions, unsafe cast: TBEncoded(object) instead of "object as TBEncoded",
checking for nil object before object.free, which is tautology, but in general it works.
Update 1
Simple code to take one of the fields, 'pieces' and show in hex.
procedure FindAndShowHash(be: TBEncoded);
var i: Integer;
s: string;
infoChunk, piecesChunk: TBencoded;
begin
s:='';
infoChunk:=be.ListData.FindElement('info') as TBencoded;
piecesChunk:=infoChunk.ListData.FindElement('pieces') as TBencoded;
for i:=1 to Length(piecesChunk.StringData) do
s:=s+IntToHex(Byte(piecesChunk.StringData[i]),2);
form1.Memo1.Lines.Add('Hash function:');
form1.Memo1.Lines.Add(s);
end;
As you see, we access StringData char by char and cast it as Byte. I just showed it in hex, of course you can use these bytes for further processing.
Beware: you'll get LOADS of hex values, this is not MD5 hash or any other hash of WHOLE torrent, it's sequence of hash functions for each piece of data, usually blocks of 1 or 2 MB.
UPDATE 2
This unit can be used in newer versions of Delphi, all you need to do is to replace ALL string variables in it from 'string' to 'ANSIstring', just with Ctrl+R - ':string' replace to ':ANSIstring'.
UPDATE 3
OK, finally I get it. Here is procedure which computes info_hash and shows it in hex, this requires newer version of Delphi. Also, add IdGlobal and IdHashSHA to 'uses' section.
procedure makeInfoHash(be: TBEncoded);
var SHA1: TIdHashSHA1;
s: string;
infoChunk: TBencoded;
infoEncoded: ANSIString;
bytes: TIdBytes;
begin
infoChunk:=be.ListData.FindElement('info') as TBencoded;
TBencoded.Encode(infoChunk,infoEncoded);
bytes:=RawToBytes(infoEncoded[1],Length(infoEncoded));
SHA1:=TIdHashSHA1.Create;
try
s:=SHA1.HashBytesAsHex(bytes);
finally
SHA1.Free;
end;
Form1.Memo1.Lines.Add(s);
end;
It gives correct info_hash, the same which is displayed in uTorrent, like this:
7D0487D3D99D9C27A7C09CDCBB2F2A8034D4F9BF
You must replace all string to ANSIstring in BENcode.pas, as said in update 2. Enjoy!
Delphi XE6 - I have a Unit (EMAIL1.pas) which does related processing. This is meant to be a standalone unit I can incorporate into multiple programs. My initial procedure is called GetDetailsFromEmailAddress. It has two parameters, an email address which I lookup and a "group of data" which will get updated, currently defined as a var. This can be a record or a class, I don't really care. It is just a group of related strings (firstname, last name, city, etc). Let's call this EmpRec.
My challenge is that this procedure creates an instance of a class (JEDI VCL HTMLParser) which uses a method pointer to call a method (TableKeyFound). This routine needs to update EmpRec. I do not want to change this code (HTMLPArser routine) to add additional parameters. There are several other procedures that my UNIT creates. All of them need to read/update EmpRec. How do I do this?
I need a way to "promote" the variable EmpRec which is passed in this one routine (GetDetailsFromEmailAddress) to be GLOBAL within this UNIT so that all the routines can access or change the various elements. How do I go about this? I do NOT really want to have to define this as a GLOBAL / Application wide variable.
Code sample below. So.. How does the routine TableKeyFoundEx get access to the EmpRec variable?
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
begin
...
// Now create the HTML Parser...
JvHtmlParser1 := TJvHTMLParser.Create(nil);
// On event KeyFoundEx, call Parsehandlers.TableKeyFoundEx;
JvHtmlParser1.OnKeyFoundEx := ParseHandlers.TableKeyFoundEx;
...
end.
procedure TParseHandlers.TableKeyFoundEx(Sender: TObject; Key, Results, OriginalLine: String; TagInfo: TTagInfo;
Attributes: TStrings);
begin
..
// NEED ACCESS to EmpRec here, but can't change procedure definition
end;
There are two different ways I would approach this:
use the parser's Tag property:
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
begin
...
JvHtmlParser1 := TJvHTMLParser.Create(nil);
JvHtmlParser1.OnKeyFoundEx := ParseHandlers.TableKeyFoundEx;
JvHtmlParser1.Tag := NativeInt(#EmpRec);
...
end;
procedure TParseHandlers.TableKeyFoundEx(Sender: TObject; Key, Results, OriginalLine: String; TagInfo: TTagInfo; Attributes: TStrings);
var
EmpRec: PEmpRec; // assuming PEmpRec = ^TEmpRec
begin
EmpRec := PEmpRec(TJvHTMLParser(Sender).Tag);
...
end;
use a little TMethod hack to pass the record DIRECTLY to the event handler:
// Note: this is declared as a STANDALONE procedure instead of a class method.
// The extra DATA parameter is where a method would normally pass its 'Self' pointer...
procedure TableKeyFoundEx(Data: Pointer: Sender: TObject; Key, Results, OriginalLine: String; TagInfo: TTagInfo; Attributes: TStrings);
var
EmpRec: PEmpRec; // assuming PEmpRec = ^TEmpRec
begin
EmpRec := PEmpRec(Data);
...
end;
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
var
M: TMethod;
begin
...
JvHtmlParser1 := TJvHTMLParser.Create(nil);
M.Code := #TableKeyFoundEx;
M.Data := #EmpRec;
JvHtmlParser1.OnKeyFoundEx := TJvKeyFoundExEvent(M);
...
end;
In addition to the two options that Remy offers, you could derive a sub-class of TJvHTMLParser.
type
PEmpRec = ^TEmpRec;
TMyJvHTMLParser = class(TJvHTMLParser)
private
FEmpRec: PEmpRec;
public
constructor Create(EmpRec: PEmpRec);
end;
....
constructor TMyJvHTMLParser.Create(EmpRec: PEmpRec);
begin
inherited Create(nil);
FEmpRec := EmpRec;
end;
When you create the parser, do so like this:
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
var
Parser: TMyJvHTMLParser;
begin
Parser := TMyJvHTMLParser.Create(#EmpRec);
try
Parser.OnKeyFoundEx := ParseHandlers.TableKeyFoundEx;
....
finally
Parser.Free;
end;
end.
And in your OnKeyFoundEx you cast Sender back to the parser type to gain access to the record:
procedure TParseHandlers.TableKeyFoundEx(Sender: TObject; ...);
var
EmpRec: PEmpRec;
begin
EmpRec := (Sender as TMyJvHTMLParser).FEmpRec;
....
end;
The title may be updated once the question is posted, But I start with an .ini file I would like to save Integers , Strings , Bool To this .ini file. Which I can do with
WriteString
WriteInteger
WriteBool
Then I Would like to read it into a list, Where when i pulled the data from the list it would know its all ready a integer or string or bool?
Currently I have to write everything as a string and then i read into a stringlist.
As said, you can read all data as string. And you can use the following function to determine the datatype:
type
TDataType = (dtString, dtBoolean, dtInteger);
function GetDatatype(const AValue: string): TDataType;
var
temp : Integer;
begin
if TryStrToInt(AValue, temp) then
Result := dtInteger
else if (Uppercase(AValue) = 'TRUE') or (Uppercase(AValue) = 'FALSE') then
Result := dtBoolean
else
Result := dtString;
end;
You can (ab)use the object property of the stringlist to store the datatype:
procedure TMyObject.AddInteger(const AValue: Integer);
begin
List.AddObject(IntToStr(AValue), TObject(dtInteger));
end;
procedure TMyObject.AddBoolean(const AValue: Boolean);
begin
List.AddObject(BoolToStr(AValue), TObject(dtBoolean));
end;
procedure TMyObject.AddString(const AValue: String);
begin
List.AddObject(AValue, TObject(dtString));
end;
function TMyObject.GetDataType(const AIndex: Integer): TDataType;
begin
Result := TDataType(List.Objects[AIndex]);
end;