Иcпользование API на Delphi 7

Для создания файла DLL в Delphi необходимо выбрать пункт меню: «File -> New Item -> DLL wizard». Исходный код DLL-библиотеки нужно набрать в открывшимся окне и сохранить как файл с расширением «DPR». Никакие формы и файлы с расширение «PAS» здесь не используются.

Для одновременной отладки и создания программы и DLL-библиотеки лучше всего запустить две копии «Delphi» и в них работать отдельно.

1.1. Пример простейшей библиотеки DLL

library demo_dll;

function sc(x: real): real export; stdcall; { Функция расчета }

begin

  xsin:=sin(x)+ cos(x);

end;

exports sc; { Экспорт процедур и функций для внешних программ }

begin { Секция инициализации библиотеки DLL }

end.

end.

1.2. Пример использования библиотеки DLL

unit Demo_dll;

…

var Form1: TForm1;

function sc(x: real): real; stdcall; external 'demo_dll.dll'; { Подключение функции из DLL-библиотеки }

implementation

procedure TForm1.Button1Click(Sender: TObject);

begin

  showmessage(floattostr(sc(5)));

end;

1.3. Пример расширенной библиотеки DLL

library repa;

uses SysUtils, Classes, Windows, Registry, StdCtrls;

procedure Save1(edit1_text: pchar; mm1: pchar; scrollbar1_position: integer); export; stdcall;

// Сохранение данных в реестр

var nfile, s: string; t: tregistry; i,k: integer; m1: tstrings;

begin

  m1:=TStringList.Create; m1.Text:=mm1;

  t:=tRegistry.Create;

  t.RootKey:=HKEY_CURRENT_USER;

  t.OpenKey('\Software\is-302\tsn-12', true);

  t.writestring('', 'repa.dll');

  t.WriteString('Edit1_text', edit1_text);

  k:=m1.count;

  t.WriteInteger('memo1_count', k);

  for i:=0 to m1.Count-1 do begin

    s:=m1[i]; t.Writestring('memo1_L'+inttostr(i+1), s);

  end;

  t.WriteInteger('scrollbar1_position', scrollbar1_position);

  t.closekey; m1.Free;

  t.Free;

  end;

procedure Load1(var edit1_text: pchar; var mm1: pchar; var scrollbar1_position: integer); export; stdcall;

// Считывание данных из реестра

var path_pr, nfile, s,m: string; t: tregistry; i,k,l: integer; m1,edit: tstrings;

begin

 m1:=TStringList.Create;

  t:=tRegistry.Create;

  t.RootKey:=HKEY_CURRENT_USER;

  t.OpenKey('\Software\is-302\tsn-12', true);

   m1.text:='';

   try

    edit1_text:=pchar(t.Readstring('edit1_text'));

   except

    edit1_text:='????';

   end;

  try

  k:=t.readInteger('memo1_count');

  for i:=0 to k-1 do begin

    s:= t.readstring('memo1_L'+inttostr(i+1));

    m1.Add(s);

  end;

  except

  end;

  mm1:=pchar(m1.text);

  try

   l:= t.readInteger('scrollbar1_position'); scrollbar1_Position:=l;

  except

  end;

  t.closekey; m1.Free; t.Free;

end;

procedure Clear1(var edit1_text: pchar; var mm1: pchar; var scrollbar1_position: integer); export; stdcall;

// Очистка данных

begin

  edit1_text:=''; mm1:=''; scrollbar1_position:=0;

end;

exports Clear1, Save1, Load1;

begin

end.

1.4. Пример использования расширенной библиотеки DLL

unit Unit1;

…

var

  Form1: TForm1;

procedure Save1(edit1_text: pchar; mm1: pchar; scrollbar1_position: integer); stdcall; external 'repa.dll';

procedure Load1(var edit1_text: pchar; var mm1: pchar; var scrollbar1_position: integer); stdcall; external 'repa.dll';

procedure Clear1(var edit1_text: pchar; var mm1: pchar; var scrollbar1_position: integer); stdcall; external 'repa.dll';

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

// Запись данных

begin

   Save1(Pchar(edit1.text), Pchar(memo1.Lines.Text), scrollbar1.Position);

end;

procedure TForm1.Button2Click(Sender: TObject);

// Очистка данных

var e,m: pchar; k: integer;

begin

  clear1(e, m, k);

  edit1.text:=e; memo1.Lines.Text:=m; scrollbar1.Position:=k;

end;

procedure TForm1.Button3Click(Sender: TObject);

// Загрузка данных

var e,m: pchar; k: integer;

begin

  Load1(e, m, k);

  edit1.text:=e; memo1.Lines.Text:=m; scrollbar1.Position:=k;

end;

end.

ЛЕКЦИЯ №7

1. API – ФУНКЦИИ WINDOWS УПРАВЛЕНИЯ ВНЕШНИМИ ПРИЛОЖЕНИЯМИ

API-функции – это набор стандартных функций операционной системы Windows, через которые можно программно управлять всеми запущенными программами и ресурсами компьютера. API-функции являются некоторым современным аналогом функциям-прерываниям INT21h MS-DOS. Возможность использовать данные функции в Делфи организуется через автоматически подключаемый модуль «Windows».

Для получения справки по API-функциям из Делфи необходимо выбрать пункт «Help > Windows SDK (Win32 Developer's References)». Данный хелп содержит подробную информацию о правилах вызова основных API- функций (синтаксис языка «С»).

Все визуальные компоненты Делфи, например «Edit, Label, Button» и др. являются окнами, как и форма. Для универсальной работы с любыми окнами используются дескрипторы (handle) окон. Дескриптор окна – это указатель на окно в виде целого числа (аналог порядкового номера), типа «HWND» (прототип «Integer»). При открытии любого окна (видимого или невидимого, типа формы или кнопки), Windows присваивает ему уникальный дескриптор. Данный указатель действителен до закрытия окна или перезагрузки Windows. Любому окну Windows может присвоить любой дескриптор.

Для того, чтобы узнать дескрипторы окон какой-либо программы, применяется программа «WinSight32» из пакета программ Delphi или другая подобная программа.

ПРИМЕР ВЫЗОВА API-ФУНКЦИИПОЯСНЕНИЕ (VAR H,H2:HWND; I: LONGWORD; S: STRING;)GetWindowText(h, pchar(s),I);Получение текста из окна «h» в переменную «s» длиной не более «i» символовi:=GetWindowtextLength(h);Получение длины текста из окна «h» в переменную «i»SetWindowText(h, pchar(s));Установка текста «s» в окне «h»h:=FindWindow(pchar(s),nil);Поиск дескриптора окна с именем класса «s» в переменную «h»h2:=GetWindow(h, GW_CHILD);Поиск подчиненного окна «h2» для окна «h»h2:=GetWindow(h, GW_HWNDNEXT);Поиск следующего подобного окна «h2» для окна «h»If h=0 then WinExec(‘calc.exe’, SW_SHOWMODAL);Если искомое окно не найдено, то запустить указанную программу «calc.exe»ShowWindow(h, SW_HIDE);Установить для окна «h» заданный режим отображенияShowWindow(h, SW_MINIMIZE);Установить для окна «h» заданный режим отображенияShowWindow(h, SHOWNORMAL);Установить для окна «h» заданный режим отображенияSetForegroundWindow(h);Поместить видимое на экране окно «h» поверх всех оконSendMessage(h, WM_LBUTTONDOWN,0,0);Посылка окну «h» сообщение с параметрами (эмуляция нажатия левой кнопки мыши)MoveWindow(h, 210,38,30,20,true);Задать окну «h» координаты x и y верхнего левого угла, ширину, высоту и флаг автоматической перерисовки окнаCloseWindow(h);Сворачивание окна «h»PostMessage(h, WM_QUIT,0,0);Посылка сообщения для закрытия окна «h»Edit1.Perform(WM_CHAR, byte(“!”),0);Посылка компоненту формы сообщения (эмуляция ввода символа в компонент, эмуляция нажатия стрелки вниз). Используется в собственных программах на DelphiCombobox1.Perform(Посылка компоненту формы сообщения (эмуляция ввода символа в компонент, эмуляция нажатия стрелки вниз). Используется в собственных программах на DelphiWM_KEYDOWN, VK_DOWN,0);ShellExecute( handle, ’open’, ’c:\’, nil, nil, sw_shownormal)Открывает нужную папку в ПроводникеShellExecute( Открывает документ «test.doc». Папка для временных файлов «c:\temp»application.MainForm.handle, ’open’, ’test.doc’,nil, ’c:\temp’, sw_shownormal)ShellExecute( handle, ’open’, ’mailto: [e-mail]’, nil, nil, sw_shownormal)Открывает почтовый клиент для создания письма для заданного электронного адресаShellExecute(handle, ’open’, ’http://www.pau.kz’, nil, nil, sw_shownormal)Открывает Интернет-браузер для просмотра указанной WWW-страницы

2. ПРИМЕР РАБОТЫ С API-ФУНКЦИЯМИ

function GetText1(Wnd: HWND): string;

{ Получение текста из окна, способ 1 (универсальный) }

var textlength: Integer; Text: PChar;

begin

  textlength := SendMessage(Wnd, WM_GETTEXTLENGTH, 0, 0);

  if textlength = 0 then Result := '' else begin

     GetMem(Text, textlength + 1);

     SendMessage(Wnd, WM_GETTEXT, textlength + 1, Integer(Text));

     Result := Text;

     FreeMem(Text);

  end;

end;

function GetText2(h: HWND): string;

{ Получение текста из окна, способ 2 }

var i:LongWord; s:string;

begin

  i:=GetWindowTextLength(h)+1; SetLength(s,i);

  GetWindowText(h,pchar(s),i); SetLength(s,i-1);

  GetText2:=s;

end;

procedure SetTxt1 (h: HWND; s: string);

{ Установка текста в окне (универсальный) }

begin

 SendMessage(h,WM_SETTEXT,0, longint(pchar(s)));

end;

procedure SetTxt2 (h: HWND; s: string);

{ Установка текста в окне }

begin

  SetWindowText(h,pansichar(s));

end;

Procedure ClickWnd(h: HWND);

{ "Нажатие" на окно левой кнопкой мыши }

begin

  SendMessage(h,WM_LBUTTONDOWN,0,0);

  SendMessage(h,WM_LBUTTONUP,0,0);

end;

procedure ClickTB(h: HWND; BTN_ID: integer);

{ "Нажатие" на кнопку тулбара }

begin

  SendMessage(h, WM_COMMAND, BTN_ID, 0);

end;

procedure Button3Click(Sender: TObject);

{ Клик на кнопку "Добавить" в архиваторе "7z" }

var h: hwnd;

begin

  h:=Findwindow('FM',nil);

  if h=0 then winexec('C:\Program Files\7-Zip\7zFM.exe',sw_show);

  h:=Findwindow('FM',nil); sleep(1000);

  if h=0 then exit;

  SetForeGroundWindow(h);

  SetTxt2 (h,’ok’);

  MoveWindow(h,210,38,30,20,true);

  h:=GetWindow(h,gw_child);

  h:=GetWindow(h,gw_child);

  h:=GetWindow(h,GW_HWNDNEXT);

  ClickTB(h, 2000);

end;

3. СОЗДАНИЕ ПРОГРАММНЫХ ЛОВУШЕК В DELPHI

unit Loader_DLL_TSN;

…

var

  Form1: TForm1;

  procedure hook(switch : Boolean); stdcall; external 'hook_dll_tsn.dll';

 const IDM_TSN=$C0;

implementation

{$R *.dfm}

procedure TForm1.FormActivate(Sender: TObject);

var h: HWND; p, pp: HMENU;

begin

   h:=FindWindow('SciCalc',nil); if h=0 then winexec('calc',SW_SHOW);

   h:=FindWindow('SciCalc',nil); if h=0 then exit else SetForegroundWindow (h);

   hook(true); // Устанавливаем наш перехватчик событий Windows

  p:=GetMenu(h); // Верхнее меню

  // Меняем название пункта в верхнем меню "Справка"

  ModifyMenu(p, 2, MF_BYPOSITION, GetMenuItemID(p,2), '-TSN-' );

  pp:= GetSubMenu(p,2); // Подпункты в верхнем меню (с нуля отсчет)

  // Меняем название подпункта в подменю "Справка -> О программе"

  ModifyMenu(pp, 2, MF_BYPOSITION, GetMenuItemID(pp,2) , 'About Sergius …' );

  // Добавляем новый элемент подменю с идентификатором IDM_TSN

  AppendMenu(pp, MF_STRING ,IDM_TSN, 'А это новый пункт !');

  DrawMenuBar(h); // Прорисовываем модифицированное меню

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

{ при закрытии формы – освобождаем Hook }

var h: HWND;

begin

  hook(false); // Деактивизируем наш перехватчик событий Windows

  h:=FindWindow('SciCalc',nil);

  h:=FindWindow('SciCalc',nil); if h<>0 then Postmessage(h,WM_QUIT,0,0);

end;

end.

library HOOK_DLL_TSN;

uses Windows, Messages, SysUtils;

var SysHook: HHook = 0; Wnd: Hwnd = 0;

const IDM_TSN=$C0;

function SysMsgProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;forward;

{Процедура установки HOOK-а}

procedure hook(switch : Boolean) export; stdcall;

begin

  if switch=true then

    // Устанавливаем хук на сообщения после их обработки в приложении

    // Наша процедура захвата называется "SysHook", в данном модуле

    SysHook := SetWindowsHookEx(WH_GETMESSAGE, @SysMsgProc, HInstance, 0)

  else UnhookWindowsHookEx(SysHook);

end;

function SysMsgProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;

{ Обработчик перехвата }

label 1;

var dc: HDC; h, h2: HWND; x: cardinal; ss: string;

begin

  { Если нам не стоит обрабатывать это событие, то и не надо,

    передадим упраление следующиму хуку }

  if (code<0) or (code<>HC_ACTION) then goto 1;

  // Ищем калькулятор, если он не запущен, но отдыхаем …

  h:=FindWindow('SciCalc',nil); if h=0 then goto 1;

  h2:=GetWindow(h,GW_CHILD); // Нашли окно отображения (табло) у кальулятора

  // Если калькулятор не виден, то ничего не надо …

  if not IsWindowVisible(h) then goto 1;

   // Получаем указатель на текущее обрабатываемое окно, ждем калькулятор

   Wnd:=TMsg(Pointer(lParam)^).hwnd;

    // Механизм нашей прорисовки на калькуляторе для любого окна

     ss:='Кликни правой по калку …';

     dc:=GetDC(h); SetBkMode(dc, TRANSPARENT);

     TextOut(dc,15,4,pansichar(ss),length(ss));

     // –

     x:=TMsg(Pointer(lParam)^).message; // Получаем код сообщения окна

       // Запрещаем щелкать по окошку калькулятора

       if (wnd=h2) and (x=WM_LBUTTONDOWN) then begin

             MessageBox(0, 'Нельзя !!!', 'Щелкать по окошку',0 );

             TMsg(Pointer(lParam)^).message:=0; // Анулируем сообщение

          end;

        // Механиз обработки "нашего" пункта меню в калькуляторе

         if (wnd=h) and (x=WM_COMMAND)

             and (lo(TMsg(Pointer(lParam)^).wParam) = IDM_TSN)

             then MessageBox(0, 'Да!', 'Калькулятор говорит', 0);

  { Передаем сообщение дальше по цепочке hook-ов }

1: Result:=CallNextHookEx(SysHook, Code, wParam, lParam);

end;

exports hook;

begin

end.

ЛЕКЦИЯ №8

1. РАБОТА С ПРИЛОЖЕНИЕМ «MS WORD»

unit main;

uses … ComCtrls, WordXP, OleServer, Variants;

type TForm1 = class(TForm)

…

    wa: TWordApplication;

    wd: TWordDocument;

var Form1: TForm1; t, tt, vv: OleVariant; // параметры для передачи

implementation

…

procedure TForm1.Button1Click(Sender: TObject);

var i:integer;

begin

  wa := wa.Create(nil); // создаем экземпляр Word

  wa.Visible := true; // делаем его видимым

  t := 'Normal'; // шаблон

  tt := false; // не создавть шаблон

  wa.Documents.Add(t, tt, EmptyParam, EmptyParam); // добавляем документ

  // подключаем к объекту WordDocument созданный документ

  wd.ConnectKind := ckAttachToInterface; wd.ConnectTo(wa.ActiveDocument);

  t := wd.Range; // переменная – параметр, шаблон для нового абзаца

  // добавляем в документ 3 абзаца:

  wd.Paragraphs.Add(t); wd.Paragraphs.Add(t); wd.Paragraphs.Add(t); // абзац #3

    wd.Paragraphs.Item(1).Range.InsertBefore('Привет, TSN !!!'); // вставляем текст в абзац #1

  // вставляем текст в абзац #2

  wd.Paragraphs.Item(2).Range.InsertBefore('Переключившись в программу, можно программно менять текст ячеек !');

  wd.Paragraphs.Item(1).Range.Font.ColorIndex := 11; // цвет зеленый в абзаце #1

  wd.Paragraphs.Item(2).Range.Font.ColorIndex := 5; // цвет розовый в абзаце #2

  wd.Paragraphs.Item(3).Range.Font.Bold := 1; // шрифт – жирный

  wd.Paragraphs.Item(3).Range.Font.Italic := 1; // шрифт – рукописный

  // добавляем таблицу

  wd.Tables.Add(wd.Paragraphs.Item(3).Range, 5, 4, EmptyParam, EmptyParam); // 5-строк, 4- cтолбца

  wd.Tables.Item(1).Range.Font.ColorIndex := 2; // цвет синий в таблице

  // в цикле задаем значение ячеек, добавляем текст

  for i := 1 to 5 do wd.Tables.Item(1).Cell(i, 1).Range.Text := IntToStr(i);

end;

procedure TForm1.FormDestroy(Sender: TObject);

var s: OleVariant; // для параметров

begin

  try

    s:=False; //изменения не сохранять

    wd.Close(s,EmptyParam,EmptyParam); // закрыть сначала документ

    wa.Quit(s,EmptyParam,EmptyParam); // а потом и ворд

  except end; // ничего не предпринимаем, если ворд уже закрыт

end;

procedure TForm1.BitBtn1Click(Sender: TObject);

begin

  // в соотв ячейку ставим соотв значение, а можно и наоборот

  wd.Tables.Item(1).Cell(UpDown2.Position,UpDown1.Position).Range.Text:=Edit3.Text;

end;

end.

2. РАБОТА С ПРИЛОЖЕНИЕМ «MS EXCEL»

unit Main;

….

  private

    XLApp: Variant;

  public

implementation

uses … ComObj, Variants;

const cXL1 = -4167; cXL2 = 1;

procedure TForm1.FormDestroy(Sender: TObject);

{ Уничтожение формы }

begin

  { Если открыт нужный лист Excel, то … }

  if not VarIsEmpty(XLApp) then begin

    XLApp.DisplayAlerts := False; // если True – то спрашивает о сохр.

    XLApp.Quit; // Закрытие Excel'a

  end;

end;

procedure TForm1.Button1Click(Sender: TObject);

var R, C, S: Variant; i: Integer;

begin

  XLApp:= CreateOleObject('Excel.Application'); // Подключение к Excel

  XLApp.Visible := True; // Включение Excel на экран

  XLApp.Workbooks.Add(cXL1); // Добавляем новый лист

  // Задаем листу название

  XLApp.Workbooks[1].WorkSheets[1].Name := 'Delphi Data';

  // Вставка данных в лист

  S := XLApp.Workbooks[1].WorkSheets['Delphi Data'];

  for i := 1 to 10 do S.Cells[i, 1] := i;

  S.Cells[i, 1] := '=Sum(A1:A10)'; // Вставка формулы

  // Работа с областью (рангом)

  R:=XLApp.Workbooks[1].WorkSheets['Delphi Data'].Range['C1:F25'];

  R.Formula := '=RAND()'; // Вставка формулы в ранг

  R.Columns.Interior.ColorIndex := 3; // Цвет закраски фона

  R.Font.Color := clGreen; // Цвет ранга

  R.Borders.LineStyle := cXL2; // Ячейки обрамленные

  // Работа с колонкой и шрифтом

  C:=XLApp.Workbooks[1].WorkSheets['Delphi Data'].Columns;

  C.Columns[1].ColumnWidth := 5; C.Columns.Item[1].Font.Bold := True;

  C.Columns[1].Font.Color := clBlue;

end;

end.

3. ИМПОРТ/ЭКСПОРТ ДАННЫХ ИЗ EXCEL

unit Unit1;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Grids, StdCtrls, OleServer, ExcelXP, comobj;

type

  TForm1 = class(TForm)

    ee: TExcelApplication;

    Button1: TButton;

    StringGrid1: TStringGrid;

    Button2: TButton;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

// Импорт данных из Excel в StringGrid

var i: integer; s1,s2: string;

begin

  StringGrid1.ColWidths[0]:=120; StringGrid1.ColWidths[1]:=320;

  ee.Workbooks.Add('D:\Report11.xls ', 0);

  ee.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;

  StringGrid1.RowCount:=ee.ActiveCell.Row;

  for i:=0 to ee.ActiveCell.Row do begin

    s1:=ee.Cells.Item[8+i, 2]; s2:=ee.Cells.Item[8+i, 3];

    if s1='' then break;

    StringGrid1.Cells[0, i]:=s1; StringGrid1.Cells[1, i]:=s2;

  end; StringGrid1.RowCount:=i; ee.Disconnect;

end;

procedure TForm1.Button2Click(Sender: TObject);

// Экспорт данных из StringGrid в Excel

var e,r: Variant; i: integer;

begin

  e:=CreateOleObject('Excel.Application');

  e.Visible:=true; e.WorkBooks.Add;

  r:=e.Workbooks[1].WorkSheets[1];

  r.Columns[1].ColumnWidth := 12;

  r.Columns[2].ColumnWidth := 22;

  for i:=0 to StringGrid1.RowCount-1 do begin

    e.Cells.Item[i+1, 2]:=StringGrid1.Cells[0, i];

    e.Cells.Item[i+1, 3]:=StringGrid1.Cells[1, i];

  end;

  //e.Quit;

end;

end.