Program folders

rajniyadav
rajniyadav used Ask the Experts™
on
Hi

I am creating installable disk for my project.

I need to display all the existing program folders and
i also want to create new program folder. How can i do this.

Also i need to get the path of "program files".

Thanxs
Rajni :)



Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Hi,

Place one button and one ListBox on a form. Then try the following code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ProgramFiles: string;

implementation

{$R *.DFM}

uses FileCtrl;

function GetEnvVar(const EnvVar: string): string;
var
 BytesNeeded: DWORD;
begin
 BytesNeeded := GetEnvironmentVariable(PChar(EnvVar), nil, 0);
 if BytesNeeded > 0 then
 begin
   SetLength(Result, BytesNeeded - 1);
   GetEnvironmentVariable(PChar(EnvVar), PChar(Result), BytesNeeded);
 end
 else
   Result := '';
end;

procedure GetFolders(DirStr: String; List: TStrings);
var
  DirInfo: TSearchRec;
  R: Integer;
begin
  R := FindFirst(DirStr + '\*.*', faDirectory, DirInfo);
  while R = 0 do begin
    if (DirInfo.Name <> '.') and (DirInfo.Name <> '..') then begin
      List.Add(DirStr + '\' + DirInfo.Name);
    end;
    R := FindNext(DirInfo);
  end;
  FindClose(DirInfo);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox1.Items.Clear;
  // get program files folder
  ProgramFiles := GetEnvVar('ProgramFiles');
  ShowMessage(ProgramFiles);
  // get all folders
  GetFolders(ProgramFiles, ListBox1.Items);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  // create 'geobul' program folder
  ForceDirectories(ProgramFiles + '\geobul');
end;

end.

Regards, Geo
You'll need two buttons, of course. Button1 to get all the folders and Button2 to create a new folder.
1. There are difference between NT based systems and Win9x.
Windows NT have two Start menu 1 for all (Common) and 1 personaly for user
------
This will wortk on all version.
-------
var path:array[0..255] of char;
begin
     SHGetSpecialFolderPath(0,@path,CSIDL_PROGRAMS,false);
give to you file system directory containing Start menu items.
To create new one just make directory.
mkdir(path+'\my directory');
-------
To collect all program folders
lets put on form GroupList: TListBox;

---------
procedure ReadGroups;
var
  PROGMAN, Item: TDDEString;
  Conv: TDDEConversation;
  DataHandle: TDDEData;
  DataPointer: PChar;
  DataSize: LongInt;
  H: THandle;
  FindData: TWin32FindData;
  S: String;
begin
  try
    if (Win32Platform = VER_PLATFORM_WIN32_NT) then begin
      PROGMAN := DDE.CreateString('PROGMAN');
      Item := DDE.CreateString('GROUPS');
      Conv := DDE.BeginConnection(PROGMAN, PROGMAN);
      try
        DDE.RequestBegin (Conv, Item, CF_TEXT, DataHandle, Pointer(DataPointer), DataSize);
        try
          GroupList.Items.SetText (DataPointer);
        finally
          DDE.RequestEnd (DataHandle);
        end;
      finally
        DDE.EndConnection (Conv);
        DDE.FreeString (Item);
        DDE.FreeString (PROGMAN);
      end;
    end
    else begin
      H := FindFirstFile(PChar(ChangeDirConst('{group}\*')), FindData);
      if H <> INVALID_HANDLE_VALUE then begin
        repeat
          if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then begin
            S := FindData.cFileName;
            if (S <> '.') and (S <> '..') then
              GroupList.Items.Add (S);
          end;
        until not FindNextFile(H, FindData);
        WinProcs.FindClose (H);
      end;
    end;
  except
    { ignore any exceptions }
  end;
end;
OWASP: Avoiding Hacker Tricks

Learn to build secure applications from the mindset of the hacker and avoid being exploited.

If you want to get the program groups under 'Start-Programs' then use something like the following. In addition to my previous code there are two more buttons:

uses ShlObj, ActiveX, ComObj, FileCtrl;

function SpecialFolder(CSIDL:integer): String;
var
  pidl :pItemIDList;
  Buffer: array[0..Max_Path]of char;
  Malloc: IMalloc;
begin
  SHGetSpecialFolderLocation(0, CSIDL, pidl);
  ShGetPathFromIdList(pidl, PChar(@Buffer));
  Result:= Buffer;
  OLECheck(SHGetMalloc(Malloc));
  if pidl <> nil then Malloc.Free(pidl);
end;

procedure GetGroups(DirStr: String; List: TStrings);
var
 DirInfo: TSearchRec;
 R: Integer;
begin
 R := FindFirst(DirStr + '\*.*', faDirectory, DirInfo);
 while R = 0 do begin
   if (DirInfo.Name <> '.') and (DirInfo.Name <> '..') then begin
     if UpperCase(ExtractFileExt(DirInfo.Name)) <> '.LNK' then
       List.Add(DirInfo.Name);
   end;
   R := FindNext(DirInfo);
 end;
 FindClose(DirInfo);
end;

// get groups in ListBox1
procedure TForm1.Button3Click(Sender: TObject);
var
  sl: TStringList;
begin
 sl := TStringList.Create;
 try
  sl.Duplicates := dupIgnore;
  sl.Sorted := true;
  ListBox1.Items.Clear;
  CommonPrograms := SpecialFolder(CSIDL_COMMON_PROGRAMS);
  GetGroups(CommonPrograms, sl);
  PersonalPrograms := SpecialFolder(CSIDL_PROGRAMS);
  GetGroups(PersonalPrograms, sl);
  ListBox1.Items := sl;
 finally
  sl.Free;
 end;
end;

// create a group
procedure TForm1.Button4Click(Sender: TObject);
begin
  ForceDirectories(PersonalPrograms + '\geobul');
end;

Regards, Geo

Author

Commented:
hi geobul

Thanx for your answers. This is creating the folder but then i also have to create the shortcut of my application so that user may be able to run it through start up menu.


rajni :)
2 rajniyadav - You did ask about creating shotrcuts :)
---------

procedure CreateShortcut(FileName: string; MenuFolder: string);
var
  AnObj: IUnknown;
  ShLink: IShellLink;
  PFile: IPersistFile;
  WFileName: WideString;
begin
  AnObj := CreateComObject(CLSID_ShellLink);
  ShLink := AnObj as IShellLink;
  PFile := AnObj as IPersistFile;
//Shelllink target
  ShLink.SetPath(PChar( FileName));
//ShowCommand
ShLink.SetShowCmd(SW_SHOWNORMAL);

//Working Dir
WorkingDirectory := ExtractFilePath( ProgramFile );
ShLink.SetWorkingDirectory(PChar( WorkingDirectory ));
// Save
  WFileName := MenuFolder+'\'+ChangeFileExt(extractFileName(LinkFile),'.lnk');
  PFile.Save(PWChar(WFileName), False);
end;
-----------
MenuFolder - must be set to full path to the new created program group folder!!!

Author

Commented:
Hi Ray_Adams

Your shortcut soultion is working

I am posting question about shortcuts as a seperate question because My question had two parts and since two person answered this question and both the solution is correct.

So the only way i can give points to both is to post the question seperatly so please post your answer again for the new question.

Rajni
So where is another question?

Author

Commented:
Hi Ray_Adams

I have added new question

Rajni

Author

Commented:
thanx a lot

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial