ADD: Get OneDrive folders from registry

This commit is contained in:
Alexander Koblov 2025-04-10 00:29:19 +03:00
commit 5932fb6658
2 changed files with 69 additions and 17 deletions

View file

@ -388,7 +388,7 @@ uses
{$ENDIF}
{$IFDEF MSWINDOWS}
, ActiveX, CommCtrl, ShellAPI, Windows, DCFileAttributes, uBitmap, uGdiPlus,
DCConvertEncoding, uShlObjAdditional, uShellFolder,
DCConvertEncoding, uShlObjAdditional, uShellFolder, uMyWindows,
uShellFileSourceUtil
{$ELSE}
, StrUtils, Types, DCBasicTypes
@ -1658,7 +1658,6 @@ begin
FSysImgList := SHGetSystemImageList(iIconSize);
FOneDrivePath := TStringList.Create;
FOneDrivePath.CaseSensitive := FileNameCaseSensitive;
{$ENDIF}
{$IF DEFINED(MSWINDOWS) and DEFINED(LCLQT5)}
@ -1793,20 +1792,7 @@ begin
FiEmblemOnline:= CheckAddThemePixmap('emblem-cloud-online', I);
FiEmblemOffline:= CheckAddThemePixmap('emblem-cloud-offline', I);
// Microsoft OneDrive folders
if GetKnownFolderPath(FOLDERID_SkyDrive, sPixMap) then
begin
if (Length(sPixMap) > 0) then FOneDrivePath.Add(sPixMap);
end;
sPixMap:= mbGetEnvironmentVariable('OneDriveConsumer');
if (Length(sPixMap) > 0) and (FOneDrivePath.IndexOf(sPixMap) < 0) then
begin
FOneDrivePath.Add(sPixMap);
end;
sPixMap:= mbGetEnvironmentVariable('OneDriveCommercial');
if (Length(sPixMap) > 0) and (FOneDrivePath.IndexOf(sPixMap) < 0) then
begin
FOneDrivePath.Add(sPixMap);
end;
GetOneDriveFolders(FOneDrivePath);
end;
FiShortcutIconID := -1;
if gShowIcons > sim_standart then

View file

@ -165,6 +165,10 @@ function IsUserAdmin: TDuplicates;
This routine returns @true if the caller's process is running in the remote desktop session
}
function RemoteSession: Boolean;
{en
Get OneDrive folders
}
procedure GetOneDriveFolders(AList: TStringList);
{en
Creates windows shortcut file (.lnk)
}
@ -186,7 +190,8 @@ implementation
uses
JwaNtStatus, ShellAPI, MMSystem, JwaWinNetWk, JwaWinUser, JwaVista, LazUTF8,
SysConst, ActiveX, ShlObj, ComObj, DCWindows, DCConvertEncoding, uShlObjAdditional;
SysConst, ActiveX, ShlObj, ComObj, DCWindows, DCConvertEncoding, DCOSUtils,
Registry, uShellFolder, uShlObjAdditional;
var
Wow64DisableWow64FsRedirection: function(OldValue: PPointer): BOOL; stdcall;
@ -1093,6 +1098,67 @@ begin
end;
end;
procedure GetOneDriveFolders(AList: TStringList);
var
APath: String;
Index: Integer;
Value: UnicodeString;
List: TUnicodeStringArray;
begin
AList.CaseSensitive:= FileNameCaseSensitive;
if GetKnownFolderPath(FOLDERID_SkyDrive, APath) then
begin
if (Length(APath) > 0) then AList.Add(APath);
end;
APath:= mbGetEnvironmentVariable('OneDriveConsumer');
if (Length(APath) > 0) and (AList.IndexOf(APath) < 0) then
begin
AList.Add(APath);
end;
APath:= mbGetEnvironmentVariable('OneDriveCommercial');
if (Length(APath) > 0) and (AList.IndexOf(APath) < 0) then
begin
AList.Add(APath);
end;
with TRegistry.Create(KEY_READ) do
try
RootKey:= HKEY_CURRENT_USER;
if OpenKey('Software\SyncEngines\Providers\OneDrive', False) then
begin
try
List:= GetKeyNames;
for Index:= 0 to High(List) do
begin
if OpenKey(List[Index], False) then
begin
try
Value:= ReadString(UnicodeString('MountPoint'));
if Length(Value) > 0 then
begin
APath:= CeUtf16ToUtf8(Value);
if (AList.IndexOf(APath) < 0) then
begin
AList.Add(APath);
end;
end;
except
// Ignore
end;
CloseKey;
end;
end;
except
// Ignore
end;
CloseKey;
end;
finally
Free;
end;
end;
procedure CreateShortcut(const Target, Shortcut: String);
var
IObject: IUnknown;