Переезд

Блог переезжает на новый хостинг и будет доступен по адресу http://delphiblog.ru. Все новые статьи теперь будут публиковаться только там. К существующим статьям будут добавлены исходники примеров. Оставайтесь с нами)

Читать дальше >>

Поздравьте своих любимых!

    Господа программисты! Вы на календарь хоть изредка поглядываете? Нет? Так наведите мышкой на часики, которые обычно находятся справа-внизу экрана. Появилась подсказка? Ага… 12 февраля 2008 года (если конечно вы для обхождения триала не переводили дату). Год нам не важен, а вот на число и месяц обратите особое внимание. Скоро будет… нет, 23 февраля тоже скоро будет, но до него еще есть 14 февраля - День Святого Валентина. Надо бы поздравить свою вторую половинку. Разумеется, вы лучше меня знаете, как это сделать, но, если позволите, я подкину вам небольшое дополнение к поздравлению. Программа-валентинка, простенькая, на Delphi, попалась мне при просмотре форума на http://delphimaster.ru. Автор - Dmitry S. Надеюсь, он простит мне маленький пиар его творения.
Сама программа может послужить примером полупрозрачности, проигрывания midi, создания окон, работы с ресурсами.
    На Блоггере файлы размещать нельзя, так что пока я не обзавелся нормальным хостингов (что будет, надеюсь, скоро), файлы буду хранить на народе. Валентинку можете скачать отсюда: http://ivanfdc.narod.ru/download.html или http://argi.ru/upload/heart3-w.rar. 225 КБ. В архиве исходники + сама программа. Текст меняется в модуле WindowMessage.pas.

Читать дальше >>

Сделай сам: IE и Delphi – вместе веселее!

    Сегодня мы займёмся самым популярным web-браузером в мире – Internet Explorer'ом. Кто-то обожает эту программу, кто-то терпеть её не может, но, как ни крути, пока что ни один конкурент IE не может приблизиться к нему по возможностям (не считая, конечно, браузеров, построенных на движке IE). Итак, что мы будем делать с IE? Да ничего страшного… Мы просто научимся управлять им так же, как и любым другим окном. Для закрепления полученных знаний сделаем программу для управления IE при помощи горячих клавиш. Для пущего эффекта добавим иконку программы на Системную панель (SysTray). Итак, поехали…
Первым делом разберёмся с двумя приёмами программирования, которые мы будем использовать и в последующих статьях данного цикла:
1) Как работать с "горячими" клавишами?
2) Как добавить свой значок на Системную Панель (SysTray, можно узнать по характерным для неё часикам)?
На первый вопрос я уже дал частичный ответ в статье Сделай сам: "Вскрывалка паролей", но нам нужно копнуть немного глубже, а второй вопрос мы ещё вообще не затрагивали.

Работа с "горячими" клавишами
Для работы с "горячими" клавишами вполне достаточно использования лишь двух функций:

1) Регистрирует "горячие" клавиши:
BOOL RegisterHotKey(
    HWND hWnd, // этому окну придёт уведомление о нажатии комбинации клавиш
    int id, // идентификатор "горячих" клавиш
    UINT fsModifiers, // должны ли быть нажаты клавиши Ctrl, Shift, Alt или Win
    UINT vk // код клавиши, на которую мы будем реагировать
);
2) Удаляет "горячие" клавиши
BOOL UnregisterHotKey(
    HWND hWnd, // окно, ассоциированное с "горячими" клавишами
    int id // идентификатор "горячих" клавиш
);

  Всё бы ничего, да вот при работе с "горячими" клавишами из DLL (динамически подключаемой библиотеки) могут возникнуть проблемы с идентификаторами. Чтобы этого избежать следует использовать функцию GlobalAddAtom, которая возвратит нам уникальный идентификатор (атом) требуемого формата. После завершения работы с "горячими" клавишами атом нужно удалить при помощи функции GlobalDeleteAtom. Работу с атомами мы рассмотрим в одной из следующих статей, где будем использовать DLL.
Помещение своей иконки в SysTray
Бывают такие программы, которые постоянно должны быть активны в системе. Они довольно часто помещают свой значок на Системную панель, чтобы не надоедать пользователю присутствием своего окна и в то же время оставить возможность "достучаться" до программы. Для управления иконкой на Системной панели используется функция
Shell_NotifyIcon(dwMessage: DWORD; lpData: PNotifyIconData): BOOL;
dwMessage – сообщение, которое мы посылаем Панели задач, может принимать следующие значения: NIM_ADD – добавить новую иконку, NIM_DELETE – удалить иконку, NIM_MODIFY – изменить иконку.
lpData – указатель на структуру NotifyIconData, которая состоит из следующих полей:
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array [0..63] of AnsiChar;
Пояснения:
cbSize – размер структуры;
Wnd – идентификатор окна, которое будет получать сообщения, ассоциированные с иконкой;
uID – идентификатор иконки, который мы сами ей назначаем;
uFlags – комбинация из трёх флагов, которая обозначает, какие поля структуры мы хотим заполнить: NIF_ICON (хотим заполнить поле hIcon), NIF_MESSAGE (поле uCallbackMessage), NIF_TIP (поле szTip).
uCallbackMessage – определяемый нами идентификатор сообщения, ассоциированного с иконкой;
hIcon – идентификатор иконки;
szTip – текст подсказки к иконке, которая появляется при наведении на неё курсора мышки.
Пример использования функции Shell_NotifyIcon вы найдёте в коде нашей сегодняшней программы.

Настала пора приступить к созданию программы. Она будет выполнять две полезные функции:
1) Закрытие всех окон IE;
2) Переход "Вперёд\Назад" в коллекции некоторых объектов. Всё дело в том, что часто при просмотре какого-либо форума или галереи картинок, ссылки имеют вид "http://anysite/forum.php?page=2". Т.е мы находимся на второй странице форума. Если мы заменим цифру на '1', то попадём на предыдущую страницу, на '3' – на следующую. Примерно по такому принципу мы организуем Переход "Вперёд\Назад".

Закрытие всех окон IE
Предлагаю два способа реализации функции закрытия всех окон IE.
Способ I
Последовательно ищем окна Internet Explorer'a и закрываем их:
procedure CloseAllIE_1;
var
  ie: HWND;
begin
  //ищем окно IE
  ie := FindWindow('IEFrame', nil);
  //пока найдено окно IE…
  while (ie<>0) do
  begin
    //…закрываем его
    postmessage(ie, WM_CLOSE, 0, 0);
    //ищем следующее
    ie := FindWindow('IEFrame', nil);
  end;
end;

Способ II
Перебираем все родительские окна в системе и, если увидели окно IE, то закрываем его. Таким образом, мы совершаем только один проход по окнам, а значит, работает этот способ намного быстрее предыдущего.
procedure CloseAllIE_2;
//эта функция будет применяться к каждому окну
functionCloseIE (Wnd: HWND): boolean; stdcall;
var
  winclass: array [0..255] of char;
begin
  //получаем класс окна
  GetClassName (Wnd, WinClass, sizeof(WinClass));
  //если у нас окно IE, то закрываем его
  if (WinClass='IEFrame') then
  PostMessage (Wnd, WM_CLOSE, 0, 0);
  //принимаем следующее окно
  CloseIE := true;
end;
begin
//перебираем все родительские окна, указывая,
//какой функцией будем их обрабатывать
  EnumWindows(@CloseIE, 0);
end;

Переход "Вперёд\Назад"
Разделим нашу задачу на три составляющие:
1) Получить адрес (URL) текущей странички IE;
2) Увеличить (уменьшить) последнее число адреса на единицу;
3) Записать изменённый адрес в окно IE и заставить браузер перейти по нему.

Пункт 1: получить адрес текущей странички
Окно IE, как и любое порядочное окно, содержит множество дочерних окон (всякие там кнопочки, поля ввода, надписи и т.д.). В одном из таких окон содержится URL странички. После недолгого изучения иерархии окон в IE при помощи специальной программы, добраться до адреса совсем несложно. Следующая функция возвращает идентификатор поля ввода (класс 'Edit'), в котором содержится URL:

function FindEdit(var h:hwnd):boolean;
var
  wclass: array[0..255] of char;
begin
  //получаем идентификатор и класс "верхнего" окна
  h := getforegroundwindow;
  getclassname(h, wclass, sizeof(wclass));
  //если это окно IE, то "распутываем" иерархию дочерних окон
  if (wclass='IEFrame') then
  begin
    h := findwindowex(h, 0, 'WorkerA', nil);
    h := findwindowex(h, 0, 'ReBarWindow32', nil);
    h := findwindowex(h, 0, 'ComboBoxEx32', nil);
    h := findwindowex(h, 0, 'ComboBox', nil);
    h := findwindowex(h, 0, 'Edit', nil);
    result := true;
  end else
    result := false;
end;

После того, как мы добрались до поля ввода, в котором хранится адрес странички, извлечём его при помощи следующей функции:
function GetText(WindowHandle: hwnd): String;
var
  txtLength: Integer;
  buffer: String;
begin
  //Узнаём длину текста
  TxtLength := SendMessage(WindowHandle, WM_GETTEXTLENGTH, 0, 0);
  if (txtlength>0) then
  begin
    txtlength := txtlength + 1;
    setlength (buffer, txtlength);
    //записываем текст окна в buffer
    sendmessage(WindowHandle, wm_gettext, txtlength, longint(@buffer[1]));
    result := buffer;
  end else result := '';
end;

Таким образом, чтобы узнать текущий адрес в IE, достаточно применить эти две функции:
…
FindEdit(h);
Adress := GetText(h);
…
Пункт 2: Увеличить (уменьшить) последнее число адреса на единицу
Здесь нам потребуется только умение оперировать со строками и знание основ арифметики.
//увеличение последнего числа в строке s
function IncURL(s:string): String;
const
  num = ['0'..'9'];
var
  i,  j, cnt: word;
  plus, ch: byte;
  code: integer;
  s1: string;
begin
  i := length(s);
  plus := 0;
  //ищем первую цифру с конца
  while (i>0) and not(s[i] in num) do
    dec(i);
  //если нашли…
  if (i<>0) then
  begin
    //считаем количество девяток, которыми кончается число
    cnt := 0;
    while (i>0) and (s[i]='9') do
    begin
      dec(i);
      inc(cnt);
    end;
    if (i=0) or not( s[i] in num) then
    begin
      ch := 0;
    {если число сплошь состоит из девяток, то мы должны первой цифрой сделать '1' и заменить все девятки на нули}
      if not(s[i] in num) then
        plus := 1;
    end else
      val(s[i], ch, code);
    inc(ch);
    str(ch, s1);
    if (cnt>0) then
      //заменяем последние девятки на нули
      for j := 1 to cnt do
        s1 := s1 + '0';
    //составляем итоговую строку
    s := copy(s, 1, i-1+plus)+s1+copy(s, i+cnt+1, length(s)-i-cnt);
  end;
  result := s;
end;

//уменьшение последнего числа в строке s
function DecURL(s:string):string;
const
  num = ['0'..'9'];
var
  i, j, cnt: word;
  minus, ch: byte;
  code: integer;
  s1: string;
begin
  i := length(s);
  minus := 0;
  //ищем последнюю цифру в строке
  while (i>0) and not (s[i] in num) do
    dec(i);
  if (i<>0) then
  begin
    cnt := 0;
    //считаем количество нулей
    while (i>0) and(s[i]='0') do
    begin
      dec(i);
      inc(cnt);
    end;
    if (i>0) and (s[i] in num) then
    begin
      val(s[i],ch,code);
      dec(ch);
      if (ch=0) and (i>0) and not(s[i-1] in num) then
        s1 := ''
      else
        str(ch, s1);
      if (cnt>0) then
        //заменяем последние нули на девятки
        for j := 1 to cnt do
          s1 := s1 + '9';
      //составляем итоговый URL
      s := copy(s, 1, i-1-minus) + s1 + copy(s, i+cnt+1, length(s)-i-cnt);
    end;
  end;
  result := s;
end;

Пункт 3: записать изменённый адрес в окно IE и заставить браузер перейти по нему.
Для выполнения третьей части задачи нужно просто послать полю ввода два сообщения:
…
//"вводим" изменённый адрес
SendMessage(h, WM_SETTEXT, 0, longint(Pchar(s)));
//"нажимаем" клавишу "Ввод" (Enter)
SendMessage(h, WM_KEYDOWN, VK_RETURN, 0);
…

Теперь соберём эти три пункта в нужные нам процедуры:
//переход "Вперёд"
procedure NextPage;
var
  s: String;
  h: HWnd;
begin
  if FindEdit(h) then
  begin
    //получаем URL
    s := gettext(h);
    delete(s, length(s), 1);
    //увеличиваем последнее число на единицу
    s := IncURL(s);
    //записываем новый URL
    SendMessage(h, WM_SETTEXT, 0, longint(Pchar(s)));
    //нажимаем клавишу "Ввод"
    SendMessage(h, WM_KEYDOWN, VK_RETURN, 0);
  end;
end;

//переход "Вперёд"
procedure PrevPage;
var
  s: String;
  h: HWnd;
begin
  if FindEdit(h) then
  begin
    s := string(gettext(h));
    delete(s, length(s), 1);
    s := DecURL(s);
    SendMessage(h, WM_SETTEXT, 0, longint(Pchar(s)));
    SendMessage(h, WM_KEYDOWN, VK_RETURN, 0);
  end;
end;

Все основные процедуры нашей программы готовы, теперь настало время сделать для них оболочку. Создайте новый проект и поместите на форму один-единственный компонент – PopupMenu1:TPopupMenu1. В нём должен быть один пункт – "Выход". Процедура при выборе этого пункта:
procedure TForm1.ExitClick(Sender: TObject);
begin
  //завершаем работу программы
  halt;
end;

Добавьте к списку подключаемых модулей (раздел Uses) модуль ShellApi. Объявите константу

const
  WM_ICONTRAY = wm_user + 1;

Этим мы определили сообщение, которое будем получать от иконки в SysTray.
В раздел Private добавьте три строчки:

//информация о нашей иконке
TrayIconData: TNotifyIconData;
//эта процедура будет обрабатывать поступающие от иконки сообщения
procedure TrayMessage (var Msg: TMessage); message WM_ICONTRAY;
//процедура обработки нажатия "горячих" клавиш
procedure hotykey(var msg:TWMHotkey); message WM_HOTKEY;

Запишите процедуру для события OnCreate формы:
procedure TForm1.FormCreate(Sender: TObject);
begin
  //заполняем информацию об иконке
  with TrayIconData do
  begin
    cbSize := SizeOf(TrayIconData);
    Wnd := Handle;
    uID := 0;
    uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
    uCallbackMessage := WM_ICONTRAY;
    hIcon := application.icon.handle;
    szTip := 'My TrayIcon!';
  end;
  //добавляем иконку в SysTray
  Shell_NotifyIcon(NIM_ADD, @TrayIconData);
  //регистрируем "горячие" клавиши Alt+P
  RegisterHotKey(handle, 1,.MOD_Alt, 80);
  //регистрируем "горячие" клавиши Alt+Q
  RegisterHotKey(handle, 2,.MOD_Alt, 81);
  //регистрируем "горячие" клавиши Alt+R
  RegisterHotKey(handle, 3,.MOD_Alt, 82);
end;

Теперь процедура при уничтожении формы:
procedure TForm1.FormDestroy(Sender: TObject);
begin
  //удаляем иконку
  ShellApi.Shell_NotifyIcon(NIM_DELETE, @TrayIconData);
  //удаляем "горячие" клавиши
  UnRegisterHotKey(handle, 1);
  UnRegisterHotKey(handle, 2);
  UnRegisterHotKey(handle, 3);
end;

//обработка сообщений от иконки
procedure TForm1.TrayMessage(var Msg: TMessage);
var
  p: TPoint;
begin
  case Msg.lParam of
  //если нажата правая кнопка мыши,
    WM_RBUTTONDown, WM_RBUTTONDBLCLK:
    begin
      SetForegroundWindow(handle);
      GetCursorPos(p);
      //то показываем наше меню в текущей позиции курсора
      popupmenu1.Popup(p.x,p.y);
    end;
  end;
end;

//нажатие на "горячие" клавиши
procedure TForm1.hotykey(var msg:TWMHotkey);
var
  n: Integer;
begin
  n := msg.HotKey;
  //если нажали Alt+P, то закрываем все окна IE
  if (n=1) then CloseAllIE_2;
  else
    //если нажали Alt+Q, то переход "Вперёд"
    if (n=2) then NextPage
    else
      //если нажали Alt+R, то переход "Назад"
      if (n=3) then PrevPage;
end;

На этом создание программы, которая расширяет функциональность браузера Internet Explorer, завершено. Мы научились:
1) работать с "горячими" клавишами;
2) помещать иконку на Системную панель;
3) работать с сообщениями и окнами.
На сегодня всё.

Иван Ширко
ishyrko@gmail.com

Читать дальше >>

Сделай сам: управление автозагрузкой

Продолжаем серию "Сделай сам", посвящённую практическому применению Delphi. На этот раз мы поговорим о такой важной составляющей жизни нашего компьютера, как автозагрузка. При загрузке Windows могут запускаться самые разные приложения: от системной панели (вы её можете узнать по характерным для неё часам) до программы оптимизации реестра.
Все мы любим устанавливать новые программы. А некоторые из них, дабы мы с ними никогда не расставались, втихую прописывают себя в автозагрузку. Вот и получается, что со временем Windows загружается всё дольше и дольше. А всё потому, что с ней за компанию запускаются различные "удобняшки", антивирусы (а иногда и их анти-сородичи) и т.п.
Вывод из всего вышесказанного: время от времени нужно проводить "зачистку" в автозагрузке. Продвинутыми пользователями это делается при помощи редактора реестра и Блокнота, а все остальные используют специальные программы. Давайте посмотрим, что нам предлагает Windows для управления автозагрузкой. После недолгих поисков была найдена программа MsConfig (лежит она в каталоге …\Windows\System). MsConfig позволяет просматривать список файлов, запускающихся вместе с Windows и удалять элементы из автозагрузки с возможностью восстановления. Программа обрабатывает файл Win.ini, папку "Автозагрузка" и следующие ключи реестра: HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Run, HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run и HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices.
Теперь, когда есть с чем сравнить, сделаем свою программу для управления автозагрузкой. Вот что наше творение будет уметь делать к концу статьи:
1) Всё, что умеет MsConfig, за исключением восстановления удалённых из автозагрузки файлов;
2) Добавлять новые файлы в автозагрузку и изменять пути к существующим;
3) Обрабатывать большее количество ключей реестра, чем MsConfig.

Теперь немного теоретических сведений:
1) В Win.ini есть два параметра: Load и Run. Все файлы, имена которых записаны в этих параметрах через пробел, будут загружаться при старте Windows. А значит, в именах файлов не должно быть пробелов. Этого легко добиться при помощи функции sysutils.ExtractShortPathName (filename).
2) В реестре есть "автозагрузочные" ключи с одинаковыми названиями: Run и RunOnce. Одна пара находится в разделе HKEY_LOCAL_MACHINE, а другая – в HKEY_CURRENT_USER. В связи с этим, в нашей программе будем осуществлять переход между разделами при помощи двух компонентов TradioButton (см. рис. 1).

Создайте в Delphi новый проект и поместите на форму PageControl1:TpageControl. Затем на этот компонент поместите ListView1:TlistView. После этого на форму поместите следующие компоненты: ToolBar1:TtoolBar, ImageList1:TimageList, OpenDialog1:TopenDialog, RadioButton1:TradioButton и RadioButton2:TradioButton. Теперь выделите PageControl1 и нажмите правую клавишу мыши. Из появившегося меню выберите пункт New Page. После этого на компоненте должна появиться новая страница. Создайте, таким образом, ещё четыре страницы и дайте каждой название (свойство Caption): 1 – Run, 2 – RunOnce, 3 – RunServices, 4 – RunServicesOnce, 5 – Win.ini. Каждая страница будет отвечать за определённый ключ реестра, либо за файл Win.ini. Теперь выделите ListView1 и, при помощи свойства Columns, создайте две колонки с названиями (свойство Caption) Имя и Путь соответственно, также для каждой колонки установите свойству Autosize значение True. После этого измените значения свойства ViewStyle на vsReport. Затем сделайте активным компонент ToolBar1 и создайте на нём четыре кнопки. Для каждой свойству ShowHint (показывать подсказку) установите значение true (истина), а в свойство Hint запишите эти самые подсказки, которые будут появляться при наведении указателя мыши на ту или иную кнопку: 1 – Добавить файл, 2 – Изменить путь, 3 – Удалить файл, 4 – Автозагрузка. На кнопки, при помощи ImageList1, можно поместить иконки (см. рисунок 1). Чтобы сделать это, выполните следующие действия: кликните двойным щелчком по компоненту ImageList1, при помощи кнопки “Add…” добавьте в компонент нужные значки (каждый значок будет помещён под своим номером), выделите компонент ToolBar1 и в свойстве Images выберите компонент ImageList1. После этого нужно в свойстве ImageIndex каждой кнопки выбрать номер понравившегося значка. Теперь приведите вашу форму к виду, подобному на форму, изображённую на рисунке 1.
На этом внешнее оформление программы завершено, а значит, пора заняться непосредственно программированием. Для начала в разделе Uses подключите два модуля: Registry (для работы с реестром) и IniFiles (для работы с Ini-файлами). После этого нужно объявить несколько глобальных переменных:
var
…
ActIndex: Integer; //индекс активной страницы
Appini: TIniFile; //для работы с Ini-файлами
key: Cardinal; //текущий ключ реестра
path: String; //путь к файлу
reg: TRegistry; //для работы с реестром
i: Integer; //используется в циклах
pathfile: String;
Value, Load, Run: TStringList; //списки файлов автозагрузки
ListItem:TListItem; //для работы с компонентом ListView1

Затем запишите процедуру, которая будет из строки извлекать пути к файлам, разделённые пробелами, и помещает их в список. Позже эта процедура будет востребована.

procedure ExtractFilenames(s: String;FileNames: String;qw: TStrings);
begin
{если найдены два пробела, то удаляем один из них}
i := pos(' ', filenames);
while (i <> 0) do
begin
delete(filenames, i, 1);
i := pos(' ', filenames);
end;
i := pos(' ', filenames);
{добавляем в список qw все файлы из строки}
while (i<>0) do
begin
qw.Add(copy(Filenames, 1, i-1));
delete(filenames, 1, i);
i := pos(' ', filenames);
end;
qw.Add(filenames);
end;

Для обработки события OnShow компонента TabSheet1 (мы её назвали "Run") запишите следующую процедуру:

procedure TForm1.TabSheet1Show(Sender: TObject);
begin
//очищаем ListView1
ListView1.Items.Clear;
//создаём объект для работы с реестром
reg := TRegistry.Create;
//будем работать в ключе хранящемся в переменной Key
reg.RootKey := Key;
{открываем ключ, в котором содержатся имена файлов загружаемых при каждом старте Windows и записываем эти в ListBox1}
reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', False);
reg.GetValueNames(value);
for i := 0 to value.Count-1 do
with ListView1 do
begin
ListItem := Items.Add;
ListItem.Caption :=Value.Strings[i];
ListItem.SubItems.Add(reg.ReadString(Value.Strings[i]));
end;
//освобождаем память, выделенную под объект reg
reg.Free;
end;

Процедура события OnShow компонента TabSheet2:
Всё то же самое, только открываем другой ключ реестра:
...
reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\RunOnce', False);
...
Обработка события OnShow компонента TabSheet3:
То же, что и в предыдущих процедурах, но открываем ключ реестра, в котором хранятся имена сервисов, которые запускаются вместе с Windows:
...
reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\RunServices', False);
...
Обработка события OnShow компонента TabSheet4:
Открываем ключ реестра, в котором хранятся имена сервисов, которые запустятся только один раз при ближайшей перезагрузки Windows:
...
reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\RunServicesOnce', False);
...

Процедура обработки события OnShow компонента TabSheet5:

procedure TForm1.TabSheet5Show(Sender: TObject);
begin
ListView1.Items.Clear;
load.Clear;
run.Clear;
//получаем доступ к файлу Win.ini
AppIni := TIniFile.Create('Win.INI');
//читаем пути к файлам из строки Load
path := appini.ReadString('windows', 'Load', '');
//удаляем все ведущие пробелы
while (path[1]= ' ') do
delete(path, 1, 1);
//записываем пути к файлам в список Load
if (path <> '') then
ExtractFileNames('Load', path, Load);
{теперь всё это повторяем со строкой “Run” и записываем их в список Run}
path := appini.ReadString('windows','Run', 'error');
while (pos(' ', path) = 1) do
delete(path, 1, 1);
if (path <> '') then
ExtractFileNames('Run',path,Run);
AppIni.Free;
{отображаем пути ко всем файлам из списков Run и Load в ListView1}
for i:=0 to Load.Count-1 do
with ListView1 do
begin
ListItem := Items.Add;
ListItem.Caption :='Load';
ListItem.SubItems.Add(Load.Strings[i]);
end;
for i:=0 to Run.Count-1 do
with ListView1 do
begin
ListItem := Items.Add;
ListItem.Caption :='Run';
ListItem.SubItems.Add(Run.Strings[i]);
end;
end;

Обработка события OnClick компонента RadioButton1:
procedure TForm1.RadioButton1Click(Sender: TObject);
begin
{если текущий ключ не HKEY_LOCAL_MACHINE, то делаем его активным и, если нужно, обновляем информацию в ListBox1}
if Key<>windows.HKEY_LOCAL_MACHINE then
begin
key := Windows.HKEY_LOCAL_MACHINE;
if PageControl1.ActivePageIndex<2>then
PageControl1.ActivePage.OnShow(self);
end;
end;

Обработка события OnClick компонента RadioButton1:
procedure TForm1.RadioButton2Click(Sender: TObject);
begin
{если текущий ключ не HKEY_CURRENT_USER, то делаем его активным и, если нужно, обновляем информацию в ListBox1}
if Key<>windows.HKEY_CURRENT_USER then
begin
key := Windows.HKEY_CURRENT_USER;
if PageControl1.ActivePageIndex<2end;
end;

После этого создайте новую форму и поместите на неё кнопку Tbutton, и два компонента TradioButton (рис. 2).

Запишите обработку события нажатия на кнопку:
procedure TForm2.Button1Click(Sender: TObject);
var
FName: String;
begin
{преобразуем имя выбранного файла в краткий формат}
FName := sysutils.ExtractShortPathName(form1.opendialog1.filename);
{записываем в выбранную константу имя файла после пробела, также отображаем добавленный файл в окне нашей программы}
if form2.RadioButton1.Checked then
path := 'Load'
else path:='Run';
AppIni := TIniFile.Create('Win.INI');
AppIni.writeString('windows', path, appini.readstring('windows', path, '') + ' ' + FName);
AppIni.Free;
with form1.ListView1 do
begin
ListItem := Items.Add;
ListItem.Caption := path;
ListItem.SubItems.Add(FName);
end;
form2.hide;
form1.show;
end;

Теперь запишите обработку нажатия кнопки New, при помощи которой можно добавить новый файл в автозагрузку:
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
{если выбран файл, который нужно добавить, то продолжаем}
if OpenDialog1.Execute then
{если активна страница с ключами реестра то добавляем файл в реестр, иначе – в Win.ini}
if PageControl1.ActivePageIndex<4>then
begin
reg := Tregistry.Create;
if PageControl1.ActivePageIndex<2then
reg.RootKey:=key
else
reg.RootKey:=windows.HKEY_LOCAL_MACHINE;
case PageControl1.ActivePageIndex of
0: reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', False);
1: reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\RunOnce', False);
2: reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\RunServices', False);
3: reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\RunServicesOnce', False);
end;
//просим ввести имя константы для нового файла
path:=inputbox('Введите имя константы', '', Extractfilename OpenDialog1.filename));
{если имя не введено, то вместо него записываем имя добавляемого файла}
if path='' then
path := Extractfilename(OpenDialog1.filename);
pathfile := ExtractShortPathName(OpenDialog1.filename);
reg.WriteString(path, pathfile);
reg.CloseKey;
reg.Free;
with ListView1 do
begin
ListItem := Items.Add;
ListItem.Caption :=path;
ListItem.SubItems.Add(pathfile);
end;
end else
{если нужно добавить файл в Win.ini, то вызываем форму 2}
form2.show;
end;

Нажатие кнопки "Изменить":
procedure TForm1.ToolButton2Click(Sender: TObject);
var
Temp: String;
Results: String;
begin
{если выбран новый файл для константы, то продолжаем}
if ListView1.ItemFocused.Selected then
if opendialog1.Execute then
begin
{получаем индекс активной константы}
ActIndex := ListView1.ItemFocused.Index;
{преобразовываем имя выбранного файла в короткий формат}
results := ExtractShortPathName(OpenDialog1.filename);
{теперь записываем в константу новый файл}
if PageControl1.ActivePageIndex<4 then
begin
reg := TRegistry.Create;
if PageControl1.ActivePageIndex<2 then
reg.RootKey := key
else
reg.RootKey:=windows.HKEY_LOCAL_MACHINE;
case PageControl1.ActivePageIndex of
0: reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', False);
1: reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\RunOnce', False);
2: reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\RunServices', False);
3: reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\RunServicesOnce', False);
end;
reg.WriteString(listview1.Items.Item[ActIndex].Caption,results);
reg.CloseKey;
reg.Free;
end
else
begin
AppIni:=TIniFile.Create('Win.INI');
path := appini.readstring('windows',listview1.Items.Item[ActIndex].Caption,'error');
temp := ListView1.Items.Item[actindex].SubItems.Strings[0];
i := pos(temp,path);
if i<>0 then
begin
delete(path, i, length(temp));
path := path + ' ' + results;
appini.writeString('windows',listview1.Items.Item[ActIndex].Caption, path);
AppIni.Free;
end;
end;
ListView1.Items.Item[actindex].SubItems.Strings[0] := Results;
end;
end;

Нажатие кнопки "Удалить":
procedure TForm1.ToolButton3Click(Sender: TObject);
var
temp: String;
begin
{если пользователь уверен в своём решении, то удаляем выбранный файл из автозагрузки}
if ListView1.ItemFocused.Selected then
if messagedlg('Вы уверены?', mtConfirmation, [mbYes,mbNo], 0) = mryes then
begin
ActIndex := ListView1.ItemFocused.Index;
if PageControl1.ActivePageIndex<4 then
begin
reg:=Tregistry.Create;
if PageControl1.ActivePageIndex<2 then reg.RootKey:=key
else
reg.RootKey:=windows.HKEY_LOCAL_MACHINE;
case PageControl1.ActivePageIndex of
0: reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', False);
1: reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\RunOnce', False);
2: reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\RunServices', False);
3: reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\RunServicesOnce', False);
end;
reg.DeleteValue(listview1.Items.Item[ActIndex].Caption);
reg.CloseKey;
reg.Free;
end else
begin
AppIni := TIniFile.Create('Win.INI');
path := AppIni.readstring('windows', listview1.Items.Item[ActIndex].Caption, 'error');
temp := ListView1.Items.Item[actindex].SubItems.Strings[0];
i := pos(temp,path);
if (i<>0) then
begin
delete(path,i,length(temp));
appini.writeString('windows',listview1.Items.Item[ActIndex].Caption, path);
AppIni.Free;
end;
end;
ListView1.Items.Item[actindex].Delete;
end;
end;

Нажатие на кнопку "Автозагрузка":
procedure TForm1.ToolButton4Click(Sender: TObject);
var
Auto: String;
begin
reg:=TRegistry.Create(windows.key_Read);
reg.RootKey:=HKEY_USERS;
reg.OpenKey('.DEFAULT\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', False);
{читаем из реестра путь к папке "Автозагрузка" и открываем её}
Auto:='Explorer '+reg.ReadString('Startup');
reg.Free;
winexec(pchar(Auto),SW_ShowNormal);
end;

Теперь добавим в программу пару штрихов.
Выделите компонент ListView1 и для события OnDblClick (при двойном щелчке мышью) выберите процедуру ToolButton2Click, а для события OnKeyDown (при нажатии клавиши) запишите следующее:
procedure TForm1.ListView1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=VK_DELETE then form1.ToolButton3.OnClick(self);
end;

В итоге, при нажатии кнопки Delete, выбранный файл будет удалён, а при двойном щелчке мыши будет предложено заменить этот файл другим.
Вот и всё. Предложения по поводу тем следующих статей этого цикла присылайте мне на e-mail.

Иван Ширко
ishyrko@gmail.com

Читать дальше >>

Сделай сам: "Вскрывалка паролей"

Каждому пользователю ПК время от времени приходится вводить пароли: для установки программы, для соединения с интернетом, для получения почты и т.д. Как правило, при вводе пароля, вместо нормальных символов появляются звёздочки ('*'). Делается такая конспирация не только для сокрытия пароля от посторонних глаз, но и для того, чтобы злоумышленник, получивший доступ к компьютеру, не мог узнать пароли, сохранённые в системе. Но, как известно, нет совершенной защиты, поэтому теперь можно найти много программ для извлечения паролей  из-под "звёздочек". Некоторые программы могут показывать пароль в отдельном окошке, другие же неким чудесным образом заставляют превратиться "звёздочки" в нормальные символы. В данной статье мы рассмотрим процесс создания программы, которая умеет "выковыривать" пароли двумя вышеописанными способами.

         Вначале немного теории. Windows, судя по названию, это "сборище" окон. Каждое окно обычно содержит другие окна, т.е. является родителем для некоторых других окон (эти "другие окна" называют дочерними). Для нашей программы нам достаточно знать, что то поле, куда мы вводим пароли является хоть и маленьким, но окном. А значит, как и любое порядочное окно, оно имеет параметр "текст окна" и умеет принимать\отсылать сообщения. Именно на данных весьма полезных свойствах полей ввода основаны программы для извлечения паролей из-под "звёздочек".

         Итак, способ первый для "вскрытия" паролей: нужно просто узнать текст окна, содержащего пароль. Вот и всё, никаких сложностей. Правда, работать данный способ будет только в Win9x и, возможно, в WinMe. Осталось только написать функцию для получения текста произвольного окна:

Function GetText(WindowHandle: hwnd):string;

var

  txtLength : integer;

  buffer: string;

begin

//Узнаём длину текста

  TxtLength := SendMessage(WindowHandle, WM_GETTEXTLENGTH, 0, 0);

  if txtlength>0 then

begin

    txtlength := txtlength + 1;

    setlength (buffer, txtlength);

    //записываем текст окна в buffer

    sendmessage(WindowHandle, wm_gettext, txtlength, longint(@buffer[1]));

    result := buffer;

  end else result:='';

end;

Теперь, если мы вызовем эту функцию, записав в параметр идентификатор поля ввода пароля, то она возвратит нам сам пароль. Как узнать идентификатор нужного окна будет рассказано далее. А сейчас поговорим о втором способе извлечения пароля. Только в данном способе мы не запишем пароль в какую-либо переменную, а заставим поле ввода отобразить вместо звёздочек нормальные символы. Для этого нужно послать ему сообщение EM_SETPASSWORDCHAR. Вообще, это сообщение используется и для того, чтобы нормальный текст заменить каким-либо символом (обычно используются звёздочки). Далее приведена процедура, которая не просто показывает нормальный текст вместо звёздочек, но, если у выбранного поля ввода текст не зашифрован, то мы заменяем его звёздочками. Т.е., если для поля ввода пароля применить эту процедуру, то появятся нормальные символы, а если для того же поля повторить операцию, то текст опять превратится в звёздочки.

Procedure ShowPass(h:hwnd);

var

ch:integer;

  i:integer;

begin

  //узнаём, закодирован ли текст

  ch:=SendMessage(h, EM_GETPASSWORDCHAR, 0, 0);

  //если закодирован, то раскодируем текст, иначе кодируем звёздочками

  if ch>0 then

    i:=0

  else

    i:=ord('*');

  SendMessage(h, EM_SETPASSWORDCHAR, i, 0);

end;

Теперь можно приступить к созданию самой программы, но перед этим нужно оговорить принципы её функционирования:

–       пользователь должен как-то указать программе, какой именно пароль он хочет "вскрыть". Наиболее удобным для юзера способом мне представляется следующий: пользователь наводит курсор мышки на поле ввода с нужным паролем, нажимает определённую комбинацию клавиш и получает взамен "звёздочек" нормальный пароль.

–       сделаем функцию копирования паролей в буфер обмена (этого нет в подобных программах!). Windows не позволяет просто взять и скопировать пароль, поэтому будем делать так:

1)     Заменяем "звёздочки" на обычные символы;

2)     Выделяем весь текст в поле ввода;

3)     Копируем выделенный текст в буфер обмена;

4)     Обратно маскируем пароль "звёздочками.

Теперь запускаем Delphi и делаем формочку, взяв за образец рис.1.

В свойстве формы FormStyle установите константу fsStayOnTop, чтобы окно нашей программы находилось поверх остальных. Запишите функцию GetText и процедуру ShowPass (см. выше). В разделе Var нужно объявить несколько глобальных переменных:

p:TPoint;

h:HWND;

ch:Integer;

s:String;

Процедура обработки нажатия на кнопку "Показать\Спрятать пароль":

procedure TForm1.Button1Click(Sender: TObject);

begin

//узнаём координаты курсора мыши

  getcursorpos(p);

//получаем идентификатор окна, находящегося под курсором мыши

  h:=windowfrompoint(p);

//прячем\показываем пароль

  ShowPass(h);

//перерисовываем окно

  InvalidateRect(h, nil, true);

end;

Данная процедура позволяет маскировать\демаскировать текст почти любого поля ввода.

Процедура обработки нажатия на кнопку "Скопировать пароль":

procedure TForm1.Button2Click(Sender: TObject);

begin

//узнаём координаты курсора мыши

  getcursorpos(p);

//получаем идентификатор окна, находящегося под курсором мыши

  h:=windowfrompoint(p);

//каким символом замаскирован текст в данном окне?

  ch:=SendMessage(h, EM_GETPASSWORDCHAR, 0, 0);

//если пароль замаскирован, то показываем его в нормальном виде

  if ch>0 then

    SendMessage(h, EM_SETPASSWORDCHAR, 0, 0);

//выделяем весь текст

  SendMessage(h, EM_SETSEL, 0, -1);

//копируем выделенный текст

  SendMessage(h, WM_COPY, 0, 0);

//если мы "вскрывали" пароль, то опять маскируем его

  if ch>0 then

    SendMessage(h,EM_SETPASSWORDCHAR, ch, 0);

//перерисовываем окно

  InvalidateRect(h, nil, true);

end;

Процедура обработки нажатия на кнопку "Показать пароль в отдельном окне":

procedure TForm1.Button3Click(Sender: TObject);

begin

//узнаём координаты курсора мыши

  getcursorpos(p);

//получаем идентификатор окна, находящегося под курсором мыши

  h:=windowfrompoint(p);

//получаем текст окна

  s:=gettext(h);

//если текст не является пустой строкой, то показываем его пользователю

  if s<>'' then

  begin

    setforegroundwindow(form1.handle);

    showmessage(s);

  end;

end;

         С помощью данной процедуры (работает она только в Win9x) можно узнать не только пароль, скрытый под "звёздочками", но и текст практически любого стандартного элемента управления Windows: поля ввода, кнопки, флажка (checkbox) и др. Напомню, что текст копируется в буфер обмена, работа с которым рассматривается в №7 за 2002 год в статье "Работа с буфером обмена в Delphi".

         В принципе программа уже готова к эксплуатации. Но для удобства пользователя сделаем, как и собирались, поддержку "горячих клавиш". Для этого мы воспользуемся функцией

RegisterHotKey(

    HWND hWnd, // этому окну придёт уведомление о нажатии

     комбинации клавиш

    int id,           // идентификатор "горячих клавиш"

    UINT fsModifiers,   // должны ли быть нажаты клавиши Ctrl, Shift или Alt

    UINT vk      // код клавиши, на которую мы будем реагировать

   );

         Для события OnCreate формы запишите процедуру:

procedure TForm1.FormCreate(Sender: TObject);

begin

//регистрируем сочетание Shift+Alt+F9

 If not RegisterHotkey

         (Handle, 1, MOD_ALT or MOD_SHIFT, VK_F9) Then

   ShowMessage('Нельзя использовать данное сочетание клавиш!');

//регистрируем сочетание Shift+Alt+F8

 If not RegisterHotkey

         (Handle, 2, MOD_ALT or MOD_SHIFT, VK_F8) Then

   ShowMessage('Нельзя использовать данное сочетание клавиш!');

//регистрируем сочетание Shift+Alt+F7

 If not RegisterHotkey

        (Handle, 3, MOD_ALT or MOD_SHIFT, VK_F7) Then

   ShowMessage('Нельзя использовать данное сочетание клавиш!');

end;

         Теперь в секции Private объявите процедуру, которая будет реагировать на нажатие комбинаций клавиш:

Procedure WMHotkey( Var msg: TWMHotkey ); message WM_HOTKEY;

         А вот и сама процедура:

Procedure TForm1.WMHotkey( Var msg: TWMHotkey );

begin

 case msg.hotkey of

//если нажато Shift+Alt+F9, то копируем пароль

  1:begin

     getcursorpos(p);

     h:=windowfrompoint(p);

     ch:=SendMessage(h,EM_GETPASSWORDCHAR,0,0);

     if ch>0 then

       SendMessage(h,EM_SETPASSWORDCHAR,0,0);

     SendMessage(h,EM_SETSEL,0,-1);

     SendMessage(h,WM_COPY,0,0);

     if ch>0 then

       SendMessage(h,EM_SETPASSWORDCHAR,ch,0);

     InvalidateRect(h,nil,true);

    end;

//если нажато Shift+Alt+F8, то прячем\показываем пароль пароль

   2:begin

      getcursorpos(p);

      h:=windowfrompoint(p);

      ShowPass(h);

      InvalidateRect(h,nil,true);

     end;

//если нажато Shift+Alt+F9, то показываем пароль в отдельном окне

   3:begin

      getcursorpos(p);

      h:=windowfrompoint(p);

      s:=gettext(h); 
     if s<>'' then

      begin

        setforegroundwindow(form1.handle);

        showmessage(s);

        end;

     end;

 end;

end;

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

P. S.

         Разумеется, данную программу нельзя применять ни в каких деструктивных целях.

Иван Ширко
ishyrko@gmail.com

Читать дальше >>

"Читать дальше" в блоге или Экономим трафик читателей

После добавления очередной статьи в блог я заметил, что главная страница при загрузке "съела" почти метр трафика, что не есть хорошо. Поэтому, предварительно покопавшись в справке Блоггера, принялся редактировать шаблон блога. В итоге, при загрузке страницы со списком статей, будь то главная страница или архив, отображается только часть поста. А чтобы прочитать понравившийся пост полностью достаточно перейти по ссылке "Читать дальше>>".
Сделать это оказалось совсем несложно. Достаточно внести в шаблон блога следующие изменения:
Добавьте (например после тега стилевой блок, который, в зависимости от типа страницы (полностью пост или список постов) установит полное либо частичное отображение поста:

<style>
  <b:if cond='data:blog.pageType == "item"'>
    span.fullpost {display:inline;}
  <b:else/>
    span.fullpost {display:none;}
  </b:if>
<style>

После тега <data:post body=""> поместите код, который покажет ссылку на пост целиком:

<b:if cond='data:blog.pageType != "item"'><br />
   <a expr:href='data:post.url'>Читать дальше>>!</a>
</b:if>

Теперь осталось оформить неотображаемую часть каждого поста тегом <span class="fullpost"></span>. Пример:
Это начало поста <span class="fullpost"> а вот и продолжение</span>. В итоге, чтобы прочитать такой пост целиком, придется щелкнуть по такой вот ссылке:

Читать дальше >>