Die Volume-ID eines Laufwerks ermittelnDateien, Ordner und 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;
|
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; {Gerd Kayser}
|
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}
|
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;
|
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 "FileCtrl":
PathName:=Appication.Exename;
Label1.Caption:=MinimizeName(PathName, {Der abzukürzende Pfadname}
Label1.Canvas, {Die Referenz-Zeichenfläche}
Label1.Width); {Die maximale Ausgabe-Breite}
|
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 meine Komponente TSRLabel von meiner Komponentenseite benutzen.
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.
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!');
|
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}
|
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.
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);
|
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;
|
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 begin
Result:=SR.Size;
FindClose(SR);
end
else
Result:=-1;
end; {MyFileSize}
|
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
repeat
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);
until FindNext(SR)<>0;
FindClose(SR);
end;
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;
|
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}
|
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.
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}
|
DeleteFiles ('C:\Temp\', '*.txt', true);
|
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;
|
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;
|
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..}
|
ShowMessage(GetAssociatedProgram('gif'));
|
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}
|
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}
|
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;
|
{Win32:}
RegistriereAnwendung('.xyz', 'MeinProggy',
'MeinProggy\DefaultIcon', PChar(Application.ExeName + ',0'));
{Win16:}
RegistriereAnwendung('.xyz', Application.ExeName);
|
procedure TMainForm.FormCreate(Sender: TObject);
begin
if ParamCount>0 then
Datei_laden(ParamStr(1)); // Den Code zum Laden der Daten ausführen
end;
|
type
TMainForm = class(TForm)
Private
procedure NeedFileOpen(var Msg: tMessage); Message wmMainInstanceOpenFile;
[..]
procedure TMainForm.NeedFileOpen(var Msg: tMessage);
var Path : string;
PC : array[0..MAX_PATH] of Char;
begin
GlobalGetAtomName(Msg.wParam, PC, MAX_PATH);
Path := Trim(StrPas(PC));
Datei_laden(Path); // Den Code zum Laden der Daten ausführen
end;
|
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 : DWord;
Dummy : DWord;
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}
|
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.
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 Programm-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;
|
DeleteGroup(GroupName) |
DeleteItem(ItemName) |
{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.
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}
|
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; {Michael Hanel}
|
Wie kann man den Eigenschaften-Dialog des Windows-Explorers für Dateien anzeigen?
Dazu benutzt man die "TShellExecuteInfo"-Datenstruktur der API-Funktion "ShellExecuteEx":
function ShowProperties(hWndOwner: HWND; const FileName: string;
Registerkarte: PChar): Boolean;
var Info: TShellExecuteInfo;
begin
{ Fill in the SHELLEXECUTEINFO structure }
with Info do begin
cbSize := SizeOf(Info);
fMask := SEE_MASK_NOCLOSEPROCESS or
SEE_MASK_INVOKEIDLIST or
SEE_MASK_FLAG_NO_UI;
wnd := hWndOwner;
lpVerb := 'properties';
lpFile := pChar(FileName);
lpParameters := registerkarte;
lpDirectory := nil;
nShow := 0;
hInstApp := 0;
lpIDList := nil;
end;
{ Call Windows to display the properties dialog. }
Result := ShellExecuteEx(@Info);
end; {Frank Wunderlich}
|
Der Aufruf der Funktion sieht dann so aus:
ShowProperties(HInstance, PCHAR(Dateiname), 'Freigabe'); 'Freigabe' steht für die Caption der Registerseite, Dateiname ist der Name der Datei mit komplettem Pfad.
Wie kann man die Schublade eines Ein CD-Laufwerks öffnen und schließen?
Dazu benutzt man die "MCISendString"-Funktion aus der Unit "MMSystem":
uses MMSystem;
// Schublade öffnen:
procedure TMainForm.MItemCDEjectClick(Sender: TObject);
var Befehl : string;
ErrCode : integer;
ErrStr : array [0..255] of char;
begin
Befehl := 'open '+Config.Laufwerk+' type cdaudio alias geraet';
MCISendString(PChar(Befehl), nil, 0, 0);
ErrCode:=MCISendString('set geraet door open wait', nil, 0, 0);
MCISendString('close geraet', nil, 0, 0);
if ErrCode <> 0 then begin
MCIGetErrorString(ErrCode, ErrStr, 255);
StatusBar.Panels[1].Text:=ErrStr;
end;
end;
// Schublade schließen:
procedure TMainForm.MItemCDCloseClick(Sender: TObject);
var Befehl : string;
ErrCode : integer;
ErrStr : array [0..255] of char;
begin
Befehl := 'open '+Config.Laufwerk+' type cdaudio alias geraet';
MCISendString(PChar(Befehl), nil, 0, 0);
ErrCode:=MCISendString('set geraet door closed wait',nil, 0, 0);
MCISendString('close geraet', nil, 0, 0);
if ErrCode <> 0 then begin
MCIGetErrorString(ErrCode, ErrStr, 255);
StatusBar.Panels[1].Text:=ErrStr;
end;
end;
|