Мы переехали

Новый адрес - http://delphiblog.ru

понедельник, 17 декабря 2007 г.

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

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

         Вначале немного теории. 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


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

вторник, 11 декабря 2007 г.

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

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

<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>. В итоге, чтобы прочитать такой пост целиком, придется щелкнуть по такой вот ссылке:


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

понедельник, 10 декабря 2007 г.

Двойная буферизация или Анимация без мерцания

     Все мы с упоением в детстве смотрели мультики, да и сейчас иногда, щёлкая каналы, с ностальгией в душе останавливаемся посмотреть на рисованных персонажей, живущих своею жизнью.
     Что же представляет из себя анимация? Да просто сменяющие одна другую картинки. И чем быстрее и плавнее меняется изображение, тем лучше выглядит анимация. Возможностей современного компьютера вполне достаточно, чтобы обеспечить нормальное отображение любой анимации. Но в играх анимация формируется динамически, так что любая задержка отображения картинок может вызвать мерцание. Чтобы этого избежать используют различные алгоритмы вывода изображения на экран. Давайте рассмотрим простой способ, с помощью которого можно делать динамические анимации, отлично отображающиеся даже на слабых компьютерах.
     Итак, разберём самый простой случай, когда нам нужно двигать простую фигуру (например, круг) по одноцветному фону. Реализовать это можно разными способами. Можно, например, действовать напрямую: нарисовать поверх фона круг и через некоторый промежуток времени заливать всю картинку цветом фона, после чего рисовать круг со смещёнными координатами. В итоге мы получим вполне движущуюся фигуру, но вот мерцание будет всё портить. Решение напрашивается само собой: нужно заливать не весь холст цветом фона, а только ту область, из которой нам нужно стереть изображение круга. В данном случае достаточно просто нарисовать цветом фона такой же круг, но у которого цвет равен цвету фона, что приведёт к стиранию начального круга.
А теперь представим, что у нас по одноцветному фону движется уже сложное изображение. Здесь уже не удастся пиксель в пиксель затереть это изображение, так что придётся обводить его некоторой простой областью (например, прямоугольником) и закрашивать её.
     Всё это, конечно, хорошо, но описанные случаи не представляют из себя особой практической ценности и используется разве что в учебных целях. Так что усложним ситуацию: пусть сложное изображение движется по сложному фону. Закрашивать тут не имеет смысла, так что нужно придумывать что-нибудь новенькое. Вот тут мы и подошли к методу двойной буферизации. Этот метод использовался и используется в играх, программах с графическим интерфейсом, да и просто в стандартных компонентах операционных систем. Как следует из названия, метод двойной буферизации предполагает наличие двух буферов. Один нужен для хранения перемещаемого изображения, а другой для хранения той области фона, в которую мы собираемся прорисовать это изображение. То есть последовательность действий примерно такая:
  1. сохраняем область фона в буфер;
  2. прорисовываем на фоне в этой области перемещаемое изображение;
  3. через некоторое время восстанавливаем участок фона, вычисляем новые координаты и переходим к пункту 1.
     Давайте рассмотрим реализацию этого алгоритма на Delphi. В данном примере по сложному фону будет летать по круговой траектории самолётик  (рис.1).


Вначале нужно объявить несколько констант и переменных:

const
  //координаты центра окружности
  xc = 200;
  yc = 200;
  //приращение угла
  dl = 0.05;
  //радиус окружности
  R=100;
var
  //для хранения изображений
  sam, buf: TBitmap;
  BufRct: TRect;
  l: real;
  x, y:integer;
  w, h:integer;

Действия при запуске программы:

  //создаём объекты для хранения изображений
  Buf:=TBitmap.Create;
  Sam:=TBitmap.Create;
  //делаем фон самолётика прозрачным
  Sam.Transparent:=true;
  //загружаем изображение самолётика
  Sam.LoadFromFile('sam.bmp');
  //устанавливаем размеры буфера такими же, как у самолётика
  w := Sam.Width;
  h := Sam.Height;
  Buf.Width:=w;
  Buf.Height:=h;
  //начальный угол
  l := 0;
  //начальные координаты
  x := round(xc+R*cos(l));
  y := round(yc+R*sin(l));
  //сохраняем участок фона
  BufRct := Bounds(x,y,w,h);
  Buf.Canvas.CopyRect(Buf.Canvas.ClipRect,Image1.Canvas,BufRct);
  //рисуем самолётик
  Image1.Canvas.Draw(x,y,sam);
  //запускаем таймер
  Timer1.Enabled := true;

Теперь через небольшой промежуток времени выполняем процедуру:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  //восстанавливаем участок фона
  Image1.Canvas.Draw(x,y,buf);
  //увеличиваем угол
  l := l + dl;
  //если самолёт сделал круг, то отнимаем от угла 2 пи
  if (l>2*pi) then
    l := l - 2*pi;
  //высчитываем координаты по новому углу
  x := round(xc+R*cos(l));
  y := round(yc+R*sin(l));
  //сохраняем участок фона в буфер
  BufRct := Bounds(x,y,w,h);
  Buf.Canvas.CopyRect(Buf.Canvas.ClipRect,Image1.Canvas,BufRct);
  //рисуем самолётик
  Image1.Canvas.Draw(x,y,sam);
end;

     Разумеется, этот алгоритм можно перенести и на случай движения изображения по движущемуся фону, достаточно лишь математически учесть изменение положения фона. Метод двойной буферизации применяют также и для неподвижных объектов, например, для отображения какой-нибудь анимации (флаг развевается на ветру), т.е. после каждого кадра анимации мы восстанавливаем фон, чтобы исключить наложение кадров друг на друга.
     Как видим, метод двойной буферизации достаточно легко реализовать, но несмотря на это он показывает очень хорошие результаты. И правильное использование описанного алгоритма делает программу с простой анимацией более эффектной и профессиональной без особых усилий программиста.

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


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

среда, 5 декабря 2007 г.

Мультимедиа под контролем или Функция mciSendString

    В данной статье рассматривается функция mciSendString, которая находится в библиотеке winmm.dll. Эта функция может подавать команды любому MCI (Media Control Interface) устройству (поддерживаемое системой мультимедиа устройство: WAV, MIDI, CDAudio, Video и т.п.).
Вот её синтаксис:
MCIERROR mciSendString(
  LPCTSTR lpszCommand,
  LPTSTR lpszReturnString,
  UINT cchReturn,
  HANDLE hwndCallback
);

lpszCommand – команда;
lpszReturnString – строка результата;
cchReturn – размер в символах строки результата;
hwndCallback – окно отзыва (используется только при установленном в первом параметре флага "notify").
    Все дальнейшие примеры будут написаны на Delphi, но их перевод на другие языки, я думаю, не составит особого труда.
    Теперь условимся с параметрами функция mciSendString в последующих примерах:

  • HwndCallback: будет принимать значение 0;
  • CchReturn: будет принимать значение 64 (в MSDN написано, что это максимальная длина ошибки, которая может быть возвращена параметром lpszReturnString);
  • LpszReturnString: в этом параметре будем использовать переменную sbReturn: array [1..64] of char;
    Пришло время перейти к самому главному параметру функции – lpszCommand. Эта команда составляется при помощи специальных операторов, часть которых рассматривается далее.

Open
Эта команда поддерживается всеми устройствами. Она служит для инициализации устройства. Синтаксис команды:
'open lpszDeviceID lpszOpenFlags lpszFlags'
Параметры:
LpszDeviceID – идентификатор одного из устройств (или его псевдоним), прописанных в разделе [MCI] файла System.ini или в реестре. Может указывать также на драйвер. Например: cdaudio, sequencer, waveaudio, MyDriver.drv.
LpszOpenFlags – флаг, определяющий дополнительные параметры инициализации устройства. Я не буду приводить весь список значений этого параметра для каждого устройства, а упомяну лишь значение "alias device_alias type device_type", которое открывает устройство типа device_type под псевдонимом device_alias.
LpszFlags – может принимать одно из следующих значений:
  1. Test – служит для определения возможности выполнения команды, при этом сама команда устройству не отправляется.
  2. Wait – при этом флаге управление программе передаётся только после выполнения команды.
  3. Notify – при этом флаге программа получит специальное сообщение, при помощи которого сможет узнать о завершении выполнения команды, а управление передаётся без промедления.
Пример:
mciSendString('open d:\Sound.wav type waveaudio alias MyWave wait', nil, 0, 0); - связывает устройство WaveAudio под псевдонимом MyWave с файлом d:\Sound.wav.

Play
Эта команда запускает проигрывание для одного из следующих устройств: CD audio, digital-video, MIDI sequencer, videodisc, VCR, и waveform-audio.
Синтаксис команды:
'play lpszDeviceID lpszPlayFlags lpszFlags'
Параметры:
  • LpszDeviceID – идентификатор одного из устройств (или его псевдоним), прописанных в разделе [MCI] файла System.ini. Например: cdaudio, sequencer, waveaudio, avivideo.
  • LpszPlayFlags – флаг, определяющий тип проигрывания устройства. В Таблице 1 приведён список значений этого параметра для каждого устройства, а в Таблице 2 даны пояснения для этих значений.




Пример:
mciSendString('play cdaudio', nil, 0, 0); - музыкальный компакт-диск начинает проигрываться либо с начала, либо с позиции, зафиксированной командой "Пауза".

Status
Данная команда служит для определения различных параметров. Параметров много, поэтому все их приводить не буду. Остановлюсь лишь на командах для музыкальных компакт-дисков.
  • cdaudio type track number – для определения типа дорожки с номером number
  • current track – для определения номера текущей композиции length – для определения длины диска length track number – для определения длины композиции с номером number media present – для определения наличия диска в CD-ROM mode – для определения состояния проигрывания: playing, stopped, paused, open, not ready, parked, recording или seeking.
  • number of tracks – для определения количества дорожек на диске position – для определения текущей позиции диска position track number – для определения начальной позиции дорожки с номером number ready – возвращает истину, если устройство может принимать другие команды start position – начальная позиция диска
  • time format – формат времени, используемый в данной сессии работы с устройством.

    На этом закончим с теорией и перейдём к практике. Напишем при помощи функции mciSendString проигрыватель музыкальных компакт-дисков. Конечно, мы рассмотрели не все команды, которые нам понадобятся, но, я думаю, что проблем не возникнет, т.к. остальные команды достаточно просты в употреблении.
Создайте в Delphi новый проект и приведите форму к нужному виду (см. рис.1).



Для этого понадобятся следующие компоненты: TLabel (5 штук), TButton (7 штук), TListBox, TTrackBar и TTimer. К списку модулей добавьте MMSystem. Теперь объявите две глобальные переменные:
var
  sbReturn: array [1..64] of char; //для возвращаемых значений
  com: pchar; //посылаемая команда

После этого можно писать функции для управления проигрыванием:
//переход к дорожке с номером Track
procedure gototrack(Track: integer);
var
  com:pchar;
begin
  //установка формата времени в "Дорожка:Минуты:Секунды:Фреймы"
  com:='set cdaudio time format tmsf';
  mciSendString(com, @sbReturn, 64, 0);
  //начинаем проигрывание дорожки Track
  com:=pchar('play cdaudio from '+inttostr(Track));
  mciSendString(com, @sbReturn, 64, 0);
  //устанавливаем формат времени в миллисекунды
  com:='set cdaudio time format ms';
  mciSendString(com, @sbReturn, 64, 0);
end;

//получение номера текущей композиции
function GetCurrentTrack:byte;
var
  com:pchar;
  st:string;
begin
  result := 0;
  com := 'status cdaudio current track wait';
  if (mciSendString(com, @sbReturn, 64, 0) <> 0) then
    exit;
  st := trim(sbReturn);
  if (length(st) > 0) then
    result := strtoint(st);
end;

//количество композиций на диске
function GetTracksCnt: integer;
var
  st:string;
begin
  result := 0;
  com := 'status cdaudio number of tracks wait';
  if (mciSendString(com, @sbReturn, 64, 0) <> 0) then
    exit;
  st := trim(sbreturn);
  if (length(st) > 0) then
    result := strtoint(st);
end;

//переход к следующей композиции
procedure NextTrack;
var
  cur:integer;
begin
  cur:=GetCurrentTrack;
  //если текущая композиция – последняя, то переходим к первой
  if (cur <>then
    GoToTrack(cur+1)
  else
    GoToTrack(1);
end;

//переход к предыдущей композиции
procedure PrevTrack;
var
  cur:integer;
begin
  cur := getcurrentTrack;
  if (cur > 1) then
    GoToTrack(cur-1)
  //если текущая композиция – первая, то переходим к последней  
  else
    GoToTrack(GetTracksCnt);
end;

//длина композиции
function GetTrackLength(Track: integer): string;
begin
  com := pchar('status cdaudio length track '+inttostr(Track)+' wait');
  mciSendString(com, @sbReturn, 64, 0);
  result := trim(sbReturn);
end;

//длина диска
function GetCDLength:string;
begin
  com := pchar('status cdaudio length wait');
  mciSendString(com, @sbReturn, 64, 0);
  result := trim(sbReturn);
end;

//статус проигрывания
function GetStatus:string;
begin
  com := 'status cdaudio mode wait';
  mciSendString(com, @sbReturn, 64, 0);
  result := trim(sbReturn);
end;

//есть ли диск
function IsCDReady:string;
begin
  com := 'status cdaudio ready wait';
  mciSendString(com, @sbReturn, 64, 0);
  result := trim(sbReturn);
end;

//Начать проигрывание
procedure PlayCD;
begin
  mciSendString('play cdaudio', @sbReturn, 64, 0);
end;

//Пауза
procedure PauseCD;
begin
  mciSendString('pause cdaudio wait', @sbReturn, 64, 0);
end;

//Остановить проигрывание
procedure StopCD;
begin
  mciSendString('stop cdaudio wait', @sbReturn, 64, 0);
end;

//начальная позиция композиции
function GetTrackPos(Track:word): string;
begin
  com := pchar('status cdaudio position track '+inttostr(Track)+' wait');
  mciSendString(com, @sbReturn, 64, 0);
  result := trim(sbReturn);
end;

//текущая позиция диска
function GetCDPos: string;
begin
  com := pchar('status cdaudio position wait');
  mciSendString(com, @sbReturn, 64, 0);
  result := trim(sbReturn);
end;

А теперь напишем обработчики различных событий для компонентов:
//инициализируем устройство при загрузке
procedure TForm1.FormCreate(Sender: TObject);
begin
  mciSendString('open cdaudio', @sbReturn, 64, 0);
end;

//при выходе закрываем устройство
procedure TForm1.FormDestroy(Sender: TObject);
begin
  mciSendString('close cdaudio wait', @sbReturn, 64, 0);
end;

{при появлении формы записываем
в ListBox список композиций}
procedure TForm1.FormShow(Sender: TObject);
var
  i: word;
begin
  for i := 1 to GetTracksCnt do
  begin
    Listbox1.Items.Add(inttostr(i)+' '+GetTrackLength(i));
  end;
end
;

//кнопка Play
procedure TForm1.Button1Click(Sender: TObject);
begin
  PlayCD;
end;

//кнопка Pause
procedure TForm1.Button2Click(Sender: TObject);
begin
  PauseCD;
end;

//кнопка Stop
procedure TForm1.Button3Click(Sender: TObject);
begin
  StopCD;
end;

//кнопка Next (следующая композиция)
procedure TForm1.Button4Click(Sender: TObject);
begin
  NextTrack;
end;

//кнопка Prev (переход к предыдущей композиции)
procedure TForm1.Button5Click(Sender: TObject);
begin
  PrevTrack;
end;

//процедура для таймера, повторяющаяся каждую секунду
procedure TForm1.Timer1Timer(Sender: TObject);
var
  cur, i: word;
  st: string;
  cnt: byte;
  hour: word;
  min, sec: byte;
  t: integer;
begin
  //выводим состояние проигрывания
  label5.Caption:='Состояние: '+GetStatus;
  if (GetStatus <>'playing') and
      (GetStatus<>'stopped') and
      (GetStatus<>'paused') then exit;
  //устанавливаем формат времени в миллисекунды
  com:='set cdaudio time format ms wait';
  mciSendString(com, @sbReturn, 64, 0);
  cur:=GetCurrentTrack;
  //выделяем в списке композиций текущую
  ListBox1.ItemIndex:=cur-1;
  {выводим формат времени, эти строки только для примера, т.к. мы сами недавно   установили формат в миллисекунды}
  com:='status cdaudio time format wait';
  mciSendString(com, @sbReturn, 64, 0);
  //выводим информацию информацию
  label2.Caption:='Формат времени: '+trim(sbReturn);
  label3.Caption:='Начальная позиция: '+GetTrackPos(cur);
  label4.Caption:='Текущая позиция: '+GetCDPos;
  {устанавливаем ползунок TrackBar'a в нужную позицию, соответствующую текущему   положению проигрываемой композиции}
  TrackBar1.Max:=strtoint(GetTrackLength(cur)) div 1000;
  t:=strtoint(GetCDPos)-strtoint(GetTrackPos(cur));
  t:=t div 1000;
  TrackBar1.Position:=t;
  hour:=t div 3600;
  t:=t mod 3600;
  min:=t div 60;
  t:=t mod 60;
  sec:=t;
  st:=format('%d:%d',[min,sec]);
  if (hour > 0) then
  st:=inttostr(hour)+':'+st;
  //выводим время проигрывания текущей композиции
  label1.Caption:=st;
end;

//при двойном щелчке по композиции из списка начинаем её проигрывание
procedure TForm1.ListBox1DblClick(Sender: TObject);
begin
  GoToTrack(ListBox1.ItemIndex+1);
end;

//перемотка композиции на 5 секунд вперёд
procedure TForm1.Button6Click(Sender: TObject);
var
  t: integer;
begin
  t := strtoint(GetCDPos)+5000;
  StopCD;
  com := pchar('seek cdaudio to '+inttostr(t)+' wait');
  mciSendString(com, @sbReturn, 64, 0);
  PlayCD;
end;

//перемотка композиции на 5 секунд назад
procedure TForm1.Button7Click(Sender: TObject);
var
  t: integer;
begin
  t := strtoint(GetCDPos)-5000;
  StopCD;
  com := pchar('seek cdaudio to '+inttostr(t)+' wait');
  mciSendString(com, @sbReturn, 64, 0);
  PlayCD;
end;

    Вот и готов CD-проигрыватель, написанный на достаточно низком уровне при помощи, в принципе, всего одной функции, вынесенной в заглавие статьи. Вот такая вот функция! А ведь она может не только с музыкальным компакт-диском управляться: не следует забывать и про видеодиски, устройства записи и проигрывания мультимедиа и т.п.
Конечно, в CD-проигрывателе почти отсутствует контроль ошибок, и некоторые участки кода можно оптимизировать, но свою функцию эта программа в данной статье выполняет: демонстрирует применение функции mciSendString для различных задач.

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


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

понедельник, 3 декабря 2007 г.

Microsoft Agent. Часть II

В прошлой части мы научились применять технологию Microsoft Agent в web-страничках. В этот раз мы будем работать с Delphi. Убедитесь, что установлены все необходимые компоненты (см. первую часть) и можно отправляться в увлекательное путешествие по миру MsAgent.
Запустите Delphi и в меню "Component" выберите пункт "Import ActiveX Control…". В появившемся диалоговом окне нужно выделить строку "Microsoft Agent Control…" и нажать кнопку "Install". Далее произойдёт стандартный процесс установки нового компонента. После окончания инсталляции создайте новое приложение и поместите на форму полученный компонент – Agent1:TAgent (он должен находиться на закладке ActiveX).
Вот этот вот почти «ноль-ноль-семь» будет помогать нам создавать приложения, которые будут работать с технологией MsAgent. Начнём с небольшого примера, с маленького костяка, который можно будет использовать при разработке более сложных программ.
Установите свойству Connected компонента Agent1 значение True, затем объявите две глобальные переменные:
Var
  //для хранения персонажа
  Character: IAgentCtlCharacterEx;
  //для получения состояния персонажа
  Request: IAgentCtlRequest;

  Для события OnCreate формы запишите процедуру:
  procedure TForm1.FormCreate(Sender: TObject);
  begin
    //загружаем персонаж «Джин»
    Request := Agent1.Characters.Load('genie', 'genie.acs');
    //получаем объект персонажа Джин
    Character := Agent1.Characters.Character('genie')as IAgentCtlCharacterEx;
    //Джин появляется
    Request := Character.Show(False);
    //Джин здоровается и вкратце рассказывает о себе
    Request := Character.Speak('Здравствуйте! '+Сharacter.Description, EmptyParam);
    //Джин играет анимацию «Greet»
    Request:=Character.Play('Greet');
  end;

При закрытии формы нужно выгрузить персонаж:
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Agent1.Characters.Unload(‘genie’);
end;

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

Procedure GetAgentAnim(st: TStrings);
var
  AnEnum: IEnumVariant;
  flag: Cardinal;
  V: OleVariant;
begin
  //получаем интерфейс анимаций агента
  AnEnum := (Character.AnimationNames.Enum) as IEnumVariant;
  //Сбрасываем указатель списка на начало
  AnEnum.Reset;
  //перебираем все анимации и добавляем их в наш список
  repeat
    AnEnum.Next(1, V, flag);
    if (VarToStr(V) <> '') then
      st.Add(V);
  until (flag = 0);
end;

Давайте проверим работоспособность данной процедуры. Добавьте на форму кнопку Button1 и список ListBox1. Дайте заголовок кнопке «Список анимаций» и запишите процедуру обработки её нажатия:

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetAgentAnim(ListBox1.Items);
end;

Данная процедура записывает список анимаций загруженного персонажа в компонент ListBox1. А теперь сделаем так, чтобы при двойном щелчке мышкой по ListBox’у Джин проигрывал выбранную анимацию:

procedure TForm1.ListBox1DblClick(Sender: TObject);
begin
  Request := Character.Play(ListBox1.Items[ListBox1.ItemIndex]);
end;

Теперь посмотрим, зачем нам переменная Request (её мы объявили как глобальную). Именно она служит для синхронизации действий персонажа (либо персонажей, если их несколько). Интерфейс IAgentCtlRequest имеет одно очень полезное свойство – Status. В зависимости от состояния запроса, который в данный момент выполняет персонаж, это свойство принимает следующие значения:

Status | Пояснения
  0             Запрос успешно выполнен
  1             Запрос «провалился»
  2             Запрос не выполняется, т.к. ждёт завершения обработки других запросов
  3             Запрос прерван
  4             Запрос обрабатывается

На основе этой таблички легко написать процедуру, которая будет дожидаться выполнения всех запросов к персонажу, а затем вернёт программе управление:

procedure WaitFor(Request:IAgentCtlRequest);
begin
  repeat
    Application.ProcessMessages;
    Status := Request.Status;
  until (Request.Status <> 2) and (Request.Status <> 4);
end;

Для примера добавьте на форму кнопку «Пример WaitFor»:

procedure TForm1.Button3Click(Sender: TObject);
begin
  //Джин произносит фразу
  Request := Character.Speak('Доброе утро', EmptyParam);
  {waitfor(Request);}
  //Показываем сообщение
  ShowMessage('Всё');
end;

Если нажать на кнопку, то Джин начнёт говорить и сразу же появится сообщение. А если снять комментарии со строки waitfor(Request);, то сообщение появится только после того, как Джин закончит говорить.
А сейчас «научим» Джина вслух произносить текущее время. Для этого ему нельзя подсунуть строку типа «21 час 44 минуты 32 секунды», эту строку он произнесёт так: «двадцать один час, сорок четвёртого минуты, тридцать второго секунды». В связи с этим, Джину нужно полностью «разжевать», что именно он должен произносить. Так что будем давать ему такую строку: «21 час, 44 минуты, 30 две секунды». Т.е. число, стоящее в женском роде (32 секунды), разделяем на составляющие (30 две секунды).
Добавьте на форму очередную кнопку «Сколько времени?» и запишите следующую процедуру:

procedure TForm1.Button1Click(Sender: TObject);
var
  buf, str: string;
  Hour, Min, Sec, Msec: Word;
  Hours, Mins, Secs: string;
  hs, ms, ss: string;
  DT: TDateTime;
begin
  hs := '';
  ms := '';
  ss := '';
  //узнаём текущее время
  DT := Now;
  //разбиваем его на составляющие
  DecodeTime(DT, Hour, Min, Sec, MSec);
  //смотрим, какое окончание должно быть у слова «час»
  case hour of
    2..4, 22, 23: hs := 'а';
    0, 5..20: hs := 'ов';
  end;
  //окончание слова «минута»
  case min of
    1, 21, 31, 41, 51: ms := 'а';
    2..4, 22..24, 32..34, 42..44, 52..54: ms := 'ы';
  end;
  //окончание слова «секунда»
  case sec of
    1, 21, 31, 41, 51: ss := 'а';
    2..4, 22..24, 32..34, 42..44, 52..54: ss := 'ы';
  end;
  //часы не будем преобразовывать, т.к. слово «час» мужского рода
  hours := inttostr(hour);
  //при необходимости разбиваем минуты на слова
  mins := inttostr(min);
  if (mins[length(mins)] = '1') and (min <> 11) then
  begin
    if (min > 10) then buf := mins[1] + '0 '
    else buf:='';
    mins := buf + 'одна';
  end
  else
  begin
    if (mins[length(mins)]='2') and (min<>12) then
    begin
      if (min>10) then buf:=mins[1]+'0 '
      else buf:='';
      mins := buf + 'две';
    end
  end
;
  //при необходимости разбиваем секунды на слова
  secs := inttostr(sec);
  if (secs[length(secs)]='1') and (sec<>11) then
  begin
    if (sec>10) then buf := secs[1] + '0 '
    else buf := '';
    secs := buf + 'одна';
  end
  else
  begin
    if (secs[length(secs)]='2') and(sec<>12) then
    begin
      if (sec>10) then buf := secs[1] + '0 '
      else buf:='';
      secs := buf + 'две';
    end;
  end;
  //составляем строку, которую должен произнести Джин
  str := hours + ' час' + hs+ ', ' + mins + ' минут' + ms + ', ' + secs + ' секунд' + ss;
  //Джин произносит строку str, а над ним отображается текущее время (рис.1)
  Request := Character.Speak('\Pit=18400\\Spd=100\\Map="'+str+'"="'+timetostr(DT)+'"\',EmptyParam);
end;



Напоследок рассмотрим некоторые параметры голосового движка. На один компьютер можно установить поддержку нескольких языков. Чтобы переключаться между ними, нужно изменять параметр персонажа LanguageID. В таблице приведены идентификаторы к некоторым языкам. Символ «$» означает, что число представлено в шестнадцатеричной системе счисления.               


Пример: Character.LanguageID := $409; – переключаемся на английский язык.
Ещё можно изменять сам голос. Для этого есть свойство TTSModeID. Ниже приведён список голосов для русского и английского языков.



Пример:
Сharacter.TTSModeID:='{06377F80-D48E-11d1-B17B-0020AFED142E}';
устанавливает женский голос для русского языка. Так что можете поиздеваться над Джином, заставляя его разговаривать женским голосом.
На сегодня всё, в следующей части мы научимся управлять Джином при помощи голосовых команд.

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


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