tag:blogger.com,1999:blog-18748387942810780622024-03-06T05:56:16.834+01:00GloeggDeveloper by day
Coder by nightAnonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.comBlogger420125tag:blogger.com,1999:blog-1874838794281078062.post-55040942521631275112013-10-18T21:37:00.000+02:002013-10-18T21:37:42.200+02:00Recent additions to delphi-xe-json<div style="text-align: justify;">
I finally found some time to add two features to my <a href="https://bitbucket.org/Gloegg/delphi-xe-json" target="_blank">delphi-xe-json</a> library.<br />
<br />
I wrote a Formatter for JSON, that doesn't try to read the input into an IJSONArray or IJSONObject. The advantage is, that it even formats invalid JSON, which might make it easier to spot what is wrong with it.<br />
I'm not completely happy with it, because it violates the <a href="http://principles-wiki.net/principles:don_t_repeat_yourself" target="_blank">DRY-Principle</a> twice. I copied a method from TJSONReader and another one from TJSONReadableWriter, but I already have an idea how to fix that.<br />
<br />
The other addition is bigger and still a work in progress, which is why I haven't merged the branch back into the master branch. I decided to share it anyway, because it is working with some restrictions and I don't think that the interface is changing a lot in the next time.<br />
<br />
The idea was to generate Plain Old Delphi Objects (PODOs) from a JSON string. I utilized the code generator from <a href="http://wiert.me/" target="_blank">Jeroen Pluimers</a> which he kindly put under BSD-License in the repository from <a href="https://bo.codeplex.com/" target="_blank">better-office benelux</a>.<br />
<br />
For convenience, I copied the three needed units in the delphi-xe-json repository, but I recommend using the original ones.<br />
<br />
The usage is very simple:<br />
<pre class="brush:delphi">var
jo : IJSONObject;
begin
jo := TJSON.NewObject({some json string});
Memo1.Lines.Text := TJSON.GeneratePODOUnit(jo);
end;
</pre>
<br />
JSON-Input:<br />
<pre class="brush:js">{
"Name":"Test",
"AnswerToLife":42,
"Items":
[
1.41,
2.72,
3.13
]
}
</pre>
<br />
Generated Unit
<pre class="brush:delphi">unit GeneratedUnit;
interface
uses
Generics.Collections,
JSON;
type
TItemsList = class;
TGeneratedClass = class;
TItemsList = class(TList<double>)
public
procedure LoadFromFile(aFilename : string);
procedure SaveToFile(aFilename : string);
procedure LoadFromJSON(ja : IJSONArray);
procedure SaveToJSON(ja : IJSONArray);
end;
TGeneratedClass = class(TObject)
strict private
fItems: TItemsList;
fAnswerToLife: integer;
fName: string;
public
procedure LoadFromFile(aFilename : string);
procedure SaveToFile(aFilename : string);
constructor Create();
destructor Destroy(); override;
procedure LoadFromJSON(jo : IJSONObject);
procedure SaveToJSON(jo : IJSONObject);
property Items: TItemsList read fItems;
property AnswerToLife: integer read fAnswerToLife write fAnswerToLife;
property Name: string read fName write fName;
end;
implementation
uses
IOUtils;
{ TItemsList }
procedure TItemsList.LoadFromFile(aFilename : string);
var
json: IJSONArray;
s: string;
begin
s := TFile.ReadAllText(aFilename);
json := TJSON.NewArray(s);
LoadFromJSON(json);
end;
procedure TItemsList.SaveToFile(aFilename : string);
var
json: IJSONArray;
begin
json := TJSON.NewArray;
SaveToJSON(json);
TFile.WriteAllText(aFilename, json.ToString);
end;
procedure TItemsList.LoadFromJSON(ja : IJSONArray);
var
i: integer;
begin
for i := 0 to ja.Count - 1 do
begin
Items[i] := ja.GetDouble(i);
end;
end;
procedure TItemsList.SaveToJSON(ja : IJSONArray);
var
i: integer;
begin
for i := 0 to ja.Count - 1 do
begin
ja.put(Items[i]);
end;
end;
{ TGeneratedClass }
procedure TGeneratedClass.LoadFromFile(aFilename : string);
var
json: IJSONObject;
s: string;
begin
s := TFile.ReadAllText(aFilename);
json := TJSON.NewObject(s);
LoadFromJSON(json);
end;
procedure TGeneratedClass.SaveToFile(aFilename : string);
var
json: IJSONObject;
begin
json := TJSON.NewObject;
SaveToJSON(json);
TFile.WriteAllText(aFilename, json.ToString);
end;
constructor TGeneratedClass.Create();
begin
fItems := TItemsList.Create;
end;
destructor TGeneratedClass.Destroy();
begin
fItems.Free;
inherited;
end;
procedure TGeneratedClass.LoadFromJSON(jo : IJSONObject);
begin
fItems.LoadFromJSON(jo.GetJSONArray('Items'));
fAnswerToLife := jo.GetInteger('AnswerToLife');
fName := jo.GetString('Name');
end;
procedure TGeneratedClass.SaveToJSON(jo : IJSONObject);
var
jaItems: IJSONArray;
begin
jaItems := TJSON.NewArray;
fItems.SaveToJSON(jaItems);
jo.Put('Items', jaItems);
jo.Put('AnswerToLife', fAnswerToLife);
jo.Put('Name', fName);
end;
end. </pre>
</div>
Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com1tag:blogger.com,1999:blog-1874838794281078062.post-82910304746495592652013-10-11T11:12:00.002+02:002013-10-11T11:14:02.954+02:00Moving my public repositories<div style="text-align:justify">I am moving my public repositories from Google Code to Bitbucket and also from SVN to git.
So far these repositories have moved:
delphi-xe-json: https://bitbucket.org/Gloegg/delphi-xe-json
delphi-redis: https://bitbucket.org/Gloegg/delphi-redis</div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-67395439525886031942013-08-16T14:28:00.002+02:002013-08-16T14:28:55.915+02:00How to include source, debug DCUs and release DCUs in the Delphi-Options<div style="text-align:justify">Once again, StackOverflow proves to be a source of useful information:<br/>
This <a href="http://stackoverflow.com/a/4107917/1131723">answer</a> on SO explains how libraries should be included in the Delphi-Options.
<br/>
In a nutshell:
<ol>
<li>Library Path = Release DCUs</li>
<li>Browsing Path = Source</li>
<li>Debug DCU Path = Debug DCUs</li></ol></div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-63261111588192003812013-07-16T23:06:00.002+02:002013-07-16T23:06:50.945+02:00New Repository: Delphi-Helpers<div style="text-align:justify">I am planning to collect all my little helper units in a single repository.
<br/>
I'm starting with TSpecialFolder.
<br/>
<pre class="brush:delphi"> TSpecialFolder = record
private
class function GetSpecialFolder(CSIDL: Integer) : string; static;
class function GetProgramFiles : string; static;
class function GetProgramFilesX86 : string; static;
class function GetUserDocuments : string; static;
class function GetAppData : string; static;
class function GetCommonAppData : string; static;
class function getTempPath: string; static;
public
class property ProgramFiles : string read GetProgramFiles;
class property ProgramFilesX86 : string read GetProgramFilesX86;
class property UserDocuments : string read GetUserDocuments;
class property UserAppData : string read GetAppData;
class property CommonAppData : string read GetCommonAppData;
class property TempPath : string read getTempPath;
end;</pre><br/>
Usage:<br/>
<pre class="brush:delphi">
procedure Save;
begin
SaveDialog1.InitialDir := TSpecialFolder.UserDocuments;
if SaveDialog1.Execute then
begin
// Save the file
end;
end;</pre>
You can get the unit from my delphi-helpers git repository
<a href="https://code.google.com/p/delphi-helpers/">https://code.google.com/p/delphi-helpers/</a>
<br/>
<br/>
BTW:
You can now vote for this blog to be added to <a href="http://www.delphifeeds.com/">DelphiFeeds.com</a>: <a href="http://delphifeeds.uservoice.com/forums/14264-feedback/suggestions/4147767-add-gloegg-blogspot-com-to-delphi-feeds">Vote here</a></div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-44306068453390596892013-07-16T22:51:00.001+02:002013-07-16T22:51:53.202+02:00Some concepts for a Delphi Webserver with API versioning<div style="text-align:justify">When I began programming at my first company in a practical semester, the very first application I wrote, used TCP/IP to communicate with the existing applications. Almose every application I developed since, was using some kind of network communication to control another application or to be controlled by other applications. Over the years, I added other platforms (iOS and Android), which controlled the delphi applications. In every new project, I tried to tune the server side a little bit, to make my life easier.<br/>
<br/>
Recently, I extended the server part to support multiple versions of an API.<br/>
<br/>
The idea is that there is one IWebAPI interface, which represents the public API. The TAbstractAPI "implements" this interface. The real API classes inherit from this class and implement the methods they want. Having an abstract class between the interface and the implementation releases the real API classes from having to implement every method from the interface.<br/>
<br/>
The API classes register themselves in a TWebAPIFactory, which will instantiate these classes when needed.<br/>
<br/>
An example of an API
<pre class="brush:delphi">
unit WebAPI.Version1;
interface // empty interface section, I think Nick Hodges would like this ;-) (http://www.nickhodges.com/post/Getting-Giddy-with-Dependency-Injection-and-Delphi-Spring-5-Delphi-Spring-Basics.aspx)
implementation
uses
JSON, WebAPI.Abstract, WebAPI.Factory;
type
TWebAPIVersion1 = class(TAbstractAPI)
function ReverseString(jo: IJSONObject): string; override;
end;
{ TWebAPIVersion1 }
function TWebAPIVersion1.ReverseString(jo: IJSONObject): string;
var
ch: char;
begin
result := '';
for ch in jo.GetString('value') do
begin
result := ch + result;
end;
end;
initialization
begin
TWebAPIFactory.RegisterAPI('1', TWebAPIVersion1);
end;
end.</pre>
<br/>
Another concept, which has been used in my previous applications is that the methods of the api are not called directly. Instead, Rtti is used to invoke the right method.<br/>
<pre class="brush:delphi">class function TWebAPIInvoker.Invoke(const aAPI: IWebAPI; const aCommand: string; aParam: IJSONObject): string;
var
o: TObject;
ctx: TRttiContext;
typ: TRttiType;
m: TRttiMethod;
begin
o := TObject(aAPI);
typ := ctx.GetType(o.ClassInfo);
m := typ.GetMethod(aCommand);
if assigned(m) then
begin
result := m.Invoke(o, [TValue.From<IJSONObject>(aParam)]).AsString;
end
else
raise Exception.Create('Unknown Command: "' + aCommand + '"');
end;</pre>
I used the IJSONObject from my <a href="http://gloegg.blogspot.de/2013/02/delphi-xe-json-update.html">JSON-Library</a> as a parameter, because it has been proven to be a reliable format for passing complex data over the borders of applications. <br/>
<br/>
These concepts are glued together in the datamodule, that holds an IdHTTPServer.<br/>
<pre class="brush:delphi">procedure TdmWebserver.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
if isAPIRequest(ARequestInfo.Document) then
HandleAPIRequest(AContext, ARequestInfo, AResponseInfo)
else // Is File Request
HandleFileRequest(AContext, ARequestInfo, AResponseInfo);
end;
function TdmWebserver.isAPIRequest(const aDocument: string): boolean;
begin
result := aDocument.StartsWith('/api/');
end;
procedure TdmWebserver.HandleAPIRequest(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
documentParts: TArray<string>;
version, command: string;
api: IWebAPI;
i: integer;
begin
// e.g. /api/1/ReverseString
documentParts := ARequestInfo.Document.Split(['/'], TStringSplitOptions.ExcludeEmpty);
version := documentParts[1];
command := '';
for i := 2 to high(documentParts) do
begin
command := command + documentParts[i];
end;
api := TWebAPIFactory.newAPI(version);
AResponseInfo.ContentText := TWebAPIInvoker.Invoke(api, command, nil)
end;</pre>
<br/>
It is a work in progess, so use it carefully!<br/>
Delphi XE3 is required.<br/>
<br/>
You can get the source code from the git repository at <a href="http://code.google.com/p/delphi-webapi/">http://code.google.com/p/delphi-webapi/</a>
</div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-84765381800394593872013-02-10T16:59:00.000+01:002013-02-10T16:59:13.652+01:00Delphi XE JSON Update<div style="text-align:justify">I recently updated my <a href="http://code.google.com/p/delphi-xe-json/">JSON-Library</a>. Both, IJSONObject and IJSONArray now have methods to check for the type of the nested items.
<pre class="brush:delphi">IJSONObject = interface
['{D00A665F-3CBB-4DDB-8300-FB8020DA564B}']
.
.
.
function isJSONObject(aKey : string) : boolean;
function isJSONArray(aKey : string) : boolean;
function isString(aKey : string) : boolean;
function isInteger(aKey : string) : boolean;
function isBoolean(aKey : string) : boolean;
function isDouble(aKey : string) : boolean;
end;
IJSONArray = interface
['{B120D59A-1D00-469E-97CE-AE2A635A51ED}']
.
.
.
function isJSONObject(aIndex : integer) : boolean;
function isJSONArray(aIndex : integer) : boolean;
function isString(aIndex : integer) : boolean;
function isInteger(aIndex : integer) : boolean;
function isBoolean(aIndex : integer) : boolean;
function isDouble(aIndex : integer) : boolean;
end;</pre>
</br>
Usage:
<pre class="brush:delphi">var
jo : IJSONObject;
begin
jo := TJSON.NewObject('{"string":"abc", "integer":123}');
jo.isString('string'); // true
jo.isInteger('integer'); // true
jo.isBoolean('string'); // false
end;</pre>
The implementation is very strict, e.g. isDouble will return false if the value is an integer and could be accessed as a double. I also included unit tests to cover these methods.</div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-91403377330161218172013-02-10T16:43:00.001+01:002013-02-10T16:43:35.939+01:00tracert -h 60 obiwan.scrye.net<div style="text-align:justify">Someone had fun with the routing at <a href="http://beaglenetworks.net/">Beaglenetworks</a>
<br/>
<pre>Routenverfolgung zu obiwan.scrye.net [216.81.59.173] über maximal 60 Abschnitte:
7 137 ms 127 ms 127 ms 10gigabitethernet1-2.core1.atl1.he.net [184.105.213.110]
8 126 ms 126 ms 127 ms 216.66.0.26
9 * * * Zeitberschreitung der Anforderung.
10 163 ms 165 ms 164 ms Episode.IV [206.214.251.1]
11 193 ms 166 ms 164 ms A.NEW.HOPE [206.214.251.6]
12 169 ms 164 ms 167 ms It.is.a.period.of.civil.war [206.214.251.9]
13 168 ms 164 ms 166 ms Rebel.spaceships [206.214.251.14]
14 169 ms 163 ms 164 ms striking.from.a.hidden.base [206.214.251.17]
15 169 ms 165 ms 165 ms have.won.their.first.victory [206.214.251.22]
16 165 ms 167 ms 165 ms against.the.evil.Galactic.Empire [206.214.251.25]
17 165 ms 164 ms 168 ms During.the.battle [206.214.251.30]
18 166 ms 164 ms 165 ms Rebel.spies.managed [206.214.251.33]
19 166 ms 167 ms 162 ms to.steal.secret.plans [206.214.251.38]
20 166 ms 165 ms 163 ms to.the.Empires.ultimate.weapon [206.214.251.41]
21 165 ms 163 ms 164 ms the.DEATH.STAR [206.214.251.46]
22 168 ms 166 ms 167 ms an.armored.space.station [206.214.251.49]
23 164 ms 169 ms 167 ms with.enough.power.to [206.214.251.54]
24 164 ms 189 ms 168 ms destroy.an.entire.planet [206.214.251.57]
25 170 ms 168 ms 174 ms Pursued.by.the.Empires [206.214.251.62]
26 166 ms 169 ms 167 ms sinister.agents [206.214.251.65]
27 166 ms 163 ms 166 ms Princess.Leia.races.home [206.214.251.70]
28 168 ms 163 ms 163 ms aboard.her.starship [206.214.251.73]
29 168 ms 171 ms 165 ms custodian.of.the.stolen.plans [206.214.251.78]
30 169 ms 172 ms 168 ms that.can.save.her [206.214.251.81]
31 166 ms * 165 ms people.and.restore [206.214.251.86]
32 168 ms 167 ms 164 ms freedom.to.the.galaxy [206.214.251.89]
33 166 ms 166 ms 164 ms 0-------------------0 [206.214.251.94]
34 165 ms 170 ms 166 ms 0------------------0 [206.214.251.97]
35 168 ms 170 ms 164 ms 0-----------------0 [206.214.251.102]
36 166 ms 169 ms 168 ms 0----------------0 [206.214.251.105]
37 167 ms 168 ms 164 ms 0---------------0 [206.214.251.110]
38 163 ms 165 ms 165 ms 0--------------0 [206.214.251.113]
39 167 ms 171 ms 166 ms 0-------------0 [206.214.251.118]
40 167 ms 166 ms 172 ms 0------------0 [206.214.251.121]
41 166 ms 165 ms 165 ms 0-----------0 [206.214.251.126]
42 172 ms 169 ms 172 ms 0----------0 [206.214.251.129]
43 165 ms 168 ms 166 ms 0---------0 [206.214.251.134]
44 168 ms 163 ms 168 ms 0--------0 [206.214.251.137]
45 166 ms 167 ms 260 ms 0-------0 [206.214.251.142]
46 166 ms 164 ms 173 ms 0------0 [206.214.251.145]
47 164 ms 167 ms 165 ms 0-----0 [206.214.251.150]
48 168 ms 166 ms 168 ms 0----0 [206.214.251.153]
49 166 ms 164 ms 168 ms 0---0 [206.214.251.158]
50 184 ms 171 ms 169 ms 0--0 [206.214.251.161]
51 168 ms 170 ms 168 ms 0-0 [206.214.251.166]
52 165 ms 168 ms 169 ms 00 [206.214.251.169]
53 172 ms 169 ms 165 ms I [206.214.251.174]
54 171 ms 169 ms 169 ms By.Ryan.Werber [206.214.251.177]
55 171 ms 168 ms 171 ms When.CCIEs.Get.Bored [206.214.251.182]
56 167 ms 168 ms 173 ms read.more.at.beaglenetworks.net [206.214.251.185]
57 179 ms 170 ms 166 ms FIN [216.81.59.173]
Ablaufverfolgung beendet.</pre>
</div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-76311718305133872622013-01-31T16:03:00.001+01:002013-01-31T16:03:45.439+01:00Instacode<div style="text-align:justify"><a href="http://instacode.linology.info/">Instacode</a> is for developers what <a href="http://instagram.com/">Instagram</a> is for hipsters.
Just paste your code into the textfield and choose the level of "hipness" to get a nice image of your code. The range of supported languages is amazing and our beloved Delphi is supported as well.
<br/>
<br/>
The service is currently not working, due to the heavy load of users, that are trying to "beautify" their code.
<br/>
Here's an example from the website:
<div class="separator" style="clear: both; text-align: center;">
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiekYhC478tdOyZGlMq0E9gdBIWSRytBp1-wUsJW5IyqbdudYNgNoa_qwqUk-Pehg3Z2FUSWF-2k5lPPCtqkW8Xg2Le2DhAfyu-2NCeIGq0wfOVZuymD1-KOiYJZD7ROE_gQEr0GtG69Eo/s1600/8432978818_eee9e5b4dd_o.jpg" imageanchor="1" style="margin-left:1em; margin-right:1em"><img border="0" height="320" width="320" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiekYhC478tdOyZGlMq0E9gdBIWSRytBp1-wUsJW5IyqbdudYNgNoa_qwqUk-Pehg3Z2FUSWF-2k5lPPCtqkW8Xg2Le2DhAfyu-2NCeIGq0wfOVZuymD1-KOiYJZD7ROE_gQEr0GtG69Eo/s320/8432978818_eee9e5b4dd_o.jpg" /></a></div>
<br/>
<br/>
PS: If you are visiting the site with IE, you are in for a treat ;-)
</div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-2244201800401480292013-01-28T21:58:00.000+01:002013-01-28T21:58:00.366+01:00Delphi and Sleepsort<div style="text-align: justify;">A while ago, someone on 4chan posted a fun sorting algorithm. It is called <a href="http://dis.4chan.org/read/prog/1295544154">Sleepsort</a> and is not recommended to be usedin production. However, I thought it would be fun to implement it in Delphi.
Here it is (for your amusement):
<pre class="brush:delphi">program Sleepsort;
var
items: TArray<integer>;
i: integer;
begin
randomize;
writeln('Random: ');
setlength(items, 25);
for i := 0 to High(items) do
begin
items[i] := random(length(items) * 4);
write(IntToStr(items[i]) + ' ');
end;
writeln;
writeln('Sorted: ');
for i := 0 to high(items) do
begin
TSortThread.Create(items[i]);
end;
readln;
end.</pre>
<pre class="brush:delphi">unit uSortThread;
interface
uses
Classes;
type
TSortThread = class (TThread)
private
fValue : integer;
protected
procedure Execute; override;
public
constructor Create(n : integer);
end;
implementation
uses SysUtils;
constructor TSortThread.Create(n: integer);
begin
inherited Create;
fValue := n;
end;
procedure TSortThread.Execute;
begin
sleep(fValue * 333); // artificial slowdown, to make the process visible for the human eye
write(IntToStr(fValue)+' ');
end;
end. </pre>
</div>
Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-92134252764964928232012-02-18T14:10:00.000+01:002012-02-18T14:11:12.189+01:00Delphi and Redis<div style="text-align: justify;">
<a href="http://redis.io/" target="_blank">Redis</a> is short for Remote Dictionary Server and it is a NoSQL-Database or more specific, a Key-Value-Store. Since there was no Client for Delphi, I decided to write one by myself. </div>
<div style="text-align: justify;">
<br /></div>
<div style="text-align: justify;">
</div>
<br />
<div style="text-align: justify;">
The project is available on Google Code: <a href="http://code.google.com/p/delphi-redis/">http://code.google.com/p/delphi-redis/</a></div>
<div style="text-align: justify;">
It uses the Indy TCP Client by default, but you can use either Constructor or Property Injection to switch to another implementation.</div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com1tag:blogger.com,1999:blog-1874838794281078062.post-38233925721009786362012-02-01T21:28:00.000+01:002012-02-01T21:28:55.113+01:00Delphi and JSON<div style="text-align: justify;">
I am currently developing my own JSON Library for Delphi. There are already libraries for that, but none of them suited my needs.<br />
There is the built-in DBXJSON, which is used in the DataSnap part of Delphi. However, it is a bit of a hassle to work with.<br />
There is <a href="http://www.simonjstuart.com/delphi-stuff/tlakjson/">TlkJSON</a> from Simon Stuart, which has (or had, I don't know the current status) some problems with Umlauts (ä,ö,ü,ß, etc.)<br />
There is the <a href="http://sourceforge.net/projects/is-webstart/">Delphi Web Utils</a> from Jose Fabio N Almeida, which has some memory issues and other bugs, and most importantly, does not work well under XE2. It also hasn't been updated for a while.<br />
And there is the <a href="http://www.progdigy.com/?page_id=6">SuperObject</a> which is very powerful, but it has IMO a horrible syntax.<br />
<br />
Since I was using the Delphi Web Utils before and I didn't want to rewrite all my other code when switching libraries, I designed my Interfaces and Classes in a similar way, e.g. the objects and array have methods named "Put" and "GetString".<br />
<br />
I have released <a href="http://code.google.com/p/delphi-xe-json/">my library</a> on Google Code. You can check it out via subversion or you can download the zipfile. Any feedback or help is appreciated.
It uses Generics, Rtti (for TValue) and Regular Expressions, which is why it is targeted only for newer versions of Delphi (XE and XE2).</div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-31755232984056591522011-10-23T10:43:00.000+02:002011-10-23T14:45:13.603+02:00Delphi and RTTI / Class Helper<div style="text-align: justify;">
In many of my applications I have some data-objects which look something like this:
<br />
<pre class="brush:delphi">type
TMyObject = class
private
fInt: integer;
fDouble: double;
fBool: boolean;
public
property IntegerProp : integer read fInt write fInt;
property DoubleProp : double read fDouble write fDouble;
property BoolProp : boolean read fBool write fBool;
end;</pre>
Writing a SaveToFile and LoadFromFile for each is tedious work and if I change the object I have to change the two procedures as well. With Delphis support for RTTI and class helpers we can get rid of the tedious work.
I am using a class helper for TObject, so technically its possible to do this with every object.
<br />
<pre class="brush:delphi"> TSerialHelper = class helper for TObject
private
function isPublicProperty(aProperty : TRttiProperty): boolean;
public
function Serialize(aHumanreadable : boolean = true) : string;
procedure Deserialize(const text : string);
end;</pre>
And here is the implementation:
<br />
<pre class="brush:delphi">function TSerialHelper.Serialize(aHumanreadable : boolean = true): string;
var
context : TRttiContext;
typ : TRttiType;
prop : TRttiProperty;
soJSON : ISuperObject;
value : TValue;
begin
context := TRttiContext.Create;
try
typ := context.GetType(self.ClassType);
soJSON := SO; // Get Superobject Interface
for prop in typ.GetProperties do
begin
if isPublicProperty(prop) and prop.IsWritable then
begin
value := prop.GetValue(self);
case value.Kind of
tkInteger, tkInt64 :
soJSON.I[prop.Name] := value.AsInteger;
tkEnumeration:
if value.IsType<boolean> then
soJSON.B[prop.Name] := value.AsBoolean;
tkFloat:
soJSON.D[prop.Name] := value.AsExtended;
tkChar, tkString, tkWChar, tkLString, tkWString, tkUString:
soJSON.S[prop.Name] := value.AsString;
end;
end;
end;
result := soJSON.AsJSon(aHumanreadable);
finally
context.Free;
end;
end;
procedure TSerialHelper.Deserialize(const text: string);
var
context : TRttiContext;
typ : TRttiType;
prop : TRttiProperty;
soJSON : ISuperObject;
begin
context := TRttiContext.Create;
try
soJSON := SO(text); // Init the Superobject Interface
typ := context.GetType(self.ClassType);
for prop in typ.GetProperties do
begin
if isPublicProperty(prop) and prop.IsWritable then
begin
case prop.PropertyType.TypeKind of
tkInteger, tkInt64 :
prop.SetValue(self, TValue.From<int64>(soJSON.I[prop.Name]));
tkEnumeration:
if prop.GetValue(self).IsType<boolean> then
prop.SetValue(self, TValue.From<boolean>(soJSON.B[prop.Name]));
tkFloat:
prop.SetValue(self, TValue.From<double>(soJSON.D[prop.Name]));
tkChar, tkString, tkWChar, tkLString, tkWString, tkUString:
prop.SetValue(self, TValue.From<string>(soJSON.S[prop.Name]));
end;
end;
end;
finally
context.Free;
end;
end;
function TSerialHelper.isPublicProperty(aProperty: TRttiProperty): boolean;
begin
result := aProperty.Visibility in [mvPublic, mvPublished];
end;</pre>
It is not finished, since it can't serialize sets, arrays or childobjects, but so far it works for simple objects.<br />
<br />
You can download the unit <a href="http://dl.gl%c3%b6gg.de/delphi/uSerialHelper.pas">here</a>.<br />
This unit uses the <a href="http://www.progdigy.com/?page_id=6">SuperObject</a> by Henri Gourvest</div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com3tag:blogger.com,1999:blog-1874838794281078062.post-38429259878817943242011-07-24T21:41:00.000+02:002011-07-24T21:41:50.538+02:00Delphi and TPropertyObserver<div style="text-align: justify;">In Delphi you can use RTTI (RunTime Type Information) to get information about objects at runtime without knowing about them at compile time. To find out more about RTTI, you should check out these <a href="http://robstechcorner.blogspot.com/2009/09/so-what-is-rtti-rtti-is-acronym-for-run.html">articles</a> by Robert Love.<br />
<br />
I used the RTTI to make an observer, that informs me, whenever a specific property gets changed. It is far from being complete, there are a lot of TypeKinds that I didn't implement a compare for. The observer could also be extended to support multiple properties.<br />
<pre class="brush:delphi">uses
Rtti, Classes;
type
TProc = reference to procedure;
TPropertyObserver = class
private
fTerminated : boolean;
public
constructor Create(aInstance : TObject; aPropertyName : string; aOnChange : TProc);
procedure Terminate;
end;
implementation
uses
SysUtils, TypInfo;
{ TPropertyObserver }
constructor TPropertyObserver.Create(aInstance: TObject; aPropertyName: string; aOnChange : TProc);
begin
TThread.CreateAnonymousThread(procedure
var
ctx : TRttiContext;
t : TRttiType;
oldValue, curValue : TValue;
b : boolean;
p : TRttiProperty;
begin
ctx := TRttiContext.Create;
try
t := ctx.GetType(aInstance.ClassType);
p := t.GetProperty(aPropertyName);
oldValue := p.GetValue(aInstance);
while not fTerminated do
begin
curValue := p.GetValue(aInstance);
b := false;
case curValue.Kind of
tkInt64,
tkEnumeration,
tkInteger: b := oldValue.AsOrdinal = curValue.AsOrdinal;
tkWChar,
tkLString,
tkWString,
tkString,
tkUString,
tkChar: b := oldValue.AsString = curValue.AsString;
tkFloat: b := oldValue.AsExtended = curValue.AsExtended;
// Some of these should get a compare, too
tkUnknown: ;
tkSet: ;
tkClass: ;
tkMethod: ;
tkVariant: ;
tkArray: ;
tkRecord: ;
tkInterface: ;
tkDynArray: ;
tkClassRef: ;
tkPointer: ;
tkProcedure: ;
end;
if not b then
begin
aOnChange;
oldValue := curValue;
end;
sleep(10);
end;
finally
ctx.Free;
end;
end).Start;
end;
procedure TPropertyObserver.Terminate;
begin
fTerminated := true;
end;</pre><br />
And how it is used:<br />
<pre class="brush:delphi">procedure TForm1.FormCreate(Sender: TObject);
begin
fObserver := TPropertyObserver.Create(self,'Left',procedure
begin
TThread.Synchronize(TThread.CurrentThread,procedure // Changing the VCL has to be done in the main thread
begin
edit1.Text := IntToStr(self.Left);
end);
end);
end;</pre><br />
Download is available <a href="http://dl.glögg.de/delphi/uPropertyObserver.pas">here</a>.</div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-22098408806908505662011-07-17T18:36:00.000+02:002011-07-17T18:36:26.052+02:00Delphi and TAppSettings<div style="text-align: justify;">Delphi has had Inifle-Support for as long as I can remember. Inifiles are great for storing Application- and Usersettings, but I found myself doing the same things in each Application I wrote. Retrieve an appropiate directory for storing the actual file, creating and freeing the TInifile-Object.<br />
I wanted something that I can just add to my project to store and retrieve simple values in a TInifile-like manner. Here is the result: TAppSettings. It relies on the <a href="http://gloegg.blogspot.com/2011/06/delphi-and-geocoding.html">aforementioned</a> JSON-Library "<a href="http://sourceforge.net/projects/is-webstart/">Delphi Web Utils</a>".<br />
<pre class="brush:delphi">type
TAppSettings = class
protected
fFilename : string;
fSaveOnFree: boolean;
fSettings : TJSONObject;
function createOrGetSection(aSection : string) : TJSONObject;
public
constructor Create(aFilename : string);
destructor Destroy; override;
procedure Save;
function getInteger(aSection, aKey : string; aDefault : integer) : integer;
function getString(aSection, aKey : string; aDefault : string) : string;
function getFloat(aSection, aKey : string; aDefault : double ) : double;
function getBool(aSection, aKey : string; aDefault : boolean) : boolean;
procedure setValue(aSection, aKey : string; aValue : integer); overload;
procedure setValue(aSection, aKey : string; aValue : string); overload;
procedure setValue(aSection, aKey : string; aValue : double); overload;
procedure setValue(aSection, aKey : string; aValue : boolean); overload;
property SaveOnFree : boolean read fSaveOnFree write fSaveOnFree;
procedure OpenPathInExplorer;
end;</pre><br />
As an example the getter and setter for integer:<br />
<pre class="brush:delphi">function TAppSettings.getInteger(aSection, aKey: string;
aDefault: integer): integer;
var
section : TJSONObject;
begin
result := aDefault;
section := fSettings.optJSONObject(aSection);
if section <> nil then result := section.optInt(aKey);
end;
function TAppSettings.createOrGetSection(aSection: string): TJSONObject;
begin
result := fSettings.optJSONObject(aSection);
if result = nil then
begin
result := TJSONObject.create;
fSettings.put(aSection,result);
end;
end;
procedure TAppSettings.setValue(aSection, aKey: string; aValue: integer);
var
section : TJSONObject;
begin
section := createOrGetSection(aSection);
section.put(aKey, aValue);
end;</pre><br />
This alone doesn't help with the initial problem, it just changes the format of the file. The interesting part is at the bottom of the unit.<br />
<pre class="brush:delphi">interface
const
COMPANY_NAME = 'MyCompany';
[...]
var
AppSettings, UserSettings : TAppSettings;
[...]
function GetSpecialFolder(Folder: Integer): String;
var
Path: array[0..MAX_PATH] of char;
begin
If SHGetSpecialFolderPath(0, @Path, Folder, false)
then Result:=Path
else Result:='';
end;
function GetApplicationName : string;
begin
result := ExtractFilename(ParamStr(0));
delete(result,length(result)-3,4);
end;
initialization
begin
ForceDirectories(GetSpecialFolder(CSIDL_COMMON_APPDATA)+'\'+COMPANY_NAME+'\'+GetApplicationName);
ForceDirectories(GetSpecialFolder(CSIDL_APPDATA)+'\'+COMPANY_NAME+'\'+GetApplicationName);
AppSettings := TAppSettings.Create(GetSpecialFolder(CSIDL_COMMON_APPDATA)+'\'+COMPANY_NAME+'\'+GetApplicationName+'\settings.json');
UserSettings := TAppSettings.Create(GetSpecialFolder(CSIDL_APPDATA)+'\'+COMPANY_NAME+'\'+GetApplicationName+'\settings.json');
end;
finalization
begin
AppSettings.Free;
UserSettings.Free;
end;</pre><br />
Adding this unit to your project automatically creates two Objects of TAppSettings, one for UserSettings and one for ApplicationSettings. Before I wrote TAppSettings I always had two procedures "LoadIni" and "SaveIni" in my application where I would load and save all my application settings, because that were the only places I could access the settings. Now I just use the settings wherever I need them.<br />
<br />
You can download the complete unit <a href="http://dl.glögg.de/delphi/uAppSettings.pas">here</a>.<br />
</div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-32402305939380483842011-07-09T17:20:00.002+02:002011-07-10T11:08:02.154+02:00Delphi and TTaskListI was reading about some of the new features in Delphi XE in the new book from <a href="https://plus.google.com/109099686252303180605/posts">Marco Cantu</a>, <a href="http://www.amazon.de/Delphi-Xe-Handbook-Guide-Features/dp/1463600674/ref=sr_1_1?ie=UTF8&s=books-intl-de&qid=1310223426&sr=8-1">Delphi XE Handbook</a>. (He also told me about them earlier this year in Frankfurt on the Delphi Developer Days, but I didn't found time to play around with it until now)<br />
The newest Delphi comes with anonymous Threads, which are a very easy way to make your application multithreaded, which is very useful to make some big calculations in the background, while the UI is still responding. However, sometimes you need things to be done in order. Enter TTasklist:<br />
<br />
<pre class="brush:delphi">type
TProc = reference to procedure;
TTaskList = class
private
fTasks : TThreadedQueue<TProc>;
fTerminated : boolean;
procedure start;
public
constructor Create;
destructor Destroy; override;
procedure addTask(aTask : TProc);
procedure Terminate;
end;</pre><br />
TTaskList uses a ThreadSafe Queue to store the tasks, which are basically anonymous methods. The constructor creates the queue and starts a new thread which executes one task after another.<br />
<pre class="brush:delphi">constructor TTaskList.Create;
begin
fTasks := TThreadedQueue<TProc>.Create;
fTerminated := false;
start;
end;
procedure TTaskList.addTask(aTask: TProc);
begin
fTasks.PushItem(aTask);
end;
procedure TTaskList.start;
begin
TThread.CreateAnonymousThread(
procedure
begin
while not fTerminated do
begin
if fTasks.QueueSize > 0 then fTasks.PopItem.Invoke;
end;
end
).Start;
end;
procedure TTaskList.Terminate;
begin
fTerminated := true;
end;
destructor TTaskList.Destroy;
begin
Terminate;
fTasks.Free;
inherited;
end;</pre><br />
Download is available <a href="http://dl.gl%c3%b6gg.de/delphi/uTaskList.pas">here</a>.Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0Unbekannter Ort.52.036442273206845 8.56521606445312551.958299773206846 8.4072875644531244 52.114584773206843 8.7231445644531256tag:blogger.com,1999:blog-1874838794281078062.post-68389059163869655462011-06-19T11:21:00.000+02:002011-06-19T11:21:19.581+02:00Delphi and Geocoding<div style="text-align:justify">Google has some powerful APIs. One of them is the Maps API which is capable of geocoding an address to longitude and latitude information.<br />
<br />
It is pretty easy to use this functionality from Delphi. All you need is TIdHttp and a <a href="http://json.org/">JSON</a> library. (I'm using the <a href="http://sourceforge.net/projects/is-webstart/">Delphi Web Utils</a>)<br />
<pre class="brush:delphi">TLocationType = (ltRooftop, ltRangeInterpolated, ltGeometricCenter, ltApproximate);
TAddress = class
private
fAddress : string;
fLatitude: double;
fLongitude: double;
fLocationType: TLocationType;
public
constructor Create(aAddress : string; aHttp : TIdHttp = nil);
property Address : string read fAddress write fAddress;
property Latitude : double read fLatitude;
property Longitude : double read fLongitude;
property LocationType : TLocationType read fLocationType;
procedure Geocode(aHttp : TIdHttp);
end;</pre><br />
The Google API returns a JSON structure with a couple of fields. However, I just grab the longitude and latitude information as well as the location_type, to determine the quality of the coordinates.<br />
<pre class="brush:delphi">procedure TAddress.GeoCode(aHttp: TIdHttp);
var
url : string;
jo, location, geometry : TJSONObject;
sc : TStringCase;
begin
url := TIdURI.URLEncode('http://maps.google.com/maps/api/geocode/json?address='+fAddress+'&sensor=false');
jo := TJSONObject.create(aHttp.Get(url));
if jo.getString('status') = 'OK' then
begin
geometry := jo.getJSONArray('results').getJSONObject(0).getJSONObject('geometry');
location := geometry.getJSONObject('location');
fLongitude := location.getDouble('lng');
fLatitude := location.getDouble('lat');
sc := TStringCase.Create;
try
sc.addEntry('ROOFTOP',procedure
begin
fLocationType := ltRooftop;
end);
sc.addEntry('RANGE_INTERPOLATED',procedure
begin
fLocationType := ltRangeInterpolated;
end);
sc.addEntry('GEOMETRIC_CENTER',procedure
begin
fLocationType := ltGeometricCenter;
end);
sc.addEntry('APPROXIMATE',procedure
begin
fLocationType := ltApproximate;
end);
finally
sc.switch(geometry.getString('location_type'));
end;
sc.Free;
end
else raise Exception.Create(jo.getString('status'));
jo.Free;
end;
</pre><br />
I used this and <a href="http://www.martinzone.biz/tgomaps/overview.html">TGoMaps</a> to create a simple application which takes a list of addresses, geocodes them and displays them on a GoogleMap.<br />
<div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjzlNwA80hscEs9ghyphenhyphenmvvnr-XyQPv_vm6WkBvYh5eZ5rZotlyZBeBMTO6uIH9YQQaRD94XkfoYX6EQh-_-Cn16K3ISa1RGG3sQ2RH8CQK6hln958ku516x5jMVRoPOdJWGbkz1J9tUs1n8/s1600/geocode.png" imageanchor="1" style="margin-left:1em; margin-right:1em"><img border="0" height="250" width="400" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjzlNwA80hscEs9ghyphenhyphenmvvnr-XyQPv_vm6WkBvYh5eZ5rZotlyZBeBMTO6uIH9YQQaRD94XkfoYX6EQh-_-Cn16K3ISa1RGG3sQ2RH8CQK6hln958ku516x5jMVRoPOdJWGbkz1J9tUs1n8/s400/geocode.png" /></a></div><br />
Source and binary are available <a href="http://dl.glögg.de/delphi/Geocode/">here</a>.<br />
<br />
TAddress uses TStringCase from the <a href="http://gloegg.blogspot.com/2011/06/delphi-and-tstringcase.html">previous post</a>.<br />
</div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-80556588721101241552011-06-18T21:00:00.000+02:002011-06-18T21:00:30.849+02:00Delphi and TStringCase<div style="text-align: justify;">Delphi's Case <X> of statement works with everything that is Ordinal. integer, char, enumerations, it even works with boolean.<br />
<pre class="brush:delphi">case b of
true : MakeSomething;
false : DoNotMakeSomething;
end;</pre><br />
However, it does not work with strings. And I've come across some places where it would be very handy to have a Case <String> of.<br />
<br />
Luckily, with Delphi 2010 came <a href="http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/devcommon/anonymousmethods_xml.html">anonymous methods</a> and with the combination of a Dictionary we can finally have something that works as a Case <String> of.<br />
<pre class="brush:delphi">type
TProc = reference to procedure;
TCase<T> = class
private
fDict : TDictionary<T,TProc>;
fElse: TProc;
public
constructor Create;
destructor Destroy; override;
procedure addEntry(aKey : T; aProc :TProc);
procedure addEntries(const aKeys : array of T; aProc : TProc);
procedure switch(aKey : T);
property ElseCase : TProc read fElse write fElse;
end;
TStringCase = TCase<string>;
</pre><br />
TStringCase is the type, that will be used the most, but with the generic TCase, (almost) everything can be used for a Case statement.<br />
<br />
The implementation is very simple:<br />
<pre class="brush:delphi">procedure TCase<T>.addEntries(const aKeys: array of T; aProc: TProc);
var
key : T;
begin
for key in aKeys do
addEntry(key,aProc);
end;
procedure TCase<T>.addEntry(aKey: T; aProc: TProc);
begin
fDict.Add(aKey, aProc);
end;
constructor TCase<T>.Create;
begin
fDict := TDictionary<T,TProc>.Create;
end;
destructor TCase<T>.Destroy;
begin
fDict.Free;
inherited;
end;
procedure TCase<T>.switch(aKey: T);
var
p : TProc;
begin
if fDict.TryGetValue(aKey, p) then
p()
else
if assigned(fElse) then fElse();
end;</pre><br />
And this is how it's used:<br />
<pre class="brush:delphi">procedure UseStringCase;
var
sc : TStringCase;
begin
sc :=TStringCase.Create;
try
// setup the case
sc.addEntry('STRING1',procedure
begin
Label1.Caption := 'First Option';
end);
sc.addEntry('STRING1',procedure
begin
Label1.Caption := 'Second Option';
end);
sc.addEntries(['STRING3','STRING4','STRING5'],procedure
begin
Label1.Caption := 'one of three options';
end);
sc.ElseProc := procedure
begin
Label1.Caption := 'Something else';
end;
sc.switch(Edit1.Text); // execute the right procedure
finally
sc.Free;
end;
end;</pre><br />
The usage has some overhead compared to the standard case, but I think it is still prettier than a bunch of if-then-else's.<br />
<pre class="brush:delphi">procedure UseIfThenElse;
var
s : string;
begin
s := Edit1.Text;
if s = 'STRING1' then
begin
Label1.Caption := 'First Option';
end
else if s = 'STRING2' then
begin
Label1.Caption := 'Second Option';
end
else if (s = 'STRING3') or (s = 'STRING4') or (s = 'STRING5') then
begin
Label1.Caption := 'one of three options';
end
else
begin
Label1.Caption := 'Something else';
end;
end;</pre><br />
Download is available <a href="http://dl.glögg.de/delphi/uStringCase.pas">here</a>.<br />
<br />
</div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-44240269324888406912011-06-13T14:02:00.001+02:002011-06-19T11:28:28.739+02:00Delphi and Barcode scanning<div style="text-align: justify;">Todays example uses a dll to access a Barcode Scanner. The used Barcode Scanner is the <a href="http://www.motorola.com/business/v/index.jsp?vgnextoid=11607b103d175110VgnVCM1000008406b00aRCRD">CS1504</a> (SDK available <a href="http://support.symbol.com/support/search.do?cmd=displayKC&docType=kc&externalId=KB100331&sliceId=&dialogID=235274197&stateId=1%200%20235264657">here</a>).<br />
<br />
The CS1504 has a buffer where it stores all scanned barcodes and this buffer can be accessed via a COM-Port. Luckily, the SDK has a dll which takes care of the communication. The only problem is, that the header is written in C/C++. I translated it (in parts) to Delphi, you can grab the file <a href="http://dl.gl%c3%b6gg.de/delphi/uCSP2.pas">here</a>.<br />
<br />
Now we could just use it as is, but it would be much nicer if we had a class to wrap it all up.<br />
<br />
We need some object to store the data, which is really simple:<br />
<pre class="brush:delphi">TBarcode = class
private
fTimestamp : TDateTime;
fCode : string;
public
constructor Create(aTimestamp : TDateTime; aCode : string);
property TimeStamp : TDateTime read fTimestamp;
property Code : string read fCode;
end;</pre><br />
And now the class that does all the work: <br />
<pre class="brush:delphi">TScanner = class
private
fPort : integer;
fReady : boolean;
fHasData: boolean;
function TimestampToDateTime(aTimestamp : Ansistring) : TDateTime;
public
constructor Create(aPort : integer);
destructor Destroy; override;
function getBarcodes : TList<TBarcode>;
procedure clearBarcodes;
property IsReady : boolean read fReady;
property HasData : boolean read fHasData;
procedure setDateTime(aDateTime : TDateTime);
function getDateTime : TDateTime;
end;</pre><br />
The TScanner class returns a generic TList<TBarcode> with all the Barcodes from the device. <br />
<br />
The most important function is of course getBarcodes.<br />
<pre class="brush:delphi">function TScanner.getBarcodes: TList<TBarcode>;
var
bc : TBarcode;
i, count, pl : integer;
buffer : array[0..63] of AnsiChar;
dt : TDateTime;
s : string;
begin
result := TList<TBarcode>.Create;
begin
count := csp2ReadData;
for i := 0 to count -1 do
begin
FillChar(buffer,64,#0);
pl := csp2GetPacket(@buffer,i,63);
// The Last 4 Bytes hold the timestamp
dt := TimestampToDateTime(copy(buffer,pl-3,4));
s := copy(buffer,3,pl-6);
bc := TBarcode.Create(dt,s);
result.Add(bc);
end;
end;
end;</pre><br />
The implementation is pretty much straight forward, the trickiest part was to convert the 4-byte timestamp from each barcode to TDateTime. They crammed the six values for year, month, day, hour, minute and second into 4 bytes. (seriously, a SD Card that has the size of my fingernail can hold easily 4 GB and they worry about 2 bytes per scanned barcode)<br />
<br />
<div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhn6kN6-7u1z91hLhVZamwAQaX4zTC8mpZsjIijodIL3OS02VxITgmShblkiZAgzDwKpgdK425-3LldRIctwnYhD2pqjPLQ4IdtmIete0DCpI3eM9N2PnyJCXbfJUAWwOV9IQ3kCM5Pk1o/s1600/4_byte_date.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="35" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhn6kN6-7u1z91hLhVZamwAQaX4zTC8mpZsjIijodIL3OS02VxITgmShblkiZAgzDwKpgdK425-3LldRIctwnYhD2pqjPLQ4IdtmIete0DCpI3eM9N2PnyJCXbfJUAWwOV9IQ3kCM5Pk1o/s400/4_byte_date.png" width="400" /></a></div><br />
<pre class="brush:delphi">function TScanner.TimestampToDateTime(aTimestamp: Ansistring): TDateTime;
var
i1,i2,i3,i4,i5,i6 : integer;
qb : T4Bytes;
y,m,d,h,n,s : word;
begin
// CharToByte
qb.Bytes[3] := Ord(aTimestamp[1]);
qb.Bytes[2] := Ord(aTimestamp[2]);
qb.Bytes[1] := Ord(aTimestamp[3]);
qb.Bytes[0] := Ord(aTimestamp[4]);
// split up the bits
i1 := qb.Total and $fc000000; // 6 Bit
i2 := qb.Total and $03f00000; // 6 Bit
i3 := qb.Total and $000f8000; // 5 Bit
i4 := qb.Total and $00007c00; // 5 Bit
i5 := qb.Total and $000003c0; // 4 Bit
i6 := qb.Total and $0000003f; // 6 Bit
// Shift right to align the bits
s := i1 shr 26;
n := i2 shr 20;
h := i3 shr 15;
d := i4 shr 10;
m := i5 shr 6;
y := i6;
result := EncodeDate(y+2000,m,d) + EncodeTime(h,n,s,0);
end;</pre><br />
This uses T4Bytes which is a packed record.<br />
<pre class="brush:delphi">T4Bytes = packed record
case Integer of
0: (Bytes: array[0..3] of Byte);
1: (Total: Cardinal);
end;</pre><br />
The bytes are accessible indivudually and as the resulting 4-Byte Cardinal.<br />
<br />
Full Sourcecode is available <a href="http://dl.gl%c3%b6gg.de/delphi/uScanner.pas">here</a>.<br />
<br />
</div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-439176163631309102011-06-13T00:44:00.000+02:002011-06-13T00:44:23.622+02:00Delphi and Generics<div style="text-align: justify;">In this first developer-themed post, I am going to describe some basic stuff, before I delve into some real-world applications.<br />
<br />
Delphi 2009 brought Generics to the Delphi-World. And since then, they are found in all of my Applications. Especially Generics.Collections are heavily used by me.<br />
<br />
Before Generics.Collections I had to implement a TList for each Class I would like to store a variable amount of Objects. (Or I could use Contnrs.TObjectList and cast to TAnimal everytime I need one, but I don't find that very desirable)<br />
<pre class="brush:delphi">interface
uses
Classes;
type
TAnimal = class
private
fName : string;
public
property Name : string read fName write fName;
end;
TAnimalList = class (TList)
private
procedure putAnimal(Index : integer; Value : TAnimal);
function getAnimal(Index : integer) : TAnimal;
public
property Items [Index : integer] : TAnimal read getAnimal write setAnimal;
end;
implementation
procedure TAnimalList.putAnimal(Index : integer; Value : TAnimal);
begin
inherited put(Index, Value);
end;
function TAnimalList.getAnimal(Index : integer) : TAnimal;
begin
result := (TAnimal) inherited get(Index);
end;</pre><br />
And this is just for TAnimal, if there are any other classes, I would have to copy&paste the code for the List and replace the data types.<br />
<br />
With Generics.Collections the same thing looks like this:<br />
<pre class="brush:delphi">interface
uses
Generics.Collections;
type
TAnimal = class
private
fName : string;
public
property Name : string read fName write fName;
end;
TAnimalList = TList<TAnimal></pre><br />
And I don't even need the alias "TAnimalList", I could use "TList<TAnimal>" instead.<br />
<br />
Also, it is not limited to Classes, it can hold every datatype like integer, double, boolean and even records. In my case it is even better to use TObjectList<TAnimal>, which automatically frees its containing objects if it is freed.<br />
<br />
Since all the Generics.Collectionshave an Enumerator the following is possible:<br />
<br />
<pre class="brush:delphi">var
fAnimals : TList<TAnimal>
procedure init;
var
a : TAnimal;
begin
for a in fAnimals do
begin
a.DoSomething;
end;
end;</pre><br />
Generics.Collections has more then some simple Lists up its sleeve. There are also TQueue, which uses FIFO and TStack which uses LIFO to store its contents.<br />
<br />
TDictionary is a little different, because its taking two type parameters. One for the key, one for the Value.<br />
A case that I often stumble upon is to store (and recieve) some object or value for a specific string. And then I always use a TDictionary<String,TValue><br />
<br />
There's also a TObjectDictionary, which takes care of memory of the keys, the values or even both.<br />
<pre class="brush:delphi">procedure init;
var
ownsKeys, ownsValues, ownsBoth : TObjectDictionary<TKey, TValue>
begin
ownsKeys := TObjectDictionary<TKey, TValue>.Create([doKeys]);
ownsValues := TObjectDictionary<TKey, TValue>.Create([doValues]);
ownsBoth := TObjectDictionary<TKey, TValue>.Create([doKeys, doValues]);
end;</pre><br />
That's it for today.<br />
<br />
</div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-70199352120442879372011-06-12T23:41:00.000+02:002011-06-12T23:41:36.220+02:00Level Up<div style="text-align: justify;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhS6_yl_wwz-obyhvqrEhHomlZd_xIEnTq6omW5dvBrp3Qdyahkxtued0KhH0KxeBAOEEONLlbmf5XebTbI1-CUDTiRhJ4tQbAUPsDS1oXEfcDHGAH0X46AMgBQBH1kOxhsxle62MaWeso/s1600/cert_delphi_dev.png" imageanchor="1" style="clear: left; float: left; margin-bottom: 1em; margin-right: 1em;"><img border="0" height="191" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhS6_yl_wwz-obyhvqrEhHomlZd_xIEnTq6omW5dvBrp3Qdyahkxtued0KhH0KxeBAOEEONLlbmf5XebTbI1-CUDTiRhJ4tQbAUPsDS1oXEfcDHGAH0X46AMgBQBH1kOxhsxle62MaWeso/s400/cert_delphi_dev.png" width="185" /></a>Time for another <a href="http://gloegg.blogspot.com/2008/05/level-up.html">Level Up</a>. In this week I became a <a href="http://www.embarcadero.com/certification/delphi-developer">certified Delphi Developer</a>. There is also the Delphi Master Certification, but since this certification deals a lot with DataSnap, which I have not used very much, I don't think I'll take it anytime soon.<br />
<br />
I think this is a good opportunity to blog about some techniques I am using in my every day work. Which may help some fellow Delphi Developers, who can learn a thing or two and also give me feedback to improve my work.<br />
<br />
For those interested in these kind of posts, you can grab the feed for the "Developer"-Posts right <a href="http://gloegg.blogspot.com/feeds/posts/default/-/The%20Developer">here</a></div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-32374756231795444522010-11-11T22:20:00.000+01:002010-11-11T22:20:49.437+01:00DOSPad<div style="text-align: justify;"><br />
<br />
Nachdem die guten Leute von <a href="http://www.dospad.net/forum/">dospad</a> ihren Quellcode veröffentlicht haben, konnte ich ohne Jailbreak den <a href="http://www.dosbox.com/">DOSBox</a>-Port fürs iPad installieren. Und das öffnet natürlich eine Reihe von Möglichkeiten. <br />
Aber ich lass erstmal ein paar Bilder für sich sprechen:<br />
<br />
<div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEju5S5_XuCUJkM3FvrtLuBXeDD_dMmRc6DYBYfa9GgbkG3unLiFsHQ6T1p-lHKVtxVpHiY2Zg8iav3YFwZjR_FNGytfmrOFP1BfaIUgVpAbD24IftuOZDB1mqsVXpYTkWR0dYl-ubLOSso/s1600/IMG_0001.PNG" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="240" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEju5S5_XuCUJkM3FvrtLuBXeDD_dMmRc6DYBYfa9GgbkG3unLiFsHQ6T1p-lHKVtxVpHiY2Zg8iav3YFwZjR_FNGytfmrOFP1BfaIUgVpAbD24IftuOZDB1mqsVXpYTkWR0dYl-ubLOSso/s320/IMG_0001.PNG" width="320" /></a><br>Xenon2</div><br />
<div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhZe8DvdkQ6J8JynFHeBPrYM73B_7RDuzbxPWw8XL8BqemB_jj1-qc6cPfftwfxu2A_kp-RqLiEv4Wts8_1m-xdqZDYZulu4tcIskXp5F1i80d6W1dgpA_jHiXr8kgdKot5232YfVmKPAE/s1600/IMG_0002.PNG" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="240" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhZe8DvdkQ6J8JynFHeBPrYM73B_7RDuzbxPWw8XL8BqemB_jj1-qc6cPfftwfxu2A_kp-RqLiEv4Wts8_1m-xdqZDYZulu4tcIskXp5F1i80d6W1dgpA_jHiXr8kgdKot5232YfVmKPAE/s320/IMG_0002.PNG" width="320" /></a><br>Monkey Island 1</div><br />
<div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEicIllqJFcXHjd0XBYiVSHOqZYDtWL6YSBg6ztcWnZFtzRM-DutUjprDp438NQXuOoazsqyl_mfURtznpQAn9WMlmwKOUvzCVuL7se9Bv_0BkHqmfa2uWkQqx_5Xo8K07kgosU2cih7w_I/s1600/IMG_0003.PNG" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="240" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEicIllqJFcXHjd0XBYiVSHOqZYDtWL6YSBg6ztcWnZFtzRM-DutUjprDp438NQXuOoazsqyl_mfURtznpQAn9WMlmwKOUvzCVuL7se9Bv_0BkHqmfa2uWkQqx_5Xo8K07kgosU2cih7w_I/s320/IMG_0003.PNG" width="320" /></a><br>Civilization 1</div><br />
Desweiteren hatte ich noch Crystal Caves, Ascendancy und Doom ausprobiert. Davon läuft aber nur Crystal Caves einigermaßen flüssig. Doom ist unspielbar und Ascendancy mag er garnicht starten.<br />
<br />
Wegen der eingeschränkten Tastatur sind Spiele mit hohem Geschicklichkeitsfaktor leider noch schwieriger als sie normalerweise sind. Desweiteren ist es schade, das es den Rechtsklick nicht im Fullscreenmodus gibt. Soweit ich weiß gibt es auch noch keine Unterstützung für externe Tastaturen, die soll aber noch kommen.<br />
<br />
Fazit: Als Spielerei ganz nett, aber echte iPhone-Varianten von Spielen sind deutlich einfacher zu handlen.<br />
<br />
PS: Als nächstes könnte man mal Win 3.11 probieren...</div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-21593183930908005512010-11-08T14:17:00.000+01:002010-11-08T14:17:30.675+01:00Studienbücher<div style="text-align: justify;">Gestern überkam es mich und ich habe tatsächlich mein Bücherregal aufgeräumt. Und schweren Herzens habe ich mich entschlossen ein paar alte Studienbücher von mir zu versteigern.<br />
<br />
Von den folgenden vier konnte ich mich trennen:<br />
<ul><li><a href="http://www.amazon.de/Mathematik-Ingenieure-Naturwissenschaftler-Arbeitsbuch-Grundstudium/dp/3528942363/ref=sr_1_9?ie=UTF8&qid=1289222127&sr=8-9">Mathematik für Ingenieure und Naturwissenschaftler 1</a> - Lothar Papula</li>
<li><a href="http://www.amazon.de/Mathematik-f%C3%BCr-Ingenieure-Naturwissenschaftler-Band/dp/3834803049/ref=sr_1_11?ie=UTF8&qid=1289222127&sr=8-11">Mathematik für Ingenieure und Naturwissenschaftler 2</a> - Lothar Papula</li>
<li><a href="http://www.amazon.de/Taschenbuch-Physik-Horst-Kuchling/dp/3446217606/ref=sr_1_3?s=books&ie=UTF8&qid=1289222163&sr=1-3">Taschenbuch der Physik</a> - Horst Kuchling</li>
<li><a href="http://www.amazon.de/Taschenbuch-Elektrotechnik-Elektronik-Helmut-Lindner/dp/3446210563/ref=sr_1_5?s=books&ie=UTF8&qid=1289222183&sr=1-5">Taschenbuch der Elektrotechnik und Elektronik</a> - Helmut Lindner, Harry Brauer, Constans Lehmann</li>
</ul><br />
Alle Bücher sind in einem guten bis Top-Zustand. <br />
<br />
Hier der Link zu den eBay-Auktionen: <a href="http://shop.ebay.de/real_gloegg/m.html">http://shop.ebay.de/real_gloegg/m.html</a></div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-59559738841009455542010-06-02T10:07:00.002+02:002010-11-20T09:31:43.989+01:00Not my president<div style="text-align: justify;">Nur weil 'gefühlt' jedes zweite Kind in Deutschland aus ihrer Lende kam, ist sie noch lange nicht als "Mutter der Nation" qualifiziert.<br />
<div class="separator" style="clear: both; text-align: center;"></div><div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhYn5QfjlCkYLZ81l3sqsf3wF_fyz1XNfczXfy5fyo0wOZTXVQYS_hF2zsA50uOsKFZrLMOmGQCt9nMDuSjLKLNmg94VJLJIRSDQLpM17bcUKMx9fpvuUdXze3vcAtIVflIBrhGRP-ANzM/s1600/notmypresident.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="320" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhYn5QfjlCkYLZ81l3sqsf3wF_fyz1XNfczXfy5fyo0wOZTXVQYS_hF2zsA50uOsKFZrLMOmGQCt9nMDuSjLKLNmg94VJLJIRSDQLpM17bcUKMx9fpvuUdXze3vcAtIVflIBrhGRP-ANzM/s320/notmypresident.png" width="247" /></a></div><br />
Wer das Volk belügt, darf nicht Bundespräsidentin werden!<br />
<a href="http://www.carechild.de/news/politik/internetzensur_die_grossen_luegen_der_ursula_von_der_leyen_572_120.html">Link 1</a><br />
<a href="http://handelsblatt6.blogg.de/eintrag.php?id=2147">Link 2</a></div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-1167021247918034542010-05-21T10:18:00.000+02:002010-05-21T10:18:37.958+02:00Chips mit Geschmack<div style="text-align: justify;">Ich bin ja durchaus ein Freund von <a href="http://gloegg.blogspot.com/2008/05/bier-chips.html">speziellen Chipssorten</a>. Gut das Walkers momentan gleich 5 ausgefallene Sorten im Angebot hat.<br />
<br />
<div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjxnrb-8xKj4eo2gQ3OKevRqlQH9s1CiDMiBBMBGGhBVUpEZZEfwBK2JH7VyKbAwSj3lspg0dtg9Tg1zyJjTvJzATBMuMckQn1UrSTTaVhuVgXqgvrKJlZVU4Ph0oDLddoPF5oDfVrPrQg/s1600/brazil.JPG" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="240" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjxnrb-8xKj4eo2gQ3OKevRqlQH9s1CiDMiBBMBGGhBVUpEZZEfwBK2JH7VyKbAwSj3lspg0dtg9Tg1zyJjTvJzATBMuMckQn1UrSTTaVhuVgXqgvrKJlZVU4Ph0oDLddoPF5oDfVrPrQg/s320/brazil.JPG" width="320" /></a></div><br />
<div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhVZzkHeNfBSB9jgOmMDlO6iA0FXBdz8GKwy2Q8BqD5RrjmxtbjeaDRYKJSPqpe_Z8Cte5ZJ1C3vvkyyk0CxBkPH3t_wPdpo3ef7mJaQNDqHBwvvoCNWkTegVEORH6_SBsjkpMdiS33He4/s1600/burger.JPG" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="240" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhVZzkHeNfBSB9jgOmMDlO6iA0FXBdz8GKwy2Q8BqD5RrjmxtbjeaDRYKJSPqpe_Z8Cte5ZJ1C3vvkyyk0CxBkPH3t_wPdpo3ef7mJaQNDqHBwvvoCNWkTegVEORH6_SBsjkpMdiS33He4/s320/burger.JPG" width="320" /></a></div><br />
<div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjCRDLjtxgIXzHy3y8PBrt0KYx7rBQ6vtHTSr8zO4glJ03lH_N0eDGUB-LjYZjRjcX15j3I0HHkHiEsf1G2pcBRT1jY4xdJsAbyGzIiLb5w8FTGJA9B0IxV67xcQwqpNTir8B5STyQpJTQ/s1600/french.JPG" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="240" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjCRDLjtxgIXzHy3y8PBrt0KYx7rBQ6vtHTSr8zO4glJ03lH_N0eDGUB-LjYZjRjcX15j3I0HHkHiEsf1G2pcBRT1jY4xdJsAbyGzIiLb5w8FTGJA9B0IxV67xcQwqpNTir8B5STyQpJTQ/s320/french.JPG" width="320" /></a></div><br />
<div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgaVBsEFgEoKWz5wsBBb5qIqUM8xSTkwwEwgND-CiZRwmMT5Zs4TC10vKzqfJFAtTmofMn_g8F7STtlGMNPq6F6wJuDVejlBm9RSwmwPJdVJubU6mVrIr_32DsbOsftXYrZfc6afpuAw8w/s1600/japan.JPG" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="240" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgaVBsEFgEoKWz5wsBBb5qIqUM8xSTkwwEwgND-CiZRwmMT5Zs4TC10vKzqfJFAtTmofMn_g8F7STtlGMNPq6F6wJuDVejlBm9RSwmwPJdVJubU6mVrIr_32DsbOsftXYrZfc6afpuAw8w/s320/japan.JPG" width="320" /></a></div><br />
<div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgpOFpGoa_-28oD_uu3stM57AeDVJ_ORhLIwM6tuJHSGYG4JWhqLAy8KHEZXegjWMDE1-Uf6Bf6_VN4jGtz-wQ4NPSZUVotMpaLLOobeOor3oVx52CqUbC7ptxt893r4HXlsZoQQwafxzM/s1600/bratwurst.JPG" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="240" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgpOFpGoa_-28oD_uu3stM57AeDVJ_ORhLIwM6tuJHSGYG4JWhqLAy8KHEZXegjWMDE1-Uf6Bf6_VN4jGtz-wQ4NPSZUVotMpaLLOobeOor3oVx52CqUbC7ptxt893r4HXlsZoQQwafxzM/s320/bratwurst.JPG" width="320" /></a></div><br />
Die German Bratwurst schmeckt tatsächlich nicht schlecht und auch der American Cheeseburger ist lecker. Die restlichen Sorten werden dann beim Mittag verköstigt.</div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com0tag:blogger.com,1999:blog-1874838794281078062.post-47995848086865405902010-04-21T15:03:00.000+02:002010-04-21T15:03:54.773+02:00Warum ich Oracle hasse<div style="text-align: justify;">Grund #4312 <br />
<br />
<pre>CREATE TABLE T (
id number,
value float)
INSERT INTO T (id, value) VALUES (1, 3.3)
SELECT * FROM T
ID Value
1 3.29999981356</pre><br />
q.e.d.</div>Anonymoushttp://www.blogger.com/profile/07768182341129431497noreply@blogger.com1