Для начинающих работать с компонентом IdHTTP в Delphi

Найти компонент idHTTP можно на вкладке Indy Clients.

После того, как поместите его на форму, посмотрите его параметры и свойства в Object Inspector- е. Вы увидите, что работать с протоколом HTTP с помощью этого компонента достаточно просто. Для "составления" правильных заголовков запросов к серверу будем плотно работать с TIdHTTP.Request. Многие поля вам уже знакомы. Там же есть возможность привязки к объекту idHTTP компонента для удобной работы с кукисами (компонент idCookieManager) и настройка работы через прокси.

Рассмотрим способы отправки запросов Get и Post. С такими названиями существуют и функции, и процедуры. Непосредственно перед отправкой запроса следует настроить свойства вышеупомянутого IdHTTP.Request-а, если есть необходимость. Например, UserAgent в idHTTP по умолчанию Mozilla/3.0 (compatible; Indy Library), и, чтобы не палиться, следует его заменить на что-нибудь более безобидное :) А если вы создаете экземпляры компонента idHTTP динамически для парсинга страниц какого-нибудь большого сайта, то юзерагента можно вообще брать Рандомом из заранее подготовленного списка.

Пример использования процедуры idHTTP.Get без дополнительных настроек:


var   
  mStream: TMemoryStream;   
   
mStream := TMemoryStream.Create;   
try   idHttp := TIdHTTP.Create(nil);   
  {  тут  следует  "настроить " параметры  idHTTP }   
  { ... }   
  try   
    idHttp.Get(URL, mStream);   
  finally   
    idHttp.Free;   
  end;   
finally   
  mStream.Free;   
end;  

Или с помощью функции получить содержимое страницы в строковую переменную:


Str := idHttp.Get(URL); 

С POST-запросом дела обстоят аналогично, с одним отличием: при отправке POST-запроса передаются еще и параметры. Думаю, что более подробно рассмотрю POST-запрос в следующем посте, с примером авторизации на сайте (чтобы не пихать слишком много информации в одну запись ).

Какие еще аспекты работы с idHTTP следует отметить?
После посылки запроса проверить ответ сервера можно, посмотрев содержимое свойства


idHTTP.Response.ResponseText   

Стандартым ответом о том , что все прошло удачно , является HTTP/1.0 200 OK.

Бывают и другие ответы сервера (про коды ответов я упоминала в одной из предыдущих записей). Остановлю внимание только на двух наиболее часто встречающихся группах:
2хх: Успешно. Сигнал был успешно принят, понят и принят к обработке.
Зхх: Перемаршрутизация . Необходимо предпринять определенные действия , чтобы выполнить запрос.

Исключения, возникающие при работе компонентов Indy (тип EIdH TTPProtocolException),
классифицируются особым образом.


Except   
on E:EIdHTTPProtocolException do   
ShowMessage(E.ErrorMessage);  

Классификация исключений может пригодиться . У меня был случай , когда написанный парсер работал без проблем , но спустя какое -то время отказался работать . Помог анализ ответа сервера : на сайте временно поставили перенаправление (Код 302 Found:
HTTP_FOUND — Запрошенный ресурс был временно перемещен на новый URI), возможность которого я в начальной версии не предусмотрела. С тех пор во всех своих парсерах я проверяю код ответа: не 302 ли случаем? (Если код ответа 301 (Moved Permanently:
HTTP MOVED PERMANENTLY — Запрошенный документ был перенесен на новый URI), то информация берется без проблем, если у idHTTP свойство HandleRedirects := true, а вот с 302 это не прокатывает. Так же отдельно я обрабатываю код 404). Еще у компонента надо грамотно настроить все таймауты, чтобы, если обнаружится исключительная ситуация, запрос не "подвисал".

Пример кода для обработки исключений разного типа:


procedure TForm1.Button1Click(Sender: TObject);   
begin   
 Memo1.Lines.Clear;   
 try   
   Memo1.Lines.Add(IdHTTP1.Get(Edit1. Text));   
 except on e : EIDHttpProtocolExcepti on do   
   Begin      if e.ErrorCode = 302 then   
       begin   
         try   
           // получаем новый адрес - адрес перенаправления   
           Memo1.lines.add(idhttp1.Ge t(IdHTTP1.Response.Locati on));   
         except on e:Exception do   
    // предусматриваем, что исключение  может возникнуть и тут    
           ShowMessage(' Ошибка  при  получении  нового  адреса .'+e.Message);   
         end;   
       end   
     else   
       //http 404, 501  и так  далее    
       ShowMessage(' Ошибка  другого  вида , не  302:'+e.Message);   
   end;   
 on e:Exception do   
   ShowMessage('Ошибка: ' + e.Message);    
 end;   
end;  

Добавлено: 01 Августа 2018 07:26:12 Добавил: Андрей Ковальчук

Динамическое создание компонентов

Сегодня поговорим о том, как создавать компоненты во время работы программы.

Иногда заранее не известно количество компонентов. Поэтому в Delphi есть возможность создать их из программы. Для этого достаточно вызвать конструктор Create, установить нужные свойства и события. А для появления компонента на экран нужно установить свойство Parent.

При нажатии на левую кнопку мыши эта программа создает Button, а при нажатии на правую - Panel. Причем компоненты создаются там, где находится мышь. Если Вы нажали на Panel1, то компонент появится на Panel1.


...  
  public  
    procedure OnButtonClick(Sender: TObject);  
  end;  
  
var  
  Form1: TForm1;  
  
implementation  
  
{$R *.DFM}  
  
uses stdctrls, extctrls;  
  
procedure TForm1.OnButtonClick(Sender: TObject);  
begin  
  if Sender is TButton then  
    with (Sender as TButton) do  
      Caption := Caption + '1';  
end;  
  
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;  
  Shift: TShiftState; X, Y: Integer);  
var  
  b: TButton;  
  p: TPanel;  
begin  
  if Button = mbRight then begin  
    p := TPanel.Create(nil);  
    p.Caption := 'Panel' + IntToStr(random(100));  
    p.Left := X;  
    p.Top := Y;  
    p.Width := random(200) + 100;  
    p.Height := random(200) + 100;  
    p.OnMouseDown := Form1.OnMouseDown;  
    p.Parent := Sender as TWinControl;  
  end else begin  
    b := TButton.Create(nil);  
    b.Caption := 'Button' + IntToStr(random(100));  
    b.ShowHint := true;  
    b.Hint := 'Hint for ' + b.Caption;  
    b.Left := X;  
    b.Top := Y;  
    b.OnClick := OnButtonClick;  
    b.Parent := Sender as TWinControl;  
  end;  
end;  

Но может понадобиться что-то делать с компонентами после их создания. В этом случае нужно создать массив, в котором будут лежать эти компоненты. Эта программа хранит в массиве 100 кнопок. При изменении размера окна кнопки перегруппируются.


var  
  b: array [0..99] of TButton;  
  
procedure TForm1.FormCreate(Sender: TObject);  
var  
  i: integer;  
  c: integer;  
begin  
  c := Form1.ClientWidth div 52;  
  for i := low(b) to high(b) do begin  
    b[i] := TButton.Create(nil);  
    b[i].Caption := IntToStr(i + 1);  
    b[i].Width := 50;  
    b[i].Height := 20;  
    b[i].Left := 52 * (i mod c);  
    b[i].Top := 22 * (i div c);  
    b[i].Parent := Form1;  
  end;  
end;  
  
procedure TForm1.FormResize(Sender: TObject);  
var  
  i: integer;  
  c: integer;  
begin  
  c := Form1.ClientWidth div 52;  
  for i := low(b) to high(b) do begin  
    b[i].Left := 52 * (i mod c);  
    b[i].Top := 22 * (i div c);  
  end;  
end;  

Добавлено: 01 Августа 2018 07:25:09 Добавил: Андрей Ковальчук

Динамические массивы

Мы снова возвращаемся к Delphi. Я уже рассказал тебе достаточно много начальных знаний, поэтому я больше не буду размусоливать каждую строчку. Начиная с этого номера, я буду давать тебе пример и объяснять, что в нём происходит.

Цель это примера научить тебя работать с динамическими массивами, ты будешь встречаться с ними постоянно, поэтому я решил уделить этому внимание уже сейчас. Рассмотрим первую процедуру:


var  
 r:array of integer;  
 i:Integer;  
begin  
 ListBox1.Items.Clear;  
 SetLength(r,10);  
  
 for i:=0 to High(r) do  
  begin  
   r[i]:=i*i;  
   ListBox1.Items.Add(IntToStr(i)+' в квадрате ='+IntToStr(r[i]));  
  end;  

Эта процедура вызывается по нажатии первой кнопки. В области объявлений VAR я объявил две переменные. Первая это r которая является массивом чисел типа Integer. Вторая i это переменная, которую я буду использовать в качестве счётчика. Переходим к самой процедуре:

Первая строка очищает все строки у ListBox1. Для этого вызывается процедура ListBox1.Items.Clear. Объясню подробней. У ListBox1 есть свойство Items, где хранятся все строки. У Items есть метод Clear, который удаляет все находящиеся в нём строки.

Во второй строке вызывается процедура SetLength, которая выделила память для массива r (первый параметр), размером в 10 элементов (второй параметр). Обращение к элементом будет происходить как r[номер_элемента]. Элементы будут нумероваться от 0 до 9. Вообще, в программировании всё нумеруется с нуля.

Далее используется конструкция:


for выражение1 to выражение2 do  
  begin  
  end;  

Эта конструкция создаёт цикл выполняя операторы между Begin и End, "Выражение2" - "Выражение1" количество раз. Функция High(r) возвращает количество элементов в массиве r. В итоге получается, что цикл будет выполняться от i:=0 (от нуля), до количества элементов в массиве r (до 9). Внутри массива выполняется две строки:

r:=i*i . Здесь i-му элементу массива присваивается i*i. ListBox1.Items.Add(IntToStr(i)+' в квадрате ='+IntToStr(r[i])); Эта строка добавляет новый элемент в ListBox1. Функция IntToStr переводит число в строку. С первой процедурой мы разобрались, теперь перейдём ко второй: [DELPHI]type TDynArr=array of integer; var r:TDynArr; i:Integer; begin ListBox1.Items.Clear; SetLength(r,10); for i:=0 to High(r) do r[i]:=i*i; SetLength(r,20); for i:=10 to High(r) do r[i]:=i*i; for i:=0 to High(r) do ListBox1.Items.Add(IntToStr(i)+' в квадрате ='+IntToStr(r[i]));
Эта процедура выполняет похожие действия, но с небольшими особенностями. В начале я объявляю новый тип: TDynArr=array of integer . После этого конструкция r:TDynArr; будет означать, что r относится к типу TDynArr, а тот относится к array of integer; . Это тоже самое, что мы писали в первой процедуре r:array of integer; , только такая конструкция удобней, если ты захочешь объявить несколько динамических массивов. Тебе не приходится сто раз писать громоздкую строку r:array of integer; , ты объявляешь новый массив как TDynArr.

Далее идёт всё та же очистка строк и выделение памяти под массив.


for i:=0 to High(r) do  
  r[i]:=i*i;  

Эта конструкция заполняет десять элементов квадратами числа i. После этого я снова вызываю функцию SetLength(r,20);, в которой говорю, что массив теперь будет состоять из 20-и элементов. Таким способом можно как увеличивать количество элементов, так и уменьшать.


for i:=10 to High(r) do  
  r[i]:=i*i;  

Здесь я заполняю квадратами числа i элементы начиная с 10 по последний. И в конце я снова заполняю ListBox1 значениями элементов массива.

Теперь о том, как я изменил иконку для программы. Для того, чтобы изменить иконку для формы нужно дважды щёлкнуть в Object Inspector по свойству Icon и выбрать любую.

Для изменения иконки программы нужно щёлкнуть по меню Project и выбрать пункт Option . В появившемся окне выбрать закладку Application и на этой странице нажать кнопку Load Icon .

На сегодня новостей больше нет.

Добавлено: 01 Августа 2018 07:24:27 Добавил: Андрей Ковальчук

Делаем многострочный Caption у Button

Не раз сталкивался с такой проблемой когда необходимо что бы caption у button был многострочным т.е если подпись не влезает в размеры кнопки она располагалась не в одну строку а в несколько.

Как это сделать мы и разберем в данном уроке.

Ну что погнали, открываем delphi создаем новый проект, сейчас нужно сразу оговориться что делать многострочными мы будем все кнопки, которые находиться на панели. И сразу же кидаем на форму компонент Panel с закладки Standart, на неё ставим 2 компонента button так же с закладки Standart. Далее выберите Первую кнопку и в свойстве Caption напишите побольше текста, тоже самое проделываем и со второй кнопкой.

А вот теперь и начинается самое интересное.

Переходим в код и после ключевого слова private пишем


procedure SetMultiLineButton(AParent: TWinControl) ;   

Нажимаем комбинацию клавиш CTRL+ SHIFT + C если кто не понял, мы только что создали процедуру, но сейчас она пустая, поэтому Посмотрите что получилось у меня и добавьте к себе не достающие строки.


procedure TForm1.SetMultiLineButton(AParent: TWinControl);  
var j : integer;  
ah : THandle;  
begin  
for j := 0 to AParent.ControlCount - 1 do  
if (AParent.Controls[j] is TButton) then  
begin  
ah := (AParent.Controls[j] as TButton).Handle;  
SetWindowLong(ah, GWL_STYLE,  
GetWindowLong(ah, GWL_STYLE) OR  
BS_MULTILINE) ;  
end;  
end;  

Вот практически и все осталось создать обработчик событий OnCreate на форме и в нем прописать


SetMultiLineButton (Panel1); 

Вот теперь все, запускаем проект, вуаляяяя.... текст на кнопках располагается в несколько строк.

Добавлено: 01 Августа 2018 07:23:07 Добавил: Андрей Ковальчук

Выбор лотка принтера для печати

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

Первым делом в раздел uses добавляем модуль Printers, затем после ключевого слова public прописываем вот такую строчку


procedure ChangePrinterTray;  

И нажимаем CTRL+SHIFT+C.
Delphi автоматически генерирует шаблон нашей процедуры, а полный её вид будет выглядеть следующим образом:


procedure TForm1.ChangePrinterTray;  
var  
ADevice, ADriver, APort: array [0..255] of Char;  
ADeviceMode: THandle;  
DevMode: PDeviceMode;  
begin  
Printer.GetPrinter( ADevice, ADriver, APort, ADeviceMode );  
if ADeviceMode <> 0 then  
begin  
GlobalUnlock( ADeviceMode );  
DevMode := GlobalLock( ADeviceMode ); //Получаем указатель на текущие параметры  
DevMode.dmDefaultSource := DMBIN_AUTO; //Здесь указывается параметры относительно лотка (в данный момент указывается, что выбирается автоматически)  
DevMode.dmFields := DevMode.dmFields or DM_DEFAULTSOURCE; //Указывает, что мы будем обновлять  
GlobalUnlock( ADeviceMode );  
Printer.SetPrinter( ADevice, ADriver, APort, ADeviceMode );//Применяем новые параметры  
end;  
end;   

На этом все,... ДА чуть не забыл помимо автоматического выбора лотка существуют следующие параметры:


DMBIN_ONLYONE  
DMBIN_MIDDLE  
DMBIN_LOWER  
DMBIN_MANUAL  
DMBIN_ENVELOPE  
DMBIN_ENVMANUAL  
DMBIN_AUTO  
DMBIN_TRACTOR  
DMBIN_SMALLFMT  
DMBIN_LARGEFMT  
DMBIN_LARGECAPACITY  
DMBIN_CASSETTE  
DMBIN_FORMSOURCE  

Вот сейчас действиельно все !!!

Добавлено: 01 Августа 2018 07:20:54 Добавил: Андрей Ковальчук

Вставляем Progress в ListView

Всем HI, в этом уроке мы научимся вставлять в компонент ListView компонент ProgressBar. Открываем delphi, кидаем на форму компонент ListView, 2 компонента button и компонент Timer. Для начала нам нужно создать 2 столбца в компоненте ListView, выделяем его, находим свойство columns и жмем по нему. Появиться небольшое окошечко, в котором нужно два раза нажать на кнопку с изображением желтой папки (Add New). Как вы наверно уже поняли, только что мы создали 2 колонки в компоненте ListView, но они пока еще не отображаються, что бы это исправить находим свойство ViewStyle и выставляем в нем значение на vsReport. Все на этом предварительные настроки завершены. Начинаем кодить.

Выделяем первую кнопку, при нажатии на неё пользователь будет добавлять строки (содержащие в себе компонент ProgressBar) в компонент ListView. Итак, создаем обработчик событий OnClick на первой кнопке. Полный код обработчика событий приведен ниже, посмотрите на него и допишите к себе недостающие строки.


procedure TForm1.Button1Click(Sender: TObject);  
const  
pbColumnIndex = 1;  
pbMax = 100;  
var  
li : TListItem;  
lv : TListView;  
pb : TProgressBar;  
pbRect : TRect;  
begin  
lv := ListView1;  
li := lv.Items.Add;  
li.Caption := 'Item ' + IntToStr(lv.Items.Count);  
pb := TProgressBar.Create(nil);  
pb.Parent := lv;  
li.Data := pb;  
pbRect := li.DisplayRect(drBounds);  
pbRect.Left := pbRect.Left +  
lv.Columns[-1 + pbColumnIndex].Width;  
pbRect.Right := pbRect.Left +  
lv.Columns[pbColumnIndex].Width;  
pb.BoundsRect := pbRect;  
end;  

Так добавлять строки в компонент ListView мы научились, осталось научиться их удалять. Для этого нам и понадобиться вторая кнопка. Выделяем её и создаем на ней обработчик событий OnClick. Опять же полный код обработчика приведен ниже, посмотрите на него и добавьте к себе недостающие строки.


procedure TForm1.Button2Click(Sender: TObject);  
var  
lv : TListView;  
li : TListItem;  
i, idx : integer;  
pb : TProgressBar;  
begin  
lv := ListView1;  
li := lv.Selected;  
if li <> nil then  
begin  
idx := li.Index;  
TProgressBar(li.Data).Free;  
lv.Items.Delete(idx);  
for i := idx to -1 + lv.Items.Count do  
begin  
li := lv.Items.Item[i];  
pb := TProgressBar(li.Data);  
pb.Top := pb.Top -  
(pb.BoundsRect.Bottom -  
pb.BoundsRect.Top);  
end;  
end;  
end;  

Сейчас я хочу немного оживить компонент ProgressBar и сделать так что бы Progress увеличивался. Вот тут то нам на помощь приходит компонент Timer, выделяем его и создаем на нем обработчик событий Ontime. Полный код обработчика представлен ниже:


procedure TForm1.Timer1Timer(Sender: TObject);  
var  
idx : integer;  
pb: TProgressbar;  
lv : TListView;  
begin  
lv := ListView1;  
if lv.Items.Count = 0 then Exit;  
idx := Random(lv.Items.Count);  
pb := TProgressBar(lv.Items[idx].Data);  
if pb.Position < pb.Max then  
pb.StepIt  
else  
pb.Position := 0;  
end;  

Да и не забудьте свойство Enabled у компонента Timer выставить в значение true

На этом все, как видите ничего сложного, запускаем проект и наслаждаться результатами !

Добавлено: 01 Августа 2018 07:20:14 Добавил: Андрей Ковальчук

Вставка Bitmap через буфер обмена


function CopyClipToBuf(DC: HDC; Left, Top,  
           Width, Height: Integer;  Rop: LongInt;  
           var CopyDC: HDC;  
           var CopyBitmap: HBitmap): Boolean;  
var  
  TempBitmap: HBitmap;  
begin  
  Result := False;  
  CopyDC := 0;  
  CopyBitmap := 0;  
  if DC <> 0 then  
    begin  
      CopyDC := CreateCompatibleDC(DC);  
      if CopyDC <> 0 then  
        begin  
          CopyBitmap := CreateCompatibleBitmap(DC,  
                          Width, Height);  
          if CopyBitmap <> 0 then  
            begin  
              TempBitmap := CopyBitmap;  
              CopyBitmap := SelectObject(CopyDC,  
                              CopyBitmap);  
              Result := BitBlt(CopyDC, 0, 0,  
                          Width, Height, DC,  
                          Left, Top, Rop);  
              CopyBitmap := TempBitmap;  
            end;  
        end;  
    end;  
end;  
  
function CopyBufToClip(DC: HDC; var CopyDC: HDC;  
           var CopyBitmap: HBitmap;   
           Left, Top, Width, Height: Integer;  
           Rop: LongInt; DeleteObjects: Boolean): Boolean;  
var  
  TempBitmap: HBitmap;  
begin  
  Result := False;  
  if (DC <> 0) and  
     (CopyDC <> 0) and  
     (CopyBitmap <> 0) then  
    begin  
      TempBitmap := CopyBitmap;  
      CopyBitmap := SelectObject(DC, CopyBitmap);  
      Result := BitBlt(DC, Left, Top,  
                  Width, Height, CopyDC,  
                  0, 0, Rop);  
      CopyBitmap := TempBitmap;  
      if DeleteObjects then  
        begin  
          DeleteDC(CopyDC);  
          DeleteObject(CopyBitmap);  
        end;  
    end;  
end;  

Добавлено: 01 Августа 2018 07:18:37 Добавил: Андрей Ковальчук

Внешняя компонента. Аналог ОтправитьДляОбработки() объекта HTTPReader v7plus.dll (1С 7.7)

В программе «1С:Предприятие» версии 7.7 для работы с Интернет предусмотрен объект HTTPReader компоненты v7plus.dll. В частности, для получения WEB-станицы с сервера предусмотрен метод ОтправитьДляОбработки(). Пример использования указанного метода можно найти здесь. Как видно из примера функционал данного метода может очень сильно помочь при решении интеграционных задач. И не было б никакого смысла в написании данной статьи, если б не одно НО. У метода ОтправитьДляОбработки() ест один весьма существенный недостаток: в случае, если сервер в заголовке ответа не передает размер пакета, то принимаемая страница обрезается до размера в примерно 1024 байта (приблизительно логику данного явления можно понять при дальнейшем ознакомлении с этой статьей). Именно указанное неудобство побудило автора сначала к написанию внешней компоненты, а впоследствии и этой статьи.
Для реализации задачи средством разработки было принято Delphi 6 как единственная среда разработки кроме 1С, которой автор владеет на необходимом уровне. Скажу сразу, что писать компоненты для 1С «с нуля» дело весьма хлопотное и неблагодарное. По этой причине был использован шаблон, взятый отсюда. Я не стану подробно останавливаться на принципах разработки внешних компонент для 1С (это весьма хорошо описано в последней ссылке) а сразу перейду к делу.

Итак, для получения данных по HTTP используем следующие методы (не забыв подключить библиотеку wininet).


InternetOpen  
InternetOpenUrl  
HttpQueryInfo  
InternetReadFile  
InternetQueryDataAvailable  
InternetReadFile  
InternetQueryDataAvailable  
InternetCloseHandle  

О назначении и применении указанных методов можно прочесть здесь.

Работа метода аналогична методу ОтправитьДляОбработки(): полученные данные можно записать в файл или получить в виде строки. Ниже приведен фрагмент кода с комментариями.

var url: string;  
        hSession, hfile: hInternet;  
        dwindex,dwcodelen :dword;  
        dwcode:array[1..20] of char;  
        res : pchar;  
        fSize, ReadLen:DWORD; //<-количество реально прочитанных байт  
        fBuf:array[1..1024]of byte;//<-буфер куда качаем  
        f:file; //<-файл куда качаем  
        s,i_f: string;  
        flag:integer;  
  begin  
    case mode of  
      m_rus_name: Result:='ПолучитьВебСтраницу';//Имя процедуры  
      m_eng_name: Result:='GetWWWPage';//Англоязычный синоним  
      m_n_params: g_NParams:=3; //Количество параметров функции  
      m_execute: begin  
        flag:=GetParamAsInteger(0);//тип действия 1-записать в файл, 2-записать в переменную  
        url:=GetParamAsString(1);//адрес  
        i_f:=GetParamAsString(2);//имя файла  
        fSize:=0; //<- |переменных  
        if pos('http://',lowercase(url))=0 then  
        url := 'http://'+url;  
        hSession := InternetOpen('InetURL:/1.0',//открываем адрес  
        INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0);  
        if assigned(hsession) then  
        begin  
        hfile := InternetOpenUrl(hsession, pchar(url), nil,  0,  INTERNET_FLAG_RELOAD, 0);  
        dwIndex  := 0;  
        dwCodeLen := 10;  
        HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex);  
        res := pchar(@dwcode);  
        if (res ='200') or (res ='302') then  
        result:= '1'  
        else result:= '0';  
        //Попробуем получить страницу...  
        if result='1' then  
        begin  
                if flag=1 then begin  
                AssignFile(f,i_f);//открываем файл  
                ReWrite(f,1);  
                while ReadLen<>0 do  
                begin  
                //читаем в буфер  
                InternetReadFile(hfile, @fBuf, SizeOf(fBuf), ReadLen);  
                //смотрим ск-ко осталось докачать  
                InternetQueryDataAvailable(hfile, fSize,0,0);  
                BlockWrite(f, fBuf, ReadLen) //<-пишем в файл  
                end;  
                end  
                else  
                begin  
                result:='';  
                while ReadLen<>0 do  
                begin  
                //читаем в буфер  
                        InternetReadFile(hfile, @fBuf, SizeOf(fBuf), ReadLen);  
                        //смотрим ск-ко осталось докачать  
                        InternetQueryDataAvailable(hfile, fSize,0,0);  
                        s := '';  
                        SetString(S, pchar(@fBuf), ReadLen);//преобразуем массив в сторку  
                        result:=result+s;  
                end;  
                end;  
                if flag=1 then  
                CloseFile(f) //<закроем файл  
                else begin  
                g_Value:=result;  
                PutNParam(2,g_Value);//установим значение третьей переменной  
                end;  
                result:='1';  
                end;  
                g_Value:=StrToInt(result);//Установим возвращаемое функцией  
                //конец получения страницы  
                InternetCloseHandle(hfile);//закроем сессию  
                InternetCloseHandle(hsession);  
        end;  
      end;  
    end;//case  

Для проверки работы внешней компоненты используем обработку (ссылка для скачивания в конце статьи). Вот код процедуры проверки:

Попытка  
             vk = СоздатьОбъект("AddIn.GetURL");  
Исключение  
             Сообщить("Не удается создать объект AddIn.GetURL... !!");  
             Сообщить("Зайдите в Windows под правами локального администратора и повторите попытку.");     
  
КонецПопытки;      
  
Ф = СокрЛП(СТР);  
Сообщить(vk.ПолучитьВебСтраницу(фл,СОКРЛП(адр),Ф));   
Стр = Ф;   
vk = 0;  

Добавлено: 01 Августа 2018 07:17:50 Добавил: Андрей Ковальчук

Взаимодействие с чужими окнами

Представьте себе, глупый пользователь сидит как ни в чём небывало с умным видом уже в какой раз пытается составить документ в Microsoft Word'e, но вдруг окно начинает бешено скакать по экрану, в его заголовке выводятся непристойные сообщения, оно то сворачивается, то разворачивается, меняя постоянно свои размеры, а под конец совсем исчезает, унося в небытиё весь текст, который с таким трудом набил ламерюга... а если так себя в любой момент может повести любая программа... впечатления от этого останутся на долго!!!

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

Для начала запустите стандартную программу "Блокнот" - и что же мы видим? В блокноте в заголовке окна отслеживается имя текущего файла. Изначально, т.к. файла нет в использовании, заголовок блокнота выглядит так: "Безымянный - Блокнот". Постараемся по этому критерию найти окно блокнота. Выглядеть это будет так:


if FindWindow(nil, 'Безымянный - Блокнот') <> 0 then  
  ShowMessage('Окно найдено')  
else  
  ShowMessage('Окно НЕнайдено'); 

Как мы видим из кода, если наша программа найдёт окно блокнота, мы увидим сообщение, гласящее об этом.

Далее попробуем передвинуть это окно


var  
  h: HWND;  
begin  
  h := findwindow(nil, 'Безымянный - Блокнот');  
  if h <> 0 then  
    SetWindowPos(h, HWND_BOTTOM, 1, 1, 20, 20, swp_nosize);  
end;   

Опять находим блокнот. Его дескриптор помещаем в переменную класса HWND[С английского Handle Window - дескриптор окна]. Далее используем функцию SetWindowPos для задания позиции. В качестве параметров нужно указать:

Дескриптор окна, которое хотим переместить
Идентификатор окна, которое предшествует перемещаемому окну в Z-последовательности. Z-последовательность это порядок, в котором формировались окна. Данный параметр указывает с какого именно окна необходимо начинать писк. В качестве значений может принимать либо дескриптор какого-либо окна в системе, либо одно из нижеследующих значений:
HWND_BOTTOM Начало Z-последовательности
HWND_NOTOPMOST Первое окно которое располагается не "поверх все окон"
HWND_TOP Вершина Z-последовательности
HWND_TOPMOST Первое окно которое располагается "поверх все окон"
Позиция окна по горизонтали
Позиция окна по вертикали
Ширина окна
Высота окна
Спецификаторы изменения позиции и размеров окна[флаги]. Для задания значения можно комбинировать следующие константы
SWP_DRAWFRAME Прорисовка фрейма вокруг окна.
SWP_FRAMECHANGED Посылает сообщение WM_NCCALCSIZE окну, даже если размер его не был изменён. Если этот флаг не указан, сообщение WM_NCCALCSIZE будет посылаться, только после изменения размеров окна.
SWP_HIDEWINDOW Скрывает окно.
SWP_NOACTIVATE Не активизирует окно. Если же этот флаг не будет поставлен, окно активизируется и будет перемещено поверх всех окон. А вот встанет ли окно даже выше тех окон, которым задано HWND_TOPMOST или нет зависит от параметра hWndInsertAfter.
SWP_NOCOPYBITS Если этот спецификатор не будет установлен, тогда содержимое клиентской области окна будет скопировано и вставлено во вновь отобразившееся окно после его перемещения.
SWP_NOMOVE Сообщает, что нужно игнорировать параметры задания позиции окну.
SWP_NOOWNERZORDER Сообщает, что не следует изменять позицию окна владельца в Z-последовательности.
SWP_NOREDRAW Не перерисовывает окно.
SWP_NOREPOSITION Такой же как и SWP_NOOWNERZORDER.
SWP_NOSENDCHANGING Мешает окну получить сообщение WM_WINDOWPOSCHANGING.
SWP_NOSIZE Сообщает, что нужно игнорировать параметры задания размеров окну.
SWP_NOZORDER Сохраняет текущее положение в Z-последовательности (игнорирует сообщение hWndInsertAfter parameter).
SWP_SHOWWINDOW Отображает окно.
Если данная функция выполнится успешно, она возвратит отличное от нуля значение. Ну, вот, теперь мы можем передвигать и изменять в размерах чужие окна!!! Для того, чтобы изменить заголовок окна напишем следующий код:


SetWindowText(FindWindow(nil, 'Безымянный - Блокнот'),  
'Дарова, ламерюга, типа ты попал... '); 

Функции setwindowtext нужно указать только два параметра: это дескриптор нужного окна и новое значение для заголовка. Вот вообщем-то и всё!

Есть ещё одна интересная функция ShowWindow, которая позволяет скрывать или отображать окна. Использовать её нужно так::


ShowWindow(FindWindow(nil, 'Безымянный - Блокнот'), sw_hide); 

В скобках указываем сначала над каким именно окном хотим издеваться, а затем что именно мы хотим с ним сделать. В качестве возможных действий можем указать:

SW_HIDE Скрывает окно и активизирует другое.
SW_MAXIMIZE Разворачивает окно.
SW_MINIMIZE Сворачивает окно.
SW_RESTORE Активизирует и выводит окно. Если окно было развёрнуто или свёрнуто - восстанавливает исходный размер и позицию.
SW_SHOW Активизирует и выводит окно с его оригинальным размером и положением.
SW_SHOWDEFAULT Активизирует с установками, заданными в структуре STARTUPINFO, которая была передана при создании процесса приложением запускающим нужную программу.
SW_SHOWMAXIMIZED Выводит окно в развёрнутом виде.
SW_SHOWMINIMIZED Выводит окно в виде пиктограммы на панели задач.
SW_SHOWMINNOACTIVE Выводит окно в свёрнутом виде на панели задач и не передаёт ему фокус ввода, т.е. окно, которое до этого было активно остаётся активно по прежнему.
SW_SHOWNA Отображает окно в его текущем состоянии. Активное окно остаётся активным по прежнему.
SW_SHOWNOACTIVATE Выводит окно в его последнем положении и с последними используемыми размерами. Активное окно остаётся активным по прежнему.
SW_SHOWNORMAL Выводит окно. Если оно было свёрнуто или развёрнуто - восстанавливает его оригинальные размеры и позицию
Но вся сложность действий заключается в том, что в заголовке Блокнота отслеживается имя текущего файла и использовать значение "Безымянный - Блокнот" мы можем не всегда : (. Тем более это не только в случае с блокнотом... Но есть выход: ведь функции FindWindow для поиска окна мы указываем не только заголовок нужного окна, но ещё его класс. Какой же это выход скажете вы, заголовок окна мы видим, значит знаем, что указывать - а класс окна... в действительности тоже может найти приложив немного усилий!

В пакет Delphi входим специальная утилита для отслеживание всех активных процессов, она называется WinSight32. Вот ею мы и воспользуемся. Запустите её, покопайтесь в списке процессов, ищите строку где значится текущий заголовок нужного окна, например Блокнота, и в левой части этой строки в фигурных скобках вы найдёте имя класса окна. Для блокнота это будет "Notepad". Теперь зная имя класса окна мы можем переписать поиск окна таким способом:


ShowWindow(FindWindow('Notepad', nil), sw_hide);   

Теперь мы вместо заголовка окна указываем значение nil, игнорируя данный параметр.

Есть ещё один замечательный способ передачи команд окнам.- функция PostMessage. Ей в качестве параметров нужно указать:

Дескриптор окна, которому посылается сообщение или следующие значения:
HWND_BROADCAST Сообщение будет послано всем окнам верхнего уровня системы, включая неактивные и невидимые окна, overlapped-окна, и PopUp-окна, но сообщение не будет посылаться дочерним
 окнам. 
NULL Ведёт себя как функция PostThreadMessage с переданным ей dwThreadId параметром. 
Посылаемое сообщение 
Первый параметр сообщения 
Второй параметр сообщения 
Например, если послать сообщение wm_quit блокноту - окно будет закрыто без вывода всяких сообщений о необходимости сохранения!


[DELPHI]PostMessage(FindWindow('Notepad', nil), wm_quit, 0, 0); 

Добавлено: 01 Августа 2018 07:15:59 Добавил: Андрей Ковальчук

Быстрый парсер html кода на Delphi

Что такое парсер? Парсер – это программа, которая парсит текст, по заданному алгоритму.

Что такое парсить? Парсить – анализировать и расставлять символы, входящие в текст в соответствии заложенного алгоритма, например, для удобного восприятия текста программистом.

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

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

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

Далее привожу код структурирования тегов, цель работы алгоритма – разместить по 1 тегу на каждую строчку memo. В рабочей версии кода программа загружает Html страницы согласно их вложенности в сайте и парсит их, после чего заменяет их.

Для зашиты от дураков оставлю часть кода, который был в основной программе, для демонстрации просто удалите код под комментариями – ///


unit Unit1;  
interface  
  
uses  
  
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
  Dialogs, StdCtrls;  
  
type  
  
  TForm1 = class(TForm)  
    Button7: TButton;  
    Button13: TButton;  
    Memo1: TMemo;  
    Memo2: TMemo;  
    procedure Button7Click(Sender: TObject);  
    procedure Button13Click(Sender: TObject);  
      
  private  
    { Private declarations }  
  
  public  
    { Public declarations }  
  
  end;  
  
var  
  Form1: TForm1;  
  
implementation  
  
{$R *.dfm}  
  
procedure TForm1.Button7Click(Sender: TObject);  
label 1;  
var  
i,j,k,g:integer;  
bol:boolean;  
position:integer;  
str:string;  
begin  
//chdir(edit1.Text);   /// рабочая папка  
//poiskpapki;         /// процедура для создания списка файлов в папке.  
       memo2.Clear;  
     ///здесь был код загрузки следующего файла  
     for i:= 0 to memo1.Lines.Count - 1 do  
       begin  
          str:= memo1.Lines;  
          1:  
          position := AnsiPos('>',  str);  
          if  position<>0 then  
                           begin  
                           memo2.Lines.Add(copy(str,1,position));  
                           delete(str,1,position);  
                           goto 1;  
                           end;  
        if  position=0    then    memo2.Lines.Add(str);  
         end;  
        memo1.Text:=memo2.Text;  
     ///здесь был код сохранения следующего файла  
  //продолжаем парсить  
  button13.Click;  
end;  
  
procedure TForm1.Button13Click(Sender: TObject);  
label 1;  
var  
i,j,k,g:integer;  
bol:boolean;  
position:integer;  
str:string;  
begin  
//chdir(edit1.Text);     /// рабочая папка  
//poiskpapki;           /// процедура для создания списка файлов в папке.  
          memo2.Clear;  
    ///здесь был код загрузки следующего файла  
     for i:= 0 to memo1.Lines.Count - 1 do  
       begin  
          str:= memo1.Lines;  
          1:  
          position := AnsiPos('<',  str);  
          if  position>1 then  
                           begin  
                           memo2.Lines.Add(copy(str,1,position-1));  
                           delete(str,1,position-1);  
                           goto 1;  
                           end;  
          memo2.Lines.Add(str);  
///здесь был код сохранения следующего файла.  
  end;  
 //продолжаем парсить убираем пустые строки  
 // здесь был код.  
end;  
end.  

В алгоритме используется рекурсивный цикл перенос до и после знаков открытии закрытии тегов.

Что называют парсерами? Я сделал поиск по форуму по ключевому слову – парсер, движок мне предложил ряд тем, в которых обсуждалось использование и применение парсера. Попробую прокомментировать эти темы, и по возможности дать ответ.

26.04.2007, 16:39 на форуме – programmersforum.ru была создана тема – XML Parser с поддержкой XSLT

Я пишу электронный учебник. Текст хранится в XML файле. При загрузке файла строится дерево по главам в TreeView, а сам текст отображается в RichView. И вот надо чтобы текст отображался со всеми ссылками, картинками, мультимедиа и т.д. В данный момент я добиться этого не могу. У меня отображается простой текст

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

27.10.2007, 18:29 на форуме – programmersforum.ru была создана тема – Парсер для обработки тагов

Есть некоторый текст из N символов. В этом тексте содержатся разные таги (table, tr, td, img, a). Нужно этот текст разделить на несколько равных частей, т.е сделать постраничный вывод для этого текста. Возникают такие ситуации, когда при разделении текста половина тага находится в одной части, другая половина находится в другой. Чтобы этого избежать, нужно обрабатывать эти таги. Может быть кто-нибудь подскажет, есть ли готовые решения подобных парсеров или же может кто делал что-то подобное. Буду признателен за любую информацию.

Отвечаю, есть решение, с него и начал эту статью, код представлен выше.

07.01.2008, 00:54 на форуме – programmersforum.ru была создана тема – пример парсинга


procedure TForm1.Button1Click(Sender: TObject);  
var  
  Stream: TStream;  
  s: string;  
begin  
  Stream := TMemoryStream.Create;  
  try  
    { получаем текст области редактирования и помещаем его в поток }  
    s := memo1.Text;  
   Stream.WriteBuffer(s[1], length(s));  
    { сбрасываем стартовую позицию потока и создаем парсер }  
    Stream.Position := 0;  
    with TParser.Create(Stream) do  
    try  
      { "добываем" числа и добавляем их в список }  
      while Token <> toEOF do  
      begin  
        CheckToken(toInteger); { возбуждаем исключение, если не toInteger }  
        Listbox1.Items.Add(IntToStr(TokenInt));  
        NextToken;  
      end;  
    finally  
      Free;  
    end;  
  finally  
    Stream.Free;  
  end;  

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


Ответ дали там же на форуме –


procedure TForm1.Button1Click(Sender: TObject);  
var  
  Stream: TStream;  
  s: string;  
begin  
  Stream := TMemoryStream.Create;  
  try  
    { получаем текст области редактирования и помещаем его в поток }  
    s := memo1.Text;  
    Stream.WriteBuffer(s[1], length(s));  
    { сбрасываем стартовую позицию потока и создаем парсер }  
    Stream.Position := 0;  
    with TParser.Create(Stream) do  
    try  
      { "добываем" числа и добавляем их в список }  
      s := '';  
      while Token <> toEOF do  
      begin  
        CheckToken(toInteger); { возбуждаем исключение, если не toInteger }  
        //Listbox1.Items.Add(IntToStr(TokenInt));   -->  
        s := s + IntToStr(TokenInt);  
        NextToken;  
      end;  
    finally  
      Free;  
    end;  
  finally  
    Stream.Free;  
  end;  

Вован вам ответил на ваш вопрос – как сделать, чтобы символы выводились в строку, а не в столбец (упустил, правда, один оператор – Listbox1.Items.Add(s), но это только от того, что торопился вам помочь побыстрее).

Добавлено: 01 Августа 2018 07:13:31 Добавил: Андрей Ковальчук

Бегущий текст

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

Итак, создаем новый Delphi проект. Переходим в окно кода, и после ключевого слова var дописываем:


bm:TBitmap;x,y:Integer;  

Потом опять, переходим на форму, и кидаем компонент TTimer (вкладка system). Свойство Enabled ставим в значение false, а в свойстве interval таймера ставим значение 20.
Далее, создаем обработчик событий OnCreate на форме. В котором прописываем следующий код:


x:=Form1.width/2; //текст будет выводиться посредине формы  
y:=Height+50; //чтобы текст выводился не сразу  
bm:=TBitmap.Create; //создаем объект TBitmap  
bm.Width:=width; //ширина как у формы  
bm.height:=height; //высота как у формы  
bm.PixelFormat:=pf32bit; //32 битный режим изображения  
Canvas.Font.Name:='Times New Roman'; //делаем шрифт Times New Roman  
bm.Canvas.Brush.Color:= $004F4F52; //серый цвет фона bitmap  
bm.Canvas.FillRect(bm.Canvas.ClipRect); //делаем, bitmap стал весь серый  
timer1.Enabled:=True; //включаем таймер  

Далее создаем, обработчик событий OnTimer у таймера и пишем туда следующий код:

y:=y-1;  
if y=-200 then y:=height+10;  
with bm do begin  
Canvas.Font.Color:=$000576DC; //делаем цвет оранжевым  
Canvas.TextOut(x-10,y, 'Имя программы:');  
Canvas.Font.Color:=clWhite;  
Canvas.TextOut(x,y+15, 'Автор: Имя Автора');  
Canvas.Font.Color:=$000576DC; //делаем цвет оранжевым  
Canvas.TextOut(x-10,y+30,'Тестеры:                  ');  
Canvas.Font.Color:=clWhite;  
Canvas.TextOut(x,y+45,'Имя тестера');  
Canvas.TextOut(x,y+60,'Имя тестера');  
Canvas.TextOut(x,y+75,'Имя тестера');  
Canvas.Font.Color:=$000576DC; //делаем цвет оранжевым  
Canvas.TextOut(x-10,y+90,'Спасибо:            ');  
Canvas.Font.Color:=clWhite;  
Canvas.TextOut(x,y+105,'Имя');  
Canvas.TextOut(x,y+120,'Имя');  
Canvas.TextOut(x,y+135,'Имя');  
Canvas.TextOut(x,y+150,'Имя');  
Canvas.Font.Color:=$000576DC; //делаем цвет оранжевым  
Canvas.TextOut(x-10,y+165,'Автор.Год');  
Canvas.TextOut(x-10,y+180,'          ');  
end;  
Canvas.Draw(0,0,bm); //вырисовываем на форме объект Bitmap  

Вот и все, осталось только объяснить несколько технических моментов в этом примере.
Так как это самый простой пример, у него могут возникать ошибки. Например, хвост какой ни будь буквы растягивается. Это можно устранить пробелами. Следующее:


if y=-200 then y:=height+10;  

это означает, что если текст вышел вверх на высоту -200 пикселей, то значение y будет высота формы+10, чтобы текст опять ехал вверх.

Добавлено: 01 Августа 2018 07:12:33 Добавил: Андрей Ковальчук

Ассемблер в Delphi

Основное предназначение этой статьи, заполнить пробелы в оригинальной документации по Borland Delphi Developer, при этом весь программный код, а так же теория, полность совместимы со всеми версиями Delphi.

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

Использование Ассемблера в Борландовком Delphi

Перед тем, как начать, хотелось бы определиться с уровнем знаний, необходимых для нормального усвоения данного материала. Необходимо быть знакомым со встроенными средствами отладки в Delphi. Так же необходимо иметь представление о таких терминах как тип реализации (instantiation), null pointer и распределение памяти. Если в чём-то из вышеупомянутого Вы сомневаетесь, то постарайтесь быть очень внимательны и осторожны при воплощении данного материала на практике. Кроме того, будет обсуждаться только 32-битный код, так что понадобится компилятор не ниже Delphi 2.0.

Зачем использовать Ассемблер? На мой взгляд, Object Pascal, это инструмент, позволяющий генерировать быстрый и эффективный код, однако использование ассемблера в некоторых случаях позволяет решать некоторые задачи более эффективно. За всю работу с Delphi, я пришёл к выводу, что использование низкоуровневого кода необходимо в двух случая.

(1) Обработка большого количества данных. Nb. В данный случай не входит ситуация, когда используется язык запроса данных.

(2) В высокоскоростных подпрограммах работы с дисплеем. Nb. Имеется ввиду использование простых процедур на чистом паскале, но никак не внешних библиотек и DirectX.

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

Что такое Ассемблер? Надеюсь, что Все читатели этой статьи имеют как минимум поверхностное представление о работе процессора. Грубо говоря, это калькулятор с большим объёмом памяти. Память, это не более чем упорядоченная последовательнось двоичных цифр. Каждая такая цифра является байтом. Каждый байт может содержать в себе значение от 0 до 255, а так же имеет свой уникальный адрес, при помощи которого процессор находит нужные значения в памяти. Процессор так же имеет набор регистров (это можно расценить как глобальные переменные). Например eax,ebx,ecx и edx, это универсальные 32-битные регистры. Это значит, что самое большое число, которое мы можем записать в регистр eax, это 2 в степени 32 минус 1, или 4294967295.

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

05/0a/00/00/00
Однако, такая запись абсолютно не читабельна и, как следствие, не пригодна при отладке программы. Так вот Ассемблер, это простое представление машинных команд в более удобном виде. Теперь давайте посмотрим, как будет выглядеть прибавление 10 к eax в ассемблерном представлении:


add eax,10 {a := a + 10}   

А вот так выглядит вычитаение значения ebx из eax


sub eax,ebx {a := a - b }  

Чтобы сохранить значние, можно просто поместить его в другой регистр


mov eax,ecx {a := c }  

или даже лучше, сохранить значение по определённому адресу в памяти


mov [1536],eax {сохраняет значение eax по адресу 1536}  

и конечно же взять его от туда


mov eax,[1536]   

Однако, тут есть важный момент, про который забывать не желательно. Так как регистр 32-битный(4 байта), то его значение будет записано сразу в четыре ячейки памяти 1536, 1537, 1538 и 1539.

А теперь давайте посмотрим, как компилятор преобразует действия с переменными в машинный код. Допустим у нас есть строка


Count := 0;   

Для компилятора это означает, что надо просто запомнить значение. Следовательно, компилятор генерирует код, который сохраняет значение в памяти по определённому адресу и следит, чтобы не произошло никаких накладок, и обзывает этот адрес как 'Count'. Вот как выглядит такой код


mov eax,0   

mov Count,eax
Компилятор не может использовать строку типа


mov Count,0   

из-за того, что как минимум один параметр инструкции должен являться регистром. Если посмотреть на строку


Count := Count + 1;   

то


mov eax,Count   
add eax,1   
mov Count,eax  

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

Итак, рассмотрим первый пример. Сразу извинюсь за тривиальность, но с чего-то надо начинать.


function Sum(X, Y: integer): integer;  
begin   
 Result := X + Y;   
end;  

А вот так будет выглядеть оперция сложения двух целых чисел на ассемблере:


function Sum(X,Y:integer):integer;   
begin   
 asm  
  mov eax,X  
  add eax,Y  
  mov Result,eax  
 end;  
end;  

Этот код прекрасно работает, однако он не даёт нам преимущества в скорости, а так же потерялось восприятие кода. Но не стоит огорчаться, так как те немногие знания, которые Вы почерпнули из этого материала, можно использовать с большей пользой. Допустим, нам необходимо преобразовать явные значения Red,Green, и Blue в цвета типа TColor, подходящие для использования в Delphi. Тип TColor описан как 24-битный True Colour хранящийся в формате целого числа, то есть четыре байта, старший из которых равен нулю, а далее по порядку красный, зелёный, синий.


function GetColour(Red,Green,Blue:integer):TColor;   
begin   
 asm  
{ecx будет содержать значение TColor}  
  mov ecx,0   
{начинаем с красной компоненты}  
  mov eax,Red   
{необходимо убедиться, что красный находится в диапазоне 0<=Red<=255}  
  and eax,255   
{сдвигаем значение красного в правильное положение}  
  shl eax,16   
{выравниваем значение TColor}  
  xor ecx,eax   
{проделываем тоже самое с зелёным}  
  mov eax,Green   
  and eax,255  
  shl eax,8  
  xor ecx,eax  
{и тоже самое с синим}  
  mov eax,Blue   
  and eax,255  
  xor ecx,eax  
  mov Result, ecx  
 end;  
end;  

Заметьте, что я использовал несколько бинарных операций. Эти операции также определены непосредственно в Object Pascal

Автор: Ian Hodger

Добавлено: 01 Августа 2018 07:11:15 Добавил: Андрей Ковальчук

Алгоритмы сортировки

Алгоритм 1. Сортировка вставками.
Это изящный и простой для понимания метод. Вот в чем его суть: создается новый массив, в который мы последовательно вставляем элементы из исходного массива так, чтобы новый массив был упорядоченным. Вставка происходит следующим образом: в конце нового массива выделяется свободная ячейка, далее анализируется элемент, стоящий перед пустой ячейкой (если, конечно, пустая ячейка не стоит на первом месте), и если этот элемент больше вставляемого, то подвигаем элемент в свободную ячейку (при этом на том месте, где он стоял, образуется пустая ячейка) и сравниваем следующий элемент. Так мы прейдем к ситуации, когда элемент перед пустой ячейкой меньше вставляемого, или пустая ячейка стоит в начале массива. Помещаем вставляемый элемент в пустую ячейку . Таким образом, по очереди вставляем все элементы исходного массива. Очевидно, что если до вставки элемента массив был упорядочен, то после вставки перед вставленным элементом расположены все элементы, меньшие его, а после — большие. Так как порядок элементов в новом массиве не меняется, то сформированный массив будет упорядоченным после каждой вставки. А значит, после последней вставки мы получим упорядоченный исходный массив. Вот как такой алгоритм можно реализовать на языке программирования Pascal:


Program InsertionSort;  
Var A,B   : array[1..1000] of integer;  
    N,i,j  : integer;  
Begin  
{Определение размера массива A (N) и его заполнение}  
 …  
{сортировка данных}  
 for i:=1 to N do  
 begin  
  j:=i;  
  while (j>1) and (B[j-1]>A[i]) do  
   begin  
    B[j]:=B[j-1];  
    j:=j-1;  
   end;  
  B[j]:=A[i];  
 end;  
 {Вывод массива B}  
 …  
End.   

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

Алгоритм 2. Пузырьковая сортировка.
Реализация данного метода не требует дополнительной памяти. Метод очень прост и состоит в следующем: берется пара рядом стоящих элементов, и если элемент с меньшим индексом оказывается больше элемента с большим индексом, то мы меняем их местами. Эти действия продолжаем, пока есть такие пары. Легко понять, что когда таких пар не останется, то данные будут отсортированными. Для упрощения поиска таких пар данные просматриваются по порядку от начала до конца. Из этого следует, что за такой просмотр находится максимум, который помещается в конец массива, а потому следующий раз достаточно просматривать уже меньшее количество элементов. Максимальный элемент как бы всплывает вверх, отсюда и название алгоритма Так как каждый раз на свое место становится по крайней мере один элемент, то не потребуется более N проходов, где N — количество элементов. Вот как это можно реализовать:


Program BubbleSort;  
Var A    : array[1..1000] of integer;  
    N,i,j,p : integer;         
Begin  
 {Определение размера массива A (N) и его заполнение}  
 …  
 {сортировка данных}  
 for i:=1 to n do  
  for j:=1 to n-i do  
  if A[j]>A[j+1] then  
   begin  {Обмен элементов}  
    p:=A[j];  
    A[j]:=A[j+1];  
    A[j+1]:=P;  
   end;  
 {Вывод отсортированного массива A}  
 …  
End.  

Алгоритм 3. Сортировка Шейкером.
Когда данные сортируются не в оперативной памяти, а на жестком диске, особенно если ключ связан с большим объемом дополнительной информации, то количество перемещений элементов существенно влияет на время работы. Этот алгоритм уменьшает количество таких перемещений, действуя следующим образом: за один проход из всех элементов выбирается минимальный и максимальный. Потом минимальный элемент помещается в начало массива, а максимальный, соответственно, в конец. Далее алгоритм выполняется для остальных данных. Таким образом, за каждый проход два элемента помещаются на свои места, а значит, понадобится N/2 проходов, где N — количество элементов. Реализация данного алгоритма выглядит так:


Program ShakerSort;  
Var A       : array[1..1000] of integer;  
    N,i,j,p    : integer;         
    Min, Max : integer;  
Begin  
 {Определение размера массива A — N) и его заполнение}  
 …  
 {сортировка данных}  
 for i:=1 to n div 2 do  
  begin  
   if A[i]>A[i+1] then  
   begin  
    Min:=i+1;  
    Max:=i;  
   end  
   else  
   begin  
    Min:=i;  
    Max:=i+1;  
   end;  
   for j:=i+2 to n-i+1 do  
   if A[j]>A[Max] then  
    Max:=j  
   else  
   if A[j]<A[Min] then  
    Min:=j;   
   {Обмен элементов}  
    P:=A[i];  
    A[i]:=A[min];  
    A[min]:=P;  
    if max=i then  
    max:=min;  
    P:=A[N-i+1];  
    A[N-i+1]:=A[max];  
    A[max]:=P;  
  end;  
 {Вывод отсортированного массива A}  
 …  
End.  

Рассмотрев эти методы, сделаем определенные выводы. Их объединяет не только то, что они сортируют данные, но также и время их работы. В каждом из алгоритмов присутствуют вложенные циклы, время выполнения которых зависит от размера входных данных. Значит, общее время выполнения программ есть O(n2) (константа, умноженная на n2). Следует отметить, что первые два алгоритма используют также O(n2) перестановок, в то время как третий использует их O(n). Отсюда следует, что метод Шейкера является более выгодным для сортировки данных на внешних носителях информации.

Если вы думаете, что бравые «алгоритмщики» остановились на достигнутом, то вы ошибаетесь. Видите ли, временная оценка O(n2) показалась им слишком громоздкой, и они, жадины такие, решили еще потратить свое время, чтобы впоследствии сэкономить наше. Итак, давайте теперь рассмотрим более быстрые алгоритмы.

Алгоритм 4. Сортировка слиянием.
Эта сортировка использует следующую подзадачу: есть два отсортированных массива, нужно сделать (слить) из них один отсортированный. Алгоритм сортировки работает по такому принципу: разбить массив на две части, отсортировать каждую из них, а потом слить обе части в одну отсортированную. Корректность данного метода практически очевидна, поэтому перейдем к реализации.


Program SlivSort;  
Var A,B : array[1..1000] of integer;  
    N  : integer;   
Procedure Sliv(p,q : integer); {процедура сливающая массивы}  
Var r,i,j,k : integer;  
Begin  
 r:=(p+q) div 2;  
 i:=p;  
 j:=r+1;  
 for k:=p to q do  
 if (i<=r) and ((j>q) or (a[i]<a[j])) then  
  begin   
   b[k]:=a[i];  
   i:=i+1;  
  end  
 else  
  begin  
   b[k]:=a[j];  
   j:=j+1;  
  end ;  
 for k:=p to q do  
  a[k]:=b[k];  
End;  
Procedure Sort(p,q : integer); {p,q — индексы начала и конца сортируемой части массива}  
Begin  
 if p<q then {массив из одного элемента тривиально упорядочен}  
 begin  
  Sort(p,(p+q) div 2);  
  Sort((p+q) div 2 + 1,q);  
  Sliv(p,q);  
 end;  
End;  
Begin  
 {Определение размера массива A — N) и его заполнение}  
 …  
 {запуск сортирующей процедуры}  
 Sort(1,N);  
 {Вывод отсортированного массива A}  
  …  
End.  

Чтобы оценить время работы этого алгоритма, составим рекуррентное соотношение. Пускай T(n) — время сортировки массива длины n, тогда для сортировки слиянием справедливо T(n)=2T(n/2)+O(n) (O(n) — это время, необходимое на то, чтобы слить два массива). Распишем это соотношение:

T(n)=2T(n/2)+O(n)=4T(n/4)+2O(n/2)+O(n)=4T(n/4)+2O(n)= … = 2kT(1)+kO(n)
Осталось оценить k. Мы знаем, что 2k=n, а значит k=log2n. Уравнение примет вид T(n)=nT(1)+ log2nO(n). Так как T(1) — константа, то T(n)=O(n)+log2nO(n)=O(nlog2n). То есть, оценка времени работы сортировки слиянием меньше, чем у первых трех алгоритмов (я прошу прощения у тех, кто не понял мои рассуждения или не согласен с ними, — просто поверьте мне на слово). Перед тем как объяснить, чем этот метод лучше, рассмотрим еще один алгоритм.

Алгоритм 5. Сортировка двоичной кучей
Проблема первых трех алгоритмов, описанных в прошлой части статьи, состояла в том, что после того как элемент занимал свое место, информация об уже произведенных сравнениях никак не использовалась. Структура двоичного дерева позволяет сохранить эту информацию. Итак, представим массив в виде дерева (Рис. 1). Корень дерева — элемент с индексом 1; элемент с индексом i является «родителем» для элементов с индексами 2*i и 2*i+1, а те, в свою очередь, являются его «детьми». Каждый элемент кроме первого имеет «родителя» и может иметь до двух «детей» — речь ведь идет именно о ДВОИЧНОМ дереве. Очевидно, что корнем дерева является наименьший элемент, а наибольший не имеет детей. Тут возникают два вопроса: как нам такую кучу наплодить? И зачем нам это вообще нужно? Пренебрегая порядком, отвечу сразу на второй вопрос: мы хотим извлечь из кучи минимальный элемент, а потом как-то преобразовать и восстановить кучу. Таким образом, по очереди извлечь все элементы и получить отсортированный массив. И вот как мы собираемся это сделать: пусть поддеревья с корнями 2*i и 2*i+1 уже имеют свойство кучи, мы же хотим, чтобы такое свойство имело и поддерево с корнем i. Для этого, если корень больше наименьшего своего «ребенка», мы меняем корень дерева (элемент с индексом i) с этим «ребенком», после повторяем алгоритм для поддерева, куда перешел бывший корень. Выполняя этот алгоритм «снизу вверх» (сначала для маленьких поддеревьев, потом для больших), мы добьемся того, что свойство кучи будет выполняться для всего дерева. Извлечение элемента происходит очень простым способом: мы ставим последний элемент на первое место и запускаем алгоритм исправления кучи от корня дерева… Я тут много наговорил, но на самом деле, реализация совсем несложная:


Program HeapSort;  
Var A,B  : array[1..1000] of integer;  
    N,i,P : integer;  
Procedure Heapi(ind : integer); {процедура, формирующая и исправляющяя кучу}  
Var k    : integer;   
Begin  
 k:=ind*2;  
 If k<=N then  
 begin  
  if (k+1<=N) and (A[k]>A[k+1]) then  
  k:=k+1;   
  if A[ind]>A[k] then  
  begin  
   P:=A[ind];  
   A[ind]:=A[k];  
   A[k]:=P;  
   Heapi(k);  
  end;  
 end;  
End;  
Begin  
 {Определение размера массива A — N) и его заполнение}  
 …  
 {формирование кучи}  
 for i:=N div 2 downto 1 do  
  Heapi(i);  
 {формирование массива B}  
 for i:=1 to N do  
 begin  
  B[i]:=A[1];  
  A[1]:=A[N];  
  N:=N-1;  
  Heapi(1);  
 end;  
 {Вывод отсортированного массива B}  
  …  
End. 

А теперь главное, т. е. оценка сложности. Время работы процедуры исправляющей кучу зависит от высоты дерева. Высота всего дерева равна log2n, значит, время работы процедуры есть O(log2n). Программа состоит из двух частей: формирование кучи и создание отсортированного массива B. Время исполнения каждой из частей не больше O(n log2n) (в каждой части исправляющая процедура вызывается не более n раз). Значит, время работы то же, что и в сортировке слиянием.

Теперь лирическое отступление насчет времени работы. Может, читатель думает, что быстрые алгоритмы сложны в исполнении и проще написать что-то вроде сортировки вставками. Что ж, рассмотрим простой пример: допустим, вы написали сортировку вставками, тщательно, с помощью ассемблера, и время работы получилось 2n2, а какой-нибудь раздолбай написал сортировку слиянием со временем работы 50nlog2n. И тут появилась необходимость отсортировать 1000000 элементов (что в наше время не редкость). Вы использовали крутой компьютер, который делает 108 операций сравнения и перестановки в секунду, а у него компьютер похуже — всего 106 операций в секунду. И вы будете ждать 2*(106)2/108 = 20 000 секунд (приблизительно 5.56 часов), а ваш конкурент — 50*(106)*log2(106)/106 = 1000 секунд (приблизительно 17 минут). Надеюсь, вы проведете это время (5 часов) с пользой для себя и поймете, что хороший алгоритм — быстрый алгоритм :-). Хотя, если вы будете сортировать маленький массив или много маленьких массивов, то 2n2 для вас будет лучше, чем 50nlog2n. Эту закономерность использует один из способов оптимизации сортировки слиянием: сортировать маленькие части массива вставками.

Теперь переходим к самому интересному, а именно к одной из самых быстрых и эффективных из известных сортировок, которая так и называется — «быстрая сортировка».

Алгоритм 6. Быстрая сортировка.
Как и в сортировке слиянием, массив разбивается на две части, с условием, что все элементы первой части меньше любого элемента второй. Потом каждая часть сортируется отдельно. Разбиение на части достигается упорядочиванием относительно некоторого элемента массива, т. е. в первой части все числа меньше либо равны этому элементу, а во второй, соответственно, больше либо равны. Два индекса проходят по массиву с разных сторон и ищут элементы, которые попали не в свою группу. Найдя такие элементы, их меняют местами. Тот элемент, на котором индексы пересекутся, и определяет разбиение на группы. Классическая реализация алгоритма выглядит так:


Program QuickSort;  
Var A  : array[1..1000] of integer;  
    N,T : integer;   
Procedure Sort(p,q : integer); {p,q — индексы начала и конца сортируемой части массива}  
Var i,j,r : integer;  
Begin  
 if p<q then {массив из одного элемента тривиально упорядочен}  
 begin  
  r:=A[p];  
  i:=p-1;  
  j:=q+1;  
  while i<j do  
   begin  
    repeat  
     i:=i+1;  
    until A[i]>=r;  
    repeat  
     j:=j-1;  
    until A[j]<=r;  
    if i<j then  
     begin  
      T:=A[i];  
      A[i]:=A[j];  
      A[j]:=T;  
     end;  
   end;  
  Sort(p,j);  
  Sort(j+1,q);  
 end;  
End;  
Begin  
 {Определение размера массива A — N) и его заполнение}  
 …  
 {запуск сортирующей процедуры}  
 Sort(1,N);  
 {Вывод отсортированного массива A}  
  …  
End.   

Что же делает данный алгоритм таким быстрым? Ну во-первых, если массив каждый раз будет делится на приблизительно равные части, то для него будет верно то же соотношение, что и для сортировки слиянием, т. е. время работы будет O(nlog2n). Это уже само по себе хорошо. Кроме того, константа при nlog2n очень мала, ввиду простоты внутреннего цикла программы. В комплексе это обеспечивает огромную скорость работы. Но как всегда есть одно «но». Вы, наверное, уже задумались: а что если массив не будет делится на равные части? Классическим примером является попытка «быстро» отсортировать уже отсортированный массив. При этом данные каждый раз будут делиться в пропорции 1 к n-1, и так n раз. Общее время работы при этом будет O(n2), тогда как вставкам, для того чтобы «понять», что массив уже отсортирован, требуется всего-навсего O(n). А на кой нам сортировка, которая одно сортирует хорошо, а другое плохо? А собственно, что она сортирует хорошо? Оказывается, что лучше всего она сортирует случайные массивы (порядок элементов в массиве случаен). И поэтому нам предлагают ввести в алгоритм долю случайности. А точнее, вставить randomize и вместо r:=A
; написать r:=A[random(q-p)+p]; т. е. теперь мы разбиваем данные не относительно конкретного, а относительно случайного элемента. Благодаря этому алгоритм получает приставку к имени «вероятностный». Особо недоверчивым предлагаю на своем опыте убедится, что данная модификация быстрой сортировки сортирует любые массивы столь же быстро.

А теперь еще один интересный факт: время O(nlog2n) является минимальным для сортировок, которые используют только попарное сравнение элементов и не использует структуру самих элементов. Тем, кому интересно, откуда это взялось, рекомендую поискать в литературе, доказательство я здесь приводить не намерен, не Дональд Кнут, в конце концов :-). Но вы обратили внимание, что для рассмотренных алгоритмов в принципе не важно, что сортировать — такими методами можно сортировать хоть числа, хоть строки, хоть какие-то абстрактные объекты. Следующие сортировки могут сортировать только определенные типы данных, но за счет этого они имеют рекордную временную оценку O(n).

[B]Алгоритм 7. Сортировка подсчетом.

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


Program CountingSort;  
Var A,B   : array[1..1000] of byte;  
    C     : array[byte] of integer;  
    N,i    : integer;  
Begin  
{Определение размера массива A (N) и его заполнение}  
 …  
{сортировка данных}  
 for i:=0 to 255 do  
 C[i]:=0;  
 for i:=1 to N do  
 C[A[i]]:=C[A[i]]+1;  
 for i:=1 to 255 do  
 C[i]:=C[i-1]+C[i];  
 for i:=N downto 1 do  
 begin  
  B[C[A[i]]]:=A[i];  
  C[A[i]]:=C[A[i]]-1; {здесь мы избегаем возможности записи двух одинаковых чисел в одну ячейку}  
 end;  
{Вывод массива B}  
 …  
End.  

Этот простой метод не использует вложенных циклов и, учитывая небольшой диапазон значений, время его работы есть O(n).

Рассмотрев такое количество сортировок, можно задуматься: а будет ли результат их работы одинаковым? Странный вопрос, ведь все сортировки правильно сортируют данные, так почему же результат работы может быть разным? Хорошо, объясню: меньшие элементы всегда расположены перед большими, но порядок одинаковых элементов может быть нарушен. Если мы сортируем данные, которые состоят из одного ключа, то мы, конечно, не заметим разницы. Но если к ключу прилагается дополнительная информация, то одна сортировка может вернуть нам 1977 "Иванов" и 1977 "Сидоров", а другая — 1977 "Сидоров" и 1977 "Иванов". Значит, порядок одинаковых элементов может в процессе сортировки стать другим. Правда, это бывает далеко не всегда и не в каждой сортировке. В сортировках вставками, пузырьком, подсчетом и слиянием порядок элементов с одинаковыми ключами всегда такой же, как и в изначальном массиве. Такие сортировки называются устойчивыми, и сейчас я познакомлю вас с улучшенной сортировкой подсчетом, которая позволяет сортировать числа большего диапазона, используя другую устойчивую сортировку.

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


Program RadixSort;  
Var A,B   : array[1..1000] of word;  
   N,i    : integer;  
   t      : longint;  
Procedure Sort; {сортировка подсчетом}  
Var C    : array[0..9] of integer;  
    j     : integer;  
Begin  
 For j:=0 to 9 do  
 C[j]:=0;  
 For j:=1 to N do  
 C[(A[j] mod (t*10)) div t]:= C[(A[j] mod (t*10)) div t]+1;  
 For j:=1 to 9 do  
 C[j]:=C[j-1]+C[j];  
 For j:=N downto 1 do  
 begin  
  B[C[(A[j] mod (t*10)) div t]]:=A[j];  
  C[(A[j] mod (t*10)) div t] := C[(A[j] mod (t*10)) div t]-1;  
 end;  
End;  
Begin  
{Определение размера массива A (N) и его заполнение}  
 …  
{сортировка данных}  
 t:=1;  
 for i:=1 to 5 do  
 begin  
  Sort;  
  A:=B;  
  t:= t*10;  
 end;  
{Вывод массива A}  
 …  
End. 

Так как сортировка подсчетом вызывается константное число раз, то время работы всей сортировки есть O(n). Заметим, что таким способом можно сортировать не только числа, но и строки, если же использовать сортировку слиянием в качестве устойчивой, то можно сортировать объекты по нескольким полям.

Теперь вы владеете достаточным арсеналом, чтобы сортировать все что угодно и как угодно. Помните, что выбор нужной вам сортировки зависит от того, какие данные вы будете сортировать и где вы их будете сортировать.
P.S. Все программы рабочие — если, конечно, вам не лень будет заменить три точки на код ввода и вывода массивов :-).

Автор: Владимир ТКАЧУК

Добавлено: 01 Августа 2018 07:09:07 Добавил: Андрей Ковальчук

Автоматическая обработка ошибок

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

У всех
Типичная обработка ошибки заключается в том, чтобы обрамить блоки кода в конструкции try..except или try..finally. В общем, все по учебнику. Тем не менее, многие попросту не делают этого, так как им недосуг или обработка исключений оставляется "на потом". Когда подходит время сдачи проекта, нередко такие программисты начинают спешно латать дыры, что может дать не только положительный эффект, я имею ввиду появившуюся у программы обработку исключений, но и отрицательный. Дело в том, что обработка исключительных ситуаций тоже является частью кода, а внесение нового кода может повлечь за собой и внесение новых ошибок.

Избавиться от сложившейся ситуации не так трудно, как может показаться на первый взгляд. Почти все становится ясно, когда вспоминаешь про объект Application и его свойство OnException.

Не у всех
Как вы уже, наверное, догадались, свойство Application.OnException является глобальным обработчиком событий приложения. Перед тем как описать метод использования этого свойства, давайте договоримся, что у нас есть объект класса TgsCatcher (именно его я и описываю в данной статье), у которого есть метод TgsCatcer.Catcher, который и будет обработчиком ошибок приложения. Простейший вариант вышесказанного выглядит следующим образом:


unit gsCatcher;  
  
//**! ----------------------------------------------------------  
//**! This unit is a part of GSPackage project (Gregory Sitnin\'s  
//**! Delphi Components Package).  
//**! ----------------------------------------------------------  
//**! You may use or redistribute this unit for your purposes  
//**! while unit\'s code and this copyright notice is unchanged  
//**! and exists.  
//**! ----------------------------------------------------------  
//**! (c) Gregory Sitnin, 2001-2002. All rights reserved.  
//**! ----------------------------------------------------------  
  
{***} interface {***}  
  
uses Classes, SysUtils, JPEG;  
  
type  
  TgsCatcher = class(TComponent)  
  private  
    FEnabled: boolean;  
    FGenerateScreenshot: boolean;  
    FJPEGScreenshot: boolean;  
    FJpegQuality: TJPEGQualityRange;  
    FCollectInfo: boolean;  
    Fn: TFilename;  
    procedure SetEnabled(const Value: boolean);  
    { Private declarations }  
  protected  
    { Protected declarations }  
    procedure EnableCatcher;  
    procedure DisableCatcher;  
  public  
    { Public declarations }  
    constructor Create(AOwner: TComponent); override;  
    destructor Destroy; override;  
    procedure Catcher(Sender: TObject; E: Exception);  
  published  
    { Published declarations }  
    property Enabled: boolean read FEnabled write SetEnabled  
                      default False;  
  end;  
  
procedure Register;  
  
{***} implementation {***}  
  
uses Windows, Forms, Dialogs, Graphics;  
  
procedure Register;  
begin  
  RegisterComponents(\'Gregory Sitnin\', [TgsCatcher]);  
end;  
  
{ TgsCatcher }  
constructor TgsCatcher.Create(AOwner: TComponent);  
begin  
  inherited;  
end;  
  
destructor TgsCatcher.Destroy;  
begin  
  DisableCatcher;  
  inherited;  
end;  
  
procedure TgsCatcher.SetEnabled(const Value: boolean);  
begin  
  FEnabled := Value;  
  if Enabled then EnableCatcher else DisableCatcher;  
end;  
  
procedure TgsCatcher.DisableCatcher;  
begin  
  Application.OnException := nil;  
end;  
  
procedure TgsCatcher.EnableCatcher;  
begin  
  Application.OnException := Catcher;  
end;  
  
procedure TgsCatcher.Catcher(Sender: TObject; E: Exception);  
begin  
  {TODO: Write some exception handling code}  
end;  
  
end. 

Это компонент, который умеет подключаться и отключаться от обработчика Application.OnException при помощи установки свойства Enabled. В подключенном состоянии все возникшие в приложении исключительные ситуации перенаправляются методу TgsCatcher.Catcher, который с этими исключениями, пока, ничего не делает.

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

Реализация функций
Для начала, давайте снимем скриншот активного окна. Сделать это довольно легко. В секцию implementation подключаем модуль Graphics.
Лирическое отступление: Считается неплохим стилем, подключать модули в секцию implementation, если их информация требуется только в этой секции. Например, в секции interface я нигде не использовал ни одного класса или типа, который описан в модуле Graphics, поэтому и занес его в implementation.
После подключения вышеназванного модуля мы получили возможность работы с изображениями в формате BMP, то есть, мы можем описать объект класса TBitmap и получить в него снимок активного окна при помощи следующего вызова:

bmp := Screen.ActiveForm.GetFormImage;

Сам объект класса TBitmap создавать нет необходимости, так как он будет автоматически создан вызываемым методом GetFormImage. Теперь нам хорошо бы было полученное изображение сохранить в файл, а для этого не плохо бы было назвать файл уникальным именем. Надо заметить, что в Windows, как и во многих операционных системах есть специальный механизм создания действительно уникальных имен файлов. Однако, имена файлов на выходе этих механизмов являются, по большей части, ничего не значащими наборами символов. Но суть этой технологии в уникальности, а это она делает. Мне же хотелось, чтобы имена несли смысловую нагрузку. Было бы здорово, если бы в них было записано имя исполняемого файла, имя формы, дата и время возникновения ошибки. Решается данная задача вот таким образом (Fn - переменная строкового типа):


Fn := ExtractFilename(Application.ExeName)+\'_\'+  
Screen.ActiveForm.Name+  
FormatDateTime(\'_ddmmyyyy_hhnnss\',now)+  
\'_debug\';  

Таким образом, мы получили генератор имен файлов, создающий имена, очень похожие на "PROJECT1.EXE_Form1_22092002_171956_debug.bmp", только без расширения. Теперь, запишем изображение в файл.

bmp.SaveToFile(fn+\'.bmp\'); 

Итог - любое исключение в приложении вызовет автоматическую запись скриншота в файл формата BMP. Но, такой графический формат имеет одну неприятную особенность, дельфи умеет работать только с несжатыми файлами, которые благодаря этому имеют большой объем, а мне бы хотелось посылать эти файлы автоматически по e-mail, чтобы всегда быть в курсе ошибок программы.
К счастью, фирма Borland бесплатно приложила к Delphi библиотеку работы с изображениями в формате JPEG. Поищите на компакт-диске с дельфи или на своем жестком диске в каталогах дельфи файлы, начинающиеся с букв "jpeg".
Таким образом, подключаем модуль JPEG после модуля Graphics и пишем вот такой код:

procedure TgsCatcher.DoGenerateScreenshot;  
var bmp: TBitmap;  
    jpg: TJPEGImage;  
begin  
  bmp := Screen.ActiveForm.GetFormImage;  
  begin  
    jpg := TJPEGImage.Create;  
    jpg.CompressionQuality := 100;  
    jpg.Assign(bmp);  
    jpg.SaveToFile(fn+\'.jpg\');  
    FreeAndNil(jpg);  
  end;  
  FreeAndNil(bmp);  
end;  

>Теперь из метода Catcher достаточно просто вызвать метод DoGenerateScreenshot и автоматическое сохранение скриншота в формате JPEG с качеством 100% вам обеспечено.
Теперь, я хотел бы, чтобы генерировался текстовый отчет об ошибке. Это еще проще. Давайте, к примеру, сделаем отчет, в котором будут указаны имя компьютера и имя текущего пользователя. Пишем вот такие функции и процедуры:

function TgsCatcher.CollectUserName: string;  
var  
  uname: pchar;  
  unsiz: cardinal;  
begin  
  uname := StrAlloc(255);  
  unsiz := 254;  
  GetUserName(uname,unsiz);  
  if (unsiz > 0) then  
    Result := string(uname) else  
    Result := \'n/a\';  
  StrDispose(uname);  
end;  

Эта функция запросит у системы имя пользователя при помощи функции API GetUserName, и вернет строку "n/a", если имя пользователя получить не удалось.

function TgsCatcher.CollectComputerName: string;  
var  
  cname: pchar;  
  cnsiz: cardinal;  
begin  
  cname := StrAlloc(MAX_COMPUTERNAME_LENGTH + 1);  
  cnsiz := MAX_COMPUTERNAME_LENGTH + 1;  
  GetComputerName(cname,cnsiz);  
  if (cnsiz > 0) then  
    Result := string(cname) else  
    Result := \'n/a\';  
  StrDispose(cname);  
end;  

Эта функция аналогична функции CollectUserName, только запрашивает имя компьютера.

procedure TgsCatcher.DoCollectInfo(E: Exception);  
var sl: TStringList;  
begin  
  sl := tstringlist.Create;  
  sl.add(\'--- This report is created by automated \'+  
         \'reporting system.\');  
  sl.add(\'Computer name is: [\'+ComputerName+\']\');  
  sl.add(\'User name is: [\'+UserName+\']\');  
  sl.add(\'--- End of report ----------------------\'+  
         \'-----------------\');  
  sl.SaveToFile(Fn+\'.txt\');  
end;  

Последняя процедура создает объект класса TStringList, наполняет его информацией, которую надо записать и сохраняет в файл, с именем, аналогичном имени файла со скриншотом. Остается только прописать вызов этого метода в процедуре Catcher.
Заключение
Вот, собственно и все. Что же мы получили? Мы получили невизуальный компонент, который автоматически подключается к обработчику исключительных ситуаций приложения. При этом, обработчик умеет создавать скриншот активного окна и записывать в текстовый файл интересующие нас параметры. Вроде бы неплохо.

Автор: Григорий Ситнин

Добавлено: 01 Августа 2018 07:06:04 Добавил: Андрей Ковальчук

Добавляем компонент в стандартный Message Dialog

Пример показывает стандартное диалоговое окно, которое обычно используется для подтверждения дальнейших действий в любой программе с галочкой "Don't show this message again".

Используем функцию CreateMessageDialog и добавляем любой компонент до того как будет вызвана ShowModal.

Например:


procedure TForm1.Button1Click(Sender: TObject);   
var   
  AMsgDialog: TForm;   
  ACheckBox: TCheckBox;   
begin   
  AMsgDialog := CreateMessageDialog('This is a test message.',mtWarning, [mbYes, mbNo]);   
  ACheckBox := TCheckBox.Create(AMsgDialog);   
  with AMsgDialog do   
    try   
      Caption := 'Dialog Title';   
      Height := 169;   
   
      with ACheckBox do   
      begin   
        Parent := AMsgDialog;   
        Caption := 'Don''t show me again.';   
        Top := 121;   
        Left := 8;   
      end;   
   
      case ShowModal of   
        ID_YES: ; //здесь Ваш код после того как диалог будет закрыт   
        ID_NO:  ;   
      end;   
   
      if ACheckBox.Checked then   
      begin   
        //...   
      end;   
    finally  
      ACheckBox.Free;  
      Free;  
    end;  
end;

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

Добавлено: 01 Августа 2018 07:04:33 Добавил: Андрей Ковальчук