|
|
@@ -0,0 +1,257 @@ |
|
|
|
unit uwinImports; |
|
|
|
|
|
|
|
{$mode objfpc}{$H+} |
|
|
|
|
|
|
|
{ |
|
|
|
Accepts the following defines (pass to package in project's Additions and Overrides): |
|
|
|
|
|
|
|
UTL_WINSUPP_NT50 => Code should work/compile/start on NT5.0 (Windows 2000) |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
interface |
|
|
|
|
|
|
|
uses |
|
|
|
Classes, SysUtils, windows, activex, shlobj; |
|
|
|
|
|
|
|
const |
|
|
|
shell32 = 'shell32.dll'; |
|
|
|
|
|
|
|
|
|
|
|
{%REGION Filesystem } |
|
|
|
|
|
|
|
//function GetVolumePathNameA(lpszFileName: LPCSTR; lpszVolumePathName: LPSTR; cchBufferLength: DWORD): BOOL; stdcall; external kernel32 name 'GetVolumePathNameA'; |
|
|
|
//function GetVolumePathNameW(lpszFileName: LPCWSTR; lpszVolumePathName: LPWSTR; cchBufferLength: DWORD): BOOL; stdcall; external kernel32 name 'GetVolumePathNameW'; |
|
|
|
function GetVolumePathName(lpszFileName: LPCTSTR; lpszVolumePathName: LPTSTR; cchBufferLength: DWORD): BOOL; stdcall; external kernel32 name 'GetVolumePathNameA'; |
|
|
|
|
|
|
|
{%ENDREGION} |
|
|
|
|
|
|
|
{%REGION IOCTL } |
|
|
|
const |
|
|
|
FILE_DEVICE_DISK = $00000007; |
|
|
|
FILE_DEVICE_MASS_STORAGE = $0000002D; |
|
|
|
|
|
|
|
METHOD_BUFFERED = 0; |
|
|
|
|
|
|
|
FILE_ANY_ACCESS = 0; |
|
|
|
FILE_SPECIAL_ACCESS = FILE_ANY_ACCESS; |
|
|
|
FILE_READ_ACCESS = $0001; |
|
|
|
FILE_WRITE_ACCESS = $0002; |
|
|
|
FILE_RW_ACCESS = FILE_READ_ACCESS or FILE_WRITE_ACCESS; |
|
|
|
|
|
|
|
IOCTL_DISK_BASE = FILE_DEVICE_DISK; |
|
|
|
IOCTL_DISK_GET_DRIVE_GEOMETRY = ((IOCTL_DISK_BASE shl 16) or (FILE_ANY_ACCESS shl 14) or ($0000 shl 2) or METHOD_BUFFERED); |
|
|
|
IOCTL_DISK_FORMAT_TRACKS = ((IOCTL_DISK_BASE shl 16) or (FILE_RW_ACCESS shl 14) or ($0006 shl 2) or METHOD_BUFFERED); |
|
|
|
IOCTL_DISK_GET_LENGTH_INFO = ((IOCTL_DISK_BASE shl 16) or (FILE_READ_ACCESS shl 14) or ($0017 shl 2) or METHOD_BUFFERED); |
|
|
|
IOCTL_DISK_GET_MEDIA_TYPES = ((IOCTL_DISK_BASE shl 16) or (FILE_ANY_ACCESS shl 14) or ($0300 shl 2) or METHOD_BUFFERED); |
|
|
|
|
|
|
|
|
|
|
|
IOCTL_STORAGE_BASE = FILE_DEVICE_MASS_STORAGE; |
|
|
|
IOCTL_STORAGE_CHECK_VERIFY = ((IOCTL_STORAGE_BASE shl 16) or (FILE_READ_ACCESS shl 14) or ($0200 shl 2) or METHOD_BUFFERED); |
|
|
|
IOCTL_STORAGE_CHECK_VERIFY2 = ((IOCTL_STORAGE_BASE shl 16) or (FILE_ANY_ACCESS shl 14) or ($0200 shl 2) or METHOD_BUFFERED); |
|
|
|
IOCTL_STORAGE_MEDIA_REMOVAL = ((IOCTL_STORAGE_BASE shl 16) or (FILE_READ_ACCESS shl 14) or ($0201 shl 2) or METHOD_BUFFERED); |
|
|
|
IOCTL_STORAGE_EJECT_MEDIA = ((IOCTL_STORAGE_BASE shl 16) or (FILE_READ_ACCESS shl 14) or ($0202 shl 2) or METHOD_BUFFERED); |
|
|
|
IOCTL_STORAGE_LOAD_MEDIA = ((IOCTL_STORAGE_BASE shl 16) or (FILE_READ_ACCESS shl 14) or ($0203 shl 2) or METHOD_BUFFERED); |
|
|
|
IOCTL_STORAGE_LOAD_MEDIA2 = ((IOCTL_STORAGE_BASE shl 16) or (FILE_ANY_ACCESS shl 14) or ($0203 shl 2) or METHOD_BUFFERED); |
|
|
|
IOCTL_STORAGE_RESERVE = ((IOCTL_STORAGE_BASE shl 16) or (FILE_READ_ACCESS shl 14) or ($0204 shl 2) or METHOD_BUFFERED); |
|
|
|
IOCTL_STORAGE_RELEASE = ((IOCTL_STORAGE_BASE shl 16) or (FILE_READ_ACCESS shl 14) or ($0205 shl 2) or METHOD_BUFFERED); |
|
|
|
IOCTL_STORAGE_FIND_NEW_DEVICES = ((IOCTL_STORAGE_BASE shl 16) or (FILE_READ_ACCESS shl 14) or ($0206 shl 2) or METHOD_BUFFERED); |
|
|
|
IOCTL_STORAGE_EJECTION_CONTROL = ((IOCTL_STORAGE_BASE shl 16) or (FILE_ANY_ACCESS shl 14) or ($0250 shl 2) or METHOD_BUFFERED); |
|
|
|
IOCTL_STORAGE_MCN_CONTROL = ((IOCTL_STORAGE_BASE shl 16) or (FILE_ANY_ACCESS shl 14) or ($0251 shl 2) or METHOD_BUFFERED); |
|
|
|
|
|
|
|
IOCTL_STORAGE_GET_MEDIA_TYPES = ((IOCTL_STORAGE_BASE shl 16) or (FILE_ANY_ACCESS shl 14) or ($0300 shl 2) or METHOD_BUFFERED); |
|
|
|
IOCTL_STORAGE_GET_MEDIA_TYPES_EX = ((IOCTL_STORAGE_BASE shl 16) or (FILE_ANY_ACCESS shl 14) or ($0301 shl 2) or METHOD_BUFFERED); |
|
|
|
IOCTL_STORAGE_GET_MEDIA_SERIAL_NUMBER= ((IOCTL_STORAGE_BASE shl 16) or (FILE_ANY_ACCESS shl 14) or ($0304 shl 2) or METHOD_BUFFERED); |
|
|
|
IOCTL_STORAGE_GET_HOTPLUG_INFO = ((IOCTL_STORAGE_BASE shl 16) or (FILE_ANY_ACCESS shl 14) or ($0305 shl 2) or METHOD_BUFFERED); |
|
|
|
IOCTL_STORAGE_SET_HOTPLUG_INFO = ((IOCTL_STORAGE_BASE shl 16) or (FILE_RW_ACCESS shl 14) or ($0306 shl 2) or METHOD_BUFFERED); |
|
|
|
|
|
|
|
IOCTL_STORAGE_RESET_BUS = ((IOCTL_STORAGE_BASE shl 16) or (FILE_READ_ACCESS shl 14) or ($0400 shl 2) or METHOD_BUFFERED); |
|
|
|
IOCTL_STORAGE_RESET_DEVICE = ((IOCTL_STORAGE_BASE shl 16) or (FILE_READ_ACCESS shl 14) or ($0401 shl 2) or METHOD_BUFFERED); |
|
|
|
IOCTL_STORAGE_BREAK_RESERVATION = ((IOCTL_STORAGE_BASE shl 16) or (FILE_READ_ACCESS shl 14) or ($0405 shl 2) or METHOD_BUFFERED); |
|
|
|
|
|
|
|
IOCTL_STORAGE_GET_DEVICE_NUMBER = ((IOCTL_STORAGE_BASE shl 16) or (FILE_ANY_ACCESS shl 14) or ($0420 shl 2) or METHOD_BUFFERED); |
|
|
|
|
|
|
|
IOCTL_STORAGE_PREDICT_FAILURE = ((IOCTL_STORAGE_BASE shl 16) or (FILE_ANY_ACCESS shl 14) or ($0440 shl 2) or METHOD_BUFFERED); |
|
|
|
|
|
|
|
{%ENDREGION} |
|
|
|
|
|
|
|
|
|
|
|
{%REGION ShellAPI } |
|
|
|
{$if FPC_FULLVERSION < 030101} |
|
|
|
// only needed in versions where 0029036 is not fixed (before r32452) |
|
|
|
type LPPCITEMIDLIST = ^LPCITEMIDLIST; |
|
|
|
function SHOpenFolderAndSelectItems(pidlFolder:LPCITEMIDLIST;cidl:UINT; apidl: LPPCITEMIDLIST; dwflags: DWORD):HResult;StdCall; external shell32 name 'SHOpenFolderAndSelectItems'; |
|
|
|
|
|
|
|
{$ifend} |
|
|
|
|
|
|
|
// FIXME: temporary until 0028760 is fixed in FPC |
|
|
|
function SHBindToParent2(pidl:LPCITEMIDLIST; constref riid:TREFIID; var ppv:Pointer; var ppidlLast:LPCITEMIDLIST):HRESULT;StdCall;external External_library name 'SHBindToParent'; |
|
|
|
|
|
|
|
{%ENDREGION} |
|
|
|
|
|
|
|
{%REGION Helper - Filesystem } |
|
|
|
function GetVolumePathName(const aFileName: string): string; |
|
|
|
function GetVolumeSpace(const aDisk: string; out Total, Free: QWord): Boolean; |
|
|
|
function GetVolumeSizeIoCtl(const aDisk: string; out Total: QWord): Boolean; |
|
|
|
function GetDiskGeometry(hDisk: THandle; var Geometry: DISK_GEOMETRY): Boolean; |
|
|
|
function GetDriveGeometry(DriveLetter: char; var Geometry: DISK_GEOMETRY): Boolean; |
|
|
|
function GetVolumeInformation(const aDisk: string; out DriveLabel, Filesystem: string): boolean; |
|
|
|
function GetFileCompressedSize(const aFileName: string; out FSize: QWord): Boolean; |
|
|
|
function GetFileIndex(const aFilename: string; out FIndex: QWORD): boolean; |
|
|
|
{%ENDREGION} |
|
|
|
|
|
|
|
{%REGION Helpr - ShellAPI } |
|
|
|
function GetConfigLocation(const aPortable, aRoaming: boolean; aProgramSubdir: String): string; |
|
|
|
|
|
|
|
function OpenFolderAndSelectFile(const FileName: string): boolean; |
|
|
|
{%ENDREGION} |
|
|
|
|
|
|
|
implementation |
|
|
|
|
|
|
|
uses |
|
|
|
windirs; |
|
|
|
|
|
|
|
function GetVolumePathName(const aFileName: string): string; |
|
|
|
begin |
|
|
|
SetLength(Result, MAX_PATH + 2); |
|
|
|
if not uwinImports.GetVolumePathName(LPCTSTR(aFileName), LPCTSTR(Result),MAX_PATH) then |
|
|
|
exit; |
|
|
|
SetLength(Result, strlen(PChar(Result))); |
|
|
|
end; |
|
|
|
|
|
|
|
function GetVolumeSpace(const aDisk: string; out Total, Free: QWord): Boolean; |
|
|
|
var |
|
|
|
freequota: QWord; |
|
|
|
begin |
|
|
|
Result:= GetDiskFreeSpaceEx(PChar(aDisk), @freequota, @Total,@Free); |
|
|
|
end; |
|
|
|
|
|
|
|
function GetVolumeSizeIoCtl(const aDisk: string; out Total: QWord): Boolean; |
|
|
|
var |
|
|
|
dn: string; |
|
|
|
fh: THANDLE; |
|
|
|
gio: GET_LENGTH_INFORMATION; |
|
|
|
ret: dword; |
|
|
|
begin |
|
|
|
Result:= false; |
|
|
|
dn:= '\\.\'+ExcludeTrailingPathDelimiter(aDisk); |
|
|
|
fh:= CreateFile(PChar(dn), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0); |
|
|
|
if fh = INVALID_HANDLE_VALUE then |
|
|
|
exit; |
|
|
|
try |
|
|
|
if DeviceIoControl(fh, IOCTL_DISK_GET_LENGTH_INFO, nil, 0, @gio, sizeof(gio), @ret, nil) then begin |
|
|
|
Total:= gio.Length.QuadPart; |
|
|
|
Result:= true; |
|
|
|
end; |
|
|
|
finally |
|
|
|
CloseHandle(fh); |
|
|
|
end; |
|
|
|
end; |
|
|
|
|
|
|
|
//////////////////////////////////////////////////////////////////////////////// |
|
|
|
// Comment : gets the geometry of the disk |
|
|
|
// Arguments : hDisk: THandle; var Geometry: DISK_GEOMETRY |
|
|
|
// Result : Boolean |
|
|
|
|
|
|
|
function GetDiskGeometry(hDisk: THandle; var Geometry: DISK_GEOMETRY): Boolean; |
|
|
|
var |
|
|
|
ReturnedBytesCount: DWORD; |
|
|
|
begin |
|
|
|
result := DeviceIoControl(hDisk, IOCTL_DISK_GET_DRIVE_GEOMETRY, nil, 0, @Geometry, sizeof(Geometry), ReturnedBytesCount, nil); |
|
|
|
end; |
|
|
|
|
|
|
|
function GetDriveGeometry(DriveLetter: char; var Geometry: DISK_GEOMETRY): Boolean; |
|
|
|
var |
|
|
|
SrcDrive : string; |
|
|
|
hDrive : THandle; |
|
|
|
begin |
|
|
|
Result:= false; |
|
|
|
SrcDrive := '\\.\' + DriveLetter + ':'; |
|
|
|
// open floppy drive |
|
|
|
hDrive := CreateFile(@SrcDrive[1], GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE , nil, OPEN_EXISTING, 0, 0); |
|
|
|
if hDrive <> INVALID_HANDLE_VALUE then try |
|
|
|
Result:= GetDiskGeometry(hDrive, Geometry); |
|
|
|
finally |
|
|
|
CloseHandle(hDrive); |
|
|
|
end; |
|
|
|
end; |
|
|
|
|
|
|
|
function GetVolumeInformation(const aDisk: string; out DriveLabel, Filesystem: string): boolean; |
|
|
|
var |
|
|
|
dn, fs: array[0..MAX_PATH] of Char; |
|
|
|
begin |
|
|
|
ZeroMemory(@dn[0], Length(dn)); |
|
|
|
ZeroMemory(@fs[0], Length(fs)); |
|
|
|
Result:= Windows.GetVolumeInformation(PChar(aDisk), @dn[0], High(dn), nil, nil, nil, @fs[0], high(fs)); |
|
|
|
if Result then begin |
|
|
|
DriveLabel:= StrPas(dn); |
|
|
|
Filesystem:= StrPas(fs); |
|
|
|
end; |
|
|
|
end; |
|
|
|
|
|
|
|
function GetFileCompressedSize(const aFileName: string; out FSize: QWord): Boolean; |
|
|
|
var |
|
|
|
li: LARGE_INTEGER; |
|
|
|
begin |
|
|
|
SetLastError(0); |
|
|
|
li.LowPart:= GetCompressedFileSize(LPCSTR(aFileName), @li.HighPart); |
|
|
|
Result:= GetLastError = NOERROR; |
|
|
|
if Result then |
|
|
|
FSize:= li.QuadPart; |
|
|
|
end; |
|
|
|
|
|
|
|
function GetFileIndex(const aFilename: string; out FIndex: QWORD): boolean; |
|
|
|
var |
|
|
|
fh: THANDLE; |
|
|
|
bhfi: TBYHANDLEFILEINFORMATION; |
|
|
|
fi: LARGE_INTEGER; |
|
|
|
begin |
|
|
|
Result:= false; |
|
|
|
fh:= FileOpen(aFilename, fmOpenRead or fmShareDenyNone); |
|
|
|
if fh <> feInvalidHandle then begin |
|
|
|
if GetFileInformationByHandle(fh, bhfi) then begin |
|
|
|
fi.LowPart:= bhfi.nFileIndexLow; |
|
|
|
fi.HighPart:= bhfi.nFileIndexHigh; |
|
|
|
FIndex:= fi.QuadPart; |
|
|
|
Result:= true; |
|
|
|
end; |
|
|
|
FileClose(fh); |
|
|
|
end; |
|
|
|
end; |
|
|
|
|
|
|
|
function GetConfigLocation(const aPortable, aRoaming: boolean; aProgramSubdir: String): string; |
|
|
|
begin |
|
|
|
if aPortable then |
|
|
|
Result:= ExtractFilePath(ParamStr(0)) |
|
|
|
else begin |
|
|
|
if aRoaming then |
|
|
|
Result:= IncludeTrailingPathDelimiter(GetWindowsSpecialDir(CSIDL_APPDATA)) |
|
|
|
else |
|
|
|
Result:= IncludeTrailingPathDelimiter(GetWindowsSpecialDir(CSIDL_LOCAL_APPDATA)); |
|
|
|
if aProgramSubdir > '' then |
|
|
|
Result += aProgramSubdir + PathDelim; |
|
|
|
end; |
|
|
|
end; |
|
|
|
|
|
|
|
function OpenFolderAndSelectFile(const FileName: string): boolean; |
|
|
|
{$IFNDEF UTL_WINSUPP_NT50} |
|
|
|
var |
|
|
|
IIDL: PItemIDList; |
|
|
|
begin |
|
|
|
result := false; |
|
|
|
IIDL := ILCreateFromPath(PChar(FileName)); |
|
|
|
if IIDL <> nil then |
|
|
|
try |
|
|
|
result := SHOpenFolderAndSelectItems(IIDL, 0, LPPCITEMIDLIST(nil), 0) = S_OK; |
|
|
|
finally |
|
|
|
ILFree(IIDL); |
|
|
|
end; |
|
|
|
{$ELSE} |
|
|
|
begin |
|
|
|
ShellExecute(0, 'explore', PChar(ExtractFilePath(FileName)), nil, nil, SW_SHOWNORMAL); |
|
|
|
{$ENDIF} |
|
|
|
end; |
|
|
|
|
|
|
|
|
|
|
|
end. |
|
|
|
|