Отправляет email-рассылки с помощью сервиса Sendsay

Программирование на Delphi

  Все выпуски  

Программирование на DELPHI в вопросах и ответах #15


Информационный Канал Subscribe.Ru

Программирование на Delphi
Программирование на Delphi. Выпуск №15 от 10.01.05.


Приветствую Вас, уважаемые читатели!

Те, кто отвечают на вопросы, задаваемые в нашей рассылке, знают, что после отправки ответа приходит сообщение, в котором указано, на сколько баллов был оценен ваш ответ, а также общее количество баллов на вашем счету. Эти сообщения имели такой вид:

Добрый день, <имя>.
<укороченный текст ответа>
За ваш ответ начислено баллов: X.
Всего на вашем счету баллов: Y.

Теперь формат этих сообщений несколько изменён и упрощён. Они имеют вид:

<номер вопроса> - X, Y.

Таким образом, сообщения сократятся до одной строки. Просто решил всех предупредить, чтобы не возникло непониманий.

Наш конкурс продолжается! Напомню вкратце его правила. Найдите на нашем сайте на одной из страниц секретный текст и расшифруйте его. Зашифрован он был без каких-либо программ. Затем пришлите его нам по этой ссылке. Первые 10 правильно ответивших читателей получат на свой счёт 25 баллов, а в конце февраля читатель, набравший наибольшее количество баллов, получит в подарок CD! Желаю удачи!

Top-3 (читатели, лидирующие по кол-ву баллов).

1.
73 балла
2.
48 баллов
3.
43 балла

Правила нашей рассылки:
1. Не присылайте ответов на вопросы вроде "да я не знаю" или "да/нет". Такие ответы не публикуются.
2. Вопросы, не касающиеся Delphi, не принимаются (для этого существуют другие рассылки).
3. Запрещено присылать вложенные файлы, размером более 100 Кб, без предварительной связи с администратором.
4. Не изменяйте тем присылаемых писем. Письма с "неправильными" темами не публикуются!


Новые вопросы.

44. Подскажите ссылки на ресурсы, где можно скачать много исходников, компонентов для Delphi. [Ответить].

45. Необходимо сделать, чтобы при нажатии кнопки запускался файл, типа как в пиратских автозапусках. Как это делается? Имеется ввиду .EXE файл, хотя, думаю, другие запускаются также. [Ответить].

46. Как заставить вызов функции (InetIsOffline)из URL.DLL повторятся через N-ое кол-во времени пока значение InetIsOffline не будет FALSE? Эта функция возвращает TRUE если соед-ие отсутствует Вот примерно так: procedure TForm1.Timer1Timer(Sender: TObject); begin if InetIsOffline(0) then {повторяется вызов} else {идёт дальнейшее выполнение кода программы} [Ответить].

47. Никак не могу понять, как сделать в TreeView так, чтобы значок у раскрытой (SelectedIndex) ветки не менялся на значок нераскрытой (ImageIndex) ветки при выделении дочерней ветки. Надеюсь, кто-нибудь поймет, что мне нужно ;) [Ответить].

48. Подскажите пожалуйста, как передать канву TСanvas в TMetafileCanvas для записи в EMF? Хочу потом дополнительно обработать рисунок в Corel. [Ответить].


Ответы на вопросы.

32. (Вывод времени в статусбаре). [Отвечает: Iron Monk]: Не знаю, как с элегантностью решения, но время в статусбар можно вывести с помощью создания класса. В данном примере можно редактировать формат даты и времени по своему вкусу:
unit Unit1;
interface

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

type
TMyClock = class;
TClockChanged = procedure(ADateTime : TDateTime ) of object;
TForm1 = class(TForm)
StatusBar1: TStatusBar;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
ClockThread : TMyClock;
Procedure ClockChanged( ADateTime : TDateTime );
public
{ Public declarations }
end;

TMyClock = class(TThread)
private
FOnClockChanged : TClockChanged;
protected
procedure Execute; override;
public
property OnClockChanged : TClockChanged read
FOnClockChanged write FOnClockChanged;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

{ TMyClock}

procedure TMyClock.Execute;
begin
while( Not Terminated ) do
begin
if( Assigned(FOnClockChanged)) then
FOnClockChanged( Now );
Sleep(1000);
end;
end;

procedure TForm1.ClockChanged(ADateTime: TDateTime);
begin
StatusBar1.SimpleText := FormatDateTime
( 'hh:nn:ss AMPM dd/mm/yyyy', ADateTime );
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ClockThread := TMyClock.Create( False );
ClockThread.OnClockChanged := ClockChanged;
end;
end.

[Отвечает: Den]: Это и есть элегантное решение.

41. (Иконки в пунктах PopupMenu). [Отвечает: Юрий Кременецкий]: Все просто. Вешаешь на форму ImageList. Туда добавляешь нужные иконки. В PopupMenu.Images цепляешь этот ImageList И в нужном MenuItem в свойстве ImageIndex выбираешь нужную иконку... Вроде все.

[Отвечает: Iron Monk]: В новом проекте на форму кидаем PopupMenu1 и ImageList1, в свойствах PopupMenu1(Images) - добавляем ImageList1. В ImageList1 загружаем иконки, в свойствах PopupMenu1(Items(ImageIndex)) - выбираем нужную иконку. И не забудь в свойстве Form1(PopupMenu) добавить PopupMenu1.

[Отвечает: Dasha]: В свойствах пункта меню есть Bitmap, туда и ставь.

[Отвечает: Dron]: Ну это очень легко! Практически точно также, как и для TMainMenu. Создай PopupMenu, свяжи его с каким-нибудь контролом через свойство PopupMenu. Сделай пункты, запрограммируй их. Положи на форму TImageList (Win32). Добавь в него все необходимые изображения (иконки). У PopupMenu в Images выбери имя созданного ImageList. Он таким образом подключится к твоему меню. Затем выбери любой пункт меню и в свойстве ImageIndex поставь число-индекс необходимой иконки (номера начинаются с нуля). Вот и всё...

[Отвечает: Садовников Владимир]: Ну это совсем не сложно: пихаешь на форму ImageList, загружаешь иконки, которые тебе надо пихнуть в пункт меню, после чего в свойстве Images выбираешь твой ImageList. Теперь для каждого пункта меню можно задать значение ImageIndex, по которому будет рисоваться иконка напротив текста.

42. (Определение имени по IP-адресу и наоборот). [Отвечает: Iron Monk]: Имя по IP адресу:
uses winsock;

function IPAddrToName(IPAddr : String): String;
var
SockAddrIn: TSockAddrIn;
HostEnt: PHostEnt;
WSAData: TWSAData;
begin
WSAStartup($101, WSAData);
SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(IPAddr));
HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
if HostEnt<>nil then
begin
result:=StrPas(Hostent^.h_name)
end
else
begin
result:='';
end;
end;
// Вызывать так:

procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption:=IPAddrToName(Edit1.Text);
end;

---------------------------------------------------------------

IP адрес по имени:

uses Winsock;

function NameToIP(Name: string; var Ip: string): Boolean;
var
wsdata : TWSAData;
hostName : array [0..255] of char;
hostEnt : PHostEnt;
addr : PChar;
begin
WSAStartup ($0101, wsdata);
try
gethostname (hostName, sizeof (hostName));
StrPCopy(hostName, Name);
hostEnt := gethostbyname (hostName);
if Assigned (hostEnt) then
if Assigned (hostEnt^.h_addr_list) then begin
addr := hostEnt^.h_addr_list^;
if Assigned (addr) then begin
IP := Format ('%d.%d.%d.%d', [byte (addr [0]),
byte (addr [1]), byte (addr [2]), byte (addr [3])]);
Result := True;
end
else
Result := False;
end
else
Result := False
else begin
Result := False;
end;
finally
WSACleanup;
end
end;

// Вызываем так:

procedure TForm1.Button1Click(Sender: TObject);
var
IP:string;
begin
if NameToIP(Edit1.Text,IP) then;
Edit2.Text:=IP ;
end;
end.

[Отвечает: yga72]: Это можно сделать с помощью NetBios так: (я нашёл это в интернете, немного переработал, и это действительно работает вполне нормально):

unit ygaMAC;

interface

function ygaGetMAC(const IP: string): string; // только IP, а не имя!!!

implementation

uses
NB30,
Windows,
SysUtils;

type
TAdapterStatus = record
adapter_address: array [0..5] of byte;
filler: array [1..4 * SizeOf(char) + 19 * SizeOf(Word) + 3 * SizeOf(DWORD)] of Byte;
end;

function IsNetConnect: Boolean;
begin
if GetSystemMetrics(SM_NETWORK) and $01 = $01 then Result := True
else
Result := False;
end;{function}

function AdapterToString(Adapter: TAdapterStatus): string;
begin
with Adapter do Result :=
IntToHex(adapter_address[0], 2)+':'+IntToHex(adapter_address[1], 2)+':'+IntToHex(adapter_address[2], 2)+':'+
IntToHex(adapter_address[3], 2)+':'+IntToHex(adapter_address[4], 2)+':'+IntToHex(adapter_address[5], 2)
end;{function}

function ygaGetMAC(const IP: string): string;
const
NCBNAMSZ = 16; // absolute length of a net name
MAX_LANA = 254; // lana's in range 0 to MAX_LANA inclusive
NRC_GOODRET = $00; // good return
NCBASTAT = $33; // NCB ADAPTER STATUS
NCBRESET = $32; // NCB RESET
NCBENUM = $37; // NCB ENUMERATE LANA NUMBERS
type
PNCB = ^TNCB;
TNCBPostProc = procedure(P: PNCB);
stdcall;
TNCB = record
ncb_command: Byte;
ncb_retcode: Byte;
ncb_lsn: Byte;
ncb_num: Byte;
ncb_buffer: PChar;
ncb_length: Word;
ncb_callname: array [0..NCBNAMSZ - 1] of char;
ncb_name: array [0..NCBNAMSZ - 1] of char;
ncb_rto: Byte;
ncb_sto: Byte;
ncb_post: TNCBPostProc;
ncb_lana_num: Byte;
ncb_cmd_cplt: Byte;
ncb_reserve: array [0..9] of char;
ncb_event: THandle;
end;
PLanaEnum = ^TLanaEnum;
TLanaEnum = record
Length: Byte;
lana: array [0..MAX_LANA] of Byte;
end;
ASTAT = record
adapt: TAdapterStatus;
namebuf: array [0..29] of TNameBuffer;
end;
var
NCB: TNCB;
Enum: TLanaEnum;
I: integer;
Adapter: ASTAT;
begin
Result := '';
FillChar(NCB, SizeOf(NCB), #0);
NCB.ncb_command := NCBENUM;
NCB.ncb_buffer := Pointer(@Enum);
NCB.ncb_length := SizeOf(Enum);
if Word(NetBios(@NCB)) = NRC_GOODRET then
begin
for I := 0 to Ord(Enum.Length) - 1 do
begin
FillChar(NCB, SizeOf(TNCB), #0);
NCB.ncb_command := NCBRESET;
NCB.ncb_lana_num := Enum.lana[I];
if Word(NetBios(@NCB)) = NRC_GOODRET then
begin
FillChar(NCB, SizeOf(TNCB), #0);
NCB.ncb_command := NCBASTAT;
NCB.ncb_lana_num := Enum.lana[i];
StrLCopy(NCB.ncb_callname, PChar(IP), NCBNAMSZ);
StrPCopy(@NCB.ncb_callname[Length(IP)], StringOfChar(' ', NCBNAMSZ - Length(IP)));
NCB.ncb_buffer := PChar(@Adapter);
NCB.ncb_length := SizeOf(Adapter);
if Word(NetBios(@NCB)) = NRC_GOODRET then
begin
Result := AdapterToString(Adapter.adapt);
Exit;
end;
end;
end;
end;
end;

end.

43. (Генерация паролей). [Отвечает: Iron Monk]: В программе генерируются пароли размером от 4 до 30 символов, для генерации используются цифры и английские ПРОПИСНЫЕ и строчные буквы. Для изменения символов для генерации, в исходнике необходимо изменить или добавить массив по подобию и добавить возможность выбора, например, с помощью CheckBox. [Исходники: http://www.delphi-faq.fatal.ru/answers/1000/100/50/PassGen.rar].

[Отвечает: Dasha]: Создаешь массив символов, из которых хочешь создать пароль (например, на форме добавляешь их в ListBox, а потом записываешь в массив). После этого Random-ом вытаскиваешь из этого массива нужное количество символов, и все.

[Отвечает: Садовников Владимир]: Самое простое - обращаться с твоей строкой-паролем как "с числом". То есть строка, в которой перечисляются символы - цифры твоей системы счисления. А результирующая строка - твоё "число". Случайная генерация (S-набор "цифр"):

function GeneratePass(S:string;Length:Integer):string;
var
I:Integer;
begin
Result:='';
for I:=1 to Length do
Result:=Result+S[Random(Length(S))+1];
end;

Инкремент текущего пароля "на единицу":

procedure IncPassword(S:string;Passwd:string);
var
I:Integer;
SF:Boolean;
begin
I:=Length(Passwd)+1;
repeat
Dec(I);
SF:=False;

if (Passwd[I]=S[Length(S)]) then
begin
Passwd[I]:=S[1];
SF:=True;
end
else
Passwd[I]:=S[Pos(Passwd[I],S)+1];
until (not SF) or (I=1);
end;

28. (Воспроизведение фоновой музыки и звуков одновременно с помощью функции PlaySound). [Отвечает: Iron Monk]: Всем привет! {$R Wave.res} // подключаем наш файл с .wav ресурсами...

uses MMSystem;
//Фоновый звук из ресурса
procedure BackgroundSound(WAVE:PAnsiChar);
var
FindHandle, ResHandle: THandle;
ResPtr: Pointer;
begin
FindHandle := FindResource(HInstance, WAVE, RT_RCDATA);
if FindHandle <> 0 then
begin
ResHandle := LoadResource(HInstance, FindHandle);
if ResHandle <> 0 then
begin
ResPtr := LockResource(ResHandle);
if ResPtr <> nil then
sndPlaySound(PChar(ResPtr), SND_LOOP // флаг SND_LOOP -звук в цикле
or SND_ASYNC or SND_MEMORY );
UnlockResource(ResHandle);
end;
FreeResource(FindHandle);
end;
end;

// Выводим фоновый звук из ресурса при активации приложения
procedure TForm1.FormActivate(Sender: TObject);
begin
BackgroundSound('FON'); //'FON' - имя нашего ресурса
end;

// эта процедура позволяет воспроизводить сразу несколько звуков
// во многих форматах
procedure SendMCICommand(Cmd: string);
var
RetVal: Integer;
ErrMsg: array[0..254] of char;
begin
RetVal := mciSendString(PChar(Cmd), nil, 0, 0);
if RetVal <> 0 then
begin
mciGetErrorString(RetVal, ErrMsg, 255);
MessageDlg(StrPas(ErrMsg), mtError, [mbOK], 0);
end;
end;

procedure Sound(SoundFile:string);
begin
SendMCICommand('open waveaudio shareable');
SendMCICommand('play "'+SoundFile+'"');
SendMCICommand('close waveaudio');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Sound('C:\WINDOWS\Media\tada.wav'); // воспроизводим один звук
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Sound('D:\autorun.mp3'); // воспроизводим другой звук
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Sound('C:\WINDOWS\Media\ringout.wav'); // воспроизводим третий звук
end;
end.

33. (Отслеживание поведения дисплея). [Отвечает: Iron Monk]: В Delphi средств, позволяющих отслеживать поведение дисплея - полно: Вот они из модуля Windows.pas:
=========================
{ Device Parameters for GetDeviceCaps() }
{$EXTERNALSYM DRIVERVERSION}
DRIVERVERSION = 0; { Device driver version }
{$EXTERNALSYM TECHNOLOGY}
TECHNOLOGY = 2; { Device classification }
{$EXTERNALSYM HORZSIZE}
HORZSIZE = 4; { Horizontal size in millimeters }
{$EXTERNALSYM VERTSIZE}
VERTSIZE = 6; { Vertical size in millimeters }
{$EXTERNALSYM HORZRES}
HORZRES = 8; { Horizontal width in pixels }
{$EXTERNALSYM VERTRES}
VERTRES = 10; { Vertical height in pixels }
{$EXTERNALSYM BITSPIXEL}
BITSPIXEL = 12; { Number of bits per pixel }
{$EXTERNALSYM PLANES}
PLANES = 14; { Number of planes }
{$EXTERNALSYM NUMBRUSHES}
NUMBRUSHES = $10; { Number of brushes the device has }
{$EXTERNALSYM NUMPENS}
NUMPENS = 18; { Number of pens the device has }
{$EXTERNALSYM NUMMARKERS}
NUMMARKERS = 20; { Number of markers the device has }
{$EXTERNALSYM NUMFONTS}
NUMFONTS = 22; { Number of fonts the device has }
{$EXTERNALSYM NUMCOLORS}
NUMCOLORS = 24; { Number of colors the device supports }
{$EXTERNALSYM PDEVICESIZE}
PDEVICESIZE = 26; { Size required for device descriptor }
{$EXTERNALSYM CURVECAPS}
CURVECAPS = 28; { Curve capabilities }
{$EXTERNALSYM LINECAPS}
LINECAPS = 30; { Line capabilities }
{$EXTERNALSYM POLYGONALCAPS}
POLYGONALCAPS = $20; { Polygonal capabilities }
{$EXTERNALSYM TEXTCAPS}
TEXTCAPS = 34; { Text capabilities }
{$EXTERNALSYM CLIPCAPS}
CLIPCAPS = 36; { Clipping capabilities }
{$EXTERNALSYM RASTERCAPS}
RASTERCAPS = 38; { Bitblt capabilities }
{$EXTERNALSYM ASPECTX}
ASPECTX = 40; { Length of the X leg }
{$EXTERNALSYM ASPECTY}
ASPECTY = 42; { Length of the Y leg }
{$EXTERNALSYM ASPECTXY}
ASPECTXY = 44; { Length of the hypotenuse }
{$EXTERNALSYM SHADEBLENDCAPS}
SHADEBLENDCAPS = 45; { Shading and Blending caps }

{$EXTERNALSYM LOGPIXELSX}
LOGPIXELSX = 88; { Logical pixelsinch in X }
{$EXTERNALSYM LOGPIXELSY}
LOGPIXELSY = 90; { Logical pixelsinch in Y }

{$EXTERNALSYM SIZEPALETTE}
SIZEPALETTE = 104; { Number of entries in physical palette }
{$EXTERNALSYM NUMRESERVED}
NUMRESERVED = 106; { Number of reserved entries in palette }
{$EXTERNALSYM COLORRES}
COLORRES = 108; { Actual color resolution }

{ Printing related DeviceCaps. These replace the appropriate Escapes }
{$EXTERNALSYM PHYSICALWIDTH}
PHYSICALWIDTH = 110; { Physical Width in device units }
{$EXTERNALSYM PHYSICALHEIGHT}
PHYSICALHEIGHT = 111; { Physical Height in device units }
{$EXTERNALSYM PHYSICALOFFSETX}
PHYSICALOFFSETX = 112; { Physical Printable Area x margin }
{$EXTERNALSYM PHYSICALOFFSETY}
PHYSICALOFFSETY = 113; { Physical Printable Area y margin }
{$EXTERNALSYM SCALINGFACTORX}
SCALINGFACTORX = 114; { Scaling factor x }
{$EXTERNALSYM SCALINGFACTORY}
SCALINGFACTORY = 115; { Scaling factor y }

{ Display driver specific}
{$EXTERNALSYM VREFRESH}
VREFRESH = 116; { Current vertical refresh rate of the }
{ display device (for displays only) in Hz}
{$EXTERNALSYM DESKTOPVERTRES}
DESKTOPVERTRES = 117; { Horizontal width of entire desktop in }
{ pixels }
{$EXTERNALSYM DESKTOPHORZRES}
DESKTOPHORZRES = 118; { Vertical height of entire desktop in }
{ pixels }
{$EXTERNALSYM BLTALIGNMENT}
BLTALIGNMENT = 119; { Preferred blt alignment }
-------------------------------------------------------------------------------------------------------------------------
А это - пример использования. Процедура которая возвращает частоту обновления монитора.
------------------------------------
procedure RefrMonitor;
var
DC: hDC;
Refr:word;
begin
DC := CreateDC('DISPLAY', nil, nil, nil);
Refr:=GetDeviceCaps(DC,VREFRESH);
end;
-------------------------------------

14. (Управление принтерами). [Отвечает: Iron Monk]: Всем привет! Я не стал особо загружать демо - программку, но основные функции в ней есть: Находит доступные принтеры и изменяет принтер "по умолчанию", показывает очередь печати принтера, отправляет текст на печать на выбранный принтер. Для тестирования можно установить несколько виртуальных принтеров. [Исходник - http://www.delphi-faq.fatal.ru/answers/1000/100/20/printer.rar].

25. (Сохранение параметров цвета в INI-файл, ресурсы в DLL.). [Отвечает: Den]:

Параметры цвета в ini можно хранить напрямую в целочисленном эквиваленте, а компоненте в свойтво цвета присваивать это значение (цвет для компонента может принемать разные значения - clRed, clInfoBk, 16777215 или 16-ое представление этого числа). Насчет jpg в DLL, проше хранить все ресурсе, а его пусть использует и основная прога и DLL.

29. ("Рисование" на кнопке "Пуск"). [Отвечает: Den]: Кнопка "Пуск" - есть не что иное, как окно прижатое к нижнему левому краю, на этом окне лежит одна картинка и настроены пару событий. 1. Поверх этого окна кладешь свое и делай с ним что хочеш. 2. Через WinAPI подаешь системному окну "Пуск", команду...

35. (БД в каталоге приложения). [Отвечает: Den]: В проге при подключении к БД используй ADOConnection, при загрузке проги из .ини читай коталог с БД, имя и что еще хочешь. Затем собирай из этого CjnnectionString компонента и конектися к БД, перед закрытием проги сохрани все это в .ини

36. (Единый курсор для всех компонентов формы). [Отвечает: Den]: Очень просто, Screen.Cursor := LoadFromFile(... параметры ...); Параметры узнаешь в хелпе, в файле курсора можно подставить свой анимированный...


Вы также можете ответить на предыдущие вопросы. Поскольку на них уже ответили как минимум раз, они больше не публикуются в рассылке. Но если вы можете что-то добавить к ответам других, пожалуйста, отвечайте - ответы будут опубликованы. Найти предыдущие вопросы вы можете на нашем сайте: http://www.delphi-faq.fatal.ru/ или в спец-выпусках рассылки.


Статья по Delphi.

Написание инсталлятора на Delphi (Часть 8).

Создание группы программ (продолжение)

Теперь мы подробнее остановимся на создании группы программ средствами Проводника. Дело в том, что меню, которое вы видите, нажав на кнопку Пуск, хранится на диске в виде обычных каталогов и файлов.

Для того, чтобы создать группу, мы должны всего лишь создать каталог; для того, чтобы создать элемент — скопировать файл в каталог или создать ярлык на существующую программу. Что такое ярлык? Ярлык — это файл с расширением .LNK, в котором хранится информация о каком-то другом файле. Для операционной системы ярлык олицетворяет собой файл, на который он ссылается.

Для чего применяются ярлыки? Для того, чтобы вам не нужно было хранить на своём диске несколько одинаковых файлов. Например, программа WinZip во время инсталляции помещает себя на рабочий стол, в меню Пуск и в меню Программы. Что, вы думаете, файл winzip.exe хранится на диске в трёх экземплярах? Отнюдь.

Учтите, что ярлык занимает на диске где-то 250–400 байт, поэтому для файлов меньшего размера ярлыки создавать бессмысленно.

С этого момента я объявляю ярлыки новой парадигмой создания групп! :) Звучит громко... Нам осталось только выяснить, как это делается. :) Итак, группы менеджера программ доступны нам через кнопку Пуск подменю Программы. В действительности, все они являются подкаталогами, одного из каталогов Windows (это может быть, например, C:\Windows\Главное меню\Программы. Путь к этому каталогу Проводник хранит в реестре (где именно найти эти данные, рассматривалось в одной из предыдущих статей цикла).


procedure ReadGroups(Strings: TStrings);
var
ARegistry: TRegistry;
Programs: String;
SearchRec: TSearchRec;
FindResult: Integer;
begin
Strings.Clear;
// Находим каталог
ARegistry := TRegistry.Create;
with ARegistry do
begin
RootKey := HKEY_CURRENT_USER;
if OpenKey('\Software\Microsoft\Windows\CurrentVersion\Explorer\ Shell Folders', False) then
begin
Programs := ReadString('Programs');
CloseKey;
end
else
Programs := '';
Free;
end;
if (Length(Programs) > 0) and (Programs[Length(Programs)] <> '\') then
Programs := Programs + '\';
// Читаем содержимое каталога
FindResult := FindFirst(Programs + '*.*', faDirectory, SearchRec);
while FindResult = 0 do
begin
with SearchRec do
if (Name <> '.') and (Name <> '..') and (Attr and faDirectory <> 0) then
Strings.Add(Name);
FindResult := FindNext(SearchRec);
end;
FindClose(SearchRec);
end;

Точно таким же макаром можно прочитать содержимое любой группы. Достаточно очевидно делаются такие вещи, как создать группу, удалить группу, переименовать (!) группу и так далее. Более того, теперь вы можете создавать группы в меню Пуск и на рабочем столе (в статье о системном реестре рассказано как найти путь к этим каталогам). Мы также можем воспользоваться функцией SHGetSpecialFolderLocation для того, чтобы выяснить, где находится тот или иной каталог Проводника.


function GetSpecialFolderLocation(nFolder: Integer): String;
var
ppidl: PItemIDList;
Malloc: IMalloc;
szPath: array[0..MAX_PATH - 1] of Char;
begin
SHGetSpecialFolderLocation(Handle, nFolder, ppidl);
SHGetMalloc(Malloc);
SHGetPathFromIDList(ppidl, szPath);
Malloc.Free(ppidl);
Malloc := nil;
Result := String(szPath);
end;

См. описание функции SHGetSpecialFolderLocation для того, чтобы узнать, какие константы можно использовать в качестве nFolder.

Что нам осталось узнать? Как получить информацию о ярлыке и как создать ярлык. Обе эти операции удобно делать с помощью интерфейса IShellLink, предоставляемого нам Проводником. Об интерфейсах (и связанных с ними COM-объектах) говорить можно долго, однако, для наших целей это не нужно. Нам достаточно знать, что интерфейсы очень напоминают обычне классы, за несколькими исключениями. Вот, например:


const
MAX_DESCRIPTION = 100;
var
Bitmap: TBitmap;
ShellLink: IShellLink;
Description: array[0..MAX_DESCRIPTION - 1] of Char;
begin
// Создаём обычный объект
Bitmap := TBitamp.Create;
// Создаём COM-объект
CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IID_IShellLinkA, ShellLink);
. . .
// Используем обычный объект
Bitmap.Width := 100;
// Используем COM-объект
ShellLink.GetDescription(Description, MAX_DESCRIPTION);
. . .
// Удаляем обычный объект
Bitmap.Free;
// Удаляем COM-объект
ShellLink := nil;
end;

Итак, для того, чтобы создать COM-объект в Дельфи, вы должны вызвать функцию CoCreateInstance, передав её в качестве параметров несколько странного вида констант. COM-объекты автоматически удаляются по завершении процедуры, в которой они были созданы. Тем не менее, я предпочитаю явное указание того факта, что COM-объект должен быть уничтожен:
ShellLink := nil;
Теперь приведу пример, показывающий, как можно создать ярлык на рабочем столе.
var
Desktop: String;
ShellLink: IShellLink;
hRes: HRESULT;
PersistFile: IPersistFile;
begin
// Находим каталог
Desktop := GetSpecialFolderLocation(CSIDL_DESKTOPDIRECTORY);
if (Length(Desktop) > 0) and (Desktop[Length(Desktop)] <> '\') then
Desktop := Desktop + '\';
CoInitialize(nil);
hRes := CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
IID_IShellLinkA, ShellLink);
if SUCCEEDED(hRes) then
begin
ShellLink.SetPath(PChar(Application.ExeName));
ShellLink.SetDescription('Вот моя программа!');
hRes := ShellLink.QueryInterface(IID_IPersistFile, PersistFile);
if SUCCEEDED(hRes) then
begin
PersistFile.Save(PWideChar(WideString(Desktop + 'Моя программа.lnk')), True);
PersistFile := nil;
end;
ShellLink := nil;
end;
CoUninitialize;
end;

Подробнее узнать о том, что можно делать с помощью интерфейса IShellLink вы можете в win32.hlp (ключевое слово — IShellLink :) Вызовы функций CoInitialize и CoUninitialize обеспечивают работу COM, всегда вызывайте первую из них перед работой, а вторую — после работы.

Для работы этих примеров вам потребуется включить (uses) в свой модуль файлы Windows, ShlObj, ActiveX, ShellApi. По недосмотру, или по какой-то другой причине, Инпрайз не внесла константу IID_IPersistFile ни в один из этих файлов. Эту константу можно найти в модуле Ole2, однако этот модуль оставлен в 3-ей и 4-ой версиях Дельфи только в целях совместимости со 2-ой версией, где COM-интерфейсы были реализованы по другому. Я сам уже запутался, честно говоря, объясняя, что здеь к чему :) Если в двух словах, скопируйте эти строчки из модуля Ole2.pas в свою программу и расслабтесь:


const
IID_IPersistFile: TGUID = (
D1:$0000010B;D2:$0000;D3:$0000;D4:
($C0,$00,$00,$00,$00,$00,$00,$46));

Напоследок остановимся на том, какой же метод создания групп лучше? Давайте рассмотрим достоинства и недостатки этих методов.

Менеджер программ достался нам в наследство от 16-битных версий Windows. Он капризен и работает неторопливо. Помимо всего прочего, с помощью него нельзя помещать ярлыки на рабочий стол и в меню Пуск.

С другой стороны, интерфейсы проводника более современны, дают больший контроль за происходящим, работают быстрее... И помимо прочего, заставляют программиста осваивать новую технологии (а если программист ленив, ему такие стимулы необходимы, как воздух :)

И тем не менее — для создания групп в меню Программы я рекомендую вам пользоваться менеджером программ.

Почему?

Потому что менеджер программ, помимо того, что создаёт все необходимые каталоги и ярлыки, отражает изменения в файлах с расширением .GRP. Может оказаться, что некоторые программы (старые) работают с файлами групп, и, следовательно, некорректно будут работать с вашими ярлыками.

Конечно, ситуация, о которой я вам рассказываю, гипотетическая. Я ещё не разу не слышал о каких-бы то ни было действительных нареканиях для способа с IShellLink. В любом случае, решайте сами.

Примечание
Всё, о чём я говорил выше, относится только к группам, ярлыки на рабочем столе или в меню Пуск в любом случае придётся создавать с помощью IShellLink.

Итак, это была предпоследняя статья из цикла "Написание инсталлятора на Delphi". Осталось только рассмотреть процесс деинсталляции (удаления). О нём вы узнаете в следующем выпуске рассылки. Не забывайте, что прислав инсталлятор, который вы напишете своими руками, мы обязательно оценим ваши труды и добавим вам на счёт много баллов, а значит у вас будет больше шансов выиграть CD в конце февраля!

Присылайте свои статьи по адресу delphi-faq@list.ru с темой 'Clause' (без кавычек), и они будут опубликованы в ближайших выпусках рассылки. Большая просьба: статью оформляйте в -txt или -doc формате и используйте -zip или -rar сжатие (без самораспаковки).


Кладовая.

Если вам есть, что добавить в данный раздел, - пишите, щёлкнув по этой ссылке. Только большая просьба: не присылайте файлы сразу! Итак, свежие файлы:

Компоненты:

MSAHCTRL - Microsoft Active Hyper Controls - стандартные компоненты, но ведут себя как гиперссылки.
[Скачать. Размер: 47.3 Кб, ZIP].

GIF - Компонент, с помощью которого вы сможете работать с GIF-изображениями.
[Скачать. Размер: 15.7 Кб, ZIP].

 


Друзья.

Здесь представлены ссылки на дружественные сайты нашего портала. Если вы тоже хотите стать нашим другом, разместите баннер на главной странице своего сайта. Подробнее о том, как стать другом, можно прочитать здесь: http://www.delphi-faq.fatal.ru/banner.htm, а узнать о всех наших друзьях - на странице http://www.delphi-faq.fatal.ru/friends.htm

http://infomania2004.webhost.ru/ - Этот сайт создан для того, чтобы вы могли получить интересующую вас информацию с минимальными затратами сил и времени. Если вы не нашли здесь нужной информации, вы можете оставить заявку на ее поиск. Как только информация будет найдена, она появится на сайте, а вам сообщат об этом.
http://www.basic.webhost.ru/ - Программирование на языках Basic и Visial Basic. На сайте Вы найдете версии Бейсик, игры, вопросы и ответы, статьи, а также многое другое...
http://www.sashook.nm.ru/ - Игры, флешки, обои, компьютерные приколы.
http://www.dcar.nm.ru - У Вас есть компьютер подключённый к интернет? Тогда у Вас есть всё, чтобы делать деньги прямо сейчас. Создайте свою собственную денежную машину.
http://www.x-program.narod.ru/
- На этом сайте Вы найдёте некоторые наши программы. Также мы занимаемся создание ПО для любой версии ОС Windows под заказ.


Юмор.

Заядлый геймер смотрит увлекательный триллер, в самый интригующий момент не выдерживает и кричит главной героине:
- Сохраняйся, дура, пока не поздно!

Программиста спрашивают:
- Почему Ваши дети постоянно ссорятся?
- Конфликт версий.

Маленький мальчик не просто играл -
Вирус компьютерный он сочинял.
Весь Пентагон удивлен неспроста:
Пропали куда-то все файлы с винта.

Один программист другому:
- Представь, что у тебя есть 1000 рублей, или: для круглого счета, давай лучше 1024 рубля...

Ява - сигареты, выпускаемые по лицензии Sun Microsystems.


Присылайте свои "компьютерные" анекдоты по этой ссылке: delphi-faq@list.ru и они обязательно будут опубликованы! Нецензурные анекдоты не публикуются!

Товарищи программисты! Проявляйте свою активность. Давайте помогать друг другу!
Если вы не нашли ответа на свой вопрос, не отчаивайтесь! Ведь количество подписчиков постоянно растёт и, наверняка, найдётся тот человек, который поможет вам!
На сегодня всё. До встречи через неделю!

Сайт рассылки: http://www.delphi-faq.fatal.ru E-mail: Delphi-FAQ@list.ru Рассылка: http://subscribe.ru/catalog/comp.soft.prog.delphifaq


http://subscribe.ru/
http://subscribe.ru/feedback/
Подписан адрес:
Код этой рассылки: comp.soft.prog.delphifaq
Отписаться

В избранное