Mega Code Archive
Create a new folder in the start menu
<![CDATA[
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;
]]>