RussianDelphiProgrammingAlliance

---

Главная | О проекте | Новости | Статьи | Проекты | Исходники | Файлы | ЧаВо | Ссылки

FAQ - ЧаВо
Полезно для проектов

Создать ярлык объекта в любой папке	Получить файл
Обработка исключительных ситуаций	Получить файл
Избегание повторного запуска	Получить файл
Действующий URL на форме	Получить файл

---

Создать ярлык объекта в любой папке
procedure TForm1.Button1Click(Sender: TObject);
var
MyObject : IUnknown;
MyIcon : IShellLink;
MyPFile : IPersistFile;
FileName : String;
Directory : String;
WFileName : WideString;
MyReg : TRegIniFile;
begin
MyObject := CreateComObject(CLSID_ShellLink);
MyIcon := MyObject as IShellLink;
MyPFile := MyObject as IPersistFile;
FileName := 'C:\Project.exe'; //Указать что является запускающей программой
with MyIcon do begin
SetArguments('C:\Project.exe'); // Какой файл подвергаеться воздействию запускающей программы
SetPath(PChar(FileName)); //Установить путь к запускающему файлу
SetWorkingDirectory(PChar(ExtractFilePath(FileName))); // Установить рабочую директорию
end;
MyReg := TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\Explorer');

{Begin_Чтобы положить ярлык на Desktop}
Directory := MyReg.ReadString('Shell Folders','Desktop','');
{End_Чтобы положить ярлык на Desktop}

{Begin_Чтобы положить ярлык в start menu}
//{Directory := MyReg.ReadString('Shell Folders','Start Menu','')+'\Whoa!'; //CreateDir(Directory);
{End_Чтобы положить ярлык в start menu}

{Begin_Чтобы положить ярлык в любую директор.}
//Directory := 'c:\windows\desktop';
{End_Чтобы положить ярлык в любую директор.}

WFileName := Directory+'/ShortCut1.lnk';
MyPFile.Save(PWChar(WFileName),False);
MyReg.Free;
end;
К оглавлению

---

Обработка исключительных ситуаций
program Project1;
uses
Forms,
dialogs, //добавленно в ручную
Sysutils, //добавленно в ручную
Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}
Type
TExceptclass = class
public
procedure GlobalException(sender:Tobject;e:exception);
end;
procedure TexceptClass.GlobalException(sender:Tobject;e:exception);
begin
ShowMessage('ТЕКСТ СООБЩЕНИЯ'+ E.ClassName+':'+E.Message+#13#10'ВСЕ ПЛОХО' )
end;
Begin
with TExceptClass.Create do
begin
Application.OnException:=GlobalException;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end;
end.
К оглавлению

---

Избегание повторного запуска
procedure TForm1.FormCreate(Sender: TObject);
VAR
Wnd : hWnd;
buff: ARRAY [0..127] OF Char;
d:string;
begin
Application.ShowMainForm:=false;
Wnd := GetWindow(Handle, gw_HWndFirst);
WHILE Wnd <> 0 DO BEGIN {Пропускаем в поиске}
IF IsWindowVisible(Wnd) AND {-Невидимые окна}
(GetWindow(Wnd, gw_Owner) = 0) AND {-Дочернии окна}
(GetWindowText(Wnd, buff, sizeof(buff)) <> 0) {-Окна без заголовков}
THEN BEGIN
GetWindowText(Wnd, buff, sizeof(buff));
d:=(StrPas(buff));
if d=application.Title then
if Application.MessageBox('эта программа уже запущена'+#13+ 'запустить еще одну', 'предупреждение',MB_YESNO) = IDNO then
Application.Terminate;

END;
Wnd := GetWindow(Wnd, gw_hWndNext);
END;
application.ShowMainForm:=True;
end;
К оглавлению

---

Дейcтвующий URL на форме
ShellExecute(0, nil, 'mailto:adress@to.mail',nil, nil, sw_ShowNormal);
К оглавлению

---

Обязанности по поддержанию порядка и обновления этой страницы лежат на Diamond Cat.

Последнее обновление - 15 октября 1999

---

Чужая реклама:

InterReklama Advertising Network