Program folders

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;

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!!!

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?

Hi Ray_Adams

I have added new question

Rajni

thanx a lot