neoturk: ...Check if a path exists ?...
uses FileCtrl;
procedure TForm1.Button1Click(Sender: TObject);
begin
if DirectoryExists('c:windows') then
ShowMessage('Path exists!');
end;
Delphi - .....................................
neoturk: ...Show the select directory dialog ?...
uses Filectrl;
{....}
procedure TForm1.Button1Click(Sender: TObject);
var
Dir: String;
begin
SelectDirectory('Select a directory', '', Dir);
ShowMessage(Dir);
end;
Delphi - .....................................
neoturk: ...Show the select directory dialog ?...
uses Filectrl;
{....}
procedure TForm1.Button1Click(Sender: TObject);
var
Dir: String;
begin
SelectDirectory('Select a directory', '', Dir);
ShowMessage(Dir);
end;
Delphi - .....................................
neoturk: ...Convert long filenames in short filenames ?...
uses
Windows, SysUtils;
function GetShortName(sLongName: string): string;
var
sShortName: string;
nShortNameLen: Integer;
begin
SetLength(sShortName, MAX_PATH);
nShortNameLen := GetShortPathName(PChar(sLongName), PChar(sShortName), MAX_PATH - 1);
if (0 = nShortNameLen) then
begin
// handle errors...
end;
SetLength(sShortName, nShortNameLen);
Result := sShortName;
end;
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
Caption := GetShortName('C:Program FilesDelphi6Libtest.cnt');
// --> C:PROGRA~1Delphi6Libtest.cnt
end;
Delphi - .....................................
neoturk: ...Convert long filenames in short filenames ?...
uses
Windows, SysUtils;
function GetShortName(sLongName: string): string;
var
sShortName: string;
nShortNameLen: Integer;
begin
SetLength(sShortName, MAX_PATH);
nShortNameLen := GetShortPathName(PChar(sLongName), PChar(sShortName), MAX_PATH - 1);
if (0 = nShortNameLen) then
begin
// handle errors...
end;
SetLength(sShortName, nShortNameLen);
Result := sShortName;
end;
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
Caption := GetShortName('C:Program FilesDelphi6Libtest.cnt');
// --> C:PROGRA~1Delphi6Libtest.cnt
end;
Delphi - .....................................
neoturk: ...Get the free disk space ?...
procedure TForm1.Button1Click(Sender: TObject);
var
freeSpace, totalSpace: Double;
s: Char;
begin
// Drive letter
// Laufwerksbuchstabe
s := 'D';
freeSpace := DiskFree(Ord(s) - 64);
totalSpace := DiskSize(Ord(s) - 64);
label1.Caption := Format('Free Space: %12.0n', [freeSpace]);
Label2.Caption := Format('Total Space: %12.0n', [totalSpace]);
Label3.Caption := IntToStr(Round((totalSpace - freeSpace) / totalSpace * 100)) +
' Percent used.';
end;
Delphi - .....................................
neoturk: ...Get the free disk space ?...
procedure TForm1.Button1Click(Sender: TObject);
var
freeSpace, totalSpace: Double;
s: Char;
begin
// Drive letter
// Laufwerksbuchstabe
s := 'D';
freeSpace := DiskFree(Ord(s) - 64);
totalSpace := DiskSize(Ord(s) - 64);
label1.Caption := Format('Free Space: %12.0n', [freeSpace]);
Label2.Caption := Format('Total Space: %12.0n', [totalSpace]);
Label3.Caption := IntToStr(Round((totalSpace - freeSpace) / totalSpace * 100)) +
' Percent used.';
end;
Delphi - .....................................
neoturk: ...Get the pathes of the windows special folders ?...
uses
ActiveX, ShlObj;
procedure TForm1.Button1Click(Sender: TObject);
// Replace CSIDL_HISTORY with the constants below
var
Allocator: IMalloc;
SpecialDir: PItemIdList;
FBuf: array[0..MAX_PATH] of Char;
PerDir: string;
begin
if SHGetMalloc(Allocator) = NOERROR then
begin
SHGetSpecialFolderLocation(Form1.Handle, CSIDL_HISTORY, SpecialDir);
SHGetPathFromIDList(SpecialDir, @FBuf[0]);
Allocator.Free(SpecialDir);
ShowMessage(string(FBuf));
end;
end;
// With Windows Me/2000, the SHGetSpecialFolderLocation function
// is superseded by ShGetFolderLocation.
// function to get the desktop folder location:
function GetDeskTopPath : string;
var
shellMalloc: IMalloc;
ppidl: PItemIdList;
PerDir: string;
begin
ppidl := nil;
try
if SHGetMalloc(shellMalloc) = NOERROR then
begin
SHGetSpecialFolderLocation(Form1.Handle, CSIDL_DESKTOP, ppidl);
SetLength(Result, MAX_PATH);
if not SHGetPathFromIDList(ppidl, PChar(Result)) then
raise exception.create('SHGetPathFromIDList failed : invalid pidl');
SetLength(Result, lStrLen(PChar(Result)));
end;
finally
if ppidl <> nil then
shellMalloc.free(ppidl);
end;
end;
{
Constants:
CSIDL_DESKTOP
CSIDL_INTERNET
CSIDL_PROGRAMS
CSIDL_CONTROLS
CSIDL_PRINTERS
CSIDL_PERSONAL
CSIDL_FAVORITES
CSIDL_STARTUP
CSIDL_RECENT
CSIDL_SENDTO
CSIDL_BITBUCKET
CSIDL_STARTMENU
CSIDL_DESKTOPDIRECTORY
CSIDL_DRIVES
CSIDL_NETWORK
CSIDL_NETHOOD
CSIDL_FONTS
CSIDL_TEMPLATES
CSIDL_COMMON_STARTMENU
CSIDL_COMMON_PROGRAMS
CSIDL_COMMON_STARTUP
CSIDL_COMMON_DESKTOPDIRECTORY
CSIDL_APPDATA
CSIDL_PRINTHOOD
CSIDL_ALTSTARTUP
CSIDL_COMMON_ALTSTARTUP
CSIDL_COMMON_FAVORITES
CSIDL_INTERNET_CACHE
CSIDL_COOKIES
CSIDL_HISTORY
}
{***********************************************************}
{ Read paths from registry. by LENIN INC }
uses
Windows, SysUtils, Registry;
type
TSystemPath = (Desktop, StartMenu,
Programs, Startup, Personal, AppData,
Fonts, SendTo, Recent, Favorites, Cache,
Cookies, History, NetHood, PrintHood,
Templates, LocADat, WindRoot, WindSys,
TempPath, RootDir, ProgFiles, ComFiles,
ConfigPath, DevicePath, MediaPath, WallPaper);
function GetSystemPath(SystemPath: TSystemPath): string;
var
ph: PChar;
begin
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
OpenKey('SoftwareMicrosoftWindowsCurrentVersion' +
'ExplorerShell Folders', True);
case SystemPath of
Desktop: Result := ReadString('Desktop');
StartMenu: Result := ReadString('Start Menu');
Programs: Result := ReadString('Programs');
Startup: Result := ReadString('Startup');
Personal: Result := ReadString('Personal');
AppData: Result := ReadString('AppData');
Fonts: Result := ReadString('Fonts');
SendTo: Result := ReadString('SendTo');
Recent: Result := ReadString('Recent');
Favorites: Result := ReadString('Favorites');
Cache: Result := ReadString('Cache');
Cookies: Result := ReadString('Cookies');
History: Result := ReadString('History');
NetHood: Result := ReadString('NetHood');
PrintHood: Result := ReadString('PrintHood');
Templates: Result := ReadString('Templates');
LocADat: Result := ReadString('Local AppData');
WindRoot:
begin
GetMem(ph, 255);
GetWindowsDirectory(ph, 254);
Result := Strpas(ph);
Freemem(ph);
end;
WindSys:
begin
GetMem(ph, 255);
GetSystemDirectory(ph, 254);
Result := Strpas(ph);
Freemem(ph);
end;
TempPath:
begin
GetMem(ph, 255);
GetTempPath(254, ph);
Result := Strpas(ph);
Freemem(ph);
end;
RootDir:
begin
GetMem(ph, 255);
GetSystemDirectory(ph, 254);
Result := (Copy(Strpas(ph), 1, 2));
Freemem(ph);
end;
end;
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('SOFTWAREMicrosoftWindowsCurrentVersion', True);
case SystemPath of
ProgFiles: Result := ReadString('ProgramFilesDir');
ComFiles: Result := ReadString('CommonFilesDir');
ConfigPath: Result := ReadString('ConfigPath');
DevicePath: Result := ReadString('DevicePath');
MediaPath: Result := ReadString('MediaPath');
WallPaper: Result := ReadString('WallPaperDir');
end;
finally
CloseKey;
Free;
end;
if (Result <> '') and (Result[Length(Result)] <> '') then
Result := Result + '';
end;
//Use
procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption := GetSystemPath(DevicePath);
end;
Delphi - .....................................
neoturk: ...Get the pathes of the windows special folders ?...
uses
ActiveX, ShlObj;
procedure TForm1.Button1Click(Sender: TObject);
// Replace CSIDL_HISTORY with the constants below
var
Allocator: IMalloc;
SpecialDir: PItemIdList;
FBuf: array[0..MAX_PATH] of Char;
PerDir: string;
begin
if SHGetMalloc(Allocator) = NOERROR then
begin
SHGetSpecialFolderLocation(Form1.Handle, CSIDL_HISTORY, SpecialDir);
SHGetPathFromIDList(SpecialDir, @FBuf[0]);
Allocator.Free(SpecialDir);
ShowMessage(string(FBuf));
end;
end;
// With Windows Me/2000, the SHGetSpecialFolderLocation function
// is superseded by ShGetFolderLocation.
// function to get the desktop folder location:
function GetDeskTopPath : string;
var
shellMalloc: IMalloc;
ppidl: PItemIdList;
PerDir: string;
begin
ppidl := nil;
try
if SHGetMalloc(shellMalloc) = NOERROR then
begin
SHGetSpecialFolderLocation(Form1.Handle, CSIDL_DESKTOP, ppidl);
SetLength(Result, MAX_PATH);
if not SHGetPathFromIDList(ppidl, PChar(Result)) then
raise exception.create('SHGetPathFromIDList failed : invalid pidl');
SetLength(Result, lStrLen(PChar(Result)));
end;
finally
if ppidl <> nil then
shellMalloc.free(ppidl);
end;
end;
{
Constants:
CSIDL_DESKTOP
CSIDL_INTERNET
CSIDL_PROGRAMS
CSIDL_CONTROLS
CSIDL_PRINTERS
CSIDL_PERSONAL
CSIDL_FAVORITES
CSIDL_STARTUP
CSIDL_RECENT
CSIDL_SENDTO
CSIDL_BITBUCKET
CSIDL_STARTMENU
CSIDL_DESKTOPDIRECTORY
CSIDL_DRIVES
CSIDL_NETWORK
CSIDL_NETHOOD
CSIDL_FONTS
CSIDL_TEMPLATES
CSIDL_COMMON_STARTMENU
CSIDL_COMMON_PROGRAMS
CSIDL_COMMON_STARTUP
CSIDL_COMMON_DESKTOPDIRECTORY
CSIDL_APPDATA
CSIDL_PRINTHOOD
CSIDL_ALTSTARTUP
CSIDL_COMMON_ALTSTARTUP
CSIDL_COMMON_FAVORITES
CSIDL_INTERNET_CACHE
CSIDL_COOKIES
CSIDL_HISTORY
}
{***********************************************************}
{ Read paths from registry. by LENIN INC }
uses
Windows, SysUtils, Registry;
type
TSystemPath = (Desktop, StartMenu,
Programs, Startup, Personal, AppData,
Fonts, SendTo, Recent, Favorites, Cache,
Cookies, History, NetHood, PrintHood,
Templates, LocADat, WindRoot, WindSys,
TempPath, RootDir, ProgFiles, ComFiles,
ConfigPath, DevicePath, MediaPath, WallPaper);
function GetSystemPath(SystemPath: TSystemPath): string;
var
ph: PChar;
begin
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
OpenKey('SoftwareMicrosoftWindowsCurrentVersion' +
'ExplorerShell Folders', True);
case SystemPath of
Desktop: Result := ReadString('Desktop');
StartMenu: Result := ReadString('Start Menu');
Programs: Result := ReadString('Programs');
Startup: Result := ReadString('Startup');
Personal: Result := ReadString('Personal');
AppData: Result := ReadString('AppData');
Fonts: Result := ReadString('Fonts');
SendTo: Result := ReadString('SendTo');
Recent: Result := ReadString('Recent');
Favorites: Result := ReadString('Favorites');
Cache: Result := ReadString('Cache');
Cookies: Result := ReadString('Cookies');
History: Result := ReadString('History');
NetHood: Result := ReadString('NetHood');
PrintHood: Result := ReadString('PrintHood');
Templates: Result := ReadString('Templates');
LocADat: Result := ReadString('Local AppData');
WindRoot:
begin
GetMem(ph, 255);
GetWindowsDirectory(ph, 254);
Result := Strpas(ph);
Freemem(ph);
end;
WindSys:
begin
GetMem(ph, 255);
GetSystemDirectory(ph, 254);
Result := Strpas(ph);
Freemem(ph);
end;
TempPath:
begin
GetMem(ph, 255);
GetTempPath(254, ph);
Result := Strpas(ph);
Freemem(ph);
end;
RootDir:
begin
GetMem(ph, 255);
GetSystemDirectory(ph, 254);
Result := (Copy(Strpas(ph), 1, 2));
Freemem(ph);
end;
end;
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('SOFTWAREMicrosoftWindowsCurrentVersion', True);
case SystemPath of
ProgFiles: Result := ReadString('ProgramFilesDir');
ComFiles: Result := ReadString('CommonFilesDir');
ConfigPath: Result := ReadString('ConfigPath');
DevicePath: Result := ReadString('DevicePath');
MediaPath: Result := ReadString('MediaPath');
WallPaper: Result := ReadString('WallPaperDir');
end;
finally
CloseKey;
Free;
end;
if (Result <> '') and (Result[Length(Result)] <> '') then
Result := Result + '';
end;
//Use
procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption := GetSystemPath(DevicePath);
end;
Delphi - .....................................
neoturk: ...Check if a file-directory exists ?...
uses
FileCtrl;
procedure TForm1.Button1Click(Sender: TObject);
begin
if FileExists('c:boot.ini') then
ShowMessage('File exists! Datei existiert!');
if FileExists('c:windows') then
ShowMessage('Directory Exists!');
end;
Delphi - .....................................
neoturk: ...Check if a file-directory exists ?...
uses
FileCtrl;
procedure TForm1.Button1Click(Sender: TObject);
begin
if FileExists('c:boot.ini') then
ShowMessage('File exists! Datei existiert!');
if FileExists('c:windows') then
ShowMessage('Directory Exists!');
end;
Delphi - .....................................
neoturk: ...Check if a file can be opened ?...
function IsFileInUse(const fName: TFileName): Boolean;
var
HFileRes: HFILE;
begin
Result := False;
HFileRes := CreateFile(PChar(fName),
GENERIC_READ or GENERIC_WRITE,
0,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);
Result := (HFileRes = INVALID_HANDLE_VALUE);
if not Result then
CloseHandle(HFileRes);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
if IsFileInUse(Opendialog1.FileName) then
ShowMessage('File is in use!');
end;
Delphi - .....................................
neoturk: ...Check if a file can be opened ?...
function IsFileInUse(const fName: TFileName): Boolean;
var
HFileRes: HFILE;
begin
Result := False;
HFileRes := CreateFile(PChar(fName),
GENERIC_READ or GENERIC_WRITE,
0,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);
Result := (HFileRes = INVALID_HANDLE_VALUE);
if not Result then
CloseHandle(HFileRes);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
if IsFileInUse(Opendialog1.FileName) then
ShowMessage('File is in use!');
end;
Delphi - .....................................
neoturk: ...Set a file's date ?...
function SetFileDateTime(FileName: string; NewDateTime: TDateTime): Boolean;
var
FileHandle: Integer;
FileTime: TFileTime;
LFT: TFileTime;
LST: TSystemTime;
begin
Result := False;
try
DecodeDate(NewDateTime, LST.wYear, LST.wMonth, LST.wDay);
DecodeTime(NewDateTime, LST.wHour, LST.wMinute, LST.wSecond, LST.wMilliSeconds);
if SystemTimeToFileTime(LST, LFT) then
begin
if LocalFileTimeToFileTime(LFT, FileTime) then
begin
FileHandle := FileOpen(FileName, fmOpenReadWrite or
fmShareExclusive);
if SetFileTime(FileHandle, nil, nil, @FileTime) then
Result := True;
end;
end;
finally
FileClose(FileHandle);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
if SetFileDateTime(OpenDialog1.FileName, now) then
ShowMessage('Date set to now !');
end;
