Создать папку в меню кнопки ПУСК



Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

Uses
ShlObj, ActiveX;
procedure FreePidl(pidl: PItemIDList);
var
allocator: IMalloc;
begin
if Succeeded(SHGetMalloc(allocator)) then
begin
allocator.Free(pidl);
{$IFDEF VER100}
allocator.Release;
{$ENDIF}
end;
end;
function CreateFolder(aFolderName: string; aLocation: Integer): Boolean;
var
pIdl: PItemIDList;
hPath: PChar;
begin
Result := False;
if SUCCEEDED(SHGetSpecialFolderLocation(0, aLocation, pidl)) then
begin
hPath := StrAlloc(MAX_PATH);
SHGetPathFromIDList(pIdl, hPath);
SetLastError(0);
CreateDirectory(PChar(hPath + '\\' + aFolderName), nil);
if (GetLastError = 0) or (GetLastError = ERROR_ALREADY_EXISTS) then
Result := True;
FreePIDL(pIdl);
StrDispose(hPath);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CreateFolder('MyProgramgroup', CSIDL_PROGRAMS);
end;

Далее: Спрятать или показать кнопку ПУСК »»