unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, cpl;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TCPlAppletFunc =
function(
hwndCPl: HWnd; // handle to Control Panel window
uMsg: DWord; // message
lParam1: Longint; // first message parameter
lParam2: Longint // second message parameter
): Longint; stdcall;
var
Form1: TForm1;
implementation
{$R *.dfm}
function LoadStringFromModule(Module: HInst; ID: Integer): string;
const
MaxLen = 2000;
var
Len: Integer;
begin
SetLength(Result, MaxLen);
Len := LoadString(Module, ID, PChar(Result), MaxLen);
if Len > 0 then
SetLength(Result, Len)
else
Result := '';
end;
procedure ShowCPLNameAndDescription(FileName: string; Memo1: TMemo);
var
H: HInst;
CPlApplet: TCPlAppletFunc;
NumberOfApplets: Integer;
AppletInfo: TCPLInfo;
I: Integer;
Name, Desc: string;
begin
// Load CPL
H:= LoadLibrary(PChar(FileName));
if H <> 0 then
try
// Get CPlApplet Function from Module
CPlApplet:= GetProcAddress(H, 'CPlApplet');
if Assigned(CPlApplet) then
begin
// Get Number of Applets contained
NumberOfApplets:= CPlApplet(Application.Handle,
CPL_GetCount, 0, 0);
Memo1.Lines.Add((Format('There are %d Applets in file: ' + FileName,
[NumberOfApplets])));
Memo1.Lines.Add(' -------------------');
// For each Applet in the file
for I:= 0 to NumberOfApplets - 1 do
begin
// Get Name and Desription
CPlApplet(Application.Handle, CPL_INQUIRE, I,
Longint(@AppletInfo));
Name:= LoadStringFromModule(H, AppletInfo.idName);
Desc:= LoadStringFromModule(H, AppletInfo.idInfo);
// And display them
Memo1.Lines.Add(Format('Applet No %d: %s / %s',
[I, Name, Desc]));
end;
end;
finally
// Unload CPL
FreeLibrary(H);
end;
end;
procedure GetFileList( FileList: TStringList; inDir, Extension : String );
procedure processSearchRec( aSearchRec : TSearchRec );
begin
if ( aSearchRec.Attr and faDirectory ) <> 0 then
begin
if ( aSearchRec.Name <> '.' ) and
( aSearchRec.Name <> '..' ) then
begin
FileList.Add( aSearchRec.Name );
GetFileList( FileList, Extension, InDir + '\' + aSearchRec.Name );
end;
end
else
FileList.Add( aSearchRec.Name );
end;
var CurDir : String;
aSearchRec : TSearchRec;
begin
CurDir := inDir + '\*.' + Extension;
if FindFirst( CurDir, faAnyFile, aSearchRec ) = 0 then
begin
ProcessSearchRec( aSearchRec );
while FindNext( aSearchRec ) = 0 do
ProcessSearchRec( aSearchRec );
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
FL: TStringList;
i : Integer;
begin
Memo1.Lines.Clear;
FL := TStringList.Create;
try
GetFileList( FL, 'c:\winnt\system32', 'cpl' );
for i := 0 to Pred(FL.Count) do
ShowCPLNameAndDescription(fl.Strings[i], Memo1);
finally
FL.Free;
end;
end;
end. |
|
