Delphi Pipe

 blog, Delphi  Comments Off
Mar 282015
 

Since Delphi Feeds doesn’t list my blog any more and generally isn’t very fast in responding to requests for adding or removing feeds, I have created my own aggregated feed: RSS-02Delphi Pipe. It’s done with Yahoo Pipes and currently contains the following feeds in no particular order (*1):

Many of these are also on Delphi Feeds and there are probably many interesting feeds that are still missing. If you want to add a feed, please contact me via my Gooogle+ profile or post a comment to the announcement on Google+. I promise to do my best to maintain the pipe, but that doesn’t mean that I will respond immediately.

You can see the current content of the pipe to the right.

I have also created a static page and subdomain for it: delphipipe.dummzeuch.de

(*1: Meaning that I have yet to be able to create a meaningful sort order for the rss feed listing the sources.)

Mar 202015
 

Consider this code:

procedure SplitAt(const _Input: string; _Position: integer; out _Head, _Tail: string);
begin
  _Head := Copy(_Input, 1, _Position-1);
  _Tail := Copy(_Input, _Position);
end;

It’s meant to split a given string into two parts at the given position.

Nothing fancy, really, isn’t it?

Now, consider this call to the procedure above:

var
  s1: string;
  s2: string;
begin
  s1 := 'hello world';
  SplitAt(s1, 5, s1, s2);
  WriteLn('s1: "', s1, '"');
  WriteLn('s2: "', s2, '"');
end;

Which output do you expect?

The output I got certainly wasn’t what I expected:

s1: ""
s2: ""

I took me a while to understand what happened:

It has been brought to my attention, that the following explanation is wrong:

The compiler passes the parameters right to left, so the first parameter it passes is s2, then s1, then 5 and last s1 again as the input. Since the two rightmost parameters are *out* parameters it clears them before passing them, so s1 is already an empty string when it gets passed as input.

What actually happens is that regardless of the order in which the parameters are passed clearing of the out parameters happens. This clears s1 and it doesn’t matter whether it is was already passed as Input or not since strings in Delphi are always passed as pointers.

Not quite what I would have expected. It doesn’t help to remove the const modifier either.

Feb 282015
 

It just took me quite a while to find this information so I’ll put it here for future reference.

A Firemonkey application can not just access the clipboard, it needs to ask the platform whether it actually has one, then get the service interface and use that.

uses
  Fmx.Platform;

[...]
function TryGetClipboardService(out _clp: IFMXClipboardService): boolean;
begin
  Result := TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService);
  if Result then
    _clp := IFMXClipboardService(TPlatformServices.Current.GetPlatformService(IFMXClipboardService));
end;

procedure StringToClipboard(const _s: string);
var
  clp: IFMXClipboardService;
begin
  if TryGetClipboardService(clp) then
    clp.SetClipboard(_s);
end;

procedure StringFromClipboard(out _s: string);
var
  clp: IFMXClipboardService;
  Value: TValue;
  s: string;
begin
  if TryGetClipboardService(clp) then begin
    Value := clp.GetClipboard;
    if not Value.TryAsType(_s) then
      _s := '';
  end;
end;

(This is for Delphi XE7.)

TEdit and TMemo have got a CopyToClipboard and PasteFromClipboard method. (Which begs the question: Why not implement a generic function for reading and writing a string rather than methods for two controls? I was tempted to use the Visual Basic solution: Put a hidden control on the form and use its methods. Bad memories awake …)

Feb 282015
 

I have just updated dzEditorLineEndsFix to address a small problem: The tool can be too fast so the file is already gone when Delphi tries to access it. It now waits 200 ms after detecting the file creation before moving it. This should solve the issue.

It’s available for download from the dzEditorLineEndsFix page on SourceForge.

Feb 162015
 

Dirvish is a backup solution for Linux (and probably other unixoid OSes). I use it to make a daily backup of one server to a different server located in a different building (it’s not the only backup solution we use but the most convenient one because we can access these files easily). Once set up, it runs automatically and I have configured it to send me an email with the result of the backup and the remaining free hard disk space. I’m not the only one who does that.

The backup server has multiple 2 tb disks mounted as a single btrfs volume, so the resulting disk space is huge. The backup has run flawlessly for over a year until now it started running out of space. So now is the first time I have actually to think about expiring old backups. (Bad Thomas, you should have given that a little bit more thought from the beginning.)

The way Dirvish handles expiry is like this:

You specify a default expiry rule and optionally more detailed expiry rules in either /etc/dirvish/master.conf or in the vault’s default.conf file. If you don’t change anything, most Dirvish installations will set the default to +1 year:

expire-default: +1 year

All this will do is add an Expire entry to the summary file of each image. To actually expire anything you must call dirvish-expire, but that call is usually added to cron automatically by the dirvish package via the /etc/dirvish/dirvish-cron shell script:

# other stuff ...
/usr/sbin/dirvish-expire --quiet && /usr/sbin/dirvish-runall --quiet

Now, expiring every image after one year is probably not the best backup strategy. You usually want to keep one copy every week, every month and every year for a longer period, maybe even forever. So more complex rules are required and must be added to either /etc/dirvish/master.conf or default.conf of an individual vault. I opted for keeping Friday backups forever and deleting everything else after 9 months, so the configuration looks like this:

expire-default: +9 months

# keep Friday backups forever
# (for everything else we use the default from above)
expire-rule:
#       MIN    HR      DOM     MON     DOW     STRFTIME_FMT
        *       *       *       *       fri     never

The rules follow crontab format, so the line above means:

  • ignore the minute
  • ignore the hour
  • ignore the day of the month
  • ignore the month
  • only for Friday

Here is a good explanation about how these rules work.

Now, since all this does is adding an entry to the summary file of each image, I have a problem: This takes care of all future backups, but all existing images were created with an expire-default of +1 year, so they contain corresponding entries like this:

Image: 2014-02-21_12-00
Reference: 2014-02-20_12-00
Image-now: 2014-02-21 12:00:02
Expire: +1 year == 2015-02-21 12:00:02

So the image was taken on 21 FEB 2014 and will be expired on 21 FEB 2015. That is a Friday backup, so I want it to be kept forever. Other images also have an expire entry of +1 year but I have to free up some disk space and therefore want to expire them after 9 months already.

What this means is that I need to change the expire entry in the summary files. All two hundred and something of them. That’s not something you want to do by hand because it’s boring and error prone.

I could probably write a shell script (but since I rarely do that it would also be quite error prone) or a Perl script (same problem even though I have got more practice with that). So I’ll write a Delphi program and access the files via a Samba share.

Jan 032015
 

Sometimes you just want to know how a program gets called by another program or by Windows. In that case this little batch file might come in handy:

@echo off
rem This batch file shows its full filename and its parameters
echo cmd file: %~dpnx0
echo Parameters:
for %%I IN (%*) DO ECHO %%I
pause

Blatantly copyied from This StackOverflow answer.

Dec 222014
 

Note to self:

If MS Access adds double quotes to field names in queries, do not use them!
It won’t complain about them (You’d wish it would), but it just won’t work.

So if you see something like:

SELECT *
FROM t_Mst_Tageserfassung
WHERE ("TeMitarbeiter"=92)  AND ("TeArbeitstag"=#12/24/2014#);

Remove the quotes and it will start to work as expected.

If you need to ensure that the fields are treated as field names, put them into parentheses like this:

SELECT *
FROM t_Mst_Tageserfassung
WHERE ((TeMitarbeiter)=92)  AND ((TeArbeitstag)=#12/24/2014#);

This also works with TAdoQuery in Delphi.

Nov 102014
 

By default, if no translation for a language is available, dxgettext will not do any translation but use the strings as they are in the source code. Sometimes this is not desirable. e.g.

  • Your customer does not understand the source language (e.g. your source language is not English but say German)
  • You are using dxgettext to convert special characters from a placeholder (e.g. “(R)” or “[deg]”) to the actual character (“®” or “°”)

In these cases you’d probably want the translation to default to a language that is actually supplied.

dxgettext doesn’t seem to have this feature (I looked quite hard) so I implemented it myself.

unit u_dzTranslator;

interface

// ... other stuff ...

///<summary>
/// Sets the language to use </summary>
procedure UseLanguage(_LanguageCode: string);

///<summary>
/// gets a list of languages for which translations are available </summary>
procedure GetListOfLanguages(const _Domain: string; _Codes: TStrings;
  _Languages: TStrings = nil);

///<summary>
/// Sets the language to use if the desired language is not available,
/// defaults to English </summary>
procedure SetDefaultLanguage(const _LanguageCode: string);

// ... other stuff ...

implementation

uses
  gnugettext;

// ... other stuff ...

const
  DEFAULT_LANGUAGE = 'en';
var
  gblDefaultLanguage: string = DEFAULT_LANGUAGE;

procedure UseLanguage(_LanguageCode: string);
var
  Codes: TStringList;
  CurLang: string;
  i: Integer;
  p: Integer;
begin
  gnugettext.UseLanguage(_LanguageCode);

  CurLang := gnugettext.GetCurrentLanguage;
  Codes := TStringList.Create;
  try
    GetListOfLanguages('default', Codes);
    for i := 0 to Codes.Count - 1 do begin
      if SameText(CurLang, Codes[i]) then begin
        // There is a translation for this language and country, everything is fine
        Exit; //-->
      end;
    end;
    // no translation found, try without the country code
    p := Pos('_', CurLang);
    if p <> 0 then begin
      CurLang := Copy(CurLang, 1, p - 1);
      for i := 0 to Codes.Count - 1 do begin
        if SameText(CurLang, Codes[i]) then begin
          // There is a translation for this language but not country, we can live with that
          Exit; //-->
        end;
      end;
    end;
  finally
    FreeAndNil(Codes);
  end;

  // we found no translation for this language, so we use the default language
  gnugettext.UseLanguage(gblDefaultLanguage);
end;

procedure SetDefaultLanguage(const _LanguageCode: string);
begin
  if _LanguageCode = '' then
    gblDefaultLanguage := DEFAULT_LANGUAGE
  else
    gblDefaultLanguage := _LanguageCode;
  UseLanguage(gnugettext.GetCurrentLanguage);
end;

procedure GetListOfLanguages(const _Domain: string; _Codes: TStrings; _Languages: TStrings = nil);
var
  i: Integer;
begin
  _Codes.Clear;
  gnugettext.DefaultInstance.GetListOfLanguages(_Domain, _Codes);
  if Assigned(_Languages) then begin
    _Languages.Clear;
    for i := 0 to _Codes.Count - 1 do begin
      _Languages.Add(languagecodes.getlanguagename(_Codes[i]));
    end;
  end;
end;

// ... other stuff ...

initialization
  SetDefaultLanguage(DEFAULT_LANGUAGE);
end.

Apart from the obvious, that is, setting a unit global variable to the desired default language, which itself defaults to English, this code changes the way UseLanguageWorks. It now does:

  • Call gnugettext.UseLanguage to let gnugettext do its stuff
  • Call gnugettext.GetCurrentLanguage to get the language that gnugettext uses (just in case gnugettext changes it from what was set with UseLanguage).
  • Gets a list of all supported translations
  • Tries to find a matching translation for the desired language and country.
  • If not found, tries to find a matching translation for the desired language, ignoring the country
  • If not found, changes the language to the default language.

Note that I just wrote this code, it might still contain bugs and is probably far from perfect. I will put it into the unit u_dzTranslator of my dzlib library and will fix any bugs I find in the future there.

Nov 052014
 

Today I spent several hours hunting down a problem with opening a COM port. Basically the program opens a COM port, writes some bytes to it, reads an answer and closes it again. This determines whether the expected device is connected to the COM port or not.

If the answer is the expected one, so the device is connected and active, the detection loop exists (the COM port has been closed using CloseHandle).

Now the actual communication with the device starts. The first thing is does, is open the same COM port again. Which fails with the error code 5 (ERROR_ACCESS_DENIED). WTF?

Of course, I tried to debug the issue using the Delphi integrated debugger. While I stepped through the code, the error disappeared, only to come back when I just run the code without stepping through it. This was reproducible (I love reproducible errors.).

When something like this happens, you can be sure it is a timing issue. Either your program is multithreaded and the issue is one thread doing something while the other is doing something else that conflicts with the first thread (called race condition or deadlock, depending on the outcome). Or it’s not your own threads but somebody else’s.

In my case this StackOverflow question seems to be about the same issue and the accepted answer was mentioning the FTDI drivers I am using (the COM port is actually a USB serial adapter). These drivers apparently do not immediately close the port when the handle is closed so opening it again can fail. It turned out that a retry loop when opening the COM port solved the issue. Here is the code I ended up using:

procedure TCustomComPort.CreateHandle;
const
  MAX_TRIES = 10;
var
  Tries: integer;
  OK: boolean;
begin
  Tries := 0;
  repeat
    Inc(Tries);
    FHandle := CreateFile(
      PChar('\\.\' + FPort),
      GENERIC_READ or GENERIC_WRITE,
      0,
      nil,
      OPEN_EXISTING,
      FILE_FLAG_OVERLAPPED,
      0);
    OK := (FHandle <> INVALID_HANDLE_VALUE);
    if not OK then
      Sleep(10 * Tries); // it wasn't enough to Sleep(10) here
  until OK or (Tries >= MAX_TRIES);

  if not OK then
    CallException(CError_OpenFailed, GetLastError);
end;

Some of you might recognize part of this code from the ComPort library for Delphi and C++. (But probably not, because the original code is just three lines. ;-) )

Of course the real debugging was more complex than I described above because the program is multi threaded and the detection is done in one thread while the actual communication is done with the foreground thread writing to the port and the answers being processed by a background thread. So of course, at first I suspected an error in my code, actually found one, fixed it, just to run into the next problem. Finally it turned out to be the driver problem described here.

Nov 042014
 

Once in a while I run into this problem and every single time it takes me forever to remember the cause:

Say, you have got an interface and a class implementing that interface:

type
  IMyInterface = interface
    function asMyInterface: IMyInterface;
  end;

type
  TMyClass = class(TInterfacedObject, IMyInterface)
  private
    function asMyInterface: IMyInterface;
  end;

[...]

function TMyClass.asMyInterface: IMyInterface;
begin
  Result := Self as IMyInterface; // compile error here
end;

This will fail to compile in the marked line with the error “Operator not applicable to this operand type”.

The reason is simple: In order for the as operator to work on interfaces, the interface must have a GUID assigned to it. You do that in the Delphi IDE by positioning the cursor after the interface keyword and press Shift+Ctrl+G. As soon as your interface declaration looks like this …

type
  IMyInterface = interface ['{93903D10-58F7-41B0-AFB1-2A8E17F828EF}']
    function asMyInterface: IMyInterface;
  end;

… the code will compile.

(Don’t just copy this code, you will need to generate your own unique GUID as described above! Otherwise you will experience strange things.)