Блог начинающего программиста: февраля 2011

пятница, 18 февраля 2011 г.

Парсинг

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

Заходим на страницу, смотрим между какими тегами будем парсить.

<div class="text">
<table class="votingbox" border="0">

Так мы нашли теги от куда мы будем брать наш текст, теперь напишем сам код.
Создадим функцию, назовем ParsingAnegdot объявим переменную GetTex в нее будет входит сам html код странице, результат будет типа String.

function TForm1.ParsingAnegdot(GetText: String): String;
begin

end;

Теперь нам осталось описать функцию чем мы сейчас и займемся.
Объявим переменную Str тип String, там будет хранится результат(анекдота). Переменные p1,p2 тип Integer, будет хранится позиция тегов.

function TForm1.ParsingAnegdot(GetText: String): String;
var
 str: String; // Результат
 p1,p2: Integer; // Позиции поиска, Pos
begin
  repeat
   p1 := Pos('<div class="text">' ,GetText) + 18; // Позиция тега 1
   p2 := Pos('<table class="votingbox" border="0">', GetText); // Позиция тега 2
   Str := Copy(GetText,p1, p2 - Pos('<div class="text">' ,GetText) - 18 ); // Вытаскиваем под тегами, сам Анекдот
   Memo1.Lines.Add(Str); // Добавляем анекдот с новой строки
   Str := '';  // Обнуляем результат
   Delete(GetText,1,p2); // Удалеем с начала html кода, до конца позиции анегдота
  until Pos('<table class="votingbox" border="0">', GetText) = 0; // Ищим до тех пор пока теги найдены.

 // Удаляем все не нужные теги.
  Memo1.Lines.Text :=  AnsiReplaceText(Memo1.Lines.Text, '<br />', ' ');
  Memo1.Lines.Text :=   AnsiReplaceText(Memo1.Lines.Text, '</div>', ' ');
  Memo1.Lines.Text := AnsiReplaceText(Memo1.Lines.Text, '<br />', ' ');
  Memo1.Lines.Text := AnsiReplaceText(Memo1.Lines.Text, '<div class="site">', ' ');
  // Удаляем все не нужные теги.
end;

Функцию написана, надеюсь все понятно. Теперь на форму добавим компонент Memo, Кнопку Button, пожалуй все. Чуть не забыл компоненты IdHTTP1 и IdAntiFreeze1.

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

unit CLXMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, StrUtils;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Memo1: TMemo;
    IdHTTP1: TIdHTTP;
    IdAntiFreeze1: TIdAntiFreeze;
    procedure Button1Click(Sender: TObject);
    function ParsingAnegdot(GetText: String): String;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 GetText: String;
begin
 GetText := IdHttp1.Get('http://www.anekdot.ru/a/an1102/j110218;100.html');
 ParsingAnegdot(GetText);
end;

function TForm1.ParsingAnegdot(GetText: String): String;
var
 str: String; // Результат
 p1,p2: Integer; // Позиции поиска, Pos
begin
  repeat
   p1 := Pos('<div class="text">' ,GetText) + 18; // Позиция тега 1
   p2 := Pos('<table class="votingbox" border="0">', GetText); // Позиция тега 2
   Str := Copy(GetText,p1, p2 - Pos('<div class="text">' ,GetText) - 18 ); // Вытаскиваем под тегами, сам Анекдот
   Memo1.Lines.Add(Str); // Добавляем анекдот с новой строки
   Str := '';  // Обнуляем результат
   Delete(GetText,1,p2); // Удалеем с начала html кода, до конца позиции анегдота
  until Pos('<table class="votingbox" border="0">', GetText) = 0; // Ищим до тех пор пока теги найдены.

 // Удаляем все не нужные теги.
  Memo1.Lines.Text :=  AnsiReplaceText(Memo1.Lines.Text, '<br />', ' ');
  Memo1.Lines.Text :=   AnsiReplaceText(Memo1.Lines.Text, '</div>', ' ');
  Memo1.Lines.Text := AnsiReplaceText(Memo1.Lines.Text, '<br />', ' ');
  Memo1.Lines.Text := AnsiReplaceText(Memo1.Lines.Text, '<div class="site">', ' ');
  // Удаляем все не нужные теги.
end;
end.

четверг, 10 февраля 2011 г.

Задачи и их решения.

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

Задача №1
Найти сколько раз каждый элемент встречается в массиве, дополнительных массивов не создавать.

Program zad1;
var
 m: Array [1..10] of Integer;
 i,j,Count: Byte;
begin
 WriteLn('| Массив |');
 Randomize;
 for i := 1 to 10 do // Присваиваем каждый элемент массива рандомное число и выводим на экран.
  begin
  m[i] := Random(10)-5;
  Write(m[i],' ');
  end;
  Writeln;
 for j := 1 to 10 do // Сравнение элементов массива.
 begin
 Count := 0;
  for i := 1 to 10 do
   begin
    if m[j] = m[i] then // Сравнение массива j со всеми элементами массива
    begin
    Inc(Count); // Если элемент равен то прибавляем +1.
    end;
  end;
 WriteLn('Элемент: ',m[j],' встречался ',count,' раз.');
 end;
end.

вторник, 8 февраля 2011 г.

Pascal. Множества

Каждый из объектов множества имеет какую то взаимосвязь. Выражения указываются в квадратные скобки, например ['a'..'z'] [1,3,4,5]. Множество на Pascal объявляется так set of - множество из.

var
s: Set of 0..9; // Множество может принимать значение от 0 до 9
m: Set of 'a'..'z'; // множество принимает символы от a до z 
t: Set of Char; // может принимать любое символьное значение

Операции над множествами.
Операция in для проверки вхождения в множество, проверяет входит ли значение в множество.

Var
 a: Set of 1..5;
 b: integer;
begin
 a := [1..5];
 WriteLn('Vvedite znashenie b =');
 ReadLn(b);
 if b in a then WriteLn('True - vhodit') else WriteLn('False - ne vxodit');
end.

Операция '='. Если значение равно то результат принимает True если не равно False.

Var
 s,b: Set of 'a'..'z';
 j: Boolean; // Результат
begin
 s := ['a','g','c'];
 b := ['a','c','g'];
 j := s = b; // Сравниваем значения s и b.
 WriteLn(j);
 end.

Пересечение множеств (*). Если значения двух множеств пересекаются, то результатом будет их пересечения.

Var
 s,b,j: Set of 1..100;
begin
 s := [1,4,5,2,5];
 b := [1..100];
 j := s * b;
end.

Операция (-). Разность множеств. Допустим что у нас [1,5,7,3] - [4,1,7,3,5] то результат будет то что не входит, то есть это 4.

var
 s,b,rezult: Set of Byte;
begin
 s := [1,2,3,4,5];
 b := [5,4,3,2];
 rezult := s - b; // Результат '1'.
end.

Операция (+) объединения.

Var
 s,b,j: Set of 1..9;
begin
 s := [1,2,3,4,5];
 b := [6,7,8,9];
 j := s + b; // Результат 1,2,3,4,5,6,7,8,9
end.

Еще есть операции такие как:
<> - не равно. ['a','f','g'] <> ['a','f','j'] = True
<= - меньше или равно. ['b','g'] <= ['b','c','v'] = True
>= - больше или равно ['s','b'] >= ['f'] даст False
Операции '<' и '>' не допустимы!

Еще есть две процедуры для множеств:
Include(s,i) - Включает новый элемент I в множество S
Exclude(s,i) - Исключает элемент I из множества S

четверг, 3 февраля 2011 г.

Зависание get запроса

Как убрать зависание get запроса?
В некоторых случаях компонент IdAntiFreeze убирает зависание get запроса, компонент находится на вкладке Indy Misc. Нужно просто добавить компонент.

среда, 2 февраля 2011 г.

Парсинг HTML

Как спарсить текст со страницы? Парсить будем стандартными функциями copy,pos. Сделаем get запрос, что бы получить html код страницы и начнем "парсить".
1. Добавьте компонент IdHTTP1 с вкладки Indy Clients. Отправим get запрос с помощью компонента.
Memo1.Text := idHttp1.Get('http://bash.org.ru/quote/11');

2. Начинаем "парсить", для начала вытащим слово 'Войти',
<a href="http://mail.yandex.ru"onclick="c(this,17,1080)">Войти в почту</a> .
Начинаем с позиции ' )"> ' до ' &nbsp '. Получается такой код:

var
Str: String; \\ в переменной str будет хранится результат 
begin
str := Copy(memo1.Lines.Text,Pos(' )"> ',memo1.Lines.Text) + 3, pos('   ',memo1.Lines.Text) - pos(')">',memo1.Lines.Text) - 3 );
           ShowMessage(Str); // выводим на экран сообщение.

3. Приведу еще пример:
Нужно вытащить текст Студия Артемия Лебедева.
<a href="http://www.artlebedev.ru"onclick="c(this,17,1084)">Студия Артемия Лебедева</a></p></td>
Но у нас будем ответ, типо 'Студия Артемия Лебедева' а нужно 'Студия Артемия Лебедева'
Есть функция AnsiReplaceStr(Str, Text, Text1: String) - замена выражения Text на Text1 в строке str.
То есть функцию напишем так Str:=AnsiReplaceStr(Str, ' ',' '); и у нас получается:

procedure TForm1.Button2Click(Sender: TObject);
 var
 Str: String;
 begin
str := Copy(memo1.Lines.Text,Pos('84)">',memo1.Lines.Text) + 5, pos('</a>
',memo1.Lines.Text) - pos('84)">',memo1.Lines.Text) - 5 );
Str:=AnsiReplaceStr(Str, ' ',' ');
ShowMessage(Str);
end; end.

На сегодня все, надеюсь статья вам помогла освоить мой пример парсинга.

Блог начинающего программиста