В модуле описан класс TMyItem, упрощающий работу с TListView в режиме таблицы (ViewStyle – vsReport).

type
  TMyItem=Class(TObject)
    Caption: String;
    SubItems: TStrings;
    constructor Create;
    destructor Destroy; override;
    procedure AddValueToItem(Value: String);
    procedure ApplyColumnWidthsToList(List: TListView);
    procedure AddItemToList(List: TListView);
    procedure ApplyColumnsToList(List: TListView);
    procedure ItemToMyItem(List: TListView; ItemIndex: Integer);
    procedure CaptionToMyItem(List: TListView);
    procedure CaptionWidthsToMyItem(List: TListView);
    function IsNumeric: Boolean;
    procedure StrToMyItem(s: String);
    function MyItemToStr: String;
    procedure Clear;
    function Count: Integer;
  end;

По порядку:

Caption и SubItems – аналогично элементам у TListView, решил их не прятать.

AddValueToItem – добавить значение. Если элемент ещё не заполнен, пойдёт в Caption, иначе в SubItems.

AddItemToList – добавить (скопировать) созданный элемент в указанный TListView.

ApplyColumnsToList – наш элемент содержит имена  столбцов. Присвоить их.

ApplyColumnWidthsToList – наш элемент содержит ширину столбцов. Присвоить.

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

ItemToMyItem – наоборот, берём информацию из существующего элемента TListView.

CaptionToMyItem, CaptionWidthsToMyItem – ApplyColumnsToList и ApplyColumnWidthsToList в обратном направлении.

StrToMyItem – преобразуем строку в TMyItem. Формат строки: Caption|SubItem1|SubItem2|…

MyItemToStr – формируем такую строку.

Ещё один момент: если мы присваиваем заголовок, и где-нибудь есть знак %, то он исчезнет, а у столбца появится свойство Tag=1. И в обратную сторону знак процента появится, если стоит Tag=1.

Скачать модуль MyItems.

И при копировании материала с блога, обязательно оставляйте прямую ссылка на http://parsers.info.

В своё время пришлось помучиться с TListView, ибо логически не сразу понятно, как работать с элементами в режиме таблицы. С этими и другими проблемами очень помогали форумы программистов. А сейчас этот модуль написал за две поездки в метро :)

Похожие записи

• Модуль crt для delphi. (1)
• Модуль crt для delphi (5)
• pagerank.dcu – модуль для определения pagerank на delphi (53)

Привет. Сегодня выкладываю исходник первой версии удачной на мой взгляд программы mr.gen.

Суть программы: мы вводим определённую маску, программа генерирует текстовый файл с нужными нам комбинациями символов. Чем программма уникальна? Мы можем задать все возможные варианты каждого символа, а программа выдаст все возможные варианты строки с символами во всех возможных их вариантах.

Очень много направлений, в которых программу можно доделать, – mr.gen with symbol filter, например. При использовании кода указываем автора, при копировании поста указываем источник.

Теперь кратко суть программы: mr.gen использует рекурсию:

procedure rec(f:string;n,len:integer);
var
  i:integer;
  buf:string;
begin
  buf:=marr[n];
  if n=len-1 then begin
    for i:=1 to Length(buf) do
      AddPARR(f+buf[i]);
    Exit;
  end;
  for i:=1 to Length(buf) do
    rec(f+buf[i],n+1,len);
end;

Процедура AddPARR уже записывает в файл конечный результат, сама процедура rec формирует определённый символ строки и добавляет его к ней. После добавления последнего символа как раз и дописывает в файл результата.

Скачать исходник mr.gen v0.

С помощью программы ЛовиВКонтакте можно скачивать видео и музыку из социальной сети вконтакте. Вконтакте видео и аудио, размещённое и разрешённое к просмотру пользователями.

Похожие записи

• Нет похожих записей.

Блог уже давно на автономном существовании, нет времени писать. Программирование ушло на второй, если не третий, план – я теперь работаю инженером-конструктором, уже на второй работе. Раньше проектировал сварные металлоконструкции из стальных профильных труб (квадратных и прямоугольных), а теперь – более точные детали станков. А статьи написаны, люди читают, и на этом спасибо. Не так давно один человек попросил исходники reparser’а, а я пообещал выложить и позабыл. Так вот, выкладываю.

Скачать исходники reparser.

Выкладываю как есть. Для перестановки частей используется массив строк type TParse=array[1..9] of string;
Парсим строку – делим на части:

function _parse(str,det:string):TParse;
var
  _out:TParse;
  p,i:integer;
begin
  p:=0;
  i:=1;
  repeat
    _out[i]:=Copy(str,p+Length(det),PosEx1(det,str,p+Length(det))-p-Length(det));
    p:=PosEx(det,str,p+Length(det));
    i:=i+1;
  until (p=0) or (i>=10);
  Result:=_out;
end;

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

Функция для перестановки частей строки местами:

function _concat(_p:TParse;template:string):string;
var
  _s:string;
  i:integer;
begin
  _s:=template;
  for i:=1 to 9 do
    _s:=StringReplace(_s,'%'+IntToStr(i),_p[i],[rfReplaceAll]);
  Result:=_s;
end;

В _p у нас уже части строки – это массив, напомню. Template – шаблон вида %1%2-%3; . Происходит замена вхождений %1..%9 на соответствующие элементы из массива. Не лучший вариант для быстродействия, но это не было моей целью.

При использовании материала или исходника ставить прямую ссылку / указывать, что использовали. Спасибо!

Похожие записи

• Krewedko Regger – исходники (1)
• получение пути к qip. (0)
• Моцарт из внутреннего динамика. Сороковая симфония и delphi. Часть 1. (2)
• Модуль crt для delphi. (1)
• Модуль crt для delphi (5)

Это всё сводится к обработке сообщения WM_DRAWCLIPBOARD, но дело в том, что никто просто так нам его не отправит. 

Немного теории.

Есть такое понятие, как «Clipboard chain» - назовём это цепочкой буфера обмена. Фактически в ней содержится список handle’ов окон, которым посылается сообщение WM_DRAWCLIPBOARD. На самом деле оно посылается только первому окну в цепочке. И каждое окно в этой цепочке должно (обязано :) ) обрабатывать это сообщение и ещё одно, о котором речь пойдёт дальше.

Поехали!

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

nwnd:=SetClipboardViewer(Handle);

nwnd – глобальная переменная типа Cardinal (тот же THandle), в неё мы получили следующий в цепочке handle, она нам пригодится в других процедурах.

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

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ChangeClipboardChain(Handle, nwnd);
end;

Функция  ChangeClipboardChain удаляет нас из цепочки. Функция рассылает сообщение WM_CHANGECBCHAIN окнам цепочки, нам это сообщение также предстоит обработать. Обычно возвращает false, true только в случае, если наше окно в цепочке было единственным. Нам результат этой функции не очень-то и важен.

Обработаем WM_CHANGECBCHAIN. Для тех, кто подзабыл: в раздел private типа TForm1 пишем procedure WMChangeCBChain(var msg: TWMChangeCBChain); message WM_CHANGECBCHAIN; и обрабатываем:

procedure TForm1.WMChangeCBChain(var msg: TWMChangeCBChain);
begin
 if msg.Remove=nwnd then
   nwnd:=msg.Next
 else
   SendMessage(nwnd, WM_CHANGECBCHAIN, msg.Remove, msg.Next);
end;

Здесь всё тоже несложно: если удалилось следующее в цепочке окно, берём на заметку – меняем nwnd на теперь действительное следующее окно. Иначе уведомляем следующее окно, как этого требует цепочка.

Осталось только обработать событие  WM_DRAWCLIPBOARD:

procedure TForm1.WMDrawClipBoard(var msg: TWMDrawClipboard);
begin
 if ClipBoard.HasFormat(CF_TEXT) then
   ShowMessage(ClipBoard.AsText)
 else
   ShowMessage('скопирован не текст');
 SendMessage(nwnd, WM_DRAWCLIPBOARD, 0, 0);
end;

Вот так вот, всё просто. Смотрим, что скопировано, делаем, что нам нужно, и отправляем сообщение по цепочке дальше.

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

Для ленивых предлагаю скачать исходник.

(c) crystalbit, http://parsers.info
При копировании материала обязательно ставить прямую ссылку на источник.

Похожие записи

• Работаем с окнами. AnimateWindow и FlashWindow. (0)
• Работаем с окнами и объектами. Часть 4. Функции и процедуры. (0)
• Работаем с окнами и объектами. Часть 3. Поиск объектов. (0)
• Работаем с окнами и объектами. Часть 2 (0)
• Работаем с окнами и объектами. Delphi. Api. Часть 1 (2)

Задавшись этим вопросом, полез смотреть, с каких страниц его можно спарсить. Первое, что попадается, это картинка, которая показывается при просмотре аттестата WebMoney (например, вот эта). Далее в заметке буду использовать wmid 000000000000 для примера. Можно и картинку распознать – не вопрос, но зачем так сложно?

Побродив немного по форумам и прочим ссылкам из выдачи, нашёл ещё пару возможностей определить WebMoney BL. Пара скриптов с https и, о чудо, простой скрипт, выдающий основную информацию о сертификате.

Итак, наша цель сводится к простой задаче парсинга html-страницы.

Что парсим? http://passport.webmoney.ru/asp/certcard.asp?id=000000000000 – вот ссылка. Зайдя на неё, видим информацию о: типе аттестата, фио, бизнес-уровне (тот самый BL), дате регистрации и количестве претензий. Мы спарсим только BL, но ничего не стоит потом изменить программу и для парсинга остальных значений.

Для простоты поставим на форму TIdHTTP, TEdit и TButton. В процедуре Button1Click создадим переменные:

var
 resp: string;
 bl, err: integer;

В resp получим код страницы:

 resp:=IdHTTP1.Get('http://passport.webmoney.ru/asp/certcard.asp?id='+Edit1.Text);

Теперь присмотримся к коду страницы: нужное нам значение бизнес-уровня находится сразу после [BL]:</span> и пробела. Чтобы получить это число, скопируем 10 символов после этого фрагмента и используем процедуру Val:

Val(Copy(resp ,Pos('[BL]:</span>',resp)+13,10), bl, err);

Если всё сработало правильно (то есть WebMoney не поменяли формат вывода того скрипта), то в bl окажется так нужный нам Business Level, а в err – 0, если длина BL 10 символов (что вряд ли возможно), 1 в случае ошибки или число от двух до десяти, которое показывает позицию первой «не цифры».

То есть, в случае err=1 мы имеем ошибку, иначе bl получен верно. Весь код:

procedure TForm1.Button1Click(Sender: TObject);
var
 resp: string;
 bl, err: integer;
begin
 resp:=IdHTTP1.Get('http://passport.webmoney.ru/asp/certcard.asp?id='+Edit1.Text);
 Val(Copy(resp ,Pos('[BL]:</span>',resp)+13,10), bl, err);
 if err<>1 then
 ShowMessage('WebMoney BL: '+inttostr(bl))
 else
 ShowMessage('error retrieving WebMoney BL');
end;

(c) crystalbit, http://parsers.info

Похожие записи

• Построчный парсинг (24)
• Парсим даты апдейтов с главной pr-cy (104)
• Парсим csv и tsv файлы в delphi (10)
• Количество подстрок в строке. (3)

Пропали некоторые последние комментарии и один пост, про то, что блог теперь уже не dofollow, но все комментарии, сделанные до того поста, остались dofollow.

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

Вполне может оказаться необходимым контролировать перемещение формы пользователем – будь то некоторая стыковка к границам экрана или необходимость запретить перемещать форму.

Мы сперва лезем в Events, видим, что события OnMove нету.

Итак, существует два события: WM_MOVING и WM_MOVE. Первое передаётся окну, когда его перетаскивают, а второе, когда уже переместили. В принципе, в windows xp и выше (а может ещё и чуть раньше) при перемещении окна курсором оно сразу меняет позицию (в отличие от windows 95, например, там мы перемещали контур окна), WM_MOVE возникает достаточно много раз, поэтому не вижу особого смысла его использовать.

Для примера поставим Label1 на форму. Теперь в раздел private типа TForm1 напишем:

procedure WMMoving (var msg: TWMMoving); message WM_MOVING;

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

procedure TForm1.WMMoving (var msg: TWMMoving);
begin
  Label1.Caption:=IntToStr(msg.DragRect.Left)+';'+IntToStr(msg.DragRect.Top);
end;

Можно проверить, при перемещении формы в Label1 меняются её координаты.

Хочу добавить, что это заметка, которая не претендует на журнальную статью, но я решил об этом написать, так как передо мной встал вопрос, отражённый в заголовке. Буду и дальше писать конкретно и по теме блога :)

(с) crystalbit, http://parsers.info

Вопрос восстановления файлов – важный вопрос. Если бы всё было так просто, я не потерял бы бд блога, которая сгорела вместе с хостингом (к слову, похоже на то, что каталог с базами специально отформатировали). Программ есть много (та же Recuva), но они не всегда могут помочь.

Похожие записи

• Работаем с окнами. AnimateWindow и FlashWindow. (0)
• Работаем с окнами и объектами. Часть 4. Функции и процедуры. (0)
• Работаем с окнами и объектами. Часть 3. Поиск объектов. (0)
• Работаем с окнами и объектами. Часть 2 (0)
• Работаем с окнами и объектами. Delphi. Api. Часть 1 (2)

Так вот, уже позже, 23 ноября того года, я написал статью (пост, заметку) с алгоритмом работы программы. Но, мало чего понимая в нотной грамоте, допустил пару ошибок.

Сейчас исправил, кое-чем дополнил и заново привлекаю внимание к той статье.
Моцарт из внутреннего динамика. Сороковая симфония и delphi. Часть 1.
Моцарт из внутреннего динамика. Сороковая симфония и delphi. Часть 2.

Спасибо за внимание

Похожие записи

• Сороковая симфония Моцарта из внутреннего динамика. (20)
• Моцарт из внутреннего динамика. Сороковая симфония и delphi. Часть 2. (1)
• Моцарт из внутреннего динамика. Сороковая симфония и delphi. Часть 1. (2)

Открываем, редактируем список из строк и оставляем поверх всех окон. Изначально выделена первая строчка, она находится уже в буфере обмена. Нажимая Shift-Insert, мы можем это, очевидно, куда-либо вставить.

Программа перехватывает нажатие Shift-Insert и, когды ты уже отпустил, копирует в буфер следующее значение.

То есть, с достаточной подготовкой, можно быстро заполнять формы, нажимая Shift-Ins, Tab, …

При закрытии программы ClipFill список сохраняется.

Под катом программа, исходник и вопрос к читателям.Программа ClipFill достаточно сырая, писал на коленке для одного сайта (lockerz, заказал с помощью неё термос :D ).

Вопрос: какие комбинации клавиш сделать для того, чтобы вернуть в буфер предыдущее значение и вернуться к первому?

Автор crystalbit, http://parsers.info

При копировании поста прямую ссылку оставлять обязательно.

Скачать ClipFill: программа, исходник

Похожие записи

• Нет похожих записей.

А что если, например, у нас на форме штук 20 TPanel, и нам нужно у пяти из них поменять высоту?
Передо мной сейчас как раз и встала такая задача.

Всё очень просто:

• Выделяем нужные компоненты (в данном случае TPanel).
• Ставим свойство Tag отличное от нуля – по нему мы поймём, что этот компонент – нам нужный
• И вот мой код:

  var
    i: integer;
  begin
    for i:=0 to ComponentCount-1 do
      if Components[i].Tag=1 then
        (Components[i] as TControl).Height:=Panel3.Height div 6;
  end;
  

В общем, всё аналогично той статье, но теперь мы используем свойство Tag компонента, чтобы отделить его от общей массы, а не тип.

Между делом замечу, что у меня последние два апа тиц держится на уровне полтинника, а я на него не потратил ни копейки (не считая кое-каких услуг после последнего апдейта). Можно вручную пытаться получить ссылки, а можно и заказать seo оптимизацию.

Похожие записи

• Нет похожих записей.

Три даты. Чтож, ТЗ есть.

Теперь смотрим исходный код фрагмента:

<p><span class="blue">G</span><span class="red">o</span><span class="yellow">o</span><span class="blue">g</span><span class="red">le</span> <span class="lar">PR</span><span class="date"><acronym title="11 д. назад">03.04.2010</acronym></span></p>

<p><span class="red">Я</span><b>ндекс</b> <span class="ar">тИЦ</span><span class="date"><acronym title="6 д. назад">08.04.2010</acronym></span></p>
<p class="p-last"><span class="ar">выдача</span><span class="date"><b>13.04.2010</b></span></p>

Достаточно примечательный фрагмент.

Итак, создадим новую программу, поставим кнопку и надпись (Button1 и Label1).
Для получения страницы мы будем использовать библиотеку Synapse, поэтому подключим модуль httpsend.

В процедуре-обработчике нажания на кнопку пропишем:

procedure TForm1.Button1Click(Sender: TObject);
var
  vres: TStringList;
begin
  vres:=TStringList.Create;
  if HttpGetText('http://pr-cy.ru', vres) then begin
    // мы успешно получили код страницы pr-cy, дальше будем писать сюда
  end else begin
    ShowMessage('error getting pr-cy!');
  end;
  vres.Free;
end;

Теперь введём переменные scy, spr, syv: string; и константу cpr = ‘<span class=»lar»>PR</span>’; – по ней мы будем ориентироваться.

Строки с датами найдём так:

    i:=0;
    Repeat
      if Pos(cpr, vres.Strings[i])<>0 then break;
      i:=i+1;
    until 1=0;
    spr:=vres.Strings[i];
    scy:=vres.Strings[i+1];
    syv:=vres.Strings[i+2];

Выделим в каждой строке span с помощью функций delete, pos и posex (strutils):

    i:=Pos('<span class="date">', spr);
    Delete(spr, 1, PosEx('">', spr, i+1)+1);
    i:=Pos('<span class="date">', scy);
    Delete(scy, 1, PosEx('">', scy, i+1)+1);
    i:=Pos('<span class="date">', syv);
    Delete(syv, 1, PosEx('">', syv, i+1)+1);

Ещё немного попарсим:

    i:=Pos('<span class="date">', spr);
    Delete(spr, 1, PosEx('">', spr, i+1)+1);
    i:=Pos('<span class="date">', scy);
    Delete(scy, 1, PosEx('">', scy, i+1)+1);
    i:=Pos('<span class="date">', syv);
    Delete(syv, 1, PosEx('">', syv, i+1)+1);
    repeat
      i:=Pos('<', spr);
      if i=0 then break;
      Delete(spr, i, PosEx('>', spr, i));
    until 1=0;
    repeat
      i:=Pos('<', scy);
      if i=0 then break;
      Delete(scy, i, PosEx('>', scy, i));
    until 1=0;
    repeat
      i:=Pos('<', syv);
      if i=0 then break;
      Delete(syv, i, PosEx('>', syv, i));
    until 1=0;
    spr:=StringReplace(spr, '>', '', [rfReplaceAll]);
    scy:=StringReplace(scy, '>', '', [rfReplaceAll]);
    syv:=StringReplace(syv, '>', '', [rfReplaceAll]);
    spr:=StringReplace(spr, ' ', '', [rfReplaceAll]);
    scy:=StringReplace(scy, ' ', '', [rfReplaceAll]);
    syv:=StringReplace(syv, ' ', '', [rfReplaceAll]);

И можно вывести результат:

    Label1.Caption:='pr: '+spr+#13#10+'тИЦ: '+scy+#13#10+'Выдача: '+syv;

Вот и вся арифметика. Скачать проект с парсингом дат можно по этой ссылке.
Также советую готовую программу от Борисова Сергея – Search Monitor, спасибо, что обратили на неё внимание :)

Давно я не появлялся :) Меня просто очень сильно мотивировали написать пост обои для рабочего стола. Они бесплатные :D

Похожие записи

• Построчный парсинг (24)
• Парсим csv и tsv файлы в delphi (10)
• Определяем WebMoney BL (86)
• Количество подстрок в строке. (3)