neoturk: ...Get the path to program files ?...
uses
Registry;
function GetProgramFilesDir: string;
var
reg: TRegistry;
begin
reg := TRegistry.Create;
try
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey('SOFTWAREMicrosoftWindowsCurrentVersion', False);
Result := reg.ReadString('ProgramFilesDir');
finally
reg.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// Shows something like c:Program files
// zeigt "c:Programme" (oder ähnlich)
ShowMessage(GetProgramFilesDir);
end;
Delphi - .....................................
neoturk: ...Retrieve unc paths ?...
ExpandUNCFileName returns the full path of the FileName
with the network drive portion in UNC format.
The pathname in the UNC-Format has the format:
Servernamesharename
ExpandUNCFileName gibt einen String mit dem vollständigen
Pfadnamen der in FileName übergebenen Datei zurück.
Ein vollständig qualifizierter Pfadname besteht aus der
Laufwerkskomponente des Dateinamens im UNC-Format:
Servernamesharename
// Example, Beispiel:
Label1.Caption := ExpandUNCFileName('K:sharename.tmp'));
{where "K" is a Network Drive.}
{*****************************************************}
{2. Way }
function GetUNCName(const LocalPath: string): string;
var
BufferSize: DWord;
DummyBuffer: Byte;
Buffer: Pointer;
Error: DWord;
begin
BufferSize := 1;
WNetGetUniversalName(PChar(LocalPath), UNIVERSAL_NAME_INFO_LEVEL, @DummyBuffer, BufferSize);
Buffer := AllocMem(BufferSize);
try
Error := WNetGetUniversalName(PChar(LocalPath), UNIVERSAL_NAME_INFO_LEVEL, Buffer, BufferSize);
if Error <> NO_ERROR then
begin
SetLastError(Error);
RaiseLastWin32Error;
end;
Result := PUniversalNameInfo(Buffer)^.lpUniversalName
finally
FreeMem(Buffer);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := GetUNCName('y:xyz')
end;
Delphi - .....................................
neoturk: ...Retrieve unc paths ?...
ExpandUNCFileName returns the full path of the FileName
with the network drive portion in UNC format.
The pathname in the UNC-Format has the format:
Servernamesharename
ExpandUNCFileName gibt einen String mit dem vollständigen
Pfadnamen der in FileName übergebenen Datei zurück.
Ein vollständig qualifizierter Pfadname besteht aus der
Laufwerkskomponente des Dateinamens im UNC-Format:
Servernamesharename
// Example, Beispiel:
Label1.Caption := ExpandUNCFileName('K:sharename.tmp'));
{where "K" is a Network Drive.}
{*****************************************************}
{2. Way }
function GetUNCName(const LocalPath: string): string;
var
BufferSize: DWord;
DummyBuffer: Byte;
Buffer: Pointer;
Error: DWord;
begin
BufferSize := 1;
WNetGetUniversalName(PChar(LocalPath), UNIVERSAL_NAME_INFO_LEVEL, @DummyBuffer, BufferSize);
Buffer := AllocMem(BufferSize);
try
Error := WNetGetUniversalName(PChar(LocalPath), UNIVERSAL_NAME_INFO_LEVEL, Buffer, BufferSize);
if Error <> NO_ERROR then
begin
SetLastError(Error);
RaiseLastWin32Error;
end;
Result := PUniversalNameInfo(Buffer)^.lpUniversalName
finally
FreeMem(Buffer);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := GetUNCName('y:xyz')
end;
Delphi - .....................................
neoturk: ...Replace a running dll ?...
function SystemErrorMessage: string;
var
P: PChar;
begin
if FormatMessage(Format_Message_Allocate_Buffer + Format_Message_From_System,
nil,
GetLastError,
0,
@P,
0,
nil) <> 0 then
begin
Result := P;
LocalFree(Integer(P))
end
else
Result := '';
end;
// Path to Original File
procedure TForm1.Button2Click(Sender: TObject);
begin
if Opendialog1.Execute then
edit1.Text := OpenDialog1.FileName;
end;
// Path to New File
procedure TForm1.Button3Click(Sender: TObject);
begin
if Opendialog2.Execute then
edit2.Text := OpenDialog2.FileName;
end;
// Replace the File.
procedure TForm1.Button1Click(Sender: TObject);
begin
if (Movefileex(PChar(Edit1.Text), PChar(Edit2.Text), MOVEFILE_DELAY_UNTIL_REBOOT) = False) then
ShowMessage(SystemErrorMessage)
else
begin
ShowMessage('Please Restart Windows to have these changes take effect');
halt;
end;
end;
Delphi - .....................................
neoturk: ...Replace a running dll ?...
function SystemErrorMessage: string;
var
P: PChar;
begin
if FormatMessage(Format_Message_Allocate_Buffer + Format_Message_From_System,
nil,
GetLastError,
0,
@P,
0,
nil) <> 0 then
begin
Result := P;
LocalFree(Integer(P))
end
else
Result := '';
end;
// Path to Original File
procedure TForm1.Button2Click(Sender: TObject);
begin
if Opendialog1.Execute then
edit1.Text := OpenDialog1.FileName;
end;
// Path to New File
procedure TForm1.Button3Click(Sender: TObject);
begin
if Opendialog2.Execute then
edit2.Text := OpenDialog2.FileName;
end;
// Replace the File.
procedure TForm1.Button1Click(Sender: TObject);
begin
if (Movefileex(PChar(Edit1.Text), PChar(Edit2.Text), MOVEFILE_DELAY_UNTIL_REBOOT) = False) then
ShowMessage(SystemErrorMessage)
else
begin
ShowMessage('Please Restart Windows to have these changes take effect');
halt;
end;
end;
Delphi - .....................................
neoturk: ...Rename, remove, delete, move a file-directory ?...
Directories
Create a Directory :
* CreateDir('c:path');
* Tip 102 (MkDir Example)
Remove a Directory : RemoveDir('c:path') or RmDir('c:path')
Change a Directory : ChDir('c:path')
Current Directory : GetCurrentDir
Check if a Directory exists : if DirectoryExists('c:path') then ...
Rename a Directory: Tip 1024 (SHFileOperation)
Copy/Move/Delete whole directories: Tip 152 (ShFileOperation)
Files
Rename a File : RenameFile('file1.txt', 'file2.xyz')
Delete a File : DeleteFile('c:text.txt')
Move a File : MoveFile('C:file1.txt','D:file1.txt');
Copy a File :
* CopyFile(Pchar(File1),PChar(File2),bFailIfExists)
* Tip 101 (Example)
* Tip 28 (SHFileOperation)
Change a File's Extension : ChangeFileExt('test.txt', 'xls')
Check if a File exists : if FileExists('c:filename.tst') then ...
Delphi - .....................................
neoturk: ...Rename, remove, delete, move a file-directory ?...
Directories
Create a Directory :
* CreateDir('c:path');
* Tip 102 (MkDir Example)
Remove a Directory : RemoveDir('c:path') or RmDir('c:path')
Change a Directory : ChDir('c:path')
Current Directory : GetCurrentDir
Check if a Directory exists : if DirectoryExists('c:path') then ...
Rename a Directory: Tip 1024 (SHFileOperation)
Copy/Move/Delete whole directories: Tip 152 (ShFileOperation)
Files
Rename a File : RenameFile('file1.txt', 'file2.xyz')
Delete a File : DeleteFile('c:text.txt')
Move a File : MoveFile('C:file1.txt','D:file1.txt');
Copy a File :
* CopyFile(Pchar(File1),PChar(File2),bFailIfExists)
* Tip 101 (Example)
* Tip 28 (SHFileOperation)
Change a File's Extension : ChangeFileExt('test.txt', 'xls')
Check if a File exists : if FileExists('c:filename.tst') then ...
Delphi - .....................................
neoturk: ...Get the owner of a file ?...
// When you create a file or directory, you become the owner of it.
// With GetFileOwner you get the owner of a file.
function GetFileOwner(FileName: string;
var Domain, Username: string): Boolean;
var
SecDescr: PSecurityDescriptor;
SizeNeeded, SizeNeeded2: DWORD;
OwnerSID: PSID;
OwnerDefault: BOOL;
OwnerName, DomainName: PChar;
OwnerType: SID_NAME_USE;
begin
GetFileOwner := False;
GetMem(SecDescr, 1024);
GetMem(OwnerSID, SizeOf(PSID));
GetMem(OwnerName, 1024);
GetMem(DomainName, 1024);
try
if not GetFileSecurity(PChar(FileName),
OWNER_SECURITY_INFORMATION,
SecDescr, 1024, SizeNeeded) then
Exit;
if not GetSecurityDescriptorOwner(SecDescr,
OwnerSID, OwnerDefault) then
Exit;
SizeNeeded := 1024;
SizeNeeded2 := 1024;
if not LookupAccountSID(nil, OwnerSID, OwnerName,
SizeNeeded, DomainName, SizeNeeded2, OwnerType) then
Exit;
Domain := DomainName;
Username := OwnerName;
finally
FreeMem(SecDescr);
FreeMem(OwnerName);
FreeMem(DomainName);
end;
GetFileOwner := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Domain, Username: string;
begin
GetFileOwner('YourFile.xyz', domain, username);
ShowMessage(username + '@' + domain);
end;
// Note: Only works unter NT.
Delphi - .....................................
neoturk: ...Get the owner of a file ?...
// When you create a file or directory, you become the owner of it.
// With GetFileOwner you get the owner of a file.
function GetFileOwner(FileName: string;
var Domain, Username: string): Boolean;
var
SecDescr: PSecurityDescriptor;
SizeNeeded, SizeNeeded2: DWORD;
OwnerSID: PSID;
OwnerDefault: BOOL;
OwnerName, DomainName: PChar;
OwnerType: SID_NAME_USE;
begin
GetFileOwner := False;
GetMem(SecDescr, 1024);
GetMem(OwnerSID, SizeOf(PSID));
GetMem(OwnerName, 1024);
GetMem(DomainName, 1024);
try
if not GetFileSecurity(PChar(FileName),
OWNER_SECURITY_INFORMATION,
SecDescr, 1024, SizeNeeded) then
Exit;
if not GetSecurityDescriptorOwner(SecDescr,
OwnerSID, OwnerDefault) then
Exit;
SizeNeeded := 1024;
SizeNeeded2 := 1024;
if not LookupAccountSID(nil, OwnerSID, OwnerName,
SizeNeeded, DomainName, SizeNeeded2, OwnerType) then
Exit;
Domain := DomainName;
Username := OwnerName;
finally
FreeMem(SecDescr);
FreeMem(OwnerName);
FreeMem(DomainName);
end;
GetFileOwner := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Domain, Username: string;
begin
GetFileOwner('YourFile.xyz', domain, username);
ShowMessage(username + '@' + domain);
end;
// Note: Only works unter NT.
Delphi - .....................................
neoturk: ...Show directories in a ttreeview ?...
procedure TForm1.GetDirectories(Tree: TTreeView; Directory: string; Item: TTreeNode; IncludeFiles: Boolean);
var
SearchRec: TSearchRec;
ItemTemp: TTreeNode;
begin
Tree.Items.BeginUpdate;
if Directory[Length(Directory)] <> '' then Directory := Directory + '';
if FindFirst(Directory + '*.*', faDirectory, SearchRec) = 0 then
begin
repeat
if (SearchRec.Attr and faDirectory = faDirectory) and (SearchRec.Name[1] <> '.') then
begin
if (SearchRec.Attr and faDirectory > 0) then
Item := Tree.Items.AddChild(Item, SearchRec.Name);
ItemTemp := Item.Parent;
GetDirectories(Tree, Directory + SearchRec.Name, Item, IncludeFiles);
Item := ItemTemp;
end
else if IncludeFiles then
if SearchRec.Name[1] <> '.' then
Tree.Items.AddChild(Item, SearchRec.Name);
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
Tree.Items.EndUpdate;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Node: TTreeNode;
Path: string;
Dir: string;
begin
Dir := 'c:temp';
Screen.Cursor := crHourGlass;
TreeView1.Items.BeginUpdate;
try
TreeView1.Items.Clear;
GetDirectories(TreeView1, Dir, nil, True);
finally
Screen.Cursor := crDefault;
TreeView1.Items.EndUpdate;
end;
end;
Delphi - .....................................
neoturk: ...Show directories in a ttreeview ?...
procedure TForm1.GetDirectories(Tree: TTreeView; Directory: string; Item: TTreeNode; IncludeFiles: Boolean);
var
SearchRec: TSearchRec;
ItemTemp: TTreeNode;
begin
Tree.Items.BeginUpdate;
if Directory[Length(Directory)] <> '' then Directory := Directory + '';
if FindFirst(Directory + '*.*', faDirectory, SearchRec) = 0 then
begin
repeat
if (SearchRec.Attr and faDirectory = faDirectory) and (SearchRec.Name[1] <> '.') then
begin
if (SearchRec.Attr and faDirectory > 0) then
Item := Tree.Items.AddChild(Item, SearchRec.Name);
ItemTemp := Item.Parent;
GetDirectories(Tree, Directory + SearchRec.Name, Item, IncludeFiles);
Item := ItemTemp;
end
else if IncludeFiles then
if SearchRec.Name[1] <> '.' then
Tree.Items.AddChild(Item, SearchRec.Name);
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
Tree.Items.EndUpdate;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Node: TTreeNode;
Path: string;
Dir: string;
begin
Dir := 'c:temp';
Screen.Cursor := crHourGlass;
TreeView1.Items.BeginUpdate;
try
TreeView1.Items.Clear;
GetDirectories(TreeView1, Dir, nil, True);
finally
Screen.Cursor := crDefault;
TreeView1.Items.EndUpdate;
end;
end;
Delphi - .....................................
neoturk: ...Run a program automatically at windows start-up ?...
uses
Registry;
procedure SetAutoStart(AppName, AppTitle: string; bRegister: Boolean);
const
RegKey = 'SoftwareMicrosoftWindowsCurrentVersionRun';
// or: RegKey = 'SoftwareMicrosoftWindowsCurrentVersionRunOnce';
var
Registry: TRegistry;
begin
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_LOCAL_MACHINE;
if Registry.OpenKey(RegKey, False) then
begin
if bRegister = False then
Registry.DeleteValue(AppTitle)
else
Registry.WriteString(AppTitle, AppName);
end;
finally
Registry.Free;
end;
end;
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
// 1.Parameter: Path to your Exe-File
// 2. Parameter: the Title of your Application
// 3. Set (true) or Unset (false) Autorun
SetAutoStart(ParamStr(0), 'Title of your Application', True);
end;
Delphi - .....................................
neoturk: ...Run a program automatically at windows start-up ?...
uses
Registry;
procedure SetAutoStart(AppName, AppTitle: string; bRegister: Boolean);
const
RegKey = 'SoftwareMicrosoftWindowsCurrentVersionRun';
// or: RegKey = 'SoftwareMicrosoftWindowsCurrentVersionRunOnce';
var
Registry: TRegistry;
begin
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_LOCAL_MACHINE;
if Registry.OpenKey(RegKey, False) then
begin
if bRegister = False then
Registry.DeleteValue(AppTitle)
else
Registry.WriteString(AppTitle, AppName);
end;
finally
Registry.Free;
end;
end;
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
// 1.Parameter: Path to your Exe-File
// 2. Parameter: the Title of your Application
// 3. Set (true) or Unset (false) Autorun
SetAutoStart(ParamStr(0), 'Title of your Application', True);
end;
Delphi - .....................................
neoturk: ...Use gettempfilename to create a unique temporary file ?...
function GetTempFile(const Extension: string): string;
var
Buffer: array[0..MAX_PATH] of Char;
aFile: string;
begin
repeat
GetTempPath(SizeOf(Buffer) - 1, Buffer);
GetTempFileName(Buffer, '~', 0, Buffer);
Result := ChangeFileExt(Buffer, Extension);
until not FileExists(Result);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetTempFile('.~tp'));
// The temp. file looks like C:WINDOWSTEMP~61D5.TMP
end;
{
Note:
The GetTempFile function just returns a unique filename but
doesn't create the file.
}
{
Bemerkung:
Die GetTempFile Funktion liefert nur den Namen der temp.
Datei aber erstellt sie nicht.
}
Delphi - .....................................
neoturk: ...Use gettempfilename to create a unique temporary file ?...
function GetTempFile(const Extension: string): string;
var
Buffer: array[0..MAX_PATH] of Char;
aFile: string;
begin
repeat
GetTempPath(SizeOf(Buffer) - 1, Buffer);
GetTempFileName(Buffer, '~', 0, Buffer);
Result := ChangeFileExt(Buffer, Extension);
until not FileExists(Result);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetTempFile('.~tp'));
// The temp. file looks like C:WINDOWSTEMP~61D5.TMP
end;
{
Note:
The GetTempFile function just returns a unique filename but
doesn't create the file.
}
{
Bemerkung:
Die GetTempFile Funktion liefert nur den Namen der temp.
Datei aber erstellt sie nicht.
}
Delphi - .....................................
neoturk: ...Change file attributes ?...
{
To set a file's attributes, pass the name of the file and
the attributes you want to the FileSetAttr function.
}
{
FileSetAttr setzt die Attribute der mit FileName
angegebenen Datei auf den Wert Attr.
}
{
To hide a file:
Eine Datei verstecken:
}
procedure TForm1.Button1Click(Sender: TObject);
begin
FileSetAttr('C:YourFile.ext', faHidden);
end;
{
Other Files Attributes:
Andere Dateiattribute:
}
{
faReadOnly $00000001 Schreibgeschützte Datei
faHidden $00000002 Verborgene Datei
faSysFile $00000004 Systemdatei
faVolumeID $00000008 Laufwerks-ID
faDirectory $00000010 Verzeichnis
faArchive $00000020 Archivdatei
faAnyFile $0000003F Beliebige Datei
}
{
You can also set some attributes at once:
Es können auch mehrere Attribute aufs Mal gesetzt werden:
}
FileSetAttr('C:Autoexec.bat', faReadOnly + faHidden);
{
To remove write protection on a file:
Den Schreibschutz einer Datei aufheben:
}
if (FileGetAttr(FileName) and faReadOnly) > 0
then FileSetAttr(FileName, FileGetAttr(FileName) xor faReadOnly);
{
Re-Set write protection:
Schreibschutz wieder setzen:
}
FileSetAttr(FileName, FileGetAttr(FileName) or faReadOnly);
Delphi - .....................................
neoturk: ...Change file attributes ?...
{
To set a file's attributes, pass the name of the file and
the attributes you want to the FileSetAttr function.
}
{
FileSetAttr setzt die Attribute der mit FileName
angegebenen Datei auf den Wert Attr.
}
{
To hide a file:
Eine Datei verstecken:
}
procedure TForm1.Button1Click(Sender: TObject);
begin
FileSetAttr('C:YourFile.ext', faHidden);
end;
{
Other Files Attributes:
Andere Dateiattribute:
}
{
faReadOnly $00000001 Schreibgeschützte Datei
faHidden $00000002 Verborgene Datei
faSysFile $00000004 Systemdatei
faVolumeID $00000008 Laufwerks-ID
faDirectory $00000010 Verzeichnis
faArchive $00000020 Archivdatei
faAnyFile $0000003F Beliebige Datei
}
{
You can also set some attributes at once:
Es können auch mehrere Attribute aufs Mal gesetzt werden:
}
FileSetAttr('C:Autoexec.bat', faReadOnly + faHidden);
{
To remove write protection on a file:
Den Schreibschutz einer Datei aufheben:
}
if (FileGetAttr(FileName) and faReadOnly) > 0
then FileSetAttr(FileName, FileGetAttr(FileName) xor faReadOnly);
{
Re-Set write protection:
Schreibschutz wieder setzen:
}
FileSetAttr(FileName, FileGetAttr(FileName) or faReadOnly);
