Tips und Tricks zu Delphi

Allgemein

Wenn nicht anders angegeben gilt für alle folgenden Tips:
Copyright © 1997 All Rights Reserved. Alle Rechte vorbehalten DMV/FranzisVerlag - PC Magazin

Automatische Label-Größe
Delphi 1-4
Labels haben eine wunderbare Eigenschaft: "AutoSize". Setzen Sie diese auf "True", paßt sich das Labelfeld immer an den
enthaltenen Text an. Soviel zur Theorie. In der Praxis sieht das Ganze nicht so rosig aus. Denn kaum ändern Sie Ihre
Bildschirmdarstellung auf "Große Schriften", schon passen Ihre Texte nicht mehr in die vorgesehenen Rahmen."AutoSize" wirkt
nämlich nur dann, wenn sie die Eigenschaft selbst oder die "Caption" des Labels verändern. Mit dem folgenden kurzen
Code-Fragment überprüfen Sie jede einzelne Komponente. Handelt es sich um einen Label und dessen AutoSize-Eigenschaft
ist True, erhält diese zunächst den Wert "False" und sofort wieder den Wert"True". Dadurch paßt sich der Label wieder an die
Breite des Textes in der Eigenschaft "Caption" an.

for I := 0 to ComponentCount -1 do if Components[I] is TLabel then
With TLabel(Components[I]) Do
If AutoSize = True Then Begin
AutoSize := False; AutoSize := True;
End;

zurück

Bildschirmschoner mit Delphi
Delphi 1-4
Vom Prinzip her unterscheiden sich Screensaver und EXE-Dateien nur in der Dateiendung. Beides sind ausführbare
Programme. Lediglich in der Praxis müssen Sie drei Dinge beachten, wenn Sie selbst Bildschirmschoner programmieren wollen:
- Bildschirmschoner müssen sich im Windows-Hauptverzeichnis befinden und die Endung SCR haben, damit Windows sie auch
findet. - über den Eintrag "{$D SCRNSAVE: Beschreibung}" inder Projektdatei direkt nach der Klausel "Program" vergeben
Sie den Namen des Bildschirmschoners (Hinweis: Windows 95 ignoriert diesen Namen und zeigt statt dessen den Dateinamen
in der Auswahl an). - Hat der Anwender in der "Systemsteuerung" oder in "Eigenschaften von Anzeige" den Bildschirmschoner
ausgewählt und klickt auf die Schaltfläche"Einstellungen", so wird das Programm mit dem Parameter "/c"aufgerufen. - Wird das
Programm hingegen im Screensaver-Modus ausgeführt,erhält es als Parameter "/s". Die Vorgehensweise ist also recht simpel.
Erstellen Sie ein neues Projekt und fügen Sie über die Compilerdirektive "$D" den Namen Ihres Bildschirmschoners ein.
Doppelklicken Sie auf das Formular und geben Sie als Code für das OnCreate-Ereignis ein:

If ParamCount > 0 Then Begin
If ParamStr(1) = '/c' Then
{Konfigurationsformular starten}
Else If ParamStr(1) = '/s' Then
{Starten des Screensaver-Modus}
Else {falscher Parameter} Application.Terminate;
End Else {fehlender Parameter} Application.Terminate;

Den Saver-Modus beenden Sie am besten in den Ereignissen "OnKeydown"und "OnMouseDown" indem Sie mit 

Application.Terminate

die Anwendung beenden.

zurück

Listboxen mit Bitmaps und mehrzeiligem Text
Delphi 1-2
Immer wieder erforderlich und nirgends richtig beschrieben ist das Verfahren, in List- und ComboBox-Feldern sowohl Text als
auch Bitmaps darzustellen. Noch dazu, wenn der Text in mehreren Zeilen dargestellt werden soll. Abhilfe schafft die Fähigkeit
dieser Listenelemente, mittels des Ereignisses OnOwnerDraw, die einzelnen Zeilen selbst darzustellen. Um das Projekt an
einem Beispiel nachzuvollziehen, erstellen Sie drei Image-Komponenten und laden hier unterschiedliche Bilder über die
Picture-Eigenschaft. Legen Sie dazu noch eine leere ListBox sowie eine ComboBox-Komponente auf Ihr Formular. Setzen Sie
bei beiden Listenelementen die Eigenschaft "Style" auf "lbOwnerDrawFixed" respektive "csOwnerDrawFixed". Füllen Sie
dann beide Komponenten im OnCreate-Ereignis des Formulars mit den Bitmaps und passendem Text:

ListBox1.Items.AddObject('Erstes Bitmap', Image1.Picture.Bitmap);
ListBox1.Items.AddObject('Zweites Bitmap', Image2.Picture.Bitmap);
ListBox1.Items.AddObject('Dies ist'#13'das dritte Bitmap ', Image3.Picture.Bitmap);

Anschließend erstellen Sie die Behandlungsroutine des OnDrawItem-Ereignisses:

procedure TForm1.ListBox1DrawItem(Control: TWinControl;
Index: Integer;Rect: TRect; State: TOwnerDrawState);
var Bitmap: TBitmap;
OutChar: PChar;
TS: TStrings;
CV: TCanvas;
begin
If Control is TCustomListBox Then Begin
TS := TCustomListBox(Control).Items;
CV := TCustomListBox(Control).Canvas;
End Else If Control is TCustomComboBox Then Begin
TS := TCustomComboBox(Control).Items;
CV := TCustomComboBox(Control).Canvas;
End;
OutChar := StrAlloc(length(TS.Strings[Index]) + 1);
StrPCopy(OutChar, TS.Strings[Index]);
with CV do begin
FillRect(Rect);
if TS.Objects[Index] <> nil then begin
Bitmap := TS.Objects[Index] as TBitmap;
BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2,
Bitmap.Width, Bitmap.Height), Bitmap,
Bounds(0, 0, Bitmap.Width, Bitmap.Height),
Bitmap.Canvas.Pixels[0,Bitmap.Height]);
end;
Rect.Left := Rect.Left + Bitmap.Width + 4;
Rect.Bottom := Rect.Top + Bitmap.Height + 4;
DrawText(Handle, OutChar, StrLen(OutChar), Rect, dt_WordBreak);
StrDispose(OutChar);
end;
end;

Anmerkung: Diese Routine ist so flexibel gehalten, daß Sie sie für beliebige Combo- und ListBox-Komponenten verwenden
können, sogar solche mit Datenbank-Anschluß. Wollen Sie die Größe der einzelnen Zeilen des Listenfeldes verändern, so
setzen Sie die Eigenschaft ItemHeight. Soll diese variabel sein, so setzen Sie die Eigenschaft Style auf csOwnerDrawVariable
respektive lbOwnerDrawVariable. Im Ereignis OnMeasureItem werden Sie dann bei jedem Element aufgefordert, dessen
Höhe - mit Hilfe des Referenzparameters Height - anzugeben.

zurück

Hintergrundbitmaps in eigenen Fenstern
Viele Applikationen verwenden marmorierte Hintergründe oder sonstige Texturen, um die Anwendung aufzupeppen. Auch
Ihnen steht diese Technik in Delphi offen. Dazu benötigen Sie zunächst einmal eine BMP-Datei. Zwar können Sie diese auch in
einem Image-Feld auf Ihrem Formular positionieren. Das verschwendet jedoch unnötig Ressourcen. Statt dessen ist es
günstiger, das Bild direkt als RES-Datei in Ihrer EXE-Datei einzubinden. Gehen Sie wie folgt vor: 1. Zuerst speichern Sie das
Bitmap - nennen wir es Backbmp.bmp - in Ihrem Projektverzeichnis. 2. Dann legen Sie eine Textdatei namens Backbmp.rc mit
dem Eintrag
BACKBITMAP BITMAP BACKBMP.BMP
an und rufen von der DOS-Ebene den Ressourcen-Compiler von Delphi auf. Dessen Name lautet in der 16-Bit-Version
Brcc.exe respektive Brcc32.exe und befindet sich im Bin-Verzeichnis Ihrer Delphi-Installation. Der Aufruf brcc backbmp.rc
erzeugt eine RES-Datei. 3. Als nächstes fügen Sie am Anfang des Implementation-Abschnitts den Eintrag
{$R BACKBMP.RES} ein. So wird die Grafikressource in Ihre EXE-Datei gelinkt. 4. Im Ereignis OnPaint des Formulars
schließlich laden Sie das Bild in eine Tbitmap-Variable und übertragen es auf die Zeichenfläche:

procedure TForm1.FormPaint(Sender: TObject);
Var BackBitmap: TBitMap;
begin
BackBitmap := TBitmap.Create;
BackBitmap.Handle := LoadBitmap(hInstance,'BACKBITMAP');
{ oder in Delphi 2: BackBitmap.LoadFromResourceName(hInstance,'BACKBITMAP');}
Canvas.Draw(0,0,BackBitmap);
BackBitmap.Free;
end;

zurück

Bitmaps auf der Zeichenfläche kacheln
Windows selbst kann Hintergrundbilder auf zwei verschiedene Arten anzeigen:zentriert oder gekachelt. Bei ersterem Verfahren
erscheint das Bild nur einmal in der Mitte des Bildschirms. Beim kacheln wird das Bild über die gesamte Desktop-Fläche
verteilt. Genau dieses Verfahren können Sie selbst anwenden. Alles was Sie benötigen ist ein Control, das eine
Canvas-Eigenschaft enthält und die Prozedur TileBmp:

Procedure TileBmp(C: TCanvas; B: Tbitmap);
Var X, Y, XAnz, YAnz: Integer;
Begin
XAnz := C.ClipRect.Right Div B.Width;
YAnz := C.ClipRect.Bottom Div B.Height;
For X := 0 To XAnz Do
For Y := 0 To YAnz Do
C.Draw(X*B.Width, Y*B.Height, B);
End;

Zu den Controls mit Canvas-Eigenschaft gehören mehr Delphi-Komponenten, als Sie wahrscheinlich vermuten: TBitmap,
TCustomComboBox, TCustomControl, TCustomLabel, TCustomListBox, TCustomOutline, TDBGrid, TDrawGrid, TForm,
TGraphicControl, THintWindow, TImage, TPaintBox, TPrinter, TTabSet. Haben Sie beispielsweise eine Textur -
beispielsweise eine Granit oder Marmorstruktur - in Image1 geladen, so legen Sie diese Textur mit
TileBmp(Form1.Canvas, Image1.Picture.Bitmap);
auf die gesamte Fensterfläche.

zurück

CD-ROM oder nicht
Sicherlich standen Sie auch schon einmal vor dem Problem, zu erkennen, ob ein Laufwerk ein CD-ROM ist oder nicht. In der
Regel behilft man sich mit der Abfrage, ob alle Dateien schreibgeschützt sind und 0 Bytes freier Speicher auf dem Laufwerk ist.
Dies sind jedoch nur Indizien, die keinesfalls mit Sicherheit sagen, daß es sich um ein CD-Laufwerk handelt. Zudem ist die
Abfrage sehr zeitaufwendig. Sehr viel simpler ist es, den CD-ROM Interrupt 2Fhex zu verwenden. Genau das machen die
beiden folgenden Funktionen:

Procedure Check4CDROM(var Anzahl, Erstes: word); assembler;
asm
mov ax, 1500h
xor bx, bx
int $2f
les di, Anzahl
mov es:[di], bx
les di, Erstes
mov es:[di], cx
end;

Function IstCDrom(LW : Char):BOOLEAN;
Var I, Anzahl,Erstes : word;
begin
Result := false;
Check4CDROM(Anzahl,Erstes);
if Anzahl > 0 then
for I := 0 to (Anzahl-1) do
If char(Erstes + Byte('A') + I) = upcase(LW)
Then Result := True;
end; 

Wollen Sie also künftig prüfen, ob Laufwerk D: ein CD-ROM ist, reicht der Aufruf 

If IstCDROM('d') Then ...

zurück

Farbpalette in einer ComboBox
In vielen Programmen ist es bereits zu sehen, in Ihren nach diesem Tip auch. Die Rede ist von Combo-Boxen, in denen statt
Text eine Farbpalette dargestellt ist. Im ersten Schritt legen Sie eine ComboBox-Komponente auf ein Formular. Danach füllen
Sie es - beispielsweise im Ereignis OnCreate des Formulars - mit den gewünschten Farbwerten:

with ComboBox1.Items do begin
Add(IntToStr(clRed));
Add(IntToStr(clFuchsia));
Add(IntToStr(clBlue));
Add(IntToStr(clGreen));
Add(IntToStr(clYellow));
end;

Starten Sie jetzt das Programm, dann sehen Sie nur Zahlen statt der Farbwerte. Als nächstes setzen Sie die Eigenschaft Style
der ComboBox auf "csOwnerDrawFixed". Das bedeutet, daß bei jeder Darstellung eines Elements der ComboBox das
Ereignis "OnDrawItem" ausgelöst wird. In der zugehörigen Behandlungsroutine "verwandeln" Sie die Zahlenwerte in die
passenden Farbbalken:

procedure TForm1.ComboBox1DrawItem(Control: TWinControl;
Index : Integer; Rect: TRect; State: TOwnerDrawState);
begin
with Control as TComboBox,Canvas do begin
Brush.Color := clWhite;
FillRect(Rect);
InflateRect(Rect,-2,-2);
Brush.Color := StrToInt(Items[Index]);
FillRect(Rect);
end;
end;

zurück

RGB-Werte zu TColor konvertieren
Mit einer einfachen Funktion konvertieren Sie Farbwerte im RGB-Farbraum(Rot, Grün, Blau) in Delphi-konforme
TColor-Werte:

Function RGB(R,G,B: Byte): TColor;
Begin
Result := B Shl 16 Or
G Shl 8 Or
R;
End;

Um beispielsweise der TColor-Wert von Rot zu erhalten, lautet der Aufruf "RGB(255,0,0)". Mischfarben setzen sich aus einer
Kombination der Grundfarben zusammen. So liefert "RGB(0,255,255)" die Farbe Gelb. Wollen Sie Graustufen, so setzen Sie
für alle drei Parameter denselben Wert ein. Weiß hat somit den Aufruf "RGB(255,255,255)", Schwarz"RGB(0,0,0)" und ein
50-prozentiger Grauton "RGB(127,127,127)".

zurück

Umwandlung in Graustufen
Auf der Zeichenfläche "Canvas" können Sie beliebige Farbgrafiken darstellen. Mit einer einfachen Transformation wandeln Sie
diese in Graustufenbilder um. Dazu müssen Sie wissen, daß jede dargestellte Farbe aus einer Kombination aus Rot, Grün und
Blau zusammengesetzt ist. Jede dieser Grundfarben hat eine gewisse Leuchtkraft. Grün leuchtet am stärksten, danach kommt
Rot und am dunkelsten erscheint Blau. Haben Sie bereits die Farbwerte eines Pixels in den Variablen R, B und G abgelegt, so
erhalten Sie den Grauwert über 
GR := Trunc(B*0.11+G*0.59+R*0.3);
Die folgende Funktion Convert2Gray setzt jede beliebige Zeichenfläche in Graustufen um:

Procedure Convert2Gray(Cnv: TCanvas);
Var X, Y: Integer;
Color: LongInt;
R, G, B, Gr: Byte;
T0: TDateTime;
Begin
T0 := Time;
With Cnv Do
For X := Cliprect.Left To ClipRect.Right Do
For Y := Cliprect.Top To ClipRect.Bottom Do begin
Color := ColorToRGB(Pixels[X,Y]);
B := (Color And $FF0000) Shr 16;
G := (Color And $FF00) Shr 8;
R := (Color And $FF);
Gr := HiByte(R*77+G*151+B*28);(* GR := Trunc(B*0.11+G*0.59+R*0.3);*)
Pixels[X,Y] := RGB(Gr,Gr,Gr);
End;
ShowMessage(IntToStr(Trunc((Time-T0)*24*60*60*10)));
End;

Function RGB(R,G,B: Byte): TColor;
Begin
Result := B Shl 16 Or
G Shl 8 Or
R;
End;

Wollen Sie beispielsweise das Bild in Image1 umwandeln, so lautet der Aufruf:
Convert2Gray(Image1.Picture.Bitmap.Canvas); 

zurück

Applikationen verstecken
Oft ist es wünschenswert, daß ein Fenster oder eine ganze Anwendung nicht in der Taskleiste erscheint. Hierzu existiert in der
Windows-API die Funktion "ShowWindow", der Sie das Fenster- oder Applikations-Handle sowie eine Befehlskonstante
übergeben. Wollen Sie beispielsweise eine Anwendung samt Fenster für 3 Sekunden verschwinden lassen, so kommen Sie mit
dem folgenden Code zum Ziel:

[...]
Var T : TDateTime;
begin
ShowWindow(Self.Handle, SW_Hide);
ShowWindow(Application.Handle, SW_Hide);
T := Time;
Repeat
Application.ProcessMessages;
Until Time - T > 3 / 24 / 3600;
ShowWindow(Self.Handle, SW_Show);
ShowWindow(Application.Handle, SW_Show);
end;

zurück

Wechselndes Taskbar-Icon
Delphi 2, 3, 4
Mit wechselnden Symbolen in der Taskleiste machen Sie die Anwender Ihrer Programme auf wichtige Änderungen in Ihrer
Applikation aufmerksam. Mit Hilfe eines Timers und zwei Image-Komponenten wechseln Sie dieses Symbolbild animiert: 

procedure TForm1.Timer1Timer(Sender: TObject);
Const I : Integer = 0;
begin
I := (I + 1) Mod 2;
If I=0
Then Application.icon := Image1.Picture.Icon
Else Application.icon := Image2.Picture.Icon;
end;

Auch in Delphi 1 ändern Sie auf diese Weise das Icon. Allerdings existiert unter Windows 3.1 keine Taskbar, wodurch die
Animation nicht sichtbar wird. Aber auch 16-Bit-Programme, die unter Windows 95 laufen, zeigen keinerlei Änderung des
Symbolbilds.

zurück

Fenster ohne Titelzeile verschieben
Delphi 1, 2, 3, 4
Vielleicht haben Sie auch schon einmal Fenster gesehen, die nicht nur mit Hilfe der Titelleiste verschoben werden konnten. Und
vielleicht haben Sie ja schon einmal versucht, dieses Verhalten mit Hilfe des OnMouseMove-Ereignisses nachzuprogrammieren
und sind auf zahlreiche Probleme gestoßen. Mit diesem Trick hat die komplizierte Programmierung ein Ende. Alles, was Sie
brauchen, ist eine Methode, die auf das Windows-Ereignis WM_NCHitTest reagiert. Dazu deklarieren Sie im Abschnitt
Private die Methode 

procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest; 

Im Implementation-Abschnitt definieren Sie dann den Code der Methode

procedure TForm1.WMNCHitTest (var M: TWMNCHitTest);
begin
inherited;
if M.Result = htClient then M.Result := htCaption;
end;

Fertig. Was aber macht diese Routine? Eigentlich ganz einfach! Das Ereignis tritt ein, sobald Sie auf das Fenster klicken.
Unsere Routine erfragt nun, ob der Klick im Fenster-Titel (htCaption) oder im Arbeitsbereich (htClient) stattgefunden hat. Ist
letzteres der Fall, dann meldet die Routine einfach zurück, daß es sich keineswegs um den Arbeitsbereich, sondern doch um
den Fenstertitel handelt. Derart getäuscht macht sich Windows daran, das Fenster zu verschieben.

zurück

Aufteilung in Token
Delphi 1, 2, 3, 4
Ein Token ist ein Teil einer Zeichenkette, die durch ein definiertes Sonderzeichen von anderen Teilstrings getrennt ist. So kann
man beispielsweise einen Satz als eine Ansammlung von Tokens ansehen, die durch Leerzeichen unterschieden werden.
Besonders in INI-Dateien finden sich oft Einträge, die durch Kommata voneinander getrennt sind. Mit Hilfe der folgenden
beiden Funktionen NumToken und GetToken ermitteln Sie die Anzahl der einzelnen Teilzeichenketten respektive filtern den
x-ten Ausdruck heraus.

function GetToken(aString: String; SepChar: Char; TokenNum: Byte):String;
var Token : String;
StrLen : Byte;
TNum : Byte;
TEnd : Byte;
begin
StrLen := Length(aString);
TNum := 1; TEnd := StrLen;
while ((TNum <= TokenNum) and (TEnd <> 0)) do begin
TEnd := Pos(SepChar,aString);
if TEnd <> 0 then begin
Token := Copy(aString,1, Tend - 1); Delete(aString,1,TEnd);
Inc(TNum);
end else begin
Token := aString;
end;
end;
if TNum >= TokenNum then begin
Result := Token;
end else begin
Result := '';
end;
end;

function NumToken(aString: String; SepChar: Char):Byte;
var RChar : Char;
StrLen : Byte;
TNum : Byte;
TEnd : Byte;
begin
if SepChar = '#' then RChar := '*' else RChar := '#'
StrLen := Length(aString);
TNum := 0; TEnd := StrLen;
while TEnd <> 0 do begin
Inc(TNum); TEnd := Pos(SepChar,aString);
if TEnd <> 0 then begin
aString[TEnd] := RChar;
end;
end;
Result := TNum;
end; 

So ermitteln Sie mit NumToken('Nur ein Test',' '); die Anzahl der Wörter(hier: 3) und GetToken('Nur ein Test',' ',2) liefert
Ihnen das zweite Wort (hier: ein) zurück.

zurück

Bitmaps aus Ressourcendatei laden
Delphi 1, 2, 3, 4

Mit dem Bildeditor können Sie unter anderem Bitmaps, Cursor und Icons in einer Ressourcendatei ablegen. In Delphi selbst
wird die Ressource mit dem gleichen Namen wie das Formular beim Linken durch die Anweisung 
{$R *.DFM} 
in die EXE-Datei eingebunden. Vom Code aus haben Sie dann ganz einfach Zugriff auf diese Grafiken. Haben Sie
beispielsweise ein Bitmap mit dem Namen "HUGO" in der RES-Datei abgelegt, so erlangen Sie mit den Zeilen

Var BMap : TBitmap;
[...]
BMap:= TBitmap.Create;
BMap.Handle := LoadBitmap(hInstance, 'HUGO');

Zugriff auf die Grafik. Vergessen Sie aber nicht, den Speicherplatz wieder freizugeben, sobald Sie das Bitmap nicht mehr
benötigen:

BMap.Free; 

zurück

Dateien kopieren
Delphi 1, 2, 3, 4 
Nein, keine Angst! Hier folgt keine weitere Kopierroutine, in der Sie sequentiell Dateien einlesen und wieder schreiben. Statt
dessen verwenden wir eine Funktion, die sowieso bereits in Windows enthalten und in Delphi deklariert ist. Die Rede ist von
den LZExpand-Funktionen. Diese Routinen haben die Aufgabe, Dateien zu entkomprimieren, die mit Microsofts
Standardverfahren gepackt wurden. Ist eine Datei aber nicht komprimiert, wird sie lediglich kopiert. Die Funktion CopyFile
veranschaulicht das Verfahren: 

function CopyFile( src, dest: String): Boolean;
var s, d: TOFStruct;
fs, fd: Integer;
fnSrc, fnDest: PChar;
begin
src:=src + #0;
dest:=dest + #0; {Trick, um aus einem String ein ASCIIZ zu machen:}
fnSrc:=@src[1];
fnDest:=@dest[1];
fs := LZOpenFile( fnSrc, s, OF_READ );
fd := LZOpenFile( fnDest, d, OF_CREATE );
if LZCopy( fs, fd ) < 0
then Result:=False
else Result:=True;
{ Dateien schliessen }
LZClose( fs );
LZClose( fd );
end; 

Vergessen Sie jedoch nicht, die Unit LZExpand in die USES-Klausel aufzunehmen.

zurück

Linker Rand für Memofelder
Delphi 1, 2, 3, 4
Mit Hilfe der API-Routine SendMessage setzen Sie den linken und rechten Rand in Memofeldern. Soll dieser beispielsweise 20
Pixel betragen, so lautet der zugehörige Code: 

var Rect: TRect;
begin
SendMessage(Memo1.Handle, EM_GETRECT, 0, LongInt(@Rect));
Rect.Left:= 20;
SendMessage(Memo1.Handle, EM_SETRECT, 0, LongInt(@Rect));
Memo1.Refresh;
end;

zurück

Laufwerk bereit?
Delphi 1, 2, 3, 4
Oftmals - besonders bei Wechseldatenträgern - ist es nötig, zu prüfen, ob ein Laufwerk bereit respektive überhaupt
ansprechbar ist. Die Funktion DiskInDrive übernimmt genau diese Aufgabe: 

function DiskInDrive (Drive: Char): Boolean;
var ErrorMode: word;
begin
Drive := UpCase(Drive);
if not (Drive in ['A'..'Z'])
then raise EConvertError.Create ('Kein Laufwerksbuchstabe');
ErrorMode := SetErrorMode( SEM_FailCriticalErrors);
try
Result := DiskSize( Ord(Drive)-$40) <> -1;
finally
SetErrorMode(ErrorMode);
end;
end;

zurück

Laufwerkstyp ermitteln
Delphi 1, 2
Um den Typ eines Laufwerks zu ermitteln, verwenden Sie die API-Routine GetDriveType. Diese Routine erhält als Parameter
die Nummer des Laufwerks(A=0, B=1, etc.) und liefert einen numerischen Wert, anhand dessen Sie den Datenträgertyp
bestimmen können..

function ShowDriveType (Drive: char): string;
var i: word;
begin
Drive := UpCase(Drive);
i := GetDriveType(ord (Drive) - ord('A'));
case i of
DRIVE_REMOVABLE: result := 'Floppy';
DRIVE_FIXED: result := 'Festplatte';
DRIVE_REMOTE: result := 'Netzwerk';
else result := 'nicht vorh.';
end;
end; 

Allerdings wird hier nur zwischen Wechselmedium, Festplatte und Netzwerklaufwerk unterschieden. Während Wechselplatten
als Floppy kategorisiert werden, meldet die Routine bei CD-ROM-Laufwerken ein Netzwerk zurück. Daher müssen Sie in
jedem Fall noch gründlicher nachprüfen, ob der ermittelte Laufwerkstyp auch stimmt.

zurück

Stringfunktionen
Delphi 1
Endlich haben es auch die Borlander erkannt und ab der Version 2 von Delphi stehen Zeichenketten-Funktionen zur Verfügung,
wie man sie aus VisualBasic kennt. Was aber machen die armen 16-Bit-Programmierer? Nun, die schreiben sich eine
kompatible String-Unit:

function TrimRight(const s: string): string;
{Folgende Leerzeichen entfernen}
var i: integer;
begin
i := Length(s);
while (I>0) and (s[i]<=#32) do Dec(i);
Result := Copy(s, 1, i);
end;

function TrimLeft(const S: string): string;
{Führende Leerzeichen entfernen}
var I, L: Integer;
begin
L := Length(S); I := 1;
while (I<=L) and (S[I]<=#32) do Inc(I);
Result := Copy(S, I, Maxint);
end;

function Trim(const S: string): string;
{Anfangs- und Endeleerzeichen entfernen}
begin
Result:=TrimLeft(TrimRight(S));
end; 

Noch mehr Stringfunktionen gibt's bei mir (im Moment per eMail, bald vielleicht per Download)

zurück

Stringlisten ausdrucken
Delphi 1, 2, 3, 4
Immer wieder ist es nötig, den Inhalt eines Listen- oder Memofeldes auf dem Drucker auszugeben. Eine besonders einfache
Variante bietet die folgende Funktion, die ohne jeglichen Schnickschnack die Zeilen einer Stringliste zu Papier bringt:

uses Printers;
[...]
procedure PrintStrings (S: TStrings);
var Prn: TextFile;
i: word;
begin
AssignPrn(Prn);
try
Rewrite(Prn);
try
for i:=0 to S.Count-1 do writeln(Prn, S.Strings[i]);
finally
CloseFile(Prn);
end;
except
on EInOutError do MessageDlg('Fehler!', mtError, [mbOk], 0);
end;
end; 

Um beispielsweise den Inhalt eines Memofeldes zu drucken, lautet der Befehl

PrintStrings(Memo1.Lines); 

und um dasselbe mit einem Listenfeld zu tun

PrintStrings(Listbox1.Items); 

Achten Sie allerdings darauf, daß die Zeilen genauso ausgegeben werden, wie am Bildschirm angezeigt.

zurück

IO-Ports lesen und schreiben
Delphi 1, 2
Wollen Sie unter Delphi 1 mit Hilfe der IO-Ports beispielsweise die serielle oder parallele Schnittstelle ansprechen, so
verwenden Sie das globale Array"Ports". Dieses steht allerdings in der 32-Bit-Entwicklungsumgebung nicht mehr zur
Verfügung. Die zwei folgenden allgemein gehaltenen Routinen können Sie jedoch in jeder Version von Delphi verwenden:

function InPort(PortAddr:word): byte;
{$IFDEF WIN32}assembler; stdcall;
asm mov dx,PortAddr
in al,dx
end;
{$ELSE}
begin
Result := Port[PortAddr];
end;
{$ENDIF}

procedure OutPort(PortAddr: word; Databyte: byte);
{$IFDEF WIN32}assembler; stdcall;
asm mov al,Databyte
mov dx,PortAddr
out dx,al
end;
{$ELSE}
begin
Port[PortAddr] := DataByte;
end;
{$ENDIF}

Dieser Delphi Tip stammen vom Michael Peter E.Mail:michael_peter@os2bbs.art-line.de

zurück

Runde Fenster erzeugen
Delphi 2, 3
Warum sollen Fenster immer eckig sein. Am Beispiel einer Uhr zeigen wir Ihnen,daß auch beliebige andere Fensterformen
möglich sind. Mit Hilfe der Win32 API Funktion "CreateRoundRectRgn" wird eine Region erzeugt, die mit "SetWindowRgn"
zur Fensterdarstellung verwendet wird. Dieser Vorgang ist in der Procedure "FormResize" verpackt. In der Procedure Destroy
wird die Region bei schließen des Fensters freigegeben. Alles andere ist eigentlich nur buntes Beiwerk, um ein schönes Beispiel
zu erstellen. Das Zeichnen der Uhrzeiger bietet noch eine kleine Nachhilfestunde in Trigonometrie. Das Beispiel benötigt eine
Form, ein Kontextmenü mit "MenuePunkt" zum Ein-/Ausblenden der Titelzeile, einen Timer für die Uhr und eine Paintbox für
das Zeichnen der Uhr.
Da es bezüglich des folgenden Quelltextes bereits mehrfach zu Nachfragen kam, habe ich ein Beispielprojekt erzeugt
und die kompletten Quellen als ZIP-File zum Download gepackt.

Die Proceduren sollten wie folgt definiert sein:

procedure Timer1Timer(Sender: Tobject); // Aktualisierung der Uhr
procedure Titelzeile1Click(Sender: TObject); // Titelzeile einblenden
procedure FormResize(Sender: TObject); // hier steckt das Know-How
procedure PaintBox1Paint(Sender: TObject);

Jetzt geht's los:

destructor TFormRound.Destroy;
begin
if FRegion <> 0 then begin // Region für das Fenster abmelden (Parameter 0)
SetWindowRgn(Handle, 0, True); // GDI-Objekt freigeben
DeleteObject(FRegion);
end;
inherited Destroy;
end;

procedure TFormRound.FormResize(Sender: TObject);
var versatz: integer;
begin
if Titelzeile1.Checked
then versatz:=10
else versatz:=(paintbox1.ClientToScreen(Point(0,0))).y-FormRound.top ;
// Rechteck mit abgerundeten Ecken als Region definieren
FRegion := CreateRoundRectRgn(0, versatz, Width, Height, Width, Height);
// die neue Region einsetzen -> damit wird nur das am Bildschirm
// sichtbar, was sich innerhalb der Regionsgrenzen befindet!
if FRegion <> 0 then SetWindowRgn(Handle, FRegion, True);
end;

procedure TFormRound.Timer1Timer(Sender: TObject);
var Hour, Min, Sec, MSec: Word;
mx, my, dx, dy: integer;
alfa: extended;
begin
DecodeTime(Now, Hour, Min, Sec, MSec);
mx:=Paintbox1.width div 2; my:=Paintbox1.Height div 2;
with Paintbox1.canvas do begin
brush.color:=clSilver;
pen.color:=clSilver;
rectangle(0,0,Paintbox1.width, Paintbox1.height);
// ellipse(4, 6,Paintbox1.width-4, Paintbox1.height-4);
pen.color:=clYellow; pen.width:=4;
moveto(mx, my);
alfa:=(Hour+3+(Min/60))*0.1047*5;
dx:=round(cos(alfa) * (mx- (mx / 2)));
dy:=round(sin(alfa) * (my- (my / 2)));
lineto(mx-dx, my-dy);
pen.width:=3; moveto(mx, my);
alfa:=(Min+15+(Sec/60))*0.1047;
dx:=round(cos(alfa) * (mx- (mx / 9)));
dy:=round(sin(alfa) * (my- (my / 9)));
lineto(mx-dx, my-dy);
pen.color:=clBlack; pen.width:=1;
moveto(mx, my);
alfa:=(Sec+15+(MSec/1000))*0.1047;
dx:=round(cos(alfa) * (mx- (mx / 10)));
dy:=round(sin(alfa) * (my- (my / 10)));
lineto(mx-dx, my-dy);
end;
end;

procedure TFormRound.Titelzeile1Click(Sender: TObject);
begin
Titelzeile1.checked:= not Titelzeile1.checked;
FormResize(nil);
end;

procedure TFormRound.PaintBox1Paint(Sender: TObject);
begin
with Paintbox1.canvas do begin
pen.color:=clGray; pen.width:=2;
ellipse(2, 4,Paintbox1.width-2, Paintbox1.height-2);
end;
end;

Autor: Michael Peter E.Mail: michael_peter@os2bbs.art-line.de

Beispielprojekt von: Thomas Groß

zurück

Netzwerkbenutzer anzeigen
Der Windows Explorer zeigt unter dem Ordner "Netzwerkumgebung" alle dem Netzwerk angeschlossenen Benutzer und
Drucker sortiert nach Arbeitsgruppen an. Wie erreicht man nun so etwas in seinen eigenen Programmen? - Hier ein
Lösungsansatz:

procedure TNetInfoForm.NetError(Error: Integer);
var NetErrorCode: Integer;
NetError: PChar;
ProviderName: PChar;
begin
NetError := StrAlloc(256); ProviderName := StrAlloc(100);
WNetGetLastError( NetErrorCode, // pointer to error code
NetError, // pointer to string describing error
256, // size of description buffer, in characters
ProviderName, // pointer to buffer for provider name
100 // size of provider name buffer
);
Status := Format('Extended NetError [%d]: %s', [NetErrorCode,NetError]);
StrDispose(NetError); StrDispose(ProviderName);
end;

procedure TNetInfoForm.EnumNetChilds(Node: TTreeNode; NetInfo: PNetResource);
const MaxCount = 10;
Var Error : Integer;
I, EntryCount,
BufferSize : Integer;
Buffer: array[1..MaxCount] of TNETRESOURCE;
begin
Error := WNetOpenEnum(RESOURCE_GLOBALNET, // scope of enumeration
RESOURCETYPE_ANY, // resource types to list
0, // resource usage to list 0 = any
NetInfo, // pointer to resource structure
HRootEnum // pointer to enumeration handle buffer
);
case Error of
ERROR_NO_NETWORK: Status := 'No Network!';
No_Error: begin
EntryCount := MaxCount;
BufferSize := SizeOf(Buffer);
Error := WNetEnumResource(HRootEnum, // handle to enumeration
EntryCount, // pointer to entries to list
@Buffer, // pointer to buffer for results
BufferSize); // pointer to buffer size variable
Case Error of
No_Error: begin
Status := 'Info read successful';
for I := 1 to EntryCount do with NetInfoTV do
if Assigned(NetInfo)
then EnumNetChilds(Items.AddChild(Node,
StrPas(Buffer[I].lpRemoteName)), @Buffer[I])
else EnumNetChilds(Items.Add(Node,
StrPas(Buffer[I].lpRemoteName)), @Buffer[I]);
end;
ERROR_NO_MORE_ITEMS: Status := 'No More Entries';
else begin
Error:= GetLastError;
case Error of
ERROR_EXTENDED_ERROR: NetError(Error);
else Status := Format('Error reading Info, Error: %d', [GetLastError]);
end;
end;
end;
end;
end;
WNetCloseEnum(HRootEnum);
end;

procedure TNetInfoForm.InfoReadBtnClick(Sender: TObject);
begin
NetInfoTV.Items.BeginUpdate;
NetInfoTV.Items.Clear;
EnumNetChilds(NetInfoTV.TopItem, nil);
NetInfoTV.Items.EndUpdate;
end;

Autor: Michael Peter

zurück

Programm nur einmal starten
Zum Thema 'Mein Programm darf nur einmal innerhalb der Windows-Umgebung ausgeführt werden' haben sich schon viele
Programmierer den Kopf zerbrochen. Folgende Lösung finde ich besonders elegant:
Wird versucht über den Dateimanager, den Programmanager o.ä. Programmstarter ein weiteres Mal Ihre Anwendung
auszuführen, wird statt dessen zur ersten Instanz Ihres Programmes umgeschaltet, auch wenn Ihr Programm als Icon auf dem
Windows-Desktop abgelegt wurde.
Wie immer ein kurzes Beispiel: Der Prozeduraufruf muß vor dem Entwerfen des ersten Formulars erfolgen. Also z.B. so:

program MyProg;
uses Forms, Tools, {angenommen Tools ist die Unit, in der Win3DDlgs deklariert wurde}
Unit1 in 'UNIT1.PAS' {Form1};
{$R *.RES}
begin
AppPrevInst;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

Die folgenden Routinen sollten am besten in eine eigene Unit kopiert werden:

UNIT TOOLS;
type PHWND = ^HWND;
function EnumFunc(Wnd:HWND; TargetWindow:PHWND): boolean; export;
var ClassName : array[0..30] of char;
begin
Result := true;
if GetWindowWord(Wnd,GWW_HINSTANCE) = hPrevInst then begin
GetClassName(Wnd,ClassName,30);
if StrIComp(ClassName,'TApplication') = 0 then begin
TargetWindow^ := Wnd;
Result := false;
end;
end;
end;

procedure GotoPreviousInstance;
var PrevInstWnd : HWND;
begin
PrevInstWnd := 0;
EnumWindows(@EnumFunc,longint(@PrevInstWnd));
if PrevInstWnd <> 0 then
if IsIconic(PrevInstWnd)
then ShowWindow(PrevInstWnd,SW_RESTORE)
else BringWindowToTop(PrevInstWnd);
end;

procedure AppPrevInst;
begin
if hPrevInst <> 0 then begin
GotoPreviousInstance;
Application.Terminate;
end;
end;

zurück

WinVer
Diese Funktion liefert die Nummer der Windows-Version unter der momentan gearbeitet wird. Die Ausgabe ist vom Typ
Word, damit man im Projectcode über die größer-, kleiner- und gleich-Operatoren (>,<,=) den Ausgabewert mit der
erwarteten Windows-Version leicht vergleichen kann. Man erhält z.B. unter Windows 3.1 den Wert 310, unter Windows 95
den Wert 395(!)(nicht 400 wie man vielleicht annehmen würde). 
Beispiel: Es wird eine Windows-Version höher als Windows für Workgroups ermittelt und dann ein Info-Fenster eingeblendet.

procedure TForm1.FormCreate(Sender: TObject);
begin
if WinVer > 311 then
ShowMessage('Dies ist keine WIN95-32Bit-Anwendung');
end;

WinVer selbst ruft intern die Windows API-Funktion GetVersion auf um die Versionsnummer zu erhalten.

function WinVer: Word;
begin
Result := ( LOBYTE(LOWORD(GetVersion)) * 100) +
HIBYTE(LOWORD(GetVersion));
end;

zurück

WinDir
Diese Funktion liefert das Arbeitsverzeichnis der laufenden Windowsversion. Die Funktion gibt das
Windows-Arbeitsverzeichnis als String, ohne abschließenden Backslash zurück. In diesem Verzeichnis befinden sich u.a. die
Windows INI-Dateien wie z.B. die Datei WIN.INI.
Beispiel: Nach anklicken eines Buttons erscheint ein Dialogfenster mit dem Windows-Pfad.

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage('Das Windows-Verzeichnis ist: ' + WinDir);
end;

function WinDir: string;
var Buffer: PChar;
Size: Word;
begin
Size := 144;
GetMem(Buffer,144);
if GetWindowsDirectory(Buffer, Size) >0 then Result := StrPas(Buffer)
else Result := '';
FreeMem(Buffer,144);
end;

zurück

SysDir
Diese Funktion liefert das Systemverzeichnis der laufenden Windowsversion. Die Funktion gibt das
Windows-System-Verzeichnis als String ohne abschließenden Backslash zurück. In diesem Verzeichnis befinden sich
u.a.System-, Treiber- und Bibliotheksdateien.
Beispiel: Nach anklicken eines Buttons erscheint ein Dialogfenster mit dem Windows-System-Pfad.

procedure TForm1.Button1Click(Sender: Tobject);
begin
ShowMessage('Das System-Verzeichnis ist: ' + SysDir);
end;

function SysDir: string;
var Buffer: Pchar;
Size: Word;
begin
Size := 144;
GetMem(Buffer,144);
if GetSystemDirectory(Buffer, Size) >0 then Result := StrPas(Buffer)
else Result := '';
FreeMem(Buffer,144);
end;

zurück

Rotierte Schriften auf dem Bildschirm oder Drucker
Normalerweise werden Schriften nur horizontal ausgegeben. Alle Attribute einer Schrift verwaltet Windows in einem Record
namens "TLogFont". Dessen Feld "lfEscapement" bestimmt die Rotation der Schrift. Standardmäßig ist dieser Wert "0". Über
die API-Funktion"CreateFontIndirect" können Sie den Wert jedoch beliebig setzen. Achten Sie jedoch darauf, daß Sie die
Angabe in 1/10tel Grad angeben. Eine einfache Routine nimmt Ihnen diese Arbeit ab:

procedure CanvasSetAngle( C: TCanvas; A: Single);
var LogRec: TLOGFONT; {Font Infos}
begin
GetObject(C.Font.Handle, SizeOf(LogRec),Addr(LogRec));
LogRec.lfEscapement := Trunc(A*10);
C.Font.Handle := CreateFontIndirect(LogRec);
end; 

Wollen Sie jetzt beispielsweise auf Ihrem Formular Text von unten nach oben ausgeben, dann rufen Sie zunächst die Prozedur
mit CanvasSetAngle(Form1.Canvas, 90) auf und führen danach die Ausgabe wie gewohnt mit
Form1.Canvas.TextOut(20,150,'Test'); aus. Das selbe funktioniert natürlich auch auf dem Drucker. Dann lautet der Aufruf
analog CanvasSetAngle(Printer.Canvas, 90);

zurück

Dateien, Ordner, Laufwerke

Die Volume-ID eines Laufwerks ermitteln

Die Funktion "VolumeID" gibt die Volume-ID, also den Namen einer Partition zurück: 

function VolumeID(DriveChar: Char): string;
var
OldErrorMode : Integer;
NotUsed, VolFlags : DWORD;
Buf : array [0..MAX_PATH] of Char;
begin
OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
GetVolumeInformation(PChar(DriveChar + ':\'), Buf, 
sizeof(Buf), nil, NotUsed, VolFlags, 
nil, 0);
Result := Format('[%s]',[Buf]);
finally
SetErrorMode(OldErrorMode);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption:=VolumeID('c');
end;

zurück

Wie kann man aus einem Delphi-Programm eine Diskette formatieren?

Dieses Beispiel demonstriert das "stille" Formatieren eines Datenträgers. Die Routine ruft das DOS-Programm Format.com
auf, darum erscheint kein Windows-Formatier-Dialog, es wird auch kein DOS-Fenster geöffnet. Nach dem Aufruf des
Formatierprogramms wartet die Routine, bis das Formatieren beendet ist und prüft schließlich noch, ob die Formatierung
erfolgreich war: 

function TMainform.Diskette_formatieren(Laufwerk: String): Integer;
var
Befehl : String;
Datei : TextFile;
TempDateiName : Array [0..255] of Char;
TempVerzeichnis : Array [0..255] of Char;
StartupInfo : TStartupInfo;
ProcessInfo : TProcessInformation;
SektorenProCluster : Integer;
BytesProSektor : Integer;
FreieCluster : Integer;
ClusterInsgesamt : Integer;
Temp : Integer;
begin
// Datei zum Beantworten der Abfragen von FORMAT.EXE
// im Temp-Verzeichnis anlegen.
GetTempPath(255, TempVerzeichnis);
GetTempFileName(TempVerzeichnis, 'TMP', 0, TempDateiName);

// Antwort-Datei erzeugen
AssignFile(Datei, TempDateiName);
Rewrite(Datei); // Antwort-Datei erzeugen und öffnen
Writeln(Datei, #13#10); // 1. Return ("Diskette einlegen ...")
Writeln(Datei, #13#10); // 2. Return (Diskettenbezeichnung)
Writeln(Datei, 'n'#13#10); // keine weitere Diskette
CloseFile(Datei); // Datei schließen

// Befehlszeile zum Aufrufen von FORMAT.COM
// command.com /c = automatisch nach Beendigung schließen
// format ... /u = unbedingt formatieren
// format ... /c = defekte Sektoren prüfen
Befehl := 'command.com /c format '+Laufwerk+' /u /c < '+TempDateiName;

// StartupInfo initialisieren.
FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
StartupInfo.cb := SizeOf(TStartupInfo);

// DOS-Fenster soll nicht angezeigt werden.
StartupInfo.dwFlags := StartF_UseShowWindow;
StartupInfo.wShowWindow := SW_Hide;

// Formatieren
if CreateProcess(nil, PChar(Befehl), nil, nil,
False, 0, nil, 'c:\',
StartupInfo,
ProcessInfo) then begin
// Warten bis Format beendet ist.
WaitForSingleObject(ProcessInfo.hProcess, Infinite);
CloseHandle(ProcessInfo.hProcess);
end;

// Antwort-Datei wieder löschen
DeleteFile(TempDateiName);

// War das Formatieren erfolgreich?
if GetDiskFreeSpace(PChar(Laufwerk), SektorenProCluster,
BytesProSektor, FreieCluster, 
ClusterInsgesamt) then begin 
// Anzahl defekter Sektoren berechnen
Temp := FreieCluster * SektorenProCluster * BytesProSektor;
Result := (1457664 - Temp) div BytesProSektor;
end
else 
// Diskette nicht eingelegt oder unformatiert
Result := - 1;
end;

zurück

Ermitteln von kurzen und langen Dateinamen

Mit der Funktion GetShortPathName ermittelt man aus einem langen Windows 95-Dateinamen den kurzen DOS-Dateinamen
im Format 8.3: 

function ShortFilename(LongName:string):string;
var ShortName : PChar;
begin
ShortName:=StrAlloc(Max_Path);
GetShortPathName(PChar(LongName), ShortName, Max_Path);
Result:=string(ShortName);
StrDispose(ShortName);
end;

In LongName wird der (lange) Original-Dateinamen als PCHAR-String übergeben, der kurze 8.3-dateiname wird als Wert der
Funktion zurückgegeben. MaxLength ist die maximal erlaubte Dateinamensgröße. Der Pfad muß mit übergeben werden und wird
auch wieder in Result zurückgegeben.

Zur Ermittlung eines langen Dateinamens aus einem kurzen (bzw. abgekürzten) empfiehlt sich diese Funktion, die auf der
FindFirst-Routine basiert: 

function GetLongPathName(APath:String):String;
var
i : Integer;
h : THandle;
Data : TWin32FindData;
IsBackSlash : Boolean;
begin
APath:=ExpandFileName(APath);
i:=Pos('\',APath);
Result:=Copy(APath,1,i);
Delete(APath,1,i);
repeat
i:=Pos('\',APath);
IsBackSlash:=i>0;
if Not IsBackSlash then 
i:=Length(APath)+1;
h:=FindFirstFile(PChar(Result+Copy(APath,1,i-1)),Data);
if h<>INVALID_HANDLE_VALUE then begin
try
Result:=Result+Data.cFileName;
if IsBackSlash then 
Result:=Result+'\';
finally
Windows.FindClose(h);
end;
end
else begin
Result:=Result+APath;
Exit;
end;
Delete(APath,1,i);
until Length(APath)=0;
end; {Peter Haas}

Diese Routine liefert die langen Namen zu Dateien und Verzeichnissen zurück. Diese sollten dazu existieren.

zurück

Wie prüfe ich, ob der User einen gültigen Dateinamen eingegeben hat?

Einfach testen, ob eines der folgenden Zeichen im Dateinamen (hier:Filename) enthalten ist: 

const
{fuer 8.3-Dateinamen im DOS-Format:}
ShortForbiddenChars : 
set of char=[';','=','+','<','>','|','"','[',']',' ','\',#39];
{fuer lange Dateinamen im Win95-Format:}
LongForbiddenChars : 
set of char=['<','>','|','"','\'];

procedure TForm1.Edit1Change(Sender: TObject);
var NameValid : boolean;
Filename : string;
i : word;
begin
Filename:=Edit1.Text;
NameValid:=true;
if CheckBoxLong.Checked then begin
for i:=1 to length(Filename) do
if Filename[i] in LongForbiddenChars then
NameValid:=false;
end
else begin
for i:=1 to length(Filename) do
if Filename[i] in ShortForbiddenChars then
NameValid:=false;
end;
if not NameValid then
ShowMessage('Ungültig!');
end;

zurück

Wie kürzt man einen Dateipfad ab, daß er eine bestimmte Länge nicht überschreitet?

Ab Delphi 3 gibt es dafür die undokumentierte Funktion "MinimizeName" aus der Unit "SysUtils": 

PathName:=Appication.Exename;
Label1.Caption:=MinimizeName(PathName, {Der abzukürzende Pfadname}
Label1.Canvas, {Die Referenz-Zeichenfläche}
Label1.Width); {Die maximale Ausgabe-Breite}

Zur Berechnung der maximal erlaubten Buchstabenzahl für den verkürzten Pfadnamen benötigt die Funktion die Zeichenfläche
(und damit die für diese Zeichenfläche eingestellte Schriftart), auf der der Text ausgegeben werden soll und die Breite des
Ausgaberechtecks.

Die Verkürzung eines Pfadnamens kann dann z.B. so aussehen:
C:\Programme\Borland\Delphi3\Projekte\Demos wird zu
C:\...\Projekte\Demos

Für ältere Delphiversionen kann man die Komponente TFileLabel von meiner Komponentenseite benutzen.

zurück

Wie erstelle ich eine Dateiliste mit den registrierten Icons und Dateibeschreibungen?

Diese Unit demonstriert, wie ein TListView mit den Dateiennamen aus einem beliebigen Verzeichnis, sowie mit den damit
assoziierten Icons und Dateibeschreibungen gefüllt wird.

Sie können auch ein komplettes Beispielprojekt (3 kB) mit dieser Unit vom Server laden.

zurück

Wie kann man Dateien löschen, kopieren oder verschieben?

1.) Dateien löschen
Dazu gibt es mehere Möglichkeiten: 

var Dateiname : string;

{Möglichkeit 1: DeleteFile}
if not DeleteFile(Dateiname) then
ShowMessage('Datei "'+Dateiname+'" konnte nicht gelöscht werden!');

{Möglichkeit 2: Erase}
var F : File;
begin
AssignFile(F,Dateiname);
{$I-}
Erase(F);
{$I+}
if IOResult<>0 then
ShowMessage('Datei "'+Dateiname+'" konnte nicht gelöscht werden!');

Die 3. Möglichkeit ist die API-Funktion SHFileOperation, mit dieser können Dateien auch in den Papierkorb verschoben werden.
Außerdem kann man die Standard-Windows-Fortschrittanzeige anzeigen. Der Gebrauch von SHFileOperation, sowie
SHBrowseForFolder wird in dieser Unit demonstriert. 

Sie können auch ein komplettes Beispielprojekt (5 kB) mit dieser Unit vom Server laden.

2.) Dateien kopieren oder verschieben
Auch dazu gibt es mehere Möglichkeiten: 

{Möglichkeit 1: CopyFile}
var Quelldatei, Zieldatei : string;

if not CopyFile(PChar(Quelldatei), PChar(Zieldatei), true) then
ShowMessage('Datei "'+Quelldatei+'" konnte nicht kopiert werden!');

{Möglichkeit 2: Per TFileStream}
FUNCTION QuickCopy ( Quelle, Ziel : STRING ) : BOOLEAN;
VAR
S, T: TFileStream;
BEGIN
Result := TRUE;
S := TFileStream.Create( Quelle, fmOpenRead );
TRY
TRY
T := TFileStream.Create( Ziel, fmOpenWrite OR fmCreate );
EXCEPT
Screen.Cursor := crDefault;
MessageDlg('Fehler beim Erzeugen der Zieldatei'+#13+Ziel, mtError, [mbOK], 0);
Result := FALSE;
END;
TRY
TRY
T.CopyFrom( S, S.Size ) ;
if Config.CopyDat then
FileSetDate( T.Handle, FileGetDate( S.Handle ) )
else
FileSetDate( T.Handle, DateTimeToFileDate(Now) );
{ Dateizeit setzen }
EXCEPT
Screen.Cursor := crDefault;
MessageDlg('Fehler beim Kopieren der Zieldatei'+#13+Ziel, mtError, [mbOK], 0);
Result := FALSE
END;
FINALLY
T.Free
END;
FINALLY
S.Free
END
END; {QuickCopy}

Möchte man eine Datei verschieben, muß man die Quelldatei(en) anschließend noch löschen.

Die 3. Möglichkeit ist die API-Funktion SHFileOperation, mit dieser kann man auch die Standard-Windows-Fortschrittanzeige
anzeigen. Der Gebrauch von SHFileOperation, sowie SHBrowseForFolder wird in dieser Unit demonstriert.

Sie können auch ein komplettes Beispielprojekt (5 kB) mit dieser Unit vom Server laden.

zurück

Wie kann man das Änderungsdatum von Dateien ermitteln?

Die einfachste Variante heißt FileAge: 

var DOSDatum : integer;
WinDatum : TDateTime; 
Dateiname : string;

DOSDatum:=FileAge(Dateiname);
WinDatum:=FileDateToDateTime(DOSDatum);

Eine andere Möglichkeit ist FindFirst: 

function Dateidatum(Dateiname:string):TDateTime;
var SR : TSearchRec;
begin
if FindFirst(Dateiname,faAnyFile,SR)=0 then begin
Result:=FileDateToDateTime(SR.Time);
FindClose(SR);
end;
end;

Verschiedene Funktionen, um nicht nur das Datum der letzten Änderung zu ermitteln oder zu ändern, sondern auch das
Erstellungsdatum einer Datei findet man in dieser Datei von Peter Haas. 

zurück

Wie kann man die Größe von Dateien ermitteln?

Man kann die Datei als File of Byte öffnen und dann die Dateigröße mit der FileSize-Funktion ermitteln, oder man benutzt die
FindFirst-Funktion: 

Function MyFileSize(Filename:string):integer;
var SR : TSearchRec;
begin
if FindFirst(Filename,faAnyFile,SR)=0 then
Result:=SR.Size
else
Result:=-1;
FindClose(SR);
end; {MyFileSize}

zurück

Wie kann man alle Dateien eines Ordners mitsamt der Unterverzeichnisse ermitteln?

Diese Funktion liest rekursiv alle Dateinamen eines Ordners und dessen Unterverzeichnisse in eine Stringliste ein und gibt
außerdem als Result die Gesamtgröße des Verzeichnisbaumes zurück: 

var VerzListe : TStringList;

function VerzGroesse(Verzeichnis:string):longint;
var SR : TSearchRec;
Groesse : longint;
begin
Groesse:=0;
if Verzeichnis[length(Verzeichnis)]<>'\' then
Verzeichnis:=Verzeichnis+'\';
if FindFirst(Verzeichnis+'*.*',$3F,SR)=0 then begin
if ((SR.Attr and faDirectory)>0) and (SR.Name<>'.') and (SR.Name<>'..') then
Groesse:=Groesse+VerzGroesse(Verzeichnis+SR.Name)
else
Groesse:=Groesse+SR.Size;
if (SR.Name<>'.') and (SR.Name<>'..') then
VerzListe.Add(Verzeichnis+SR.Name);
while FindNext(SR)=0 do begin
if ((SR.Attr and faDirectory)>0) and (SR.Name<>'.') and (SR.Name<>'..') then
Groesse:=Groesse+VerzGroesse(Verzeichnis+SR.Name)
else
Groesse:=Groesse+SR.Size;
if (SR.Name<>'.') and (SR.Name<>'..') then
VerzListe.Add(Verzeichnis+SR.Name);
end;
end;
FindClose(SR);
Result:=Groesse;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
VerzListe:=TStringList.Create;
Label1.Caption:=IntToStr(VerzGroesse('C:\Programme'))+' Byte';
ListBox1.Items.Assign(VerzListe);
VerzListe.Free;
end;

zurück

Wie man einen Verzeichnisbaum in ein TTreeView einliest 

Die Funktion "Verzeichnisse_Einlesen" liest rekursiv alle Ordner eines Verzeichnisbaumes und optional auch alle Dateien als
Baumstruktur in ein TTreeView ein: 

{Aufrufbeispiel:}
TreeView1.Items.Clear;
Verzeichnisse_Einlesen(TreeView1,'C:\',nil,false);

procedure Verzeichnisse_Einlesen(Tree : TTreeView; 
Verzeichnis : String;
Eintrag : TTreeNode; 
Mit_Dateien : Boolean);

Var SearchRec : TSearchRec;
EintragTemp : TTreeNode;

begin
Tree.Items.BeginUpdate;
if Verzeichnis[length(Verzeichnis)]<>'\' then 
Verzeichnis:=Verzeichnis+'\';
if FindFirst(Verzeichnis+ '*.*', faDirectory, SearchRec)=0 then begin
repeat
if (SearchRec.Attr and faDirectory = faDirectory) 
and (SearchRec.Name[1] <> '.') then begin

//Eintrag ist ein Verzeichnis
if (SearchRec.Attr and faDirectory > 0) then
//zum aktuellen Eintrag hinzufügen
Eintrag := Tree.Items.AddChild(Eintrag, SearchRec.Name);

//Eintrag merken
EintragTemp := Eintrag.Parent;

//auf Untereinträge prüfen
Verzeichnisse_Einlesen(Tree, 
Verzeichnis + SearchRec.Name, 
Eintrag,
Mit_Dateien);

//Eintrag wiederholen
Eintrag := EintragTemp;
end
else
//Eintrag ist eine Datei
if Mit_Dateien then
if SearchRec.Name[1] <> '.' then
Tree.Items.AddChild(Eintrag, SearchRec.Name);
until FindNext(SearchRec)<>0;
FindClose(SearchRec);
end;
Tree.Items.EndUpdate;
end; {Michael Geisler}

zurück

Wie kann man Dateien in einem Verzeichnisbaum suchen? 

Diese Unit zeigt, wie man rekursiv eine bestimmte Datei in einem Verzeichnisbaum sucht. Die Funktion der rekursiven Suche
in der Unit demonstriert dieses Beispielprojekt.

zurück

Wie löscht man nur bestimmte Dateien in allen Unterverzeichnissen? 

Die Prozedur "DeleteFiles" löscht alle Dateien, deren Name einer vorgegebenen Maske entspricht, in einem bestimmten
Verzeichnis und optional in allen daran anhängenden Unterverzeichnissen: 

procedure DeleteFiles(const Path, Mask: string; SubDirectories: Boolean);
var
Result: integer;
SR: TSearchRec;
begin
if FindFirst(Path + Mask, faAnyFile - faDirectory, SR) = 0 then begin
repeat
if not SysUtils.DeleteFile (Path + SR.Name) then begin
FileSetAttr(Path + SR.Name, 0); {Alle Dateiattribute löschen}
SysUtils.DeleteFile(Path + SR.Name);
end;
until FindNext(SR) <> 0;
SysUtils.FindClose(SR);
end;
{ Rekursiv durch alle Unterverzeichnisse }
if SubDirectories then begin
if SysUtils.FindFirst(Path + '*.*', faDirectory, SR) then begin
repeat
if (SR.Name <> '.') and (SR.Name <> '..') then begin
FileSetAttr(Path + SR.Name, faDirectory);
DeleteFiles(Path + SR.Name + '\', Mask, true);
RmDir(Path + SR.Name); {Leeres Verzsichnis löschen}
end;
until FindNext(SR) <> 0;
SysUtils.FindClose(SR);
end;
end;
end; {Angepasst für Win NT von Marco Klemm}

Und so löscht man z.B. alle Dateien mit der Endung ".txt" im Verzeichnis "C:\Temp" und allen Unterverzeichnissen von "C:\Temp":

DeleteFiles ('C:\Temp\', '*.txt', true);

zurück

Wie stelle ich fest, ob ein bestimmter Laufwerkstyp (z.B. CD-ROM) vorhanden ist?

Diese Funktion erstellt eine Stringliste mit allen Laufwerksbuchstaben eines bestimmten Typs und gibt als Result die Anzahl der
vorhandenen Laufwerke zurück: 

var DriveList : TStringList;
LWCount : byte;

function GetDrives(DriveType:integer):byte;
var Drives : array [1..255] of char;
LWListe : TStringList;
i : byte;
Len : DWord;
begin
LWListe:=TStringList.Create;
{Alle Laufwerke ermitteln}
Len:=GetLogicalDriveStrings(255,@Drives);
for i:=1 to Len-2 do
if (i mod 4)=1 then
LWListe.Add(copy(Drives,i,3));
{Laufwerke des angegebenen Typs zählen}
Result:=0;
DriveList.Clear;
for i:=0 to LWListe.Count-1 do begin
if GetDriveType(PChar(LWListe[i]))=DriveType then begin
Result:=Result+1;
DriveList.Add(copy(LWListe[i],1,2))
end;
end;
LWListe.Destroy;
end;

DriveList:=TStringLIst.Create;
{Wechselplatten:}
LWCount:=GetDrives(DRIVE_REMOVABLE);
{Festplatten:}
LWCount:=GetDrives(DRIVE_FIXED);
{Netzlaufwerke:}
LWCount:=GetDrives(DRIVE_REMOTE);
{CD-ROM:}
LWCount:=GetDrives(DRIVE_CDROM);
{RAM-Disks:}
LWCount:=GetDrives(DRIVE_RAMDISK);

{..Mach' was mit der DriveList..}
DriveList.Free;

zurück

Wie stelle ich fest, ob eine Diskette im Laufwerk steckt?

Die Funktion "DiskSize" gibt als Größe -1 zurück, wenn kein Datenträger vorhanden ist. Um keine System-Fehlermeldung zu
erhalten, benutzt man die API-Funktion "SetErrorMode": 

procedure TForm1.Button1Click(Sender: TObject);
var
ErrorMode: word;
begin
{Meldung eines kritischen Systemfehlers vehindern}
ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
try
if DiskSize(1) = -1 then
ShowMessage('Drive not ready');
finally
{ErrorMode auf den alten Wert setzen}
SetErrorMode(ErrorMode);
end;
end;

zurück

Wie ermittelt man das mit einem Dateitypen verknüpfte Programm?

Die Funktion GetExeForExtension funktioniert sowohl unter Win3.x, als auch unter Win9x. Sie findet das mit einem Dateitypen
verknüpfte Programm, indem man ihr die Dateiendung übergibt. Unter Win9x wird das Programm aus der Registry ausgelesen,
unter Win3.x aus der Systemdatei Win.ini. 

uses
{$IFDEF WIN32}
Registry; {Unter Win9x benutzen wir die Registry}
{$ELSE}
IniFiles; {Unter Win3.x benutzen wir die Datei win.ini}
const MAX_PATH = 144;
{$ENDIF}

function GetExeForExtension(Ext:string):string;
var
{$IFDEF WIN32}
reg : TRegistry;
s : string;
{$ELSE}
WinIni : TIniFile;
WinIniFileName : array[0..MAX_PATH] of char;
s : string;
{$ENDIF}
begin
{$IFDEF WIN32}
s:='';
reg:=TRegistry.Create;
reg.RootKey:=HKEY_CLASSES_ROOT;
if reg.OpenKey('.'+ext+'\shell\open\command', false) then
begin
{The open command has been found}
s:=reg.ReadString('');
reg.CloseKey;
end
else begin
{perhaps there is a system file pointer}
if reg.OpenKey('.'+ext, false) then begin
s:=reg.ReadString('');
reg.CloseKey;
if s<>'' then begin
{A system file pointer was found}
if reg.OpenKey(s+'\shell\open\command', false) then
{The open command has been found}
s:=reg.ReadString('');
reg.CloseKey;
end;
end;
end;
{Delete any command line, quotes and spaces}
if Pos('%', s)>0 then
Delete(s, Pos('%', s), length(s));
if ((length(s)>0) and (s[1]='"')) then
Delete(s, 1, 1);
if ((length(s)>0) and (s[length(s)]='"')) then
Delete(s, Length(s), 1);
while ((length(s)>0) and
((s[length(s)]=#32) or (s[length(s)] = '"'))) do
Delete(s, Length(s), 1);
{$ELSE}
GetWindowsDirectory(WinIniFileName, sizeof(WinIniFileName));
StrCat(WinIniFileName, '\win.ini');
WinIni:=TIniFile.Create(WinIniFileName);
s:=WinIni.ReadString('Extensions', ext, '');
WinIni.Free;
{Delete any command line}
if Pos(' ^', s)>0 then
Delete(s, Pos(' ^', s), length(s));
{$ENDIF}
Result:=s;
end; {Johannes..}

Um z.B. das mit GIF-Dateien verknüpfte Programm zu ermitteln, übergibt man der Routine die Dateiendung "gif": 

ShowMessage(GetAssociatedProgram('gif'));

Um das mit einer existierenden Datei verknüpfte Programm zu ermitteln, kann man sich der API-Funkiton FindExecutable
bedienen: 

function GetExeForFile(const FileName: String): String;
var x: Integer;
begin
SetLength(Result, MAX_PATH);
if FindExecutable(PChar(FileName), nil, PChar(Result))>=32
then SetLength(Result, StrLen(PChar(Result)))
else Result:=inttostr(x);
end; {Michael Winter}

zurück

Wie verknüpft man ein eigenes Programm mit einem bestimmten Dateitypen?

Ich habe ein Delphi-Programm, daß für bestimmte Dateien zuständig sein soll (*.xyz). Wie bringe ich jetzt Windows am
einfachsten bei, daß bei einem Doppelklick automatisch mein Programm aufgerufen werden soll ?

Diese Funktion RegistriereAnwendung für 32Bit-Windows von Edmund Matzke nimmt alle erforderlichen Einträge in der
Windows-Registrierdatenbank vor. 

uses Registry;

function RegistriereAnwendung(extension, 
typename, 
commandKey, 
command: PChar): boolean;
var key: HKey;
begin
Result := false;
if RegCreateKey(HKEY_CLASSES_ROOT, extension, key) = ERROR_SUCCESS then begin
if RegSetValue(key, nil, REG_SZ, typename, 0) = ERROR_SUCCESS then begin
RegCloseKey(key);
if RegCreateKey(HKEY_CLASSES_ROOT, commandKey, key) = ERROR_SUCCESS then begin
if RegSetValue(key, nil, REG_SZ, command, 0) = ERROR_SUCCESS then begin
RegCloseKey(key);
Result := true; // hat geklappt
end 
else begin
RegCloseKey(key);
RegDeleteKey(HKEY_CLASSES_ROOT, extension);
end;
end 
else
RegDeleteKey(HKEY_CLASSES_ROOT, extension);
end 
else begin
RegCloseKey(key);
RegDeleteKey(HKEY_CLASSES_ROOT, extension);
end;
end;
end; {Edmund Matzke}

Und hier das ganze noch für 16Bit-Windows, da gehören die Einträge in die Datei "Win.ini": 

uses IniFiles;

function RegistriereAnwendung(extension,
command: string): boolean;
var
WinIni : TIniFile;
WinIniFileName : array[0..MAX_PATH] of char;
s : array[0..64] of char;
begin
GetWindowsDirectory(WinIniFileName, sizeof(WinIniFileName));
StrCat(WinIniFileName, '\win.ini');
try
WinIni := TIniFile.Create(WinIniFileName);
WinIni.WriteString('Extensions',
extension,
command+' ^.'+extension);
WinIni.Free;
Result:=true;
StrCopy(S, 'Extensions');
SendMessage(HWND_BROADCAST, WM_WININICHANGE,
0, LongInt(@S));
except
Result:=false;
end;
end;

Und so ruft man die Funktionen auf: 

{Win32:}
RegistriereAnwendung('.xyz', 'MeinProggy', 
'MeinProggy\DefaultIcon', PChar(Application.ExeName + ',0'));

{Win16:}
RegistriereAnwendung('.xyz', Application.ExeName);

zurück

Wie kann ich die Versionsnummer einer Datei (z.B. einer DLL) auslesen?

Benutze die API-Funktion "GetFileVersionInfo": 

function GetBuildInfo(const AFilename:String; var V1,V2,V3,V4:Word):Boolean;
var
VerInfoSize : Integer;
VerValueSize : Integer;
Dummy : Integer;
VerInfo : Pointer;
VerValue : PVSFixedFileInfo;
begin
VerInfoSize:=GetFileVersionInfoSize(PChar(AFilename),Dummy);
Result:=False;
if VerInfoSize<>0 then begin
GetMem(VerInfo,VerInfoSize);
try
if GetFileVersionInfo(PChar(AFilename),0,VerInfoSize,VerInfo) then begin
if VerQueryValue(VerInfo,'\',Pointer(VerValue),VerValueSize) then
with VerValue^ do begin
V1:=dwFileVersionMS shr 16;
V2:=dwFileVersionMS and $FFFF;
V3:=dwFileVersionLS shr 16;
V4:=dwFileVersionLS and $FFFF;
end;
Result:=True;
end;
finally
FreeMem(VerInfo,VerInfoSize);
end;
end;
end; {Peter Haas}

zurück

Fortgeschrittene Anwendung der SHBrowseForFolder-API-Funktion

Mit der API-Funktion "SHBrowseForFolder" kann man sich einen Dialog zur Verzeichnisauswahl anzeigen lassen. Ein
Anwendungsbeispiel findet man in der Demo-Unit zur SHFileOperation-Funktion. Thorsten Vitt erklärt auf seiner
Delphi-Tips-Seite, wie man ein Root-Verzeichnis bestimmen und bei der Anzeige des Dialogs einen Ordner vorwählen kann.

Auf der Grundlage seines Artikels habe ich ein Beispiel-Projekt erstellt, welches die in Thorstens Artikel beschriebenen
Funktionen demonstriert. Das Projekt benötigt eine installierte RxLibrary, weil ich ausnahmsweise mal andere, als die
Delphi-Standard-Komponenten verwendet habe. Man kann aber auch einfach diese Unit des Beispiel-Projekts in ein eigenes
Projekt einbinden.

zurück

Erzeugen von Programmgruppen und Verknüpfungen

- DDE mit dem Programm-Manager in Win 3.x

In Windows 3.x erzsugt man Programmgruppen und Verknüpfunden per DDE-Konversation mit dem Progrmm-Manager. Dazu
kann man einfach eine DDEClient-Komponente (System, DdeClientItem) auf das Formular setzen. Mit dieser baut man dann die
DDE-Verbindung zum Progrmm-Manager auf, um eine Programmgruppe und eine Verlknüpfung zu erstellen: 

Var Macro : String;
Cmd: array[0..255] of Char;
NewPrg,Desc : String;
Begin { Create the group, does nothing if it existst }
Name := 'StartUp';
Macro := Format('[CreateGroup(%s)]', [Name]) + #13#10;
StrPCopy (Cmd, Macro);
DDEClient.OpenLink;
if not DDEClient.ExecuteMacro(Cmd, False) then
MessageDlg(<ErrorMsg>, mtInformation, [mbOK], 0);
{ Then you add you program }
NewPrg := 'C:\HELLO.EXE'; {Full path of the program you}
Desc := 'Say Hello'; {Description that appears under the icon}
Macro := '[AddItem('+NewPrg+','+Desc+')]'+ #13#10;
StrPCopy (Cmd, Macro);
if not f1_.DDEClient.ExecuteMacro(Cmd, False) then
MessageDlg(<errorMsg>,mtInformation, [mbOK], 0); 
{ To make sure the group is saved }
StrPCopy (Cmd,'[ShowGroup(nonexist,1)]');
DDEClient.ExecuteMacro(Cmd, False);
{ Now... this part doesn't work and I don't know why } 
{ Anybody who knows why is welcome }
StrPCopy (Cmd,'[reload()]');
DDEClient.ExecuteMacro(Cmd, False);
{ and close the link }
DDEClient.CloseLink;
End;

Das "DeleteGroup"-Kommando weist den Program Manager an, eine existierende Gruppe zu löschen. Die Syntax für das
"DeleteGroup"-Kommando sieht so aus: 

DeleteGroup(GroupName)

Das "DeleteItem"-Kommando weist den Program Manager an, eine existierende Verknüpfung aus der aktuellen Gruppe zu
löschen. Die Syntax für das "DeleteItem"-Kommando sieht so aus: 

DeleteItem(ItemName)

Hier ist noch eine Prozedur, die eine Liste aller existiernden Gruppen vom Programm Manager abfragt. Diese Prozedur benutzt
dazu die DDEClientConv-Komponente: 

{This example needs a listbox called AllGroups}

procedure GetGroups(Sender: TObject);
var Thedata: pchar; {pchar that holds the groups}
dat: char; {used to process each group}
charcount: word;
Theitem,theline: string;
begin {get allgroups items}
charcount:=0;
TheData:= DDEClientConv2.RequestData('Groups');
theline:='';
repeat
application.processmessages;
dat:=Thedata[charcount]; {get character from the Thedata}
if (dat=chr(10)) {or (dat=chr(13))} then begin
while Pos(char(10), Theline) > 0 do
delete(Theline,pos(char(10),Theline),1);
while Pos(char(13), Theline) > 0 do
delete(Theline,pos(char(13),Theline),1);
If theline='' then 
continue;
allgroups.items.add(theline); {Allgroups is a LISTBOX}
theline:='';
end;
Theline:=theline+dat;
inc(charcount);
until charcount >= strlen(Thedata);
strdispose(Thedata);
end;

Win32-API-Funktionen

Eine Textdatei mit den Win32-API-Funktionen zur Erstellung von Verknüpfungen (Shortcuts) und Programmgruppen kann hier
geladen werden. Eine Delphi-Klasse zum Herumspielen mit Shell-Links findet man auf der Homepage von Thorsten Vitt.

zurück

Wie kann man aus einer *.lnk die Informationen zur eigentlichen Datei entnehmen?

Du mußt die Units ComObj, ActiveX und ShlObj einbinden. Dann kann man über die IShellLink-Schnittstelle die Informationen
zum Linkfile abfragen. Diese Funktion liefert z.B. den Namen der EXE-Datei, auf die die Verknüpfung verweist:

function GetExeFromLink(LinkFile:string):string;
var
IU : IUnknown;
SL : IShellLink;
PF : IPersistFile;
FindDate : TWin32FindData;
TargetFile : array[0..MAX_PATH] of char;
begin
{ Herstellen des IShellLink und IPersistFile zum Zugriff auf
die .LNK Datei. }
IU := CreateComObject(CLSID_ShellLink);
SL := IU as IShellLink;
PF := SL as IPersistFile;
{ .LNK Datei in IPersistFile Objekt laden. }
PF.Load(PWideChar(LinkFile), STGM_READ);
{ Den Link durch Aufruf der Resolve-Methode auflösen }
SL.Resolve(0, SLR_ANY_MATCH or SLR_NO_UI);
{ Jetzt kommt man an die Infos }
SL.GetPath(TargetFile, MAX_PATH, FindDate, SLGP_UNCPRIORITY);
{ Zieldatei ausgeben }
Result:=string(TargetFile);
end; {Oliver Stoer}

Wenn es nur um den Namen der verknüpften EXE-Datei geht, kann man diesen auch einfacher mit FindExecutable ermitteln: 

function GetExeFromLink(LinkFile:string):string;
var
FDir,
FName,
ExeName : PChar;
z : integer;
begin
{Speicher für die PChar-Variablen allozieren}
ExeName:=StrAlloc(255);
FName:=StrAlloc(255);
FDir:=StrAlloc(255);

StrPCopy(FName, ExtractFileName(FileName));
StrPCopy(FDir, ExtractFilePath(FileName));
z:=FindExecutable(FName, FDir, ExeName);
if z>32 then
Result:=StrPas(ExeName)
else
Result:='';

{Speicher der PChar-Variablen freigeben}
StrDispose(FDir);
StrDispose(FName);
StrDispose(ExeName);
end;

zurück