uwinImports: Windows-specific imports and utils

bitSpaceUtils.lpk

@@ -11,7 +11,7 @@
         <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
       </SearchPaths>
     </CompilerOptions>
-    <Files Count="31">
+    <Files Count="32">
       <Item1>
         <Filename Value="uutlAlgorithm.pas"/>
         <UnitName Value="uutlAlgorithm"/>
@@ -136,6 +136,10 @@
         <Filename Value="uutlCommandLine.pas"/>
         <UnitName Value="uutlCommandLine"/>
       </Item31>
+      <Item32>
+        <Filename Value="uwinImports.pas"/>
+        <UnitName Value="uwinImports"/>
+      </Item32>
     </Files>
     <RequiredPkgs Count="2">
       <Item1>

bitSpaceUtils.pas

@@ -12,7 +12,7 @@ uses
   uutlEvent, uutlEventManager, uutlFilter, uutlGenerics, uutlInterfaces, uutlKeyCodes, uutlLinq, uutlListBase, 
   uutlLogger, uutlMCF, uutlObservable, uutlSScanf, uutlStreamHelper, uutlSyncObjs, uutlThreads, uutlTypes, 
   uutlXmlHelper, uutlVariantObject, uutlVariantProperty, uutlVariantEnum, uutlVariantSet, uutlCommandLine, 
-  LazarusPackageIntf;
+  uwinImports, LazarusPackageIntf;
 
 implementation
 

uwinImports.pas

@@ -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.
+