Delphi - сбориник статей
Формат файла модели
Этот формат и необходимо определить перед тем, как писать процедуру загрузки. Во-первых, файл должен содержать знак - признак файла модели. В качестве такого знака можно использовать три буквы, которые одновременно будут и расширением файла.Поскольку в OpenGL основной используемый формат данных - это GLFloat, который определён, как Single, то файл модели должен быть именно file of Single. Поскольку мы собираемся хранить в файле так же данные типа word, то можно заранее ввести ещё один новый тип, который послужит для записи этих данных в файл типа Single. Определить этот тип можно следующим образом: b4=array[1..2] of word;
Далее можно составить процедуры перевода типа b4 в тип Single. Так же, необходимо сохранить в файл строковые данные - это знак модели и её имя. Поэтому так же необходимо ввести возможность сохранения в файл и последующего чтения строковых данных. В файл будут подряд записаны следующие данные:
Теперь можно написать процедуру чтения данных из такого файла. Для начала, введём тип b4 и напишем подпрограммы для преобразования его в тип Single для записи в файл, а так же функцию, которая будет читать из файла строку. Procedure TModel.LoadFromFile(filename:string); //4-х байтный тип, преобразуемый в Single type b4=array[1..2] of word; //Получить два целых числа - старшую и младшую пару //из двойного слова Single Function Getb4ofd(n:single):b4; var p1:pointer; p2:^b4; begin p1:=@n; p2:=p1; Getb4ofd:=p2^; end; //Получить строку из 3-х символов из Function GetStrOfD(n:single):string; type s3=string[3]; var p1:pointer; p2:^s3; begin p1:=@n; p2:=p1; GetStrOfD:=p2^; end; var //Переменные для доступа к файлу модели Function ReadString:ansistring; var x:single; l, k:integer; res:string; //Получить целое двойное слово из числа Single Function GetLIOfS(n:Single):LongInt; var p1:pointer; p2:^longint; begin p1:=@n; p2:=p1; GetLIOfs:=p2^; end; begin res:=''; read(t, x); l:=GetLIOfS(x); for k := 1 to l do begin read(t, x); res:=res+GetStrofD(x); end; ReadString:=res; end;
После этого можно прочитать модель из файла, пользуясь описанием её формата. Begin //Открыть файл для чтения assignfile(t, filename); reset(T); //Прочитать заголовок read(t, n); //Если он не такой, какой нужен, следовательно, //файл не формата модели if getStrOfD(n)<>'YEM' then begin closefile(t); exit; end; //Прочитать из файла имя модели ModelName:=readstring; //Прочитать из файла данные о сетке read(t, body.Empty); //Пустое место read(t, n); //Получить количество вершин body.VertexCount:=Getb4ofd(n)[1]; //количество треугольников body.FacesCount:=Getb4ofd(n)[2]; read(t, n); //И количество вершин на карте текстуры body.TexVertexCount:=Getb4ofd(n)[1]; //Выделить подо всё это память GetMem(body.Vertices, body.VertexCount*SizeOf(TVertex)); GetMem(body.Faces, body.FacesCount*SizeOf(TFace)); //Необходимо выделить память и для переменных //временного назначения GetMem(body.DeformatedVertices, SizeOf(TVertex)*body.VertexCount); GetMem(body.TexVertices, body.TexVertexCount*SizeOf(TVertex)); GetMem(body.TexFaces, body.FacesCount*Sizeof(TFace)); for i := 0 to body.VertexCount-1 do begin //Ввести координаты вершин сетки read(t, body.Vertices[i].x); read(t, body.Vertices[i].y); read(t, body.Vertices[i].z); end; for i := 0 to body.FacesCount-1 do begin //Ввести индексы вершин треугольников read(t, n); body.Faces[i][0]:=Getb4ofd(n)[1]; body.Faces[i][1]:=Getb4ofd(n)[2]; read(t, n); body.Faces[i][2]:=Getb4ofd(n)[1]; end; for i := 0 to body.TexVertexCount-1 do begin //Ввести координаты текстуры read(t, body.TexVertices[i].x); read(t, body.TexVertices[i].y); read(t, body.TexVertices[i].z); end; for i := 0 to body.FacesCount-1 do begin //Ввести треугольники на текстурной карте read(t, n); body.TexFaces[i][0]:=Getb4ofd(n)[1]; body.TexFaces[i][1]:=Getb4ofd(n)[2]; read(t, n); body.TexFaces[i][2]:=Getb4ofd(n)[1]; end; read(t, n); //Получить количество точек body.PointCount:=Getb4ofd(n)[1]; //и количество костей body.BoneCount:=Getb4ofd(n)[2]; //Выделить для их хранения память GetMem(body.Points, body.PointCount*sizeof(SkPoint)); GetMem(body.Bones, body.BoneCount*SizeOf(SkBone)); for i := 0 to body.PointCount-1 do begin //Прочитать координаты точек read(t, body.Points[i].x); read(t, body.Points[i].y); read(t, body.Points[i].z); end; for i := 0 to body.BoneCount-1 do begin //Прочитать индексы точек начала и конца кости read(t, n); body.Bones[i].StartPoint:=Getb4ofd(n)[1]; body.Bones[i].EndPoint:=Getb4ofd(n)[2]; read(t, n); //Получить количество привязанных вершин body.Bones[i].numVertices:=Getb4ofd(n)[1]; GetMem(body.Bones[i].VertArray, 2*body.Bones[i].numVertices); for j := 0 to body.Bones[i].numVertices-1 do begin //Получить индексы вершин сетки,привязанных к кости read(t, n); body.Bones[i].VertArray[j]:=Getb4ofd(n)[1]; end; end; read(t, n); //Получить количество частей тела numBodyParts:=Getb4ofd(n)[1]; //Прочитать названия частей тела for i := 0 to numBodyParts-1 do readString; //Выделить память для временного хранения //углов поворота костей в данный момент времени GetMem(body.DeformationBoneState, body.BoneCount*SizeOf(TBoneState)); //Обнулить эти ячейки памяти for i := 0 to body.BoneCount-1 do begin body.DeformationBoneState[i].AngleYOZ :=0; body.DeformationBoneState[i].AngleXOZ :=0; body.DeformationBoneState[i].AngleXOY :=0; end; //Ввести данные анимации для каждой части тела for i := 0 to numBodyParts-1 do begin read(t, n); //Ввести количество движений, которые может совершать //данная часть тела numActions[i]:=Getb4ofd(n)[1]; for j := 0 to numactions[i]-1 do begin //Выделить память для хранения движения GetMem(BodyParts[i][j], SizeOf(TBodyPartAction)); read(t, n); //Ввести из файла продолжительность движения и //количество ключевых кадров BodyParts[i][j].Duration:=Getb4ofd(n)[1]; BodyParts[i][j].KeyFrameCount:=Getb4ofd(n)[2]; //Ввод ключевого кадра for m := 0 to BodyParts[i][j].KeyFrameCount-1 do begin read(t, n); //Ввести количество задействованных в ключевом //кадре костей BodyParts[i][j].KeyFrames[m].KFTimer:= Getb4ofd(n)[1]; //и момент времени, в который выполняется //этот ключевой кадр BodyParts[i][j].KeyFrames[m].BoneCount:= Getb4ofd(n)[2]; //Выделить память для хранения ключевого кадра GetMem(BodyParts[i][j].KeyFrames[m].BoneState, BodyParts[i][j].KeyFrames[m] .BoneCount*SizeOf(TBoneState)); GetMem(BodyParts[i][j].KeyFrames[m].BoneIndexes, BodyParts[i][j].KeyFrames[m].BoneCount*2); for v := 0 to Bodyparts[i][j].KeyFrames[m] .BoneCount-1 do begin //Получить данные о повороте костей //в ключевом кадре read(t, n); BodyParts[i][j].KeyFrames[m].BoneState[v] .AngleYOZ:=n; read(t, n); BodyParts[i][j].KeyFrames[m].BoneState[v] .AngleXOZ:=n; read(t, n); BodyParts[i][j].KeyFrames[m].BoneState[v] .AngleXOY:=n; read(t, n); //и индексы этих костей Bodyparts[i][j].KeyFrames[m].BoneIndexes[v]:= GetB4ofd(n)[1]; end; end; end; end; closefile(t); end;
Теперь можно реализовать подпрограмму TimeLeft, однако, в силу её простоты, я надеюсь, читатель сможет сам в ней разобраться. Я же перейду к подпрограмме PresetRotateAngles, которая должна совершать следующие действия. Как мы знаем, в массиве Timers хранятся значения времени выполнения действия каждой частью тела. Программа должна определить, соответствуют ли эти моменты времени ключевым кадрам. Если да, то она просто переписывает углы поворота в массив DeformatedBonesState подобъекта Body, а если текущему моменту не соответствует ключевой кадр, программа должна определить два ближайших ключевых кадра и вычислить угол поворота кости. Напомню, что в условии нигде не говорилось о том, что ключевые кадры отсортированы в файле по возрастанию KFTimer. Поскольку потребуется создавать каким-то образом модели, то пользователь вряд ли сможет сразу узнать, в какие моменты времени потребуется вставить ключевые кадры. Поэтому при создании ключевые кадры не отсортированы. Итак, приступим. Введём три переменные для цикла и 9 переменных Single, которые будут хранить углы поворота в следующий момент времени, предыдущий и текущий. Кроме того, для поиска соседних ключевых кадров нам потребуются две переменные, которые как-то запомнят эти кадры, а, если ключевой кадр будет найден, его так же потребуется сохранить. Procedure TModel.PresetRotateAngles(DeltaTimer:word); var i, j, k:integer; Anglex1, anglex2, angley1, angley2, anglez1, anglez2, anglex, angley, anglez:single; minupper, maxlower:integer; KeyFrameIndex:integer;
Теперь нужно увеличить значение всех таймеров на DeltaTimer. А если при этом таймер переходит за предел времени, требуется вернуть его назад. for i := 0 to numBodyParts-1 do begin Timers[i]:=Timers[i]+DeltaTimer; if Timers[i]>BodyParts [i, CurrentActions[i]].Duration then Timers[i]:=Timers[i]-BodyParts [i, currentActions[i]].Duration; end;
После этого можно попробовать найти ключевой кадр, соответствующий данному моменту. Если он найден, можно сразу переписать значения. Иначе - их придётся вычислить. ()
Теперь значения углов поворота костей были записаны в массив DeformationBoneState подобъекта Body. Теперь можно составить алгоритм поворота этих костей. Модель должна содержать такую вершину скелета, положение которой не зависит ни от одной кости. Программа находит эту точку и пробует повернуть кости, которые начинаются в этой точке. По пути, она поворачивает и все кости, которые начинаются из конца текущей. Определим рекурсивную процедуру поворота костей. Procedure TModel.Draw(x1, y1, x2, y2, mx1, my1, mx2, my2:single); Procedure RotateBone(BoneIndex:word); var R_i:integer; //Чтобы не перепутать циключескую //переменную из тела основной процедуры, //Добавим к этой префикс x, y, z:single; x0, y0, z0, d, alpha0:single; begin for R_i := 0 to Body.BoneCount-1 do //Если другая кость выходит из конца данной кости, //провести эту процедуру с ней if Body.Bones[R_i].StartPoint=Body.Bones [BoneIndex].EndPoint then RotateBone(R_i); //Получить координаты точки, вокруг //которой совершить поворот x:=Body.Points[Body.Bones[BoneIndex].StartPoint].x; y:=Body.Points[Body.Bones[BoneIndex].StartPoint].y; z:=Body.Points[Body.Bones[BoneIndex].StartPoint].z; for R_i := 0 to Body.Bones[BoneIndex].numVertices-1 do begin //Получить координаты поворачиваемой точки x0:=Body.DeformatedVertices [Body.Bones[BoneIndex].VertArray[R_i]].x; y0:=Body.DeformatedVertices [Body.Bones[BoneIndex].VertArray[R_i]].y; z0:=Body.DeformatedVertices [Body.Bones[BoneIndex].VertArray[R_i]].z; //Совершить поворот отдельно //в трёх различных плоскостях d:=sqrt((y0-y)*(y0-y)+(z0-z)*(z0-z)); alpha0:=arctan((z0-z)/(y0-y)); if y0-y<0 then begin if alpha0<0 then alpha0:=alpha0+pi else alpha0:=alpha0-pi; end; alpha0:=alpha0+Body.DeformationBoneState [BoneIndex].AngleYOZ; y0:=y+d*Cos(alpha0); z0:=z+d*sin(alpha0); d:=sqrt((x0-x)*(x0-x)+(z0-z)*(z0-z)); alpha0:=arctan((z0-z)/(x0-x)); if x0-x<0 then begin if alpha0<0 then alpha0:=alpha0+pi else alpha0:=alpha0-pi; end; alpha0:=alpha0+Body.DeformationBoneState [BoneIndex].AngleXOZ; x0:=x+d*Cos(alpha0); z0:=z+d*sin(alpha0); d:=sqrt((x0-x)*(x0-x)+(y0-y)*(y0-y)); alpha0:=arctan((y0-y)/(x0-x)); if x0-x<0 then begin if alpha0<0 then alpha0:=alpha0+pi else alpha0:=alpha0-pi; end; alpha0:=alpha0+Body.DeformationBoneState [BoneIndex].AngleXOY; x0:=x+d*Cos(alpha0); y0:=y+d*sin(alpha0); //Сохранить координаты вершин после поворота Body.DeformatedVertices[Body.Bones [BoneIndex].VertArray[R_i]].x:=x0; Body.DeformatedVertices[Body.Bones [BoneIndex].VertArray[R_i]].y:=y0; Body.DeformatedVertices[Body.Bones [BoneIndex].VertArray[R_i]].z:=z0; end; end; var PointsDerivation:array[word] of boolean; TmpVertex:TVertex; TmpFace:TFace; TmpTexVertex:TVertex; TmpTexFace:TFace; i, j, k:integer; begin for i := 0 to Body.VertexCount-1 do //Записать значения вершин до деформации Body.DeformatedVertices[i]:=Body.Vertices[i]; //Найти независимую точку for i := 0 to Body.PointCount-1 do PointsDerivation[i]:=false; for i := 0 to Body.PointCount-1 do for j := 0 to Body.BoneCount-1 do if Body.Bones[j].EndPoint = i then PointsDerivation[i]:=true; for i := 0 to Body.BoneCount-1 do //Совершить поворот костей, //начинающихся от независимой точки if not PointsDerivation[Body.Bones[i].StartPoint] then RotateBone(i);
Теперь следует расхождение. Одна из подпрограмм рисует тело с маскировкой, другая - без неё. Честно скажу, не уверен в том, что процедура рисования сетки с маскировкой будет работать - была написана наспех. Однако первая процедура проверена. В силу её простоты я не буду её здесь приводить. В силу того, что рисование объектов с маскировкой не входит в тему настоящей статьи, считаю, что читатель сам сможет в ней разобраться, используя статьи соответствующей тематики. Так же считаю ненужным приводить здесь комментарии к процедуре Destroy. Ломать всегда легче, чем строить. Выгружать почти всегда легче, чем загружать. На этом могу сказать, что модуль для работы с моделью готов.
Однако сам модуль не умеет делать ровным счетом ничего. Сначала нужно составить, во-первых, программу для разработки таких моделей, а, во-вторых, какую-нибудь программу, которая бы использовала этот модуль. Скажу несколько слов только по поводу названной программы. Она составлена. И включена в пакет, включенный в статью. Эта программа загружает из текстового файла сетку и позволяет создать к ней скелет, а к скелету - анимацию. Сразу скажу, работать в ней - не в потолок плевать. Это Вам не MAX. Текстовые файлы должны иметь тип EYE, и следующий формат. В первой строке файла записаны количество вершин сетки, количество полигонов и количество вершин на карте текстуры. После этого в текстовом виде перечислены все необходимые данные. Заранее прошу прощения за то, что программа на английском языке. Дело в том, что, по крайней мере на моей машине, в двух операционных системах - Windows 98 и Windows XP, - разные кодировки русских букв, поэтому программа, составленная под WinXP, под Win98 выводит на экран иероглифы. Для создания файл EYE из 3DStudioMax можно воспользоваться поставляемым макросом. Идея макроса и экспорта сетки с текстурой заимствованы из статьи .
Теперь скажу пару слов о тестовой программе. Она загружает файл модели и файл текстуры. Нельзя, чтобы модель была привязана к текстуре. Если модель не привязана к текстуре, то, пользуясь различными текстурами, можно, надевая их на одну и ту же модель, создавать разные объекты. Например, на сетку, которая могла бы быть лейтенантом, кроме текстуры лейтенанта можно надеть текстуры капитана, майора, и т.д. Загружаемая тестовой программой модель содержит слегка анимированного террориста из Counter Strike. Я говорю слегка потому, что он может выполнять совсем мало действий, однако этого достаточно, чтобы продемонстрировать возможности модуля. Надетая на него текстура является смесью текстуры персонажа и текстуры дробовика, позаимствованной мною из игры Medal of Honour. После этого при нажатии на форме появляется человек, вооружается и начинает бежать, наставив на кого-то прицел. Программа ведёт подсчёт FPS и выводит его в заголовке. На процессоре Pentium 1.7 GHz мне удалось выжать из программы скорость 110 FPS, однако такое случилось только один раз, когда я под WinXP выгрузил из памяти все ненужные службы. В обычном же режиме скорость составляла около 50, если на форму был наведён курсор мыши и 62, если курсор был убран с экрана. Можно сказать, что модель не обладает таким уж высоким быстродействием, как модели Quake MD3, однако это отражается и на объёме файла модели. Кроме того, программа имеет один серьёзный недостаток. При запуске таймера нажатием на форму FPS равна 0, поэтому иногда человек начинает с феноменальной скоростью махать ружьем и ногами, но это продолжается лишь секунду.
Дальше я скажу о том, как создать такого человека с помощью поставляемого комплекта. Во-первых, я буду использовать 3DStudioMax. Если у Вас нет этой программы, то можете использовать заранее экспортированный файл сетки ManArmed.eye. Запустим программу EditMdl.exe. Выберете в открывшемся окне фильтр файлы *.eye и откройте файл ManArmed.eye. В следующем окне введите рост Вашего персонажа. Я выбрал 1.8 (или 2? - забыл). Наконец, в следующем окне выберете файл текстуры g2.bmp. Затем, если в открывшемся окне редактора выбрать вид Перспективы, перед нами предстаёт грозного вида мужчина с опасной игрушкой. ()
Теперь необходимо создать вершины скелета. Для данной модели это удобнее всего делать в проекции Left. Замечу, что заполнение полей x, y, z производится следующим образом. Когда курсор стоит в окне x, то при щелчке мышью на окне проекции заполняются все поля. Если курсор стоит в окне y, то заполнятся только y и z. Если курсор установлен в окно z, то только это окно и заполняется. Однако, не забывайте, что в проекции Left создаваемой точке будет присваиваться координата x=0. Координаты указателя в пространстве можно видеть в верхней полосе дисплея. Далее необходимо создать кости. Для выбора точки скелета в качестве начала или конца создаваемой кости, достаточно выделить точку с помощью мыши. Аналогично выбираются вершины сетки. Помните, что при выделении с вершинами будет проделана та операция, которая выбрана в окне опций.
После того, как скелет создан, в проекции Left вы можете увидеть нечто похожее на это:
Самое время сохранить изменения. Обратите внимание, что программа сохраняет изменения в файл формата sks. Это связано с тем, что этот файл не является текстовым экспортированным файлом, и не является ещё файлом модели. Теперь нажмите кнопку Части Тела и распределите кости между двумя частями тела: UpperBody и LowerBody. Конечно, можно было создать и голову, но зачем? Ведь наш персонаж не имеет рта и не умеет разговаривать. Можно перейти в другой режим, нажав кнопку Animate. При этом необходимо ввести имя создаваемой модели. Это необходимо, если мы захотим, чтобы нашей моделью затем управлял составленный на языке VBScript сценарий. Нажав на ОК, Вы попадёте в режим анимации.
Думаю, этот режим достаточно прост для понимания. Нужно выбрать часть тела и добавить движения. После того, как указана длительность, действия программы похожи на действия 3DStudioMax, поэтому дальнейший процесс не описывается. Полученный мною результат хранится в файле 1.yem, и Вы можете сразу же загрузить его с помощью тестовой программы.
Редактор содержит так же множество недостатков. Один из них - это то, что окна редактора всегда прячутся под другие открытые окна. Если Вы, открыв редактор и выбрав в первом окне файл модели, не обнаружили заметной реакции программы, нужно с помощью Alt+Tab переключиться на значок Кусок Мяса И Кость. Другой недостаток - это то, что иногда окна прячутся под вид, отображаемый OpenGL.
Текст программы EditMdl я не привожу по нескольким причинам. Эта диалоговая программа не имеет никаких сложных алгоритмов, кроме алгоритма костных деформаций, зато содержит массу однообразного текста программы, который совершенно не интересен. Кроме того, хочу оставить при себе алгоритмы и методы работы этой программы.
Использованная литература.
Использованные материалы.
document.write('');
Архив новостей
2 Август, 17:53 (19)
2 Август, 17:51 (34)
2 Август, 15:40 (42)
2 Август, 15:35 (1)
2 Август, 14:54 (3)
2 Август, 14:34 (3)
2 Август, 14:15 (2)
2 Август, 13:34 (7)
2 Август, 13:04 (3)
2 Август, 12:28
Море работы для программистов, сисадминов, вебмастеров.
Иди и выбирай!
|
|
| IT-консалтинг | Software Engineering | Программирование | СУБД | Безопасность | Internet | Сети | Операционные системы | Hardware |
| PR-акции, размещение рекламы — , тел. +7 495 6608306, ICQ 232284597 | Пресс-релизы — |
|
|
|
| This Web server launched on February 24, 1997 Copyright © 1997-2000 CIT, © 2001-2009 |
|
|
| Внимание! Любой из материалов, опубликованных на этом сервере, не может быть воспроизведен в какой бы то ни было форме и какими бы то ни было средствами без письменного разрешения владельцев авторских прав. |
|
Элитные от интернет-магазина, проверенным временем. |
Эксперимент
Мой эксперимент заключается в следующем. Создать 3d-движок с нуля. Это значит, что нужно, ни на что не опираясь, ввести формат тел, формат анимации, комплекс процедур для реализации в движке методов аналитической геометрии и физики. И, двигаясь по порядку, я начинаю с создания формата моделейПринцип костной деформации
Тот, кто работает в программе 3dStudioMax, отлично знает, что это такое. Для начала создаётся сетка - множество точек в пространстве и треугольники, вершинами которых являются эти точки. Затем создаются кости. Каждая кость имеет начальную точку и конечную точку. Затем, выражаясь языком MAX, применив модификатор Skin, мы привязываем к каждой кости определённое множество вершин сетки, и, после этого, при движении скелетных костей вместе с ними двигаются и привязанные к ним точки, поворачиваясь вокруг точек начал костей.Теперь скажу о том, как принцип костной деформации будет реализован в моём алгоритме. В пространстве будут определены точки. Затем эти точки будут соединены костями. Для каждой кости будут определены начало, конец и привязанные вершины. Итак, следуют следующие определения: //Определение костей SkPoint=record //Точка имеет три координаты в пространстве x, y, z:double; end; PSkPointArray=^TSkPointArray; TSkPointArray=array[word] of SkPoint; PVertArray=^TVertArray; //Список привязанных вершин определим как множество //индексов этих точек TVertArray=array[word] of word; SkBone=record //Начало и конец кости - индексы точек скелета StartPoint:word; EndPoint:word; //Количество вершин сетки, привязанных к кости numVertices:word; //Массив индексов этих вершин VertArray:PVertArray; end; PSkBoneArray=^TSkBoneArray; TSkBoneArray=array[word] of SkBone; //Определение сетки TVertex=record x, y, z:single; end; PVertexArray=^TVertexArray; TVertexArray=array[word] of TVertex; TFace=array[0..2] of word; PFaceArray=^TFaceArray; TFaceArray=array[word] of TFace; //Эта запись определяет угол поворота кости и //привязанных точек в соответствующей плоскости TBoneState=record AngleYOZ, AngleXOZ, AngleXOY:single; end; PBoneStateArray=^TBoneStateArray; TBoneStateArray=array[word] of TBoneState;
Теперь определим основную структуру для сетки со скелетом. Она должна содержать массив вершин, массив полигонов, массив вершин текстуры, массив полигонов текстуры, массив точек скелета, массив костей, а так же временный массив для хранения координат вершин после деформации. SkinnedMesh=record //Количество вершин сетки VertexCount:word; //Количество полигонов FacesCount:word; //Количество вершин на текстурной карте TexVertexCount:word; //Массив вершин сетки Vertices:PVertexArray; //Массив треугольников сетки Faces:PFaceArray; //Массив вершин на текстурной карте TexVertices:PVertexArray; //Массив треугольников на текстурной карте TexFaces:PFaceArray; //Количество точек скелета PointCount:word; //Массив точек скелета Points:PSkPointArray; BoneCount:word; //Количество костей Bones:PSkBoneArray; //Массив костей Empty:single; //Не используется //Массив для хранения DeformationBoneState:PBoneStateArray; //углов поворота костей DeformatedVertices:PVertexArray; //Массив для хранения //координат вершин деформированной сетки end;
После того, как мы получим сетку и скелет, можно приступить к описанию самих структур движений. Весь скелет мы поделим на части тела. Так можно будет экономичнее записать модель. Тогда можно будет, например, заставить торс и ноги персонажа выполнять разные действия. К примеру, человеческую модель можно разделить на то, что ниже пояса, выше пояса и голову. Каждая часть дела может выполнять различное количество действий. Каждое действие задаётся изменением положения костей.
Каждое действие может иметь некоторое количество ключевых положений, а если требуется отобразить промежуточное положение, то его можно вычислить для каждой кости отдельно, используя положения костей в ближайших ключевых положениях. Каждое ключевое положение содержит массив углов поворота костей, массив индексов костей, смысл которого заключается в следующем.
Допустим, что имеются кости 0, 1, 2, 3, 4. Из них кости 0, 1, 3 принадлежит части тела Upper_body, оставшиеся - Lower_body. Тогда массив индексов костей в ключевом движении Upper_body будет содержать (0, 1, 3), а Lower_body - (2,4). Итак, далее следует новые определения. PWordArray=^TWordArray; //Ключевое положение части тела BodyPartKeyFrame=record BoneCount:word; //Массив положений костей в данный ключевой кадр BoneState:PBoneStateArray; //Массив индексов костей BoneIndexes:PWordArray; //Момент времени, которому соответствует //данный ключевой кадр KFTimer:integer; end; PBodyPartAction=^TBodyPartAction; //Действие, выполняемое одной из частей тела TBodyPartAction=record //Продолжительность этого действия Duration:integer; //Количество ключевых кадров в действии KeyFrameCount:word; //Множество ключевых кадров KeyFrames:array[byte] of BodyPartKeyFrame; end; //Основной класс модели TModel=class Body:SkinnedMesh; //Сетка и скелет модели //Данные для анимации модели BodyParts:array[byte] of array[byte] of PBodypartAction; //Количество частей тела numBodyParts:byte; //Массив, содержащий количество движений //каждой части тела numActions:array[byte] of byte; //Имя модели ModelName:ShortString; //Текущие действия, выполняемые разными частями тела CurrentActions:array[byte] of byte; //Момент действия каждой части тела Timers:array[byte] of word; //Процедура осуществляет загрузку модели из файла Procedure LoadFromFile(filename:string); //Функция возвращает время, оставшееся до того, //как одна из частей тела //закончит выполнять текущее действие Function TimeLeft:word; //Записать углы поворота каждой кости в массив //DeformationBoneState из Body Procedure PresetRotateAngles(DeltaTimer:word); //Нарисовать модель Procedure DrawModel(x1, y1, x2, y2:single); overload; //Нарисовать модель, используя маску текстуры Procedure DrawModel(x1, y1, x2, y2, mx1, my1, mx2, my2:single); overload; //Процедура осуществляет стирание из памяти //всех данных и удаление класса Destructor Destroy; override; end;
Теперь пришло время написать тексты программ для каждой из процедур, однако я ещё ничего не сказал об одной важной вещи.
Улучшение вспомогательных окон среды Delphi
Владимир Коднянко,В практике программирования в среде часто приходится пользоваться вспомогательными окнами, в которых необходимо вывести сообщение - однострочное или многострочное или задать вопрос (также однострочный или многострочный) с тем, чтобы получить от пользователя программы ответ, который необходим для разрешения какой-либо ситуации. Задача эта простая и даже для малоопытного программиста не представляет особых затруднений: можно использовать процедуру ShowMessage, функцию MessageDlgPos стандартного модуля Dialogs.pas или подобные им подпрограммы. Однако есть несколько "но":
Прежде нужно создать новый unit или добавить низлежащий код в уже имеющийся подходящий unit и объявить несколько переменных, которые потребуются для автоматической русификации надписей. Их лучше разместить в секции implementation выше текстов приведенных ниже подпрограмм.
var // кнопки ButtonEngCaptions: array[1..11] of string = ('Yes', 'No', 'OK', 'Cancel', 'Abort', 'Retry', 'Ignore', 'All', 'NoToAll','YesToAll', 'Help'); ButtonRusCaptions: array[1..11] of string = ('Да', 'Нет', 'OK', 'Отмена', 'Прервать','Повтор', 'Пропуск', 'Все', 'Нет Всем','Да Всем', 'Помощь'); // заголовки окон MsgEngCaptions: array[1..4] of string = ('Confirm', 'Information', 'Warning', 'Error'); MsgRusCaptions: array[1..4] of string = ('Подтвердите', 'Сообщение','Предупреждение','Ошибка');
Далее возьмем стандартную функцию MessageDlgPosHelp модуля Dialogs.pas и коррекцией ее кода создадим новую функцию KdnMessageDlg (текст функции снабжен необходимыми комментариями):
function KdnMessageDlg(MsgVariant: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): Integer; var w1,w2,h1,h2,t2,L2,cx,cy: Integer; ScreenActFormVisBoo: boolean; i,j: Integer; F: TForm; Msg,s: ^String; begin New(Msg); New(s); Msg^:= MsgVariant; // конвертируем Variant в строку F:= CreateMessageDialog(Msg^,DlgType,Buttons); with F do try w1:=0; w2:=0; h1:= 0; // рабочие переменные // русифицируем надпись на шапке F-формы for i:= 1 to 4 do if Caption = MsgEngCaptions[i] then Caption:= MsgRusCaptions[i]; // изменяем положение элементов формы и русифицируем кнопки for i:= 0 to F.ComponentCount-1 do begin // приподнимаем рисунок if F.Components[i] is TImage then With F.Components[i] as TImage do Top:= Top-4; // позиционируем метку относительно рисунка // в зависимости от числа строк if F.Components[i] is TLabel then With F.Components[i] as TLabel do begin w1:=1; // вычислим число строк в метке if Length(Caption)>2 then for j:= 1 to Length(Caption)-2 do if Copy(Caption,j,2) = #13#10 then Inc(w1); if w1=1 then Top:= Top+2 else if w1=2 then Top:= Top-2 else Top:= Top-4; w2:= Top+height; // положение нижней части метки end; // русифицируем надписи на кнопках и позиционирум кнопки // в зависимости от числа строк метки if F.Components[i] is TButton then With F.Components[i] as TButton do begin s^:= Caption; // приведем надпись к виду ButtonEngCaptions Delete(s^,Pos('&',s^),1); s^:= AnsiUpperCase(DelSymbAll(s^,' ')); for j:=1 to 11 do // поиск надписи if s^ = AnsiUpperCase(ButtonEngCaptions[j]) then Caption:= ButtonRusCaptions[j]; // русификация if w1=1 then Top:= w2+20 else // позиционирование if w1=2 then Top:= w2+12 else Top:= w2+10; h1:= Top+height; // положение нижней части кнопок end; end; // for i height:= h1+42; // подбираем подходящую высоту формы // вычисляем положение F-формы // 1. определяем центр активной формы cx:= -1; cy:= -1; // координаты центра активной формы ScreenActFormVisBoo:= false; // наличие и видимость активной формы if Screen.ActiveForm <> Nil then if Screen.ActiveForm.Visible then begin w2:= Screen.ActiveForm.width; h2:= Screen.ActiveForm.height; t2:= Screen.ActiveForm.Top; L2:= Screen.ActiveForm.Left; cx:= L2 + w2 div 2; // координаты центра активной формы cy:= t2 + h2 div 2; ScreenActFormVisBoo:= true; end; // 2. определяем координаты левого верхнего угла F-формы w1:= width; h1:= height; // параметры F-окна if ScreenActFormVisBoo then // активная форма видима begin w2:= Screen.width; // размеры экрана h2:= Screen.height; Top:= cy - h1 div 2; // F.Top Left:= cx - w1 div 2; // F.Left // F-окно должо быть полностью в экране if Top<0 then Top:=0 else if Top>h2-h1 then Top:= h2-h1; Left:= cx - w1 div 2; if Left<0 then Left:=0 else if Left>w2-w1 then Left:= w2-w1; end else Position:= poScreenCenter; // активной формы нет или невидима Result:= ShowModal; finally // освобождаем память Dispose(Msg); Dispose(s); F.Free; Application.ProcessMessages; // убираем следы F-окна end; end;
где функция DelSymbAll имеет код
function DelSymbAll(s: String; Ch: Char): String; // удаляет символ везде var i: Integer; begin i:= pos(Ch,s); while i>0 do begin Delete(s,i,1); i:= pos(Ch,s); end; Result:= s; end;
Теперь всякое окно, построенное на основе функции KdnMessageDlg, будет иметь с активной формой общий центр, за исключением тех случаев, когда центрирование увело бы любую часть F-окна за пределы экрана (F-окно будет всегда находиться полностью в экране), все надписи русифицированы, метка "правильно" позиционирована относительно рисунка.
Несколько примеров обращения к процедуре:
KdnMessage(24); // числовой целочисленный тип аргумента KdnMessage(-224.89); // числовой вещественный тип аргумента KdnMessage('Это строка'); // строковый тип KdnMessage(Now); // тип TDateTime KdnMessage(Tim); // тип TTime KdnMessage(Dat); // тип TDate
В последнем случае активное окно и нависающее над ним окно сообщения будут выглядеть так (центры активной формы и окна сообщения совпадают):
где функция DinVarArrToStrs имеет код:
function DinVarArrToStrs(a: array of Variant): Variant; // конвертация Variant-массива в многострочный Variant var s: array of String; i: byte; begin SetLength(s,2); s[0]:=''; if Length(a)>0 then begin s[0]:= a[0]; if Length(a)>1 then for i:= 1 to Length(a)-1 do begin s[1]:= a[i]; s[0]:= s[0]+''#13#10''+s[1]; end; end; Result:= s[0]; s:= Nil; end;
Пример обращения к процедуре:
KdnMessageV([1355,-15.87,Now,DateOf(Now),TimeOf(Now)]);
и окно, отображающее результат обращения:
и соответствующее многострочное окно
function KdnYesNoV(Question: array of Variant): boolean; // многострочный вопрос begin Result:= KdnYesNo(DinVarArrToStrs(Question)); end;
Примеры обращения к функциям:
if KdnYesNo('Удалить рисунок ?') then DeleteFile(ImFile); if not KdnYesNoV(['Вы действительно желаете', 'удалить непустую папку', ExeDir,'?']) then exit;
Соответствующие окна показаны ниже.
Точно также можно создать окна с тремя кнопками:function KdnYesNoCancel(Question: Variant): byte; // однострочное окно с тремя кнопками var r: Integer; begin r:= KdnMessageDlg(Question,mtConfirmation, [mbYes,mbNo,mbCancel]); Result:= 3; // на случай выхода вне кнопок if r = mrYes then Result:= 1 else if r = mrNo then Result:= 2; end; function KdnYesNoCancelV(Question: array of Variant): byte; // многострочное окно с тремя кнопками begin Result:= KdnYesNoCancel(DinVarArrToStrs(Question)); end;
Ограничимся примером обращения к последней функции
if KdnYesNoCancelV(['Вы действительно желаете', 'удалить непустую папку', ExeDir,'?']) = 1 then if KdnYesNo('Подтвердите') then DeleteFolder(ExeDir);
Первое окно, которое появится в результате исполнения этого кода, имеет вид:
Аналогично на основе функции KdnMessageDlg могут быть без труда созданы другие подобные процедуры и функции.В статье предложен код, который
Владимир Коднянко,В статье предложен код, который позволяет решить несколько вопросов, связанных с улучшением стандартных окон Delphi и надписей на них, русификацией надписей. Одним из важных свойств окон является позиционирование их над центром активной формы приложения.
Несколько слов об обсуждении названной статьи. Нельзя сказать, что оно было продуктивным. Главным образом, обсуждающие демонстрировали свою просвещенность, не вдаваясь особенно в суть предлагаемых решений. И все же один из принявших участие в обсуждении под псевдонимом Gemini высказал интересную мысль о том, что код, изложенный в статье, может быть с успехом использован не только для русификации, но и, вообще, для быстрой иной "национализации" надписей окна окна (такой мысли у меня даже не было).
Теперь к теме настоящей статьи. Как показала практика, центрирование окон относительно активной формы не всегда удобно. Например, если активная форма мала или вблизи ее центра расположены данные, которые необходимо видеть, но вспомогательное окно заслоняет их, что при многократном его появлении требует всякий раз перемещения его в сторону, то в таких ситуациях предложенный способ вывода окна следует признать неудачным.
Возможным средством устранения этого недостатка можно считать способ, когда смещенное от центра активной формы вспомогательное окно при следующем вызове появится в том месте, куда его сместили при предыдущем вызове.
Эта задача решается посредством незначительной модернизации описанного в упомянутой статье кода. Возможный вариант такой модернизации приведен ниже.
В секции interface опишем глобальную переменную
// по умолчанию - старый способ var KdnMessageDlgByLastPosition: boolean = false;
Для фиксации местоположения окна в момент его закрытия введем две переменные KdnMessageDlgLeft, KdnMessageDlgTop, определяющие координаты верхнего левого угла окна. Их описание лучше разместить в секции implementation там, где описаны массивы кнопок:
var // координаты верхнего левого угла окна на случай // вывода окна в том месте, // где оно было закрыто в предыдущее появление KdnMessageDlgLeft: Integer = -1; KdnMessageDlgTop : Integer = -1; // кнопки ButtonEngCaptions: array[1..11] of string = ('Yes', 'No', 'OK', 'Cancel', 'Abort', ...
В тело функции KdnMessageDlg добавим необходимый код. Текст функции в сокращенном виде приведен ниже.
function KdnMessageDlg(MsgVariant: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): Integer; ... cx:= L2+w2 div 2; // координаты центра активной формы cy:= t2+h2 div 2; ScreenActFormVisBoo:= true; end; if KdnMessageDlgByLastPosition and not ((KdnMessageDlgLeft = -1) and (KdnMessageDlgTop = -1)) then begin F.Left:= KdnMessageDlgLeft; F.Top:= KdnMessageDlgTop; end else begin w1:= Width; h1:= Height; // параметры F-окна ... end else Position:= poScreenCenter; end; Result:= ShowModal; finally Dispose(Msg); Dispose(s); KdnMessageDlgLeft:= F.Left; // запоминаем координаты угла KdnMessageDlgTop:= F.Top; F.Free; Application.ProcessMessages; end; end;
Больше ничего менять не нужно.
Чтобы окна появлялось там, где их закрыли при предыдущем вызове, нужно прежде один раз выполнить оператор
KdnMessageDlgByLastPosition:= true; Теперь функции KdnMessage, KdnMessageV и прочие потомки KdnMessageDlg будут "работать" по-новому. Если нужно, чтобы после этого все окна стали "работать" по-старому (позиционирование над центром активной формы), следует один раз выполнить оператор
KdnMessageDlgByLastPosition:= false;
Можно вообще ни разу не выполнять ни один из этих операторов. Тогда окна будут "работать" по-старому. Замечу, что модернизированный код предоставляет пользователю приложений, использующих этот код, более широкие возможности, отличается очевидной гибкостью. Если кто-либо из программистов посчитал целесообразным использовать описанный в предыдущей статье код, то можно порекомендовать модернизировать его вышеописанным либо аналогичным способом. Быть может, модернизированный код следует считать основным (по умолчанию). Не исключено также, что этот код может быть признан кем-либо безальтернативным, что позволит убрать переменную KdnMessageDlgByLastPosition и не заботиться о ее значении при разработке приложения.
В заключение приведу рисунок, который иллюстрирует описанную ниже ситуацию.
На рисунке, представляющем небольшой фрагмент активной формы, изображена ситуация, когда пользователь под контролем со стороны программы многократно добавляет новые записи в таблицу базы данных при помощи нажатия кнопки (она расположена слева от нависшего над активной формой вспомогательного окна). При этом программа после каждого нажатия кнопки посредством вспомогательного окна задает вопрос о необходимости вставки записи. На форме находится 9 таблиц и она занимает всю площадь экрана. Используемая в данный момент таблица находится в самом низу активной формы. Если использовать старый метод вызова окна подтверждения, то в такой ситуации всякий раз пришлось бы "тянуться" мышью к центру активной форму, где появлялось бы окно подтверждения, что, с одной стороны, замедлило бы работу, а с другой стороны, способствовало бы постоянному отвлечению внимания от того участка экрана, на котором как раз и нужно сосредоточить внимание. В модернизированном варианте окно подтверждения теперь можно перетащить ближе к кнопке, как показано на рисунке, и за счет этого, во-первых, укорить работу по вводу данных и, во-вторых, сосредоточить внимание пользователя на ограниченном участке экрана, несколько повысив тем самым производительность и уровень комфортности работы.Обход дерева каталогов с прерыванием и возобновлением или "Куда мы идем завтра?"
Паша Звягинцев,Программист,
просыпаясь утром с сильнейшего похмелья,
начинает с тестирования памяти...
Недавно занимаясь интересной задачкой по написанию службы индексации, столкнулся с интересным вопросом: " А как бы нам поиск заморозить и продолжить после (через минуту, завтра, через месяц)?". Да конечно можно сказать - что у тебя за машина такая, вот у меня дерево каталогов обходит за 3 минуты... Согласен, это не вопрос. Но когда нужно не просто обходить, а еще и выполнять некоторые действия с файлами, да если их на диске 150 тыс. и больше, да еще не загружая процессор на 100%, то время может затянуться до нескольких суток, вот тогда - как быть?
Вот этой теме я и решил посвятить статью. Как оказалось, в Интернете информации по этой теме нет. Либо это слишком просто, либо никому не нужно. Как выяснилось - ни то ни другое.
Со стандартной процедурой обхода дерева сталкивались очень многие
procedure FileFind(path:string); var sr:Tsearchrec;// Описываем структуру, которую // использует для поиска система found:integer; // найдено или нет begin found:=FindFirst(path + '\*.*', FaAnyfile, sr); {по команде FindFirst программа создает структуру следующего типа TsearchRec = record Time: Integer; // время создания Size: Integer; // его размер Attr: Integer;// атрибуты Name:TFileName // = TString; собственно имя файла ExcludeAttr: Integer; найденные атрибуты FindHandle: THandle; // !!! указатель на структуру //поиска, которую создает система, а не наша программа. //Вот для чего обязательно в конце поиска //указывать FindClose - это высвобождает память FindData: TWin32FindData; // собственно эта структура end;} while (found = 0) do // если хоть что-то найдено begin if (sr.name <> '.') and (sr.name <> '..') then begin // если это не указатели на корневые каталоги, // то что-то нашли if (sr.attr and FaDirectory) = FaDirectory then // ага вот поддиректория - вызываем себя рекурсивно, // но с поиском уже // в этой директории FileFind(path+'\'+sr.name) else begin // вот тут выполняем чтото с найденным файлом //...... mainform.memo1.lines.append(path+'\'+sr.name); end end; found:=findnext(sr); // есть ли еще файлы или каталоги end; FindClose(sr); // поиск закончен - нужно освободить память end;
Казалось бы сохранить состояние процедуры поиска просто - достаточно сохранить структуру - sr:TsearchRec, а потом ее восстановить и поиск продолжится.
Первое Однако при даже невнимательном рассмотрении процедуры видно, что она вызывает сама себя - налицо обычная рекурсия. Получается что надо сохранять не одну SearchRec, а несколько. Полдела - сохранить, но ведь нужно и восстановить эти рекурсивные вызовы. Т.е при продолжении поиска построить этакую матрешку из процедур поиска, а потом уже его продолжать. Второе — сама SearchRec. Казалось бы она находится в области данных нашей программы. Да это наполовину верно. Верхняя половина SearchRec действительно лежит в области данных нашей программы и делать мы с ней можем что душе угодно. Это переменные Time: Integer; Size: Integer; Attr: Integer; Name:TFileName; ExcludeAttr: Integer;. А вот вторая ее половина (FindHandle: THandle; FindData: TWin32FindData;) нам не принадлежит -ее генерирует система по нашему запросу FindFirst(.....) и уничтожает по команде FindClose(....). Третий, казалось бы, простой вопрос — SearchRec.Name имеет тип TFileName=TString. Какую длину он имеет? Одни скажут 255, другие 65535. Согласен, и то и другое верно, но не тут. Длина действительно 255. А вот с типом нас нагло обманули. Реально в памяти хранится не TString [255], а PChar {Имя файла}+PChar{его расширение}. Для нас с вами это преобразуется в обычную строку при обращении, и до столкновения с данной ситуацией я свято верил что там TString[255].Кстати в чем разница между Богом и билом гейтсом? Бог не считает себя билом гейтсом ... И так попробуем решить эти проблемы. Проше всего разбор начать в обратном порядке... (не подумайте превратно, я знаю через что рвут гланды в России...)
Третий вопрос - как сохранить , а потом восстановить SearchRec, если он состоит непонятно из чего. А давайте сделаем свой SearchRec, как нам нужно. А именно так
type // этот тип почти полностью переписывается // со стандартного TSearchRec TMysearchRec = record Time: Integer; Size: Integer; Attr: Integer; Name: string[250];//вот тут обрабатывалось неверно при типе TString, как длина ? ExcludeAttr: Integer; FindHandle: THandle; // в принципе не нужен, но // не будем сильно пугать читателей // сильными отличиями, да и бог // с ними - с восемью байтами FindData: TWin32FindData; end;
но нам еще требуется сохранять несколько переменных самой программы, а именно Found - найдено чтото или нет и Path - с каким параметром нас вызывали, поэтому на основе этого типа делаем еще один
TMyRec_Sea = record Rec_Sea:TMySearchRec; // наша структура поиска path:String[250]; // откуда начинали found:integer; // при остановке нашли чтото или нет end;
Второй вопрос после первого решается не очень красиво, но довольно легко. Да система генерит структуру: FindHandle: THandle; FindData: TWin32FindData. FindData - собственно сама структура и FindHandle - указатель на нее. Пусть система генерит что угодно, если с умом, то можно обойти и это. Многие ли помнят такое INT21h->INT 13H. Думаю вспомнили. При восстановлении поиска дадим команду FindFirst, а потом подменим FindData и остальные поля, не трогая FindHandle, иначе сразу после окончания поиска (!!! ???) получим обращение к недопустимому адресу и вылет программы.
...... // создаем запись для поиска FindFirst(path+'\'+mask, FaAnyfile, sr); delfile:=false; found:=buffer.found; // загоняем в SEARCHREC все кроме FINDHANDLE // (он создается системой) sr.Time:=buffer.rec_sea.Time; sr.Size:=buffer.rec_sea.Size; sr.Attr:=buffer.rec_sea.Attr; sr.Name:=buffer.rec_sea.Name; sr.ExcludeAttr:=buffer.rec_sea.ExcludeAttr; sr.FindData:=buffer.rec_sea.FindData;
Первый вопрос - как же сохранять состояние процедуры при рекурсии?. Давайте сохранять SearchRec в файл и используем принцип магазина (не продуктового, а от автомата калашникова) - последний вошел - первый вышел. Вот примерная структура процедуры при выполняющемся поиске ( при нескольких рекурсивных вызовах)
Findfile('c:\') Findfile('c:\Docs') FindFile(c:\Docs\Delphi') ......
При получении сигнала на остановку процедуры начинают писать в файл в обратном порядке, а именно - FindFile(c:\Docs\Delphi'),Findfile('c:\Docs'),Findfile('c:\'). Примерно так
Findfile('c:\')------------------------------------+ Findfile('c:\Docs')---------------------+ ! FindFile(c:\Docs\Delphi') ---+ ! ! v v v [файл сохранений состояния] [rec1] [rec2] [rec3]
Ну а когда нужно восстановить состояние поиска смотрим не пустой ли файл сохранений, и читаем записи начиная с конца, после прочтения их удаляем. Таким образом поиск по дереву автоматом развернется на столько рекурсивных вызовов, сколько надо, и продолжит поиск.
Да, едва не забыл, как мы узнаем что надо приостановить поиск ? Давайте заведем глобальную переменную Process. Как она станет False - пора останавливаться
Ниже приведена часть модуля с использованием описанных алгоритмов
Unit unit1; ...... var .... process:boolean; // вот глобальная переменная // она и управляет поиском // true - можно // false - стоп с запоминанием состояния ..... procedure FileFind(path:string;resume:boolean); { сканирует диск (вернее дерево каталогов) при вызове PATH - начальный каталог для обхода RESUME - если TRUE - то продолжать сохраненный поиск (тогда значение PATH игнорируется, кроме случая, когда не обнаружен файл сохранения поиска) при установке глобальной переменной PROCESS в false останавливается с запоминанием предыдущего состояния, внимание - РЕКУРСИЯ !!! } const save_ext='.rec'; // в каталоге приложения //создает SAVE файл с именем //приложения и указанным расширением mask='*.*'; type TMysearchRec = record //пришлось написать свой тип SEARCHREC //с NAME фиксированной длины Time: Integer; Size: Integer; Attr: Integer; Name: string[250]; //вот тут обрабатывалось // неверно при типе TString, // как длина ? ExcludeAttr: Integer; FindHandle: THandle; FindData: TWin32FindData; end; TMyRec_Sea = record Rec_Sea:TMySearchRec; path:String[250]; found:integer; delfile:boolean; end; var sr:TSearchRec; RecFile:TFileStream; buffer:tMyRec_Sea; sp,save_file_name:string; found:integer; delfile:Boolean; delfile:Boolean; begin if resume then // возобновить поиск или начать новый begin save_file_name:=ChangeFileExt(ParamStr(0),save_ext); if FileExists(save_file_name) then begin RecFile:=TFileStream.Create(save_file_name, fmOpenReadWrite); // чистим буфер, не важно, необходимо для отладки fillchar(buffer,sizeof(buffer),#0); // читаем сохранение начиная с конца файла RecFile.Seek(-1*sizeof(buffer),soFromEnd); RecFile.Readbuffer(buffer,sizeof(buffer)); path:=buffer.path; sp:=path; // создаем запись для поиска FindFirst(path+'\'+mask, FaAnyfile, sr); delfile:=false; found:=buffer.found; // загоняем в SEARCHREC все кроме FINDHANDLE (он создается системой) sr.Time:=buffer.rec_sea.Time; sr.Size:=buffer.rec_sea.Size; sr.Attr:=buffer.rec_sea.Attr; sr.Name:=buffer.rec_sea.Name; sr.ExcludeAttr:=buffer.rec_sea.ExcludeAttr; sr.FindData:=buffer.rec_sea.FindData; // режем кусок уже прочитали свои данные - другим // они не понадобятся RecFile.Seek(-1*sizeof(buffer),soFromEnd); recfile.Size:=RecFile.Position; // дорезались - дозагружаться неоткуда if RecFile.Size=0 then delfile:=true; RecFile.Free; if delfile then sysutils.DeleteFile(save_file_name); end else // нет сохраненных поисков begin // начинаем новый sp:=path; resume:=false; // тут исправляется разница между C:\ и // C:\DOCS - убираем // последний слэш if sp[length(sp)]='\' then sp:=copy(sp,1,length(sp)-1); found:=FindFirst(sp + '\'+mask, FaAnyfile, sr); end end else begin // новый поиск - пристрелить старые записи save_file_name:=ChangeFileExt(ParamStr(0),save_ext); if fileExists(save_file_name) then sysutils.DeleteFile(save_file_name) ; sp:=path; if sp[length(sp)]='\' then sp:=copy(sp,1,length(sp)-1); found:=FindFirst(sp + '\'+mask, FaAnyfile, sr); end; // закончена подготовка - вперед поиск while (found = 0) and process do begin application.ProcessMessages; if (sr.name <> '.') and (sr.name <> '..') then begin if (sr.attr and FaDirectory) = FaDirectory then begin FileFind(sp+'\'+sr.name,resume); end else begin // ну тут разные действия с найденым файлом mainform.label1.caption:= ('начат разбор '+sp+'\'+sr.name) ; // ................ // закончили действия Application.ProcessMessages; // а вот без этого // мы никогда не узнаем что пора поиск закончить end; end; if process then found:=findnext(sr); end; if not process then // получили сигнал на остановку сканирования нужно запомнить состояние begin save_file_name:=ChangeFileExt(ParamStr(0),save_ext); if not FileExists(save_file_name) then RecFile:=TFileStream.Create(save_file_name,fmCreate) else RecFile:=TFileStream.Create(save_file_name, fmOpenReadWrite); RecFile.Seek(0,soFromEnd); // заполняем буфер текущим состоянием buffer.rec_sea.Time :=sr.Time; buffer.rec_sea.Size :=sr.Size ; buffer.rec_sea.Attr :=sr.Attr ; buffer.rec_sea.Name :=sr.Name ; buffer.rec_sea.ExcludeAttr :=sr.ExcludeAttr ; buffer.rec_sea.FindHandle :=sr.FindHandle ; buffer.rec_sea.FindData :=sr.FindData ; buffer.path:=sp; buffer.found:=found; RecFile.Writebuffer(buffer,sizeof(buffer)); RecFile.Free; end; Application.ProcessMessages; sysutils.FindClose(sr); end;
Delphi - сбориник статей
ADSI
После того как определились, что надо сделать (в данном случае это не составляет труда), встает вопрос о реализации. Первой мыслью было использовать технологию WMI, но после краткого исследования проблемы решено было остановиться на ADSI. Далее вольный перевод нескольких предложений из MSDN:ADSI - Active Directory Service Interfaces. Микрософт создала набор COM-интерфейсов, предназначенных для доступа к различным службам каталогов.
Служба каталогов - это распределенная система, которая предоставляет средства для поиска и использования сетевых ресурсов различных типов.
Объектная модель ADSI базируется на COM - объектах. Программа клиент управляет объектами через интерфейсы. Следующая таблица перечисляет фундаментальные элементы ADSI.
| Интерфейсы | Описание |
| IADs | Используется для идентификации объекта. Как фундаментальный интерфейс, поддерживаемый всеми ADSI объектами, позволяет получить доступ к метаданным объекта, включая описание объекта в схеме Active Directory . |
| IADsContainer | Используется для извлечения и управления объектом. Все ADSI объекта - контейнеры требуют использование этого интерфейса для доступа к объектам в контейнере и манипулирования ими. |
| IADsPropertyList | Используется для работы со свойствами объекта. |
Постановка задачи
На компьютерах с операционными системами Windows NT x.x при установке создается учетная запись локального администратора, которая имеет неограниченные права на данном компьютере. Если компьютер предполагается использовать в домене, то, как правило, технический персонал устанавливает один и тот же пароль для данной учетной записи. И как правило он не очень сложный. При наличии физического доступа к рабочей станции пароль администратора может быть легко подобран со всеми вытекающими отсюда последствиями. Задача администратора сети - установить достаточно сложный пароль для данной учетной записи и периодически его менять. Если в домене несколько десятков компьютеров, это может занять много времени. Если же в домене несколько сот компьютеров, а часто они еще и географически разнесены, то без автоматизации данного процесса не обойтись.Определимся, что должна делать программа - утилита. Т.е. составим простой алгоритм работы:
Реализация на Delphi.
Задача была реализована на Delphi6 sp2. В процессе работы оказалось, что необходимые функции не описаны в библиотеке. Далее в статье будут приведены описания всех необходимых функций.4.1 Извлечение имен компьютеров домена из AD.
Первым этапом попытаемся установить связь AD. Для этого воспользуемся функцией ADsGetObject. Описание из MSDN:
HRESULT ADsGetObject( LPWSTR lpszPathName, REFIID riid, VOID** ppObject); lpszPathName - строка связывания;
riid - идентификатор интерфейса;
ppObject - указатель на указатель интерфейса, возвращаемый функцией.
Эта функция эквивалентна функции GetObject из VB (в данном контексте).Она берет строку связывания и возвращает указатель на запрашиваемый интерфейс. Связывание производится в контексте защиты вызывающего потока, используя опции ADS_SECURE_AUTHENTICATION. Если требуется указать конкретного пользователя, необходимо использовать функцию ADsOpenObject (прошу прощения за корявый перевод).
Далее пример использования ADsGetObject для связывания с AD:
interface Uses :. , ActiveDs_TLB; : function ADsGetObject(lpszPathName: WideString; const riid: TGUID; out ppObject: Pointer): HRESULT; stdcall; implementation function ADsGetObject; external 'activeds.dll'; Procedure TForm1.Test Var hr: HResult; objDomain: Pointer; begin hr:= ADsGetObject('LDAP://ou=test, ou=mine, dc=mydomain, dc=com', IID_IADsContainer, objDomain); if Failed(hr) then Exit; end; Чтобы данный пример мог быть откомпилирован необходимо импортировать библиотеку типов Activeds.tlb, как показано на рисунке 2:
Рисунок 2
Замечание:
При работе с ADsGetObject бывали ситуации, когда при попытке прочитать какое-либо свойство полученного объекта выходила ошибка 'The directory property cannot be found in cache'. К сожалению, это было достаточно давно, и восстановить ситуацию не удалось. Тем не менее ошибка была. Обойти ее удалось при использовании функции ADsOpenObject . Вот пример использования данной функции:
interface Uses :. , ActiveDs_TLB; : function ADsOpenObject(lpszPathName: WideString; lpszUserName: WideString; lpszPassword: WideString; dwReserved: DWORD; const riid: TGUID; out ppObject: Pointer): HRESULT; stdcall; implementation function ADsOpenObject; external 'activeds.dll'; Procedure TForm1.Test Var hr: HResult; objDomain: Pointer; begin hr:= ADsOpenObject('LDAP://ou=test, ou=mine, dc=mydomain, dc=com', '', '', DS_SECURE_AUTHENTICATION, IID_IADsContainer, objDomain);} if Failed(hr) then Exit; end; Далее в статье будет использоваться только ADsGetObject.
В данных примерах мы пытаемся получить ссылку на интерфейс IID_IADsContainer.
IID_IADsContainer используют для получения коллекции ADSI объектов. Полный список интерфейсов, с которыми можно работать при помощи ADsGetObject, и их описание можно найти в MSDN.
После того, как мы получили ссылку на контейнер, осталось перебрать его объекты и считать их имена. Для этого нам понадобятся еще две функции - AdsBuildEnumerator и ADsEnumerateNext.
AdsBuildEnumerator- создает объект Enumerator (перечеслитель) для конкретного объекта контейнера ADSI.
function ADsBuildEnumerator(pADsContainerL: IADsContainer; ppEnumVariant: PIEnumVARIANT): HRESULT; stdcall; function ADsBuildEnumerator; external 'activeds.dll'; pADsContainerL - указатель на IADsContainer;
ppEnumVariant - указатель на указатель IEnumVariant интерфейс, который связывает создаваемый объект Enumerator с соответствующим объектом контейнером.
Интерфейс IEnumVARIANT описан в модуле ActiveX.
ADsEnumerateNext - позволяет перемещать указатель по элементам коллекции.
function ADsEnumerateNext(pEnumVariant: IEnumVARIANT; cElements: ULONG; pvar: POleVariant; pcElementsFetched: PULONG): HRESULT; stdcall; function ADsEnumerateNext; external 'activeds.dll'; pEnumVariant - получаем после вызова ADsBuildEnumerator;
cElements - количество элементов, которые мы хотим извлечь из коллекции за один раз;
pvar - указатель на массив, в который помещаются извлеченные из коллекции объекты;
pcElementsFetched - указатель на фактическое количество найденных элементов.
Далее, собственно, пример, демонстрирующий как получить список компьютеров домена из AD:
procedure TForm1.Button1Click(Sender: TObject); var objDomain: Pointer; objChild: Pointer; hr: HResult; s: String; i: Integer; iArr : OleVariant; iEnum: IEnumVARIANT; iFetch: ULONG; iAPath: String; begin ListBox1.Clear; hr:= ADsGetObject('LDAP://ou=test, ou=mine, dc=bogatyr, dc=kz', IID_IADsContainer, objDomain); if Failed(hr) then Exit; hr:=ADsBuildEnumerator(IADsContainer(objDomain), @iEnum); if Failed(hr) then Exit; hr := ADsEnumerateNext(iEnum, 1, @iArr, @iFetch); while (S_OK = hr) and (1 = iFetch) do begin hr:=IDispatch(iArr).QueryInterface(IADs,objChild); if Failed(hr) then Exit; if AnsiLowerCase(IAds(objChild).Class_)='computer' then begin s:=IAds(objChild).Name; System.Delete(s,1,3); ListBox1.Items.Add(s); end; if AnsiLowerCase(IAds(objChild).Class_)='organizationalunit' then begin Continue; { s:=IAds(objChild).Name; iAPath:=PAPAth; System.Delete(iAPath, 1, 7); iAPath:='LDAP:// '+s+','+iAPath; if not NextNode_Computer(iAPath) then exit;} end; if AnsiLowerCase(IAds(objChild).Class_)='container' then begin Continue; { s:=IAds(objChild).Name; iAPath:=PAPAth; System.Delete(iAPath, 1, 7); iAPath:='LDAP:// '+s+','+iAPath; if not NextNode_Computer(iAPath) then exit;} end; iArr:=null; hr := ADsEnumerateNext(iEnum, 1, @iArr, @iFetch); end; end; Часть кода в примере закомментирована. Код взят из рабочей программы и слегка исправлен. В закомментированных частях видно, что подпрограмма вызывается рекурсивно. Это было сделано что бы просканировать всю указанную ветку из AD, включая содержащиеся внутри ветки.
4.2 Смена пароля локального администратора.
Здесь все просто. Формируем строку связывание для доступа к объекту с именем "Администратор". Класс объекта - "user". Объект расположен на рабочей станции "Computer01".
iPath:='WinNT://'+NameWs+'/Администратор,user'; И, собственно, реализация.
procedure ChangePassword; var objUser: Pointer; hr: HResult; iPath: String; i: Integer; begin iPath:='WinNT://Computer01/Администратор,user'; hr:= ADsGetObject(iPath, IID_IADsUser, objUser); if hr<>S_OK then Exit; IADsUser(objUser).SetPassword('anykey'); end; 4.3 Обработка ошибок.
Если вызов ADSI функции завершился неудачей, функция вернет код ошибки стандартным для COM объектов способом. Коды ошибок делятся не четыре группы:
function ADsGetLastError(lpError: LPDWORD; lpErrorBuf: LPWSTR; dwErrorBufLen: DWORD; lpNameBuf: LPWSTR; dwNameBufLen: DWORD): HRESULT; stdcall; lpError - указатель на код ошибки;
lpErrorBuf - указатель на буфер, куда будет передано описание ошибки;
dwErrorBufLen - размер буфера;
lpNameBuf - указатель на буфер, куда будет передано имя провайдера, который возбудил эту ошибку;
dwNameBufLen - размер буфера;
Простой пример использования этой функции можно будет посмотреть в исходных кодах, прилагаемых к статье. Для получения наиболее полной информации о произошедших ошибках обратитесь к MSDN. В частности, по приведен пример функций (на Си), которые в качестве аргумента принимают код ошибки и возвращают ее описание. Осталось их (эти функции) перевести на Pascal и использовать.
Список литературы
VBS
Первая реализация задачи была сделана на VBS. И это понятно. Достаточно зайти на сайт Микрософт и скачать готовые скрипты. И немного их подправить под свои нужды. Кроме того, на VB код получается очень короткий и легкий для восприятия. Вот пример создания списка компьютеров из домена, расположенных в определенном organization unit в Active Directory (AD):Set objDictionary = CreateObject("Scripting.Dictionary") strDomain = "LDAP://ou=Test, ou=Mine, dc=mydomain, dc=com" Set objDomain = GetObject(strDomain) objDomain.Filter = Array("computer") i = 0 For Each objComputer In objDomain objDictionary.Add i, Mid(objComputer.Name,4) i = i + 1 Next
Рисунок 1
Для получения доступа к пространству имен каталога необходимо связаться с нужным объектом ADSI.
Set objDomain = GetObject(strDomain) strDomain - строка связывания.
Первая часть строки связывания определяет, к какой именно службе каталогов мы обращаемся.
Примеры обращения к различным службам
| "LDAP://" | Служба каталогов, созданная на основе протокола LDAP (Active Directory в том числе) |
| "WinNt://" | Служба каталогов в сети Windows NT 4.0 или на рабочей станции Windows XP/2000 |
В следующих таблицах приводятся примеры строк связывания:
LDAP
| LDAP: | Связь с корнем пространства имен LDAP |
| LDAP://server01 | Связь с конкретным сервером |
| LDAP://server01:390 | Связь с конкретным сервером через указанный порт |
| LDAP://CN=Jeff Smith,CN=users,DC=fabrikam,DC=com | Связь с конкретным объектом |
| LDAP://server01/CN=Jeff Smith,CN=users,DC=fabrikam,DC=com | Связь с конкретным объектом через указанный сервер |
| WinNT:// |
| WinNT:// |
| WinNT:// |
| WinNT:// |
| WinNT:// |
| WinNT:// |
| WinNT:// |
| WinNT:// |
objDomain.Filter = Array("computer") И затем перебираем элементы коллекции.
Главный минус данной реализации (на мой взгляд) - это низкая скорость работы. Для перебора ~150 рабочих станция и смены на них пароля понадобилось около часа времени.
Основные задержки приходятся на операцию связывания. Особенно большие таймауты при попытке связывания с выключенным или не существующим компьютером ( или если по какой-то причине отказано в доступе). Решением данной проблемы является организация многопоточности. Поэтому от VBS пришлось отказаться.
Создание графического интерфейса пользователя средствами Win32 API
, Королевство Дельфи09 июля 2003г. С появлением разнообразных визуальных средств разработки приложений, написание графических интерфейсов программ превратилось в подобие детской игры. Ткнул мышкой - появилась формочка, второй раз ткнул - кнопочка нарисовалась. Как мне кажется, многие сейчас не помышляют об ином способе программирования в графической среде. Безусловно, против прогресса не попрешь, при написании больших проектов все эти удобства очень даже кстати. Но разговор не об этом. Иногда дело доходит до абсурда, примитивное приложение пишется с использованием MFC, VCL etc. Такие программы жрут память, как термиты и занимают, своим жирным телом, лишнее дисковое пространство. Как правило, MFC/VCL аналоги "весят" в десять - двадцать раз больше, чем программы написанные на чистом API. А Visual Basic (да простит меня бог за это словосочетание) с его msvbvmXX.dll? Да и системных ресурсов расходуется значительно больше (в несколько раз). Бедные пользователи, отказывая себе в пиве, копят ассигнации на покупку нового железа. Разве не жалко - бедненьких? Не только же программерам пиво пить? Есть еще один положительный момент в API кодинге, программист становится ближе к операционной системе. Соответственно - лучше ее понимает и контролирует. Да и просто - это очень увлекательное занятие. Повторюсь, все вышесказанное относится именно к маленьким, простеньким программкам, в больших проектах все обстоит совершенно иначе.
Надеюсь, убедил. Поехали.
Мы рассмотрим создание простенького оконного интерфейса с минимальной функциональностью. Это будет простое окошко с двумя полями ввода и двумя кнопочками. При нажатии на кнопку "Copy", текст из первого поля ввода будет скопирован во второе. При нажатии на кнопку "Close", программа завершит свою работу. В дальнейшем оно может послужить шаблоном для написания других, более сложных, приложений. Будем общаться на языке C/C++, хотя и Delphi не обидим. Общий принцип один и тот же, различается только синтаксис. Чтобы работать с системными сообщениями и API-функциями, необходимо к своему проекту подключить заголовочные файлы; в C/C++ это windows.h, в Delphi это модули windows и messages.
Любая программа в ОС Windows состоит из трех основных частей: главной функции, цикла обработки сообщений и оконной функции, которая обрабатывает все сообщения, посылаемые окну.
Наша программа начинает выполняться с функции WinMain(). Это и есть главная функция. Функция WinMain() выполняет, обычно, следующие задачи:
В Delphi мы не увидим такой картины, в этой среде разработки главная функция скрывается от программиста компилятором. Хотя, несомненно, она присутствует в конечном коде. Для регистрации класса окна, необходимо заполнить поля структуры типа WNDCLASS (в Delphi TWNDCLASS). У нас, для этого, объявлена переменная wcl. wcl.hInstance = hInstance; Дескриптор текущего экземпляра приложения, переменная hInstance инициализируется функцией WinMain(). В Delphi инициализируется неявным образом. wcl.lpszClassName = szWinName; Имя класса. Строковую переменную szWinName мы создали и инициализировали предварительно. wcl.lpfnWndProc = WindowFunc; Указатель на оконную функцию. wcl.style = 0; Константа, задающая стиль окна. Для этого используется флаги CS_, я просто обнулил. Можно задавать комбинацию флагов с помощью битовой операции "или". wcl.hIcon = LoadIcon(NULL, IDI_ASTERISK); Дескриптор иконки приложения, возвращаемый функцией LoadIcon(). Я загрузил стандартную иконку. Смотри константы IDI_. wcl.hCursor = LoadCursor(NULL,IDC_ARROW); Дескриптор курсора приложения, возвращаемый функцией LoadCursor(). Я загрузил стандартную стрелочку. Смотри константы IDC_. wcl.lpszMenuName = NULL; Указатель на строку, задающую имя ресурса меню для данного оконного класса. Нет меню, нет и указателя. wcl.cbClsExtra = 0; Зарезервированное поле. Обнуляем. wcl.cbWndExtra = 0; Зарезервированное поле. Обнуляем. wcl.hbrBackground = (HBRUSH)COLOR_WINDOW; Цвет окошка. Константа COLOR_WINDOW приводится к типу HBRUSH (в Delphi приводить не нужно). Также, с помощью функции GetStockObject(), можно задать цвет кисти окна или фоновый рисунок. Теперь, смело, регистрируем класс окна. RegisterClass(&wcl); В качестве параметра функции RegisterClass передается указатель на структуру wcl.
Следующей строкой мы создаем наше окно.
| hMainWnd = CreateWindow(szWinName, "Простое окно на API.", WS_OVERLAPPEDWINDOW ^ WS_THICKFRAME ^ S_MAXIMIZEBOX, CW_USEDEFAULT, CW_USEDEFAULT, 300, 170, HWND_DESKTOP, NULL, hInstance, NULL); |
Дескриптор окна - уникальный номер в системе, по которому идентифицируется окно или элемент управления.
Далее мы создадим необходимые элементы управления. Все элементы управления - те же окна, просто они имеют другое имя класса. Классы элементов управления регистрировать не нужно, они уже предопределены в системе. Кнопка - класс button. Поле ввода - класс edit. Надпись - класс ststic. Существует множество классов, которые соответствуют стандартным элементам управления. Контролы создаем с помощью, знакомой нам, функции CreateWindow() и незнакомой CreateWindowEx(). CreateWindowEx() позволяет создать окно с расширенным стилем. Мы используем ее для создания полей ввода. В этой функции добавлен первый параметр, который и задает этот самый расширенный стиль, остальные параметры как у CreateWindow(). Элементы управления являются дочерними окнами, их владелец главное окно.
Создавая контролы, в параметрах функции необходимо указать дескриптор главного окна, а также стиль окна WS_CHILD. Внешним видом и функциональностью элементов управления можно манипулировать с помощью флагов: WS_, ES_, BS_, SS_, объединяя их битовой операцией "или". Создавая контролы, мы инициализируем соответствующие переменные их дескрипторами, которые возвращают функции CreateWindow() и CreateWindowEx(). Эти дескрипторы понадобятся нам для дальнейшей работы с элементами управления. Отображаем, созданное нами, окно на экране и перерисовываем его.
| ShowWindow(hMainWnd, nCmdShow); UpdateWindow(hMainWnd); Создаем цикл обработки сообщений. while(GetMessage(&msg, NULL, 0, 0)) { TranslateMessage(&msg); DispatchMessage(&msg); } |
Оконная функция обеспечивает функциональность программы, путем обработки системных сообщений. Оконная функция является CALLBACK - функцией, т.е. вызывается операционной системой в ответ на поступившее, новое сообщение. Оконная функция объявлена таким образом: LRESULT CALLBACK WindowFunc(HWND hMainWnd, UINT iMsg, WPARAM wParam, LPARAM lParam)
При появлении сообщения, мы можем сравнить параметр iMsg с одной из констант WM_ и запрограммировать соответствующую реакцию программы.
Например: при нажатии левой кнопки мыши, когда указатель мыши находится над клиентской областью окна, возникает событие WM_LBUTTONDOWN. Вызывается оконная функция, в параметр iMsg заносится значение константы WM_LBUTTONDOWN, мы можем проверить условие и запрограммировать нужную нам реакцию программы.
Внутри оконной функции расположен оператор выбора, который и выполняет вышеописанную задачу. В операторе выбора обязательно должен быть организован обработчик по умолчанию, который реализуется функцией DefWindowProc(hMainWnd, iMsg, wParam, lParam);
Если этого не сделать, наша программа издохнет так и не ожив. Множество сообщений, обрабатывается самой системой, такие как: изменение размеров окна, сворачивание/разворачивание окна, вызов системного меню etc. Для этого и служит DefWindowProc().
При работе с оконными элементами управления, окну владельцу посылается сообщение WM_COMMAND, при этом lParam содержит дескриптор элемента управления, а старший байт параметра wParam - идентификатор события, вызванного в элементе управления. Например: при нажатии на кнопку - BN_CLICKED. Смотри константы BN_, WM_. Закрыть прогу мы можем использовав функцию PostQuitMessage(0). Эта функция посылает окну сообщение WM_QUIT.
Несколько слов о том, как писать такие программы на Delphi. Создаем новый проект, запускаем Project Manager, удаляем Unit1 вместе с формой. Жмем Ctrl + F12 и открываем файл проекта. Удаляем из uses модуль forms, добавляем туда windows и messages. Удаляем все между begin и end. Заготовка готова. Можно кодить. Писать программы на чистом API невозможно без справки, которая всегда должна быть под рукой. Будь ты самим Гейтсом - все не запомнить. Рекомендую:
Удачи.
Скачать: (2.6 K)
архив содержит файлы windows.cpp и windows.dpr
Delphi - сбориник статей
Дельфийское слово
Антончук Сергей,Cамая прогрессивная часть человечества - программисты - вынуждены зачастую заниматься изобретением велосипеда. Почему это происходит? В большинстве случаев, реализуемый программистом алгоритм уже присутствует в компьютере пользователя, и даже неоднократно. Но воспользоваться им из новой программы нет возможности, или нет информации, как это делается. Речь пойдет о Delphi-Word.
Наглядный пример— MS Office. Зачем самому создавать систему генерации отчетов, деловых диаграмм или алгоритм линейной оптимизации. Все уже есть в MS Office, кроме того, есть механизмы использования всего этого богатства, называемые OLE Automation. Только в Help нужно заглянуть… И тут выступает проза жизни. Написать самому оказывается быстрее, чем найти в колоссальной по объему системе помощи нужную информацию. Кроме того, тут даже есть элемент комизма. Нужный вам раздел системы помощи при обычной установке, как правило, не инсталлируется. В общем, кладезь мудрости, засыпанный второстепенной информацией и к тому же, лежащий на дистрибутивном диске. А если очень хочется, или постановка задачи явно требует? Приведенный далее материал— попытка дать «быстрый старт» программисту, на которого взвалили такой выгодный заказ. Речь пойдет о «связке» Delphi-Word, однако, многое из ранее изложенного применимо ко многим другим приложениям Microsoft (Excel, Internet Explorer и т. д.), которые поддерживают OLE Automation.
Форматирование текста
varS: Selection;
...
S := Word.Selection;
{вывод фразы полужирным шрифтом}
S.Font.Bold := integer(True);
S.TypeText('Be bold!');
S.Font.Bold := integer(False);
S.TypeParagraph;
{прописным шрифтом}
S.Font.Italic := integer(True);
S.TypeText('Be daring!');
S.Font.Italic := integer(False);
Особых пояснений не требуется, единственно, что следует помнить о свойстве «Application.Options.ReplaceSelection», чтобы новый текст случайно не затер старый.
Как подключиться к загруженной копии Word
Для подключения к исполняемой копии Word можно использовать команду «GetActiveOleObject». Она возвращает переменную с именем «IDispatch», содержащую указатель на работающее приложение Word. После этого у него можно с помощью «QueryInterface» запросить указатель на объект «_Application». GetActiveOleObject генерирует исключение, если запрашиваемый объект не существует в Running Object Table (ROT). Поэтому вызов его необходимо делать внутри блока «try..except».uses Word_TLB;
procedure StartWord(var WordApp: _Application);
var
SaveChanges: OleVariant;
begin
try
GetActiveOleObject('Word.Application').QueryInterface(_Application, WordApp);
except
WordApp := nil;
end
if (UnAssigned(WordApp)) then
try
WordApp := CoApplication.Create;
WordApp.Visible := True;
except
if (Assigned(WordApp)) then begin
SaveChanges := wdDoNotSaveChanges;
WordApp.Quit(SaveChanges, EmptyParam, EmptyParam);
end;
end;
end;
Открытие существующего документа
В Word 97:var
FileName: OleVariant;
begin
FileName := 'C:\My Documents\Открываемый файл.doc';
Word.Documents.Open(FileName, EmptyParam, EmptyParam,
EmptyParam, EmptyParam, EmptyParam, EmptyParam,
EmptyParam, EmptyParam, EmptyParam);
Необязательные параметры задают следующие свойства:
ReadOnly (третий параметр, по умолчанию False);
PasswordDocument (пятый параметр);
Format (последний параметр дает возможность выбрать конвертор для файла).
В Word 2000 метод «Documents.Open» имеет два дополнительных параметра, для расшифровки и определения,— должен ли документ быть видимым на экране. Как и в случае с методом «Add» при использовании его в Word 97 вызывается исключение, поэтому для совместимости нужно использовать метод «Documents.OpenOld». Он имеет такие же параметры, как и метод «Open» из Word.
Открытие Word через OLE Automation
В библиотеке типов определен касс «CoApplication», который реализует интерфейс с Word-ом. Для создания из своей программы экземпляра Word необходимо вызвать метод «CoApplication.Create». Этот метод возвращает ссылку на интерфейс типа «_Application». Интерфейс «_Application» предоставляет интерфейс «Documents», в котором определены два метода доступа к документам: «Add» и «Open».Оба эти метода возвращают указатель на интерфейс «_Document». При вызове методам можно передавать параметры «OLEVariant». Многие параметры, передаваемые методам Word, являются необязательными (optional). Необязательные параметры, тем не менее, должны быть включены в обращения к методам, но могут быть определены как неинициализированные (Unassigned), чтобы указать, что они не используются. Для неиспользуемых параметров можно использовать переменную Delphi 4 называемую EmptyParam.
uses Word_TLB;
procedure StartWord(var WordApp: _Application; var WordDoc: _Document);
var
SaveChanges: OleVariant;
begin
try
WordApp := CoApplication.Create;
WordDoc := WordApp.Documents.Add(EmptyParam, EmptyParam);
WordApp.Visible := True;
except
if (Assigned(WordApp)) then begin
SaveChanges := wdDoNotSaveChanges;
WordApp.Quit(SaveChanges, EmptyParam, EmptyParam);
end;
end;
Переход к закладке по имени
varWhat : OLEVariant;
Name : OLEVariant;
begin
What := wdGoToBookmark;
Name := 'Имя закладки';
App.Selection.GoTo_(What, EmptyParam, EmptyParam, Name);
Очень полезный метод. Позволяет превратить Word в генератор писем или отчетов. В заготовке письма проставляем закладки, затем из программы переходим к ним и вставляем нужный текст, например из базы данных. Второй необязательный параметр— счетчик. С помощью него можно организовать переход не по имени, а по номеру закладки.
Получение информации из Word
Если кто-то не помнит — Word когда-то был текстовым процессором, поэтому из уважения к его истории в нем эти функции все еще присутствуют. Информацию из Word можно получить через интерфейс «IdataObject». Для получения указателя на этот интерфейс необходимо использовать функцию «QueryInterface».Документы Word поддерживают стандартные форматы CF_TEXT и CF_METAFILEPICT так же как ряд других специфических форматов, включая RTF и structured storage. Для стандартных форматов используются константы значений переменной «cfFormat», но для других форматов нужно делать запрос, используя функцию «EnumFormatEtc». Эта функция возвратит список обеспечиваемых форматов. Требуемый формат из этого списка затем передается функции «GetData» интерфейса «IDataObject». Значение cfFormat для одинаковых форматов может различаться на разных компьютерах, поэтому всегда должно находиться с помощью функции «EnumFormatEtc». Для подробной информации относительно методов интерфейса «IdataObject» можно обратиться к файлам помощи по программированию в Win32.
uses Word_TLB;
function GetRTFFormat(DataObject: IDataObject; var RTFFormat: TFormatEtc):
Boolean;
var
Formats: IEnumFORMATETC;
TempFormat: TFormatEtc;
cfRTF: LongWord;
Found: Boolean;
begin
try
OleCheck(DataObject.EnumFormatEtc(DATADIR_GET, Formats));
cfRTF := RegisterClipboardFormat('Rich Text Format');
Found := False;
while (not Found) and (Formats.Next(1, TempFormat, nil) = S_OK) do
if (TempFormat.cfFormat = cfRTF) then begin
RTFFormat := TempFormat;
Found := True;
end;
Result := Found;
except
Result := False;
end;
end;
procedure GetRTF(WordDoc: _Document);
var
DataObject: IDataObject;
RTFFormat: TFormatEtc;
ReturnData: TStgMedium;
Buffer: PChar;
begin
if (Assigned(WordDoc)) then try
WordDoc.QueryInterface(IDataObject, DataObject);
if GetRTFFormat(DataObject, RTFFormat) then begin
OleCheck(DataObject.GetData(RTFFormat, ReturnData));
//RTF is passed through global memory
Buffer := GlobalLock(ReturnData.hglobal);
//Buffer is a pointer to the RTF text
//Insert code here to handle the RTF text (ie. save it, display it etc.)
GlobalUnlock(ReturnData.hglobal);
end;
except
ShowMessage('Error while getting RTF');
end;
end;
Создание и доступ к таблицам
Создать таблицу можно следующим образом (проверялось в Word 97):var
Doc: _Document;
T: Table;
begin
Doc := Word.ActiveDocument;
T := Doc.Tables.Add(Word.Selection.Range, 5, 3);
T.Cell(1, 1).Range.Text := 'January';
T.Cell(1, 2).Range.Text := 'February';
T.Cell(1, 3).Range.Text := 'March';
T.Columns.Width := 72; // in points
Получение содержимого ячейки происходит так:
Caption := T.Cell(1, 3).Range.Text;
Учтите, что работа с таблицами в Word происходит очень медленно, а в Word 2000 чрезвычайно медленно. Поэтому, если в результирующем документе просто нужно быстро поместить таблицу, то можно, например, разместить текст, разделенный запятыми (или другим разделителем), а затем преобразовать его в таблицу. Сделать это можно так:
const
Line1 = 'January,February,March';
Line2 = '31,28,31';
Line3 = '31,59,90';
var
R: Range;
Direction, Separator, Format: OleVariant;
begin
Doc := Word.ActiveDocument;
R := Word.Selection.Range;
Direction := wdCollapseEnd;
R.Collapse(Direction);
R.InsertAfter(Line1);
R.InsertParagraphAfter;
R.InsertAfter(Line2);
R.InsertParagraphAfter;
R.InsertAfter(Line3);
R.InsertParagraphAfter;
Separator := ',';
Format := wdTableFormatGrid1;
R.ConvertToTable(Separator, EmptyParam, EmptyParam,
EmptyParam, Format, EmptyParam,
EmptyParam, EmptyParam, EmptyParam,
EmptyParam, EmptyParam, EmptyParam,
EmptyParam, EmptyParam);
Создание нового документа
В Word 97 на основании шаблона «Normal»:Word.Documents.Add(EmptyParam, EmptyParam);
Если Вы хотите, чтобы новый документ был основан на шаблоне отличном от «Normal», передайте имя (и путь) шаблона как первый параметр. Если необходимо открыть новый документ как шаблон, передайте «True» для второго параметра.
В Word 2000, метод «Documents.Add» имеет два дополнительных параметра, для типа документа и определения, должен ли документ быть видимым на экране. Внимание! Использование этого метода с Word 97 вызовет исключение. Если необходима совместимость с Word 97, можно использовать метод «Documents.AddOld» из библиотеки Word 2000. Он имеет такие же параметры, как и метод «Add» из Word 97.
Установка Delphi для работы с Word
Для того чтобы из Delphi можно было обращаться к методам и свойствам, предоставляемым Word (используя раннее связывание OLE Automation), необходимо установить библиотеку типов Word. Библиотека типов объявляет в стандартизированном виде все методы и свойства Automation Server, которые могут быть использованы любым совместимым средством программирования, включая Delphi. Для того чтобы использовать в Delphi библиотеку типов Word в меню «Project» -> «Import Type Library» необходимо выбрать файл msword8.olb, находящийся в каталоге Microsoft Office и подкаталоге «Office». При этом будет создан файл «Word_TLB.pas», в котором содержимое библиотеки типов представлено на языке object pascal. Будут созданы также файлы библиотек «Office_TLB.pas» и «VBIDE_TLB.pas», на которые ссылается библиотека типов. Эти файлы необходимо сохранить в каталоге «Imports». Теперь достаточно в секцию «uses» нового модуля добавить «Word_TLB» для работы с Word посредством OLE Automation.Подробную информацию о предоставляемых приложениями Office методах и свойствах можно найти в файлах vba*.hlp. Учтите только, что по умолчанию они не устанавливаются. Для их установки для каждой программы необходимо явно указать наличие файлов справки по Visual Basic или выполнить полную установку.
Следует отметить также, что в Delphi версии 5 есть стандартные методы для работы в Word. Это модули Word97 и Word2000, которые уже содержат в себе библиотеку типов Word.
Вставка текста
varS: Selection;
...
S :=Word.Selection;
S.TypeText(Вставляемый текст');
S.TypeParagraph;
S.TypeParagraph;
S.TypeText('Текст после пустой строки');
Если выставить свойство «Application.Options.ReplaceSelection» в «True», выделенный текст будет заменяться новым.
Приведенная ранее информация позволит вам
Приведенная ранее информация позволит вам передавать в Word информацию и генерировать или заменять документы. Существует также возможность получать из Word некоторые события для их обработки, но они позволяют только отследить открытие/закрытие документов, самого Word и активацию OCX-элементов. Поэтому не думаю, что вам это пригодится, хотя, если народ пожелает…document.write('');
Архив новостей
2 Август, 17:53 (19)
2 Август, 17:51 (34)
2 Август, 15:40 (42)
2 Август, 15:35 (1)
2 Август, 14:54 (3)
2 Август, 14:34 (3)
2 Август, 14:15 (2)
2 Август, 13:34 (7)
2 Август, 13:04 (3)
2 Август, 12:28
Море работы для программистов, сисадминов, вебмастеров.
Иди и выбирай!
|
|
| IT-консалтинг | Software Engineering | Программирование | СУБД | Безопасность | Internet | Сети | Операционные системы | Hardware |
| PR-акции, размещение рекламы — , тел. +7 495 6608306, ICQ 232284597 | Пресс-релизы — |
|
|
|
| This Web server launched on February 24, 1997 Copyright © 1997-2000 CIT, © 2001-2009 |
|
|
| Внимание! Любой из материалов, опубликованных на этом сервере, не может быть воспроизведен в какой бы то ни было форме и какими бы то ни было средствами без письменного разрешения владельцев авторских прав. |
|
Приобретайте новую Ansher, только здесь Вам предложат самые низкие цены и высокий уровень сервиса. |
Закрытие документа
varSaveChs: olevariant;
begin
SaveChs := wdSaveChanges;
Word.ActiveDocument.Close(SaveChs, EmptyParam, EmptyParam);
Параметры имеют те же значения, что и в случае метода «Word.Close», с одним неприятным исключением: при передаче значения «wdPromptToSaveChanges» метод останавливается. Поэтому запрос пользователю нужно сделать самостоятельно.
Закрытие Word
Быстрое закрытие без сохранения изменений приведено далее:var
SaveChanges: OleVariant;
begin
SaveChanges := wdDoNotSaveChanges;
Word.Quit(SaveChanges, EmptyParam, EmptyParam);
Другие возможные варианты для параметра «SaveChanges» — это «wdSaveChanges» (сохранить изменения) и «wdPromptToSaveChanges» (запросить у пользователя необходимость сохранения изменений).
Второй параметр используется для документов не Word формата. Возможные значения «wdOriginalDocumentFormat» (сохранить в исходном формате), «wdPromptUser» (запросить формат у пользователя) или «wdWordDocument» (сохранить как документ Word).
The last parameter should be set to True if you want the document to be routed to the next recipient in line.
Последний параметр должен быть установлен в «True», если вы хотите, чтобы документ был направлен следующему получателю по маршруту.
Delphi - сбориник статей
Class property
Раньше, хотя компилятор и позволял использовать методы класса в качестве аксессоров свойств, обращение к таким свойствам в форме TSomeClass.PropName было невозможно. Теперь, с введением свойств класса такое обращение разрешено. Однако, в отличие от Delphi for .NET, свойства класса могут работать только через методы, т.к. понятие полей класса для компилятора Delphi for Win32 отсутствует.type TTestClass = class class function GetClassProp: integer; class procedure SetClassProp(value: integer); class property ClassProp: integer read GetClassProp write SetClassProp; end; TestClass.ClassProp := ...;
Error Insight
В левой части экрана есть окно "Structure". Оно используется для показа визуальных компонент, лежащих на форме, переменных и констант, списка модулей, которые подключены и так далее. Но, кроме этого окно "Structure" может показывать список синтаксических ошибок, которые определяются до момента компиляции с помощью "Error Insight".Например, самая обычная ошибка — неверно написан идентификатор или не подключен модуль, в котором он определен. Если раньше, до момента компиляции эти ошибки не отслеживались, то сейчас ошибочные имена (идентификаторов, методов и т.п.) мгновенно обращают на себя внимание, так как в редакторе кода они подчеркиваются красной волнистой линией, а в окне "Structure" появляется полный список таких ошибок (см. ). Естественно, что, кликнув на ошибке в списке, мы сразу попадаем на нужное место в коде.
For..in..do
В язык Delphi добавлена конструкция for..in..do для перебора всех членов массива, строки, множества или коллекции.Полная и весьма понятная информация находится в справке, смотрите раздел "Declarations and Statements"
Наиболее интересным применением циклов такого вида является их использование с коллекциями для перебора элементов. Для того, чтобы класс можно было использовать с циклами for..in, класс должен реализовать предопределенный паттерн коллекции. А именно, класс должен удовлетворять следующим требованиям:
Следующий пример показывает реализацию паттерна коллекции
program Project1; {$APPTYPE CONSOLE} type TMyIntArray = array of Integer; TMyEnumerator = class Values: TMyIntArray; Index: Integer; public constructor Create; function GetCurrent: Integer; function MoveNext: Boolean; property Current: Integer read GetCurrent; end; TMyContainer = class public function GetEnumerator: TMyEnumerator; end; constructor TMyEnumerator.Create; begin inherited Create; Values := TMyIntArray.Create(100, 200, 300); Index := -1; end; function TMyEnumerator.MoveNext: Boolean; begin if Index < High(Values) then begin Inc(Index); Result := True; end else Result := False; end; function TMyEnumerator.GetCurrent: Integer; begin Result := Values[Index]; end; function TMyContainer.GetEnumerator: TMyEnumerator; begin Result := TMyEnumerator.Create; end; var MyContainer: TMyContainer; I: Integer; Counter: Integer; ar: TMyIntArray; begin MyContainer := TMyContainer.Create; Counter := 0; for I in MyContainer do Inc(Counter, I); WriteLn('Counter = ', Counter); end.
Поддержка синтаксиса for...in уже встроена в ряд классов VCL, например, TList, TComponent, TCollection, и т.д. - в общей сложности около 15 классов. Так, например, перечисление имен компонентов формы может выглядеть следующим образом (хотя и непривычно):
var I: TComponent; begin for I in Self do ListBox.Add (I.Name); end;
Help Insight
Если в привычном "Code Insight" показывался тип идентификатора (переменной, функции и т.д.) и модуль, в котором он определен, то "Help Insight" представляет собой всплывающее окно-подсказку, с кратким описанием этого идентификатора и дополнительными ссылками (см. рис). Достаточно подвести мышку к нужному идентификатору, чтобы получить такой "маленький help". Использовать "Help Insight" можно в комбинации с "Code Completion". Если в окне "Code Completion" выбрать определенное свойство или метод, то справа появится окно с подсказкой.Открыть скриншот в отдельном окне Эта возможность реализована не только для стандартных, но и для собственных классов и переменных. Использование "Help Insight" включено по умолчанию. Местонахождение в настройках: Tools->Options->Editor Options->Code Insight
Хранимые процедуры
Доступные операции Refresh/View Parameters. Окно просмотра параметров открывается при двойном клике на имени процедуры. В этом окне можно указать значения всех входных параметров и, выполнив процедуру, получить заполненные значениями выходные параметры (см. рис). Для выполнения процедуры можно воспользоваться иконкой в верхнем левом углу окна или по правой кнопке мыши (команда Execute).Если хранимая процедура в качестве результата возвращает еще и (или только) набор данных, необходимо поставить галочку "Stored procedure has one or more cursors" и выполнить процедуру снова.
Просмотр скриншотов в отдельном окне:
Окно просмотра параметров
Окно с настройкой параметров процедуры и получением результатов
Результат работы хранимой процедуры, которая возвращает набор данных
Безусловно, новые возможности для тестирования работы хранимых процедур очень удобны и позволят упростить жизнь разработчика баз данных.
В качестве недостатка можно отметить отсутствие возможности прервать выполнение хранимой процедуры, если время выполнения оказывается довольно продолжительным.
Inline
В новой версии компилятора Delphi появилась возможность использования inline кода. Для этого наполнена новым смыслом директива inline. Теперь, если процедура или функция имеют директиву inline, это заставит компилятор попытаться вставить в место, где эта процедура используется, не вызов, а код тела процедуры. Само наличие директивы inline ещё не гарантирует того, что попытка будет удачной. Существуют определенные ограничения. Согласно справочной системе, эти ограничения таковы:Также для контроля использования inline-подстановок введена директива компилятора {$INLINE}. Она может принимать следующие значения:
История изменений
По мере редактирования и сохранения кода в проекте, средой автоматически ведется история этих изменений. Для каждого модуля, включенного в проект, можно просмотреть историю изменений, сравнить разные версии файлов и, если необходимо, возвратиться к любому из промежуточных изменений кода проекта. Смотрите закладку History в редакторе кода и тему "History Manager" в документации.Открыть скриншот в отдельном окне После даже этой небольшой работы с новой IDE, возвращение к старым версиям в свои рабочие проекты кажется откатом назад.
Комментирование блока текста
Начнем с одной приятной мелочи. Не знаю, как кому, но мне ее иногда очень не хватало в Delphi. Я имею в виду возможность быстро закомментировать или раскомментировать блок текста в редакторе.
В новой IDE это делается легким движением руки. Выделяем текст, нажимаем клавиши [Ctrl+/] и весь выделенный код оказался закомментирован. Обратная операция делается точно так же. На всякий случай напомню, почему это лучше, чем обычные скобки {} в начале и конце куска кода. В случае использования в начале каждой строки двойного слеша нет никакой нужды заботиться о вложенных комментариях, которые могут уже быть в выделенном тексте. Этот способ "устранения" части кода бывает удобен при отладке.Очень удобна новая возможность редактора показывать соответствующие пары скобок (см. рисунок).
Компилятор
Предопределенный символ для идентификации компилятора - VER170 (выяснено опытным путем, в Help информация отсутствует).Многие из перечисленных ниже возможностей являются нововведениями только для компилятора Win32.
Модификаторы области видимости
Для большей совместимости исходного кода с Delphi for .NET введены два новых модификатора области видимости членов класса.strict private
Члены класса с видимостью strict private доступны только самому классу.
strict protected
Члены класса с видимостью strict protected доступны только самому классу и его непосредственным наследникам.
Отличие новых модификаторов от традиционных private и protected заключается в том, что члены с новыми модификаторами не доступны постороннему коду, находящемуся в том же модуле.
Ненаследуемые классы
Если по каким-то причинам разработчик хочет запретить создание наследников класса, это можно сделать используя модификатор sealed.type TMyFinalClass = class sealed(TObject) end;
Так же, в язык добавлено ключевое слово final для вирутальных и динамических методов, запрещающее их дальнейшее перекрытие. Эта возможность присутствует как в компиляторе .NET, так и в компиляторе для Win32
Например, компиляция кода type TClass1 = class private .... public constructor Create; destructor Destroy; override; final; .... end; TClass2 = class(TClass1) .... public destructor Destroy; override; end;
приведет к ошибке - E2352 Cannot override a final method.
Но, есть и неприятные моменты.
Русские буквы в комментариях к кодуПоначалу неприятно удивило открытие файлов кода с комментариями в заголовке, написанными русскими буквами в кодировке Win1251. Часть таких файлов открываются, как двоичные. После небольшого исследования оказалось, что портит все маленькая буква "я" в тексте комментариев в начале модуля. Если в новой среде написать такой комментарий в начале модуля, то он редактируется нормально. Но, если его закрыть, то вновь откроется он в двоичном виде. По-видимому, проблема связана с тем, что редактор кода по первой порции фиксированного объема определяет формат файла. Встречая в этой порции букву "я" (ее код $FF), редактор некорректно определяет формат файла. При переносе текста с буквой "я" в конец файла или в середину файла большого размера, его формат определяется корректно.
Сходная ситуация обсуждалась в .
Проблема с открытием таких файлов решается или удалением слов из заголовка модуля, содержащих маленькую букву "я", или замена ее на букву "Я" в верхнем регистре. Кому что нравится.
Русские буквы в названиях каталогов проекта
Проекты VCL.NET и WinForms не запускаются из-под среды, если в полном имени каталога проекта есть русские буквы. Среда сообщает "Unable to create process".
К сожалению, ссылки в окне "Help Insight" не будут работать, если у вас в названии каталогов используются русские буквы.
Отладка
Понравилось поведение системы при возникновении Exception — появляется окно с уведомлением об Exception и с возможностью поставить галочку "Игнорировать этот тип Exception", вместо того, чтобы открывать окно Tools | Debugger..Изменилась работа с точками останова. Появилась очень удобная возможность, не удаляя точку останова, отключить ее, пометив как "disable". Это можно сделать в редакторе кода по правой кнопке на точке останова, и прямо в списке "Breakpoint list". В этом списке можно включать/выключать все точки или определенные группы (меню по правой кнопке). Так же, теперь прямо в окне "Breakpoint list" можно изменять значение Condition и принадлежность к определенной группе для каждой точки.
Первая страница
После загрузки среды перед нами возникает приветственная страница "Welcome Page". Это новый аналог того самого окошка новостей, которое выглядело довольно неказисто, если ваш компьютер не был подключен к интернету во время работы. Однако не стоит так же сбрасывать со счетов и новый вариант. Кроме ленты новостей (RSS), "Welcome Page" содержит немало полезных ссылок. Во-первых, в самом верху страницы перечислен список проектов, которые вы уже открывали некоторое время назад, с указанием даты последней модификации. Каждая ссылка, естественно, открывает выбранный проект.Показать скриншот в отдельном окне В левой части страницы подобраны ссылки на справочную информацию, документацию, которая устанавливается на ваш компьютер при инсталяции Delphi2005. Далее идут ссылки в интернет, на страницы компаний-разработчиков, чьи продукты встроены в среду. Например, на страницу Rave Reports, IntraWeb и так далее. И, наконец, ссылки на новостные группы в интернете, BDN и другие страницы Borland-ресурсов. То есть, "Welcome Page", действительно содержит полезную информацию. Может быть, не часто придется ею пользоваться, но и забывать о ней не стоит, может пригодиться.
Среда предоставляет возможнсть работать как в классическом стиле предыдущих версий Delphi (с отдельными окнами для дизайнера форм, инспектора объектов и т.д.), так и в стиле, максимально приближенном к MS Visual Studio, когда все окна пристыковываются к центральному, в котором можно заниматься дизайном формы или редактированием кода.
Для того, чтобы привести окна редактирования и палитры компонентов к привычному виду, поэкспериментируйте с настройками Tools | Environment Options | Delphi Options | VCL Designer | Embedded designer и Tools | Environment Options | Tool Pallete.
В Delphi2005 изменилась справочная система. Изменился не только внешний вид, но внутренняя структура предлагаемой информации.
На мой взгляд, пользоваться справкой стало намного удобнее.
Показать скриншот в отдельном окне Появилась возможность настраивать цвета для Object Inspector, смотритеTools | Environment Options | Object Inspector.
Расширенный синтаксис объявления и инициализации массивов
Delphi для Win32Теперь можно делать задание размеров массива и инициализацию одной строкой
type TMyIntArray = array of Integer; var Ints: TMyIntArray; begin Ints := TMyIntArray.Create(1,2,3,4,5);
Delphi for .NET
Новый расширенный синтаксис позволяет объявлять массивы в форме
array[, ..., ] of baseType; Также возможна инициализация массивов при помощи стандартной процедуры new.
var a: array [,,] of integer; // 3 dimensional array b: array [,] of integer; // 2 dimensional array c: array [,] of TPoint; // 2 dimensional array of TPoint begin // New taking element type and size of each dimension. a := New(array[3,5,7] of integer); // New taking the element type and initializer list. b := New(array[,] of integer, ((1,2,3), (4,5,6))); // New taking an initializer list of TPoint. c := New(array[,] of TPoint, (((X:1;Y:2), (X:3;Y:4)), ((X:5;Y:6), (X:7;Y:8)))); end.
Рефакторинг
Рефакторинг "переименование символа" — при позиционировании курсора на нужном идентификаторе и выборе пункта меню Refactoring | Rename Field, среда показывает все строки, где встречается выбранный идентификатор, и предлагает выбрать новое имя. Очень удобная возможность, как тут не вспомнить Мартина Фаулера:"Важной частью пропагандируемого мною стиля программирования является разложение сложных процедур на небольшие методы. Если делать это неправильно, то придется изрядно помучиться, выясняя, что же делают эти маленькие методы. Избежать таких мучений помогает назначение методам хороших имен. Методам следует давать имена, раскрывающие их назначение. Хороший способ для этого - представить себе, каким должен быть комментарий к методу, и преобразовать этот комментарий в имя метода. Жизнь такова, что удачное имя может не сразу придти в голову. В подобной ситуации может возникнуть соблазн бросить это занятие - в конце концов, не в имени счастье. Это вас соблазняет бес, не слушайте его. Если вы видите, что у метода плохое имя, обязательно измените его. Помните, что ваш код в первую очередь предназначен человеку, а только потом - компьютеру. Человеку нужны хорошие имена. Вспомните, сколько времени вы потратили, пытаясь что-то сделать, и насколько проще было бы, окажись у пары методов более удачные имена. Создание хороших имен - это мастерство, требующее практики; совершенствование этого мастерства - ключ к превращению в действительно искусного программиста. То же справедливо и в отношении других элементов сигнатуры метода. Если переупорядочивание параметров проясняет суть - выполните его."
Раньше для подобных действий использовался метод переименования идентификатора в месте, где он объявлен, и инкрементная компиляция до выяснения всех мест, в которых этот идентификатор использовался.
Рефакторинг "Выделение метода" оказался вторым из удобных нововведений, в выделенном методе автоматически объявляются необходимые параметры и локальные переменные. К сожалению, пока остается мечтой автоматический поиск аналогичного кода выделенного метода в других местах и замена его вызововом выделенного метода.
Рефакторинг: процесс выделения метода
После выделения метода
Остальные рефакторинги (объявить переменную, объявить поле, выделить ресурсную строку), на мой взгляд, являются не рефакторингами в классическом смысле, а удобной возможностью редактора кода вставлять необходимые объявления, не перемещаясь в раздел объявлений.SQL Window
Это привычное окно для выполнения SQL-запросов. Так как тестирование проходило только для MS SQL Server, то возможно, некоторые странности связаны с конкретным драйвером.Сами SQL-запросы любой сложности (UNION, вложенные подзапросы и т.п.) выполняются без проблем. Странности начались после попытки исполнить в этом окне процедуру ("execute имя_процедуры"), которая в качестве результата возвращает набор данных. В качестве результата было получено сообщение "-1 row(s) affected". И этот результат был одинаков для всех процедур одного сервера. Тест на другом сервере дал иной результат, возможно этот эффект зависит от настроек на сервере (или от настроек конкретной базы), но такого иследования не проводилось. Итак, на другом сервере после выполнения процедуры было получено окошко с сообщением, например, таким: "192 row(s) affected", что само по себе верно, но никакого результата, то есть набора данных, все равно не было выведено. Если в тексте процедуры был оператор "Insert Into имя_таблицы exec имя_процедуры", то в качестве nколичества обработанных строк в результирующем сообщении выдавалось количество строк этого insert'а, а вовсе не nпоследнего select'а процедуры.
Можно предположить, что проблема кроется в ADO.NET, на котором реализован Data Explorer.
И, все же, несмотря на это, Data Explorer добавляет в среду разработки функционал, который реально может облегчить жизнь разработчику клиентских приложений для баз данных.
* * * Данный обзор составлен по результатам первого знакомства с новой средой разработки. Изучить все нововведения в Delphi2005 за короткий срок невозможно, но такой задачи мы и не ставили перед собой. Разделив работу на параллельные части, мы постарались охватить как можно больше интересных, с нашей точки зрения, нововведений и "вкусностей" нашей любимой среды разработки.
Спасибо компании за возможность ознакомиться с новой версией, которая несомненно, позволит вывести разработку приложений на качественно новый этап.
К материалу прилагаются файлы:
(565.5 K)
Сворачивание части кода
Как и в Delphi8, в редакторе Delphi2005 реализовано частичное скрытие (сворачивание кода). Это позволяет работать с большими текстами, не прокручивая многостраничный экран. Достаточно оставить развернутым сейчас только тот код, который используется. Для того чтобы свернуть или развернуть нужный блок, специально предусмотрены значки [-] и [+] в левой части редактора. Если нажать на значок [-], например, возле определения метода, код этого метода будет свернут, то есть, убран из видимости. Но, кроме этого, есть возможность применить эту операцию ко всему коду, а не только к текущему месту.В меню по правой кнопке мыши есть два пункта Fold и UnFold. Это, соответственно, операции "свернуть" и "развернуть". Для каждой из них нужно указать место действия. Например, свернуть все методы в коде или все определения типов. Хочется заметить, что "свернутая" часть кода никуда не девается, а лишь уходит из видимой части редактора. Так что, если при компиляции или во время работы "Error Insight", ошибка окажется в свернутом коде, он прекрасным образом будет развернут автоматически в нужном месте. Так что никакой путаницы не возникнет.
Кроме этих возможностей, введены две директивы, которые по синтаксису аналогичны директивам компилятора, но оказывают влияние на поведение редактора, а не на генерируемый код. Это директивы $REGION и $ENDREGION. Они задают начало и конец сворачиваемого региона кода. Можно задать имя региона, в этом случае, когда регион свернут, вместо многоточия отображается имя региона (см. ).
Sync Edit
При выделении части кода в редакторе, на левой полосе, вслед за выделяемыми строками, передвигается маленькая иконка (на рисунке она отмечена красным). Это включение режима "Sync Edit". Если нажать на эту иконку, то выделенный текст подкрасится (при цветовых настройках по умолчанию) голубым цветом и будет выделен первый в блоке идентификатор.Открыть скриншот в отдельном окне Суть режима "Sync Edit" в том, что он позволяет показать в выделенном тексте все повторяющиеся идентификаторы, их может оказаться несколько групп. Самая первая считается текущей.
Для текущей группы все дубли помечены рамочкой, для остальных групп просто подчеркнуты. Переход между группами повторяющихся идентификаторов осуществляется клавишей TAB. Если начать изменять текущий идентификатор, то вслед за ним будут синхронно изменены все его дубли в этом выделенном блоке. Это похоже на .
В отличие от полноценного рефакторинга, в режиме "Sync Edit" не производится никакого синтаксического анализа, а просто ищется повторяющееся имя. Его можно применять, как "быстрый рефакторинг" или использовать для поиска всех мест, где используется искомый идентификатор.
Рекомендуется использовать этот режим для небольших блоков кода, например, для функций или методов. Для всех остальных случаев рекомендуется использовать полноценный рефакторинг.
Повторное нажатие на иконку на левой полосе редактора кода, выключает "Sync Edit" и возвращает обычный режим редактирования.
Таблицы
Для таблиц определены следующие операции:Просмотр данных
Это операция по умолчанию — двойной клик по имени таблицы в списке. Открывается отдельное окно с содержимым таблицы. Возможно редактировать все поля, даже identity и computed column. Диагностика производится в момент сохранения изменений (правая кнопка мыши | Update/Rollback), так что испортить таблицу затруднительно.
Изменение структуры
Визуальный аналог команды "Alter table".
В этом окне по правой кнопке мыши доступны команды Save changes/Show DDL/ Exeсute DDLDDL (Data definition language) — текст SQL-скрипта, который отражает сделанные визуально изменения в структуре таблицы.
Удаление таблицы
Выполнение команды "Drop table"
Копирование таблицы
Копирование существующей таблицы в новую. Происходит, как создание новой таблицы с такой же структурой (имя новой таблицы запрашивается при выполнении paste) и заполнении ее данным из копируемой таблицы.
Unicode-идентификаторы
Появилась возможность использовать в именах типов и переменных символы Unicode.Запись вида
type Работник = record Фамилия: string; Имя: string; Отчество: string; ДатаРождения: TdateTime; Должность: string; end;
выглядит понятнее, чем
Rabotnik = record Familija: string; Imya: string; Ochestvo: string; DataRogdenija: TdateTime; Dolgjnost: string; end;
Разумеется, такой код будет многим непривычен и вызовет недовольные нарекания в духе "настоящий программист должен писать имена переменных/типов/методов на английском языке", но давайте помнить, что программа пишется в первую очередь для человека, компилятору абсолютно все равно, какие имена будут объявлены в программе.
Пример компилирующегося и работающего кода:
type Целое = Integer; procedure TfMain.BtnCountClick(Sender: TObject); var Счетчик: Целое; begin for Счетчик:=0 to 5 do begin btnCount.Caption := IntToStr(Счетчик); Sleep(500); Application.ProcessMessages; end; end;
Unit-тестирование
"Мой опыт показывает, что создав хорошие тесты, можно значительно увеличить скорость программирования"(с) Мартин Фаулер.
Delphi 2005 располагает встроенными средствами для организации тестирования работы отдельных модулей программы, основанными на известных open-source проектах DUnit и NUnit (.NET). Среда позволяет создать проект-оболочку для тестов и шаблоны тестирующих модулей. Рассмотрим возможности Delphi 2005 на примере тестирования простого класса, осуществляющего перевод чисел из двоичной формы в символьную по заданному основанию системы счисления и, наоборот, из символьной в двоичную.
Создадим класс, методы которого будут выполнять перевод, а основание системы счисления будет являться свойством класса.
Реализация метода ToString будет содержать ошибки, которые мы будем обнаруживать тестированием. Первая реализация выглядит так:
unit Convertor; interface type TNumericConvertor = class private FBase: Integer; public constructor Create (const ABase: Integer); property Base: Integer read FBase; function ToString (const Value: Integer): string; function ToNumber (const Value: string): Integer; end; implementation { TNumericConvertor } constructor TNumericConvertor.Create(const ABase: Integer); begin Assert ((ABase > 1) and (ABase <= 36), 'Illegal Base specfied'); FBase := ABase; end; function TNumericConvertor.ToNumber(const Value: string): Integer; var I, Digit: Integer; begin Result := 0; for I:=1 to Length(Value) do begin if Value[I] > '9' then Digit := Ord(Value[I]) - Ord('A') + 10 else Digit := Ord(Value[I]) - Ord('0'); Assert ((Digit >= 0) and (Digit < Fbase), 'Illegal character'); Result := Result * FBase + Digit; end; end; function TNumericConvertor.ToString(const Value: Integer): string; var Rem, Quot: Integer; begin Assert (Value >= 0, 'Only positive numbers can be converted'); Result := ''; Quot := Value; while Quot <> 0 do begin Rem := Quot mod FBase; if Rem >= 10 then Result := Result + Char(Rem + Ord('0')) else Result := Result + Char(Rem + Ord('A') - 10); Quot := Quot div Fbase; end; if Result = '' then Result := '0'; end; end.
Создадим проект-оболочку для тестов командой File|New|Other выбрав в категории Unit Tests элемент Test Project (см. рис. 1 и 1-1).
Показать скриншоты в отдельном окне: рисунок 1 и рисунок 1-1
После этого группа проектов принимает вид:
Добавим в эту оболочку первый тестирующий модуль командой File|New|Other выбрав в категории Unit Tests элемент Test Case.Показать скриншоты в отдельном окне:
unit TestConvertor; { Delphi DUnit Test Case ---------------------- This unit contains a skeleton test case class generated by the Test Case Wizard. Modify the generated code to correctly setup and call the methods from the unit being tested. } interface uses TestFramework, Convertor; type // Test methods for class TNumericConvertor TestTNumericConvertor = class(TTestCase) strict private FNumericConvertor: TNumericConvertor; public procedure SetUp; override; procedure TearDown; override; published procedure TestToString; procedure TestToNumber; end; implementation procedure TestTNumericConvertor.SetUp; begin FNumericConvertor := TNumericConvertor.Create; end; procedure TestTNumericConvertor.TearDown; begin FNumericConvertor.Free; FNumericConvertor := nil; end; procedure TestTNumericConvertor.TestToString; var ReturnValue: string; Value: Integer; begin // TODO: Setup method call parameters ReturnValue := FNumericConvertor.ToString(Value); // TODO: Validate method results end; procedure TestTNumericConvertor.TestToNumber; var ReturnValue: Integer; Value: string; begin // TODO: Setup method call parameters ReturnValue := FNumericConvertor.ToNumber(Value); // TODO: Validate method results end; initialization // Register any test cases with the test runner RegisterTest(TestTNumericConvertor.Suite); end.
В методах тестов заменяем помеченные TODO строки на код, обеспечивающий входные данные для тестируемых методов и сравнивающие результат с ожидаемым.
В методе Setup пишем код для вызова корректного конструктора
procedure TestTNumericConvertor.SetUp; begin FNumericConvertor := TNumericConvertor.Create (10); end;
Метод TestToString принимает вид:
procedure TestTNumericConvertor.TestToString; var ReturnValue: string; Value: Integer; begin Value := 10; ReturnValue := FNumericConvertor.ToString(Value); Assert (ReturnValue = '10', 'Expect ''10'', receive '''+ReturnValue+''''); end;
И последний метод - TestToNumber
procedure TestTNumericConvertor.TestToNumber; var ReturnValue: Integer; Value: string; begin Value := '10'; ReturnValue := FNumericConvertor.ToNumber(Value); Assert (Returnvalue = 10, 'Expect 10, receive '+IntToStr(ReturnValue)); end;
Компилируем и запускаем тестовый проект, его окно выглядит .
После запуска тестов видно, что один из методов исходного класса работает некорректно, так как полученный результат не соответствует ожидаемому (Ожидается '10' получен 'AB')
Показать скриншот в отдельном окне Анализируя исходный код метода, видно, что при переводе очередного знака числа, условия then и else необходимо поменять местами:
if Rem >= 10 then Result := Result + Char(Rem + Ord('A') - 10) else Result := Result + Char(Rem + Ord('0'));
Перекомпилировав проект после исправления, снова запускаем тесты.
Видно, что ошибка исправлена, но метод все работает не так, как ожидается (Ожидается '10', получено '01').
Показать скриншот в отдельном окне Дальнейший анализ кода метода показывает, что при переводе числа в строку старшие цифры записываются после младших, исправляем эту ошибку, часть кода метода ToString теперь выглядит так:
if Rem >= 10 then Result := Char(Rem + Ord('A') - 10) + Result else Result := Char(Rem + Ord('0')) + Result;
Снова компилируем тестовый проект, после запуска убеждаемся, что исправленный метод теперь работает как ожидалось, при заданных в тесте условиях.
Показать скриншот в отдельном окне Это не окончательный показатель гарантии правильной работы методов класса, для полной проверки необходим еще ряд тестов, тем не менее, две ошибки выявлены тестами за короткое время.
Для проверки перевода чисел в другой системе счисления можно создать еще один Test Case, например, тестирующий перевод из двоичного вида в символьный и обратно в двоичной системе счисления.
unit TestConvertor1; { Delphi DUnit Test Case ---------------------- This unit contains a skeleton test case class generated by the Test Case Wizard Modify the generated code to correctly setup and call the methods from the unit being tested. } interface uses TestFramework, Convertor; type // Test methods for class TNumericConvertor TestTNumericConvertor1 = class(TTestCase) strict private FNumericConvertor: TNumericConvertor; public procedure SetUp; override; procedure TearDown; override; published procedure TestToString; procedure TestToNumber; end; implementation uses SysUtils; procedure TestTNumericConvertor1.SetUp; begin FNumericConvertor := TNumericConvertor.Create(2); end; procedure TestTNumericConvertor1.TearDown; begin FNumericConvertor.Free; FNumericConvertor := nil; end; procedure TestTNumericConvertor1.TestToString; var ReturnValue: string; Value: Integer; begin Value := 11; ReturnValue := FNumericConvertor.ToString(Value); Assert(ReturnValue = '1011', 'Expect ''1011'', receive '''+ReturnValue+''''); end; procedure TestTNumericConvertor1.TestToNumber; var ReturnValue: Integer; Value: string; begin Value := '1011'; ReturnValue := FNumericConvertor.ToNumber(Value); Assert(ReturnValue = 11, 'Expect 11, receive '+IntToStr(ReturnValue)); end; initialization // Register any test cases with the test runner RegisterTest(TestTNumericConvertor1.Suite); end.
После компиляции и запуска тестового проекта, видно, что новые тесты добавились к старым, так что любые исправления исходного кода можно протестировать как всеми созданными тестами, так и выбрав конкретные тесты.
Показать скриншот в отдельном окне В заключение хочется добавить, что использовать unit-тесты можно было и раньше. Например, полтора года назад, одним из авторов обзора была разработана среда подобного рода для того, чтобы полностью осознать, что же такое unit-тесты. Среда включала в себя главную программу и эксперт для генерации тестирующих модулей. Разумеется, не с таким красивым и удобным интерфейсом, гораздо больше кода приходилось писать вручную, но главный итог такой разработки и использования — осознание необходимости тестирования, в особенности, использования unit-тестов как значительного подспорья для разработки программ.
Спасибо фирме Borland, что такие нужны и удобные средства уже встроены в их новый продукт — Delphi 2005.
Unsafe Code
Для компилятора Delphi for .NET добавлена возможность включения небезопасного кода в приложения .NET. Для этого введена локальная директива компилятора {$UNSAFECODE}, которая может принимать значения ON и OFF а также добавлено ключевое слово unsafe, которое применяется к процедурам и функциям. Приложения, использующие небезопасный код не проходит проверку при помощи утилиты PEVerify. Подробнее о небезопасном коде смотрите в документации .NET SDK.procedure unsafeProc; unsafe; begin end;
Вложенные типы данных и константы
Эта возможность также является новшеством только для компилятора Delphi for Win32. Теперь, как и в случае с Delphi for .NET, можно объявлять типы данных и константы внутри других классов.type TOuterClass = class public const x = 12; i: integer = 1; type TInnerClass = class public myInnerField: Integer; procedure innerProc; end; procedure outerProc; end;
Обращение ко вложенным типам и константам производится через имя типа, в который они вложены, например, TOuterClass.TInnerClass или TOuterClass.x. Для вложенных типов и констант действуют те же модификаторы видимости, что и для остальных членов классов.
Существует одна интересная особенность. Хотя компилятор для Win32 не поддерживает полей класса, их в какой-то мере можно заменить вложенными типизированными константами при условии, что включена опция компилятора $J (она же $WRITEABLECONST).
Встроенный Data Explorer
В IDE интегрирован Data Explorer, который содержит как средства просмотра базы данных, так и ряд инструментов для редактирования. Окно Data Explorer можно найти на одной из закладок окна Project Manager справа от редактора кода (при умолчанных настройках среды) или в меню View | Data ExplorerВыбираете провайдера для вашей БД, настраиваете коннекцию к базе и получаете список ее объектов:
XML Documentation
Для компилятора Delphi for .NET эта возможность существует с версии Delphi 8. Теперь эта возможность доступна и в компиляторе для Win32. Компилятор умеет различать в исходном тексте специальным образом оформленные комментарии и генерировать на их основе XML файлы. Формат комментариев во многом похож на XML. Каждый комментарий, который будет анализироваться на наличие тегов XML документации предшествовует документируемому объекту и должен начинаться с комбинации из трёх символов "/". Существует набор тегов, которые рекомендуется применять при оформлении комментариев. Он описан в справке .NET SDK. К сожалению для тех, кто не любит писать всякие теги руками, IDE никак не облегчает оформление таких комментариев.Примитивный пример оформления документации:
type ///
Примерный вид XML документации, генерируемой компилятором:
Delphi - сбориник статей
Алфавит языка описания формул
Основные символы языка описания формул это - буквы, цифры и специальные символы:<Аргумент функции>
::= <Выражение>{, <Выражение>} | {<Выражение>,}<Перечисление аргументов>{,<Выражение>}<Аргумент локальной функции>
::= U Примечание: <Аргумент локальной функции> можно использовать только в <Описании локальной функции><Буква>
::= А|В|С|D|E|F|G|H|I|J|K|L|M|N|O|P|Q|R|S|T|U|V|W|X|Y|Z| a|b|c|d|e|f|g|h|i|j|k|l|m|n|o|p|q|r|s|t|u|v|w|x|y|z<Число>
::= <Целое число> | <Вещественное число><Дополнительная переменная>
::= <Буква>{<Буква>}[<Целое число>] Примечание: Значение <Дополнительной переменной> не может принимать значения зарезервированные за <Переменной цикла>, <Аргументом локальной функции>, <Результатом> и <Ключевым словом><Формула>
::= {<Определение локальной функции> | <Определение>} <Результирующие определение><Функция>
::= <Имя функции> "("<Аргумент функции>")" Примечание: У некоторых <Функций> (например, SUM или PROD) аргументы анализируются особым образомГрамматика языка описания формул
Язык описания математических формул можно задать более формально с использованием грамматики в расширенной форме Бэкуса-Наура с использованием следующих соглашений:Язык описания математических формул
В качестве формулы выступает функция многих переменных F(x), x=(x1,…, xn).Элементарные конструкции
Элементарные конструкции языка описания формул включают в себя идентификаторы и числа. Идентификаторами называют элементы языка: переменные, функции и константы. Идентификатор это последовательность букв и чисел, начинающаяся с буквы. Идентификаторы не чувствительны к регистру букв. Запрещается использовать в качестве идентификаторов ключевые слова.<Ключевое слово>
::= IF | THEN | ELSE | NOT | AND | OR | BEGIN | ENDКомментарии представляют
Комментарии представляют собой текстовые строки, предназначенные для аннотирования формулы. В языке описания формул поддерживается два типа комментариев: однострочные и многострочные. Первый тип начинается с последовательности "//" и при этом комментируется весь текст после нее до конца строки. Второй тип комментария может быть использован для выделения в комментарий многострочного текста, его начало и конец обозначаются соответственно "{" и "}" или " (*" и "*)", весь текст размещенный между этими символами, считается комментарием.<Комментарий>
::== "//" <Любой текст> <Перевод строки>| "{"{<Любой текст> [<Перевод строки>]}"}" "(*"<Любой текст> [<Перевод строки>] "*)" Примечание: Все <Комментарии> в процессе анализа пропускаются<Константа>
::= PI | DIM Примечание: <Константа> DIM описывает размерность вектора входящих переменныхЛитература
Скачать "Библиотеку для разбора и трансляции математических формул: optMathParser": (177K)Примечание к архиву:
kaOptima
MathExprDraw
QStrings
Portions (C) 2000,
Архив новостей
2 Август, 17:53 (19)
2 Август, 17:51 (34)
2 Август, 15:40 (42)
2 Август, 15:35 (1)
2 Август, 14:54 (3)
2 Август, 14:34 (3)
2 Август, 14:15 (2)
2 Август, 13:34 (7)
2 Август, 13:04 (3)
2 Август, 12:28
Море работы для программистов, сисадминов, вебмастеров.
Иди и выбирай!
|
|
| IT-консалтинг | Software Engineering | Программирование | СУБД | Безопасность | Internet | Сети | Операционные системы | Hardware |
| PR-акции, размещение рекламы — , тел. +7 495 6608306, ICQ 232284597 | Пресс-релизы — |
|
|
|
| This Web server launched on February 24, 1997 Copyright © 1997-2000 CIT, © 2001-2009 |
|
|
| Внимание! Любой из материалов, опубликованных на этом сервере, не может быть воспроизведен в какой бы то ни было форме и какими бы то ни было средствами без письменного разрешения владельцев авторских прав. |
|
Интересно: на www.td-vessel.ru. |
<Локальная функция>
::= <Имя локальной функция>"("<Аргумент функции>")"<Операция сравнения>
::= = | "<" | ">" | "<>" | ">"= | "<"=<Операнд>
::= <Число> | <Переменная> | <Переменная цикла> | <Функция> | <Константа> | <Локальная функция> | <Аргумент локальной функции><Определение локальной функции>
::= <Имя локальной функция> "("<Аргумент локальной функции>")" = <Выражение> Примечание: <Выражение> в <Определении локальной функции> не может содержать: <Переменную> и спец. функции SUM и PROD<Определение переменной>
::= <Дополнительная переменная> = <Выражение> <Разделитель><Определение>
::= <Определение переменной> | <Условное определение><Перечисление аргументов>
::= <Переменная1>, ..., <Переменная2> Примечание: <Переменная1> и <Переменная2> - должны иметь одинаковое имя и обязательно должны быть с числовым индексом! Причем индекс <Переменной1> должен быть меньше индекса <Переменной2><Переменная цикла>
::= i Примечание: <Переменную цикла> можно использовать только внутри спец. функций SUM и PROD<Переменная>
::= <Входная переменная> | <Дополнительная переменная>Примеры формул
1. Z1 = sin(X1) Z2 = cos(X2) F= Z1^2 + Z2^2 2. Z1 = 3 // Уровень помехи Z2 = |X1| // Модуль X1 Z3 = abs(X2) // Это тоже модуль X2 F = Z2 - Z3 + Z1R(-1, 1) 3. // пример использования "умножения" по умолчанию Alfa=3X1 Beta=4Sin(2Pi*X1X2) F = Alfa + Beta 4. // пример использования локальных функций Y1(U) = |U| Y2(U) = (U-3)^2 - 1 Y3(U) = |U-5| F=min(Y1(X1), Y2(X1), Y3(X1))+ min(Y1(X2), Y2(X2), Y3(X2)) 5. // пример использования суммы и произведения Z1= sum(1, dim-1, Xi+1-Xi) // явно указываем пределы суммирования Z2= sum(Xi^i)+prod(cos(Xi)) // пределы суммирования по умолчанию i=1,dim F= Z1+Z2 6. // пример использования условного определения if (|X1| <= 1) then I0=1 else I0=0 F= X1^2 + I0*R(-1,1)Программная реализация трансляции формулы
Обработка формулы состоит из следующих этапов:Лексический анализ: входящий поток символов разбивается на лексемы. Выделение очередной лексемы производится путем посимвольного анализа теста формулы, разбор идет до тех пор, пока есть символы на входе. Если обнаружена неизвестная лексема, то разбор прекращается и выводится сообщение об ошибке с указанием места в тексте формулы, где была найдена эта лексема. После успешного завершения этого этапа будет сформирован список из "допустимых" лексем. Этот список можно использовать в побочных практических целях, например, выполнить "красивое" форматирование текста формулы.
Семантический анализ: список лексем проверяется, на то, что они образуют в совокупности допустимую формулу. Если обнаруживается ошибка, то выдается сообщение об ошибке с указанием места ошибки и ее описанием. Семантический анализатор построен по принципу конечного рекурсивного автомата, который каждая следующая лексема переводит из одного допустимого состояния в другое или выбрасывает исключительную ситуацию (переводит автомат в недопустимое состояние). Для каждого типа лексем есть набор правил (из выше описанной грамматики) определяющих как их анализировать в зависимости от текущего состояния автомата. После этого этапа получается список "обработанных" лексем. Этот список может отличаться от списка после первого этапа, так как семантический анализатор может добавлять, удалять и изменять лексемы в процессе анализа, например, будут добавлены лексемы умножения, которые согласно определению языка описания формул могут опускаться при записи формул.
Трансляция: опираясь на проверенный список лексем, формируется текст функции на языке высокого уровня которая, будучи скомпилированной, в составе некоторой программы будет вычислять заданную формулу.
Описанный подход можно представить в виде следующей схемы:
<Разделитель>
::= ; | <Перевод строки> | <Конец файла><Результирующие определение>
::= <Результат> = <Выражение> <Разделитель выражений> Примечание: Весь текст формулы после <Результирующего определения> при анализе игнорируетсяСтруктура формулы
Формула может состоять из следующих элементов:Первые три элемента могут присутствовать в произвольном количестве и порядке, однако переменные и локальные функции необходимо явно определять до их использования. Четвертый элемент всегда присутствует в формуле и находится в ее конце, весь дальнейший текст формулы после него игнорируется.
Типы данных
Предполагается, что все элементы формулы являются действительными числами, кроме следующих случаев: <Переменная цикла> (см. далее в описании грамматики), начальный и конечный индексы цикла (в функциях SUM и PROD), а так же константа DIM (размерность вектора входящих переменных) являются целыми положительными числами.<Условие>
::= <Выражение> <Операция сравнения> <Выражение> | <Условие> (AND|OR) <Условие> | "(" <Условие> ")"<Условное определение>
::= IF <Условие> THEN <Блок определений> | <Определение> [ELSE <Блок определений> | <Определение>]<Вещественное число>
::= (<Целое число>.<Целое число>) | (<Целое число>[.<Целое число>]E[-|+]<Целое число>) | .<Целое число>[E[-|+]<Целое число>]<Входная переменная>
::= X(<Целое число> | _i | _"("i ± <Целое число>")") Примечание: <Входную переменную> у которой в индексе присутствует "i" можно использовать только внутри спец. Функций SUM и PRODкто занимаются различными научными расчетами
Те, кто занимаются различными научными расчетами или написанием научного программного обеспечения часто сталкиваются со следующей проблемой: "Каким образом добавить возможность интерактивно вводить и вычислять математические формулы в своей программе?". Традиционно существует два подхода:К достоинствам первого подхода можно отнести скорость выполнения и минимальные размеры исполняемого модуля (если конечно все оптимально и аккуратно запрограммировано), а также возможность реализовать сколь угодно сложные и неформализованные задачи. Но этот подход не очень гибкий, так как пользователь может настраивать только параметры задачи, а если необходимо что-либо добавить или изменить - требуется изменять исходный код программы (что чревато известными трудностями, например, любые изменения требуют тестирования и отладки программы). Второй подход можно разделить на три основных направления:
Конечно, можно использовать такие пакеты как MathLab, MathCad и т.п. для проведения научных и инженерных вычислений, но эти пакеты достаточно дорого стоят и, на мой взгляд, несколько "громоздкие". Этот подход можно рекомендовать тем, кто уже владеет подобными пакетами и знает, как их использовать для своих нужд. Основное преимущество данного подхода заключается в том, что эти пакеты "умеют" очень много. К недостаткам же можно отнести то, что они не поставляются в исходных кодах и поэтому представляют собой "черный ящик" со всеми вытекающими из этого неудобствами.
Интерпретация формул - достаточно распространенный подход и существует множество его реализаций. Достоинства: простота реализации, подробное диагностирование ошибок во время вычисления. Основным недостатком является крайне низкая скорость вычислений (хотя мне известны реализации с использованием кэширования и представления формул с использованием древовидных структур которые этим недостатком практически не обладают).
Компиляция - анализ и трансляция формул непосредственно в машинный код или в программу на языке высокого уровня. Преобразование формул в машинный код сопряжено со значительными трудностями, так как требует от разработчика глубоких знаний в этой области и к тому же привязывает реализацию к определенной аппаратной платформе. Гораздо более гибким способом является трансляция формул в программу на языке высокого уровня, так как это, во-первых, значительно упрощает сам процесс трансляции и, во-вторых, позволяет использовать этот подход практически без ограничений для любых программно-аппаратных платформ. К достоинствам этого подхода можно отнести высокую скорость вычислений, а к недостаткам, несколько более сложную обработку формул по сравнению с интерпретацией. Далее в этой статье будет рассмотрен именно этот подход - анализ и трансляция формул в программу на язык высокого уровня (на момент написания статьи реализована поддержка Object Pascal).
<Выражение>
::= <Операнд> | <Унарный знак выражения> <Выражение> | <Выражение> [<Операция>] <Выражение> | "("<Выражение>")" | "|"<Выражение>"|" Примечание: Если между выражениями пропущена <Операция>, то по умолчанию полагаем, что это операция умноженияи трансляции математических формул вот
Следует отметить, что рассмотренный в данной статье подход к разбору и трансляции математических формул вот уже более трех лет эффективно используется для описания тестовых задач глобальной оптимизации, которые состоят не только из функции качества, но еще и из произвольного количества ограничений в пакете глобальной поисковой непараметрической оптимизации "kaOptima". В упомянутом пакете, после трансляции формулы в программу (в данной реализации на языке Object Pascal), производится ее компиляция в динамически подключаемую библиотеку (dll) с помощью компилятора командной строки. Описанный подход можно легко адаптировать под любые другие языки программирования (например, язык С), при этом фактически надо только переписать процедуру трансляции списка обработанных лексем в программу на требуемом языке программирования.Delphi - сбориник статей
Автоматическое управление памятью
Автоматическое управление памятью есть один из сервисов, которые CLR обеспечивает во время управляемого исполнения. Сборка мусора управляет распределением и освобождением памяти. Это избавляет разработчика от необходимости писать соответствующий код. Автоматическое управление памятью решает типичные проблемы, такие как утечка памяти или попытка освободить уже уничтоженный объект.Когда инициируется новый процесс, для него резервируется непрерывное адресное пространство, называемое управляемой кучей. Управляемая куча поддерживает указатель на следующий распределяемый в памяти объект. Первоначально он указывает на базовый адрес управляемой кучи. Все типы указателей распределяются в управляемой кучи. Когда создается первый указатель, память для ассоциированного с ним типа начинается с базового адреса кучи. При создании следующего указателя, память выделяется непосредственно за первым. Пока адресное пространство доступно, процесс продолжается описанным образом.
Распределение в управляемой куче идет быстрее, чем в неуправляемой. CLR просто наращивает значение указателя кучи, что почти также быстро, как при заталкивании данных в стек. Кроме того, так как новые объекты распределяются в памяти последовательно, приложение обращается к ним быстрее.
Оптимизирующая машина сборщика мусора определяет наилучшее время для удаления мусора. В процессе очистки он удаляет из памяти объекты, которые более не используются приложением. Для этого он исследует корни приложений. Каждое приложение имеет набор корней. Каждый корень либо ссылается на объект в управляемой куче, либо содержит NIL. Корни включают указатели на глобальные и статические объекты, локальные переменные и ссылки на объектные параметры в стеке потока и регистрах процессора. Мусорщик имеет доступ к списку активных корней, которые управляются компилятором времени исполнения и CLR. Используя этот список, он проверяет корни и строит граф, который содержит все объекты, которые порождены от корня.
Объекты, которые не содержит граф, не порождены от корней приложения. Мусорщик удаляет эти объекты из памяти. При этом он оптимизирует состояние управляемой кучи и нужным образом корректирует указатели.
База данных без BDE
Сергей КривошеевИздательский Дом "КОМИЗДАТ"
Что есть жизнь Delphi-разработчика без Borland Database Engine aka BDE?
Полная зависимость от прихотей этого мощного, но при этом не лишенного недостатков механизма связи с базами данных с самого начала нравилась далеко не всем. Тем не менее, до последнего времени BDE была одним из наиболее распространенных механизмов доступа к данным из приложений, разработанных с использованием систем программирования от Borland.
Впрочем, альтернативы BDE существовали всегда. Многие программисты, работающие на Delphi, пошли своим путем. Так начали появляться всевозможные компоненты для работы с различными базами данных - настольными и серверными СУБД, текстовыми файлами, временными таблицами в памяти и т.п. Кроме того, в самой системе разработки Borland Delphi существуют альтернативы BDE, которые, однако, выбора не упрощают. На сегодня на палитре компонент Delphi 7.0 присутствуют следующие закладки, относящиеся к механизмам доступа к данным: dbExpress, BDE, ADO и Interbase.
Из числа перечисленных механизмов фирма Borland наиболее активно продвигает сегодня технологию dbExpress - не в последнюю очередь по той причине, что она предоставляет кроссплатформенную поддержку как для Delphi и C++ Builder под Windows, так и для Kylix под Linux. Следует учитывать также и тот факт, что с целью повышения скорости доступа к данным dbExpress переписана практически "с нуля". Однако на сегодняшний день вряд ли можно считать dbExpress безоговорочной преемницей BDE.
Delphi 7 Enterprise поставляется с драйверами dbExpress для работы с DB2, Informix, InterBase, MS SQL Server, MySQL и Oracle. Но для создания бесплатных приложений подходят только MySQL и FireBird (InterBase-совместимая СУБД, распространяемая по лицензии Open Source). Поэтому мы рассмотрим использование dbExpress для работы с СУБД MySQL.
Библиотека классов и пространства имен
Замечательной особенностью новой технологии является ее объектная ориентация. Вместе с CLR в рамках программного продукта .NET Framework (этот продукт свободно доступен на сайте http://www.microsoft.com/) поставляется обширная библиотека классов, которую должна использовать новая операционная система с рабочим названием Longhorn (выпуск намечен на 2005-2006 гг.) и все работающие под ее управлением программы.Классы в .NET Framework организованы в ветвящиеся иерархические структуры, которые называются пространствами имен. До технологии .NET практически все промышленные операционные системы (ОС) строились из крошечных "кирпичиков", которые назывались функциями API (Application Program Interface - интерфейс прикладных программ). Эти функции выполняли небольшие локальные задачи как для нужд самой ОС, так и для любой работающей под ее управлением программы. В системах с .NET Framework роль функций API играют объекты (экземпляры классов).
DbExpress и MySQL
Какие возможности связи со структурами данных из Delphi-проекта с помощью dbExpress существуют?Взглянув на список возможных значений свойства Connection компонента TSQLConnection, мы обнаружим там значение MySQLConnection. Кроме этого необходимо указать значение для свойства VendorLib - libMySQL.dll. Для корректной работы приложения нужно обеспечить обнаружение данного файла нашей программой. Для чего следует либо скопировать библиотеку в один из каталогов, где приложение будет искать файлы (например, WinNT\System32), либо внести в список таких каталогов c:\mysql\bin. Конечно, можно жестко задать путь к файлу библиотеки (MySQLConnection.VendorLib:= 'c:\mysql\bin\libmysql.dll') - но вряд ли это лучший вариант, хотя на этапе разработки и отладки сойдет.
Последним штрихом настройки компонента Connection является установка имени базы данных, с которой будет работать приложение. Не стоит забывать и о таких параметрах, как имя пользователя и пароль доступа к БД. В данном случае мы работаем под именем root, но в реальных проектах набор пользователей, естественно, будет иным.
Для доступа к таблицам, входящим в состав созданной нами базы данных testdbExpress (пока что это единственная таблица customer), можно воспользоваться компонентами TSQLTable, TSQLDataSet и TSQLQuery.
Создадим в качестве примера небольшое приложение для просмотра и модификации данных. Поскольку компоненты DataSet, входящие в состав dbExpress, предоставляют только возможность чтения данных read-only, то для полноценного доступа к хранящейся в таблице информации потребуются компоненты TSQLTable, TDataSetProvider, TClientDataSet и TDataSource. Ниже приведен фрагмент.dfm-файла с описанием тех свойств компонентов, которые следует изменить:
object SQLTableCustomer: TSQLTable … SQLConnection = SQLConnection TableName = 'customer' … end object dspCustomer: TDataSetProvider DataSet = SQLTableCustomer … end object cdsCustomer: TClientDataSet … ProviderName = 'dspCustomer' … end object dsCustomer: TDataSource DataSet = cdsCustomer … end
Одним из основных отличий dbExpress от BDE является необходимость использования компонентов DataSetProvider и ClientDataSet для взаимодействия компонентов доступа к данным dbExpress с компонентом DataSource и средствами визуализации информации (закладка Data Controls). Поначалу эта особенность может сбивать с толку, однако скоро вы к ней привыкнете и перестанете считать это неудобством.
Для оформления формы просмотра и редактирования данных из таблицы customer можно воспользоваться стандартными компонентами Delphi, расположенными на закладке Data Controls панели компонентов. Однако не следует забывать, что для реальной записи в таблицу базы данных MySQL необходимо явно вызвать метод компонента ClientDataSet.ApplyUpdates. Это можно сделать при обработке событий OnAfterPost и OnAfterDelete компонента cdsCustomer - а можно и по факту нажатия некоей кнопки (например, "Сохранить изменения"). Кроме того, обработчик события запроса на закрытие формы OnCloseQuery может проверять свойство cdsCustomer.ChangeCount на равенство нулю. При отрицательном результате приложению следует уточнять у пользователя, имеет ли он в виду завершение работы без сохранения изменений (что-нибудь типа: Application.MessageBox ('Сохранить изменения?', 'Внимание', mb_YESNOCANCEL or mb_ICONWARNING)). Ниже приводится пример применения ApllyUpdates:
procedure TMainForm.cdsCustomerAfterPostOrDelete (DataSet: TDataSet); begin (DataSet as TClientDataSet).ApplyUpdates (0) end; procedure TMainForm.FormCloseQuery (Sender: TObject; var CanClose: Boolean); var AnswId:Integer; begin CanClose:= True; if cdsCustomer.ChangeCount > 0 then begin AnswId:= Application.MessageBox ('Сохранить изменения?', 'Внимание', mb_YESNOCANCEL or mb_ICONWARNING); if AnswId = ID_CANCEL then CanClose:= False else if AnswId = ID_YES then cdsCustomer.ApplyUpdates (0); end; end;
Обратите внимание: такой подход позволяет без дополнительных усилий предоставить пользователю возможность принять решение о необходимости сохранения на сервере изменений, внесенных в БД. При использовании BDE это также возможно, однако требует намного больше усилий. В случае же с dbExpress для отмены изменений, внесенных в процессе работы, достаточно применить RevertRecord (для текущей записи) или метод ClientDataSet.UndoLastChange (для всей несохраненной информации). Правда, следует помнить, что при таком положении дел нельзя использовать метод ApplyUpdates в обработчике события OnAfterPost - это вызовет очистку буфера несохраненных изменений и запись данных в таблицу БД.
Delphi 6: первое знакомство
В. Ковалев,Ну вот наконец-то, в руках коробочка с диском и бумажкой, на которой кто-то старательно вывел фломастером Delphi 6. Из коробочки вынимается диск, вставляется в cd-rom и вот оно: чудо священнодействия начинается!
Нет, конечно, я не отношусь к разряду тех людей, для которых установка новой программы обрастает ритуальными плясками. Порой случается и так, что за день с компьютера навечно стираются две-три программы, а еще больше обретают свой дом - правда не известно на какой период времени. Такова уж судьба технического писателя - приходится бороться с программами не на жизнь, а на смерть.
Но тут совсем другой случай. Все-таки Delphi. Любимая всеми (или почти всеми) компания Borland вернула себе свое имя и представила на суд новое творение. Испокон веков повелось, что российские разработчики неравнодушны к "делфям". Уж не знаю, каким чудным образом это произошло, но это так. Конечно, находятся сторонники и других RAD-средств программирования, но Delphi пока надежно удерживает пальму первенства на пост-советском пространстве.
Ну ладно, не будем долго расстилаться маслом по бутерброду, перейдем к первым (и естественно наиболее ярким) впечатлениям от Delphi 6. Тут нелишни будет напомнить, в каких собственно вариантах поставки, распространяется сей продукт. Их три: Delphi 6 Personal, Delphi 6 Professional и Delphi 6 Enterprise. Естественно, "навороченность" увеличивается от пакета к пакету. Разумеется, "нормальный русский программист" спешит поставить себе Delphi 6 Enterprise. Я не исключение. Поэтому все, что будет сказано далее, имеет право на достоверность именно для этой версии.
На что я обратил внимание сразу же. На то, что Delphi теперь использует при инсталляции стандартный инсталлятор от Microsoft, отчего сам процесс установки теперь совершенно не отличим от установки Office 2000.
Те же самые возможности по установки на диск или загрузки компонентов продукта с cd-rom-а по мере необходимости. Стандарт Microsoft процветает.
Не долго думая, я выбрал все имеющиеся компоненты и стал смотреть как они слоями укладываются на жесткий диск. Тут не грех вспомнить и о минимальной конфигурации. Borland настаивает на следующем раскладе:
Intel Pentium 166 MHz (рекомендуется P2 400)
Microsoft Windows Me, 2000, 98 или NT 4.0 с установленным Service Pack 5+
64Mb RAM (рекомендуется 128Mb)
115Mb жесткого диска (compact install), 350Mb жесткого диска (full install)
Естественно лучше - больше, но если и будет чуть меньше - не велика беда. Если вы, конечно, не заняты сборкой достаточно большого проекта. А то придется курить перед компьютером. А курение - сами знаете - вредит здоровью и влияет на интеллект (вроде как).
Что же нового я увидел по сравнению с Delphi 5? Первым делом, конечно, полез в компоненты, что бы оценить насколько близко приблизилась Delphi к так называемой интеграции с интернетом и всего прочего, о чем так долго говорили. Шаг сделан достаточно внушительный (будем надеяться, что в нужном направление) и обеспечит не один месяц почесывания головы и разбора нововведений.
Итак, что же нового. Добавилось несколько новых, да некоторые из имеющихся в предыдущей версии "обросли" парой-другой компонентов. Например, на закладке Additional появились ValueListEditor, ColorBox, ActionManager, ActionMainMenuBar, ActionToolBar и CustomizeDlg. Следует отметить, что больше всего "пострадали" компоненты, связанные с базами данных и интернетом. Появились наборы WebServices, WebSnap, компоненты Indy, для работы с BDE выделен отдельный набор компонентов.
И так повсеместно. Borland постаралось, что бы при работе с Delphi не было необходимости навешивать среду разработки компонентами от третьих лиц. Вряд ли это будет возможно, но стремление безусловно хорошее.
Интерфейсных нововведений практически нет. Разве что, кроме кода проекта можно теперь на закладке Diagram попробовать себя в качестве художника.
Здесь можно выстроить алгоритм программы. Компоненты с Object TreeView переносятся в окно диаграммы, а здесь лишь остается указать необходимые связи.
Еще из приятного. В Delphi 6 используется средства Borland Translation Suite, позволяющего быстро переводить на различные языки сообщения и текстовые элементы интерфейса приложений. Очень удобно. Говорить о том, что на уровне кода, все, что сделано в Delphi 6 совместимо с Kylix-ом и не стоит. Знают все.
Конечно, рассказать о всех нововведениях в Delphi 6 мне не удастся. Для этого нужно писать целую книгу. И напоследок. После установки Delphi 6, имеющаяся на компьютере Delphi 5 не подала пока никаких признаков для беспокойства - достаточно крепко стоит на ногах и падать вроде как не собирается. Что, между прочим, добавляет еще одну ложку меда. О ложках дегтя - немного позже.
В. Ковалев / ©
Домены и сборки
Перед запуском приложения вы должны загрузить сборку в домен. Запуск типичного приложения вызывает загрузку различных сборок в программный домен. По умолчанию, CLR загружает сборку в домен, который содержит ссылку на нее. Таким образом, код и данные сборки изолируются от использующего его приложения.Если одна и та же сборка используется несколькими доменами, ее код (но не данные) могут разделяться доменами. Это уменьшает затраты памяти. Этот метод подобен разделению DLL. Сборка называется доменно-нейтральной, если ее код может разделяться другими доменами в одном процессе. CLR решает, будет ли сборка доменно-нейтральной.
Сборка не разделяется между доменами, если предоставляемые ею возможности нужны лишь одному домену.
Домены приложений
Исторически сложилось так, что параллельно запускаемые на одном компьютере программы всемерно изолированы друг от друга.Приложения изолируются прежде всего из-за того, что адресные указатели зависят от процесса. Указатель, переданный из одного приложения другому, никак не может использоваться в нем. Более того, вы не можете из одного процесса обратиться непосредственно к другому. Вместо этого вы должны использовать механизм представителей (proxy), которые реализуют косвенные вызовы, как это делается в СОМ (Component Object Model - компонентная модель объектов).
Домены приложений репализуют безопасный процесс, который позволяет CLR изолировать приложения. Вы можете запускать различные домены в рамках единственного процесса с уровнем изоляции, который существует между отдельными процессами, и не заботиться о перекрестных обращениях и переключениях. Возможность запуска множества приложений в едином процессе существенно увеличивает масштабируемость серверов.
Изоляция приложений важна также для безопасности программ. Например, вы можете запускать управления из Web-приложения в единственном процессе браузера так, что управления не будут иметь доступ к другим данным и ресурсам.
Изоляция, обеспечиваемая доменами приложений, имеет следующие преимущества.
Нельзя выгрузить сборку или тип, но можно - домен.
Две модели Windows-приложений
Несмотря на то, что Delphi теперь всего лишь один из языков, поддерживающих .NET, сама система программирования Delphi имеет богатую историю, и миллионы программистов до сих пор с удовольствием работают с ней. Учитывая это, разработчики Delphi обеспечили максимально возможную совместимость (пусть - мнимую, см. выше) новейшей версии с предыдущими.С этой целью они создали пространства имен Borland.VCL.XXXX, почти полностью имитирующие библиотеку компонентов VCL (Visual Component Library - библиотека визуальных компонентов) предыдущих версий. В эти пространства имен вошли VCL-классы, хорошо известные по предыдущим версиям - TApplication, TForm, TButton, TCheckBox и т. д. Символы ХХХХ в названиях пространств имен совпадают с именами соответствующих модулей VCL. Например, пространство имен Borland.VCL.DB содержит классы, определенные в модуле DB библиотеки VCL (клас-сы для работы с базами данных). Класс TForm определен в пространстве имен Borland.VCL.Forms, в этом же пространстве определен класс TApplication, класс TButton - в пространстве имен Borland.VCL.StdCtrls, в этом пространстве объявлен также класс TCheckBox и т. д.
Пространства имен Borland.VCL.XXXX являются прозрачными надстройками над пространствами имен классов, входящих в .NET Framework, но не закрывают их. Это означает, что вам доступны и классы .NET Framework. Чтобы создать Windows-приложение, базирующееся на классах .NET Framework, вы выбираете команду меню File > New > Windows Forms Application, для создания VCL-подобного приложения - команду File > New > VCL Forms Application.
FWS-компоненты для работы с базами данных без использования BDE
При всей своей эффективности технология dbExpress - далеко не универсальное средство, годящееся на все случаи жизни. В некоторых случаях использование стандартных решений от фирмы Borland может быть связано с рядом неудобств. Это обстоятельство является одним из основных побудительных мотивов движения FWS (FreeWare With Source, бесплатное ПО с открытым кодом). В интернете то и дело встречаются оригинальные и, главное, применимые на практике разработки. О двух из них мне и хотелось бы рассказать в рамках этого лирического отступления.Исполнение кода
CLR обеспечивает инфраструктуру, которая позволяет управлять процессом исполнения машинного кода, а также предоставляет различные службы, которые могут быть использованы во время исполнения. Перед вызовом метода он должен быть скомпилирован в машинные инструкции. Каждый метод, для которого есть CIL-код, должен вначале с помощью JIT-компилятора генерироваться в машинный и затем выполняться. Каждый следующий раз компилятор не вызывается, но используется созданный им код. Этот процесс повторяется до конца прогона.Во время выполнения управляемый код получает дополнительное обслуживание, такое как сборка мусора, повышенная защита, взаимодействие с неуправляемым кодом, поддержка межъязыковой отладки , улучшение распространения программ и версионного контроля.
Компилирование CIL в машинные инструкции
Перед выполнением кода CIL он должен быть преобразован с помощью JIT-компилятора в машинные инструкции. В процессе компиляции JIT-компилятор подсчитывает также те участки кода, которые могут никогда не вызываться. Компилятор преобразует CIL по мере надобности и вставляет заглушки на место вызова любого метода. При первом же вызове кода заглушка передается JIT-компилятору, который заменяет заглушку реальным кодом. Такого рода обращения к компилятору производятся непосредственно из реальных машинных инструкций, ранее сгенерированных компилятором, что повышает скорость исполнения программ.В ходе компиляции CIL-кода он передается верификационному процессу. Верификация проверяет код CIL и метаданные в поисках выхода из надежного кода. Надежность типов объектов есть надежность их изолирования от других объектов и надежность защиты их от ошибочного иди злонамеренного разрушения.
Во время верификации код проверяется на доступ к разрешенной памяти и вызов только правильно определенных методов. Например, не допускается обращение к полям, которые выходят за отведенные им границы. Дополнительно верификация проверяет правильность генерации машинного кода. Процесс верификации открывает доступ к правильно определенному надежному коду. Если встретился ненадежный код, возбуждается исключение.
Компилирование в промежуточный язык CIL
При создании управляемого кода компилятор языка программирования, поддерживающего .NET (Visual Basic .NET, C#, J#. а с появлением Delphi 8 еще и Delphi4 ) транслирует исходный код в набор машинно-независимых инструкций языка CIL.Замечание:
Синтаксис того или иного языка никак не влияет на CLR. Однако некоторые языки (C#, Delphi), не имеют существенных синтаксических ограничений и позволяют использовать практически все возможности CLR.
Эти инструкции могут затем легко переводиться в машинно-зависимые. CIL включает инструкции для загрузки, сохранения, инициализации объектов, вызова их методов, а также для логических и арифметических операций, управления потоками, прямого доступа к памяти, поддержки исключений и др. Перед выполнением программы инструкции CIL преобразуются JIT-компилятором CLR в машинно-зависимые инструкции процессора.
Одновременно с инструкциями CIL производятся также метаданные. Метаданные описывают типы вашего кода, в том числе содержат описание каждого типа, сигнатуры вызова методов объектов, ссылки на членов вашего кода и другие необходимые при выполнении данные. MSIL и метаданные содержатся в выполняемом файле формата РЕ, который основан на расширенной версии опубликованного формата MS PE и общего объектного файлового формата, использующегося исторически для выполняемых программ. Этот файловый формат, который объединяет CIL-код и метаданные, предоставляет операционной системе компьютера исполнения всю необходимую информацию для создания объектов CLR. Присутствие в CIL-кодах метаданных позволяет коду описывать самого себя и, таким образом, отказаться от библиотек типов и языка IDL (Interface Definition Language - язык описания интерфейсов). CLR находит и извлекает метаданные из РЕ-файла по мере надобности в ходе прогона.
Ловим баги или Почему программы допускают "недопустимые операции"
Е. Левшаков, В. Ковалев,Ошибки - неизбежное зло программирования. Видимо, пока трудно даже представить средство с помощью которого можно избавится от них. Человеку, который выдумает это чудодейственное лекарство, благодарные потомки-программисты, несомненно, воздвигнут памятник. Пока же остается лишь заниматься обычным делом: ловлей багов.
"Нарушение Доступа" - фраза, которую пользователи видят, когда приложение делает попытки обратиться к памяти, которая не обозначена для их использования - и как следствие происходит сбой в работе программы: Access violation at address
Ситуация, при которой Windows давала бы полную свободу программам - записывай данные куда хочешь, скорее всего бы привела к разноголосице программ и полной потери управления над компьютером. Но этого не происходит - Windows стоит на страже "границ памяти" и отслеживает недопустимые операции. Если сама она справиться с ними не в силах - происходит запуск утилиты Dr. Watson, которая записывает данные о возникшей ошибке, а сама программа закрывается.
Известно, что при программировании, особенно крупных программных продуктов, уследить за всеми процессами в коде невозможно, да и нет необходимости. Использование сторонних компонентов и библиотек только усложняет дело. Именно поэтому программисты Delphi порой и сталкиваются со "своенравными" программами, которые то и дело норовят "сбросить пользователя". Итак, давайте рассмотрим некоторые вопросы, связанные с корректной средой программирования, так и непосредственно проблемы написания кода, которые ведут к возникновению ошибок типа "ошибка доступа" (AVS) и очертим наиболее известные пути их исправления.
Мы можем поделить AVS, с которыми сталкиваются при разработке в Delphi, на два основных типах: ошибки при выполнения и некорректная разработка проекта, что вызывает ошибки при работе программы.
Ошибки возникают при старте и закрытии Delphi или формировании проекта. Причиной могут являться сбои в "железе" компьютера.
Эти ошибки могут быть вызваны различными источниками, включая систему BIOS, операционную систему или аппаратные подпрограммы драйверов. Некоторые видео-, звуковые или сетевые платы могут фактически вызывать подобного рода ошибки в Delphi. Для решения подобных аппаратных проблем можно предпринять последовательность неких "стандартных" ходов:
И в конце концов просто попытаться заменить драйвера на более свежие.
Но помимо чисто железных проблем - большую головную боль могут вызвать ошибки в работе программного обеспечения. Особенно это касается непосредственно операционной системы. Зачастую Windows терпит крах спонтанно. Вот рекомендации которые помогут вам создать более устойчивую среду программирования:
Хотя Windows 9X популярная система, разработку лучше проводить в Windows NT или Windows 2000 - это более устойчивые операционные системы. Естественно, при переходе на них придется отказаться от некоторых благ семейства Windows 95/98/Me - в частности, не все программы адаптированы для Windows NT/2000. Зато вы получите более надежную и стабильную систему.
Не забывайте о том, как важно всегда иметь под рукой свежие версии компонентов для Delphi и дополнительных библиотек. В отличие от Windows создатели данных пакетов стараются от версии к версии уменьшать количество ошибок.
Следите за тем, чтобы устанавливаемые компоненты были предназначены непосредственно для вашей версии Delphi. Попробуйте деинсталлировать чужеродные компоненты один за другим (или пакет за пакетом), пока проблема не будет устранена.
Контролируйте все программные продукты, установленные на вашей машине и деинсталлируйте те из них, которые сбоят. Фаворитами AV среди них являются шароварные утилиты и программы и бета версии программных продуктов.
Все вышеперечисленное в основном не касалось самого процесса программирования и в малой степени зависит от разработчика. Теперь же обратимся к теме, как не допустить при разработке программного продукта ситуации, при которой он сам будет являться причиной ошибки.
Вы могли бы рассмотреть компилирование вашего приложения с директивой {$D}, данная директива компилятора может создавать файлы карты (файлы с расширением map, которые можно найти в том же каталоге, что и файлы проекта), которые могут послужить большой справкой в локализации источника подобных ошибок. Для лучшего "контроля" за своим приложением компилируйте его с директивой {$D}. Таким образом, вы заставите Delphi генерировать информацию для отладки, которая может послужить подспорьем при выявление возникающих ошибок.
Следующая позиция в Project Options - Linker & Compiler позволяет вам, определить все для последующей отладки. Лучше всего, если помимо самого выполняемого кода будет доступна и отладочная информация - это поможет при поиске ошибок. Отладочная информация увеличивает размер файла и занимает дополнительную память при компилировании программ, но непосредственно на размер или быстродействие выполняемой программы не влияет. Включение опций отладочной информации и файла карты дают детальную информацию только если вы компилируете программу с директивой {$D+}.
Эта информация состоит из таблицы номеров строк для каждой процедуры, которая отображает адреса объектных кодов в номера строк исходного текста. Директива $D обычно используется совместно с другой директивой - $L, что позволяет или запрещает генерацию информации о локальных символах для отладки.
Таким образом вы без труда сможете найти точный адрес той подпрограммы, которая была ответственна за ошибку. Одна из наиболее общих причин ошибок выполнения - использование объекта, который еще не был создан. Если второй адрес при выдачи ошибки - FFFFFFF (или 0000000) Вы можете почти утверждать, что было обращение к объекту, который еще не был создан. Например, вызов метода формы, которая не была создана. procedure TfrMain.OnCreate(Sender: TObject); var BadForm: TBadForm; begin BadForm.Refresh; // причина ошибки end;
Попытаемся разобратся в этой ситуации. Предположим, что BadForm есть в списке "Available forms" в окне Project Options|Forms. В этом списке находятся формы, которые должны быть созданы и уничтожены вручную. В коде выше происходит вызов метода Refresh формы BadForm, что вызывает нарушение доступа, так как форма еще не была создана, т.е. для объекта формы не было выделено памяти.
Если вы установите "Stop on Delphi Exceptions" в Language Exceptions tab в окне Debugger Options, возможно возникновение сообщения об ошибке, которое покажет, что произошло ошибка типа EACCESSVIOLATION. EACCESSVIOLATION - класс исключение для недопустимых ошибок доступа к памяти. Вы будете видеть это сообщение при разработке вашего приложения, т.е. при работе приложения, которое было запущено из среды Delphi.
Следующее окно сообщения будет видеть пользователь - и программа будет закрыта при совершение недопустимой операции: Access violation at address 0043F193 in module 'Project1.exe' Read of address 000000.
Первое шестнадцатиричное число ('0043F193') - адрес ошибки во время выполнения программы. Выберите опцию меню 'Search|Find Error', введите адрес, в котором произошла ошибка ('0043F193') в диалоге и нажмите OK. Теперь Delphi перетранслирует ваш проект и покажет вам строку исходного текста, где произошла ошибка во время выполнения программы, то есть BadForm.Refresh.
Естественно, что списка наиболее общих причин ошибок, вызывающих аварийное завершение работы программы, написанной в Delphi, в чистом виде нет. Есть несколько общих "узких мест" в коде и структуре программы, когда подобная ошибка может произойти. Перечислим наиболее распространенные.
Недопустимый параметр API
Если вы пытаетесь передать недопустимый параметр в процедуру Win API, может произойти ошибка. Необходимо отслеживать все нововведения в API при выходе новых версий операционных систем и их обновлений.
Уничтожение исключения
Никогда не уничтожайте временный объект исключения. Обработка исключения автоматически уничтожает объект исключения. Если вы уничтожите объект самостоятельно, то приложение попытается уничтожать объект снова, и произойдет ошибка. Zero:=0; try dummy:= 10 / Zero; except on E: EZeroDivide do MessageDlg('Can not divide by zero!', mtError, [mbOK], 0); E.free. // причина ошибки end;
Индексация пустой строки
Пустая строка не имеет никаких достоверных данных. Следовательно, попытка индексировать пустую строку - подобно попытке обратиться к нулю, что приведет также к ошибке: var s: string; begin s:=''; s[1]:='a'; // причина ошибки end;
Обращение к динамической переменной
Вы должны строить обращение к динамической переменной корректно, иначе вы перемещаете адреса указателей и возможно разрушаете другие выделенные ячейки памяти. procedure TForm1.Button1Click(Sender: TObject); var p1 : pointer; p2 : pointer; begin GetMem(p1, 128); GetMem(p2, 128); {эта строка может быть причиной ошибки} Move(p1, p2, 128); {данная строка корректна } Move(p1^, p2^, 128); FreeMem(p1, 128); FreeMem(p2, 128); end;
Перечисленные подходы позволят избежать наиболее частых недочетов в разработке, которые могут вызвать столь неприятное как для пользователя, так и для разработчика сообщение о том, что программа выполнила "недопустимую операцию".
Удачной вам ловли багов, господа! Е. Левшаков, В. Ковалев / ©
Использованы материалы
наследник TDataSet, предназначенный для доступа
Этот компонент - наследник TDataSet, предназначенный для доступа к DBF-файлам без использования BDE. Демонстрационный проект радует глаз. Как говорится, простенько и со вкусом. Огорчает отсутствие файла помощи, нет даже комментариев в исходных текстах проекта. Но ведь сами-то тексты есть! Поэтому я все-таки решил исследовать данный компонент поглубже.Среди немногих свойств компонента TMDBFTable, доступных в режиме design-time, следует выделить MakeBackup, PackOnSave и ShowDeleted. Даже не искушенный в английском языке читатель без труда определит, какие функции они выполняют.
Увы, как показало тестирование, DBFTable не подходит для работы с таблицами, где число записей превышает 100 тыс. Последовательных приближений к тому количеству записей, при работе с которыми демо-приложение не "вываливается" с удручающим сообщением "Out of memory", я не делал - однако таблицу на 15 тыс. оно восприняло вполне спокойно. А все потому, что для загрузки информации из таблиц используется обычный TStringList.
Тут обнаружилось еще одно удручающее обстоятельство - вместо русских букв, на экране в качестве значений текстовых полей отображаются "крокозябры". Кроме того, DBFTable поддерживает отнюдь не любые dbf-файлы, как можно было бы предположить из его названия, а только с DBase-III или IV. Умиляют также закомментированные строки кода в описании компонента.
Последнее, что я занесу в "пассив" этой разработки: компонент не лишен "глюков", возникающих в design-time и в ходе работы приложений. Критичными их не назовешь, но помнить о них следует. Подозреваю, что кроме парочки выловленных мною есть и другие.
Все же использовать MiTeC DBFTable v.1.5 в реальных проектах) можно. Во-первых, DBFTable (как и предыдущий кандидат на звание альтернативы BDE) может послужить базой для дальнейших разработок. Во-вторых, начинающим программистам очень полезно будет изучить исходные тексты компонента. Уверен, они почерпнут оттуда много интересного. В-третьих, DBFTable, как-никак, рабочий компонент и вполне может подойти для определенного класса задач - например, для создания на диске пользователя временных файлов данных, для описания настроек приложения и т.п. А проблему с отображением русских букв вполне можно решить, внеся изменения в исходный код DBFTable.
И все-таки очень жаль, что нет файла помощи!
MySQL: краткая справка
MySQL представляет собой сейчас одну из наиболее распространенных СУБД с открытым кодом, она регламентируется лицензией GPL (GNU General Public License, http://www.gnu.org/ licenses/ licenses.html). В некоммерческих проектах MySQL можно использовать бесплатно. Однако при встраивании кода MySQL в коммерческие приложения следует приобрести коммерческую лицензионную версию.Первоначально MySQL разрабатывалась программистами-энтузиастами с целью усовершенствовать возможности использовавшегося в те время сервера mSQL. В дальнейшем компания MySQL AB, созданная для поддержки продукта, стала предоставлять широкую техническую поддержку пользователям MySQL - за счет чего эта компания существует и по сей день. На сайте MySQL AB, помимо исходных кодов и скомпилированных под различные платформы модулей самого сервера, выложено множество утилит, облегчающих жизнь разработчикам и администраторам этой СУБД.
MySQL обычно используется для решения не очень серьезных задач (ведение статистики, форумов и т.п.), однако существует опыт реализации на ее базе достаточно крупных проектов. MySQL доступна для работы в различных средах - как Windows, так и Linux. Она является приоритетным вариантом при выборе СУБД для хранения данных на большинстве веб-серверов. MySQL предоставляет многие возможности, характерные для реляционных СУБД, демонстрируя особенно высокую производительность при выполнении запросов на чтение данных. Кроме того, она поддерживает SQL, разработку клиент-серверных приложений и даже транзакции.
Новые возможности Delphi
Как уже отмечалось, записи не могут иметь вариантных частей, но могут - процедуры и функции. Это в какой-то степени сближает их с классами. Вот пример объявления:type MyRec = record a: Integer; procedure aProc; end; procedure MyRec.aProc; begin end; Несмотря на похожесть, записи, конечно, не классы - в них нет механизмов наследования и полиморфизма.
.NET позволяет интегрировать в единое целое код, написанный на разных языках, в которых используются, в общем случае, разные ключевые слова. Как быть, если в CTS определен класс, совпадающий с ключевым словом? В Delphi для этого можно использовать стандартный прием - составное имя. Например:
var T: System.Type; Однако "путь" к классу может быть достаточно длинным, и составное имя окажется громоздким. В этом случае Delphi разрешает перед именем класса ставить символ "&" (амперсанд):
var T: &Type; Встретив такое описание, компилятор станет просматривать список доступных модулей в поисках типа Type и найдет его в модуле System.
Существенным изменениям подверглось объявление класса. Дело в том, что Delphi и CLR по-разному трактуют области видимости секций private и protected: в Delphi члены, объявленные в этих секциях, видны всюду в пределах данного модуля. В CLR секция private объявляет члены, доступные только внутри методов класса, а секция protected - члены, доступные потомкам класса. В связи с этим, в Delphi перед названиями секций следует ставить спецификатор class - в этом случае области видимости в Delphi и CLR совпадут:
type MyClass = class class private a: Integer; // Поле видно только в методах класса MyClass class protected b: Boolean; // Поле видно только потомкам класса и //самому классу end; Классы можно лишить потомков, а виртуальный метод - возможности перекрытия. Для этого объявление класса сопровождается директивой sealed, а объявление метода - директивой final:
type NoInst = class public procedure NoOverride; dynamic; final; // Метод нельзя перекрыть end sealed; // Класс не может иметь потомков Приведенный выше пример лишь иллюстрирует синтаксис объявлений и по существу бессмыслен: если класс не имеет потомков, то ни один его метод не может быть перекрыт. Замечу, что следующее объявление ошибочно:
procedure NoOverride; final; Можно лишить возможности перекрывать только виртуальные методы, то есть объявленные с директивами dynamic, virtual или override.
Общеязыковая инфраструктура
Общеязыковая инфраструктура CLI (Common Language Infrastructure) - это набор перечисленных ниже спецификаций, определяющих различные аспекты технологии .NET.Общеязыковая среда исполнения
Общеязыковая среда исполнения (CLR) играет ключевую роль во всей технологии. Она поддерживает строгую систему правил и соглашений, которым должен следовать промежуточный язык. Этот язык представляет собой код, который называется управляемым. Важнейшим свойством CLR является то обстоятельство, что входной поток данных может представлять собой и неуправляемый код, а также управляемый и неуправляемый одновременно! Неуправляемые участки входных данных являются обычными машинными инструкциями, которые без изменений поступают в процессор. Указателем на то, что входной поток содержит управляемый код, является специальный бит в заголовке файла.Управляемый код в общем случае порождает объекты с управляемым временем жизни. Такие объекты автоматически уничтожаются, когда надобность в них исчезает (например, завершает работу создавшая их программа). Таким образом, одной их замечательных способностей CLR является встроенная в нее борьба с утечкой памяти3.
Для создания объектов с управляемым временем жизни в управляемый код помещаются также метаданные, которые содержат подробные инструкции о порождаемых объектах, их свойствах, методах и событиях. Управляемый код перед запуском должен пройти процесс верификации (если только администратор не разрешил его пропустить). Процесс верификации определяет, будет ли код пытаться получить доступ к неправильным адресам памяти или производить другие неверные действия. Код, удовлетворяющий верификации, называется надежным (safe). Возможность верификации позволяет CLR обеспечивать высокий уровень изолированности объектов при минимальном снижении производительности. CLR использует метаданные, чтобы найти и загрузить классы, поместить их экземпляры в память, разрешить вызов программ, генерировать машинные инструкции, усиливать безопасность и устанавливать динамические контекстные границы.
CLR облегчает разработку компонентов и программ, объекты которых взаимодействуют с помощью языка. Объекты, написанные на разных языках, могут взаимодействовать друг с другом, и их поведение может быть тесно связанным. Например, вы можете определить класс и его потомка на разных языках или вызвать метод класса, написанного на другом языке. Межъязыковое взаимодействие возможно потому, что языковые компиляторы и инструменты целевой машины используют общую систему типов, определенную в CLI, и они следуют общим правилам для определения новых типов, а также их создания, использования, снабжения данными и связывания типов.
В отличие от обычных компиляторов,
2 Август, 17:53 (19)
2 Август, 17:51 (34)
2 Август, 15:40 (42)
2 Август, 15:35 (1)
2 Август, 14:54 (3)
2 Август, 14:34 (3)
2 Август, 14:15 (2)
2 Август, 13:34 (7)
2 Август, 13:04 (3)
2 Август, 12:28
Море работы для программистов, сисадминов, вебмастеров.
Иди и выбирай!
|
|
| IT-консалтинг | Software Engineering | Программирование | СУБД | Безопасность | Internet | Сети | Операционные системы | Hardware |
| PR-акции, размещение рекламы — , тел. +7 495 6608306, ICQ 232284597 | Пресс-релизы — |
|
|
|
| This Web server launched on February 24, 1997 Copyright © 1997-2000 CIT, © 2001-2009 |
|
|
| Внимание! Любой из материалов, опубликованных на этом сервере, не может быть воспроизведен в какой бы то ни было форме и какими бы то ни было средствами без письменного разрешения владельцев авторских прав. |
|
Для Вас: с гибкой системой скидок. |
Работа с базами данных
Отличительной особенностью системы программирования Delphi была и остается встроенная в нее возможность работы с различными промышленными базами данных (БД). Добрая треть компонентов VCL в Delphi 7 в той или иной степени связаны с созданием приложений для работы с БД.В .NET Framework встроена архитектура ADO.NET, решающая аналогичные задачи. Упрощенная схема этой архитектуры показана на рис.1.1.
Рис. 1.1. Архитектура ADO.NET На этой схеме Источник данных - физическая БД или XML-файл с данными. Провайдер данных обеспечивает связь с Источником данных и передает ему команды. Набор данных предназначен для отображения данных. С любым источником данных (ИД) могут быть связаны один или несколько наборов данных (НД) и наоборот - единственный НД может отображать данные из нескольких ИД.
Провайдер данных, входящий в архитектуру ADO.NET, обеспечивает взаимодействие наборов данных с такими ИД, как MS SQL Server, OLE DB и Oracle. В Delphi 8 можно использовать также провайдер BDP.NET (Borland Database Provider for .NET - провайдер баз данных корпорации Borland для .NET), который обеспечивает взаимодействие с серверами DB2, Oracle и InterBase. Дублирование в BDP.NET связи с промышленным сервером Oracle не случайно: корпорации Borland и Oracle связывает многолетнее плодотворное сотрудничество5. По оценкам разработчиков Delphi, управление сервером Oracle с помощью BDP.NET дает определенные преимущества по сравнению с управлением через провайдер ADO.NET.
Наличие BDP.NET не ограничивает новаторского подхода разработчиков Delphi к интеграции с технологией .NET Framework. Связано это с тем, что изначально Delphi тяготела к приложениям для работы с БД в значительно большей степени, чем разработанная в Microsoft технология ADO (Active Data Object - активный объект данных), которая и легла в основу ADO.NET. Delphi 7, например, поддерживала такие технологии, как BDE (Borland Database Engine - машина баз данных корпорации Borland; обеспечивала доступ к файл-серверным БД на таблицах Paradox, dBASE и т. п.), dbExpress (набор скоростных драйверов для непосредственного доступа к некоторым промышленным серверам, в том числе - к MySQL), IBX (доступ к серверу InterBase на уровне его API-функций), DataSnap (разработка многозвенных СУБД) и ряд других.
Delphi 8 определяет естественную миграцию этих технологий в новую среду. Для этого в ее состав включены такие дополнительные технологии:
Работа с директориями (папками) в Дельфи
, ()В этой статье я постараюсь познакомить Вас с некоторыми стандартными функциями для работы с директориями. И еще приведу несколько пользовательских функций и примеры их использования. Также рассмотрен вопрос вызова диалога выбора директории.
Для начала начнем с простой функции для создания новой папки. Общий вид функции такой:
function CreateDir(const Dir: string): Boolean;
То есть если папка успешно создана функция возвращает true. Сразу же простой пример ее использования:
procedure TForm1.Button1Click(Sender: TObject);
begin
if createdir('c:\TestDir') = true then
showmessage('Директория успешно создана')
else
showmessage('При создании директории произошла ошибка');
end;
При нажатии на кнопку программа пытается создать папку с именем TestDir на диске C: и если попытка увенчалась успехом, то выводится соответствующее сообщение. Следует отметить, что если вы не указываете имя диска, на котором хотите создавать папку, то функция будет создавать папку в той же директории, где находится сама программа.
Объявления
createdir(edit1.text);
и
createdir(extractfilepath(paramstr(0))+edit1.text);
приведут к одному и тому же результату.
Теперь рассмотрим функцию для удаления папок. Ее объявление выглядит так:
function RemoveDir(const Dir: string): Boolean;
Сразу же хочу предупредить, что данная функция способна удалять только пустые папки, и если там что-нибудь будет, то произойдет ошибка! Но выход есть!!! Здесь нам на помощь придет пользовательская функция с простым названием MyRemoveDir. Вот описание функции:
Function MyRemoveDir(sDir : String) : Boolean;
var
iIndex : Integer;
SearchRec : TSearchRec;
sFileName : String;
begin
Result := False;
sDir := sDir + '\*.*';
iIndex := FindFirst(sDir, faAnyFile, SearchRec);
while iIndex = 0 do begin
sFileName := ExtractFileDir(sDir)+'\'+SearchRec.Name;
if SearchRec.Attr = faDirectory then begin
if (SearchRec.Name <> '' ) and
(SearchRec.Name <> '.') and
(SearchRec.Name <> '..') then
MyRemoveDir(sFileName);
end else begin
if SearchRec.Attr <> faArchive then
FileSetAttr(sFileName, faArchive);
if NOT DeleteFile(sFileName) then
ShowMessage('Could NOT delete ' + sFileName);
end;
iIndex := FindNext(SearchRec);
end;
FindClose(SearchRec);
RemoveDir(ExtractFileDir(sDir));
Result := True
end;
Копируете это все в Вашу программу, а затем эту функцию можно вызвать например так:
if NOT MyRemoveDir('C:\TestDir') then
ShowMessage('Не могу удалить эту директорию');
Теперь маленько отстранимся от непосредственной работы с папками и рассмотрим волнующий многих вопрос. Как вызвать диалог выбора папки (как при установке программ)?? ПРОСТО!!!
Подключаем в uses модуль Filectrl.pas (то есть uses FileCtrl;). Теперь ставим на форму еще кнопочку (чтобы не путаться :) и пишем такой код:
procedure TForm1.Button3Click(Sender: TObject);
const
SELDIRHELP = 1000;
var
Dir: string;
begin
Dir := 'C:\windows';
if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],SELDIRHELP) then
Caption := Dir;
end;
При выборе директории в заголовке формы отобразиться ее название!
Теперь рассмотрим следующую процедуру. К примеру Вам надо создать папку Dir1 по адресу: C:\MyDir\Test\Dir1, но при этом папок MyDir и Test на Вашем компьютере не существует. Функция CreateDir здесь не сработает, поэтому воспользуемся процедурой ForceDirectories. Ее общий вид таков:
procedure ForceDirectories(Dir: string);
Пример ее использования (как всегда я поставил на форму новую кнопку, а там написал)
procedure TForm1.Button4Click(Sender: TObject);
var
Dir: string;
begin
Dir := 'C:\MyDir\Test\Dir1';
ForceDirectories(Dir);
end;
Ну и напоследок приведу функцию для проверки: существует ли директория или нет. Ее общий вид такой:
function DirectoryExists(Name: string): Boolean;
Если директория указанная в параметре Name существует - то функция возвратит true.
Надеюсь, что помог Вам описанием данных функций и процедур. Сразу хочется дать совет: почаще заглядывайте в HELP, там много интересной и полезной информации!
(С) Автор статьи: // (). При использовании этого материала ссылка на автора и источник информации обязательна!!!
Удачи в программировании...
Работа с Интернет
Работа с Интернет никогда не была в Delphi столь же эффективной, как работа с БД. И хотя уже в Delphi 2 была вкладка Internet (компоненты FTP, HTML, POP и т. д.) поддержке Интернет в Delphi всегда не хватало некоторой системности. Даже многочисленные компоненты Indy в Delphi 7 годятся лишь на то, чтобы создать "самопальный" Outlook Express или скромный Web-браузер. В то же время в Microsoft разработали технологию ASP (Active Server Pages - активные страницы сервера), которая во многом упрощала актуальную ныне задачу создания интерактивных Web-сайтов (например, для электронной торговли товарами и услугами)6 . Технология ASP вошла в .NET Framework в виде ASP.NET и в полной мере доступна в Delphi 8. Для использования технологии ASP.NET на хостинге (то есть на машине, на которой развернут сайт) должен функционировать сервер Microsoft IIS (Internet Information Server - информационный сервер для Интернет корпорации Microsoft), а сам хостинг работать под управлением Windows 2000/ХР.Основой технологии являются компоненты Web-страниц, на которых размещаются серверные управляющие компоненты и HTML-текст. Страницы содержат внутренний код, обеспечивающий логику работы, и поддерживаются скомпилированными DLL. Когда пользователь впервые обращается к активной странице, ASP.NET автоматически создает и компилирует DLL, которая в конечном счете передает пользователю HTML-код. Этот код способен исполняться в браузере клиента. В результате значительная часть работы по взаимодействию клиента с сервером выполняется на машине клиента, что повышает пропускную способность хостинга.
Активные страницы помимо HTML-текста могут содержать различные серверные элементы управления, например, обеспечивающие необходимую идентификацию пользователя, а также специализированные компоненты, такие как календарь, решетка с данными, навигатор, списки и т. п.
Внутри .NET Framework активные страницы получают доступ к данным через ADO.NET c "родным" провайдером или BDP.NET.
Сборки
Сборки - фундаментальные части программирования с .NET Framework. Сборка выполняет перечисленные ниже функции.Сборки могут быть статическими и динамическими. Статические сборки включают типы .NET Framework (интерфейсы и классы), а также нужные ресурсы. Статические сборки сохраняются на диске в виде РЕ-файлов. Вы можете использовать .NET Framework для создания динамических сборок, которые не сохраняются на диске и создаются (и запускаются) непосредственно в памяти. После выполнения динамическую сборку можно сохранить на диске.
Сборки созданы для упрощения распространения программ и для решения проблем версионного контроля, которые возникают в приложениях, основанных на компонентах.
В платформах Win32 возникают две проблемы совместимости версии.
Windows 2000 (ХР) частично решает проблему с помощью двух приемов.
Создание сводного отчета в Excel
Владимир Федченко,В списке обсуждаемых тем на Круглом столе Королевства Delphi часто возникает вопрос о построении сводных таблиц. Сводная таблица представляет собой очень удобный инструмент для отображения и анализа данных, возвращаемых запросом к базе данных. Можно, конечно, для этой цели использовать различные пакеты для построения отчетов (вроде FastReport). Но с генераторами отчетов возникает масса вопросов (отсутствие каких либо библиотек, проблемы с экспортом, отсутствие необходимой документации и т.д.). А начальник требует выдать ему отчет приблизительно такого вида: чтобы были видны все продажи, по всем сотрудникам, по всем регионам, по всем товарам за указанный период времени (скажем, за два года), но денег на покупку генератора отчетов не дает. А как бы было хорошо выдать что-нибудь типа вот такой формы:
Что тут остается делать. Варианта только два: либо пытаться создавать что-то свое, либо увольняться. Альтернативное решение проблемы предоставлено фирмой Microsoft уже очень давно. Называется оно PivotTable (Сводная таблица) и доступно в меню "Данные" приложения Excel. Осталось только научиться пользоваться этой возможностью. Для этого нам понадобиться:WB:_WorkBook;//рабочая книга WS:_WorkSheet;//лист Excel куда помещается сводная таблица PC:PivotCache;//кеш для данных сводной таблицы PT:PivotTable;//собственно сама сводная таблица i:byte; Отключим реакцию Excel на события (для ускорения работы): XLS.EnableEvents:=False; После предварительной подготовки создаем сводный отчет. Для этого необходимо создать кэш для хранения данных: PC:=WB.PivotCaches.Add(xlExternal,emptyparam) Этот метод имеет два параметра SourceType и SourceData. Но так как мы используем внешние данные (SourceType = xlExternal), то второй параметр нужно оставить пустым. Кэш создан, но не подключен к источнику данных. Надо восполнить этот пробел. Укажем строку подключения, тип подключения и зададим сам запрос:
PC.Connection:=Format('OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%snorthwind.mdb', [ExtractFilePath(ParamStr(0))]); В строке подключения указываем, что база данных находится в одном каталоге с проектом. PC.CommandType:=xlCmdSQL; PC.CommandText:='select salesperson, country, city, productname,'+ 'orderdate, year(orderdate) as yy, month (orderdate) as mm, '+ 'quantity, extendedPrice from invoices'; Данные определены и находятся практически в боевой готовности. Попытаемся их визуализировать. Как говорилось выше, визуализировать будем в PivotTable. Для начала создадим сводную таблицу, привязав ее к кэшу с данными, и получим ссылку на интерфейс. Делается это все очень элегантно:
PT:=PC.CreatePivotTable(WS.Range['A3',emptyparam], 'PivotTable1',emptyparam,xlPivotTableVersionCurrent). Три заданных параметра означают следующее: ячейка в которую поместим сводную таблицу, имя сводной таблицы и версия сводной таблицы (зависит от установленной версии M$ Office, в данном случае установлена текущая версия). Пустой параметр называется ReadData. Он указывает на то, читать ли в кэш все данные из внешнего источника (нам это не надо). Вот шаблон и готов. Но что такое шаблон без данных?
В сводной таблице существует несколько типов полей данных: поля колонок, поля строк, поля данных, поля страниц (в данной статье не рассматриваются).
Надо их разместить. Начнем с полей (колонок) таблицы. Тут стоит оговориться, что Excel имеет ограничения на количество полей на одном листе (255). Поскольку данные берутся из базы за период в три года, то количество полей будет существенно больше этого ограничения. Отсюда ясно, почему в запросе был выделен год и месяц. Наши данные будут группироваться сначала по году, затем - по месяцу, затем - по дате. Для того чтобы не возникло ошибки в связи в вышеуказанным ограничением будем прятать детализацию для каждого уровня группировки в цикле по всем полям детализации (кроме последнего, т.к. детализация по нему не предусмотрена):
with (PT.PivotFields('yy') as PivotField) do begin Caption:='Год'; Orientation:=xlColumnField; for i:=1 to PivotItems(emptyparam).Count do PivotItems(i).ShowDetail:=False; end; with (PT.PivotFields('mm') as PivotField) do begin Caption:='Месяц'; Orientation:=xlColumnField; for i:=1 to PivotItems(emptyparam).Count do PivotItems(i).ShowDetail:=False; end; with (PT.PivotFields('orderdate') as PivotField) do begin Caption:='Дата'; Orientation:=xlColumnField; end; Аналогично заполним строки. В них ограничения составляют 65535 записей на лист. По этой причине можно не сворачивать детализацию:
with (PT.PivotFields('salesperson') as PivotField) do begin Caption:='Сотрудник'; Orientation:=xlRowField; end; with (PT.PivotFields('country') as PivotField) do begin Caption:='Страна'; Orientation:=xlRowField; end; with (PT.PivotFields('city') as PivotField) do begin Caption:='Город'; Orientation:=xlRowField; end; with (PT.PivotFields('productname') as PivotField) do begin Caption:='Товар'; Orientation:=xlRowField; end; Осталось поместить сами данные в отчет: PT.AddDataField(PT.PivotFields('quantity'),'Кол-во',xlSum); with PT.AddDataField(PT.PivotFields('extendedPrice'),'Продано на сумму',xlSum) do begin //слегка отформатируем вывод суммы на экран if not XLS.UseSystemSeparators then NumberFormat:='#'+XLS.ThousandsSeparator+'##0'+XLS.DecimalSeparator+'00' else NumberFormat:='#'+ThousandSeparator+'##0'+DecimalSeparator+'00'; end; Ну и наконец, вернем к жизни сам Excel. PT.ManualUpdate:=True; Вот, собственно, и все. Осталось нажать кнопочку F9, немного подождать и порадовать начальника новой формой отчета. Пусть сидит и забавляется. Стоит отметить, что данный отчет абсолютно независим от данных из БД, т.к. все, что вернул запрос, храниться в самой книге Excel. Отчет можно отправить по сети, по электронной почте или перенести любым доступным способом. Сворачивать/разворачивать детализацию по дате можно двойным кликом по данным колонки/строки (только не по серым кнопочкам с заголовками полей). Нажатие на заголовок поля приводит к появлению фильтра по данным выбранной колонки/строки. Ниже приведен код на C# (перевод с Delphi сделал Shabal, за что ему большое спасибо):
using System; using System.Collections.Generic; using System.ComponentModel; using System.Data; using System.Drawing; using System.Text; using System.Windows.Forms; using System.Threading; using System.Globalization; using Excel = Microsoft.Office.Interop.Excel; namespace WinApp1 { public partial class Form1 : Form { public Form1() { InitializeComponent(); } private void button1_Click(object sender, EventArgs e) { const string cmdSelect = "select OrderDate, Year(OrderDate) as yy,\n" + "Month(OrderDate) as mm, Country, City, ProductName,\n" + "SalesPerson, Quantity, ExtendedPrice from Invoices"; Excel.PivotCache pivotCashe; Excel.PivotTable pivotTable; Excel.PivotField pivotField; Excel.Worksheet oSheet; Excel.Application xlApp = new Excel.Application(); string dataSource = Application.StartupPath + @"\..\..\Northwind.mdb"; button1.Enabled = false; label1.Visible = true; try { xlApp.Workbooks.Add(Type.Missing); xlApp.Visible = true; xlApp.Interactive = false; xlApp.EnableEvents = false; oSheet = (Excel.Worksheet)xlApp.ActiveSheet; oSheet.get_Range("A1", Type.Missing).Value2 = "Сводный отчет"; oSheet.get_Range("A1", Type.Missing).Font.Size = 12; oSheet.get_Range("A1", Type.Missing).Font.Bold = true; oSheet.get_Range("A1", Type.Missing).Font.Italic = true; oSheet.get_Range("A1", Type.Missing).Font.Underline = true; // создаем запрос pivotCashe = ((Excel.PivotCaches)xlApp.ActiveWorkbook.PivotCaches()). Add(Excel.XlPivotTableSourceType.xlExternal, Type.Missing); pivotCashe.Connection = string.Format("OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0}", dataSource); pivotCashe.CommandType = Microsoft.Office.Interop.Excel.XlCmdType.xlCmdSql; pivotCashe.CommandText = cmdSelect; // создаем сводную таблицу на основе запроса (пока без полей) pivotTable = pivotCashe.CreatePivotTable(oSheet.get_Range("A3", Type.Missing), "MyPivotTable1", Type.Missing, Excel.XlPivotTableVersionList.xlPivotTableVersionCurrent); pivotTable.DisplayImmediateItems = false; pivotTable.EnableDrilldown = true; pivotTable.ManualUpdate = true; // настраиваем поля // поля колонок pivotField = (Excel.PivotField)pivotTable.PivotFields("yy"); pivotField.Orientation = Microsoft.Office.Interop.Excel.XlPivotFieldOrientation.xlColumnField; pivotField.Caption = "Год"; // сворачиваем данные по годам, чтобы влезли все данные for (int i = 1; i <= ((Excel.PivotItems)pivotField.PivotItems(Type.Missing)).Count; i++) { ((Excel.PivotItem)pivotField.PivotItems(i)).ShowDetail = false; } pivotField = (Excel.PivotField)pivotTable.PivotFields("mm"); pivotField.Orientation = Microsoft.Office.Interop.Excel.XlPivotFieldOrientation.xlColumnField; // сворачиваем данные по месяцам, чтобы влезли все данные for (int i = 1; i <= ((Excel.PivotItems)pivotField.PivotItems(Type.Missing)).Count; i++) { ((Excel.PivotItem)pivotField.PivotItems(i)).ShowDetail = false; } pivotField.Caption = "Месяц"; pivotField = (Excel.PivotField)pivotTable.PivotFields("OrderDate"); pivotField.Orientation = Microsoft.Office.Interop.Excel.XlPivotFieldOrientation.xlColumnField; pivotField.Caption = "Дата заказа"; // поля строк pivotField = (Excel.PivotField)pivotTable.PivotFields("SalesPerson"); pivotField.Orientation = Microsoft.Office.Interop.Excel.XlPivotFieldOrientation.xlRowField; pivotField.Caption = "Продавец"; pivotField = (Excel.PivotField)pivotTable.PivotFields("Country"); pivotField.Orientation = Microsoft.Office.Interop.Excel.XlPivotFieldOrientation.xlRowField; pivotField.Caption = "Страна"; pivotField = (Excel.PivotField)pivotTable.PivotFields("City"); pivotField.Orientation = Microsoft.Office.Interop.Excel.XlPivotFieldOrientation.xlRowField; pivotField.Caption = "Город"; pivotField = (Excel.PivotField)pivotTable.PivotFields("ProductName"); pivotField.Orientation = Microsoft.Office.Interop.Excel.XlPivotFieldOrientation.xlRowField; pivotField.Caption = "Изделие"; // // поля данных pivotField = pivotTable.AddDataField(pivotTable.PivotFields("Quantity"), "Кол-во", Microsoft.Office.Interop.Excel.XlConsolidationFunction.xlSum); //pivotField.Function = Microsoft.Office.Interop.Excel.XlConsolidationFunction.xlSum; // возможна персональная настройка формата вывода данных (не забываем о "культуре") // pivotField = pivotTable.AddDataField(pivotTable.PivotFields("ExtendedPrice"), "Сумма продаж", Microsoft.Office.Interop.Excel.XlConsolidationFunction.xlSum); // настроим "культуру" на англ., чтоб не зависить от локальных настроек int savedCult = Thread.CurrentThread.CurrentCulture.LCID; Thread.CurrentThread.CurrentCulture = new CultureInfo(0x0409, false); Thread.CurrentThread.CurrentUICulture = new CultureInfo(0x0409, false); try { // установим "американский" формат данных pivotField.NumberFormat = "#,##0.00"; // возможно задать формат сразу всей области даных! //pivotTable.DataBodyRange.NumberFormat = "#,##0.00"; } finally { // восстановим пользовательскую "культуру" для отображения всех данных в // привычных глазу форматах Thread.CurrentThread.CurrentCulture = new CultureInfo(savedCult, true); Thread.CurrentThread.CurrentUICulture = new CultureInfo(savedCult, true); } // убираем спиcок полей с экрана xlApp.ActiveWorkbook.ShowPivotTableFieldList = !(pivotTable.Version == Microsoft.Office.Interop.Excel.XlPivotTableVersionList.xlPivotTableVersion10); // рассчитаем таблицу pivotTable.ManualUpdate = false; xlApp.ActiveWorkbook.Saved = true; } finally { // отсоединяемся от Excel'я pivotField = null; pivotTable = null; pivotCashe = null; oSheet = null; xlApp.Interactive = true; xlApp.ScreenUpdating = true; xlApp.UserControl = true; xlApp = null; button1.Enabled = true; label1.Visible = false; } } private void Form1_FormClosing(object sender, FormClosingEventArgs e) { e.Cancel = !button1.Enabled; } } } Статья показывает лишь небольшие возможности Сводного отчета. Незатронутыми остались вопросы по созданию расчетных полей, сводных диаграмм и т.д.
Проект создавался и тестировался на Delphi 7, BDS 2006 и Excel2003. Исходные тексты программы на Delphi, база данных и пример отчета находятся в архиве PivotTable.zip. Исходные тексты на C# (VS2005) и база данных находятся в архиве WinApp1.zip. Более детальную информацию можно получить из файла vbaxl9.chm для Microsoft Excel 2000 или vbaxl10.chm для Microsoft Excel 2002, или с сайтов:
К материалу прилагаются файлы:
Создание Web-приложений в среде Delphi
В. Ковалев,Эпоха web-дизайна, когда наиважнейшим считалось возможность запихнуть на страницу как можно больше графики и поразить пользователя широтой фантазии дизайнера, канула в лету. В моде - информационный дизайн и всяческие удобности для пользователя. Плохим тоном уже считается одно только то, что на сайте нет форума или гостевой книги, и самое ужасное - о, боже - вы до сих пор верстаете каждую страницу вручную, вместо того, что бы поручить сеё скучное и утомительное занятие скрипту.
Время первопроходцев HTML в скором времени закончится и вовсе, и их место займут профессионалы-программисты. Именно программисты, ибо уже в большей степени от их умения создать удобный в использование сайт зависит его успех. Кроме прочего, теперь сайты создают совсем уж как программные продукты: тем кто занят наполнением содержанием, уже может не опасаться запутаться в html, java, cgi и прочих ипостасях интернет-технологий - администрирование сайта становится таким же привычным и удобным, как работа с текстовыми процессорами. Пока, правда, ощущается явный недостаток законченных продуктов, на плечи которых можно было бы возложить все функции по поддержанию сайта в актуальном состоянии, оставив себе лишь вопросы по наполнению его содержанием.
Пока же тяжкое бремя по созданию данных систем, на основе которых будет функционировать сайт, ложится на плечи программистов, только вот-вот успевших изумится возможностями языка Perl или Java. И многие из них, сказать без преувеличения, вышли, словно из гоголевской "Шинели", из Delphi. Действительно, данная среда разработчика, предоставляющая удобный интерфейс для визуального программирования и широкие возможности Object Pascal, столь мила сердцу российских программистов.
Но, похоже, что времена меняются, и Delphi из среды создания обычных настольных приложений, может сгодиться и в другом плане: для написания прикладных web-программ. И действительно, что может быть лучше: уже знакомая среда разработки, вдоль и поперек изученный язык, да и достаточно широкий круг специалистов по программированию в Delphi - это ли не плюсы создания web-приложений на Delphi. Есть конечно и минусы: созданные программы вряд ли смогут удовлетворить тех, кто считает, что лучший web-сервер, это сервер не от Microsoft. Но что поделаешь - версия Delphi под Unix отложена пока до лучших времен. Зато посудите сами: перенос программ в будущем светлом будущем можно будет совершить с малой кровью.
Но отложим пока теорию в сторону, и обратимся к практике. Итак, создание web-приложения в среде Delphi, что называется шаг за шагом.
Пример из учебника
В отличие от прочих аспектов создания приложений в Delphi, о создании приложений для web написано мало. Так ужасающе мало, что из книги в книгу, из учебника в учебник путешествует один и тот же пример. Не будем оригинальничать и мы - чем проще, тем лучше.
Вообще, простейшее web-приложение на Delphi мало чем отличается, а точнее ничем не отличается от создания программы для старой доброй DOS. Это - простейшее консольное приложение, запускаемое на стороне сервера и взаимодействующие с пользователем (в случае необходимости) через броузер.
Создайте в Delphi новый проект - ту самую уже давно забытую всем Console Application. Вы получите знакомый со школьной скамьи, текст обычной паскалевской программы: program primer; {$APPTYPE CONSOLE} uses SysUtils; begin // Insert user code here end.
Далее еще проще. Организуем вывод кода HTML с помощью команды writeln.
writeln ('CONTENT-TYPE: TEXT/HTML'); writeln; writeln (''); writeln (' '); writeln (''); writeln ('
Обратите внимание на строку CONTENT-TYPE: TEXT/HTML, которая определяет описание последующего содержимого, а именно кода HTML. После CONTENT-TYPE: TEXT/HTML, необходимо вывести пустую строку иначе броузер может выдать сообщение об ошибке.
Теперь, когда приложение закончено, осталось его скомпилировать и проверить. Для проверки работоспособности программы вам понадобиться веб-сервер. Можно особо не утруждаться, подойдет любой, даже стандартный домашний веб-сервер от Microsoft. Приложение надо будет разместить в папке публикаций сервера (обычно это - C:\Inetpub\ wwwroot) и запустить сам сервер. Теперь, если вы перейдете по адресу http://localhost/primer.exe в броузере, вы должны увидеть результат действия данной программы - строку Hello, world! Вот и всё, простейшее web-приложение на Delphi готово.
Передача параметров
На самом деле нам бы вряд ли понадобилось Delphi, для создания подобных программ. Конечно, можно генерировать страницы исходя из различных условий, но вопрос в том, как данные условия передать программе. И здесь оказывается не всё так сложно, достаточно вспомнить передачу параметров приложению с помощью командной строки и поступить соответствующе. Хотя это, разумеется, хитрость. Это для приложения Delphi мы оперируем командной строкой, для пользователя же это адресная строка в броузере, то есть url.
Попробуем на примере. Необходимо создать приложение, которое выдает различную информацию (к примеру, время, дату или то и другое вместе) в зависимости от параметров, указанных в адресной строке броузера. Как известно, за данные в параметрах отвечают такие функции, как ParamCount и ParamStr. Их-то мы и будем использовать. program CgiDate; {$APPTYPE CONSOLE} uses SysUtils; begin writeln ('CONTENT-TYPE: TEXT/HTML'); writeln; writeln (' '); writeln ('
Пример передачи параметров
'); writeln (''); writeln ('
if ParamCount >0 then begin if ParamStr (1) = 'date' then writeln (FormatDateTime('"Сегодня " dddd, mmmm d, yyyy', Now)) else if ParamStr (1) = 'time' then writeln (FormatDateTime('"Время" hh:mm:ss AM/PM', Now)) else if ParamStr (1) = 'both' then writeln (FormatDateTime('"Сегодня " dddd, mmmm d, yyyy,' + '" и время" hh:mm:ss AM/PM', Now)) else writeln ('Ошибка! Неверный параметр: ' + ParamStr (1) + '.') end else writeln ('Параметр отсутствует.'); writeln (''); end.
Не правда ли просто? Теперь, если в адресной строке броузера вы наберете, например http://localhost/cgidate/exe?time, будет сгенерирована страница, отображающая текущее время, http://localhost/cgidate/exe?date - соответственно дата, а при передаче параметра both - текущая дата и время. В случае если никакой из параметров передан не был или он был ошибочен - возникнет сообщение об этом.
Данные адреса и параметры можно непосредственно указать в коде HTML и генерировать необходимые изменения на странице либо другие страницы переходя по соответствующим ссылкам.
Следует обратить внимание на то, как передавать данные через url. Знак вопроса отделяет параметр от адреса файла, с помощью знака равенства web-приложению передается значение данного параметра. Так как в адресной строке нельзя использовать пробел, он заменяется на шестнадцатеричный код в таблице ASCII, то есть %20.
Но на самом деле, если некие данные передаются от пользователя web-приложению, то обычно для этого используют формы, а не url (хотя одно другому не мешает). Попробуем и мы создать приложение, которое бы получало данные от пользователя, занесенные им в форму.
Для начала, естественно, нужно создать сам код HTML в котором бы присутствовала форма с полями ввода, кнопкой отправки и прочими необходимыми атрибутами. При этом form action должен содержать адрес программы, которая будет получать данные. Значение method может быть равно как GET, так и POST. На самом деле GET - это и есть передача параметров через url, добавляя их к адресной строке, так как POST передает их приложению посредством стандартного потока ввода. Какой из них лучше и удобней - решать вам, но чаще всего метод GET используется именно для генерации страниц (достаточно взглянуть на url который возникает при работе на поисковых серверах), тогда как второй для - передачи данных, отображать которые в адресной строке было бы весьма накладно.
Затем необходимо создать приложение, которое бы адекватно смогло воспринять все эти данные со стороны пользователя. В случае если данные передавались с помощью метода GET проблем не будет - можно действовать как в предыдущем примере. Если же приложение получает данные от пользователя с помощью POST, всё несколько иначе.
Необходимо будет считывать данные из переменной окружения, а для этого мы, естественно, должны знать данные переменные.
Гюльчитай, открой личико
Нет в мире тайн. Особенно их мало у пользователя от web-приложения. И если мы не знаем о пользователе кое-что личное, все прочее броузеры с легкостью отдают web-серверу, нисколько не заботясь о приватности и желаниях того самого пользователя. Это, конечно, нехорошо для пользователя, но хорошо для разработчика web-приложения, поскольку для него знания - великая вещь.
Итак, данные от пользователя web-приложению можно передать через переменные окружения. Вот список наиболее часто употребляемых:
GATEWAY_INTERFACE
Поддерживаемая версия CGI.
REQUEST_METHOD
Метод запроса, может быть как GET так и POST.
HTTP_REFERER
Адрес страницы (url), активирующей текущее приложение на web-сервере.
PATH_INFO
Путь переданный приложению расположенный между именем приложения и строкой запроса.
QUERY_STRING
Строка запроса, если метод - GET, добавляеться к url.
REMOTE_HOST
Имя хоста удаленного пользователя.
REMOTE_USER
Имя удаленного пользователя.
REMOTE_IDENT
IP-адрес удаленного пользователя.
HTTP_USER_AGENT
Имя и версия броузера удаленного пользователя.
С помощью данных переменных можно получить исчерпывающую информацию о пользователе и передаваемых данных для верного проектирования вашего web-приложения. Конечно, этого хватит в том случае, если вы не собираетесь подобно Большому Брату следить за каждым телодвижением пользователя.
Но вернемся к поставленной задаче - передаче данных приложению от пользователя через форму. Данные, которые передаются через QUERY_STRING в приложение с помощью метода POST, достаточно просто извлечь для использования.
Ниже листинг программы, выдающий список некоторых переменных окружения и их значения. Узнайте кое-что о своем броузере и web-сервере.
program CgiVars;
{$APPTYPE CONSOLE}
uses Windows; сonst VarList: array [1..17] of string [30] = ('SERVER_NAME', 'SERVER_PROTOCOL', 'SERVER_PORT', 'SERVER_SOFTWARE', 'GATEWAY_INTERFACE', 'REQUEST_METHOD', 'PATH_TRANSLATED', 'HTTP_REFERER', 'SCRIPT_NAME', 'PATH_INFO', 'QUERY_STRING', 'HTTP_ACCEPT', 'REMOTE_HOST', 'REMOTE_USER', 'REMOTE_ADDR', 'REMOTE_IDENT', 'HTTP_USER_AGENT');
var I: Integer; ReqVar: string; VarValue: array [0..200] of Char;
begin writeln('Content type: text/html'); writeln; writeln('
'); writeln('CGI Variables '); writeln(''); writeln('CGI Variables
'); writeln('
');
for I := Low (VarList) to High (VarList) do begin ReqVar := VarList[I]; if (GetEnvironmentVariable (PChar(ReqVar), VarValue, 200) > 0) then else VarValue := ''; writeln (VarList[I] + ' = ' + VarValue); end; writeln(''); end.
За кадром
В этой статье мы не коснулись другой и уж наверняка более обширной и сложной темы, как создание ISAPI-приложений на Delphi. Вышеприведенные способы создания приложений годны лишь в том случае, если вам необходимо быстрое, компактное и не слишком сложное web-приложение. Если же вам необходим, к примеру, доступ к базам данным, то подобный путь неприемлем.
Для создания полномасштабных приложений для интернета в Delphi существует специальный помощник - Web Server Application. С его помощью можно создать приложение генерируещее динамические web-страницы, основанные на CGI, NSAPI или ISAPI. Единственное накладываемое ограничение - непосредственно web-сервер должен работать на базе Windows.
Одним из главных преимуществ создания подобных приложений именно в среде Delphi является то, что вы продолжаете работать с визуальными компонентами - это значительно проще, чем создание приложений в других средах - возможность ошибки в больших проектах, где используется визуальное проектирование меньше, чем в тех, где всё описывается исключительно кодом. Кроме того, средства создания web-приложений позволяют импортировать уже существующие приложения в интернет-среду, что, согласитесь, немаловажно. Пока, конечно, Delphi не обладает большим набором компонентов для web-приложений, но, видимо, уже следующая версия этой среды обзаведется необходимыми. Но и сейчас Delphi можно считать достаточно удобным инструментом для создания приложений, взаимодействующих с интернетом. В. Ковалев / ©
Суть технологии
В основе технологии .NET лежит идея использования некоторого промежуточного машинно-независимого языка. В обычном программировании (с использованием любых существующих вне технологии .NET языков - от Ассемблера до ранних версий Delphi) программа, написанная в понятной для программиста нотации, компилировалась в последовательность машинных инструкций, "понятных" процессору. В новой технологии программа компилируется в термины машинно-независимого языка CIL (Common Intermediate Language - общий промежуточный язык) и сопровождается метаданными - подробными инструкциями как о самой программы, так и о всем необходимом для ее успешного выполнения. В момент, когда коды промежуточной программы (они называются управляемыми кодами) ставятся на исполнение, в дело вступает среда CLR (Common Language Runtime - общеязыковая среда исполнения), которая с помощью встроенного JIT-компилятора (JIT - just-in-time - вовремя, по мере надобности) переводит управляемые коды в набор исполняемых машинных инструкций и обеспечивает разнообразные вспомогательные действия для исполняемой программы.
Идея использования машинно-независимого промежуточного языка не нова. Впервые она была высказана еще в 1958 г. американским программистом Мелвином Е. Конвеем (Conway) в журнальной статье "Proposal For An UNCOL" ("Предложение по универсальному компьютерно-ориентированному языку"). Двухфазное кодирование имеет два существенных преимущества. Во-первых, предельно упрощается распространение программ. Переведенная в СIL программа может выполняться на любом компьютере, имеющем соответствующую среду исполнения. Причем в управляемый код включается вся системная информация, необходимая для нормального функционирования программы, так что отпадает необходимость в регистрации отдельных частей программы (объектов, модулей, динамических библиотек) в системном реестре.
Замечание:
В настоящее время технология .NET реализована для ОС семейства Windows. Существуют проекты переноса технологии в ОС FreeBSD, Mac OC X 10.2 и Linux. Однако распространение .NET на другие платформы затруднено, в основном, проблемами воспроизведения пользовательского интерфейса: экраны настольного компьютера, наладонного компьютера или мобильного телефона совершенно отличны.
Во-вторых, повышается защищенность программ и файлов: в управляемых кодах нет информации о файловой системе компьютера, на котором исполняется программа, или способах запуска программ, а среда исполнения сконструирована так, чтобы всемерно уберечь программно-аппаратные средства компьютера от атак вирусов, других злонамеренных программ, а также от программных ошибок.
однопользовательская реляционная СУБД, причем база
TjanSQL - однопользовательская реляционная СУБД, причем база данных представлена в виде плоских текстовых файлов, где разделителем между столбцами служит точка с запятой. TjanSQL поддерживает следующие команды языка SQL: SELECT (с возможностью объединения таблиц, вычислений и псевдонимов полей), UPDATE, INSERT (значения полей и подзапросы), DELETE, CREATE TABLE, DROP TABLE, ALTER TABLE, CONNECT TO, COMMIT, WHERE, IN (список или подзапрос), GROUP BY, HAVING, ORDER BY (ASC, DESC), а также вложенные подзапросы, статистические функции (COUNT, SUM, AVG, MAX, MIN), операторы (+, -, *, /, and, or, >, >=, <, <=, =, <>, Like), функции UPPER, LOWER, TRIM, LEFT, MID, RIGHT, LEN, FIX, SOUNDEX, SQR, SQRT и др.
Все это я узнал из аннотации к архиву. Начало интригующее… После распаковки zip-архива объемом 425 Кб обнаружилось еще несколько интересных особенностей. В первую очередь, порадовало наличие в образовавшемся каталоге таких поддиректорий, как db, demosource и sql, а также файла janSQL.hlp. Появилась надежда, что не придется исследовать исходные коды компонентов для определения набора и назначения их свойств и методов.
Увы, она не оправдалась. К сожалению, более тесное знакомство с TjanSQL вызвало больше отрицательных эмоций, нежели положительных. Первым разочарованием стало отсутствие законченных компонент, которые можно было бы использовать по аналогии с Data Access. В частности, для подключения к текстовой базе данных необходимо в режиме runtime создавать (и ликвидировать) объект класса TjanSQL, используя примерно такой код:
var janSQLDemoF: TjanSQLDemoF; appldir:string; thefile:string; db:TjanSQL; procedure TjanSQLDemoF.FormCreate (Sender: TObject); begin db:=TjanSQL.create; end; procedure TjanSQLDemoF.FormDestroy (Sender: TObject); begin db.free; end;
Таким образом, в TjanSQL отсутствует одно из основных, на мой взгляд, преимуществ компонентного Delphi-программирования: для доступа к базе данных необходимо прописывать всю настроечную информацию в тексте программы. Конечно, это тоже своего рода design-time, но помилуйте - что стоило разработать невизуальный компонент, аналог какого-нибудь TDataBase или TAdoConnection?
Второй минус - демонстрационный проект, поставляемый вместе с классами Tjan* (язык не поворачивается назвать их компонентами), просто так не работает. Я впервые столкнулся с ситуацией, когда демо-проект не скомпилировался при попытке запуска. Делать нечего - начал разбираться. Как выяснилось, проблема устранима - достаточно закомментировать те строки, которые вызывают "раздражение" у модулей проекта Delphi, а также изменить пути к модулям с описанием классов доступа к базе данных - они почему-то "зашиты" в проект с точностью до имени каталога и буквы диска. Так я узнал, что у разработчика на компьютере как минимум три логических диска (пути начинались с Е:\…).
В файле помощи тоже ряд пробелов. Зачем было помещать в оглавление ссылки на страницы, содержащие только заголовок? Впрочем, возможно, я придираюсь...
Но главным, на мой взгляд, недостатком TjanSQL является невозможность непосредственной связи между TJanSQL и компонентами Data Aware, как это делается, в частности, с TQuery, TDataSource и TDBGrid. В демонстрационном проекте для отображения информации, получаемой с помощью SQL-запросов, используется обычный TStringGrid. В следующем примере приводится та часть кода, которая относится к обработке и визуализации результатов запроса:
unit janSQLDemoU; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, FileCtrl,Grids, ExtCtrls, ComCtrls, ToolWin, Menus, janSQL, StdCtrls, Buttons;
type TjanSQLDemoF = class (TForm) MainMenu1: TMainMenu; ToolBar1: TToolBar; StatusBar1: TStatusBar; Panel1: TPanel; Splitter1: TSplitter; viewgrid: TStringGrid; sqlmemo: TMemo; cmdExecute: TSpeedButton; edmessage: TEdit; Insert1: TMenuItem; ApplicationFolder1: TMenuItem; SelectedFolder1: TMenuItem; Help1: TMenuItem; Contents1: TMenuItem; procedure cmdExecuteClick (Sender: TObject);
private procedure showresults (resultset:integer); Private declarations
public Public declarations end;
var janSQLDemoF: TjanSQLDemoF; appldir:string; db:TjanSQL;
implementation {$R *.DFM}
procedure TjanSQLDemoF.cmdExecuteClick (Sender: TObject); var sqlresult:integer; sqltext:string; begin sqltext:=sqlmemo.text; sqlresult:=db.SQLDirect (sqltext); if sqlresult<>0 then begin edmessage.Text:='OK'; sqlmemo.text:=''; if sqlresult>0 then begin showresults (sqlresult); db.ReleaseRecordset (sqlresult); end; end else edmessage.Text:=db.Error; sqlmemo.SetFocus; end;
procedure TjanSQLDemoF.showresults (resultset:integer); var r1:integer; i,arow,acol,c,rc,fc:integer; begin r1:=resultset; rc:=db.RecordSets [r1].recordcount; if rc=0 then exit; fc:=db.RecordSets [r1].fieldcount; if fc=0 then exit; viewgrid.RowCount:=rc+1; viewgrid.ColCount:=fc; for i:=0 to fc-1 do viewgrid.Cells [i,0]:=db.recordsets [r1].FieldNames [i]; for arow:=0 to rc-1 do for acol:=0 to fc-1 do viewgrid.cells [acol,arow+1]:=db.RecordSets [r1].records [arow].fields [acol]; end;
Только не подумайте, что я собрался обругать всё и вся. Я всего лишь считаю необходимым предупредить вас о подводных камнях, на которые вы можете напороться при использовании TJanSQL.
Вообще TJanSQL - очень полезный набор разработок. Но только если рассматривать его не как конечный продукт, а как базу для написания собственных BDE-независимых компонентов для работы с плоскими текстовыми файлами, организованными в реляционные базы данных.
Действительно, возможность обращения к структурированным текстовым файлам с использованием SQL - ценное преимущество. Можно совместить помещенные в TJanSQL функции, например, со стандартными компонентами Data Access или воспользоваться другими разработками - компонентами для организации временных таблиц в памяти. Это обеспечит доступ к плоским текстовым файлам на уровне SQL-запросов - сервис, аналогичный стандартным Delphi-компонентам, но без зависимости от такого монстра, как Borland Database Engine. Стоит ли говорить, какие перспективы тогда откроются?
Усложняем проект
Теперь можно внести некоторое разнообразие в структуру базы данных testdbExpress и добавить еще одну таблицу, SQL-скрипт создания которой ниже.
CREATE TABLE orders ( OrderNo INT (4) NOT NULL PRIMARY KEY, CustNo INT (4) NOT NULL, Name VARCHAR (24), Price DOUBLE (8,2))
Подобные SQL-инструкции могут быть выполнены с помощью метода TConnection.ExecuteDirect:
procedure TMainForm.Button1Click (Sender: TObject); var SQLScript:String; begin SQLScript:= 'CREATE TABLE orders (OrderNo INT (4) NOT NULL PRIMARY KEY,' +' CustNo INT (4) NOT NULL, Name VARCHAR (24), Price DOUBLE (8,2))'; SQLConnection.ExecuteDirect (SQLScript); end;
Таким образом, нам больше не нужны дополнительные средства для изменения состава таблиц базы данных MySQL - у нас появилась возможность менять ее структуру "на лету", в процессе выполнения приложения. Для того чтобы еще более упростить создание требуемой структуры таблиц в тестовой базе данных, я поместил в демонстрационный проект кнопку "Создать таблицы" - ее нажатие приводит к выполнению команд SQL, создающих эти структуры данных.
Таблица orders позволяет просматривать и модифицировать информацию не только о клиентах, но и об их заказах. Организация связи между этими таблицами по ключевому полю достаточно очевидна. Пользователю предоставляется возможность просмотра детальной информации по заказам при выборе клиента. Как известно, BDE позволяет достаточно просто организовать такого рода связи. DbExpress предоставляет, как минимум, два способа решения этой задачи.
Проще всего будет загрузить содержимое компонентов TSQLTable, соответствующих таблицам customer и orders, в компоненты ClientDataSet (посредством TDataSetProvider). Затем можно организовать связи по ключевому полю между этими наборами данных, используя штатные средства соответствующих компонентов. Однако содержимое обеих MySQL-таблиц размещается в оперативной памяти клиентского ПК, что чревато нехваткой ресурсов в случае больших объемов данных. С другой стороны, это обстоятельство обеспечивает высокую скорость работы. В приведенном ниже листинге описаны ключевые параметры создаваемых при использовании такого подхода компонентов.
object SQLTableOrders: TSQLTable SQLConnection = SQLConnection TableName = 'orders' end object dspOrders: TDataSetProvider DataSet = SQLTableOrders end object cdsOrders: TClientDataSet IndexFieldNames = 'CustNo' MasterFields = 'CustNo' MasterSource = dsCustomer ProviderName = 'dspOrders' end object dsOrders: TDataSource DataSet = cdsOrders end
В данном случае связь между таблицами организована по ключевому полю на уровне компонентов ClientDataSet. Но есть альтернативный подход, реализуемый двумя способами. Речь идет о формировании детализирующего набора данных по факту перехода с одной записи на другую в master-компоненте. Таким образом мы сокращаем расход оперативной памяти за счет скорости работы. Реализовать такой механизм можно с помощью как TSQLTable, так и TSQLQuery. В первом случае используется связь между главным и подчиненным наборами данных по полям MasterSource и MasterFields:
object SQLTableOrdersByCustomer: TSQLTable IndexFieldNames = 'CustNo' MasterFields = 'CustNo' MasterSource = dsCustomer SQLConnection = SQLConnection TableName = 'orders' end object dspOrdersByCustomer: TDataSetProvider DataSet = SQLTableOrdersByCustomer end object cdsOrdersbyCustomer: TClientDataSet ProviderName = 'dspOrdersByCustomer' end object dsOrdersbyCustomer: TDataSource DataSet = cdsOrdersbyCustomer end
Во втором случае применяется параметр, передаваемый в SQL-запрос:
object SQLQueryOrders: TSQLQuery DataSource = dsCustomer Params = < item DataType = ftInteger Name = 'custno' ParamType = ptInput end> SQL.Strings = ( 'select * from orders where (orders.custno =:custno)') SQLConnection = SQLConnection end object dspQOrders: TDataSetProvider DataSet = SQLQueryOrders end object cdsQOrders: TClientDataSet ProviderName = 'dspQOrders' end object dsQOrders: TDataSource DataSet = cdsQOrders end
Оба способа требуют явного указания обработчика события OnDataChanged компонента dsCustomerDataChange:
procedure TMainForm.dsCustomerDataChange (Sender: TObject; Field: TField); begin if cdsOrdersByCustomer.Active then cdsOrdersByCustomer.Refresh; if cdsQOrders.Active then cdsQOrders.Refresh; end;
Установка и управление MySQL
Размер дистрибутива (mysql-4.0.12-win.zip) составляет примерно 21 Мб (прим.ред.: текущая версия на момент публикации статьи на CITForum.ru - , 24.7 Мб). Установка не требует особых усилий и занимает несколько минут. Если раньше вы не имели дела с MySQL, то рекомендую не менять настройки, предлагаемые по умолчанию.
Полная установка СУБД не превышает 72 Мб - согласитесь, по сравнению с теми сотнями мегабайт, которые требуются для продуктов IBM, Oracle, Microsoft и др., впечатляет. В каталоге C:\MySQL\Docs вы найдете руководства по MySQL (на английском языке) - однако организация их, к сожалению, оставляет желать лучшего. Тем не менее, вся необходимая информация там есть.
В каталоге C:\mysql\bin размещен ряд программ и библиотека libmySQL.dll, которая потребуется нам для Delphi-проектов. Для манипуляции структурой базы и самими данными на первых порах воспользуемся утилитой mysql.exe, которая предоставляет нам интерфейс командной строки. Это не единственный способ работы с MySQL. Есть и другие приложения, в том числе, входящие в стандартную поставку,- например, WinMySqladmin. Обзор таких приложений может послужить темой отдельной статьи, мы же пока воспользуемся скромной mysql.exe.
Каждый из подкаталогов, расположенных в C:\mysql\data, соответствует базе данных. При инсталляции MySQL там формируются две БД - mysql и test. Для того чтобы создать собственную базу данных - например, с одной таблицей из трех полей, в которой будет храниться информация о заказчиках,- следует осуществить общение с mysql.exe примерно следующим образом:
mysql> CREATE DATABASE testdbExpress; Query OK, 1 row affected (0.01 sec) mysql> USE testdbExpress; Database changed; mysql> show tables; Empty set (0.02 sec) mysql> CREATE TABLE customer (CustNo INT (4) NOT NULL PRIMARY KEY, Name VARCHAR (50), Company VARCHAR (100)); Query OK, 0 rows affected (0.18 sec) mysql> exit Bye
Результат описанной выше сессии - создание новой базы данных testdbExpress и таблицы customer.
Устаревшие и новые средства Delphi
Для того, чтобы Delphi соответствовал требованиям к языкам, вырабатывающим CIL, была проведена его модификация. В ходе модификации из языка убраны средства, которые не поддерживаются CLR, и добавлены новые.
Устаревшие типы
Это, пожалуй, самая болезненная проблема для совместимости с ранними версиями. Прежде всего, речь идет об указателях. Указатели считаются небезопасным типом, так как код, содержащий указатели, нельзя проверить на безопасность. Запрещена любая арифметика указателей, а также обращение к функциям и процедурам New, Dispose, GetMem, FreeMem и ReallocMem. Вместо концепции указателей программы должны использовать два класса из CTS: IntPtr и Marshal. Первый - суть универсальный платформеннонезависимый указатель, открывающий доступ к механизму межплатформенного взаимодействия P/Invoke. Второй осуществляет маршализацию данных, то есть низкоуровневое взаимодействие процессов, включая упаковку/распаковку передаваемых данных.
В следующем примере создается и используется указатель для размещения в нем целого числа. uses System.Runtime.InteropServices; var
X: IntPtr; begin
X := Marshal.AllocHGlobal(SizeOf(Integer)); // Создаем указатель try // на 4 байта Marshal.WriteInt32(X, 123456); // Наполняем его Caption := IntToStr(Marshal.ReadInt32(X) * 2); // Используем finally
X.Free; // Освобождаем end
end;
Запрещены типизированные и нетипизированные файлы. Безопасный код может использовать только текстовые файлы типа FileVar: TextFile. Для работы с не текстовыми файлами рекомендуется использовать объекты класса TFileStream. Например, следующая программа создаст файл, содержащий 5 случайных вещественных чисел.
procedure TForm3.Button1Click(Sender: TObject); var
A: Real; k: Integer; F: TFileStream; begin
F := TFileStream.Create('data.dat', fmCreate); try
for k := 1 to 5 do
begin
A := Random; F.Write(A, SizeOf(Real)); end; finally
F.Free end
end; Записи не могут содержать вариантную часть, но могут - методы (см. ниже). В .NET Framework используются "широкие" символы (2 байта на символ). В связи с этим небезопасным считается тип PChar, который используется как ссылка на массив однобайтных символов. В то же время формат типов String в Delphi и CTS совпадает.
Поскольку тип PChar в программах Delphi используется, в основном, при обращении в функциям API, вместо PChar следует использовать класс StingBuilder. Следующая программа прочитает заголовок активного окна:
function GetText(Window: HWND; BufSize: Integer = 1024): String; var
Buffer: StringBuilder; begin
Buffer := StringBuilder.Create(BufSize); GetWindowText(Window, Buffer, Buffer.Capacity); Result := Buffer.ToString; end;
Устаревшие возможности кода
Компилятор Delphi отныне не поддерживает встроенный ассемблер и директивы asm.
Запрещено использовать функции прямого доступа к памяти, такие как BlockRead, BlockWrite, GetMem, FreeMem, ReallocMem, а также директиву absolute и функцию addr. Поддерживается операция @ (получение адреса).
Материал является отрывком из готовящейся
Валерий Васильевич Фаронов, сайт "Королевство Delphi"
Материал является отрывком из готовящейся книги В.В. Фаронова по Delphi 8. А именно, глава первая - "Знакомство с Delphi 8".
Система программирования Borland ® Delphi™ For Microsoft ® .NET Framework - сложный программный продукт, дающий программисту все необходимые средства для создания программ любой сложности и назначения. Характерной особенностью системы является органичная поддержка новой технологии .NET. В этой главе приводится краткий обзор Delphi и технологии .NET.
у dbExpress есть ряд очевидных
Как видно из рассмотренных примеров**, у dbExpress есть ряд очевидных отличий по сравнению с BDE. В частности, появилась необходимость в использовании компонентов DataSetProvider и ClientDataSet, явный вызов метода ApplyUpdatets; кроме того, имеют место различные способы организации связи между таблицами. Тем не менее, использование технологии dbExpress не только приводит к дополнительным усилиям при разработке ПО, но и дает ряд преимуществ: проекты, разработанные с применением технологии dbExpress, более производительны и менее требовательны к ресурсам по сравнению с BDE-приложениями.
и не использоваться. Версия Delphi
Ограниченная поддержка технологии .NET была реализована еще в предыдущей версии Delphi 7 Studio. Однако в этой версии .NET могла и не использоваться. Версия Delphi 8, напротив, не может не использовать эту технологию. Для совместимости с предыдущими версиями в ней используются пространства имен Borland.VCL.XXXX, позволяющие ценой небольших изменений исходного кода в версии 8 компилировать и исполнять программы, написанные в предыдущих версиях. Однако, такая совместимость - мнимая, так как компилятор новой версии порождает инструкции языка СIL, которые могут исполняться только под управлением CLR.
В этом разделе кратко рассматриваются новые возможности Delphi, связанные с переходом на новую технологию .NET.
Знакомство с технологией .NET
Технология .NET - это сравнительно недавнее изобретение программистов корпорации Microsoft. Ее разработчики поставили перед собой задачу создания единой универсальной платформы (базы) программирования, равно годящейся для разработки любых программ - будь то обычные Windows-приложения, приложения для работы с базами данных, Web- и Windows-службы, приложения для мобильных и переносных устройств и т. д.
Создание заставок для ваших программ
,
Наверно, каждый программист на Дельфи хоть раз хотел создать к какой-нибудь своей программе заставку. В этой статье мы рассмотрим создание заставок в Дельфи. Тому кто умеет работать более чем с одной формой в приложении, будет очень легко это понять. Чтобы не вдаваться в теорию, начнем сразу с практики.
Откройте какое-нибудь свое приложение, к которому вы хотите добавить заставку, или создайте новое (на чистом проще разбираться). Теперь необходимо добавить в наш проект еще одну форму, которая будет заставкой. Для этого нажмите File->New Form и Дельфи создаст вам новую форму. Измените ее размеры как вам хочется. Потом установите свойство Border Style вашей формы в bsNone (у формы не будет заголовка и системных кнопок), установите свойство Visible в false. Свойтсво Position должно быть poScreenCenter - это значит, что форма появится по центру экрана. И чтобы не перепутать эту форму ни с какой другой задайте ей имя Logo.
Настройка формы заставки произведена, теперь необходимо сделать, чтобы по щелчку мышкой по этой форме или после нажатия клавиши или по истечении 5 секунд форма-заставка закрывалась. Для этого установите на форму Timer, его свойству Interval задайте значение 5000 (форма будет закрываться через 5 секунд). В обработчик события OnTimer напишите всего одно слово: Close;
В обработчик события OnClick для формы-заставки напишите тоже самое. Установите свойство формы KeyPreview в true (это делается для того, чтобы при нажатии любой клавиши вначале реагировала форма, а затем тот элемент, который был в фокусе в момент нажатия). А в обработчик события OnKeyPress (для формы-заставки конечно же) опять-таки напишите close;
Форма-заставка готова полностью и теперь необходимо, чтобы она запускалась перед главной формой. Для этого сделайте активной вашу главную форму, перейдите на вкладку Events в Object Inspector'e и выберите событие OnShow. В обработчике этого события надо написать следующее:
logo.showmodal;
Меня иногда спрашивают, чем отличаются процедуры show и showmodal. У них только одно принципиальное различие: если форма открылась методом Showmodal, то пока она не закроется пользователь не сможет взаимодействовать с остальными формами приложения. А если форма была открыта методом Show, то пользователь легко может перейти к любой форме приложения.
Итак, форма-заставка готова. Теперь мы слегка ее усовершенствуем. Добавим такую же штуку, как в формах-заставках Microsoft Office, а именно на форме будет показываться имя пользователя и организация. Для этого разместите на форме-заставке две метки (Label). Первую назовите UserName, а вторую - Organization. Чтобы это сделать мы воспользуемся реестром (тас вообще очень много интересного можно найти). Теперь откройте обработчик события OnCreate для формы-заставки и объявите там переменную R типа TRegistry, а в раздел Uses всей программы добавьте Registry. Теперь нам нужно создать объект R :
R:=TRegistry.Create;
R.RootKey:=HKEY_LOCAL_MACHINE;
R.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion', False); //именно здесь эта информация хранится
Теперь необходимо прочитать нужные строки из этого раздела реестра и присвоить их соответствующим меткам:
UserName.Caption:=r.readstring('RegisteredOwner');
Organization.Caption:=r.readstring('RegisteredOrganization');
r.Free; //надо уничтожить этот объект, так как он нам больше не нужен
Таким образом весь этот обработчик должен иметь примерно такой вид:
procedure TLogo.FormCreate(Sender: TObject);
var R:Tregistry;
begin
R:=TRegistry.Create;
R.RootKey:=HKEY_LOCAL_MACHINE;
R.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion', False);
UserName.Caption:=r.readstring('RegisteredOwner');
Organization.Caption:=r.readstring('RegisteredOrganization');
r.Free;
end;
Ну вот собственно и все что я хотел вам рассказать о заставках. Теперь ваши программы будут выглядеть более солидно. Но помните, что при создании небольших, вспомогательных программ, объем которых не превышает килобайт 100-150 заставки лучше не использовать.
(С) Автор статьи: // ().
DLL и Дельфи
,
Думаю многие знают, что такое DLL (dynamic link library - динамические библиотеки). У библиотек есть немало преимуществ, достаточно веских, что бы их использовать. В этой статье мы научимся создавать и использовать динамические библиотеки в своих проектах.
Зачем они нужны
А зачем эти самые библиотеки мне нужны? - спросите вы. Ну я не знаю, может они вам вообще не нужны. А может и жизненно необходимы. Перечислю возможности и преимущества библиотек:
Вобщем DLL - зверь полезный и очень даже дружелюбный.
Структура динамической библиотеки
Что бы создать библиотеку в Delphi6 выберите File -> New -> Other и в появившемся окне выберите DLL Wizard. Дельфи сгенерирует шаблон для библиотеки:
library Project;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library"s USES clause AND your project"s (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
SysUtils,
Classes;
{$R *.res}
begin
end.
В комментарии указывается на необходимость вставить ссылку на модуль ShareMem, если библиотека экспортирует длинные строки в параметрах обращения к подпрограммам или как результат функций. Эта ссылка должна быть первой как в предложении uses библиотеки, так и в uses файла проекта программы, которая использует эту библиотеку. Если подпрограммы библиотеки экспортируют строки ShortString или PChar, ссылаются на ShareMem не обязательно. Что бы не возникало недоразумений в своих библиотеках я рекомендую вместо типа String пользоваться PChar, а по необходимости конвертируйте типы функциями PChar (конветирует из String в PChar) и StrPas (конвертирует из PChar в String).
Структура библиотеки похожа на структуру обычного модуля. Теперь создайте библиотеку с таким текстом:
library Project2;
uses
SysUtils,
Classes;
function MyFunc(num1, num2, Errcode : Integer; Operation : PChar) : Integer; stdcall;
begin
try
if Operation="plus" then
Result := num1+num2;
if Operation="minus" then
Result := num1-num2;
if Operation="multiply" then
Result := num1*num2;
if Operation="div" then
Result := num1 div num2;
if Operation="mod" then
Result := num1 mod num2;
except Result := Errcode;
end;
end;
exports
MyFunc INDEX 1 NAME "MathFunc";
begin
end.
Сохраните это все куда нибудь и скомпилируйте (Ctrl+F9)
Это будет демонстрационная библиотека, на которой я буду показывать различные приемы работы с DLL. Но для начала давайте рассмотрим текст этой библиотеки.
function MyFunc(num1, num2, Errcode : Integer; Operation : PChar) : Integer; - это обычная функция, возвращающая целое число. Основываясь на параметре Operation функция решает, какую операцию сделать над операндами num1 и num2. В случае ошибки она возвращает переданный ей параметр Errcode. Т.е. в программе можно будет проанализировать, возникла ли ошибка во время исполнения функции.
stdcall указывает на то, что функция будет вызываться "обычным" способом, т.е. программы, написанные на других языках тоже смогут пользоваться библиотекой. Можно использовать - "register", предназначенным только для использования программами, написанными в среде дельфи, но тогда программы, написанные не в дельфи не смогут обращаться к этой функции.
exports
MyFunc INDEX 1 NAME "MathFunc";
Раздел Exports помогает компилятору и компоновщику создать специальный заголовок DLL-модуля, в котором перечисляются имена подпрограмм и адреса их точек входа. В DLL может быть несколько списков Exports, но перечисляемые в них подпрограммы должны быть описаны где-то выше по тексту библиотеки. Помимо имени подпрограммы в заголовок DLL помещается также ее порядковый
номер (INDEX), точнее, присвоенный ей целочисленный индекс. Это позволяет вызывающей программе ссылаться не на имя, а на индекс подпрограммы и тем самым уменьшить затраты времени на установление с ней связи. Индекс присваивается подпрограмме по порядку ее появления в списках Exports: первая подпрограмма в первом списке получает индекс 0, следующая 1 и т. д.
Программист может изменить умалчиваемую индексацию и явно указать индекс подпрограммы, добавив за ее именем в списке Exports слово index и целое число в диапазоне от 0 до 32767. Помимо индекса можно указать также и произвольное (NAME) имя функции.
Надеюсь, я понятно обьяснил ;) Вобщем наша демонстрационная библиотека готова. Теперь давайте научимся пользоваться библиотечными функциями
Использование библиотечных функций
Использовать функции из библиотеки можно двумя способами:
1. Привязка библиотеки к программе (статическая загрузка)
Недостатки:
- нет эффекта экономии ресурсов (библиотека загружается при запуске программы и выгружается при завершении программы)
- при отсутствии хотя бы одной из необходимых библиотек в папке с программой, либо в папке $windir$/system программа не запускается и выдает сообщение об ошибке
- при отсутствии хотя бы одной из необходимых функций в библиотеке при запуске программа выдает сообщение об ошибке и не запускается
Преимущества:
- легкость использования
У этого способа много недостатков. Но все же он будет полезен начинающим программистам. Для использования функций или процедур из библиотеки таким способом нужно всего лишь в разделе implementation указать имя функции или процедуры примерно так:
//если функция
function FunctionName(Par1: Par1Type; Par2: Par2Type; ParN : ParNType): ReturnType; stdcall; external "MyDLL.dll" name "FunctionName" index FunctionIndex;
//если процедура
procedure ProcedureName(Par1: Par1Type; Par2: Par2Type; ...); stdcall; external "MyDLL.dll" name "ProcedureName" index ProcIndex;
Рассмотрим обьявление функции.
function FunctionName(Par1: Par1Type; Par2: Par2Type; ParN : ParNType): ReturnType; - Это собственно обьявление функции
external "MyDLL.dll" эта директива указывает на имя библиотеки, из которой будет вызвана функция (в нашем случае это MyDLL.dll)
name "FunctionName" необьязательная директива, которая указывает на имя функции в библиотеке; используется для повышения скорости доступа к функциям (имя определяется внутри библиотеки)
index FunctionIndex тоже необьязательная директива, использующаяся для ускорения доступа к функциям; указывает на индекс функции (индекс обьявляется в самой библиотеке).
Рассматривать обьявление процедуры не имеет смысла, т.к. процедурв вызывается точно так же (за исключением того, что у процедура ничего не возвращает). Вот и все! Теперь можно пользоваться обьявленой функцие в пределах модуля, в котором она была обьявлена.
Рассмотрим пример на основе нашей демонстрационной библиотеки, которую мы скомпилировали выше.
Создайте новый проект Project1 и на его форму поместите четыре поля Edit. Присвойте им такие имена: Num1Edit, Num2Edit, OpEdit, ResultEdit. Так же поместите одну кнопку, имя которой значения не имеет. В разделе implementation обьявите функцию:
implementation
function MyFunc(num1, num2, Errcode : Integer; Operation : PChar) : Integer; stdcall; external "Project2.dll" name "MathFunc" index 1;
А обработчик единственной кнопки приведите к примерно такому виду:
procedure TForm1.DoItButtonClick(Sender: TObject);
const
Errcode : Integer=978987;//код ошибки - может быть абсолютно любым.
var
Num1, Num2, Result_ : Integer;//для проверки чисел
Operation : String;//операция, для передачи параметра функции
begin
try //прежде чем передать числа
Num1 := StrToInt(Num1Edit.Text); //функции проверим их
Num2 := StrToInt(Num2Edit.Text);
except
Num1Edit.Text := "0";
Num2Edit.Text := "0";
ResultEdit.Text := "Введите целые ЧИСЛA";
EXIT;
end;
Operation := OpEdit.Text; //также проверим, введена ли правильная команда.
if (Operation<>"plus")and(Operation<>"minus")and(Operation<>"multiply")
and(Operation<>"div")and(Operation<>"mod") then
begin
ResultEdit.Text := "Введите корректную команду";
Exit;
end;
Result_ := MyFunc(Num1, Num2, Errcode, PChar(Operation)); //использование библиотечной функции
if Result_=Errcode then //если функция возвратила код ошибки то
begin //то сообщаем об этом.
ResultEdit.Text := "ОШИБКА";
EXIT;
end
else //а если результат отличный от кода ошибки
ResultEdit.Text := IntToStr(Result_);//то выводим его
end;
В комментариях к коду все подробно расписано и вопросов я думаю не возникнет. А если же возникли, то пишите мне: или обращайтесь на форуме сайта .
Обратите внимание, что мы используем функцию из библиотеки так же, как и если она была бы написана в модуле. Ещё раз повторяю, что при привязке библиотеки к программе функцию можно использовать только в тех модулях, в которых она была обьявлена. Вот вам мини калькулятор, который работает на (хотел было сказать на батарейках) DLL.
2. Динамическая загрузка
Недостатки:
- громоздкость и сложность кода
- функции библиотеки доступны только тогда, когда библиотека загружена в память
Преимущества:
- начисто лишен всех недостатков первого способа + некоторые другие преимущества перед первым способом
Этот способ довольно сложен, особенно для новичков. Но преимуществ перед первым способом у него куда больше. Для работы с динамически загружаемыми библиотеками просто необходимо знать три WinAPI функции: LoadLibrary, GetProcAddress И FreeLibrary.
LoadLibrary(LibFileName: PChar) - загружает библиотеку LibFileName в память. Если библиотека загружена удачно, то функция возвращает дескриптор (THandle) DLL в памяти.
GetProcAddress(Module: THandle; ProcName: PChar) - находит точку входа в функцию ProcName. Внимание! Здесь нужно указать NAME функции, а не её название. Если функция найдена, то функция GetProcAddress возвращает дескриптор (TFarProc) функции в загруженной DLL.
FreeLibrary(LibModule: THandle) - выгружает библиотеку LibModule. При этом вся занятая этой библиотекой память освобождается. Следует заметить, что после вызова этой процедуры функции данной библиотеки больше недоступны и обращение к ним вызовет исключение.
Для того, что бы динамически загрузить функцию из библиотеки, то необходимо её обьявить в разделе var:
MyFunc: function(num1, num2, Errcode : Integer; Operation : PChar) : Integer; stdcall;
Также нужно обьявить переменную типа THandle. "На пальцах" не обьяснишь, поэтому давайте рассмотрим пример динамической загрузки DLL на основе нашей демонстрационной библиотеки.
Откройте предыдущий проект с демонстрацией статическо загрузки. В разделе var обьявите пару новых переменных:
LibHandle: THandle;
MyFunc: function(num1, num2, Errcode : Integer; Operation : PChar) : Integer; stdcall;
Обработчик кнопки приведите к такому виду:
procedure TForm1.DoItButtonClick(Sender: TObject);
const
Errcode : Integer=978987;//код ошибки - может быть абсолютно любым.
var
Num1, Num2, Result_ : Integer;//для проверки чисел
Operation : String;//операция, для передачи параметра функции
begin
try //прежде чем передать числа
Num1 := StrToInt(Num1Edit.Text); //функции проверим их
Num2 := StrToInt(Num2Edit.Text);
except
Num1Edit.Text := "0";
Num2Edit.Text := "0";
ResultEdit.Text := "Введите ЧИСЛA";
EXIT;
end;
Operation := OpEdit.Text; //также проверим, введена ли правильная команда.
if (Operation<>"plus")and(Operation<>"minus")and(Operation<>"multiply")
and(Operation<>"div")and(Operation<>"mod") then
begin
ResultEdit.Text := "Введите корректную команду";
Exit;
end;
//до этого момента код остался без изменений.
@MyFunc := nil; //очищаем адрес функции
LibHandle := LoadLibrary("Project2.dll");//пытаемся загрузить библиотеку
if LibHandle >= 32 then
begin //если все прошло успешно то
@MyFunc := GetProcAddress(LibHandle, "MathFunc");//пытаемся найти адрес функции
if @MyFunc <> nil then //если адрес найден (функция существует в библиотеке)
Result_ := MyFunc(Num1, Num2, Errcode, PChar(Operation)); //использование библиотечной функции
if Result_=Errcode then //если функция возвратила код ошибки то
begin //то сообщаем об этом.
ResultEdit.Text := "ОШИБКА";
EXIT;
end
else //а если результат отличный от кода ошибки
ResultEdit.Text := IntToStr(Result_);//то выводим его}
end;
end;
Изменившуюся часть кода я обильно полил комментариями, так что думаю вопросов не возникнет. Но если же они и здесь все таки возникли, то советую купить книжку по дельфи и написать письмо мне: или обращайтесь на форуме сайта . Исходник этого проекта с откомпилированными библиотекой и программой можно скачать
Заключение
В этой статье мы коснулись лишь основных аспектов программирования с применением динамически-подключаемых библиотек. А ведь в DLL можно хранить всякие картинки и даже формы! С помощью них удобно создавать всякие плагины. Но это уже совсем другая история...
Delphi - сбориник статей
Цвет в формате
К сожалению, не лучше обстоит дело и с цветом в форматах. Т.е. цвет в Delphi можно задавать только по-русски: R.NumberFormat := 'Основной;[красный]-Основной'; Перечень цветов по-русски, которые можно задавать в формате: черный, красный, зеленый, синий, фиолетовый, желтый, белый. Список небогатый.Формат чисел. Разделители. (DecimalSeparator, ThousendSeparator)
Почитайте "диалог" на Круглом столе - вроде бы все понятно ("а все и делов то в запятой")! А нет, не все! В "International" (в русском "Язык и стандарты") можно установить любые DecimalSeparator и ThousandsSeparator, отличные от принятых по-умолчанию фирмой Microsoft для русской версии Windows. Я, например, всегда меняю принятые по-умолчанию десятичную точку "," на "." и разделитель тысяч с " " (пробел) на "'" (апостроф, как в калькуляторе). Так формат "# ##0,00" у меня работать не будет...И это еще не все! Заходим в настройки Excel'я "Сервис/Параметры" переходим на закладку "Международные" и видим опять "Разделитель целой и дробной части", "Разделитель разрядов" и чекбокс "Использовать системные разделители". Т.е. использование системных разделителей не может гарантировать правильного применения при форматировании чисел в Excel'е. Решение: использовать свойство ExcelApplication.International (о нем дальше). Причем, даже при установленном свойстве ExcelApplication.UseSystemSeparators = False и отличных от системных ExcelApplication.DecimalSeparator и ExcelApplication.ThousandsSeparator, ExcelApplication.International отработает корректно.
Далее рассмотрим примеры работы (или не работы), приняв "стандартные" настройки для русских Windows:
Код на VBA (эталон):
Sub Test2() Dim R As Range Set R = Range("a1") R.Clear R.Value = 1234567.89 R.NumberFormat = "#,##0.00" ' работает R.NumberFormatLocal = "# ##0,00" '
работает для стандартных настроек R.NumberFormat = "# ##0,00" ' не работает R.NumberFormatLocal = "#,##0.00" ' не работает Set R = Nothing End Sub Код на Delphi:
R := ASheet.Range['A1', EmptyParam]; R.Value2 := 1234567.89; R.NumberFormat := '#,##0.00'; // не работает R.NumberFormatLocal := '# ##0,00'; //
работает для стандартных настроек R.NumberFormat := '# ##0,00'; //
работает для стандартных настроек Примечание:
в примерах значения записываются в Value2 для предотвращения форматирования "на лету" самим Excel'ем. Так число 123.45, записанное в Value будет автоматически отформатировано Excel'ем в формат валюты, а присвоение Value = Date будет автоматически переведено в формат даты. Запись в Value2 "воспринимает" значение как Double. Подробнее смотрите в справке VBA для Excel'я.
Решения (с использованием ExcelApplication.International):
Для получения формата даты можно написать функцию:
function XL_GetShortDateFormat(XLApp: ExcelApplication): String; var d, m, y: Integer; begin if XLApp.International[xlDayLeadingZero, lcid] then d := 2 else d := 1; if XLApp.International[xlMonthLeadingZero, lcid] then m := 2 else m := 1; if XLApp.International[xl4DigitYears, lcid] then y := 4 else y := 2; Result := Format('%1:s%0:s%2:s%0:s%3:s', [ DateSeparator, StringOfChar(VarToStr(XLApp.International
[xlDayCode, lcid])[1], d), StringOfChar(VarToStr(XLApp.International
[xlMonthCode, lcid])[1], m), StringOfChar(VarToStr(XLApp.International
[xlYearCode, lcid])[1], y) ]); end; Для формата чисел:
function XL_GetNumberFormat
(XLApp: ExcelApplication): String; begin Result := Format('#%s##0%s%s', [ XLApp.International[xlThousandsSeparator, lcid], XLApp.International[xlDecimalSeparator, lcid], StringOfChar('0', Integer
(XLApp.International[xlCurrencyDigits, lcid])) ]); end; Для формата валюты:
function XL_GetCurrencyFormat(XLApp: ExcelApplication): String; begin Result := Format('%s "%s"', [ XL_GetNumberFormat(XLApp), XLApp.International[xlCurrencyCode, lcid] ]); end; Тот же принцип можно применить к времени и другим типам. Также смотрите другие индексы для свойства International (их там много) в справке VBA. Например, получить "основной" (general) формат можно так:
GenFmt := XL.International[xlGeneralFormatName, lcid]; Примечание:
установить основной формат еще можно установить, записав в NumberFormat "пустую" строку, т.е. указать, что нет форматирования для чисел (даты):
Range.NumberFormat := '';
Формат даты
Код на VBA (эталон):Sub Test1() Dim R As Range Set R = Range("a1") R.Clear ' очистим формулы и форматы R.Value2 = Date ' запишем текущую дату R.NumberFormat = "d/mm/yy" ' работает R.NumberFormatLocal = "ДД.ММ.ГГ" ' работает ' дальше не работает R.NumberFormat = "ДД.ММ.ГГ" ' не работает R.NumberFormatLocal = "d/mm/yy" ' ОШИБКА! Set R = Nothing End Sub Код на Delphi:
R := ASheet.Range['A1', EmptyParam]; R.Value2 := Date; R.NumberFormat := 'd/mm/yy'; // ОШИБКА! R.NumberFormat := 'ДД.ММ.ГГ'; // работает R.NumberFormatLocal := 'ДД.ММ.ГГ'; // работает R.NumberFormatLocal := 'd/mm/yy'; // ОШИБКА
Формулы на листе
К счастью, работа со свойствами Formula и FormulaLocal в VBA и Delphi идентична и соответствуют своим названиям. Хочется отметить только один нюанс (это, кстати, действительно и для VBA) - при написании "русских" формул нужно учитывать системную переменную ListSeparator. Так, если на другом компьютере пользователь изменит его со стандартного для русской версии Windows символа ";" на "," (например, как это делаю я :), то присвоение Range.FormulaLocal := '=округл(A1*B1; 2)'; вызовет ошибку! Поэтому, с учетом "разделителя элементов списка" нужно писать так:Range.FormulaLocal := Format('=округл(A1*B1%s 2)',
[ListSeparator]); или Range.Formula := '=round(A1*B1, 2)'; Здесь приятней и проще пользоваться английскими формулами. Но, иногда, существует необходимость писать формулы из вариантного массива…
Примечание:
системные переменные ListSeparator, DateSeparator описаны в модуле System.
Особенности работы с "русским" Excel'ем
Александр Шабля,Написанное приложение, прекрасно работающие с Excel'ем на собственном компьютере, часто, после переноса приложения на другой компьютер, оказывается неработоспособным! Отчего так происходит? В этой статья я собираюсь описать разницу в работе русской версии Excel'я из VBA и через COM интерфейс (библиотеку типов, TLB) из Delphi. Почему возникли расхождения? Ответа на эти вопросы у Microsoft я не нашел…
Примечание:
сравнивались только русская и английская (American English) версии Excel с номером версии 9.0 (MS Office 2000) и выше. Другие версии не рассматривались.
Описание типов объектов, применяемых в примерах:
XL: TExcelApplication; WB: TExcelWorkbook; ASheet: TExcelWorksheet; R: Range; // ExcelRange - для Delphi7
Используемые в примерах "дополнительные" модули:
OleServer, Excel2000, Office2000 из стандартной поставки Delphi Enterprise версии 6 и выше.
Работа со свойством объекта Range NumberFormat
NumberFormat и NumberFormatLocal четко работают в VBA и полностью соответствуют своему содержанию в названиях, но только не при работе из Delphi. В Excel2000.pas (D7) они описаны какExcelRange = dispinterface ['{00020846-0000-0000-C000-000000000046}'] ... property NumberFormat: OleVariant dispid 193; property NumberFormatLocal: OleVariant dispid 1097; Но, при попытке записи форматов из Delphi, выясняется, что NumberFormat и NumberFormatLocal ведут себя идентично, причем NumberFormat соответствует NumberFormatLocal (лучше было бы наоборот :). Т.е. в русской версии все форматы нужно писать "по-русски" (можно прямо в NumberFormat, в VBA - нельзя).
Создание колонтитулов
Давайте запустим запись макроса создания колонтитула (меню в Excel "Сервис/Макрос/Начать запись…"). Теперь откроем параметры страницы (меню "Файл/Параметры страницы…"). Создадим центральный нижний колонтитул "Лист &[Страница] из &[Страниц]" шрифтом "Arial", "полужирный" и размером 8pt. Слова "Лист" и "из" с начертанием "обычный". После "сокращения" макроса получим:Sub Макрос1() ' ActiveSheet.PageSetup.CenterFooter = _ "&""Arial""&8Лист &""Arial,полужирный""&P" & _ "&""Arial,обычный"" из &""Arial,полужирный""&N" End Sub Т.е. при выводе на печать мы хотим, чтоб в нижний колонтитул по центру выводился текст, к примеру "Лист 1 из 5".
Примечание:
если вы хотите увидеть работу вашего макроса в действии (чтоб работал PrintPreview), обязательно внесите на лист хоть какие-нибудь данные.
Внимание! Суммарная длина текста в нижнем или верхнем (левый + по_центру + правый) колонтитулах не должна превышать 250 символов (как и в ячейке). Вроде бы все ясно, осталось только переписать его под Delphi:
ASheet.PageSetup.CenterFooter := '&"Arial"&8Лист &"Arial,полужирный"&P' + '&"Arial,обычный" из &"Arial,полужирный"&N'; Проверяем в Excel'е "Предварительный просмотр" - оба, и не работает! А как же должно работать?
Припоминая русификацию еще Excel'я 4-й версии, напишем русские эквиваленты:
ASheet.PageSetup.CenterFooter := '&"Arial"&8Лист &"Arial,полужирный"&С' + //
Страница - Page '&"Arial,обычный" из &"Arial,полужирный"&К'; //
Количество - Number Сработало! Ну, и теперь добавим распознавание русской версии:
if XL.LanguageSettings.LanguageID[msoLanguageIDUI] = $0419 then ASheet.PageSetup.CenterFooter := //
русские коды форматирования '&"Arial"&8Лист &"Arial,полужирный"&С' + '&"Arial,обычный" из &"Arial,полужирный"&К' else ASheet.PageSetup.CenterFooter := //
английские коды форматирования '&"Arial"&8Лист &"Arial,bold"&P' + '&"Arial,normal" из &"Arial,bold"&N'; Вывод: при вставке кодов форматирования из Delphi в русский Excel должны вставляться только русские коды форматирования. А где их взять? Вот список кодов форматирования, полученных методом пробы:
| Format code | Русский код форматирования | Описание |
| &L | &Л | Выравнивает последующие символы влево. |
| &C | &Ц | -"- по центру. |
| &R | &П | -"- вправо. |
| &E | &Й | Двойное подчеркивание (double-underline) вкл. или выкл. |
| &X | &Р | Верхний индекс (superscript) вкл. или выкл. |
| &Y | &И | Нижний индекс (subscript) вкл. или выкл. |
| &B | &Ж | Жирный (bold) вкл. или выкл. |
| &I | &Н | Наклонный (italic) вкл. или выкл. |
| &U | &Ч | Подчеркнутый (underline) вкл. или выкл. |
| &S | &З | Зачеркнутый (strikethrough) вкл. или выкл. |
| &D | &Д | Текущая дата. |
| &T | &В | Текущее время. |
| &F | &Ф | Имя документа (книги). |
| &A | &Я | Имя листа. |
| &P | &С | Номер страницы. |
| &P+number | &С+число | Номер страницы + указанное число. |
| &P-number | &С-число | Номер страницы - указанное число. |
| && | && | Одиночный ampersand. |
| & "fontname" | &"ИмяШрифта[,начертание]" | Печать указанным шрифтом [и начертанием] (не обязательно). Обязательно указывать в двойных кавычках. |
| &nn | &nn | Печать шрифтом указанного размера. |
| &N | &К | Общее количество страниц. |
И еще один опыт:
ASheet.PageSetup.CenterFooter := '&"Arial"&8Лист &"Arial,bold"&С&"Arial,normal"
из &"Arial,bold"&К'; Работает! Т.е. начертания (Style у класса TFont в Delphi) шрифтов можно уверенно писать по-английски. Или заменить на коды форматирования:
ASheet.PageSetup.CenterFooter :=
'&"Arial"&8Лист &Ж&С&Ж из &Ж&К'; Примечание:
для перевода строки в колонтитуле или ячейке используйте симол LF, ASCI код 10 (
#10):
ASheet.PageSetup.CenterFooter := 'Первая строка'
#10'Вторая строка'; ASheet.Range['A1', EmptyParam].Value := 'Первая строка'
#10'Вторая строка';
У вас русская версия Excel?
Определить наличие русской версии Excel возможно так:if XL.LanguageSettings.LanguageID[msoLanguageIDUI] = 1049
{или $0419} then { Excel имеет русский интерфейс пользователя }; Английская версия Excel (English United States) вернет 1033 (или $0409), немецкая (German Standard) - $0407. Значения соответствуют LCID, описанным в MS SDK Help "Language Identifiers". LCID интерфейса пользователя и файла Excel.exe файла может быть неодинаковым (например, после установки MUI). Константа msoLanguageIDUI находится в модуле Office2000.pas и описана так:
const msoLanguageIDUI = $00000002; Примечание:
в Office97 свойство LanguageSettings отсутствует
Далее мы рассмотрим приемы работы с "русским" Excel'ем.
ем из Delphi необходимо соблюдать
При работе с русским Excel' ем из Delphi необходимо соблюдать следующие правила:Скачать проект: RusExcel.zip (4,6К)
Все примеры тестировались на Delphi 6, Delphi 7, на русских версиях WindowsXP + OfficeXP, Windows98SE + Office2000 SR?1.
Запись формул из Variant-ного массива
Запись в свойство Formula, FormulaLocal, Value, Value2 из Variant-ного массива идентична в русском Excel'е и при работе из Delphi. Но, если мы хотим вставлять формулы прямо из массива, все они должны быть только русскими! Вот здесь то и всплывает необходимость определения наличия русской версии Excel'я (впрочем, это уже касалось задания цвета в свойстве NumberFormat).Код на VBA: Sub TestVariant() Dim MyVar(2, 2) As Variant ' 3 строки, 3 колонки Dim R As Long, C As Byte ' первая строка MyVar(0, 0) = 10.72 MyVar(0, 1) = 3.05 ' MyVar(0, 2) = "=round(RC[-1]*RC[-2], 2)" ' ошибка #ИМЯ? MyVar(0, 2) = "=округл(RC[-1]*RC[-2]; 2)" '
работает для стандартных настроек ' вторая строка MyVar(1, 0) = 4.57 MyVar(1, 1) = 7.23 ' MyVar(1, 2) = "=round(A2*B2, 2)" ' ошибка #ИМЯ? MyVar(1, 2) = "=округл(A2*B2; 2)" '
работает для стандартных настроек ' итог ' MyVar(2, 2) = "=sum(C1:C2)" ' ошибка #ИМЯ? ' MyVar(2, 2) = "=сумм(C1:C2)" ' работает MyVar(2, 2) = "=сумм(R[-2]C:R[-1]C)" ' работает With Range("A1:C3") .Clear ' чистим область ячеек
от формул и форматов .Value = MyVar ' работает ' .Value2 = MyVar ' работает ' .Formula = MyVar ' работает ' .FormulaLocal = MyVar ' работает End With Код на Delphi (тут мы применим знание написания русских формул, описанный выше, а именно ListSeparator):
var MyVar: Variant; IsRusXL: Boolean; begin ... MyVar := VarArrayCreate([0, 2, 0, 2], varVariant); //
3 строки, 3 колонки // определим, русский ли у нас Excel IsRusXL := XL.LanguageSettings.LanguageID[msoLanguageIDUI]
= $0419; // первая строка массива MyVar[0, 0] := 10.72; MyVar[0, 1] := 3.05; if IsRusXL // стиль R1C1 then MyVar[0, 2] := Format('=округл(RC[-1]*RC[-2]%s 2)',
[ListSeparator]) else MyVar[0, 2] := '=round(RC[-1]*RC[-2], 2)'; // вторая строка массива MyVar[1, 0] := 4.57; MyVar[1, 1] := 7.23; if IsRusXL then MyVar[1, 2] := Format('=округл(A2*B2%s 2)',
[ListSeparator]) // стиль A1 else MyVar[1, 2] := '=round(A2*B2, 2)'; // итог if IsRusXL then MyVar[2, 2] := '=сумм(C1:C2)' // '=сумм(R[-2]C:R[-1]C)' else MyVar[2, 2] := '=sum(C1:C2)'; with ASheet.Range['A1:C3', EmptyParam] do begin Clear; // Formula := MyVar; // работает // FormulaLocal := MyVar; // работает // FormulaR1C1 := MyVar; //
не работает, если есть ссылки в стиле A1 // FormulaR1C1Local := MyVar; //
не работает, если есть ссылки в стиле A1 // Value := MyVar; // работает Value2 := MyVar; // работает end; ... Примечание:
из примера видно, что при записи из Variant-ного массива в Formula, FormulaLocal, Value, Value2 не имеет значения, какой стиль ссылок используется: A1 и R1C1 работают идентично. Но это не относится к свойствам FormulaR1C1 и FormulaR1C1Local, которые принимают формулы ТОЛЬКО в стиле R1C1.
Delphi - сбориник статей
Эксперты в Delphi — что это такое?
Если не хватает возможностей среды или какие-то операции кажутся слишком громоздкими, то эксперты — именно то, что нужно. С помощью экспертов вы словно проникаете внутрь среды Delphi и без труда дополняете ее. Естественно, такое проникновение должно быть осторожным и аккуратным, потому как неправильное обращение с объектами и интерфейсами может вызвать сбои в работе среды или даже ее разрушение. Эксперты могут существовать в виде библиотек DLL либо компилированных модулей DCU. Выбор “формы жизни” будущего эксперта остается за вами, но имейте в виду, что расширение файла эксперта определяет способ его регистрации. О способах регистрации чуть далее — сперва давайте рассмотрим стили экспертов Delphi. Их всего четыре, и все они приведены в таблице.Эксперты в Delphi, или Программист, упростите себе жизнь
Олег Гопанюк, ведущий программист департамента "KM-Solution" корпорации "Квазар-Микро", Имеющее множество достоинств и довольно популярное средство разработки Delphi позволяет расширять функциональные возможности среды разработчика. Речь идет не о косметических изменениях в интерфейсе и не о добавлении компонентов или их наборов, а о придании рабочему окружению программиста новых полезных возможностей, не предусмотренных его создателями. Для решения подобной задачи в Delphi можно воспользоваться так называемыми экспертами. Вспомните, как удобно, ответив на несколько вопросов, создать готовую форму для вывода содержимого таблиц. Или, щелкнув мышью на нужном элементе в списке New Items, получить “костяк” вашего будущего проекта (рис. 1).
Рис. 1. Многие возможности Delphi реализуются с помощью экспертов
Что это — стандартные возможности рабочей среды? Да, но применить их можно лишь с помощью эксперта. О том, как это сделать, и пойдет речь далее.
Некоторые полезные эксперты
Знаете ли вы, что в Internet есть предостаточно мест, где можно найти эксперты для Delphi. Одно из таких мест — польский сервер “Delphi Super Page” (). Там вы найдете множество различных экспертов и полезных компонентов. Давайте рассмотрим самый интересный, по мнению автора, набор экспертов, предоставляющий возможность ускорить разработку приложений на Delphi. Его можно загрузить по адресу: .Рассмотрим вкратце эти маленькие “добавки”. Набор содержит эксперт — редактор префиксов для имен компонентов. После того, как он будет установлен в инспекторе объектов, напротив свойства Name появится кнопка с многоточием. Это говорит о том, что можно воспользоваться редактором для изменения свойства Name. С его помощью можно указывать префикс для данного класса компонента. Строго говоря, использование префиксов в названиях компонентов — это правило хорошего тона. В меню Tools теперь появляется новое подменю Prefix list editor, с помощью которого можно изменять и добавлять такие префиксы.
Как известно, некоторые компоненты являются контейнерами для других (например, TPanel, TGroupBox, TScrollBox и т. п.). Установленный набор позволит управлять выравниванием дочерних компонентов. Для этого достаточно щелкнуть правой кнопкой мыши и выбрать в контекстном меню пункт Align controls. В Delphi есть мастер создания элементов управления, работающих с данными.
Однако в рассматриваемом наборе имеется эксперт, благодаря которому можно создавать компоненты для работы с данными более совершенным способом. С помощью эксперта, вызываемого командой Tools р Shortcut list editor, можно определить свой набор клавиатурных эквивалентов для главного меню Delphi. Кроме всего прочего, после установки набора вы обнаружите, что палитра компонентов Delphi стала многострочной (). Так вы получите возможность просматривать больше закладок, чем ранее. document.write('');
Архив новостей
2 Август, 17:53 (19)
2 Август, 17:51 (34)
2 Август, 15:40 (42)
2 Август, 15:35 (1)
2 Август, 14:54 (3)
2 Август, 14:34 (3)
2 Август, 14:15 (2)
2 Август, 13:34 (7)
2 Август, 13:04 (3)
2 Август, 12:28
Море работы для программистов, сисадминов, вебмастеров.
Иди и выбирай!
|
|
| IT-консалтинг | Software Engineering | Программирование | СУБД | Безопасность | Internet | Сети | Операционные системы | Hardware |
| PR-акции, размещение рекламы — , тел. +7 495 6608306, ICQ 232284597 | Пресс-релизы — |
|
|
|
| This Web server launched on February 24, 1997 Copyright © 1997-2000 CIT, © 2001-2009 |
|
|
| Внимание! Любой из материалов, опубликованных на этом сервере, не может быть воспроизведен в какой бы то ни было форме и какими бы то ни было средствами без письменного разрешения владельцев авторских прав. |
|
Супер предложение: от авторитетного интернет-магазина. |
Open Tools API
Open Tools API — это набор интерфейсов; они предоставляют доступ к среде Delphi и позволяют управлять файлами и проектами. Основной объект Open Tools API — ToolServices — это глобальная переменная. При запуске Delphi создается экземпляр класса TIToolServices, и переменной ToolServices присваивается ссылка на него. Эксперты могут использовать ToolServices для доступа к функциям среды разработки.Любой сервис, предоставляемый Open Tools API, прямо или косвенно вызывается через ToolServices. В приведено краткое описание Open Tools API.
Переопределение методов — задача довольно простая; она предполагает написание всего нескольких строк кода. Например, реализация метода GetStyle вряд ли отнимет у вас много времени:
function MyExpert.GetStyle:
TexpertStyle
begin
Result := [esStandard];
end;
Реализация класса TIExpert
Для создания нового эксперта необходимо наследовать новый класс от класса TIExpert, переопределив при этом часть его методов (таблица 2)Возможность переопределени методов экспертов тех или иных стилей
Все девять методов () предоставляют информацию об эксперте и организуют его взаимодействие со средой. TIExpert — это абстрактный виртуальный класс с заданными, но не реализованными функциональными возможностями. От этого класса будут порождены другие, имеющие необходимые возможности.
Определение класса TIExpert приведено далее.
TIExpert = class(TInterface)
public
{ Методы пользовательского
интерфейса с экспертом }
function GetName: string;
virtual; stdcall; abstract;
function GetAuthor: string;
virtual; stdcall; abstract;
function GetComment: string;
virtual; stdcall; abstract;
function GetPage: string;
virtual; stdcall; abstract;
function GetGlyph: HICON;
virtual; stdcall; abstract;
function GetStyle:
TExpertStyle; virtual; stdcall;
abstract;
function GetState:
TExpertState; virtual; stdcall;
abstract;
function GetIDString: string;
virtual; stdcall; abstract;
function GetMenuText: string;
virtual; stdcall; abstract;
{ Запуск эксперта }
procedure Execute; virtual;
stdcall; abstract;
end;
Регистрация экспертов
Зарегистрировать эксперт можно одним из двух способов. Первый способ сводится к определению эксперта как компонента путем вызова процедуры RegisterLibraryExpert из процедуры Register. Второй способ заключается в создании DLL-библиотеки эксперта. Преимущество первого способа в том, что не приходитс закрывать среду Delphi при внесении изменений в эксперт — достаточно его перекомпилировать. Сперва рассмотрим регистрацию эксперта как компонента. Необходимо добавить в модуль эксперта процедуру Register:Procedure Register;
Implementation {$R*.DFM}
Procedure Register;
Begin
RegisterLibraryExpert
(TPowerExpert. Create);
// TpowerExpert — это класс регистрируемого эксперта
End;
Для регистрации эксперта как DLLбиблиотеки следует выполнить две операции: реализовать новый проект DLL и изменить содержимое системного реестра Windows. Итак, создаем DLL. Выполните команду File р New, а затем укажите Delphi, что необходимо создать DLL. В результате появится новое окно модуля с неким набором исходного кода. После этого следует экспортировать функцию InitExpert. Обратите внимание, что эта функция экспортируется с помощью специальной константы ExpertEntryPoint, которую Delphi определяет для всех экспертов, создаваемых в виде DLL. Основное назначение функции InitExpert — возврат ссылки на объект ToolServices для дальнейшего использования и вызова процедуры RegisterProc, которая, собственно, и регистрирует эксперт. Ниже приведена реализация этой функции:
Function InitExpert(
ToolServices:ToolServices;
RegisterProc:TexpertRegisterProc;
var
Terminate:TExpertTerminateProc):
Boolean; export; stdcall;
implementation
procedure TerminateExpert;
begin
// завершение работы эксперта
end;
function InitExpert(
ToolServices:ToolServices;
RegisterProc:TExpertRegisterProc;
var
Terminate:TExpertTerminateProc):
Boolean; export; stdcall;
begin
Result:=False;
end;
// проверка, является ли запущенное приложение единственным
if (ToolServices=nil) or Assigned(ExptIntf.ToolServices)
then Exit;
ExptIntf.ToolServices:=ToolServices;
//сохраняем указатель на ToolServices
Application.Handle:=
ToolServices.GetParentHandle;
//сохраняем указатель на
ToolServices для родительского
окна
Terminate:=TerminateExpert;
//устанавливаем процедуру завершения
RegisterProc(TGenericExpert.Create);
//регистрация эксперта
Result:=True;
end;
Когда DLL с экспертом будет готова, от вас потребуется лишь изменить системный реестр так, чтобы Delphi “знала” расположение библиотеки с экспертом и смогла ее загрузить. Для этого с помощью редактора реестра (regedit.exe) добавьте в реестр такую запись:
HKEY_CURRENT_USER\Software\Borland\ Delphi\4.0\Experts
MyExpert=C:\MyExpertts\MyExpert.DLL
Для того чтобы среда зарегистрировала DLL, Delphi необходимо перезапустить. Вариант реализации эксперта в виде DLL кажетс автору менее удобным: перезагрузка среды отнимает больше времени по сравнению с перекомпиляцией библиотеки компонентов, что особенно ощутимо при отладке эксперта. Еще одна проблема — неполна совместимость экспертов в виде DLL, которые были созданы и скомпилированы для других версий Delphi. Автор надеется, что эта стать поможет профессионалам поближе познакомиться с экспертами Delphi. Возможно, ее публикация подтолкнет многих программистов к изучению темы.
Стили экспертов
| Стиль | Способ вызова |
| Стандартный | Добавить в подменю Help пункт меню |
| Надстройки | То же в определенное экспертом подменю пункт меню |
| Формы | - // - во вкладку Forms диалогового окна New Items пиктограмму эксперта |
| Проекта | - // - во вкладку Projects диалогового окна New Items то же |
Следует заметить, что интерфейс Open Tools API доступен только из программ, запущенных как часть интегрированной среды Delphi. В следующем разделе мы рассмотрим несколько полезных экспертов.
Delphi - сбориник статей
Часть I
В данной статье излагается материал о проблемах связанных с созданием анимированных 3D пресонажей в приложениях использующих OpenGl. Статья расчитана в основном на продвинутого читателя. Для наилучшего восприятия желательно иметь опыт работы со средой программирования Delphi, а также весьма не помешает знать библиотеку OpenGL, графический пакет 3D Studio Max и его расширение Character Studio. Все это требуется потому, что данная статья не является справочником ни по одному из указанных инструментов и содержит описание только тех действий, которые необходимо выполнить для экспорта персонажей из 3D Studio Max и вывода их на экран средствами Delphi и OpenGL.Что такое нормали?
Нормалью называется перпендикуляр к чему-либо. В нашем случае это перпендикуляр к грани. Хотелось бы, но, к сожалению, без нормалей никак не обойтись. Дело в том, что по нормалям расчитывается освещение объекта. Так, например, если нормаль грани направлена на источник света, то грань будет освещена максимально. Чем больше нормаль отвернется от источника света, тем менее грань будет освещена. В случае с OpenGL, если нормаль отвернется от экрана более чем на 90 градусов, мы вообще не увидим грань, она не будет отрисовываться. Если бы мы не использовали нормали, то наш объект был бы закрашен одним цветом, то есть мы бы увидели только силует объекта. Трехмерный эффект достигается окрашиванием граней объекта в разные по яркости цвета, или наложением теней, кому как больше нравится это называть. Кроме того, степень освещенности зависит также от длины вектора нормали, но, как правило, длина вектора нормали должна находится в пределах (0; 1).Теперь я думаю, стало ясно, что такое нормали и зачем они нужны.
Формат файла GMS
Файл GMS это текстовый файл открытого формата, что означает, что даже человек не знакомый с его описанием может создать приложение, считывающее из него информацию. Тем не менее, приведу на всякий случай описание этого файла. New object // Указывает на начало нового объекта, // следующая строка указывает тип объекта TriMesh() // Объект - сетка numverts numfaces // Указывает, что следующая строка // содержит количество вершин // и граней для данного объекта Mesh vertices: // Здесь располагается блок вершин объекта // в виде координат X Y Z end vertices Mesh faces: // Здесь располагается блок граней объекта в виде // индексов 1 2 3, где каждый индекс - индекс // в массиве вершин, указывает на вершину грани end faces Faset normals: // Здесь располагается блок фасетных нормалей // в виде координат X Y Z. // Их количество равно количеству граней end faset normals Smooth normals: // Здесь располагается блок сглаживающих нормалей // в виде координат X Y Z. // Их количество равно количеству вершин. end smooth normals end mesh // Конец описания объекта Tri Mesh end of file // Конец файлаПримерно так выглядит файл, когда мы экспортируем сетчатый объект. Если объект не сетчатый, то файл будет выглядеть следующим образом: New object // Указывает на начало нового объекта, // следующая строка указывает тип объекта <Тип объекта>, например: Box // Здесь идут параметры, зависящие от типа объекта // (Поверхности Безье и NURBS - // поверхности не поддерживаются) end <Тип объекта> // Конец описания объекта end of file // Конец файла
Рекомендуемая литература
Полный архив : ( 561 K) файлы проектов + GMS файлы + утилита MEGA.ms document.write('');
Архив новостей
2 Август, 17:53 (19)
2 Август, 17:51 (34)
2 Август, 15:40 (42)
2 Август, 15:35 (1)
2 Август, 14:54 (3)
2 Август, 14:34 (3)
2 Август, 14:15 (2)
2 Август, 13:34 (7)
2 Август, 13:04 (3)
2 Август, 12:28
Море работы для программистов, сисадминов, вебмастеров.
Иди и выбирай!
|
|
| IT-консалтинг | Software Engineering | Программирование | СУБД | Безопасность | Internet | Сети | Операционные системы | Hardware |
| PR-акции, размещение рекламы — , тел. +7 495 6608306, ICQ 232284597 | Пресс-релизы — |
|
|
|
| This Web server launched on February 24, 1997 Copyright © 1997-2000 CIT, © 2001-2009 |
|
|
| Внимание! Любой из материалов, опубликованных на этом сервере, не может быть воспроизведен в какой бы то ни было форме и какими бы то ни было средствами без письменного разрешения владельцев авторских прав. |
|
Рекомендуем купить от авторитетной компании. |
Соглашения
Автор дает полное право всем желающим на копирование, распространение и модификацию файлов примеров программ. Авторские права на данную статью принадлежат Ивану Дышленко. Право на копирование и изменение любой части текста данной статьи принадлежит только автору, данную статью разрешается копировать и распространять только полностью, с файлами и примерами программ. Не разрешается модифицировать и распространять модифицированные варианты утилиты MEGA.ms, поскольку утилита будет наращиваться и автору хотелось бы избавить пользователей от проблем с вопросами совместимости.Создание анимированного персонажа и вывод на экран
Специально для тех, кто не владеет навыками работы с 3D Studio Max и Character Studio, я создал модель бегающего человечка. Она находится в папке MAX, и файл называется BodyRun.max. Если у Вас вообще нет пакета 3D Studio Max, то файл GMS с сетками этого человечка находится в папке GMS и называется ManRun.gms.
Итак, запустите среду 3D Studio Max и создайте анимированного персонажа или загрузите его из файла BodyRun.max. Запустите утилиту MEGA, как это делалось в разделе Знакомство с утилитой MEGA V1.0. Установите значение поля From =0, значение поля To установите в кадр, на котором заканчивается анимация, в случае с файлом BodyRun.max это значение нужно установить в 11. Значение поля Step установите в еденицу. Выделите сетку персонажа.
Внимание: убедитесь, что Вы выделили именно сетку персонажа и только ее. Пометьте флажок Selected Only. Для анимации сетки используется скелет. Он создается и подгоняется под размеры и форму тела, затем вершины сетки связываются с костями скелета. При анимации изменяются параметры положения частей скелета, а сетка лишь следует за ними. Поэтому, всегда, когда используется этот подход, в сцене помимо сетки присутствует скелет. Вот почему необходимо выделить только сетку и пометить флажок Selected Only.
После того, как Вы выполнили все операции укзанные выше, экспортируйте объект в файл GMS. В процессе экспорта Вы должны увидеть, как последовательно перемещается ползунок расположенный внизу экрана, отсчитывая кадры анимации, и как меняются кадры в проекционных окнах 3D Studio Max. Процесс экспорта завершится, когда ползунок достигнет конечного значения.
Готовый проект лежит в папке Ch02. Откомпилируйте его и запустите на выполнение. На экране вы должны увидеть примерно то, что изображено на рисунке. Нажатием кнопки "Анимировать" можно запускать или останавливать анимацию. Если Ваш компьютер оснащен 3D ускорителем, то лучше развернуть окно на весь экран - так медленнее. Теперь разберем исходный код программы. Он дополнился новым объектом TGLMultyMesh, который создан для загрузки и последовательной отрисовки нескольких сетчатых объектов. TGLMultyMesh = class Meshes : TList; CurrentFrame : Integer; Action : Boolean; fExtent : GLFloat; Extent : Boolean; public procedure LoadFromFile( const FileName : String ); procedure Draw; constructor Create; destructor Destroy; override; published end;
Список Meshes хранит все сетки загруженные из файла. Переменная Action указывает выполняется анимация или нет, а CurrentFrame содержит номер текущего кадра анимации. procedure TGLMultyMesh.LoadFromFile; var f : TextFile; S : String; procedure ReadNextMesh; var i : Integer; Vertex : TGLVertex; Face : TGLFace; MaxVertex : GLFloat; NextMesh : TGLMesh; begin NextMesh := TGLMesh.Create; repeat ReadLn(f, S); until (S = 'numverts numfaces') or eof(f); // Читаем количество вершин и граней Readln(f,NextMesh.VertexCount,NextMesh.FacesCount); // Выделяем память для хранения сетки GetMem(NextMesh.Vertices, NextMesh.VertexCount*SizeOf(TGLVertex)); GetMem(NextMesh.Faces, NextMesh.FacesCount*SizeOf(TGLFace)); GetMem(NextMesh.FasetNormals, NextMesh.FacesCount*SizeOf(TGLVector)); ReadLn(f,S); // Пропускаем строку Mesh vertices: // Считываем вершины for i := 0 to NextMesh.VertexCount - 1 do begin Readln(f,Vertex.x,Vertex.y,Vertex.z); NextMesh.Vertices[i] := Vertex; end; ReadLn(f,S); // Пропускаем строку end vertices ReadLn(f,S); // Пропускаем строку Mesh faces: // Считываем грани for i := 0 to NextMesh.FacesCount - 1 do begin Readln(f,Face[0],Face[1],Face[2]); Face[0] := Face[0] - 1; Face[1] := Face[1] - 1; Face[2] := Face[2] - 1; NextMesh.Faces[i] := Face; end; // Рассчитываем масштаб MaxVertex := 0; for i := 0 to NextMesh.VertexCount - 1 do begin MaxVertex := Max(MaxVertex,NextMesh.Vertices[i].x); MaxVertex := Max(MaxVertex,NextMesh.Vertices[i].y); MaxVertex := Max(MaxVertex,NextMesh.Vertices[i].z); end; NextMesh.fExtent := 1/MaxVertex; NextMesh.CalcNormals; Meshes.Add(NextMesh); end; begin Meshes := TList.Create; AssignFile(f,FileName); Reset(f); While not Eof(f) do begin Readln(f,S); if S = 'New object' then ReadNextMesh; end; CloseFile(f); end;
Код загрузки объекта TGLMultyMesh практически идентичен коду загрузки объекта TGLMesh. Небольшое отличие состоит в том, что объект TGLMultyMesh предполагает, что файл содержит несколько сеток. Поэтому при загрузке проиходит поиск строки "New Object", создается объект TGLMesh, который помещается в список Meshes и в него считывается информация из файла. Затем весь цикл повторяется до тех пор, пока не кончится файл. Процедуры создания, уничтожения и отрисовки объекта тоже почти не изменились: procedure TGLMultyMesh.Draw; begin if Extent then begin fExtent := TGLMesh(Meshes.Items[CurrentFrame]) .fExtent; glScalef(fExtent,fExtent,fExtent); end; // Рисование текущего кадра TGLMesh(Meshes.Items[CurrentFrame]).Draw; // Если включена анимация // увеличить значение текущего кадра if Action then begin inc(CurrentFrame); if CurrentFrame > (Meshes.Count - 1) then CurrentFrame := 0; end; end; constructor TGLMultyMesh.Create; begin Action := False; CurrentFrame := 0; end; destructor TGLMultyMesh.Destroy; Var i : Integer; begin for i := 0 to Meshes.Count - 1 do begin TGLMesh(Meshes.Items[i]).Destroy; end; Meshes.Free; end;
Немного изменился и вызов функции загрузки в модуле frmMain.pas. procedure TfrmGL.N1Click(Sender: TObject); begin if OpenDialog.Execute then begin MyMesh.Destroy; Mymesh := TGLMultyMesh.Create; MyMesh.LoadFromFile( OpenDialog.FileName ); MyMesh.Extent := true; // Проверяем сколько сеток загружено // и возможна ли анимация if MyMesh.Meshes.Count <= 1 then N2.Enabled := False else N2.Enabled := True; end; end; // Включение анимации procedure TfrmGL.N2Click(Sender: TObject); begin MyMesh.Action := not MyMesh.Action; N2.Checked := not N2.Checked; end;
Здесь все должно быть предельно ясно, не будем акцентировать на этом внимание, и так статья длиннее получается, чем я расчитывал.
Да, конечно, человечек убогий. Мало того, что он кривой, так еще и прихрамывает. Что делать, чтобы создавать красивых человечков с минимальным количеством граней нужно быть профессионалом 3D моделирования. Все же, мы еще попытаемся его улучшить.
Вероятно, Вы заметили, огрехи воспроизведения объектов на экране, выражающиеся в каких - то непонятных черных треугольниках в тех местах, где их не должно быть. Сам я понятия не имею, откуда они взялись. Если Вас не удовлетворяет такой вид объектов, значит, настала пора поговорить о нормалях.
я здорово помучался, решая вопрос
В свое время я здорово помучался, решая вопрос - каким же образом создатели игр ухитряются делать трехмерные персонажи двигающиеся в реальном времени. Я предположил, что части тела у персонажей отделены от основного тела, что позволяет независимо поворачивать и перемещать их. Знаете, в Direct3D даже есть понятие фрейма, фрейм - это основное тело, к нему прикрепляются другие тела. Когда фрейм движется, прикрепленные к нему объекты движутся вместе с ним, кроме того, прикрепленные объекты могут двигаться и самостоятельно не влияя на движение фрейма. Все это замечательно подходит для создания механических объектов и персонажей, но совершенно не годится для создания объектов живого мира. Для таких объектов характерна плавность линий и отсутствие изломов на местах стыков частей объекта. Создатели компьютерных игр замечательно решили эту проблему.Как создается двумерная анимация? Рисуется несколько кадров движения, затем поледовательно выводятся на экран и таким образом создается иллюзия движения. То же самое происходит в современных трехмерных компьютерных играх. Создается несколько 3D моделей (сеток), характеризующих фазы движения персонажа в различные моменты времени, затем поледовательно выводятся на экран, создавая иллюзию движения. Возможно, это приводит к повышенному расходу оперативной памяти, поскольку все сетки желательно хранить в памяти, но зато значительно упрощается процесс программирования и, скорее всего, увеличивается скорость работы приложения.
Следующая проблема возникла при попытке экспорта объектов из 3D Studio Max в какой-либо открытый формат, например DXF. Нет ничего сложного в создании трехмерного персонажа с последующей его анимаций, если пользоваться 3D Studio и Character Studio, вся проблема состоит в том, как экспортировать объект чтобы потом файл с сетками объекта можно было использовать в своем приложении. Для этого требуется покадровый экспорт анимированного персонажа, то есть в итоге должен получится файл, содержащий несколько сеток объекта изображающих фазы движений объекта в различные моменты времени, или несколько файлов содержащих одну сетку соответствующую определенному кадру движения. Однако, несмотря на обилие поддерживаемых форматов файлов, 3D Studio Max не обладает возможностью покадрового экспорта трехмерных объектов. Так, напрмер, файл формата 3DS может хранить информацию о положении объекта, его повороте и масштабе, но не в состоянии сохранять деформации сетки в различных кадрах анимации, а именно это нам и нужно. Про файлы формата DXF и ASC даже говорить в данном случае смешно. Я объясню, почему нам нужно сохранять именно деформацию сетки. Дело в том, что наш объект должен состоять из единой, цельной сетки, а не из нескольких объектов, чтобы не было стыков на местах соединений конечностей с телом. Создать анимацию, так чтобы персонаж мог двигать своими конечностями, в этом случае, можно только деформируя сетку, а именно перемещая одни вершины сетки относительно других. Так, например, чтобы персонаж поднял руку нужно переместить вершины руки вверх относительно вершин тела. Теперь, я надеюсь, все понятно? Итак, оказалось, что 3DStudio не в состоянии сохранить подобную анимацию. Однако, не все так печально. Например, есть такой дополнительный модуль для 3DStudio, называется Bones Pro Max, а у него есть инструмент SnapShot, который позволяет делать снимки различных кадров движения объекта. В результате его работы у Вас на рабочем поле 3D Studio Max появляется целое стадо одинаковых трехмерных объектов в различных позах. Правду сказать, я его не нашел, да и выпущен он был уже давно еще под первую версию 3D Studio Max. Поэтому я решил идти другим путем и окунулся во внутренний язык 3D Studi Max - Max Script. Результатом моей деятельности стала простенькая утилита Meshes Export for Games and Animation (MEGA), которая позволяет делать все, о чем я сказал выше и некоторые другие полезные вещи.
Загрузка файла формата GMS в Delphi
Пример загрузки файла GMS находится в папке Ch01. В проекте присутствует два модуля: frmMain.pas и Mesh.pas. Откомпилировав и запустив проект на выполнение вы должны увидеть вращающийся Тор (по-нашему: "Баранка"). Несмотря на то, что объект можно считать стандартным, он был в 3D Studio преобразован в сетку, поэтому в данном случае это именно сетчатый объект. Нажав пункт меню "загрузить", вы можете посмотреть любой объект из папки GMS или загрузить свою сферу, которую сделали сами, если правильно руководствовались моими инструкциями в разделе: Знакомство с утилитой MEGA V1.0. Теперь рассмотрим данный пример подробно. Почти весь код модуля frmMain.pas написан не мной. Он взят из книги "OpenGL графика в проектах Delphi" Михаила Краснова. Этот модуль выполняет инициализацию приложения и циклическую функцию отрисовки окна, поэтому подробно мы его рассматривать не будем. Если код покажется Вам непонятным, значит Вы недостаточно знакомы с OpenGL, в этом случае Вам надлежит обратится к первоисточнику (в смысле - к книге). Код модуля Mesh.pas выполняет загрузку данных из файла и отображение объектов в окне. Рассмотрим его подробнее: Type // Объявление типов данных PGLVertex = ^TGLVertex; // Указатель на вершину TGLVertex = record x,y,z : GLFloat; // Вершина, как три // значения с плавающей точкой end; PGLVector = ^TGLVector; // Указатель на вектор // Вектор, как массив из трех элементов // с плавающей точкой TGLVector = array[0..2] of GLFloat; PGLFace = ^TGLFace; // Указатель на грань // Грань, как массив из трех целочисленных значений TGLFace = array[0..2] of GLInt; // Указатель на массив вершин PGLVertexArray = ^TGLVertexArray; // Массив вершин TGLVertexArray = array[Word] of TGLVertex; // Указатель на массив граней PGLFacesArray = ^TGLFacesArray; // Массив граней TGLFacesArray = array[word] of TGLFace;Здесь требуется небольшое пояснение. Как вы заметили, грань объявлена, как массив из трех целочисленных чисел. Дело в том, что граней почти всегда больше чем вершин. Поэтому все вершины запоминаются в отдельном массиве, а грань - это три индекса в этом массиве, указывающие на вершины принадлежащие грани. Одна вершина может принадлежать нескольким граням.
Теперь рассмотрим описание объекта сетка: TGLMesh = class // Массив вершин объекта - сетка Vertices : PGLVertexArray; // Массив граней Faces : PGLFacesArray; // Массив фасетных нормалей FasetNormals : PGLVertexArray; // Количество вершин VertexCount : Integer; // Количество граней FacesCount : Integer; // Коэффициент масштабирования fExtent : GLFloat; // Флаг масштабирования Extent : GLBoolean; public // Загрузка procedure LoadFromFile( const FileName : String ); procedure CalcNormals; // Расчет нормалей procedure Draw; // Отрисовка // Уничтожение с очисткой массивов destructor Destroy; override; end;
Здесь пояснений практически не требуется. Можно лишь отметить, что Extent служит для того, чтобы объект загнать в размеры в пределах (-1, 1), я сделал это для того, чтобы объект любого размера не мог вылезти за пределы окна. Вообще говоря, в 3D Studio Max не сложно масштабировать объект так, чтобы координаты вершин попали в интервал (-1, 1), но на этапе создания модели думать об этом совсем не хочется. procedure TGLMesh.LoadFromFile; // Загрузка файла var f : TextFile; S : String; i : Integer; Vertex : TGLVertex; Face : TGLFace; MaxVertex : GLFloat; begin AssignFile(f,FileName); Reset(f); // Пропускаем строки, пока не попадется // 'numverts numfaces' repeat ReadLn(f, S); until (S = 'numverts numfaces') or eof(f); // Читаем количество вершин и граней Readln(f,VertexCount,FacesCount); // Выделяем память для хранения сетки GetMem(Vertices,VertexCount*SizeOf(TGLVertex)); GetMem(Faces,FacesCount*SizeOf(TGLFace)); GetMem(FasetNormals,FacesCount*SizeOf(TGLVector)); ReadLn(f, S); // Пропускаем строку "Mesh vertices" // Считываем вершины for i := 0 to VertexCount - 1 do begin Readln(f,Vertex.x,Vertex.y,Vertex.z); Vertices[i] := Vertex; end; ReadLn(f, S); // Пропускаем строку "end vertices" ReadLn(f, S); // Пропускаем строку "Mesh faces" // Считываем грани for i := 0 to FacesCount - 1 do begin Readln(f,Face[0],Face[1],Face[2]); Face[0] := Face[0] - 1; Face[1] := Face[1] - 1; Face[2] := Face[2] - 1; Faces[i] := Face; end; CloseFile(f); // Рассчитываем масштаб MaxVertex := 0; for i := 0 to VertexCount - 1 do begin MaxVertex := Max(MaxVertex,Vertices[i].x); MaxVertex := Max(MaxVertex,Vertices[i].y); MaxVertex := Max(MaxVertex,Vertices[i].z); end; fExtent := 1/MaxVertex; CalcNormals; end;
Здесь могут быть непонятны следующие моменты: В блоке считывания граней я вычитаю единицу из каждого индекса вершины, считанного из файла. Делается это потому, что в программе индексы нумеруются, начиная с нуля, а в файле GMS - начиная с единицы. Процедура CalcNormals служит для расчета нормалей и взята из книги "OpenGL графика в проектах Delphi" Михаила Краснова. О том, что такое нормали и зачем они нужны я расскажу в разделах "Фасетные нормали" и "Сглаживающие нормали". procedure TGLMesh.Draw; var i : Integer; Face : TGLFace; begin if Extent then glScalef(fExtent,fExtent,fExtent); for i := 0 to FacesCount - 1 do begin glBegin(GL_TRIANGLES); Face := Faces[i]; glNormal3fv(@FasetNormals[i]); glVertex3fv(@Vertices[Face[0]]); glVertex3fv(@Vertices[Face[1]]); glVertex3fv(@Vertices[Face[2]]); glEnd; end; end;
Здесь все понятно. Сначала, если установлен флаг масштабирования, устанавливается масштаб одинаковый по всем осям, затем в цикле рисуются треугольники. Перед началом рисования треугольника объявляется нормаль к нему. В качестве параметров передаются не конкретные значения, а указатели на них. destructor TGLMesh.Destroy; begin FreeMem(Vertices,VertexCount*SizeOf(TGLVertex)); FreeMem(Faces,FacesCount*SizeOf(TGLFace)); FreeMem(FasetNormals,FacesCount*SizeOf(TGLVector)); end;
Здесь тоже все понятно, просто освобождается память, занятая объектом. Вызовы процедур загрузки и отрисовки объекта находятся в модуле frmMain и не представляют ничего интересного.
Загрузка фасетных нормалей из файла GMS
Что такое фасетная нормаль? Фасетная нормаль, это самая обычная нормаль к грани, а называется она так по производимому воздействию на изображаемый объект. После применения фасетных нормалей грани объекты хоть и освещены по-разному, но каждая грань освещена равномерно и соответственно закрашена одним цветом, что приводит к тому, что объект выглядит граненым. Отсюда и название. По-нашему "фасетная нормаль" это "граненая нормaль". В предыдущих примерах фасетные нормали рассчитывались по математическому алгоритму (процедура CalcNormals), но по всей видимости он иногда дает сбои. Не все то хорошо для программиста, что хорошо для математика. В результате и появляются черные треугольники там где их не должно быть.
К счастью, внутренний язык 3D Studio Max позволил мне найти фасетные нормали, которые он использовал для отображения объекта, а отображались объекты в 3D Studio Max правильно. Приложение, использующее нормали, взятые из 3D Studio Max, находится в папке Ch03. А какая при этом получается разница, Вы можете увидеть на картинках ниже:
Теперь наша баранка выглядит правильно. В процедуре загрузки сетки добавился блок считывания фасетных нормалей из файла GMS. Процедуру CalcNormals я оставил в исходном тексте, но закоментировал. ReadLn(f, S); //Пропускаем строку "end faces" ReadLn(f, S); // Пропускаем строку "Faset normals" // фасетные нормали for i := 0 to FacesCount - 1 do begin Readln(f,Normal.x,Normal.y,Normal.z); FasetNormals[i] := Normal; end;
Естественно, что количество фасетных нормалей равняется количеству граней.
Загрузка сглаживающих нормалей из файла GMS
Все-таки, несмотря на то, что объект теперь отображается правильно, хочется чего-то еще. Ну кому понравится граненая баранка? Или футбольный мяч такой, будто его вытесали из гранита? И, несмотря на то, что уровень детализации в данном примере не высок, можно еще улучшить внешний вид объекта. На помощь приходят сглаживающие нормали. Об этом стоит рассказать подробнее.Когда я понял, что, используя команду glShadeModel, мне не удастся сгладить мой объект (и у Вас не получится тоже), я затосковал. Нужно было что-то делать, и я решил заняться этим вопросом вплотную. Вот что мне удалось выяснить. Оказывается к одной грани можно построить не одну нормаль, а столько, сколько душа пожелает. Но это еще ничего не дает. А вот если мы нормаль отклоним в сторону, так что она станет, не перпендикулярна грани, то грань окрасится неравномерно. Конечно, слова о том, что "нормаль не перпендикулярна", могут показаться немного странными для математика, но программиста это смущать не должно :). Я попробую пояснить подробнее, что же получается в этом случае, на рисунках.
Взгляните на них. Как видно из рисунков, мы имеем четырехугольную грань, в каждом углу которой построена нормаль. На первом рисунке все нормали перпендикулярны грани, и грань выглядит плоской. На втором рисунке нормали разведены в стороны от центра грани и грань освещена неравномерно, так будто она выпукла, хотя на самом деле она плоская. Если же свести нормали к центру грани, то грань станет вогнутой.
Это можно применять следующим образом. Чтобы добиться эффекта сглаживания, строить нормали нужно к вершинам грани, на каждую вершину по одной нормали. Для построения нормали, необходимо узнать к каким граням принадлежит вершина (теоретически вершина может принадлежать бесконечному числу граней - на практике не больше 12), взять фасетные нормали от этих граней, расчитать от них среднюю нормаль и построить ее к вершине. Как это сделать? Какими формулами это считается? Честно говоря, я понятия не имею. Есть такой сайт: Ната Робинсона, там лежит пример на сглаживание и не только. Правда, написан он на Сях. Мне бы не составило труда переписать его на Дельфи, но... Зачем утруждать себя, если есть Баунти? Снова берем 3D Studio Max, лезем внутрь, хватаем сглаживающие нормали и... Вуаля!
Проект находится в папке Ch04. Скомпилируйте его и запустите на выполнение. Теперь Вы можете наслаждаться внешним видом сглаженного бублика нажав на кнопку Фасеты/Сгладить. Выглядит это примерно так:
Код программы, как всегда существенно не изменился. В процедуру загрузки добавился блок загрузки сглаживающих нормалей: ReadLn(f,S); // Пропускаем строку end faset normals ReadLn(f,S); // Пропускаем строку SmoothNormals: // Считываем сглаживающие нормали for i := 0 to NextMesh.VertexCount - 1 do begin Readln(f,Normal.x,Normal.y,Normal.z); NextMesh.SmoothNormals[i] := Normal; end;
Процедура отрисовки претерпела "существенные" изменения: procedure TGLMesh.Draw(Smooth: Boolean); var i : Integer; Face : TGLFace; begin for i := 0 to FacesCount - 1 do begin glBegin(GL_TRIANGLES); Face := Faces[i]; if Smooth then begin // Если сглаживать тогда перед каждой // вершиной рисуем сглаживающую нормаль glNormal3fv(@SmoothNormals[Face[0]]); glVertex3fv(@Vertices[Face[0]]); glNormal3fv(@SmoothNormals[Face[1]]); glVertex3fv(@Vertices[Face[1]]); glNormal3fv(@SmoothNormals[Face[2]]); glVertex3fv(@Vertices[Face[2]]); // Если не сглаживать один раз рисуем // фасетную нормаль end else begin glNormal3fv(@FasetNormals[i]); glVertex3fv(@Vertices[Face[0]]); glVertex3fv(@Vertices[Face[1]]); glVertex3fv(@Vertices[Face[2]]); end; glEnd; end; end; procedure TGLMultyMesh.Draw; begin if Extent then begin fExtent := TGLMesh(Meshes.Items[CurrentFrame]) .fExtent; glScalef(fExtent,fExtent,fExtent); end; TGLMesh(Meshes.Items[CurrentFrame]).Draw(fSmooth); if Action then begin inc(CurrentFrame); if CurrentFrame > (Meshes.Count - 1) then CurrentFrame := 0; end; end;
Сам объект TGLMesh дополнился массивом для сглаживающих нормалей, а TGLMultyMesh - флагом указывающим следует ли сглаживать или нет. Этот флаг передается в процедуру отрисовки объекта TGLMesh. Деструктор пополнился строкой уничтожающей массив сглаживающих нормалей. В модуле frmMain появился обработчик нажатия пункта меню Фасеты/Сгладить.
Вот, пожалуй, и все. Могу только добавить, что не всегда удобно пользоваться сглаживающими нормалями из файла GMS, хотя в большинстве случаев они подходят. Загрузите, к примеру, объект Zban.gms и установите сглаживающий режим. Видите, все сглажено, а в 3D Studio Max он выглядел по-другому. Сверху и снизу у него были полукруглые крышки, но посередине был четкий цилиндр, с резкой границей в местах состыковки с полукруглыми крышками. Это побочный эффект сглаживания. Если Вы хотите добится исчезновения этого эффекта, Вам придется написать приложение для ручной корректировки нормалей, или программно отслеживать ситуацию, когда излом достиг критического угла и следует воспользоваться фасетной нормалью. Теперь, пожалуй, действительно все.
с этой утилитой Вам понадобится
Для ознакомления с этой утилитой Вам понадобится графический пакет 3D Studio Max 3.0 и, собственно, сама утилита. Она расположена в папке Utility и называется MEGA.ms. Это не исполняемый файл, а текстовый файл с набором команд для 3D Studio Max написанных на языке Max Script.
Как работает утилита: При экспорте файла, берется значение из поля From и ползунок счетчика кадров расположенный внизу экрана премещается на позицию, соответствующую этому значению. Затем в выходной файл экспортируется объект в том виде, в каком он пребывает на данный момент на экране. После чего снова передвигается ползунок кадров на величину, введенную в поле Step. Снова записывается модель соответствующая этому кадру. И так до тех пор, пока ползунок не переместится на позицию соответствующую значению, введенному в поле To. Поскольку в данном примере мы не создавали анимацию, то нам нужен был только один кадр. Утилита экспортировала кадр №1, затем добавила к нему значение 100. Номер кадра стал равен 101. Поскольку это значение больше значения введенного в поле To, процесс экспорта на этом остановился. Если бы в поле From было введено значение 0, то было бы экспортировано 2 кадра с номерами 0 и 100 соответственно. Если пометить галочкой опцию Selected Only, то экспортироваться будут только выделенные объекты, это иногда бывает очень нужно, в противном случае будут экспортированы все объекты сцены. Теперь рекомендую рассмотреть формат файла GMS.
Delphi - сбориник статей
Использование форм, созданных ранее
Если необходимо использовать формы, созданные ранее, то нет необходимости переписывать их заново. Необходимо проделать следующие операции:Создание базовой формы
Для начала определим типы кнопок, которые необходимо обрабатывать. Для этого создадим тип TPrButton как набор.Далее воспользуемся механизмом наследования и создадим базовую форму, у которой определим:
На основе выше изложенного имеем:
|
type TPrButton = (prPrint, prPreview, prExport);
TfrmParent = class(TForm) procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } public { Public declarations } function ButtonUpdate(PrButton: TPrButton): Boolean; virtual; procedure ButtonExecute(PrButton: TPrButton); virtual; end; |
Создание главной формы
Займемся созданием главной формы. Главная форма должна предоставляить механизм обработки набора кнопок. Для этого на главной форме создадим список операций (ActionList) и определим 3 операции (ActionItem): ActionPrint, ActionPreview, ActionExport. Создадим панель инструментов с набором кнопок: Печать, Предварительный просмотр и Экспорт и назначим этим кнопки соответствующие операции. Для каждой операции назначим один и тот же метод обработки событий OnUpdate|
procedure TfrmMain.ActionPrButtonUpdate(Sender: TObject); var m: TPrButton; begin TAction(Sender).Enabled := False;
if Sender = ActionPrint then m := prPrint else if Sender = ActionPreview then m := prPreview else if Sender = ActionExport then m := prExport else Exit;
try TAction(Sender).Enabled := Assigned(Application. MainForm.ActiveMDIChild) and (Application.MainForm.Active MDIChild is TfrmParent) and TfrmParent(Application. MainForm.ActiveMDIChild).ButtonUpdate(m); except TAction(Sender).Enabled := False; end; // try Application.ProcessMessages; end; и OnExecute procedure TfrmMain.ActionPrButtonExecute(Sender: TObject); var m: TPrButton; begin if Not Assigned(Application.MainForm.ActiveMDIChild) or Not (Application.MainForm.ActiveMDIChild is TfrmParent) then Exit; if Sender = ActionPrint then m := prPrint else if Sender = ActionPreview then m := prPreview else if Sender = ActionExport then m := prExport else Exit; TfrmParent(Application.MainForm.ActiveMDIChild). ButtonExecute(m); end; |
Создание наследуемой формы
Для создания наследуемой формы воспользуемся следующим механизмом:Далее необходимо написать собственные обработчики.
Рассмотрим пример на основе формы frmWindow1. Переписываем методы ButtonUpdate и ButtonExecute.
|
type TfrmWindow1 = class(TfrmParent) ... public function ButtonUpdate(PrButton: TPrButton): Boolean; override; procedure ButtonExecute(PrButton: TPrButton); override; end; |
и создаем собственные обработчики методов:
|
function TfrmWindow1.ButtonUpdate(PrButton: TPrButton): Boolean; begin Result := (PrButton = prPrint) and cbCanPrint. Checked or (PrButton = prPreview) and cbCanPreview. Checked or (PrButton = prExport) and cbCanExport. Checked; end; procedure TfrmWindow1.ButtonExecute(PrButton: TPrButton); begin case PrButton of prPrint: ShowMessage( Caption + ' Print'); prPreview: ShowMessage( Caption + ' Preview'); prExport: ShowMessage( Caption + ' Export'); end; end; |
Таким образом при создании нескольких окон класса TfrmWindow1 для каждого окна будет свой обработчик событий.
Delphi - сбориник статей
Более сложные программы.
Сейчас, когда заработала простейшая программа, можно начать осваивать функции обмена данными — именно то, что позволяет осуществить взаимодействие между процессами.Функции двухточечного обмена.
Блокирующая передача (прием) — означает, что программа приостанавливает свое выполнение, до тех пор, пока передача (прием) не завершится. Это гарантирует именно тот порядок выполнения операций передачи (приема), который задан в программе.Блокирующая передача осуществляется с помощью функции MPI_Send. function MPI_Send( buf : pointer; count : longint; datatype : MPI_Datatype; destination : longint; tag : longint; comm : MPI_Comm) : longint;
Осуществляет передачу count элементов указанного типа процессу под номером destination.
| buf | — адрес первого элемента в буфере передачи |
| count | — количество передаваемых элементов в буфере |
| datatype | — MPI-тип этих элементов |
| destination | — ранг процесса-получателя (принимает значения от нуля до n-1, где n — полное число процессов) |
| tag | — тег сообщения |
| comm | — коммуникатор |
В качестве MPI-типа следует указать один из нижеперечисленных типов. Большинству базовых типов паскаля соответствует свой MPI-тип. Все они перечислены в следующей таблице. Последний столбец указывает на число байт, требуемых для хранения одной переменной соответствующего типа.
| MPI_CHAR | shortint | 1 |
| MPI_SHORT | smallint | 2 |
| MPI_INT | longint | 4 |
| MPI_LONG | longint | 4 |
| MPI_UNSIGNED_CHAR | byte | 1 |
| MPI_UNSIGNED_SHORT | word | 2 |
| MPI_UNSIGNED | longword | 4 |
| MPI_UNSIGNED_LONG | longword | 4 |
| MPI_FLOAT | single | 4 |
| MPI_DOUBLE | double | 8 |
| MPI_LONG_DOUBLE | double | 8 |
| MPI_BYTE | untyped data | 1 |
| MPI_PACKED | составной тип | - |
Переменная tag — вспомогательная целочисленная переменная.
MPI-тип MPI_PACKED используется при передаче данных производных типов (сконструированных из базовых типов). Их рассмотрение выходит за рамки данной статьи.
Функция MPI_Recv реализует блокирующий прием данных. function MPI_Recv( buf : pointer; count : longint; datatype : MPI_Datatype; source : longint; tag : longint; comm : MPI_Comm; var status : MPI_Status) : longint;
| buf | — начальный адрес буфера приема |
| count | — максимальное количество принимаемых элементов в буфере |
| datatype | — MPI-тип этих элементов |
| source | — ранг источника |
| tag | — тег сообщения |
| comm | — коммуникатор |
| status | — статус обмена |
Эта функция осуществляет запрос на получение данных. При ее вызове процесс будет ожидать поступления данных от процесса под номером source. Если таковой не последует, то это приведет к повисанию программы (тупик). Так что при использовании этих функций следует проявлять бдительность.
Число принятых элементов может быть меньше значения переменной count. Если же посылаемые данные имеют больший размер, то будет выведено предупреждение об обрывании передачи.
Возвращаемая переменная status содержит информацию о передаче. Например, ее можно использовать, чтобы определить фактическое количество принятых элементов. Для этого используется функция MPI_Get_count function MPI_Get_count(var status : MPI_Status; datatype : MPI_Datatype; var count : longint) : longint;
Число фактически принятых элементов — в возвращаемой переменной count.
Функции коллективного обмена.
Коллективный обмен данными затрагивает не два процесса, а все процессы внутри коммуникатора.Простейшими (и наиболее часто используемыми) разновидностями такого вида взаимодействия процессов являются рассылка MPI_Bcast и коллективный сбор данных MPI_Reduce. function MPI_Bcast( buff : pointer; count : longint; datatype : MPI_Datatype; root : longint; comm : MPI_Comm) : longint;
| buf | — адрес первого элемента буфера передачи |
| count | — максимальное количество принимаемых элементов в буфере |
| datatype | — MPI-тип этих элементов |
| root | — ранг источника рассылки |
| comm | — коммуникатор |
Функция MPI_Bcast реализует "широковещательную передачу". Один процесс ( главный или root процесс) рассылает всем (и себе, в том числе) сообщение длины count, а остальные получают это сообщение. function MPI_Reduce( buf : pointer; result : pointer; count : longint; datatype : MPI_Datatype; operation : MPI_Op; root : longint; comm : MPI_Comm) : longint;
| buf | — адрес первого элемента буфера передачи |
| count | — количество элементов в буфере передачи |
| datatype | — MPI-тип этих элементов |
| operation | — операция приведения |
| root | — ранг главного процесса |
| comm | — коммуникатор |
Функция MPI_Reduce выполняет операцию приведения над массивов данных buf, полученным от всех процессов, и пересылает результат в result одному процессу (ранг которого определен параметром root).
Как и функция MPI_Bcast, эта функция должна вызываться всеми процессами в заданном коммуникаторе, и аргументы count, datatype и operation должны совпадать.
Имеется 12 предопределенных операций приведения
| MPI_MAX | максимальное значение |
| MPI_MIN | минимальное значение |
| MPI_SUM | суммарное значение |
| MPI_PROD | значение произведения всех элементов |
| MPI_LAND | логическое "и" |
| MPI_BAND | побитовое "и" |
| MPI_LOR | логическое "или" |
| MPI_BOR | побитовое "или" |
| MPI_LXOR | логическое исключающее "или" |
| MPI_BXOR | побитовое исключающее "или" |
| MPI_MAXLOC | индекс максимального элемента |
| MPI_MINLOC | индекс минимального элемента |
Использование функций двухточечного обмена.
В следующем примере вычисление значений элементов массива "разводится" по двум процессам uses mpi; const num = 10; var teg, numprocs, myid : longint; i : longint; status : MPI_Status; z, x : double; arr : array[0..num] of double; function f( x : double) : double; begin f := sqr(x); end; begin MPI_Init(argc,argv); teg := 0; MPI_Comm_size(MPI_COMM_WORLD, numprocs); MPI_Comm_rank(MPI_COMM_WORLD, myid); for i := 0 to num do case myid of 0: if i mod 2 = 0 then arr[i] := f(1.0*i) else begin MPI_Recv(@x,1,MPI_DOUBLE,1,teg,MPI_COMM_WORLD,status); arr[i] := x end; 1: if i mod 2 = 1 then begin z := f(1.0*i); MPI_Send(@z,1,MPI_DOUBLE,0,teg,MPI_COMM_WORLD); end; end; // case statement if myid = 0 then for i := 0 to num do writeln(i,' ',arr[i]); MPI_Finalize; end.Формируется массив заданного числа элементов так, что элементы с четными номерами рассчитывает процесс с myid=0, а нечетными — с myid=1. Конечно, вместо функции sqr может стоять любая другая. Программа написана, конечно же, в расчете на то, что процессов будет всего два. Поскольку значения myid, отличные от 0 и 1, не используются, процессы с такими номерами будут простаивать.
Улучшить программу, то есть написать такой ее вариант, чтобы использовались все процессы, предоставляю читателю :)
Использование коллективных функций ( вычисление числа ?).
Следующая программа демонстрирует вычисление определенного интеграла.
if myid=0 then
begin
Assign(fname,'n.in'); {$I-}
Reset(fname); Readln(fname,n); Close(fname); {$I+}
startwtime := MPI_Wtime; end;
MPI_Bcast( @n, 1, MPI_INT, 0, MPI_COMM_WORLD);
if n<>0 then
begin
h := 1.0/n; sum := 0.0; i := myid + 1; while i <= n do
begin
x := h*( i - 0.5); sum := sum + f(x); i := i + numprocs; end; mypi := h*sum; MPI_Reduce( @mypi, @pimy, 1, MPI_DOUBLE, MPI_SUM, 0, MPI_COMM_WORLD);
if myid = 0 then
begin
writeln('; error is', abs(pimy-pi)); endwtime := MPI_WTime; writeln('wall clock ', endwtime-startwtime) end;
end; MPI_Finalize; end.Файл n.in, содержащий в первой строке число разбиений (чем больше число, тем точнее считается ?) должен присутствовать в том каталоге, где находится исполняемый файл.
Обратите внимание на то, что в этой программе нет case-вилок &mdash все процессы вызывают одни и те же функции.
Полезная функция MPI_Wtimefunction MPI_Wtime : double;
возвращает время ( в секундах), прошедшее с некоторого фиксированного момента в прошлом. Гарантируется, что этот фиксированный момент неизменен в течение работы процесса. С помощью этой функции можно отслеживать время вычислений и оптимизировать распараллеливание программы.
В каталоге SDK/Examples также можно найти файл systest.c. Здесь находится версия этой программы, написанная на паскале.
Модуль mpi на FreePascal.
Все вышеописанное относилось к установке собственно MPICH. Для того, чтобы прикрутить библиотеки MPICH к FreePascal, следует еще немножко поработать.Cледует воспользоваться динамической библиотекой mpich.dll, которая располагается в системном каталоге (копируется туда при установке MPICH).
1. Скачать модуль FreePascal, реализующий функции этой динамической библиотеки. Файл mpi.pp
2. Для использования модуля mpi следует просто скопировать файл mpi.pp в каталог, где FreePascal ищет модули (unit searchpath).
Модуль написан с использованием утилиты h4pas.exe и заголовочных файлов *.h из SDK\Include.
Настройка
Настройку можно осуществить с помощью простых утилит, имеющихся в дистрибутиве.Остановимся подробнее на каталоге mpd\bin в директории MPICH. Содержимое каталога:
| mpd.exe | исполняемый файл службы mpich_mpd | нужна |
| MPIRun.exe | файл, осуществляющий запуск каждой MPI-программы. | нужна |
| MPIRegister.exe | программа для шифрования паролей при обмене данными по LAN. | иногда полезна |
| MPDUpdate.exe | программа для обновления библиотек MPI | не нужна |
| MPIConfig.exe | программа настройки хостов в кластере | не нужна |
| guiMPIRun.exe | GUI версия mpirun. | не нужна |
| MPIJob.exe | программа для управления MPI-процессами | не нужна |
| guiMPIJob.exe | GUI версия mpijob.exe | не нужна |
Использование команд mpirun и mpiregister ждет нас впереди. Чтобы удостовериться, что службы MPICH, работающие на разных компьютерах, взаимодействуют должным образом, можно воспользоваться утилитой MPIconfig. Для этого следует
1. Запустить MPIConfig.exe (можно воспользоваться ссылкой в главном меню, она там должна быть)
2. Нажать на кнопку "Select"
3. В появившемся окне выбрать пункт меню "Action"—"Scan hosts"
4. Напротив имени каждой машины должна загореться пиктограмма "MPI" ( примерно вот так)
Основные функции.
Основные функции MPI, с помощью которых можно организовать параллельное вычисление| 1 | MPI_Init | подключение к MPI |
| 2 | MPI_Finalize | завершение работы с MPI |
| 3 | MPI_Comm_size | определение размера области взаимодействия |
| 4 | MPI_Comm_rank | определение номера процесса |
| 5 | MPI_Send | стандартная блокирующая передача |
| 6 | MPI_Recv | блокирующий прием |
Утверждается, что этого хватит. Причем первые четыре функции должны вызываться только один раз, а собственно взаимодействие процессов — это последние два пункта.
Описание функций, осуществляющих передачу, оставим на потом, а сейчас рассмотрим описание функций инициализации/завершения function MPI_Init( var argc : longint; var argv : ppchar) : longint;
Инициализация MPI. Аргументы argc и argv — переменные модуля system, определяющие число параметров командной строки и сами эти параметры, соответственно.
При успешном вызове функции MPI_Init создается коммуникатор ( область взаимодействия процессов), под именем MPI_COMM_WORLD. function MPI_Comm_size( comm : MPI_Comm; var nump : longint) : longint;
Определяет число процессов, входящих в коммуникатор comm. function MPI_Comm_rank( comm : MPI_Comm; var proc_id : longint) : longint;
Определяется ранг процесса внутри коммуникатора. После вызова этой функции все процессы, запущенные загрузчиком MPI-приложения, получают свой уникальный номер (значение возвращаемой переменной proc_id у всех разное). После вызова функции MPI_Comm_rank можно, таким образом, назначать различным процессам различные вычисления. functionnn MPI_Finalize : longint;
Завершает работу с MPI.
Порядок вызова таков:
1. MPI_Init — подключение к MPI
2. MPI_Comm_size — определение размера области взаимодействия
3. MPI_Comm_rank — определение номера процесса
4. Далее идет любая совокупность команд обмена (передача, прием, и тп.)
5. MPI_Finalize — завершение работы с MPI
Простейшая MPI программа такова.
test.pas uses mpi; var namelen, numprocs, myid : longint; processor_name : pchar; begin MPI_Init( argc, argv); MPI_Comm_size( MPI_COMM_WORLD, numprocs); MPI_Comm_rank( MPI_COMM_WORLD, myid); GetMem( processor_name, MPI_MAX_PROCESSOR_NAME+1); // константа MPI_MAX_PROCESSOR_NAME равна 256 namelen := MPI_MAX_PROCESSOR_NAME; MPI_Get_processor_name( processor_name, namelen); Writeln('Hello from ',myid,' on ', processor_name); FreeMem(processor_name); MPI_Finalize; end.
Здесь, как видно, никакого обмена нет, каждый процесс только "докладывает" свой ранг.
Для наглядности выводится также имя компьютера, где запущен каждый процесс. Для его определения используется функция MPI_Get_processor_name. function MPI_Get_processor_name( proc_name : Pchar; var name_len : longint) : longint;
При успешном вызове этой функции переменная proc_name содержит строку с именем компьютера, а name_len — длину этой строки.
После компиляции (с соответствующими опциями) >fpc -dRELEASE [-Fu<каталог, где размещен файл mpi.pp>] test.pas
должен появиться исполняемый файл test.exe, однако рано радоваться. Запуск этого exe-файла не есть запуск параллельной программы.
Полезные ссылки.
1. http://www.mpi-forum.org/ — сайт, посвященный стандарту MPI.2. http://www-unix.mcs.anl.gov/ — официальный сайт MPICH.
3. http://www.parallel.ru/ — ведущий русскоязычный сайт по параллельным вычислениям. На форуме будьте осторожны — там люди программируют на Си !
4. http://www.parallel.uran.ru/doc/mpi_tutor.html — хороший учебник по MPI для начинающих.
Не могу не порекомендовать также и печатную литературу по этой тематике:
1. С. Немнюгин, О. Стесик. Параллельное программирование для многопроцессорных вычислительных систем. "БХВ-Петербург" СПб, 2002.
Основы параллельного программирования изложены в доступной форме, большую часть книги занимает именно описание функций библиотеки MPI.
2. В.Д. Корнеев. Параллельное программирование в MPI. "Институт компьютерных исследований" М, Ижевск, 2003.
Здесь изложение гораздо более "приземленное", что тоже хорошо, так как описываются (и снабжаются кодом на Си) конкретные алгоритмы, использующие параллельные вычисления. document.write('');
Архив новостей
2 Август, 17:53 (19)
2 Август, 17:51 (34)
2 Август, 15:40 (42)
2 Август, 15:35 (1)
2 Август, 14:54 (3)
2 Август, 14:34 (3)
2 Август, 14:15 (2)
2 Август, 13:34 (7)
2 Август, 13:04 (3)
2 Август, 12:28
Море работы для программистов, сисадминов, вебмастеров.
Иди и выбирай!
|
|
| IT-консалтинг | Software Engineering | Программирование | СУБД | Безопасность | Internet | Сети | Операционные системы | Hardware |
| PR-акции, размещение рекламы — , тел. +7 495 6608306, ICQ 232284597 | Пресс-релизы — |
|
|
|
| This Web server launched on February 24, 1997 Copyright © 1997-2000 CIT, © 2001-2009 |
|
|
| Внимание! Любой из материалов, опубликованных на этом сервере, не может быть воспроизведен в какой бы то ни было форме и какими бы то ни было средствами без письменного разрешения владельцев авторских прав. |
|
Французские оптом и в розницу. |
Простейшая MPI программа на FreePascal.
Во именах всех функциях библиотеки MPICH используется префикс MPI_. Возвращаемое значение большинства функций — 0, если вызов был успешным, а иначе — код ошибки.Установка и настройка MPICH.
MPICH для Windows требует1. Windows NT4/2000/XP ( Professional или Server). Под Win9x/ME работать не станет!
2. Сетевое соединение по протоколу TCP/IP между машинами.
Сразу обговорю, что все примеры тестировались на двух машинах, объединенных в локальную сеть. Один компьютер (сетевое имя ILYA) — мой, а второй (сетевое имя EKATERINA) — жены.
Установка.
Компьютеры, участвующие в вычислениях, назовем кластером. MPICH должен быть установлен на каждом компьютере в кластере.Для установки нужно
1. Скачать (5278 Кб) или (5248 Кб)
Либо с официальной страницы MPICH
http://www.mcs.anl.gov/mpi/mpich/download.html
Либо с ftp сервера ftp.mcs.anl.gov/pub/mpi/nt.
2. Если запустить exe файл, то после распаковки запустится интерактивная программа установки MPICH. Чтобы не утомлять себя выбором устанавливаемых компонент, удобнее установить MPICH в неинтерактивном режиме. Для этого
а. Разархивируйте содержимое в общую папку (например, \\ILYA\common)
b. Отредактируйте файл setup.iss
c. Строка szDir=C:\Program Files\MPICH определяет каталог, куда установится MPICH. Это расположение можно изменить.
d. Строки Component-count=7 Component-0=runtime dlls Component-1=mpd Component-2=SDK Component-3=Help Component-4=SDK.gcc Component-5=RemoteShell Component-6=Jumpshot определяют число устанавливаемых компонент. Для главного компьютера (откуда запускается главный процесс) подходящие опции таковы Component-count=4 Component-0=runtime dlls Component-1=mpd Component-2=SDK Component-3=Help Для простого компьютера (которому отводится только роль вычислителя) число компонент может быть сокращено до двух. Component-count=2 Component-0=runtime dlls Component-1=mpd На каждом компьютере кластера выполнить команду установки в неинтерактивном режиме. В моем случае запуск программы установки таков: >\\ILYA\common\setup -s -f1\\ILYA\common\setup.iss
После установки на каждом компьютере должна запуститься служба mpich_mpd (MPICH Daemon (C) 2001 Argonne National Lab). (смотрите рисунок)
Если был установлен компонент SDK (что необходимо сделать на том компьютере, откуда будет производиться запуск программ), то в каталоге MPICH (прописанном в пункте szDir) присутствуют подкаталоги SDK и SDK.gcc. Содержимое этих каталогов — библиотечные и заголовочные файлы для языков C, С++ и Fortran.
Каталог SDK предназначен для компиляторов MS VC++ 6.x и Compaq Visual Fortran 6.x, а каталог SDK.gcc — для компиляторов gcc и g77.
Утилита MPIRegister.exe.
Поскольку компьютеры ILYA и EKATERINA объединены в локальную сеть, у меня нет никаких проблем с безопасностью. Пароль для пользователя mpiuser хранится в открытом виде в файле lgn. Увы, так можно делать далеко не всегда. Если компьютеры, входящие в кластер, являются частью более разветвленной сети, или, более того, используют подключение к Internet, так поступать не просто не желательно, а недопустимо.В таких случаях следует хранить пароль пользователя, от имени которого будут запускаться процессы, в системном реестре Windows в зашифрованном виде. Для этого предназначена программа MPIRegister.exe.
Опции таковы
| mpiregister |
| Запрашивает имя пользователя и пароль (дважды). После ввода спрашивает, сделать ли установки постоянными. При ответе 'yes' данные будут сохранены на диске, а иначе — останутся в оперативной памяти и при перезагрузке будут утеряны. |
| mpiregister -remove |
| Удаляет данные о пользователе и пароле. |
| mpiregister -validate |
| Проверяет правильность сохраненных данных. |
Запускать mpiregister следует только на главном компьютере. Загрузчик приложения mpirun без опции -pwdfile будет запрашивать данные, сохраненные программой mpiregister. Если таковых не обнаружит, то запросит имя пользователя и пароль сам.
О чем эта статья.
Статья посвящена вопросу написания распределенных (параллельных) вычислений с использованием компилятора FreePascal (использовалась версия 2.0.1)Проблема параллельных вычислений заинтересовала меня совсем не потому что это сейчас модно. Столкнулся с задачей, когда надо было сформировать (для дальнейнего анализа) большой массив данных. Хотелось уменьшить время вычислений имеющимися средствами. Оказывается, организовать параллельные вычисления с использованием моего любимого компилятора — вполне решаемая задача.
Стандартом для параллельных приложений для многопроцессорных вычислительных систем де-факто является MPI.
Идея MPI-программы такова: параллельная программа представляется в виде множества взаимодействующих (посредством коммуникационных процедур MPI) процессов.
Параллельные вычисления требуют
1. Разделения процессов
2. Взаимодействия между ними
MPI (Message Passing Interface) — стандарт на программный инструментарий для обеспечения связи между ветвями параллельного приложения.
В этой статье рассматривается MPICH (MPI CHameleon), свободно распространяемая реализация MPI. Использовалась версия MPICH 1.2.5 для Windows.
pp содержит описание 230 функций
Модуль mpi. pp содержит описание 230 функций MPI. У меня нет никакой возможности перечислить их все, да я и не ставил перед собой такой задачи. Я могу лишь гарантировать, что все функции, которые я использовал в приведенных примерах, работают правильно.Если же Вам удалось найти (а еще лучше &mdash исправить) какой-либо баг в файле mpi.pp &mdash большая просьба сообщить об этом мне на .
Замеченные мною баги:
1. Функции MPI_Info_c2f, MPI_Info_f2c и MPI_Request_c2f
Что они делают, я не знаю. В текущем модуле mpi.pp эти функции остаются нереализованными.
Запуск MPI-программы.
Запуск MPI-программы осуществляется с помощью загрузчика приложения mpirun. Формат вызова таков: >mpirun [ключи mpirun] программа [ключи программы]Вот некоторые из опций команды mpirun:
| -np x |
| запуск x процессов. Значение x может не совпадать с числом компьютеров в кластере. В этом случае на некоторых машинах запустится несколько процессов. То, как они будут распределены, mpirun решит сам (зависит от установок, сделанных программой MPIConfig.exe) |
| -localonly x |
| -np x -localonly |
| запуск x процессов только на локальной машине |
| -machinefile filename |
| использовать файл с именами машин |
| -hosts n host1 host2 ... hostn |
| -hosts n host1 m1 host2 m2 ... hostn mn |
| запустить на n явно указанных машинах. Если при этом явно указать число процессов на каждой из машин, то опция -np становится необязательной |
| -map drive: \\host\share |
| использовать временный диск |
| -dir drive:\my\working\directory |
| запускать процессы в указанной директории |
| -env "var1=val1|var2=val2|var3=val3..." |
| присвоить значения переменным окружения |
| -logon |
| запросить имя пользователя и пароль |
| -pwdfile filename |
|
использовать указанный файл для считывания имени пользователя и пароля. Первая строка в файле должна содержать имя пользователя, а вторая — его пароль) |
| -nocolor |
| подавить вывод от процессов различным цветом |
| -priority class[:level] |
|
установить класс приоритета процессов и, опционально, уровень приоритета. class = 0,1,2,3,4 = idle, below, normal, above, high level = 0,1,2,3,4,5 = idle, lowest, below, normal, above, highest |
| по умолчанию используется -priority 1:3, то есть очень низкий приоритет. |
Для организации параллельного вычисления на нескольких машинах следует
1. На каждом компьютере, входящем в кластер, завести пользователя с одним и тем же именем (например, MPIUSER) и паролем (я дал ему пароль "1"), с ограниченными привилегиями.
2. На главном компьютере (в моем случае это, разумеется, ILYA) создать сетевую папку (например, COMMON). Следует озаботиться, чтобы пользователь MPIUSER имел к ней полный доступ.
3. В той же папке создать файл, содержащий имя пользователя, от чьего имени будут запускаться процессы, а также его пароль. В моем случае содержимое этого файла должно быть таким: mpiuser 1Я назвал это файл lgn.
После всех этих действий запуск MPI программы test осуществить можно как >mpirun -pwdfile \\ILYA\COMMON\lgn -hosts 2 ILYA 1 EKATERINA 1 \\ILYA\COMMON\test.exe
Изменив соответствующие опции, можно запускать различное число процессов. Например >mpirun -pwdfile \\ILYA\COMMON\lgn -hosts 2 ILYA 3 EKATERINA 3 \\ILYA\COMMON\test.exe
На рисунке виден результат такого вызова. Вывод от различных процессов выделяется различным цветом, поскольку опция -nocolor отключена. Обратите внимание на то, что последовательность номер выводимой строки вовсе не совпадает с номером процесса. Этот порядок будет меняться от случая к случаю.
На этом рисунке запечатлен Диспетчер задач при запуске на компьютере EKATERINA четырех процессов. Установлен приоритет по умолчанию.
Delphi - сбориник статей
Будьте недоверчивы
Очень часто алгоритмы кодируются из расчета на "нормальный" режим работы (достаточно ресурсов, присутствуют все необходимые компоненты, пользователи нажимают правильные комбинации клавиш и т.д.). Такие реализации очень плохо справляются с возникающими возмущениями. Во избежание этих проблем следуйте следующим простым правилам:Частота выделения-освобождения ресурсов
Очевидно, что скорость потери ресурсов (памяти, дескрипторов и т.д.) пропорциональна частоте их выделения. Рассмотрите варианты реализации, в которых ресурсы выделяются наиболее редко. Таким образом, вы сможете отсрочить крах программы, и некоторые пользователи могут даже и не узнать, что с ней что-то не так.Пример:
Допустим, в объекте есть метод DoSomething. В процессе работы он выделяет и освобождает память, которая нужна только ему. С точки зрения "выделения ресурсов по месту их использования" - все корректно, но при многократном обращении к этому методу и в случае наличия ошибки при освобождении памяти вы можете получить достаточно интенсивную утечку памяти. В данной ситуации имеет смысл рассмотреть одноразовое выделение памяти при создании объекта и освобождении при его разрушении. В данной ситуации при наличии ошибки скорость утечки будет гораздо меньше. Естественно, что данное решение необходимо рассматривать в комплексе с другими задачами (производительность, минимизация расхода ресурсов и т.д.)
Циклические ссылки модулей и "осведомленность" сущностей
Технически, Object Pascal позволят создать циклические ссылки между модулями. Их наличие в программе или библиотеке свидетельствует о не очень удачной декомпозиции (IMHO). Негативными последствиями их использования есть:Избегайте использования циклических ссылок модулей. Старайтесь организовать "осведомленность" сущностей древовидной (сущности верхнего уровня знают о существовании сущностей нижнего уровня, но не наоборот). Обратное взаимодействие можно реализовывать посредством механизма событий (процедурных переменных) или при помощи сущностей "посредников".
Пример
Предположим, мы разрабатываем приложение, в котором должны производиться некоторые вычисления и процесс этих вычислений, должен представляться пользователю. Грубо говоря, в данной ситуации мы имеем две сущности: "интерфейс пользователя" и "вычислительный механизм". Они оба должны взаимодействовать друг с другом: "интерфейс пользователя" должен настраивать "вычислитель" и запускать его на выполнение, а "вычислитель" должен выдавать информацию о ходе расчетов. Можно предложить следующий вариант решения:
Модули интерфейса пользователя и вычислителя работают непосредственно друг с другом, т.е. "интерфейс пользователя" вызываем методы "вычислителя" и наоборот. Все будет работать великолепно, пока не окажется, что "вычислитель" необходимо использовать в другой задаче с другим интерфейсом пользователя (или без оного вообще). Обойти данную проблему можно, если в "вычислителе" задачу общения с "внешним миром" (в данном случае - интерфейс пользователя) возложить на функции обратного вызова (callback functions). При таком подходе, заинтересованная сторона регистрируется у "вычислителя", и он будет вызывать ее функции, не подозревая, с кем имеет дело.
Анализ:
В первом случае мы имели двунаправленную "осведомленность" сущностей друг о друге, что привело к проблемам с повторным использованием кода "вычислителя". Во втором случае у нас только однонаправленная "осведомленность" сущностей, т.е. "интерфейс пользователя" знает о вычислителе, но не наоборот. Если необходимо повторно использовать код "интерфейса пользователя", можно пойти дальше - сущность "приложение" знает о существовании сущностей "интерфейс пользователя" и "вычислитель", но последние ничего не знают друг о друге и взаимодействуют через сущность "приложение", исполняющую роль посредника.
Функции, процедуры и состояния
Для начала словарь терминов: Функция - это подпрограмма, задачей которой является получение (извлечение, вычисление и т.д.) определенного значения на основании входных параметров и текущего состояния системы. Процедура - это подпрограмма, которая предназначена для выполнения каких либо действий над системой, и соответственно изменяет состояние системы. Просьба не путать эти определения с ключевыми словами function и procedure.Правило:
Подпрограмма должна быть либо функцией, либо процедурой. Не совмещайте эти две задачи в одной подпрограмме, разделите ее на несколько подпрограмм.
Инициализация переменных и полей
Неинициализированные переменные часто становятся причинами возникновения ошибок-фантомов. Обычно они имеют нерегулярную природу, и их трудно выявить в процессе отладки. Особенно катастрофичными могут быть последствия при таком обращении с указателями.Правило:
Пример
| type TStrArray = array[1..10] of string; var A : TStrArray; ... FillChar(A, SizeOf(A), 0); |
В данном примере вызов процедуры FillChar проинициализирует строки пустыми значениями, такой подход был нормальным в ранних версиях Delphi и Borland Pascal, но недопустим в последних версиях, в которых тип string по умолчанию соответствует типу LongString и суть указатель. Если значения строк перед инициализацией были не пусты, то мы получим утечку памяти.
Интерфейсы объектов
Четко специфицируйте, какие методы, свойства и поля могут быть доступны и каким образом. "Прячьте" методы, свойства и поля, которые не должны быть доступны извне. Не давайте возможность пользоваться "недокументированными" возможностями ваших объектов. Если по каким либо причинам скрыть эти элементы не получается (к сожалению, система прав доступа к элементам объекта в Delphi несовершенна), тогда не забудьте оформить соответствующий комментарий.Исключения в обработчике события OnTimer
При написания обработчика события OnTimer компонента TTimer необходимо учитывать, что возникновение исключения в нем для обычного Delphi приложения без специализированной обработки исключений приведет к выскакиванию диалога с сообщением об ошибке. Но это не останавливает работу таймера. И если причина возникновения исключения устойчива, то скоро вы увидите следующее сообщения и т.д., пока у системы не закончатся какие-нибудь ресурсы.Решить данную проблему можно несколькими способами:
Использование констант
Используйте именованные константы. Это увеличивает "настраиваемость" исходного кода. А также избавляет от проблем связанных с изменением значения константы в случае ее множественного вхождения.Контроль достижения предела
Довольно часто встречаются случаи, когда контроль достижения предела цикла осуществляется условием равенства.Пример
| Repeat ... Inc(I); Until I = Limit; |
Что произойдет, если в результате ошибки (или просто модификации алгоритма) переменная I перескочит через значение Limit? Правильно - ничего хорошего. Более устойчивой будет конструкция с использованием условия отсечения диапазона, т.е. I >= Limit.
Область использования переменных
Много сказано и написано на эту тему. Но еще раз повторюсь:Определение и использование классов
Любой модуль можно логически разделить на две части:Правило:
При планировании библиотеки классов не совмещайте в одном модуле части определения и использования. Или другими словами - отделяйте определение класса от того, как он будет использован.
Пример
Модуль Forms содержит определения классов, вспомогательных функций и создает экземпляры глобальных переменных (Application, Screen и т.д.). Допустим, в вашем консольном приложении, не использующем графический интерфейс нужна какая-то константа из модуля Forms. Включив его в свой проект, вы получите за бесплатно довесок в несколько сотен килобайт абсолютно ненужного вам кода. В чем причина? Линковщик не может определить, какие виртуальные методы будут вызваны, так как теоретически все они могут быть вызваны косвенно. По этому достаточно одного "упоминания" класса, как весь код его виртуальных методов (а также виртуальных методов других классов, на которые он ссылается) будет влинкован в ваше приложение, тут же. Во избежание подобной проблемы модуль Forms надо было бы разделить на две части: в одной - только определения, а в другой - создания экземпляров, выше указанных, глобальных переменных.
Я столкнулся с описанной проблемой при написании серверного приложения без GUI, которое взаимодействует с базой данных. Где-то в недрах DBxxx компонент есть ссылка на модуль Forms. Эта "особенность" была замечена в Delphi 5, скорее всего эта проблема имела место и в предыдущих версиях. Справедливости ради надо отметить, что в Delphi 7 эта особенность устранена.
Передача параметров
В Delphi параметры функций и процедур по умолчанию передаются по значению. Т.е. для них выделяется область памяти в стеке или куче, куда копируются оригинальные значения. При передаче параметров сложных типов (запись, массив, строка, вариант) это сопряжено со значительными расходами ресурсов, поэтому параметры этих типов желательно передавать по ссылке, т.е. с использованием ключевых слов var или const. Замечено, что наиболее типична эта ошибка при передаче параметра типа string.Пример
| procedure Proc(s : string); //Не очень хорошо :( procedure Proc(const s : string); //Гораздо лучше :) |
"Просачивание" исключений в библиотеках
При написании библиотеки функций или классов не закрывайте просачивание исключений наружу, если это конечно не предусмотрено логикой библиотеки.Пример
| try ... {Я столкнулся с подобным кодом в библиотеке ODBCExpress в процессе написания NT сервиса J.} exception //Очень нехорошо on Exception do ShowMessage('Something wrong's happened :-('); end; |
Обработка исключений, возникших в библиотеке - это задача приложения, которое использует данную библиотеку.
Range Check и Integer Overflow Check
К сожалению, эти опции компилятора по умолчанию отключены в Delphi, и многие разработчики не пользуются их услугами, а зря. Появления этих ошибок говорит о наличии в программе семантических ошибок, таких как неправильная индексация массива или использование несоответствующего целочисленного типа. Последствия этих ошибок могут быть весьма коварны. Я советую оставлять эти флаги всегда включенными, независимо от того - это отладочная или "финальная" версия программы. Лучше иметь неработающую программу (или ее часть), чем программу работающую неправильно (IMHO).Отключать их имеет смысл, когда нет возможности исправить эту ошибку, как, например, в случае с ранними версиями VCL, скомпилированной с этими опциями.
Вступление
В течение своей профессиональной деятельности программист вырабатывает систему правил, которая позволяет ему не совершать допущенных ранее ошибок и избегать потенциально опасных ситуаций. Ценность правил заключается в том, что они ограждают программиста от не всегда очевидных проблем, дают возможность писать единообразный код и дают возможность поступать формально, тем самым, освобождая "мыслительные" ресурсы на решение поставленной задачи.Некоторые из рецептов моей кулинарной книги я хочу предложить на ваше суждение. Очевидность этих правил зависит от вашей квалификации. Согласие с ними зависит от вашей собственной системы. Их источником послужили мой личный опыт и опыт ошибок начинающих программистов, каждое поколение которых повторяет их, к сожалению, с завидной стабильностью .
Выработанные правила направлены на:
Warnings and Hints
Компилятор Delphi снабжен "анализатором" качества кода. Он может предупреждать о потенциально опасных или бессмысленных ситуациях. Не пренебрегайте его услугами.Правило:
Добивайтесь, что бы ваша программа компилировалась без предупреждений и намеков. Даже если они не существенны, в последствии в их массе вы или пользователи вашей библиотеки могут не заметить более важные предупреждения.
в этой статье носят общий
Правила приведенные в этой статье носят общий характер. Практически всегда существуют исключения (такова природа правил J). Следование этим правилам, позволило мне добиться разработки устойчивого и единообразного кода. Буду признательным за любые дополнения, исправления, замечания, примечания, пожелания и критику (особенно конструктивную).С уважением,
февраль 2003г.
Специально для
Значения по умолчанию и "неопределенные" значения
В логике распределения значений для переменных всегда необходимо предусматривать "неопределенное" значение и значение по умолчанию. Отсутствие таких значений достаточно часто приводят к семантическим ошибкам.Правило №1:
TDayOfWeek = (dwNone,dwSun,dwMon,dwTue,dwWen,dwThu,dwFri,dwSat);
Правило №2:
"Неопределенными" значениями лучше всего выбирать такие, чье двоичное представление соответствует нулю (нулям). Это увеличивает устойчивость, когда не выполнена начальная инициализация переменной, но произведена инициализация блока памяти, в котором она размещается.
Пример
Для перечислимых типов "неопределенное" значение должно быть первым, так как оно соответствует целочисленному нулю.
Delphi - сбориник статей
Алгоритмы
Для начала решим, как мы будем действовать. Когда-то давно я искал хорошую реализацию градиентной заливки, но у них у всех был большой недостаток - громоздкость и нечитабельность алгоритма. Кроме того, было только два вида - горизонтальная и вертикальная заливка. В моей статье вид заливки ограничится лишь вашей фантазией. Я создал библиотеку градиентных функций и забыл об этой проблеме. Позже я приобрел библиотеку RX и увидел там почти аналогичную реализацию, но опять таки только 2-3 вида заливки. ДАЕШЬ ТВОРЧЕСКУЮ РЕАЛИЗАЦИЮ!Итак, начнем с того, что чтобы не быть зависимым от вида заливки, нужно цвета держать в массиве. Единожды заполнив массив плавным переходом цветов, его можно использовать для разных видов заливки. Кроме того, используя массив гораздо легче будет сделать множественную заливку - скажем, от синего к красному, потом от красного к зеленому и от зеленого к синему. Давайте рассмотрим алгоритм заполнения массива.
Сразу оговоримся о типе TColorArray.
type TColorArray = array of TColor; procedure SimpleFillArray(FromColor, ToColor: TColor; var ColorArray: TColorArray; ArrayWidth: Integer); var i: Integer; R1,G1,B1, R2,G2,B2: Byte; begin R1 := GetRValue(ColorToRGB(FromColor)); G1 := GetGValue(ColorToRGB(FromColor)); B1 := GetBValue(ColorToRGB(FromColor)); R2 := GetRValue(ColorToRGB(ToColor)); G2 := GetGValue(ColorToRGB(ToColor)); B2 := GetBValue(ColorToRGB(ToColor)); for i := 0 to ArrayWidth do ColorArray[i] := RGB(R1 - i*(R1 - R2) div ArrayWidth, G1 - i*(G1 - G2) div ArrayWidth, B1 - i*(B1 - B2) div ArrayWidth); end;
Объясним все по порядку. Для начала, нам нужно извлечь отдельные RGB-координаты из цветов FromColor, ToColor. Делается это с помощью функций GetXValue(X=R,G,B). Однако, это не единственный способ получения RGB-координат. Не забудем, что цвет - это обычное целочисленное число. Поэтому, координаты можно достать и так:
R := Color mod $100; G := Color div $100 mod $100; B := Color div $10000;
и так:
R := Color and $FF; G := (Color and $FF00) shr 8; B := (Color and $FF0000) shr 16;
и так:
R := Lo(Color); G := Lo(Color shr 8); B := Lo((Color shr 8) shr 8);
Что вы выберете - ваше дело. Мне удобнее через GetXValue.
Итак, координаты извлечены, затем, согласно алгоритму, заполняются ячейки массива. (х - расстояние от начала массива, в цикле это счетчик i).
В этой процедуре мы заполняем массив простым переходом цветов. Но можно сделать и круче - переход с несколькими цветами, заданными массивом:
procedure ComplexFillArray(Colors: array of TColor; var ColorArray: TColorArray; ArrayWidth: Integer); var ColArray: TColorArray; i,j,Temp: Integer; Equal: Boolean; begin //Вначале проверим число цветов //Если массив пуст: if High(Colors) < 0 then begin raise Exception.Create('Specify at least one color!'); Exit; end; //Если только один элемент, то //просто заполняем массив этим цветом: if High(Colors) = 0 then begin for i := 0 to ArrayWidth do ColorArray[i] := Colors[0]; Exit; end; //ширина одной полосы, необходимой для перехода от //одного цвета массива к другому. Естественно, ширина //кратна числу цветов в массиве. Temp := ArrayWidth div (High(Colors)); SetLength(ColArray, Temp + 1); Equal := (ArrayWidth mod Temp)=0; //булевая переменная //- наличие остатка после деления - сигнализирует о том, //укладываются ли полосы в массив полностью, или нет for i := 0 to High(Colors) - 1 do begin SimpleFillArray(Colors[i], Colors[i + 1], ColArray, Temp); for j := 0 to Temp do ColorArray[j + i*Temp] := ColArray[j]; end; //если имеет место неполное заполнение, то делаем следующее: //отступаем от конца на расстояние ArrayWidth //mod Temp и закрашиваем от //цвета на этом расстоянии до последнего цвета (см. рисунок )
Теперь мы можем заполнять массив несколькими цветами. Теперь что касается входного параметра ArrayWidth (длина массива). Как определить, какая длина массива нам нужна? Давайте посмотрим на примере функции горизонтальной заливки. Посмотрим, сколько нам нужно в этом случае. Для горизонтальной заливки длина массива соответствует количеству пикселей, размещенных по высоте заливаемой области:
function HorizontalArrayWidth(FillRect: TRect): Integer; begin Result := abs(FillRect.Bottom - FillRect.Top); end;
Теперь, зная длину, можно и заливать. Мой принцип - лучше медленно в начале, но быстро потом, чем наоборот. Всегда рисуйте на временном битмапе, а потом отображайте этот битмап на канву. Тем более это касается сложных нелинейных видов заливки (рассмотрим позже).
procedure HorizontalGradient(Canvas: TCanvas; FillRect: TRect; Colors: TColorArray); var i: Integer; TempBmp: TBitmap; begin TempBmp := TBitmap.Create; TempBmp.Width := abs(FillRect.Right - FillRect.Left); TempBmp.Height := abs(FillRect.Bottom - FillRect.Top); try With TempBmp do for i := 0 to TempBmp.Height do begin Canvas.Pen.Color := Colors[i]; Canvas.MoveTo( - 1, i); Canvas.LineTo(TempBmp.Width + 1, i); end; Canvas.StretchDraw(FillRect, TempBmp); finally TempBmp.Free; end; end;
Пример использования:
procedure TForm1.HorizontalClick(Sender: TObject); var ColArr:TColorArray; begin SetLength(ColArr, HorizontalArrayWidth(BMP.Canvas.ClipRect) + 1); // не забудем, что индексация // идет от нуля ComplexFillArray([clBlack,clRed, $004080FF, clYellow,clGreen,clBlue, clNavy, clPurple, clBlack], ColArr, HorizontalArrayWidth(BMP.Canvas.ClipRect)); HorizontalGradient(BMP.Canvas, BMP.Canvas.ClipRect, ColArr); Canvas.StretchDraw(Clientrect,BMP); Finalize(ColArr); end;
Я разделил процесс создания - заполнения массива цветами с процессом градиентной заливки потому, что этот массив может повторно использоваться, но в принципе, процесс создания - заполнения можно занести внутрь процедуры заливки в случае единичного использования массива.
По поводу объекта BMP - это глобальный битмап, который я создаю в FormCreate, чтобы не создавать каждый раз временный битмап и форма не мерцала при каждой отрисовке. Полностью демо можно будет скачать.
Аналогично выглядит функция вертикальной заливки. Длина массива соответствует ширине заливаемой области:
function VerticalArrayWidth(FillRect: TRect): Integer; begin Result := abs(FillRect.Right - FillRect.Left); end;
procedure VerticalGradient(Canvas: TCanvas; FillRect: TRect; Colors: TColorArray); var i: Integer; TempBmp: TBitmap; begin TempBmp := TBitmap.Create; TempBmp.Width := abs(FillRect.Right - FillRect.Left); TempBmp.Height := abs(FillRect.Bottom - FillRect.Top);
try With TempBmp do for i := 0 to TempBmp.Width do begin Canvas.Pen.Color := Colors[i]; Canvas.MoveTo(i, - 1); Canvas.LineTo(i, TempBmp.Height); end; Canvas.StretchDraw(FillRect, TempBmp); finally TempBmp.Free; end; end; 
До этого, мы рассматривали лишь простые варианты заливки. Теперь перейдем, собственно, к творчеству. Давайте посмотрим, как можно сделать что-нибудь другое. Например, диагональную заливку с левого верхнего к правому нижнему углу. Все, что нужно сделать - это заполнить массив и рисовать линии по диагонали. Длина массива должна быть равна сумме высоты и ширины заполняемой области. Почему? Давайте посмотрим. Процедура заполнения должна выполниться в два приема - вначале закрашиваем левый верхний треугольник, то есть спускаемся по левой стороне области, продолжая линии до верхней стороны области. По достижении нижнего левого угла направление закрашивания меняется. Теперь идем по нижней стороне, продолжая линии до правой стороны (при условии квадратной области), если же область неквадратная, то часть линий будет касаться верхней стороны. Проблема с неквадратностью может быть решена, если создать временный квадратный битмап, стороны которого равны максимальной стороне прямоугольной области. Затем этот битмап закрасить и растянуть на закрашиваемую область с помощью метода StretchDraw (или стандартной функции из модуля Windows - StretchBlt). Аналогично будет проходить закрашивание по диагонали из правого верхнего в левый нижний угол, изменится лишь направление закрашивания.Что еще? Да хоть килограмм! Давайте посмотрим заливку "веером". Смысл веера в том, что все линии проводятся из одного угла на стороны, противоположные ему. Длина массива здесь та же, что и в случае диагонально заливки.
Теперь посмотрим круговые виды: полуокружности сверху-снизу, слева-справа, заливка концентрическими окружностями от краев к центру.
В случаях полуокружностей длина массива под цвета должна быть равна половине ширины (в случае слева-справа) и половине высоты (в случае сверху-снизу). В случае с концентрическими окружностями - половине минимальной стороны заливаемой области, т.к. радиус окружности (или дуги) изменяется от нуля до центра заливаемой области. Надо сказать, что предварительно нужно залить область начальным цветом, чтобы была иллюзия того, что переход действительно плавен.
Вот функции:
function LeftRightPiesArrayWidth(FillRect: TRect): Integer; begin Result := VerticalArrayWidth(FillRect) div 2; end; function TopBottomPiesArrayWidth(FillRect: TRect): Integer; begin Result := HorizontalArrayWidth(FillRect) div 2; end; function CirclesArrayWidth(FillRect: TRect): Integer; var Width, Height, minus: Integer; begin Width := abs(FillRect.Right - FillRect.Left); Height := abs(FillRect.Bottom - FillRect.Top); minus := 15*(Width + Height) div Min(Width, Height); //величина minus определена чисто эмпирически, //возможно вы найдете лучше Result := Min(Width, Height) div 2+minus; end; procedure TopBottomPiesGradient(Canvas: TCanvas; FillRect: TRect; Colors: TColorArray); var i: Integer; TempBmp: TBitmap; begin TempBmp := TBitmap.Create; TempBmp.Width := abs(FillRect.Right - FillRect.Left); TempBmp.Height := abs(FillRect.Bottom - FillRect.Top); try With TempBmp do begin Canvas.Brush.Color := Colors[0]; Canvas.FillRect(FillRect); for i := 0 to TempBmp.Height div 2 do begin Canvas.Pen.Color := Colors[i]; Canvas.Brush.Color := Colors[i]; Canvas.Pie(0, - (TempBmp.Height div 2), TempBmp.Width, (TempBmp.Height div 2) - i, 0, 0, TempBmp.Width, 0); Canvas.Pie(0, (TempBmp.Height div 2)+i, TempBmp.Width, 3*(TempBmp.Height div 2), 0, 0, 0, 0); end; end; Canvas.StretchDraw(FillRect,TempBmp); finally TempBmp.Free; end; end; procedure LeftRightPiesGradient(Canvas: TCanvas; FillRect: TRect; Colors: TColorArray); var i: Integer; TempBmp: TBitmap; begin TempBmp := TBitmap.Create; TempBmp.Width := abs(FillRect.Right - FillRect.Left); TempBmp.Height := abs(FillRect.Bottom - FillRect.Top); try With TempBmp do begin Canvas.Brush.Color := Colors[0]; Canvas.FillRect(FillRect); for i := 0 to TempBmp.Width div 2 do begin Canvas.Pen.Color := Colors[i]; Canvas.Brush.Color := Colors[i]; Canvas.Pie(- TempBmp.Width div 2, 0, (TempBmp.Width div 2) - i, TempBmp.Height, 0, TempBmp.Height, 0, 0); Canvas.Pie((TempBmp.Width div 2) + i, 0, 3*TempBmp.Width div 2, TempBmp.Height, TempBmp.Width, 0, TempBmp.Width, TempBmp.Height); end; end; Canvas.StretchDraw(FillRect, TempBmp); finally TempBmp.Free; end; end; procedure CirclesGradient(Canvas: TCanvas; FillRect: TRect; Colors: TColorArray); var i,Minus: Integer; TempBmp:TBitmap; begin TempBmp := TBitmap.Create; TempBmp.Width := abs(FillRect.Right - FillRect.Left); TempBmp.Height := abs(FillRect.Bottom - FillRect.Top); Minus := 15*(TempBmp.Width + TempBmp.Height) div Min(TempBmp.Width, TempBmp.Height); try With TempBmp do begin Canvas.Brush.Color := Colors[0]; Canvas.FillRect(FillRect); for i := 0 to CirclesArrayWidth(FillRect) do begin Canvas.Pen.Color := Colors[i]; Canvas.Brush.Color := Colors[i]; Canvas.Ellipse(Rect(i - Minus, i - Minus, TempBmp.Width - i + Minus, TempBmp.Height - i + Minus)); end; end; Canvas.StretchDraw(FillRect, TempBmp); finally TempBmp.Free; end; end;
Давайте теперь посмотрим заливку "конверт". Суть ее в том, что область закрашивается сходящимися в центр прямоугольниками. Длина массива здесь, также, должна быть равна половине минимальной стороны заливаемой области. Это нужно для того, чтобы был действительно эффект конверта. Кстати, мой любимый вид заливки :)
Вот эта процедура:function EnvelopeArrayWidth(FillRect: TRect): Integer; var Width, Height: Integer; begin Width := abs(FillRect.Right - FillRect.Left); Height := abs(FillRect.Bottom - FillRect.Top); Result := Min(Width,Height) div 2; end; procedure EnvelopeGradient(Canvas: TCanvas; FillRect: TRect; Colors: TColorArray); var i: Integer; TempBmp: TBitmap; begin TempBmp := TBitmap.Create; TempBmp.Width := abs(FillRect.Right - FillRect.Left); TempBmp.Height := abs(FillRect.Bottom - FillRect.Top); try With TempBmp do for i := 0 to EnvelopeArrayWidth(FillRect) do begin Canvas.Brush.Color := Colors[i]; Canvas.FillRect(Rect(i, i, TempBmp.Width - i, TempBmp.Height - i)); end; Canvas.StretchDraw(FillRect, TempBmp); finally TempBmp.Free; end; end;
Ну, не будем раздувать и без того большую статью... Быстренько пробежимся по другим видам, которые я реализовал в своем модуле.
Заливка волнами. Длина массива - ширина (в случае горизонтальных волн) или высота (в случае вертикальных волн) заливаемой области. Кстати, частоту также можно задать. Но формула подобрана также эмпирически. Кстати, волны реализованы очень легко - заливаете битмап-полоску и потом в цикле рисуете градиентные полоски на i-ом расстоянии, равном синусу: Round(50*sin(Frequency*i). (Frequency - частота синусоиды).
Заливка звездой. Длина массива - чисто эмпирически подобрано - 2/3 минимальной из сторон. Ну, это сделано, чтобы звезда была побольше. В принципе, 2/3 можете убрать. Для построения звезды достаточно вспомнить геометрию;)
Заливка ромбом. Длина массива - такая же, что и в случае заливки конвертом. 
Предела фантазии нет - все зависит только от вас. Можно комбинировать из уже имеющихся или придумать что-то новое. Мне после 16ти видов просто надоело... Надеюсь, статья не показалась вам скучной и подтолкнула на творческие поиски:)).С уважением, Sega-Zero.
Скачать проект: (18K)
Немного теории.
Все цвета в двоичном коде представляются в виде трехбайтовых (или более) последовательностей. Есть различные схемы представления цвета - RGB, HLS, CMYK и некоторые другие, (например OpenGL) которые используются исключительно в системах компьютерной графики, нас они не очень интересуют. Итак, все по порядку. RGB (Red, Green, Blue) представляет цвет следующим образом: это трех байтовая последовательность вида $GGBBRR. Каждый байт представляет определенный оттенок (от 0 до 255) цветов: красный, зеленый, синий. Например, $FF0000 означает чистый синий цвет полной интенсивности, $00FF00 - чистый зеленый, $0000FF - чистый красный, $FFFFFF - черный цвет, $000000 - белый. Таким образом, задав определенное числовое значение, можно добиться того или иного оттенка искомого цвета. Но это в формате RGB. Чаще всего в Делфи мы пользуемся типом TColor, в котором добавлен еще 1 байт -указатель на замену цвета. Этот байт может принимать три различных значения - ноль ($00), единицу ($01) или двойку ($02). Что это значит:Схемой RGB пользоваться удобнее и привычнее, чем остальные, но расскажем немного и о них. Схема HLS(Hue, Light, Saturation) - Оттенок, Яркость, Насыщенность. Как видно из аббревиатуры, цвет представляется несколько иначе - через оттенок определенного цвета, его яркость и насыщенность. К сожалению, никогда этой схемой не пользовался, поэтому пример привести не могу:(. CMYK - Cyan-Magenta-Yellow-blacK палитра (голубой-сиреневый-желтый-черный), используется в издательских системах как более четко передающая цвета, чем палитра RGB. Также ничего не могу сказать, кроме того, что уже сказано. В моей статье мы будем рассматривать только модель RGB.
Теперь, что же такое градиент? Градиент - это плавный переход от одного цвета к другому. Очень хорошо градиент можно показать на примере радуги.
Допустим, вам нужно получить промежуточный цвет между красным и синим. Для этого просто находим среднее арифметическое отдельных координат RGB.(255, 0, 0) + (0, 0, 255) = ((255+0)div 2, (0+0)div 2, (0+255)div 2) = (127, 0, 127).
То есть получили сиреневый цвет. Для случая многих цветов нужно будет сложить координаты всех цветов и разделить на их количество. Как же можно сделать этот плавный переход? Итак, пусть заданы 2 цвета своими координатами ((A1, A2, A3) и (B1, B2, B3)) и линия (длиной h пикселов), по которой нужно залить.
Тогда каждый цвет каждого пиксела, находящегося на расстоянии x пикселов от начала будет равен
(A1-(A1-B1)/h*x, A2-(A2-B2)/h*x, A3-(A3-B3)/h*x).
Теперь, наконец, перейдем, собственно, к реализации градиентной заливки.
Delphi - сбориник статей
Добавление картинок и гиперссылок.
Бывает, что в справку нужно поместить изображения. Это можно сделать, просто добавив их в документ rtf обычным для MS Word способом. Если одно изображение используется в нескольких местах, то можно воспользоваться специальной разметкой, предусмотренной для вставки изображений в справку, так что изображение будет храниться в одном экземпляре. Здесь я не буду рассматривать, как это сделать (честно говоря, я этого никогда и не делал). Обычное дело - указать адрес своего сайта и/или электронной почты в разделе "Поддержка". Как сделать, чтобы эта ссылка выглядела и функционировала как гиперссылка на Веб-страницах? Аналог гиперссылки, т.е. тега anchor () HTML в WinHelp - "hotspot". Hotspot - это область, по щелчку мыши на которой, выполняется какое-либо действие из предусмотренных в WinHelp. В данном случае нам нужно запустить один из макросов WinHelp, а именно макрос ExecFile. Этот макрос напоминает функцию WinApi ShellExecute. Синтаксис его такой:ExecFile(program[, arguments[, display-state[, topic-ID]]]) Первый параметр, как написано в справке, может указывать на программу или файл. Однако, как и в ShellExecute, вместо имени файла можно указать URL, например "http://www.mysite.ru" или "mailto:nekto@somemail.ru".
Чтобы создать hotspot, запускающий такой макрос, нужно сделать следующее:
Сразу после текста hotspot'a ввести символ "!", а сразу за ним - текст макроса, например:
Наш сайт: www.mysite.ru!ExecFile(http://www.mysite.ru) Примечание: URL в скобках должен быть без кавычек.
Далее, нужно отформатировать этот отрывок так: текст hotspot'a должен иметь двойное подчеркивание, а символ "!" и текст макроса после него - иметь атрибут "скрытый". И то, и другое делается через меню "Формат" -> "Шрифт" (см. рис. 2) На всякий случай, еще раз уточню: двойное подчеркивание (выпадающий список рядом с "цветом текста"), а не зачеркивание..
Рис. 2.
Теперь, если добавить такой hotspot и компилировать проект, то мы увидим в своей справке, что в строке текста
Наш сайт: www.mysite.ru - адрес выглядит и функционирует как гиперссылка.
Общие сведения
В состав операционной системы Windows входит подсистема поддержки справки - WinHelp. Она имеет свое API, которое позволяет предоставить справочную информацию в том или ином виде в приложениях Windows. Создание справочной системы можно разделить на две частиПишем простой хелп
Сергей Осколков, Справочная система (далее в тексте также - "справка") - важная составная часть любой более-менее сложной (и даже простой) программы. Существуют разные форматы справочных систем. Справка в формате WinHelp - о ней в статье и пойдет речь, Html-help - как, например, справка к ОС Windows или к программам MS Office. В качестве справки может выступать набор связанных html-файлов, например так организована справка к СУБД MySQL. Из достоинств WinHelp можно назвать ее надежность и меньшие, чем у HTML-help, требования к ресурсам. Существуют различные программы для создания справочных систем названных типов. Однако, для создания несложной справки вполне достаточно стандартной программы MS Help Workshop, которая поставляется с Delphi. Потребуется еще редактор rtf файлов, в данной статье описывается работа со знакомым всем MS Word'ом. Все действия, которые будут описаны - несложные, но мне в свое время потребовалось определенное количество усилий и времени, чтобы разобраться по справке к Help Workshop, как все это делать. Надеюсь, что статья сможет облегчить этот путь для других. Расчитана она на начинающих. В статье описывается создание простой справки, оглавления к ней, создание последовательностей просмотра, вставка рисунков и гиперссылок, а также подключение справки к программе. Рассматривается только техническая сторона, вопрос о том, что написано в справке, оставлен в стороне.Присоединяем справку к программе.
Чтобы справка была доступна в программе, нужно указать программе на файл .hlp. Самый простой способ размещения файла справки - в той же папке, где находится исполняемый файл. Определить для приложения файл справки можно так: открыв проект (приложения) в Delphi и выбрав меню "Project" -> "Options" -> "Application", вписать название файла справки в поле ввода "Help file". При этом нужно указать название файла без пути. Когда WinHelp пытается найти справочный файл, одна из просматриваемых директорий - та, где расположен исполняемый файл программы. Другой способ - в обработчик события OnCreate главной формы программы вставить строку: Application.HelpFile:=ExtractFilePath(Application.ExeName) + "MyHelp.hlp"; где MyHelp.hlp - название файла справки. Чтобы из меню в программе вызвать оглавление справки, нужно воспользоваться функциейApplication.HelpCommand(HELP_FINDER, 0); Чтобы перейти к одной из определенных нами тем справки, нужно вызвать функцию Application.HelpJump('MyTopic'), где MyTopic - идентификатор темы. Один из способов вызова справки - нажатие клавиши F1. Можно организовать вызов контекстной справки при нажатии на F1, когда активным является тот или иной элемент управления. Для этого соответствующей теме справки нужно присвоить номер, а затем этот номер присвоить свойству HelpContext элемента управления. Чтобы задать номера для тем справки, нужно открыть проект справки в HelpWorkshop и нажать кнопку "Map" в правой части окна. Нажимаем в диалоговом окне "Add", вводим идентификатор темы и произвольный номер (например, 1 :) ), повторяем это для всех нужных тем (каждой - свой номер), закрываем окно и нажимаем в очередной раз "Save and Compile". Затем в Delphi, в окне инспектора объектов, присваиваем нужные номера нужным элементам управления (напоминаю, свойство HelpContext).
Создание оглавления справки.
Файл оглавления справки имеет простой текстовый формат, но создавать его удобно тоже в HelpWorkshop. Для этого выбираем в меню HelpWorkshop "File" -> "New" -> "Help Contents". В верхней части окна нужно вписать имя главного файла справки (файлов, вообще говоря, может быть несколько) и заголовок (title) для оглавления справки. То же можно сделать в диалоговом окне, которое открывается при нажатии кнопки Edit... . Теперь создаем собственно оглавление. Оно состоит из элементов двух типов - разделы справки, которые включают в себя несколько тем и представлены в оглавлении справки значком книжки и сами темы - текст и картинки, представлены в оглавлении справки значком листа со знаком вопроса на нем (можно посмотреть это в оглавлении любой справки). Также в оглавление можно вставить макросы и включить файлы (include), этого я здесь касаться не буду. Справа на панели есть набор кнопок для добавления и манипуляции элементами оглавления. (Add Below - Добавить ниже, Add Above - Добавить выше, Move Right - Сдвинуть вправо, Move Left - Сдвинуть влево, Edit, Delete). При помощи них создаем нужную структуру оглавления. При добавлении раздела в диалоговом окне нужно указать только его название, при добавлении темы - название, идентификатор (тот, который мы задали ей в rtf-файле, когда вставляли концевую сноску), имя help-файла и имя окна. Если тема находится в том же help-файле, который мы указали как главный, то имя help-файла указывать не нужно. Имя окна указывать тоже не обязательно, если оно не указано, то тема откроется в окне по-умолчанию. Нужно сохранить файл оглавления (он будет иметь расширение .cnt) в той же директории, где находится help-файл лучше с тем же именем, что и help-файл. Теперь нужно снова открыть файл проекта .hpj и, нажав кнопку "Options", в открывшемся диалоговом окне на закладке "Files" указать наш файл оглавления (Contents file). Закрываем диалоговое окно, снова нажимаем "Save and Compile". Теперь при двойном щелчке мышью по значку файла справки должно открыться ее оглавление, из которого можно получить доступ ко всем темам.Мне не удалось, похоже, это невозможно, создать такую структуру оглавления, чтобы в самом левом ряду сначала шел значок темы (например, "Общие сведения"), а под ним - значки разделов. Пришлось даже для одиночной темы создавать раздел, содержащий ее одну.
Создание последовательностей просмотра.
Удобно перемещаться в справке от темы к теме с помощью кнопок ">>" и "<<" на панели инструментов окна или при помощи клавиш "<", ">" клавиатуры. Чтобы добавить такую возможность, нужно:Создание тематических файлов.
Для создания справки сначала нужно подготовить файлы, содержащие справочную информацию. Это - обычные документы в формате rtf, которые можно создавать с помощью различных программ. Я здесь буду описывать работу с MS Word (создаем документ и выбираем "Сохранить как" - "Текст в формате RTF"). Будем называть эти файлы тематическими (topic files). Для получения из тематических файлов готовых файлов справки (hlp), их нужно обработать (компилировать) программой HelpWorkshop (hwc.exe).Кроме собственно текста и рисунков, тематические файлы могут содержать также специальную разметку, которая несет в себе информацию, нужную для создания переходов по ссылкам, связи оглавления справки с ее темами и т.п. - для реализации различных возможностей WinHelp. Обычно справка содержит несколько тем и оглавление, из которого можно перейти к этим темам. Самый простой вариант: если тема - одна и оглавления нет. В таком случае просто пишем то, что нужно и сохраняем это в файле с расширением ".rtf". Для создания нескольких тем процесс усложняется ненамного:Повторяем то же самое для всех тем справки. Сохраняем файл. Теперь можно попробовать создать свой хелп.
Рис.1. Добавление концевой сноски.
Запускаем программу HelpWorkshop. Это - файл Hcw.exe в директории Delphi\Help\Tools\. Создаем новый проект через меню "File"->"New"->"Help Project". Справа на панели есть ряд кнопок, нажимаем "Files...". В диалоговом окне добавляем наш тематический файл и закрываем это окно. Сохраним проект - это будет файл с расширением hpj (Help Project). Насколько я понял, после первого запуска Help Workshop связывает себя с файлами hpj, а также - с файлами оглавления справки (cnt), так что их потом можно открывать двойным щелчком мышью. Для создания help-файла можно просто нажать кнопку "Save and Compile". Откроется новое окно с сообщением о результате компиляции. Предположим, что все в порядке, закроем это окно. Теперь в директории, где находился наш проект (.hpj), должен появиться файл справки. Однако, при двойном щелчке мышью на нем мы сможем просмотреть только первую тему. Чтобы просматривать все темы и перемещаться между ними, нужно добавить файл оглавления.
Delphi - сбориник статей
Безобидные(?) Hints
Ниже приведен код простой функции, которая не содержит синтаксических ошибок, но при её компиляции будет получено три Hint'а (в коде они отмечены красным). Давайте разберем их подробно.| Function FunctonName( Code : String) : Integer; Var i,j : Integer; ‹—— Variable 'i' is declared but never used in 'FunctonName' Begin j:=0; ‹—— Value assigned to 'j' never used For j:=0 To -1 Do Writeln(j); ‹—— FOR or WHILE loop executes zero times - deleted Result:=StrToInt(Code); End; |
Простейшее решение — удалить все неиспользованные переменные. А заодно и проверить, действительно ли они не нужны :о)
Value assigned to 'j' never used Значение, присвоенное 'j' никогда не используется. Это сообщение не означает, что программа неправильная — оно означает только то, что компилятор обнаружил, что после присвоения переменной j значения 0, эта переменная не участвует более ни в каких операциях. Что делает это присвоение абсолютно бессмысленным. И, если используется оптимизатор, оно будет удалено в откомпилированном коде.
Так же, как и предыдущий Hint, это сообщение чаще всего является признаком "мусора" в коде, от которого следует избавляться, чтобы не пропустить потенциальные ошибки. Опасность в том, что в реальности может оказаться, что это присвоение было сделано не той переменной, которой нужно. Например, надо было присвоить что-то переменной i, а присвоили j.
FOR or WHILE loop executes zero times - deleted Цикл FOR или WHILE исполняется ноль раз — удалено. Собственно, текст этого сообщения полностью объясняет ситуацию. Конечно же это не специально, это "рука дрогнула", "глаз замылился" или что-то в таком духе. И компилятору остается только сказать спасибо.
Итак, получается, что Hint'ы обращают наше внимание на странности и несуразицы в коде с точки зрения "правильного" компилятора. Конечно, приведенный пример очень прост и надуман и может не убедить вас, но если в коде функции, которая содержит не один десяток операторов, появляется hint, стоит обратить на него внимание, поверьте.
Рассмотренные выше ситуации можно и нужно исправлять. Но бывают случаи, когда нет возможности исправить код так, чтобы не получать Hint's при компиляции. Рассмотрим небольшой пример по созданию собственных классов:
| Type TLists = class(TList) Protected procedure Clear; override; ‹—— Overriding virtual method 'TLists.Clear' has a lower visibility (private) than base class (public) End; TExLists = class(TList) Private Function FutureTools(Sender : TObject) : Boolean; ‹—— Private symbol 'FutureTools' declared but never used Public ... End; |
Private symbol 'FutureTools' declared but never used Приватный символ 'FutureTools' определен, но никогда не используется. Это сообщение сродни уже описанному Variable '
Так как этот метод приватный, то он по определению не может быть доступен нигде более, как внутри класса. Тем не менее, компилятор там его использования не обнаруживает. Из чего следует естественный вывод, что функция 'FutureTools' нигде не будет использоваться.
Допустим, что в этом случае все не так просто, как это видится компилятору и функция FutureTools, например, нигде не используется вовсе не потому, что вы о ней забыли или она никому не нужна. Возможно это задел на будущее. Можно, конечно, закомментировать и объявление функции и код ее реализации до поры до времени. Но можно сделать и иначе, несколько изящнее.
Возможно, что по условию конкретной задачи понижение видимости метода в классе TLists оправдано, а корректировать код базового класса нет возможности, тогда придется попросить компилятор не принимать во внимание эту ситуацию.
Как раз для таких случаев предусмотрена сцециальная дирректива компилятора: {$HINTS OFF}. Она отключает проверку кода на предмет обнаружения Hint'ов до тех пор, пока в коде не встретится обратная дирректива — {$HINTS ON}. Если в обрамленном этими специальными комментариями коде и будут "опасные" Hint-ситуации, они будут игнорироваться компилятором.
Воспользовавшись этими диррективами, мы получим код, который компилируется не только без ошибок, но и без Hint'ов:
| Type {$HINTS OFF} TLists = class(TList) Private procedure Clear; override; End; {$HINTS ON} TExLists = class(TList) Private {$HINTS OFF} Function FutureTools(Sender : TObject) : Boolean; {$HINTS ON} Public ... End; |
Примечание:
Не поддавайтесь искушению раз и навсегда "заткнуть" с помощью {$HINTS OFF} упрямый компилятор, пользы от этого вам, как программисту, не будет никакой...
Hints and Warnings, или Спасение утопающих
Елена Филиппова, Королевство Дельфи15 апреля 2003г.
Содержание:
Каждая программа содержит по крайней мере одну ошибку
Народная мудрость
Никогда не делает ошибок тот, кто просто ничего не делает. Это тоже народная мудрость. Поэтому с ошибками в коде сталкивается в своей работе каждый программист. После того, как программа успешно откомпилирована, преодолен первый этап борьбы. :о)
Не секрет, что гораздо сложнее бороться с ошибками, возникающими во время выполнения программы, особенно, когда они приводят не просто к ее "падению", а к неадекватной работе, наслаивая проблемы и создавая "наведенные" ошибки. И здесь уже надежды на компилятор нет... Спасение утопающих, как известно, дело рук этих самых утопающих.
Материал данной статьи не имеет отношения к теме тестирования и отладки. Он предназначен начинающим программистам, дабы обратить их внимание на "соломинку", которую протягивает утопающим IDE Delphi в нелегком деле борьбы с ошибками :о) Ведь не зря же ее называют дружественной средой разработки.
Хочу сразу обратить ваше внимание на то, что все приводимые примеры не являются реальными, они специально упрощены и только иллюстрируют объяснение материала.
Коварные Warnings
Предупреждения-warnings обладают гораздо более высоким уровнем опасности с точки зрения компилятора. История с абстрактным классом служит тому примером. Разберем еще несколько случаев возникновения warning'ов: Return value of function 'VarCompare' might be undefined Значение результата функции 'VarCompare' может быть неопределено.| Function VarCompare(Index1, Index2: Integer): Integer; Begin IF Index1 = Index2 Then Result:=0; IF Index1 < Index2 Then Result:=-1; IF Index1 > Index2 Then Result:=1; End; ‹——Return value of function 'VarCompare' might be undefined |
Казалось бы, с точки зрения логики в тексте функции все верно. Перекрыты все возможные случаи и сообщение компилятора выглядит несколько неуместно. Но не стоит ждать от него слишком много, компилятор не может (да и не обязан) вникать в логику программы. Для того, чтобы избавиться от этого сообщения, было бы правильно переписать это код. Например, вот так:
| Function VarCompare(Index1, Index2: Integer): Integer; Begin IF Index1 = Index2 Then Result:=0 Else IF Index1 < Index2 Then Result:=-1 Else Result:=1; End; |
В итоге и компилятор "отстанет", и код будет более читабельным. Это сообщение только на первый взгляд кажется безобидным, ниже приведен пример, в котором возникает аналогичное предупреждение и содержится реальная ошибка — если возникнет исключительная ситуация при открытии файла, результат функции, действительно, не будет определен. В итоге это скажется при выполнении программы, когда ошибки никто не будет ожидать.
| Function ReadList( FileName : String) : Boolean ; Var Stream : TFileStream; Begin IF FileExists(FileName) Then Try Stream:=TFileStream.Create(FileName , fmOpenRead); // ..... Stream.Free; Result:=True; Except End Else Result:=False; End;‹——Return value of function 'ReadList' might be undefined |
| Function ReadList( FileName : String) : Boolean ; Var Stream : TFileStream; Begin IF FileExists(FileName) Then Try Stream:=TFileStream.Create(FileName , fmOpenRead); // ..... Stream.Free; Result:=True; Except Result:=False; End Else Result:=False; End; |
| Function SomethingList( Text : String) : Integer; Var list : TStringList; Begin IF Text <> '' Then Begin list:=TStringList.Create; list.CommaText:=Text; End; // .... код Result:=list.Count; ‹—— Variable 'list' might not have been initialized list.Free; End; |
Совершенно справедливое замечание. Если во время работы программы в функцию будет передана пустая строка, нам обеспечен знаменитый Access violation.
Вернемся еще раз к примеру с определением собственных классов.
| TExLists = class(TList) Public procedure Clear; ‹—— Method 'Clear' hides virtual method of base type 'TList' End; |
| TExLists = class(TList) Public procedure Clear; override; End; |
Точно также, как и в случае с hint'ами, существуют опции для отключения сообщений компилятора о предупреждениях — {$WARNINGS OFF}, и для их включения — {$WARNINGS ON}. И точно так же хочу обратить внимание на нежелательность использования этих опций без нужды. Молчание компилятора в этом случае не будет означать отсутствие проблемы :о)
О пользе сообщений компилятора
Небольшое лирическое отступление:В каждом уважающем себя форуме есть список вопросов, признанных как off-topic. Часть из них сто раз уже разжевана, часть решается нажатием клавиши F1 и так далее. На каждом форуме борятся с ними по-своему, но, к огромному сожалению, задающих такие вопросы не становится меньше. Более того, вопрошающие частенько еще и обижаются, когда их отсылают :о) Вот пример классического off-topic'а:
| Привет Алл! Пишу код s:tstrings; s:=tstrings.create; s.insert(... // здесь ОШИБКА! Какой-то Abstract Error s.clear; Господа подскажите что делать? |
В ответ на такой вопрос, господа, как правило, начинают страшно ругаться. :о) Самые вежливые слова, которые получает автор вопроса, звучат примерно так — "Сколько же можно?! Хелп когда научитесь читать?!" На что автор, как ему кажется, абсолютно справедливо, начинает огрызаться, что типа, откуда ему было знать, что такое абстрактный метод и что на этом самом TStrings не написано, какие у него методы!
Проведем маленький эксперимент и напишем такой код:
| Procedure AbstractMethod; Var Buffer : TStrings; Begin Buffer:=TStrings.Create; ‹—— Constructing instance of 'TStrings' containing abstract methods Buffer.LoadFromFile('test.txt'); Buffer.Free; End; |
При компиляции нам будет выдан warning, как раз на той строке, где создается экземпляр класса — Constructing instance of 'TStrings' containing abstract methods. Я надеюсь, что текст этого предупреждения абсолютно ясен и не требует пояснений...
Смотрите, что получается, ошибок компиляции нет, человек с высоко поднятой головой игнорирует "всю эту ерунду" и просто не обращает внимания на предупреждения компилятора! В итоге, он получает ошибку времени выполнения, некоторое личное недоумение, кучу словесных тычков и подзатыльников на форуме. А ведь его предупреждали! :о)
рис. 2
IDE Delphi, как дружественная среда программирования, кроме обычного факта уведомления о сообщениях компилятора, предоставляет дополнительные возможности — если дважды кликнуть на тексте сообщения (рис. 2), то курсор автоматически переместиться на ту строку в редакторе кода, в которой, по мнению компилятора, возникает спорная ситуация. Если же на тексте сообщения (hint или warning) нажать F1, то откроется окно справочной системы (рис. 3) по конкретному hint'у или warning'у. Там будет описано, в каких случаях компилятор выдает такое сообщение и что Delphi вообще "думает" по этому поводу.
рис. 3
Цель этого материала, не рассказать
Цель этого материала, не рассказать обо всех возможных hint'ах и warning'ах, их список слишком велик для одной статьи, а обратить внимание на необходимость анализировать ВСЕ сообщения компилятора в ваших программах.Елена Филиппова
Специально для
Типы сообщений компилятора
Информацию о результате компиляции и сборки программы можно увидеть в окне, показывающем процесс компиляции (рис. 1), и на панели сообщений, встроенной в редактор кода (рис. 2).
рис. 1 Сообщения компилятора бывают трех типов. В этом списке они приведены по убыванию степени опасности, если так можно выразиться :о)
Довольно распространенное отношение начинающих программистов к этим сообщениям заключается в полном игнорировании предупреждений и советов. Ведь не ошибки же? Программа откомпилирована и запускается на исполнение. И, может быть, даже работает :о)
Мне приходилось встречать на некоторых форумах "дружеские советы" новичкам, сводившиеся к предложению "не обращать на эту ерунду внимания, это оптимизатор у Delphi выделывается."
Так ли это на самом деле?
При наличии в проекте ошибок-Errors, не будет сформирован исполняемый файл и, волей не волей, ошибки придется исправлять. Наличие же сообщений Hints и Warnings позволяет запускать приложение. Обратите внимание на окно процесса компиляции (рис. 1), в строке "Done" написано не Compiled, что, в общем-то, ожидалось, а предупреждение There are warnings. Несмотря на отсутствие ошибок, проект откомпилирован с тремя "подсказками" и пятью "предупреждениями".
Насколько безопасно не обращать на это внимание? Начнем с самых безобидных сообщений компилятора, с его советов — Hints.
Delphi - сбориник статей
Иконки в трейбаре? Проще чем кажется!
Михаил Продан, Во многих форумах с завидной систематичностью выплывают вопросы об иконках в трее и многие программеры с недовольством отвечают: "Это же так просто, почитай документацию". Да, действительно просто - но лучше все посмотреть на практике, в человеческом, так сказать, изложении. Эта статья как раз и предназначена для заполнения некоторого "информационного вакуума" сложившегося по данной теме и расскажет о некоторых приемах работы с треем в Delphi.Описание параметров:
Определения
Итак, tray - это область рабочего стола Explorer'а, которая находится в одном из углов экрана, "там где часы". Вся информация, которую можно "почерпнуть" из трея, представлена в виде возможно изменяющихся иконок, отражающих состояние программы, и всплывающих подсказок. К числу активных действий над иконкой в трее можно отнести щелчок левой кнопкой и вызов контекстного меню правой.
Параметр - тип
CbSize - DWORDWnd - HWND
UID - UINT
UFlags - UINT
UCallbackMessage - UINT
Icon - HICON
SzTip - Array [0..64] of AnsiChar
С чего начать
Для операций с иконками трея используется только одна функция Windows - Shell_NotifyIconData, определение которой "звучит" следующим образом:function Shell_NotifyIcon (dwMessage: DWORD; lpData: PNotifyIconData): BOOL; stdcall;
И в качестве параметров функция воспринимает:
Как видно, сам синтаксис функции не сказал нам ничего нового о том, как реализована работа с треем. Эта функция только изменяет состояние иконки в зависимости от значения параметра dwMessage - а это значит, что вся нужная нам информация находится в структуре TNotifyIconData. Давайте теперь рассмотрим ее более детально…
Tray в чистом виде
А теперь приступим к собственно выводу иконки в трей. Для начала создадим форму, где все это разместим:type
TForm1 = class (TForm)
Button1: TButton;
procedure Button1Click (Sender: TObject);
procedure FormDestroy (Sender: TObject);
private
procedure TrayDefaultHandler (var Message:TMessage);
{Private declarations}
public
Data:TNotifyIconData;
{Public declarations}
end;
потом - кнопку TButton, в которой запишем:
procedure TForm1.Button1Click (Sender: TObject);
var H:THandle;
begin
H:=AllocateHWnd (TrayHandler);
FillChar (S,SizeOf (S),#0);
Data.cbSize:=SizeOf (S);
Data.Wnd:=H;
Data.uCallbackMessage:=WM_TRAYICON;
Data.uFlags:=NIF_ICON or NIF_TIP or NIF_MESSAGE;
Data.hIcon:=Application.Icon.Handle;
StrPCopy (data.szTip,Application.Title);
Shell_NotifyIcon (NIM_ADD,@data);
end;
Небольшие пояснения. Во-первых, мы создаем постое окно с дескриптором H, которое будет реагировать на сообщения иконки. После этого очищаем предопределенную структуру Data типа TNotifyIconData, затем заполняем необходимые поля. Значение поля uFlags представляют собой уведомление системы о том, что ей надо использовать. Так, использование значения NIF_ICON уведомляет систему о том, что в поле hIcon присутствует непустое значение, которое надо вывести в виде иконки; использование значения NIF_TIP говорит о наличии текста всплывающей подсказки в поле szTip; значение NIF_MESSAGE - о том, что в поле Wnd присутствует дескриптор окна, которому передается управление при возникновении того или иного сообщения у иконки.
После заполнения всех необходимых полей вызывается функция Shell_NotifyIcon со значением NIM_ADD - добавление иконки в трей.
Теперь рассмотрим реакцию иконки на сообщения:
procedure TForm1.TrayDefaultHandler (var Message:TMessage);
begin
if Message.Msg=WM_TRAYICON then
if Message.LParam=WM_LBUTTONDOWN then
begin
ShowMessage ('Left Button Down');
end;
end;
Как видно из текста, здесь в качестве реакции реализован простой вывод уведомления о нажатии левой кнопки мыши на иконке. Идентификатор WM_TRAYICON, используемый здесь, определен нами в модуле главной формы следующим образом:
const WM_TRAYICON = WM_USER + 1;
такое определение необходимо для того, чтобы сообщения системы не перекрывались.
После того как мы убедились в наличии реакции и хотим закрыть приложение, нам надо удалить нашу иконку из трея, так как, если мы этого не сделаем, то она останется лежать там до следующей перегрузки Explorer'а.
Удаление иконки реализуется таким кодом:
procedure TForm1.FormDestroy (Sender: TObject);
begin
Shell_NotifyIcon (NIM_DELETE,@data);
end;
Здесь нам даже не потребовалось никаких вмешательств в структуру data - мы просто вызвали Shell_NotifyIcon с необходимым параметром, как показано ниже:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls;
const UWM_TRAYICON = WM_USER+1;
const ID_TRAYICON = 1;
type
TForm1 = class (TForm)
Button1: TButton;
procedure Button1Click (Sender: TObject);
procedure FormDestroy (Sender: TObject);
private
procedure TrayDefaultHandler (var Message:TMessage);
{Private declarations}
public
data:TNotifyIconData;
{Public declarations}
end;
var
Form1: TForm1;
implementation
Uses ShellApi;
{$R *.dfm}
procedure TForm1.TrayDefaultHandler (var Message:TMessage);
begin
if Message.Msg=UWM_TRAYICON then
if Message.LParam=WM_LBUTTONDOWN then
begin
ShowMessage ('Left Button Down');
end;
end;
procedure TForm1.Button1Click (Sender: TObject);
var H:THandle;
begin
H:=AllocateHWnd (Self.TrayDefaultHandler);
FillChar (S,SizeOf (S),#0);
data.cbSize:=SizeOf (S);
data.Wnd:=H;
data.uCallbackMessage:=UWM_TRAYICON;
data.uFlags:=NIF_ICON or NIF_TIP or NIF_MESSAGE;
data.hIcon:=Application.Icon.Handle;
StrPCopy (data.szTip,Application.Title);
Shell_NotifyIcon (NIM_ADD,@data);
end;
procedure TForm1.FormDestroy (Sender: TObject);
begin
Shell_NotifyIcon (NIM_DELETE,@data);
end;
end.
Эта небольшая заметка лишь слегка
Эта небольшая заметка лишь слегка приоткрывает занавес над таким обширным полем для деятельности, как иконки в трейбаре. Вообще же в этой области создано немало чудных вещей - например, компоненты с возможностью анимации (как в The Bat!) и прочими "вкусностями".Кроме того, на иконку, как правило, навешивается меню по правой кнопке - для краткости примера здесь не показано, как это сделать, но, надеюсь, это и так ясно. Как говорится, "нет предела совершенству" - так что дерзайте! document.write('');
Архив новостей
2 Август, 17:53 (19)
2 Август, 17:51 (34)
2 Август, 15:40 (42)
2 Август, 15:35 (1)
2 Август, 14:54 (3)
2 Август, 14:34 (3)
2 Август, 14:15 (2)
2 Август, 13:34 (7)
2 Август, 13:04 (3)
2 Август, 12:28
Море работы для программистов, сисадминов, вебмастеров.
Иди и выбирай!
|
|
| IT-консалтинг | Software Engineering | Программирование | СУБД | Безопасность | Internet | Сети | Операционные системы | Hardware |
| PR-акции, размещение рекламы — , тел. +7 495 6608306, ICQ 232284597 | Пресс-релизы — |
|
|
|
| This Web server launched on February 24, 1997 Copyright © 1997-2000 CIT, © 2001-2009 |
|
|
| Внимание! Любой из материалов, опубликованных на этом сервере, не может быть воспроизведен в какой бы то ни было форме и какими бы то ни было средствами без письменного разрешения владельцев авторских прав. |
|
Если Вы решили приобрести , тогда Вам просто необходимо воспользоваться предложением от нашей компании. |
Вариант передачи параметра в хранимую процедуру, использующую оператор IN
Нариман Курбанов (_MaSteR_NN_),В этой статье мы рассмотрим возможность передачи параметров в хранимую процедуру, использующую оператор IN. Изложение материала будет вестись на базе тестового примера, который мы будем обсуждать по ходу описания данной статьи.
Используется: СУБД MSSQL 2000, Delphi7, ADO.
Итак, начнём:
Поставим перед собой задачи:
--Создаём таблицу Sellers CREATE TABLE [dbo].[Sellers] ( [ID] [bigint] IDENTITY (1, 1) NOT FOR REPLICATION NOT NULL, [SellerName] [Nvarchar] (300) COLLATE Cyrillic_General_CI_AS NULL ) ON [PRIMARY] Sellers - таблица, в которой будем хранить имена продавцов.
Поля:
Поля:
Сначала таблицу Sellers. INSERT INTO [Sellers] ([SellerName]) VALUES ('Дмитрий Олегович') INSERT INTO [Sellers] ([SellerName]) VALUES ('Антон Насыров') INSERT INTO [Sellers] ([SellerName]) VALUES ('Олег Арсеньев') INSERT INTO [Sellers] ([SellerName]) VALUES ('Алексей Логинов') INSERT INTO [Sellers] ([SellerName]) VALUES ('Альберт Игнатов') Затем таблицу SoldGoods. INSERT INTO [SoldGoods] ([GoodsName], [QuantitySold], [SoldDate], [SellerID]) VALUES ('Материнская плата', 5, '20060101', 1) INSERT INTO [SoldGoods] ([GoodsName], [QuantitySold], [SoldDate], [SellerID]) VALUES ('Видеокарта', 16, '20060108', 1) INSERT INTO [SoldGoods] ([GoodsName], [QuantitySold], [SoldDate], [SellerID]) VALUES ('Монитор', 4, '20060206', 1) INSERT INTO [SoldGoods] ([GoodsName], [QuantitySold], [SoldDate], [SellerID]) VALUES ('Сетевая плата', 8, '20060206', 1) INSERT INTO [SoldGoods] ([GoodsName], [QuantitySold], [SoldDate], [SellerID]) VALUES ('Материнская плата', 6, '20060103', 2) INSERT INTO [SoldGoods] ([GoodsName], [QuantitySold], [SoldDate], [SellerID]) VALUES ('Монитор', 9, '20060103', 2) INSERT INTO [SoldGoods] ([GoodsName], [QuantitySold], [SoldDate], [SellerID]) VALUES ('Сетевая плата', 14, '20060106', 2) INSERT INTO [SoldGoods] ([GoodsName], [QuantitySold], [SoldDate], [SellerID]) VALUES ('Видеокарта', 7, '20060102', 3) INSERT INTO [SoldGoods] ([GoodsName], [QuantitySold], [SoldDate], [SellerID]) VALUES ('Материнская плата', 6, '20060109', 3) INSERT INTO [SoldGoods] ([GoodsName], [QuantitySold], [SoldDate], [SellerID]) VALUES ('Монитор', 1, '20060115', 3) INSERT INTO [SoldGoods] ([GoodsName], [QuantitySold], [SoldDate], [SellerID]) VALUES ('Сетевая плата', 30, '20060120', 3) INSERT INTO [SoldGoods] ([GoodsName], [QuantitySold], [SoldDate], [SellerID]) VALUES ('Видеокарта', 14, '20060106', 4) INSERT INTO [SoldGoods] ([GoodsName], [QuantitySold], [SoldDate], [SellerID]) VALUES ('Материнская плата', 4, '20060106', 4) INSERT INTO [SoldGoods] ([GoodsName], [QuantitySold], [SoldDate], [SellerID]) VALUES ('Монитор', 5, '20060202', 5) INSERT INTO [SoldGoods] ([GoodsName], [QuantitySold], [SoldDate], [SellerID]) VALUES ('Сетевая плата', 19, '20060105', 5) С созданием и заполнением таблиц на сервере закончили. Приступим к разработке клиентской части.
Клиентское приложение будет иметь две формы и один DataModule.
Положим на главную (первую) форму список (TCheckListBox), в котором будут выбираться продавцы.
Теперь добавим новую форму (форма для показа отчёта) в проект, и положим на неё сетку (TDBGrid), в которую будут выводиться результаты выборки.
Так же создадим DataModule1: TDataModule и положим на него следующие компоненты: ADOConnection1: TADOConnection; ADOStoredProc1: TADOStoredProc; DataSource1: TDataSource; ADOStoredProc2: TADOStoredProc; DataSource2: TDataSource; ADOQuery1: TADOQuery; DataSource3: TDataSource; Получим результат такого вида:
Настройка компонентов: ADOConnection1.LoginPrompt := False; DataSource1.DataSet := ADOStoredProc1; DataSource2.DataSet := ADOStoredProc2; DataSource3.DataSet := ADOQuery1; Form2.DBGrid1.DataSource := DataModule1.DataSource2; Первая (главная) форма должна использовать (uses) DataModule и Form2
Вторая (форма отчёта) форма должна использовать (uses) DataModule
"Каркас" нашего приложения готов!
Самая первая задача, это соединиться с сервером из нашего приложения. Для этого нам понадобиться файл с расширением ".udl", назовём его "Connect.udl". (Создайте файл в директории с исходным кодом). При запуске этого файла должно появиться окно:
Тут мы и настраиваем соединение с сервером. Затем в обработчике события создания формы напишем код для соединения с сервером:
procedure TForm1.FormCreate(Sender: TObject); begin //БУДЬТЕ ВНИМАТЕЛЬНЫ, СНАЧАЛА ДОЛЖЕН СОЗДАВАТЬСЯ DataModule1 // закрываем Коннект с базой DataModule1.ADOConnection1.Close; // указываем файл .udl для ADOConnection1 DataModule1.ADOConnection1.ConnectionString := 'FILE NAME='+GetCurrentDir+'\Connect.udl'; // Указываем провайдера, в данном случае возьмём его из файла .udl DataModule1.ADOConnection1.Provider := 'FILE NAME='+GetCurrentDir+'\Connect.udl'; // Открываем Коннект DataModule1.ADOConnection1.Open; end; Как видим, в коде имеется предупреждение вида: "БУДЬТЕ ВНИМАТЕЛЬНЫ, СНАЧАЛА ДОЛЖЕН СОЗДАВАТЬСЯ DataModule1". Это означает, что в проекте перед созданием главной формы должен создаваться DataModule1. Для этого нужно нажать сочетание клавиш CTRL+SHIFT+F11 и в разделе Auto-Create Forms DataModule1 должен стоять первым. И уберите и списка Form2, эту форму будем создавать динамически.
На данный момент, мы уже имеем процедуру соединения с сервером. (Скомпилируйте и запустите проект, если нет ошибок, продолжаем далее).
Следующая задача, это получение списка продавцов с сервера и заполнения им нашего CheckListBox1, который находится на главной форме. Для этого нам нужно создать хранимую процедуру на сервере, которая будет возвращать нам список, и процедуру в клиентском приложении, которая будет в свою очередь запускать хранимую процедуру и получать данные с сервера.
Начнём с хранимой процедуры на сервере: CREATE PROCEDURE [dbo].[pSelectSellers] AS --выбираем все из таблицы продавцов SELECT * FROM SELLERS GO Затем процедура на клиенте (Все процедуры создаются в главном модуле Form1):
//процедура для получения списка работников procedure TForm1.SelectSellers(); begin with DataModule1.ADOStoredProc1 do begin // закрываем Close; // присваиваем Connection Connection := DataModule1.ADOConnection1; // указываем имя хранимой процедуры на сервере ProcedureName := 'pSelectSellers'; // открываем датасет Open; // переводим Connection в Nil Connection := Nil; end; end; Таким образом, в дальнейшем мы получим список продавцов в датасет. Приступим к заполнению CheckListBox1.
На событие TForm1.FormShow "вешаем": procedure TForm1.FormShow(Sender: TObject); begin // запускаем процедуру получения списка работников (см. выше), // и получаем список продавцов в датасет SelectSellers(); // очищаем список CheckListBox1 CheckListBox1.Items.Clear; // ставим курсор датасета на первую запись DataModule1.ADOStoredProc1.First; try // начало изменений в списке CheckListBox1 CheckListBox1.Items.BeginUpdate; // цикл - пока не достигли конца записей ADOStoredProc1 while not DataModule1.ADOStoredProc1.Eof do begin { заполняем CheckListBox1 именами из таблицы Sellers В параметре AObject : TObject будем хранить значение ID-поля таблицы Sellers} CheckListBox1.Items.AddObject( DataModule1.ADOStoredProc1.fieldbyname('SellerName').AsString, pointer(DataModule1.ADOStoredProc1.fieldbyname('ID').AsInteger)); // переводим курсор датасета на следующую запись DataModule1.ADOStoredProc1.Next; Application.ProcessMessages; end; finally // конец изменений в списке CheckListBox1 CheckListBox1.Items.EndUpdate; end; end; Мы в цикле заполнили Items.AddObject нашего CheckListBox1, где в первом параметре Const S мы храним имена продавцов, а в AObject храним поле ID, которое будем получать так: Integer(CheckListBox1.Items.Objects[i]);
На данный момент результат должен быть таков, запускаем проект и получаем
Главная форма: список продавцов.
Наш вариант передачи параметра будет работать по следующему принципу.
Список продавцов получен. (См. выше) Для создания, удаления временной таблицы и выбора отчёта в приложении создадим три отдельные процедуры. Первая процедура из вышеописанных будет "для создания временной таблицы".
{процедура для создания временной таблицы на сервере} procedure TForm1.CreateTempTable(); begin with DataModule1.ADOQuery1 do begin // закрываем Close; // присваиваем Connection Connection := DataModule1.ADOConnection1; // создаём запрос на создание временной таблицы на сервере SQL.Text := 'CREATE TABLE #TEMP(NUM INT)'; // открываем датасет ExecSQL; // переводим Connection в Nil Connection := Nil; end; end; Тем самым, вызвав эту процедуру, сервер будет создавать временную табличку под названием #TEMP.
Следующая процедура будет "для удаления временной таблицы". {процедура для удаления временной таблицы на сервере} procedure TForm1.DeleteTempTable(); begin with DataModule1.ADOQuery1 do begin // закрываем Close; // присваиваем Connection Connection := DataModule1.ADOConnection1; // создаём запрос на удаление временной таблицы на сервере SQL.Text := 'DROP TABLE #TEMP'; // открываем датасет ExecSQL; // переводим Connection в Nil Connection := Nil; end; end; И последняя третья процедура на запуск хранимой процедуры на сервере для выбора отчёта. {процедура для получения отчёта} procedure TForm1.SelectReport(); begin with DataModule1.ADOStoredProc2 do begin // закрываем Close; // присваиваем Connection Connection := DataModule1.ADOConnection1; // указываем имя хранимой процедуры на сервере ProcedureName := 'pSelectReport'; // обновляем параметры процедуры Parameters.Refresh; // открываем датасет Open; // переводим Connection в Nil Connection := Nil; end; end; Данная процедура будет запускать на сервере хранимую процедуру под названием pSelectReport, которой у нас пока нет. Создадим её: CREATE PROCEDURE [dbo].[pSelectReport] AS --выбираем данные из таблиц "Продавцы(SELLERS)" и "Проданные товары(SOLDGOODS)" --при помощи оператора IN в котором будем указывать(выбирать) идентификаторы из таблицы #TEMP SELECT S.ID AS SELLERID, S.SELLERNAME, SG.GOODSNAME, SG.QUANTITYSOLD, SOLDDATE FROM SELLERS S LEFT JOIN SOLDGOODS SG ON SG.SELLERID = S.ID WHERE S.ID IN (SELECT NUM FROM #TEMP) GO Примечание: как мы видим, данная процедура использует параметр IN, в котором мы задаём выборку идентификаторов из таблицы #TEMP.
Совет: Так же можно использовать оператор JOIN. Например:
SELECT S.ID AS SELLERID, S.SELLERNAME, SG.GOODSNAME, SG.QUANTITYSOLD, SOLDDATE FROM SELLERS S LEFT JOIN SOLDGOODS SG ON SG.SELLERID = S.ID INNER JOIN #TEMP T ON S.ID = T.NUM При более сложных запросах, данная конструкция будет более оптимальна. Итак, мы имеем процедуры на создание и удаление временной таблицы, выбора отчёта, выбора продавцов. Порядок их запуска должен быть примерно таков:
procedure TForm1.Button1Click(Sender: TObject); var i : integer; begin TRY //начинаем транзакцию DataModule1.ADOConnection1.BeginTrans; //Запускаем процедуру создающую временную таблицу на сервере (см.выше) CreateTempTable(); // создаём цикл - до конца записей в списке CheckListBox1 for i := 0 to CheckListBox1.Items.Count-1 do begin // если текущий Item в CheckListBox1 находится в состоянии Checked if CheckListBox1.State[i] = cbChecked then begin with DataModule1.ADOQuery1 do begin // закрываем Close; // присваиваем Connection Connection := DataModule1.ADOConnection1; // создаём запрос на заполнение временной таблицы на сервере SQL.Text := 'INSERT INTO #TEMP VALUES (:NUM)'; Parameters.ParamByName('NUM').Value := IntToStr(Integer(CheckListBox1.Items.Objects[i])); // открываем датасет ExecSQL; // переводим Connection в Nil Connection := Nil; end; CheckListBox1.Selected[i]; end; end; // запускаем процедуру формирования отчёта (см. выше) SelectReport(); //Удаляем временную таблицу на сервере (см.выше) DeleteTempTable(); //завершаем транзакцию DataModule1.ADOConnection1.CommitTrans; //создаём форму отчёта Application.CreateForm(TForm2, Form2); // показываем её в модальном режиме Form2.ShowModal; EXCEPT //при ошибке, откатываем транзакцию DataModule1.ADOConnection1.RollbackTrans; // показываем диалог ошибки MessageDlg('Ошибка при формировании отчёта.', mtError, [mbRetry], 0); END; end; Попробуем "разобрать" данную процедуру. Сначала мы начали транзакцию и создали временную таблицу на сервере. Затем создали цикл, который "проходит" по всем записям, хранящимся в CheckListBox1, выбирая из параметра AObject уникальный идентификатор каждого отмеченного продавца, и помещаем его в таблицу #TEMP. Далее запускаем процедуру формирования отчёта, в которой, используя, оператор IN, мы задействуем уже существующую и заполненную временную таблицу #TEMP. Выбрав отчёт, мы удаляем временную таблицу, запустив процедуру на её удаление. И последнее. Завершаем транзакцию и показываем форму отчёта.
Примечание: Наша транзакция расположена в блоке TRY : EXCEPT : END; это означает что при возникновении ошибки, она автоматически произведёт откат изменений методом RollbackTrans, и покажет MessageDlg. Иначе транзакция будет успешно завершена методом CommitTrans.
Результат формирования отчёта должен быть таков:
Полученный отчёт.
На этом мы и закончим рассмотрение нашего тестового примера.
К статье прилагается пример с описанием. Для работы примера, необходимо подключить базу (в папке DB) или создать свою, и настроить параметры соединения в файле Connect.udl(в папке Sources)
Проект, используемый в качестве примера (119 K) allGray">
Delphi - сбориник статей
Адресация пользователей в Jabber
Каждый пользователь в сети имеет уникальный идентификатор, адрес — Jabber ID (сокращённо JID). Во избежание необходимости существования сервера с полным списком всех адресов, JID подобно адресу электронной почты содержит имя пользователя (JID node) и DNS-адрес сервера (JID domain), на котором зарегистрирован пользователь, разделённые знаком (@). Например, пользователь user, зарегистрированный на сервере example.com, будет иметь следующий адрес (JID): user@example.com.Также пользователь может подключаться, находясь в разных местах, сервер позволяет определять дополнительное значение, называемое ресурсом, который идентифицирует клиента пользователя в данный момент. Так можно включить в адрес пользователя (JID) имя его ресурса (JID resource), добавив через слэш в конце адреса.
К примеру, пусть полный адрес пользователя будет user@example.com/work, тогда сообщения, посланные на адрес user@example.com, дойдут на указанный адрес вне зависимости от имени ресурса, но сообщения для user@example.com/work дойдут на указанный адрес только при соответствующем подключённом ресурсе.
Адреса (JID) могут также использоваться без явного указания имени пользователя (с указанием имени ресурса или без такового) для системных сообщений и для контроля специальных возможностей на сервере.
Запомним эту информацию, она нам пригодятся в дальнейшем.
Атрибуты элементов XML
При приходе XML у тегов могут быть следующие основные атрибуты:to — кому (JID).
From — откуда (JID).
Id — уникальный идентификатор, так называемый атрибут 'системы обнаружения атак'. Позволяет конкретно идентифицировать полученные данные. Рекомендовано делать его случайным. Но в принципе это не обязательно.
xml:lang — текущий язык, кодировка данных.
Version — версия.
Теги могут включать также и дополнительные атрибуты, зависящие от передоваемых данных.
Пример строфы
Базовые семантические модули
После того как мы прошли авторизацию, разберем основные базовые семантические модули XML-строф реализованных в протоколе, их довольно немного:Дочерние элементы
XML-строфаЭлемент
away — Отошел,
chat — Готов чатится (В сети),
dnd — Занят,
xa — Недоступен
Пустой элемент
Элемент
Дочерние элементы
У XML-строфыЭлемент строфы
Где элемент — является телом сообщения. В значении элемента содержится сам текст сообщения, предварительно перекодированный из-за ограничений XML. Элемент может содержать атрибут 'xml:lang' содержащий язык сообщения. В
Например:
Элемент
Информационные запросы
Информационные запросы Расширенные запросы, определенные дополнительными пространствами имен, описаны в различных дополнениях к протоколу XMPP.
Пространство имен расширенных запросов, может содержать любое значение, кроме зарезервированных следующих пространств имен: "jabber:client", "jabber:server" или "http://etherx.jabber.org/streams". Такое расширение позволяет придать протоколу XMPP дополнительную функциональность и гибкость. Таким образом, расширенный информационный запрос
Стандартный запрос не может содержать, дочерние элементы, кроме элемента
Поддержка любого расширенного пространства имен является дополнительной возможностью со стороны клиента. Если клиент не понимает такое пространство имен, то есть фактически не поддерживает данное расширение, то он должен проигнорировать данный пакет. Более подробно вы можете прочитать об этом в RFC 3921.
Структурная схема обмена информационными запросами:
Запрос Ответ ---------- ---------- | | |
Это первый вариант обмена. Существует и второй, когда запрашивающая сторона информирует принимающую о каком-то изменении, для этого она отправляет запрос с атрибутом type равным значению "set". Данное значение атрибута говорит о том, что принимающая сторона должна обработать присланные данные. Если принимающая сторона не может по каким-либо причинам обработать присланные данные, то в ответ она посылает строфу
Пример расширенного запроса определяющий информацию об использованном клиенте (XEP-0092 Software Version):
Запрос:
Основные сведения о протоколе XMPP
В основе протокола XMPP (eXtensible Messaging and Presence Protocol) лежит язык XML. XMPP является открытым, свободным протоколом для мгновенного обмена сообщениями и информацией о присутствии в режиме околореального времени.Изначально спроектированный легко расширяемым протокол помимо передачи текстовых сообщений поддерживает передачу голоса и файлов по сети.
Данный протокол принят как стандарт RFC.
Стандартный порт для Jabber-клиентов — 5222.
Протокол регламентируется следующими стандартами:
RFC 3920 — Extensible Messaging and Presence Protocol (XMPP): Core
RFC 3921 — Extensible Messaging and Presence Protocol (XMPP): Instant Messaging and Presence
Следует также отметить, так как протокол является текстовым, а не бинарным соответственно у этого протокола есть слабые стороны, а именно: избыточность передаваемой информации, отсутствие возможности передачи двоичных данных приводит к использованию различных способов перекодировки. В результате этого, для передачи файлов приходится использовать дополнительные протоколы, например HTTP. Если этого не избежать, то XMPP обеспечивает встроенную передачу файлов кодируя информацию используя base64. Другая двоичная информация, такая как закодированный разговор или графические иконки включаются с использованием такого же метода. Однако прежде чем двигаться дальше рассмотрим адресацию пользователей с Jabber-сетях.
Отправка и прием сообщений
Прием и отправка сообщений осуществляется через XML-строфу Типы сообщений могут быть следующие:
chat — Одиночное сообщение от клиента к клиенту.
error — Сообщение об ошибке. Произошедшая ошибка связанна с предыдущим, посланным одиночным сообщением.
groupchat — Групповой чат. Данное сообщение пришло с группового чата, действующего по признаку "Одно сообщение — многим получателям".
headline — Системное сообщение, автоматически генерируется различными сервисами для шировещательной рассылки (новости, спорт, RSS-каналы и пр.) Отвечать на такие сообщение не нужно, да и не зачем.
normal — одиночное сообщение, посылаемое вне контекста взаимно-однозначного сеанса связи или группового чата. То есть это такое сообщение, на которое пользователь может дать ответ, не учитывая хронологии сеанса связи.
Перекодировка символов текста
Поскольку символы "<" и ">" используются для обозначения самих XML тегов, то их вставка в текст сообщения недопустима (за исключением случая, когда вставлен символ ">", но никакой тег не был открыт). Поэтому для корректного формирования XML следующие символы должны быть заменены в теле сообщения при отправке оного и соответственно обратно возвращены при приеме:"<" в "<"
">" в ">".
Таким образом, чтобы написать "2>1", нужно написать "2>1". То же самое касается и знака "&" — он заменяется "&". Также рекомендуется заменять и кавычки (хотя в большинстве случаев они хорошо распознаются и без этого). Эквивалент двойных кавычек — """
Подготовка
Сразу оговорюсь, что я не ставлю перед собой задачу написать полноценно работающий клиент соответствующий полному стандарту XMPP. Слишком большой труд, скажем так, однако основные методы работы с XMPP будут включены в мой исходный компонент.В качестве основы для работы клиента мной были взяты наработки по работе с WinSock , используемые им в TICQClient, немного портированные, кое-где измененные и дополнительно комментированные мной, для нашего демо-клиента.
В качестве парсера XML мной был взят TjanXMLParser2, благо он бесплатный, довольно быстрый. Стандартный парсер MSXML был мной отброшен по причине, того, что некоторые XML-пакеты приходили синтаксически неправильные, что начисто отрубало желание этого парсера работать с ними.
Что касается приведенных далее листингов обмена протоколом, я постарался описать самые интересные части, если у вас кое-где возникнут вопросы, подробнее вы можете узнать в RFC. Все 800 основного RFC страниц я не смогу Вам подробно изложить, но критические места постараюсь.
Также сразу оговорюсь, что наш пример не будет поддерживать шифрование, то есть данные будут передаваться в открытом виде. Сделано это для упрощения понимания примера. Вышло, то, что вышло, а хорошо иль плохо получилось судить Вам, уважаемые коллеги.
Итак, для тестирования нашего примера, мной был зарегистрирован на сайте jabber.ru аккаунт delphi-test@jabber.ru с паролем delphi-test. Эти данные нам понадобятся для разбора протокола обмена между сервером jabber (далее — Сервер) и нашим клиентом (также — Клиент) далее.
Прохождение аутенфикации
Итак, первым действием при соединении с сервером Jabber, которым должен выполнить наш клиент — является аутенфикация. Аутенфикация будет происходить используя механизм SASL аутенфикации, описанный в в "RFC 2831 — Using Digest Authentication as a SASL Mechanism", алгоритм работы который будет рассмотрен подробнее, чуть далее.Итак, мы установили физическое соединение с сервером, теперь нам нужно пройти аутенфикацию, для этого клиент посылает серверу следующий пакет:
nonce="22647748",qop="auth",charset=utf-8,algorithm=md5-sess Из этой строки нам понадобится значение Nonce для последующего построения ответа серверу, после чего мы подготавливаем строку ответа, которую мы передадим на сервер в ответном пакете, предварительно закодировав ее в Base64. Итак, ответная строка будет иметь следующий вид:
username="delphi-test", realm="jabber.ru", nonce="22647748", cnonce="2313e069649daa0ca2b76363525059ebd", nc=00000001, qop=auth, digest-uri="xmpp/jabber.ru" ,charset=utf-8, response=16351f86cc5591312e20b4ccd880eadb где:
username — JID-node пользователя
realm — JID-domain пользователя
nonce — Уникальный код сессии, присланный нам ранее сервером
cnonce — Уникальный код ответной клиентской сессии, сгенерированный клиентом
nc — Так называемый once count — сколько раз был использован текущий nonce. Обычно значение параметра равно 00000001, его и будем использовать. На самом деле параметр довольно интересный и стоит отдельного рассмотрения и изучения в RFC, но как показала практика его смело можно игнорировать.
digest-uri — Протокол подключения, для XMPP сервера он состоит из соединения строк "xmpp/" + JID Domain
charset — поддержка кодировки пароля и имени, в нашем случае UTF-8
И самый важный параметр response в котором заключен ключ ответа серверу, включающий в себя пароль и ответные данные в формате MD5 строящийся по определенному алгоритму.
Алгоритм построения строки ответа и параметра Response более подробно мы рассмотрим далее в подразделе "RFC 2831 использование MD5-Digest аутенфикации в SASL". Пока примем к сведению, что текущее и следующие два действие относится уже к данному алгоритму.
Итак, строку ответа, мы сформировали, закодировали в Base64 и отправляем обратно серверу (всё это должно быть в одну строчку, но, чтобы страница не расползалась, разбито на несколько):
Сервер подтверждает связывание ресурса с данным клиентом:
Пространства имен XML
Так как первоначально XMPP был задуман, как протокол, поддерживающий расширения, перед разработчиками встал вопрос, как можно реализовать данные расширения, не внося коррективы в основной протокол. И решение нашлось. Это решение — пространство имен, довольно известное в XML.Пространство имён в XML — именованная совокупность имён элементов и атрибутов, служащая для обеспечения их уникальности в XML-документе. Все имена элементов в пределах пространства имён должны быть уникальны. Таким образом, реализуется различение одинаковых элементов XML или атрибутов. Для клиентов Jabber зарезервировано пространство имен "jabber:client"
Пространства имён объявляются с помощью зарезервированного XML атрибута xmlns, значение которого является названием пространства имен.
Например, элемент
Работа с ростер-листом (списком контактов)
Ростер-лист или аналог списка контактов в сетях ICQ в Jabber-е представлен списком, содержащим JID-контакты в виде элементов XML хранящимся на сервере от имени пользователя. Так как ростер-лист сохранен сервером от имени пользователя, то пользователь может обратиться к информации списка от любого ресурса.Управление ростер-листом (списком) осуществляется через расширенный информационный запрос
Уникальный идентификатор каждого элемента списка
none — У пользователя нет подписки к контакту, нет подписки и к информации присутствия пользователя
to — у пользователя есть подписка к информации присутствия контакта, но у контакта нет подписки к информации присутствия пользователя
from — у контакта есть подписка к информации присутствия пользователя, но у пользователя нет подписки к информации присутствия контакта
both — у пользователя есть подписка к присутствию контакта, да и у контакта есть подписка к пользователю.
RFC 2831 использование MD5-Digest аутенфикации в SASL
Итак, аутенфикация решает следующие задачи: Передача пароля на сервер, в закрытом виде, защиту от повторяющихся атак (monitoring nc value), защиту (monitoring nonce) в определённый промежуток времени от определённого клиента. Для того, что бы понять, как работает данный стандарт, разберем основы SASL.Общие принципы работы SASL
Метод SASL (Simple Authentication and Security Layer) используется для добавления поддержки аутентификации в различные протоколы соединения. Для аутентификации могут быть использованы различные механизмы.
Имя требуемого механизма задаётся клиентом в команде аутентификации. Если сервер поддерживает указанный механизм, он посылает клиенту последовательность окликов (challenges), на которые клиент посылает ответы (responses), чтобы удостоверить себя. Содержимое окликов и ответов определяется используемым механизмом и может представлять собой двоичные последовательности произвольной длины. Кодировка последовательностей определяется прикладным протоколом. Вместо очередного оклика сервер может послать подтверждение аутентификации или отказ. Кодировка также определяется протоколом. Вместо ответа клиент может послать отказ от аутентификации. Кодировка опять определяется протоколом. В результате обменов откликам и ответами должна произойти аутентификация (или отказ), передача идентификатора клиента (пустой идентификатор влечёт получение идентификатора из аутентификации) серверу и, возможно, договорённость об использовании безопасного транспортного протокола (security layer), включая максимальный размер буфера шифрования.
Идентификатор клиента может отличаться от идентификатора, определяемого из аутентификации, для обеспечения возможности работы прокси.
Реализация на примере механизма MD5-Digest
Схема работы SASL для нашего клиента основана на использовании механизма MD-Digest и имеет следующий алгоритм работы:
Сервер посылает случайную строку nonce, наличие поддержки utf-8 в параметре charset для имени и пароля, алгоритм аутентификации (обязательно md5-sess) в параметре algorithm.
То есть те данные, что мы раскодировали ранее из пакета challenge:
nonce="22647748",qop="auth",charset=utf-8,algorithm=md5-sess Клиент отвечает строкой, содержащей: идентификатор клиента username, идентификатор домена realm, полученную от сервера случайную строку nonce, случайную строку клиента cnonce, номер запроса (позволяет серверу заметить попытку replay attack) nc. параметр digest-uri (сочетание имени сервиса, имени сервера т.е. 'xmpp/' + JID Domain), строку responce подтверждающею знание пароля и ответ на оклик (MD5 от имени пользователя, realm, пароля, случайной строки сервера, случайной строки клиента, идентификатора клиента, номера запроса, уровня защиты, digest-uri; некоторые компоненты берутся в виде MD5, некоторые в исходном виде, некоторые в обоих видах), использование utf-8 для имени и пароля, принятый алгоритм шифрования и идентификатор клиента.
То есть, как вы догадались эта та строка, которую мы формируем в ответ:
username="delphi-test", realm="jabber.ru", nonce="22647748", cnonce="2313e069649daa0ca2b76363525059ebd", nc=00000001, qop=auth, digest-uri="xmpp/jabber.ru", charset=utf-8, response=16351f86cc5591312e20b4ccd880eadb Сервер проверяет ответ на оклик и посылает ответ на ответ в похожем формате (но всё же отличающемся, чтобы клиент мог убедиться в подлинности сервера). Данный механизм слабее системы с открытыми ключами, но лучше простой CRAM-MD5.
Примечание: Стоит отметить, что может предусматриваться упрощённый протокол повторной аутентификации (начинается сразу с посылки клиентом ответа с увеличенным на 1 номером запроса).
Алгоритм вычисления строки ответа response
Алгоритм вычисления строки ответа response имеет следующую формулу:
response-value = HEX( KD ( HEX(H(A1)), { nonce-value, ":" nc-value, ":", cnonce-value, ":", qop-value, ":", HEX(H(A2)) })) A1 = { H( { username-value, ":", realm-value, ":", passwd } ), ":", nonce-value, ":", cnonce-value } A2 = { "AUTHENTICATE:", digest-uri-value } Где:
Выражение { a, b, ... } — означает сложение строк a, b
HEX(n) — 16-байтовый MD5-хеш n, приведенный в 32 байтовую Hex-строку в нижнем регистре. Фактически строковое представление дайджеста MD5.
H(s) — 16-байтовый MD5-хеш строки s
KD(k, s) — объединение данных (строк) k, s
H({k, ":", s}) — 16-байтовый MD5-хеш, полученный в результате сложения строки k, ":", S
Как видите, особо ничего сложного нет. Вот алгоритм расчета реализованный мной на Delphi:
function GenResponse(UserName, realm, digest_uri, Pass, nonce, cnonce : String) : string; const nc = '00000001'; gop = 'auth'; var A2, HA1, HA2, sJID : String; Razdel : Byte; Context : TMD5Context; DigestJID : TMD5Digest; DigestHA1 : TMD5Digest; DigestHA2 : TMD5Digest; DigestResponse : TMD5Digest; begin Razdel := Ord(':'); // ВЫЧИСЛЯЕМ А1 по формуле RFC 2831 // A1 = { H( { username-value, ":", realm-value, ":", passwd } ), // ":", nonce-value, ":", cnonce-value, ":", authzid-value } sJID := format('%S:%S:%S', [username, realm, Pass]); MD5Init(Context); MD5UpdateBuffer(Context, PByteArray(@sJID[1]) , Length(sJID)); MD5Final(DigestJID, Context); MD5Init(Context); MD5UpdateBuffer(Context, PByteArray(@DigestJID),SizeOf(TMD5Digest)); MD5UpdateBuffer(Context, @Razdel , SizeOf(Razdel)); MD5UpdateBuffer(Context, PByteArray(@nonce[1]) , Length(nonce)); MD5UpdateBuffer(Context, @Razdel , SizeOf(Razdel)); MD5UpdateBuffer(Context, PByteArray(@cnonce[1]) , Length(cnonce)); MD5Final(DigestHA1, Context); // ВЫЧИСЛЯЕМ А2 по формуле RFC 2831 // A2 = { "AUTHENTICATE:", digest-uri-value } A2 := format('AUTHENTICATE:%S', [digest_uri]); MD5Init(Context); MD5UpdateBuffer(Context, PByteArray(@A2[1]) , Length(A2)); MD5Final(DigestHA2, Context); // ВЫЧИСЛЯЕМ RESPONSE по формуле RFC 2831 // HEX( KD ( HEX(H(A1)), // { nonce-value, ":" nc-value, ":", // cnonce-value, ":", qop-value, ":", HEX(H(A2)) })) HA1 := LowerCase( PacketToHex(@DigestHA1, SizeOf(TMD5Digest))); HA2 := LowerCase( PacketToHex(@DigestHA2, SizeOf(TMD5Digest))); MD5Init(Context); MD5UpdateBuffer(Context, PByteArray(@HA1[1]),Length(HA1)); MD5UpdateBuffer(Context, @Razdel , SizeOf(Razdel)); MD5UpdateBuffer(Context, PByteArray(@nonce[1]) , Length(nonce)); MD5UpdateBuffer(Context, @Razdel , SizeOf(Razdel)); MD5UpdateBuffer(Context, PByteArray(@nc[1]) , Length(nc)); MD5UpdateBuffer(Context, @Razdel , SizeOf(Razdel)); MD5UpdateBuffer(Context, PByteArray(@cnonce[1]) , Length(cnonce)); MD5UpdateBuffer(Context, @Razdel , SizeOf(Razdel)); MD5UpdateBuffer(Context, PByteArray(@gop[1]) , Length(gop)); MD5UpdateBuffer(Context, @Razdel , SizeOf(Razdel)); MD5UpdateBuffer(Context, PByteArray(@HA2[1]),Length(HA2)); MD5Final(DigestResponse, Context); Result := LowerCase( PacketToHex(@DigestResponse, SizeOf(TMD5Digest)) ) end; На входе функция получает параметры рассмотренные нами ранее.
Статусы, состояния, информация о присутствии, управление подпиской
Прием и отправка статусных сообщений, а также информации о видимости контактов и подписки на сообщения от них, осуществляется через XML-строфу Атрибут type строфы
Строфа, которая не обладает атрибутом type, используется Jabber-ом, для сообщений о присутствии контакта в сети Jabber и указывает на то, что данный контакт находится в сети (онлайне) и доступен для коммуникации.
Если атрибут type присутствет в строфе
Если атрибут включен, то он должен содержать иметь одно из следующих значений:,
unavailable — Сигнализирует, что данный контакт, больше не доступен для коммуникаций. Фактически контакт вышел в оффлайн.
subscribe — Запрос на подписку (авторизацию) от другого контакта.
subscribed — Информирует о том, что контакт разрешил авторизацию.
unsubscribe — Отправитель аннулирует подписку.
unsubscribed — Запрос на аннулирование подписки (отозвание авторизации) от другого контакта.
probe — Запрос о текущем присутствии контакта только сервером от имени пользователя.
error — Ошибка, произошедшая при доставки предыдущих данных. Обработка такого сообщения идет в соответствии с RFC 3920 XMPP-Core.
Например, запрос на подписку от контакта ivanov@jabber.ru для нашего контакта может выглядеть так:
Структура XML-пакетов Jabber протокола (XML Streams)
Структура XML пакетов получаемых с сервера и передаваемых на него по спецификации RFC 3920 имеет следующий вид:|--------------------| |
Поток XML — является контейнером для хранения элементов строф XML. Поток XML начинается с открытия тэга
Строфы XML — это дискретные семантические модули представленные элементами, заключенными в потоке XML. Строфы XML являются дочерними элементами (child node) корня XML
Примечание: несмотря на стандарт, мной было замечено, что с некоторых серверов могут приходить пакеты, просто содержащие строфы XML, но включенные в поток XML.
Управление ростер-листом
Добавление или редактирование контакта. При отсутствии контакта в ростер-листе контакт будет добавлен, при наличии отредактирован.Добавление / корректировка. Клиент посылает следующий пакет.
Оповещение сервера:
система для быстрого обмена сообщениями
Jabber — система для быстрого обмена сообщениями и информацией о присутствии (в контакт-листе) между любыми двумя пользователями Интернета на основе открытого протокола XMPP.В отличии от той же Аськи Jabber-сеть имеет на мой взгляд более развитые возможности, а наличие расширений протокола открывает горизонты функциональности на недосягаемые для коммерческих IM-сетей, вот некоторые из них:
Открытость: протокол Jabber открыт, общедоступен и достаточно лёгок для понимания; существует множество реализаций серверов и клиентов, а также библиотек с открытым исходным кодом.
Расширяемость: с помощью пространств имён в XML можно расширить протокол Jabber для выполнения требуемых задач и для обеспечения поддержки взаимодействия между различными системами. Общие расширения разрабатываются под контролем Jabber Software Foundation.
Децентрализованность: кто угодно может запустить свой собственный сервер Jabber, что позволяет организациям и частным лицам заниматься любыми экспериментами с IM.
Безопасность: любой сервер Jabber может быть изолирован от общедоступной сети Jabber, многие из вариантов реализации сервера используют SSL при обмене между клиентом и сервером, и немало[источник не указан 39 дней] клиентов поддерживают шифрование с помощью PGP/GPG внутри протокола.
Jabber удовлетворяет многие потребности частных лиц и организаций. Но важно понимать, что он не является универсальным решением всех задач. В частности, Jabber не является:
Универсальным чат-клиентом для различных систем IM — несмотря на множество клиентов Jabber под различные платформы, они не предоставляют таких возможностей по взаимодействию с различными системами IM, которые обеспечиваются программами Miranda IM, Trillian или Pidgin: вместо этого взаимодействие между Jabber и другими системами осуществляют шлюзы, расположенные на стороне сервера.
Универсальным решением проблем взаимодействия с различными IM-системами — некоторые сервера Jabber предоставляют возможность взаимодействия с другими системами IM через шлюзы, которые транслируют протокол Jabber в протокол этих систем; однако только от самих систем зависит осуществление взаимодействия (к чему они подчас не стремятся, и даже наоборот).
Как вы видите, ничего особо
Как вы видите, ничего особо сложного нет. Простой Jabber-клиент с минимальной функциональностью представлен в примере. Также в архив выложен парсер TjanXMLParser2, RFC 3920, 3921.К статье прилагается .
См. обсуждение статьи на сайте delphikingdom.com.
Запрос списка контактов при входе в систему
При входе в систему клиент Jabber должен послать серверу информационный запрос о получении ростер-листа.Запрос ростер-листа клиентом:
Delphi - сбориник статей
Доступ к базе данных
После того, как мы инициализировали сессию связи с Lotus Notes, мы можем обращаться к любым серверам Lotus Domino и базам данных на них. Принципиально получить доступ к БД Lotus Notes можно 2 способами – либо обратиться к текущей базе данных, открытой в Lotus Notes, либо вызвать соответствующий метод NotesSession и открыть любую другую БД []. Последний случая является наиболее востребованным, поэтому рассмотрим его:procedure TMyButtomClick(Sender: TObject); var MyServer: string; begin // Необходимо вычислить имя сервера, // на котором находится необходимая нам БД MyServer:=... // Теперь открываем БД – например, откроем адресную книгу сервера MyLNDataBase:=MySession.GetDataBase(MyServer, ‘names.nsf’); end; Мы в своей работе используем реестр Windows, в котором храним имя сервера Domino по умолчанию, к которому подключаются приложения. Для упрощения разработки и администрирования программ мы использую функцию GetDefaultServerName, которая работает по следующему алгоритму:
Инициализация сессии.
Основной принцип в написании программ состоит в использовании встроенных классов Lotus Notes в коде программ. Для этого в первую очередь необходимо инициализировать сессию связи с Lotus Notes. Для этого требуется, чтобы клиентское программное обеспечение Lotus Notes было инсталлировано на каждом компьютере, использующим программу и подключено к одному или нескольким серверам Domino.Создадим новое приложение. В разделе uses главного окна приложения укажем ComOBJ – это библиотека, позволяющая вызывать и обращаться к OLE -объектам [].
В разделе public объявим переменные, общие для всего приложения:
public { Public declarations } MySession : OLEVariant; // текущая сессия Lotus Notes MyLNDataBase : OLEVariant; // база данных Lotus Notes... Теперь необходимо написать обработчик события OnCreate главной формы приложения, в котором мы должны создать объект NotesSession, чтобы, используя его в дальнейшем, иметь возможность в рамках одного приложения обращаться сразу к нескольким базам данных, серверам, документам, представлениям и т.д. Обработчик должен иметь следующий вид:
procedure TfmMain.FormCreate(Sender: TObject); begin MySession:= createOLEObject('Notes.Notessession'); if varisempty(MySession) then begin ShowMessage('Не могу создать сессию с сервером Lotus Notes'); Exit; end; end; Следует иметь в виду, что в рамках одного приложения следует только один раз инициализировать объект Notessession, т.к. каждая последующая инициализация будет закрывать предыдущую сессию, а все объекты, созданные на основе этой сессии, потеряют свою актуальность и их обработка будет невозможна.
Работа с базой данных
Из программы, написанной в Borland Delphi, доступны практически все свойства и методы, предусмотренные разработчиками Lotus Notes / Domino. В том числе Вы можете осуществлять навигацию по представлениям, осуществлять поиск документов в базе данных, в том числе и гипертекстовый поиск и т.д. Особенностей по работе с базой данных вследствие использования Delphi мы не обнаружили. Поэтому в качестве примера приведем фрагмент кода, осуществляющий последовательный перебор и считывание документов из коллекции документов NotesDocumentCollection базы данных адресной книги сервера.procedure TfmMainWindow.BitBtn1Click(Sender: TObject); var DocumCount: longint; // количество документов в коллекции i : longint; // шаг цикла B1: OLEVariant; // переменная для объекта NotesDatabase BodyQuery: ansistring; C1: OLEVariant; // переменная для объекта NotesDocumentCollection D1: OLEVariant; // переменная для объекта NotesDocument begin DocumCount:=0; // Получаем доступ к БД. B1:= MySession.GetDatabase(GetDefaultServerName,'names.nsf'); BodyQuery:='Form = "Person"'; // Для поиска используем специальную функцию LNSearch C1:=LNSearch(MySession,B1,’Пример запроса’,BodyQuery); DocumCount:=C1.Count; if DocumCount=0 then Exit; // искомые документы не найдены D1:=C1.GetFirstDocument; for i:=1 to DocumCount do begin.... здесь осуществляется обработка документа D1:=C1.GetNextDocument(D1); end; end; В этом примере программа обращается к текущему серверу и открывает на нем базу данных адресной книги. Затем, используя специально разработанную функцию LNSearch, производит поиск документов в базе данных. Если не найдено ни одного документа, то работа процедуры завершается. Если какие-то документы найдены, то они последовательно обрабатываются в цикле. Применение специальной функции LNSearch обусловлено тем, что стандартный метод Search в классе NotesDatabase, кроме формулы для поискового запроса, требует передать дату самого старого документа, который этот запрос сможет вернуть в качестве результата. При этом дата должна быть передана не в качестве переменной типа TDate или TDateTime, а в качестве OLEVariant -переменной, созданной как объект класса NotesDataTime.
function LNSearch(LNSession, LNDataBase: OLEVAriant; Logo: string;query: string):OLEVariant; var r1:WideString; r2: OLEVariant; r3: Smallint; C1: OleVariant; begin r1:=query; r2:=LNSession.CreateDateTime('01.01.1990'); // здесь может быть любая дата r3:=0; C1:=LNDataBase.SEARCH(r1,r2,r3); Result:=C1; end; Отметим, что по нашим наблюдениям, при написании программ в Borland Delphi следует стремиться использовать навигацию по представлениям вместо использования метода search. При этом скорость обработки одной и той же коллекции документов, полученной из представления, примерно на 40% выше, чем при обработке документов, полученных поиском в базе данных.
Работа с документами
В отличие от работы с базами данных, обработка документов Lotus Notes имеет массу подводных камней. При этом в программах приходится выполнять много одинаковых операций, которые целесообразно выделять в отдельные функции. Вначале рассмотрим стандартную функцию считывания текстового значения поля из документа.function LNGetFieldStrValue(Document: OLEVariant; FieldName: string; DefaultValue: string): AnsiString; var SendValue, RetValue: OLEVariant; TmpS: Ansistring; MyPos: integer; begin TmpS:=' '; if FieldName<>'' then begin SendValue:=FieldName; if not varisempty(Document) then begin Try RetValue:=Document.HasItem(FieldName); except begin RetValue:=false; end; // do end; // Try if RetValue then begin RetValue :=Document.GetFirstItem(SendValue); try TmpS:=RetValue.Text; except TmpS:=DefaultValue; end; end else TmpS:=DefaultValue; end else TmpS:=DefaultValue; // varisempty chek end else TmpS:=DefaultValue; if TmpS='' then TmpS:=DefaultValue; Result :=tmpS; end; Эта простая функция позволяет значительно упростить написание программ, особенно в случае, когда документ содержит большое количество полей, значения которых необходимо считать и обработать. Необходимо отметить, что очень часто в полях документов Lotus Notes хранится несколько значений или значения записаны с символами, препятствующими корректной работе со строками в Borland Delphi. Мы в таком случае используем перегруженную версию представленной функции, которая может возвращать «очищенную» строку или определенную подстроку [].
По аналогии с представленным примером разработаны и версии для числовых полей, а также полей с датой или временем, что представляет особую трудность при написании программ. В таком случае, кроме стандартных проверок на корректность документа, наличия в нем указанного поля, функция может проверить тип возвращаемого значения или выполнить необходимые преобразования. Например, возможна конвертация строкового значения в число или смена символа разделителя разрядов на основании текущих настроек операционной системы.
Несколько усложненный пример – это считывание значения поля в профайле. Как известно, Lotus Notes, кроме стандартных документов, позволяет поддерживать хранение информации в т.н. профайлах – документах, к которым можно обратиться по имени формы и, как дополнение, по имени текущего пользователя. Для чтения текстового значения из профайла рассмотрим следующую функцию:
function LNGetProfileField(MySession, MyDBName: OLEVariant; MyServerName, MyProfileName, MyUserName, MyFieldName: string):string; var D1: OLEVariant; tmpS: AnsiString; begin if MyServerName='' then tmpS:= GetDefaultServerName else tmpS:=MyServerName; if varisempty(MyDBName) then begin ShowMessage('Фатальная ошибка! Переданный объект <База данных> пуст. Продолжение невозможно!'); Exit; end; D1:=MyDBName.GetProfileDocument( MyProfileName, MyUserName); if varisempty(D1) then begin ShowMessage ('Ошибка при получении профайла '+MyProfileName+' из базе данных '+MyServerName+ ' / '+MyDBName.Name+'. Продолжение невозможно!'); Exit; end; tmpS:=LNGetFieldStrValue(D1,MyFieldName,'',False); Result :=tmpS; end; Как видно из примера, эта функция использует стандартную функцию LNGetFieldStrValue, представленную ранее, но перед этим выполняет ряд дополнительных проверок и операций.
Разработка приложений для Lotus Notes/Domino в среде Borland Delphi
Гусев А.В., Дмитриев А.Г., Тихонов С.И.,Вычислительный центр ОАО "Кондопога", КНМЦ СЗО РАМН Lotus Notes / Domino – прекрасная платформа для создания мощных корпоративных информационных систем, ориентированных на групповую работу с электронными документами. В своей работе над комплексной медицинской информационной системой мы на основе тщательного анализа средств разработки и имеющихся на рынке СУБД выбрали Lotus Notes / Domino в качестве основы всей системы. Разработка осуществляется с 1999 года, за это время мы постепенно перешли с версии 4.6 на версию R 5, а затем – на R 6. В данный момент идет тестирование R 6.5 на совместимость с существующим ПО.
Lotus Notes / Domino полностью отвечает ключевым требования к созданию медицинской информационной системы по надежности, безопасности, отказоустойчивости и масштабированию. Работа пользователя в этой среде в максимальной степени приближена к привычной работе с документами – фактически, бумага и авторучка у медицинских сотрудников заменена на компьютер. Формы электронных документов могут быть разработаны по точной аналогии с их бумажными аналогами (при необходимости), а стандартные средства для работы с документами (создание, редактирование, печать, отправка по e - mail, электронная цифровая подпись и т.д.) требуют от пользователя минимального объема обучения.
Однако, как и в любой информационной технологии, имеется ряд недостатков, с которыми приходится мириться и искать пути их преодоления. Основной их недостатков Lotus Notes / Domino для применения в медицинской сфере – это слабая поддержка таблиц в электронных документах. На практике даже с точки зрения пользователя встроенные в клиентское программное обеспечение Lotus Notes средства для работы с таблицами значительно уступают аналогичным инструментам в Microsoft Office. А с точки зрения инструментария разработчика средства для управления таблицами тем более являются малоэффективными. Некоторые изменения в этом направлении были сделаны в версии R 6 Domino, однако и они являются недостаточными. Фактически, в Lotus Notes таблица, как средство отображения, управления и хранения информации, отсутствует как класс. Но это и понятно – ведь Lotus Notes – это, прежде всего, объектно-ориентированная СУБД, предназначенная для групповой работы над документами.
Вместе с тем в нашей работе поддержка табличного формата хранения информации является неотъемлемой функцией системы. Некоторые документы (лист назначений, например) и некоторые приложения (бухгалтерия, аптека, склад, автоматизация службы питания и т.д.) несравненно более эффективно работаю под управлением реляционной СУБД, чем в среде Lotus Notes / Domino. Все это породило необходимость совместного использования Lotus Notes / Domino и реляционной СУБД, в качестве которой был выбран Microsoft SQL Server []. В качестве средства разработки в Lotus Notes / Domino используется специальное программное обеспечение Lotus Designer, позволяющее создавать мультиплатформенные приложения на Visual Basic -подобном языке Lotus Script, @-формулах или Java Script. Это мощное приложение позволяет за очень небольшое время разрабатывать необходимые программы как для выполнения в среде Lotus Notes, так и для работы в обычном браузере Internet. Однако для создания приложения для реляционной СУБД его возможностей явно недостаточно. Поэтому в качестве дополнительного инструментария мы используем Borland Delphi (в настоящее время – версию 6.0).
Одним из серьезных препятствий на использовании Delphi является задача совместного доступа как к информации в реляционной базе данных, так и для доступа к базам данных Lotus Notes / Domino. Для решения этой задачи имеется несколько подходов:
Второй подход также, к сожалению, не отвечал требованиям. При этом Notes SQL фактически эмулирует обращение к базе данных Lotus Notes, как к обычной реляционной таблице. Тестирование различных версий Notes SQL показала нестабильность этого программного обеспечения. Особенно ярко недостатки Notes SQL проявлялись при обработке больших объемов информации – в случайные моменты работы программы возникали неустранимые ошибки, которые приводили к полном прекращению работы программ.
Третий подход является более предпочтительным, однако и от него мы со временем отошли в силу его трудоемкости, большой сложно написания программы, массы низкоуровневого кода и высоких требований к знанию внутренний архитектуры Lotus Notes.
Первое время доступ к Lotus Notes посредством OLE казался нам неприемлемым вариантом с точки зрения скорости работы. Однако наш 5-летний опыт работы доказал высокую устойчивость программ на основе этого подхода и вполне приемлемую скорость обработки информации.
Далее мы на примерах покажем, как написать приложение в среде Borland Delphi для баз данных Lotus Notes.
в практической разработке медицинской информационной
Мы используем представленную технологию в практической разработке медицинской информационной системы "Кондопога" вот уже в течение 5 лет. За это время многократно убедились в прекрасной устойчивости и приемлемой скорости работы программ, написанных на Borland Delphi для баз данных Lotus Notes / Domino. Фактически мы убедились, что способны создавать программы на Borland Delphi, которые используют весь арсенал встроенных в Lotus Notes классов [].Отметим, что со временем в арсенале программиста накапливается самая разнообразная масса готовых функций и процедур, которые целесообразно аккумулировать либо в виде подключаемых библиотек, либо в виде отдельных модулей (pas -файлов). При этом, по нашим наблюдениям, время на разработку новой программы можно сократить в несколько раз именно за счет использования готовых и отлаженных приложений. А это позволяет снизить стоимость разработки и повысить устойчивость приложений, что является уже не столько инструментарием разработчика, сколько экономическим стимулом.
Постепенно нами была накоплена целая библиотека класса middleware, которая реализует практически весь необходимый функционал для написания программ в Borland Delphi для среды Lotus Notes. Это позволило разработать нашу информационную систему таким образом, что взаимные недостатки реляционных и объектно-ориентированных баз данных фактически полностью компенсируются взаимными достоинствами. Поэтому пользователи ИС "Кондопога" одинаково комфортно используют и возможности совместной работы над электронными документами Lotus Notes и встроенные в базы данных Domino приложения, предоставляющие расширенные возможности работы с таблицами реляционных баз данных, мгновенное построение диаграмм на основе данных из документов Lotus Notes и т.д.
Эффективный способ применения интерфейсов в MDI приложениях
Валерий Шер-хан, Королевство Дельфи В книгах по программированию при рассмотрении различных приёмов и методов приводятся в основном "игрушечные" примеры. Иногда даже можно встретить высказывания автора: "профессиональные программы так не пишут". В самом начале изучения современного объектно-ориентированного программирования я не задумывался над тем, что значит писать профессионально. Задумался, когда стал писать масштабный проект. В этой статье хочу поделиться своим опытом — описать несколько своих решений.Изначально ставилась задача: разработать модель для построения приложений, ориентированных на работу с базами данных (БД). Под таким приложением подразумевается набор форм, каждая из которых обычно отображает одну таблицу БД. Например, в бухгалтерской или складской программе таблицы "Накладные", "Клиенты", "Товары" удобно расположить на отдельных формах. Несколько таблиц с малым числом строк и столбцов можно было бы расположить на одной форме, например: "Категории товаров", "Типы накладных", "Единицы измерения". Пользователь должен иметь возможность выбирать окно, с которым он хочет работать. Поэтому где-то должно быть меню или список всех или почти всех окон. Понятно, что окно "Накладная" в этом списке отсутствует. Оно будет открываться из списка накладных (окно "Накладные"). Было бы так же удобно открывать последнюю приходную накладную (окно "Накладная") для товара под курсором из окна "Товары". Вот для таких приложений и предназначена описанная в статье модель.
Модель приложения можно свести к абстракции "Окно—>Документ", где Окно — это список Документов, например "Окно—Накладные"—>"Документ—Накладная". Нечто похожее на модель "Master—>Detail", только на разных формах (у нас). В свою очередь Документ может быть Окном, из которого можно открыть другой Документ и т.д., т.е. опять "Окно—>Документ". Например "Окно—Накладная"—>"Документ—Клиенты". И по большому счёту, чем отличается Окно от Документа? Ведь связь может быть и обратной: Документ—>Окно. Под связью понимаем любое действие, инициированное из текущего окна (формы) по отношению к другому окну (форме). Это действие даже может и не требовать отображения того другого окна. Поэтому модель можно упростить ещё: "Документ<=>Документ". Иными словами — множество окон с множеством связей между ними.
Модель будет рассмотрена на примере Delphi, но может быть реализована и на других объектно-ориентированных языках имеющих такие конструкции, как классы, наследование и интерфейсы. Модель построена на основе многооконного интерфейса MDI. На Рис.1 изображено несколько уровней иерархии классов форм. Начальный, наиболее абстрактный уровень — уровень платформы. Под платформой понимается библиотека абстрактных классов и универсальных функций. На этом уровне расположены два базовых класса — класс главной формы TBaseMDIForm и класс дочерней формы TBaseMDIChildForm. Если мы пишем программу складского учёта (для абстрактного заказчика), переходим на другой уровень путём наследования (пунктирные стрелки) необходимых форм от соответствующих базовых классов. Это я называю уровнем схожих проектов. Здесь содержится вся функциональность окон конкретного проекта для абстрактного приложения. Из этих окон уже можно строить полнофункциональное приложение. Но конкретное приложение для конкретного заказчика строится из окон следующего уровня — уровня конкретного приложения. На этом уровне может быть несколько изменён внешний вид окон, переопределены некоторые методы и функции под конкретного заказчика. Для большей ясности приведён Рис.2. Если мы пишем программу для бухгалтерии с базой данных, отличной от базы данных в программе складского учёта, то мы переходим с уровня платформы путём наследования на уровень схожих проектов 2, т.е. это будет параллельная ветвь. И т.д.
Связи между окнами (Рис. 1) показаны сплошными линиями. Т.к. основная функциональность окон находится на уровне схожих проектов, все основные связи между окнами тоже. И сейчас возникает интересный вопрос: как правильно организовать эти связи? Если бы мы строили приложение из окон этого уровня, всё было бы хорошо — каждое окно "знало" бы о других окнах (классах форм) из секции uses. Но мы то строим приложение из наследников этих окон. Получается сложная ситуация — наследники должны "знать" о наследниках. Т.е. часть функциональности, общей для ряда заказчиков, должна уйти на уровень конкретного приложения для конкретного клиента. Это недопустимо, потому что теряется преимущество объектного программирования. Не будем же мы каждый раз после изменений основной функциональности копировать программный код между соседними ветвями уровня конкретного приложения. Вот здесь может помочь использование интерфейсов (специальная конструкция языка). Можно создать отдельные интерфейсы для всех классов окон с нужными свойствами, функциями и методами. Тогда уже окнам будет незачем "знать" друг о друге. Им нужно будет "знать" только об интерфейсах, которые реализуют нужные классы окон. Следовательно, связи между окнами будут находиться там, где и положено, а наследники окон будут нести только функциональность для конкретного приложения (заказчика). И при необходимости смогут иметь свои связи к другим окнам (используя интерфейсы), которых не предусмотрено на уровне выше.
Одно из решений выглядит так. Параллельно с созданием функциональности множества окон надо параллельно создать для каждой группы связей свой интерфейс, содержащий нужные функции, свойства, методы. А при вызове интерфейса надо перебрать все окна в приложении, найти то, которое реализует нужный интерфейс, потом вызвать нужную функцию (свойство). Поскольку функция (свойство) интерфейса может вызываться из многих мест, никто не мешает автоматизировать этот процесс путём создания некого универсального механизма поиска нужного интерфейса среди существующих и "несуществующих"(классов) окон. Дело в том, что окна с нужным интерфейсом в момент его поиска может ещё не существовать. Мы не собираемся при запуске программы создавать сразу все возможные окна. Ведь пользователь может вообще не воспользоваться многими окнами и их интерфейсами в данном сеансе работы с программой. Предположим сейчас, найдено существующее окно "Документ", реализующее связь "Открыть определённый документ". А вдруг пользователь производил там редактирование и не закрыл его (отложил на время). Если мы позволим создать связь с этим окном, оно уже должно будет отображать другой документ и все произведённые пользователем изменения могут пропасть. Значит, необходим некий критерий, позволяющий универсальному механизму поиска определять — можно ли установить связь с окном, либо надо создать другое окно того же класса.
Предлагается способ решить все вышеуказанные сложности весьма простым механизмом. В абстрактной модели "Документ<=>Документ" есть только один объект — Документ. Поэтому достаточно использовать только один интерфейс (IDoc) с одной функцией (ProcessParams), аргументом которой будет массив с любым числом элементов любого типа. Способ обработки этого универсального параметра определяет сам программист без привлечения других интерфейсов, наследования, функций-оболочек. При помощи такого универсального параметра можно организовать создание большого разнообразия связей между формами. Интерфейс IDoc будет реализоваться на уровне платформы классом TBaseMDIChildForm. Поэтому все наследники от этого класса автоматически реализуют этот интерфейс. Поскольку функция ProcessParams должна быть универсальной, тип единственного параметра (Params) используем array of const (array of TVarRec) — массив с любым числом членов любого типа. Таким образом, мы сняли необходимость добавлять новый интерфейс для каждого нового класса формы (или набора действий) и добавлять в него новую функцию при создании новой связи между формами. Интерфейс IDoc мы будем вызывать не напрямую, а посредством вспомогательного объекта DocManager. При запуске программы мы регистрируем (RegisterFormClass) в DocManager классы всех необходимых окон конкретной программы. Регистрация осуществляется с указанием номера класса и заголовка формы. Номер класса уникален для ветви уровня схожих проектов (Рис. 2). Заголовок формы необходим, т.к. предполагается автоматически создавать меню со списком окон без необходимости сразу создавать все окна. При организации связи с другим окном будем пользоваться функциями ShowDoc и ProcessDocParams. В качестве параметров для этих функций нужно задать номер класса и параметр типа array of const (Params). Поэтому для связи с другим окном данное окно должно "знать" только номер класса. Ссылки на класс (вызываемой формы) и интерфейс IDoc не требуются. ShowDoc отображает окно с передачей в него нужного параметра. ProcessDocParams организует обработку параметра без необходимости отображать окно (в фоновом режиме). Обе функции создают при необходимости окно нужного класса и затем вызывают ProcessParams (IDoc) созданного окна.
Этот механизм очень напоминает технологию COM в ОС Windows, только внутри одного приложения.
Рассмотрим один из случаев применения вышеуказанного принципа. Из списка накладных (окно "Накладные") мы хотим увидеть содержимое накладной под курсором. Для этого мы вызываем ShowDoc с указанием номера класса. В качестве параметра Params массив, один из членов которого является уникальным номером накладной из списка накладных. DocManagerst создаёт окно "Накладная" и передаёт туда массив Params с номером накладной (и др. параметрами при необходимости). В окне "Накладная" по этому номеру мы загружаем список товаров соответствующей накладной. А что будет, если пользователь не закрыв это окно, вернётся к списку накладных и опять инициирует открытие окна "Накладная"? Тут возможно два случая — пользователь хочет просмотреть содержимое той же накладной или он хочет просмотреть уже другую накладную. Для таких случаев существует вот какой механизм. IDoc имеет вспомогательные процедуры SetParams для сохранения Params в форме и ParamsIs для определения идентичности с Params, сохранённым через SetParams. При вызове DocManager.ShowDoc если найдена уже существующая форма нужного класса, происходит вызов ParamsIs для проверки равенства Params из ShowDoc и Params существующей формы. Если они равны, показываем существующую форму на переднем плане, если Params`ы не равны, то создаём новую форму на переднем плане с передачей туда нового Params.
В форме TBaseMDIChildForm после вызова SetParams происходит сохранение Params не в виде array of const, а в виде динамического массива типа Variant. Конвертация происходит функцией VarOpenArrayToVarArray в модуле Misc. Там же есть функция VarEqual, которая вызывается из ParamsIs. VarEqual и VarOpenArrayToVarArray построены специальным образом, который определяет степень свободы задания элементов массива Params типа array of const. В нём можно задавать элементы практически любых типов. Ординарные типы, ссылки на объекты, адреса переменных с соответствующим преобразованием при их интерпретации. Даже можно задать в качестве элемента динамический массив типа Variant, элементами которого могут быть тоже массивы типа Variant. При этом VarEqual будет работать корректно (на основе рекурсии). Замеченное ограничение — невозможность передачи строк String со служебными кодами типа 0х0, 0х1, 0х2 и т.д. Ничего с этим пока поделать не смог.
Ещё несколько особенностей. ProcessDocParams не влияет на Params, сохранённый в TBaseMDIChildForm с помощью SetParams (т.е. из ShowDoc). ProcessDocParams не вызывает ParamsIs и SetParams формы. ProcessDocParams и ShowDoc вызывают вспомогательные методы интерфейса IDoc DocInit и ProcessParams. Их можно переопределить в наследниках. DocInit предназначен для инициализации формы, там можно открывать таблицы БД, обрабатывать Params из ShowDoc. А ProcessParams предназначен для обработки Params из ShowDoc и из ProcessDocParams.
В DocManager встроен механизм заполнения пункта меню списком заголовков зарегистрированных классов форм с целью предоставления пользователю способа открытия желаемой формы. Функция CreateMenuItems принимает параметр типа TMenuItem, где хотим создать вышеуказанный список (Обычно это пункт главного меню главной формы). Причём параллельно автоматически заполняется свойство объекта DocManager ActionList типа TActionList. Его можно использовать для заполнения "вручную" (программистом) альтернативного средства выбора окон не меняя код TDocManager.
При регистрации класса окна (DocManager.RegisterFormClass) необходимо указать дополнительный параметр — это тип окна. Есть три типа "Окно", "Документ" и "Отчёт". При вызове CreateMenuItems всё, что зарегистрировано как "Документ" не входит в меню, а то, что помечено как "Отчёт", попадает в конец меню после разделителя. Предполагается, что "Документ" вызывается из других окон (например окно "Накладная"), а количество и порядок "Отчётов" могут часто меняться, поэтому в конце. В качестве пункта меню выбора доступных окон удобно использовать пункт главного меню главной формы.
DocManager создавать вручную не надо, создаётся и уничтожается автоматически при добавлении в проект ссылки на модуль Doc.
Некоторые рекомендации по использованию Params: array of const. Рекомендуется первым элементом массива использовать целое число — номер команды (связи), достаточно сделать уникальным в пределах класса формы на уровне схожих проектов и ниже. Т.о. при вызове ShowDoc и ProcessDocParams, чтобы попасть в нужное место, указываем номер класса (TypeId: Integer), номер команды (Например первый элемент Params: array of const). В нужной форме в ProcessParams анализируем первый элемент массива Value :Variant, в DocInit анализируем первый элемент массива FParams :Variant (поле данных TBaseMDIChildForm). В остальных элементах Params: array of const передаём всё, что необходимо для связи с другой формой.
Рассмотрим один частный случай применения вышеуказанного принципа. Предположим, что мы хотим из нескольких мест программы ("Список документов" "Список товаров") открывать окно "Накладная", в котором находится содержимое соответствующего документа. В качестве параметра при организации связи используем уникальный номер накладной в рамках БД. Всё бы хорошо. Но есть одно "но". Реальная ситуация — от общего родителя "Абстрактный документ" наследовано несколько конкретных: "Приход", "Расход", "Акт переоценки". Это разные классы, имеющие разные номера при регистрации. Т.о. напрямую вызывать ShowDoc можем но это не удобно, нам надо ещё знать тип документа: "Приход", "Расход", "Акт переоценки". Это чтоб выбрать необходимый номер класса. Решение у меня такое. Вызываем окно "Список документов" при помощи ProcessDocParams, с передачей номера документа. В окне "Список документов" в ProcessParams организуем механизм запроса из БД типа документа по его номеру. Далее вызываем ShowDoc с указанием номера класса, который соответствует типу данного документа, и транслируем туда же номер документа (другой элемент массива Params), полученный от другой формы через ProcessDocParams. Что у нас получилось. Допустим, пользователь из "Списка товаров" хочет открыть последний документ, содержащий товар под курсором. Им может оказаться как "Приход", так и "Акт переоценки". После нажатия
Прилагается рабочий код уровня платформы, демонстрационный код уровня схожих проектов и конкретного приложения. См. комментарии в исходном коде. Необходимо: Delphi 7, BDE. После распаковки запустить Proj1Firm1.dpr, скомпилировать.
Распространение статьи приветствуется, целиком с указанием источника. Использование программного кода и идей приветствуется.
К материалу прилагаются файлы:
Delphi - сбориник статей
Чудо четвертое (String Trick).
Ну, что ж, добавим опять кнопку на нашу форму и зададим следующий код для события OnClick:| procedure TfrmAllMiracles.btnCopyMrclClick (Sender: TObject); const cs: array[0..1] of char='01'; begin ShowMessage(copy(cs,0,1)+copy(cs,1,1)); end; Figure 6. |
Я знаю, что вы уже ждете подвоха и все же результат может оказаться неожиданным: "00". Как обычно обратимся к Help'у, смотрим функцию Copy:
Returns a substring of a string or a segment of a dynamic array.
...
function Copy(S; Index, Count: Integer): string;
function Copy(S; Index, Count: Integer): array;
...
Дело в том, что в выражении copy(cs,0,1)+copy(cs,1,1) оба раза вызываются разные версии функции copy, первый раз - для динамических массивов, которые нумеруются с 0, а второй раз - для строчек, первый элемент которых имеет индекс 1. Оба раза cs преобразуется к необходимому типу, и то, что cs, как массив начинается с нулевого элемента, в данном случае не имеет никакого значения.
А теперь, наконец, мы добрались и до обьектов. Множество Дельфийских чудес связаны с тем, что обьекты в Delphi - автоматически разыменуемые ссылки, которые могут указывать на освобожденную или занятую кем-то другим область памяти. О таких случаях написано немало. Наше чудо - иное.
Чудо Первое (Round Miracle).
Откройте Delphi, создайте новый проект, назовите его AllMiracles, положите кнопку на главную форму и напишите в обработчике события OnClick следующий код:| procedure TfrmAllMiracles.btnRoundMrclClick(Sender: TObject); begin ShowMessage( IntToStr( Round(3.5) - Round(2.5) ) ); end; Figure 1. |
А теперь остановитесь и скажите, какой результат вы ожидаете увидеть. Я надеюсь вы не сказали "1", ведь иначе это не было бы чудо. Те, у кого хорошо развита интуиция, могут сказать "0", и это будет еще дальше от правильного ответа. И только те, кто часто играет в Спортлото или, на худой конец, внимательно читает документацию, ответит "2" и это будет правильно. Не верите? - жмите F9.
Читаем Help по функции Round:
Round returns an Int64 value that is the value of X rounded to the nearest whole number. If X is exactly halfway between two whole numbers, the result is always the even number.
Вот такое оно, "Круглое чудо". Надеюсь, теперь вы поняли, о чем мы будем говорить сегодня. В этой статье нет сложных, замысловатых примеров. Код - предельно упрощен что бы выделить саму суть проблемы. А наше с вами дело - разобраться в ней и, если можно, исправить ситуацию. Как, например, в следующем случае.
Чудо пятое (Is-Miracle).
Опишите в разделе protected нашей формы поле FControl типа TСontrol и задайте для еще одной - новой кнопки такую вот реакцию на ее нажатие:| procedure TfrmAllMiracles.btnIsMrclClick(Sender: TObject); begin if (FControl is TControl) then begin if not Assigned(FControl) then FControl := TControl.Create(Self); end else ShowMessage('Not a Control'); end; Figure 7. |
Такое "Чудо" я видел несколько раз и в разных проявлениях. Сколько раз бы вы не нажимали на кнопку btnIsMrcl, вы каждый раз будете видеть сообщение 'Not a Control', а конструктор TControl так никогда и не будет вызван.
Вот, что говорит Help:
…The expression object is class returns True if object is an instance of the class denoted by class or one of its descendants, and False otherwise. (If object is nil, the result is False.) Дело в том, что оператор is использует ссылку на класс обьекта, а не то, как описана переменная, которая по сути - простой указатель. Так что TControl не всегда TControl.
Да, я надеюсь вы понимаете, что TControl здесь выбран случайно, с таким же успехом это мог быть и любой другой класс.
Случай когда FControl ссылается на уже освобожденный обьект или является локальной и непроинициализированной переменной, дает непредказуемые результаты и может привести к совсем не чудесному краху аппликации.
А вот для следующего чуда я нашел только косвенное обьяснение в Help'е и поэтому мы будем вынуждены провести небольшой эксперимент.
Чудо седьмое (Miracle with Variants).
Как вы уже догадались, начнем с новой кнопки, которая выполняет следующие действия при нажатии:| procedure TfrmAllMiracles.btnVarMrclClick(Sender: TObject); var X,Y,Z: variant; begin X := '1'; Y := '2'; Z := 3; ShowMessage(X+Y+Z); end; Figure 14. |
Можете ли вы предсказать результат выражения '1'+ '2'+3? Если вы сказали '6', то вы тоже попались. Посмотрим повнимательнее, '1'+ '2' будет... конечно '12', 12+3=15. Это и есть правильный ответ.
Итак, мы увидели семь чудес Delphi, семь - из многих. Это не значит, что они - самые яркие или самые чудесные. Но на них можно многому научиться. Возьмем последнее, только что рассмотренное нами, чудо. Задумайтесь, как Delphi удается сводить в одном выражении значения разных типов? А если один из членов выражения - variant?
Чудо шестое (Is-Miracle II)
Давайте посмотрим еще на одно, похожее чудо связанное с оператором is. Добавим к нашей группе проектов (ProjectGroup1) новый проект - DLL с именем AllMirrLib, в единственном модуле которого будет следующий код:| library AllMirrLib; uses Controls; function IsControlLib(const anObj: TObject): boolean; begin Result := anObj is TControl; end; exports IsControlLib; Figure 9. |
Как вы видите эта библиотека экспортирует только одну очень простую функцию, которая возвращает знечение True в том случае, если ее единственный параметр происходит от TControl и False - в остальных случаях.
В модуль формы нашего основного проекта добавим следующее определение:
| unit AllMir; interface ... implementation {$R *.DFM} function IsControlLib(const anObj: TObject): boolean; external 'AllMirrLib.DLL'; Figure 10. |
Теперь, как обычно, добавим на форму новую кнопку:
| procedure TfrmAllMiracles.btnIsMrcl2Click(Sender: TObject); begin FControl := TControl.Create(nil); try if not IsControlLib(FControl) then ShowMessage('Not a Control'); finally FreeAndNil(FControl); end; end; Figure 11. |
Как вы уже наверное догадались FControl опять окажется не TControl. Найдите в модуле System процедуру _IsClass. Хоть она и написана на ассемблере, нетрудно понять, что в ней происходит - в цикле просматриваются ссылки на классы (сначала собственная - обьекта, а потом - всех предков) и среди них ищется равная правому операнду. Давайте изменим немного процедуру:
| procedure TfrmAllMiracles.btnIsMrcl2Click(Sender: TObject); var p1, p2: pointer; begin FControl := TControl.Create(nil); try p1 := pointer(FControl.ClassType); p2 := pointer(TControl); if not IsControlLib(FControl) then ShowMessage('Not a Control'); finally FreeAndNil(FControl); end; end; Figure 12. |
Посмотрите под отладчиком значения p1 и p2 - они равны. Теперь изменим и функцию IsControlLib:
| function IsControlLib(const anObj: TObject): boolean; var p3,p4: pointer; begin p3 := pointer(anObj.ClassType); p4 := pointer(TControl); Result := anObj is TControl; end; Figure 13. |
Здесь тоже поставим точку останова и сравним значения. Переменные p1, p2 и p3 имеют одно и тоже значение, а вот p4 - указывает куда-то ни туда. Проблема в том, что в аппликации и в DLL сосуществуют два разных класса TControl, вот поэтому равества быть и не может.
Косвенное указание на эту проблему в Help'е можно найти в описании метода ClassNameIs. Читаем Help:
Use ClassNameIs when writing conditional code based on an object's type or to query objects across modules, or DLLs. Да, кстати, не забудьте, что у вас два проекта в группе и компилируется всегда только активный проект. Так что не забывайте перпеключаться на нужный проект по мере необходимости или компилируйте сразу все: Alt-P, U.
Следующее чудо я встретил в программе одного начинающего программиста и оно было конечно слегка закамуфлировано, так что я, к своему стыду, даже не сразу понял в чем дело. Я видел значения переменных, знал, что это - переменные типа variant, но никак не мог понять почему результат вычисления некоего несложного выражения все время ошибочный. Проверьте себя и вы.
Чудо третье (One more low integer miracle).
Новая кнопка на форме будет реагировать на нажатие следующим образом:| procedure TfrmAllMiracles.btnLowIntMrclClick( Sender: TObject); var lowInt: integer; begin lowInt := -2147483648; ShowMessageFmt('%d',[lowInt]); end; Figure 4. |
Совершенно обычная процедура. У нас возникло желание присвоить некоторой переменной вполне законное значение. Но этот код не компилируется: Overflow in conversion or arithmetic operation Жмем F1 на сообщении об ошибке и читаем: The compiler has detected an overflow in an arithmetic expression: the result of the expression is too large to be represented in 32 bits. Видимо компилятор пытается определить константу целого типа со значением 2147483648, а только затем изменить ее знак, но это ему не удается. Перепишем код:
| procedure TfrmAllMiracles.btnLowIntMrclClick( Sender: TObject); var lowInt: integer; begin lowInt := -int64(2147483648); // lowInt := -2147483648; ShowMessageFmt('%d',[lowInt]); end; Figure 5. |
Вот теперь - все нормально. Пример очень незамысловат, но дает нам представление о том, как компилятор Delphi обрабатывает константы и определяет их тип.
А вот следующее чудо - пример того, к какой путанице может привести перегрузка функций. Такие чудеса мы зачастую сами устраиваем себе по невнимательности, а потом часами ищем ошибки.
Чудо Второе (Absolute Miracle).
Положите на главную форму созданного ранее проекта новую кнопку и напишите в его обработчике события OnClick такой код:| procedure TfrmAllMiracles.btnAbsMrclClick (Sender: TObject); var i1: int64; begin i1:= abs(low(integer)); ShowMessage(IntToStr(i1)); end; Figure 2. |
Прежде чем нажать F9, проанализируем написаное. Low от integer - значение известное всем, записанное даже в Help'е и равное -2147483648, т.е. число отрицательное.
Help не говорит о функции Abs ничего нового: Abs returns the absolute value of the argument X. X is an integer-type or real-type expression. Переменная i1 описана как int64, и это правильно, потому что 2147483648 - уже выходит за границы типа integer. Это значение (2147483648) мы и ожидаем увидеть на экране, не так ли? А вот и нет. Проверьте. На экране вновь -2147483648. Как абсолютное значение может быть отрицательным?
Давайте еще раз, повнимательнее рассмотрим выражение abs(low(integer)). Что можно еще сказать про него? Не смотря на наличее в нем функций, это - константа
Читаем Help по теме "Constant expressions":
...Constant expressions cannot include variables, pointers, or function calls, except calls to the following predefined functions: Abs...Low... попробуем описать константу со значением равным этому выражению:
| ... const ci = abs(low(integer)); ... Figure 3. |
Код компилируется. Значит мы - правы, а это значит, что результат выражения определяется еще на стадии компиляции. Далее, low(integer)) имеет целый тип. Abs от integer - тоже целое, а нам нужно int64. Поробуем переписать код следующим образом:
| procedure TfrmAllMiracles.btnAbsMrclClick (Sender: TObject); const ci = abs(low(integer)); var i1: int64; begin // i1:= abs((low(integer))); i1:= abs(int64(low(integer))); ShowMessage(IntToStr(i1)); end; Figure 4. |
Теперь - заработало. Секрет "Абсолютного чуда" раскрыт! Кстати, abs(int64(low(integer))) - тоже константа. Следующее чудо - пример того, как вполне правильный код отказывается компилироваться.
Фокус первый (Variant trick)
Читаем Help в разделе "Variants in expressions":...In a binary operation, if only one operand is a variant, the other is converted to a variant.. Не кажется ли вам это удивительным - variant можно складывать с чем угодно. Например, integer плюс variant - будет variant, а variant можно опять складывать с чем угодно...
Новая кнопка на форме будет выполнять следующие действия:
| procedure TfrmAllMiracles.btnVarTrickClick(Sender: TObject); var v: variant; b: boolean; i: integer; s: string; d: TDatetime; x: Double; begin v:=0; b := true; i := 2; s := '3'; d := StrToDateTime('01/01/01'); x := 5; v := v+b+i+s+d+x; ShowMessage(VarToStr(v)); end; Figure 15. |
Не кажется ли вам, что чудо уже то, что этот код компилируется, а ведь он еще и выдает какой-то результат. А ведь все очень просто - "variant можно складывать с чем угодно" и снова получим - variant.
Однажды ко мне обратился один мой знакомый с вопросом нет ли в Delphi чего-то подобного скрытому параметру Self, но для оператора with. Нет - ответил я ему сперва, а потом задумался...
Фокус второй (With-trick)
Предположим у нас есть следующая функция:| procedure ShowText(sl: TStringList); begin ShowMessage(sl.text); end; Figure 16. |
И кнопка на форме:
| procedure TfrmAllMiracles.btnWithSelfTrickClick(Sender: TObject); var sl: TStringList; begin sl := TStringList.Create; try sl.CommaText := '1,2,3,4,5,6,7,8,9,0'; ShowText(sl); finally sl.Free; end; end; Figure 17. |
И мы, по каким-то причинам, хотим избавиться от локальной переменной sl. Но для того, что бы обратиться к функции ShowText, мы должны передать ей параметр типа TStringList. Откуда же его взять?
Давайте порассуждаем. Каждый метод получает скрытый параметр Self, может быть как-то можно вытащить его оттуда? Писать для этого специальный метод какого-то класса не хотелось бы - ведь это работало бы только для его потомков.
Давайте почитаем Help, раздел "TMethod type":
...This type can be used in a type cast of a method pointer to access the code and data parts of the method pointer... Не это ли то, что мы ищем?
Определим тип и функцию:
| type TSimpleMethod = procedure of object; function GetWithSelf(const pr: TSimpleMethod): TObject; begin Result := TMethod(pr).Data; end; Figure 18. |
Как видите, функция принимает указатель на метод, а возвращает обьект, являющийся владельцем этого метода. Но каким же методом мы воспользуемся? Например, метод Free, ведь его история восходит еще к самому TObject'у. Теперь проверим себя:
| procedure TfrmAllMiracles.btnWithSelfTrickClick(Sender: TObject); begin with TStringList.Create do try CommaText := '1,2,3,4,5,6,7,8,9,0'; ShowText(TStringList(GetWithSelf(Free))); finally Free; end; end; Figure 19. |
Проверьте - работает. Автор —
Живет и работает в Израиле. Женат, имеет двоих детей.
Сфера интересов - Delphi, Windows, Oracle, GSM биллинг.
Семь чудес и два фокуса на Дельфи
, Королевство Дельфи18 августа 2003г. Верите ли Вы в чудеса или нет, Вы наверняка согласитесь со мной, что иногда что-то такое случается с кодом наших программ, и они вдруг перестают компилироваться или, что еще коварнее, начинают выдавать совершенно непредсказуемый результат. И вот тогда, сознайтесь, вас начинают посещать странные мысли об участии во всех этих чудесах неких потусторонних сил.
В этой статье мы попытаемся сдернуть таинственный покров с нескольких, самых простых "чудес" и убедимся, что все это - только обман, иллюзия, а зачастую - искусное мошейничество.
Мы рассмотрим семь (из многих) таких чудес и попробуем разгадать их секреты. Поняв механизм их происхождения, мы, в заключении, покажем два примера использования этих тайных сил в "мирных целях". Наша цель - лучше узнать Delphi и в будущем избежать некоторых труднообьяснимых ошибок.
Для того, что бы вы поняли, что я имею в виду, давайте рассмотрим один очень простой пример.
Delphi - сбориник статей
Поддержка MS-макросов в DELPHI
,Многие из вас наверняка пробовали свои силы в написании макросов в Word, Excel, Access и других продуктах Microsoft. И немало программистов завидовало Word'у и мечтало встроить поддержку макрокоманд и в свои приложения
Послесловие
Встроенный макроязык - это то средство, которое может превратить вашу программу в мощный и универсальный продукт. Но имейте в виду, что показанная техника - только вершина айсберга, в составе библиотеки имеется еще много компонент (IScriptError, IScriptModule, IScriptModuleCollection, IScriptProcedure, IScriptProcedureCollection), которые позволяют всесторонне и тонко управлять интерпретатором.| AddCode | Запись в компонент исходных текстов процедур и функций для последующего их выполнения |
| AddObject | Добавление объекта к внутренней объектной модели макросов |
| Eval | Выполнение вычисления и возврат результата. То же что и if в нормальных языках программирования |
| ExecuteStatement | Немедленное выполнение представленного кода |
| Reset | Восстановление первоначального состояния интерпретатора. Очистка от всех предыдущих исходных кодов |
| Run | Выполнение предопределенной при помощи AddCode процедуры или функции с заданными параметрами |
| OnError | Событие, возникающее при ошибке времени выполнения |
| OnTimeOut | Событие, возникающее при таймауте |
К этому времени вы уже
К этому времени вы уже запустили среду разработки (которая, естественно, должна поддерживать работу с ActiveX, к примеру, Delphi) и создали новое приложение (New > Application).Теперь нужно импортировать данные из библиотеки msscript.ocx в наш проект. Для этого воспользуемся пунктом меню Project > Import Type Library - и для достоверности выберем нашу библиотеку, щелкнув на кнопке Add…(рис. 1). После чего выберем файл msscript.ocx.
Импортировав библиотеку, мы обнаружим в составе нашего проекта файл MSScriptControl_TLB.pas, в котором содержатся все необходимые определения интерфейсов и констант. Теперь в главной форме нашего приложения, в реакции кнопки (которую мы уже разместили на форме), напишем следующий код:
procedure TForm1.Button2Click (Sender: TObject); var SC:TScriptControl; Code:WideString; begin SC:=TScriptControl.Create (Self); SC.Language:='VBScript'; try Code:='Function DoSmth () '#13#10+ 'DoSmth = "This is the Simple Test"'#13#10+ 'End Function'; SC.AddCode (Code); SC.ExecuteStatement ('MsgBox "Testing:"+DoSmth ()'); finally SC.Free; end; end; После выполнения этого кода увидим на экране сообщение системы (Testing:This is the Simple Test).
Теперь рассмотрим приведенный выше код более подробно. Сначала создаем объект TScriptControl, который, собственно, и проделывает за нас всю грязную работу. Далее присваиваем свойству Language значение "VBScript", уведомляя тем самым компонент о том, что переданный ему код будет написан на Visual Basic. Помимо VBScript: тут возможны и другие значения: можно, например, воспользоваться Jscript - при этом будет использован синтаксис JavaScript или же синтаксис любого другого интерпретатора, поддерживающего технологию ActiveX-скриптов (Visual Basic, Java, ActivePython, ActivePerl и т.п).
В следующих строчках пишем исходный код функции DoSmth, которая возвращает нам вторую часть предложения. Далее записываем этот код в компонент - а в следующей строчке исполняем его, передавая возвращаемое им значение в функцию MsgBox. Все это пишется с использованием синтаксиса Visual Basic. Функции AddCode и ExecuteStatement имеют следующий вид:
procedure AddCode (const Code: WideString); safecall; Где Code - код процедуры, функции (или любого их сочетания в любом количестве), который записывается в компонент и после этого может быть вызван с помощью ExecuteStatement или Run:
procedure ExecuteStatement (const Statement: WideString); safecall; Где Statement - текст программы, который будет сразу же исполнен.
Осуществлять вывод сообщений при помощи
Осуществлять вывод сообщений при помощи макроязыка мы уже научились, однако это не единственная возможность компонента. Так, компонент TScriptControl представляет нам возможность использования собственной объектной модели в создаваемых макросах - то есть доступ к специфическим объектам нашего приложения. Для этого в нашем приложении потребуется сначала создать объект автоматизации Automation Object (пользователи Microsoft Visual Basic могут пропустить этот раздел, так как в Visual Basic поддержка объектов автоматизации встроена изначально). Чтобы создать этот объект, при открытом приложении щелкнем на пункте меню Новый и выберем закладку ActiveX. Здесь выберем пункт Automation Object.
Далее предстоит создать интерфейс, который мы собираемся включить в объектную модель ScriptControl. Для начала просто создадим объект с единственной функцией print, которая будет выводить в компонент TlistBox, размещенный на главной форме, некоторый текст. Все существенные настройки показаны на рис. 2.Далее обновляем информацию об объекте, щелкнув для этого на соответствующей кнопке (рис. 2), и переходим к секции реализации объекта.
Здесь уже нас поджидает созданный средой разработки шаблон, в который остается внести только некоторые исправления:
unit SimpleTest; {$WARN SYMBOL_PLATFORM OFF} interface uses ComObj, ActiveX, ScriptTest_TLB, StdVcl; type TSimpleTest = class (TAutoObject, ISimpleTest) protected procedure Print (Data: OleVariant); safecall; {Protected declarations} end; implementation uses ComServ,Main; procedure TSimpleTest.Print (Data: OleVariant); begin Main.Form1.ListBox1.Items.Add (Data); end; initialization TAutoObjectFactory.Create (ComServer, TSimpleTest, Class_SimpleTest, ciMultiInstance, tmApartment); end. Осталось один раз прогнать наше приложение вхолостую - для регистрации и проверки на наличие ошибок. Если все прошло удачно, можно приступать к дальнейшему написанию макросов.
Регистрация объекта
Как и в прошлый раз, создадим на нашей главной форме кнопку и объект ListBox1. Затем в реакцию кнопки на нажатие напишем следующий код:
procedure TForm1.Button1Click (Sender: TObject); var SC:TScriptControl; Test:ISimpleTest; begin SC:=TScriptControl.Create (Self); Test:=CoSimpleTest.Create; try SC.Language:='VBScript'; SC.AddObject ('PrintTest',Test,True); SC.ExecuteStatement ('PrintTest.Print "This is the Test"'); finally Test:=nil; SC.Free; end; end; Опять же, как и в прошлый раз, сначала создаем компонент ScriptControl, затем инициализируем интерфейс ISimpleText и добавляем его в нашу объектную модель посредством функции:
procedure AddObject (const Name: WideString; const Object_: IDispatch; AddMembers: WordBool); safecall; Где:
Следующая строка кода демонстрирует использование объекта Test при написании макроса. Как видно, в тексте макроса мы пользуемся названием, определенным при помощи параметра Name функции AddObject. Результат - на рис. 3.С чего начать
Конечно, выбор, как всегда, есть.Самый трудный путь - это написание собственного интерпретатора макрокоманд. Естественно, возиться с написанием собственных разборщиков синтаксиса, исполнителей команд и т.д., не каждый захочет - вот если бы найти такой компонент, который принимал бы исходный текст макроса и выводил результат. К счастью несчастных программистов и здесь на помощь пришла всеми любимая Microsoft, разработавшая Windows Script Control - компонент, который соответствует практически всем требованиям, выдвигаемым к поддержке макросов в ваших программах.
Итак, для начала нам понадобится сам компонент Windows Script Control, который можно загрузить с сайта разработчика (название архива - sct10en.exe). Распаковав его, мы увидим собственно компонент msscript.ocx и дополнительные файлы справки.
Теперь смело можно браться за разработку поддержки макросов в вашем приложении.
3Delphi - сбориник статей
Имитация внутренних группировок и метки колонок
Работая с заголовками мы не один раз их перерисовывали, вписывая текст и добавляя 3D-окантовку. Это умение можно использовать в любом месте сетки грида, а не только в заголовкахИмитация внутренних группировок
Для создания внутренних группировок необходимо подготовить не только TDBGrid, но и набор данных, которые он будет отображать. Ведь TDBGrid не умеет показывать строк, которых нет в его источнике данных (TDataSource). Подготовим данные по такому запросу: выберем всю информацию по странам и добавим список континентов с суммами полей "население" и "площадь". Обычный UNION-запрос:| Select 1 as TypeRecord , Continent , Name, Area , Population From country Union Select 0 as TypeRecord,Continent ,Continent as Name, Sum(Area) as Area , Sum(Population) as Population From country Group By Continent Order by 2,1 |
Итак, мы получим для каждого континента список его стран и еще одну запись, которую мы будем использовать как служебную запись для группировки, суммы по континенту эта строка уже содержит. Идентифицировать служебную запись можно по значению служебного поля TypeRecord (именно для этого оно и введено). Добавим в обработку события OnDrawColumnCell рисование группировочной строки:
| procedure TfExDBG.__GridFixDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); Var Alignment : TAlignment; begin // рисуем на строке итогов имитацию заголовка грида IF Column.Field.DataSet.FieldByName('TypeRecord').AsInteger = 0 Then TexDBGrid(Sender).DrawCellButton(Rect,Column.Field.DisplayText,[fsBold],State,Alignment) end; |
А вот еще один вариант группировок — без итогов по каждой колонке, только отделение групп данных друг от друга (рис. 5).
рис. 5
Для его реализации добавим метод, аналогичный DrawCellButton, вернее создадим новый на его основе. Метод DrawRowButton делает тоже самое, что и DrawCellButton, но только всегда растягивает картинку на всю видимую строку грида.
| procedure TexDBGrid.DrawRowButton(Rect: TRect; Text: String; Style: TFontStyles; Alignment: TAlignment); Var FullRect : TRect; Col : TColumn; begin FullRect:=Rect; FullRect.Left:=IndicatorWidth + 1; FullRect.Right:=CalcTitleRect(Columns[Columns.Count-1],0,Col).Right; DrawCellButton(FullRect,Text,Style,[],Alignment); end; |
Использование фиксированных колонок
И последнее, что мы сотворим с нашим гридом :о), это снабдим его свойством FixedCols, которого так не хватает в стандартном TDBGrid'е.Для тех, кто может быть не знает, отметим, что у стандартного TDBGrid есть фиксированный столбец, он используется гридом для внутренних нужд. Это тот самый индикатор слева, в котором рисуется треугольник, указывая на текущую строку. Добавляя свое свойство FixedCols, необходимо это учитывать.
| TexDBGrid = class(TDBGrid) private ... FFixedCols : Integer; ... public Property FixedCols : Integer read GetFixedCols write SetFixedCols; ... //************************************************************************************************** procedure TexDBGrid.SetFixedCols(const Value: Integer); Var FixedCount,i : Integer; begin // Следует учесть индикатор грида IF Value IndicatorOffset + 1) Then Begin IF FixedCount >= ColCount Then FixedCount:=ColCount - 1; Inherited FixedCols := FixedCount; // На фиксированных колонках нельзя останавливаться по табуляции For i := 1 To FixedCols Do TabStops[I] := False; End; FFixedCols := FixedCount - IndicatorOffset; end; //************************************************************************************************** function TexDBGrid.GetFixedCols: Integer; begin IF DataLink.Active Then Result := Inherited FixedCols - IndicatorOffset Else Result := FFixedCols; end; //************************************************************************************************** |
Необходимо восстанавливать данные о фиксированных колонках каждый раз, когда параметры колонок будут пересчитываться. Смотрите в иллюстрирующем проекте процедуры TexDBGrid.LayoutChanged; и TexDBGrid.SetColumnAttributes.
Для того, чтобы в нашем гриде фиксированные колонки вели себя также, как ведут они себя, например, в TStringGrid, нужно обработать реакцию на мышь и клавиатуру.
| //************************************************************************************************** Procedure TexDBGrid.KeyDown(var Key: Word; Shift: TShiftState); Var KeyDownEvent: TKeyEvent; Begin KeyDownEvent := OnKeyDown; IF Assigned(KeyDownEvent) Then KeyDownEvent(Self, Key, Shift); IF NOT Datalink.Active OR NOT CanGridAcceptKey(Key, Shift) Then Exit; // наша задача - не пустить в область фиксированных колонок, // то есть SelectedIndex не может быть меньше, чем FFixedCols IF ssCtrl IN Shift Then Begin IF (Key = VK_LEFT) AND (FixedCols > 0) Then Begin SelectedIndex := FixedCols; Exit; End; End Else Case Key Of VK_LEFT: IF (FixedCols > 0) AND NOT (dgRowSelect in Options) Then IF SelectedIndex 0) AND (ColCount <> IndicatorOffset + 1) AND NOT (dgRowSelect IN Options) Then Begin SelectedIndex := FixedCols; Exit; End; End; OnKeyDown := Nil; Try Inherited KeyDown(Key, Shift); Finally OnKeyDown := KeyDownEvent; End; end; //************************************************************************************************** procedure TexDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Var Cell : TGridCoord; begin Cell:=MouseCoord(X,Y); //При скроллировании данных фиксированные колонки должны оставаться на месте IF (Cell.X >= 0) AND (Cell.X < FixedCols + IndicatorOffset) AND Datalink.Active Then Begin IF (dgIndicator IN Options) Then Inherited MouseDown(Button, Shift, 1, Y) Else IF (Cell.Y >= 1) AND (Cell.Y - Row <> 0) Then Datalink.Dataset.MoveBy(Cell.Y - Row); End Else inherited MouseDown(Button, Shift, X, Y); end; //************************************************************************************************** |
Вот, собственно и все, что мы хотели рассказать.
Елена Филиппова и Игорь Шевченко
Специально для Скачать проект: (25К)
Компонент в ячейке редактирования
Отвлечемся на некоторое время от заголовков TDBGrid и обратимся к редактированию данных. Стандартный внутренний редактор ячеек грида (TInplaceEditor) не всегда самый удобный вариант. Можно использовать собственные диалоговые окна для выбора значений и их редактирования, а можно просто встроить нужный компонент в сам грид. Вот этим мы сейчас и займемся.Метки колонок: рисуем в заголовке TCheckBox или TRadioButton
Вновь вернемся к заголовкам. Допустим нам надо реализовать возможность как-то отметить колонку. В принципе для таких целей может служить два контрола TCheckBox и TRadioButton. Для рисования в заголовках воспользуемся специальным событием нашего нового грида: OnDrawTitleRect| procedure TfExDBG.OnDrawTitleRect(Sender: TObject; ACol: Integer; Column: TColumn; ARect: TRect); Var Style, TypeButton : Word; FRect : TRect; begin IF ACol >= TexDBGrid(Sender).FixedCols Then Begin InflateRect(ARect, -1, -1); TDBGrid(Sender).Canvas.FillRect(ARect); // Ширина прямоугольника для рисования контрола - 20 пикселей FRect:=ARect; IF RectWidth(FRect) > 20 Then FRect.Right:=FRect.Left + 20; // Определяем отмечено или нет текущее поле IF Column.Field.Tag = 1 Then Style:=DFCS_CHECKED Else Style:=0; // Выбираем тип контрола для отметки колонки IF FTitleIsCheckBox Then TypeButton:=DFCS_BUTTONCHECK Else TypeButton:=DFCS_BUTTONRADIO; // Рисуем отметку DrawFrameControl(TDBGrid(Sender).Canvas.Handle, FRect, DFC_BUTTON, TypeButton OR Style); FRect.Left:=FRect.Right + 1; FRect.Right:=ARect.Right; // Текст заголовка WriteText(TDBGrid(Sender).Canvas,FRect,Column.Title.Caption,Column.Title.Alignment); End; end; |
Обработку нажатия на метку колонки проводим в обработчике события OnMouseUp. В приведенном примере для хранения отметки столбца используется свойство TField.Tag. Естественно, это только один из возможных вариантов.
| procedure TfExDBG.GridFixMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Const MinX = 2; MaxX = 20; Var Row, Col , i : Integer; Grid : TexDBGrid; Begin Grid:=TexDBGrid(Sender); // Получим номер строки и столбца грида, над которыми произошел клик мышкой Grid.MouseToCell(X,Y,Col,Row); IF Button = mbLeft Then Begin // Левая кнопка мыши — проверяем попадание в заголовок // и обязательное попадание на сам крыжик IF (Row = 0) AND (Col > Grid.FixedCols ) AND (Grid.Columns[Col - 1].Field <> nil) Then Begin Dec(X, Grid.TitleRect(Col-1).Left); // Проверяем попадание в область крыжика IF (X > MinX) and (X < MaxX) Then Begin Tag:=Grid.Columns[Col - 1].Field.Tag; // Снимаем отметку со всех колонок (если это TRadioButton) IF NOT FTitleIsCheckBox Then For i:=0 To Grid.Columns.Count - 1 Do Grid.Columns[i].Field.Tag:=0; // И отмечаем текущую Grid.Columns[Col - 1].Field.Tag:=1 - Tag; // Перерисовываем только заголовки, а не весь грид Grid.RefreshTitles; RefreshSelect; End; End; End; End; |
НеОбычный TDBGrid
Игорь Шевченко, Елена Филиппова, Королевство Дельфи10 июня 2003г.
Подмена стандартного Inplace-Editor'a в DBGrid отдельным компонентом на примере TDBComboBox.
Для того, чтобы вместо стандартного редактора в колонке DBGrid'а появился другой компонент, проделаем несколько действий:Компонент DBComboBox выбран для того, чтобы обеспечить автоматическую связь с данными в DataSet'е, который отображается в Grid'е.
При создании компонента, свяжем его с тем же набором данных, что и Grid, в качестве DataField установим имя того поля, редактор которого в гриде мы хотим подменять. Вместо создания вручную компонент можно положить на форму в design-time
| FEditor := TDBComboBox.Create(Self); FEditor.Parent := Self; FEditor.Visible := false; FEditor.Style := csDropdownList; FEditor.DataSource := DBGrid.DataSource; FEditor.DataField := 'STATE'; |
| for I:=0 to Pred(DBGrid.Columns.Count) do if DBGrid.Columns[I].Field.FieldName = FEditor.DataField then begin { Присвоение списка PickList списку строк ComboBox'a } FEditor.Items.Assign(DBGrid.Columns[I].PickList); Break; end; |
рис. 2
| procedure TForm1.DBGridDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin if (gdFocused in State) then if (Column.Field.FieldName = FEditor.DataField) then begin { Вместо стандартного InplaceEditor'а показываем ComboBox } FEditor.Left := Rect.Left + DBGrid.Left; FEditor.Top := Rect.Top + DBGrid.top; FEditor.Width := Rect.Right - Rect.Left + 2; FEditor.Visible := True; end; end; |
Для того, чтобы нарисованный компонент не оставался видимым после того, как нужная ячейка потеряет фокус, спрячем его в обработчике события ColExit
| procedure TForm1.DBGridColExit(Sender: TObject); begin { При выходе с поля ComboBox надо скрыть } if DBGrid.SelectedField.FieldName = FEditor.DataField then FEditor.Visible := false; end; |
Для того, чтобы менять значение поля можно было не только выбором мышью из списка, но и с клавиатуры, необходимо передавать ComboBox'у нажатия клавиш DBGrid'а, при редактировании поля. Это можно сделать как в обработчике события OnKeyPress DBGrid'a, так и в обработчике OnKeyDown. Я приведу пример обработчика OnKeyPress.
| procedure TForm1.DBGridKeyPress(Sender: TObject; var Key: Char); begin { Передаем все нажатия клавиш в InplaceEditor'е созданному ComboBox'у } if (Key <> chr(9)) then if (DBGrid.SelectedField.FieldName = FEditor.DataField) then begin FEditor.SetFocus; SendMessage(FEditor.Handle, WM_CHAR, word(Key), 0); end; end; |
В примере использован TDBComboBox, по аналогии с ним можно использовать для редактирования и другие компоненты. Ниже на рисунке показан пример, где аналогичным образом в грид встроен TDBDateEdit для редактирования полей типа "дата":
Рисование многострочных заголовков с использованием наследника компонента TDBGrid.
В отличие от рисования нестандартных заголовков при использовании стандартного компонента TDBGrid, в наследнике такое рисование выполняется проще, так как в компоненте есть виртуальный метод DrawCell, который вызывается для всех ячеек грида, а не только для содержащих данные. Рисование нестандартных заголовков в этом случае выполняется в перекрытом методе DrawCell в наследнике.Кроме того, так как метод DrawCell вызывается гридом при любой его перерисовке, затрагивающей клиентскую область окна, нет нужды отслеживать, какие заголовки были нарисованы или обновлять все окно грида при скроллинге. Наше рисование будет вызвано только тогда, когда возникнет реальная необходимость в отрисовке области заголовков грида.
| procedure THSDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect; State: TGridDrawState); var TitleText : String; { Полный заголовок } Titles : array of String; { Части заголовка } { Разбиение полного заголовка на части с возвращением числа получившихся частей } function SplitTitle : Integer; const TitleSeparator = ' '; { Можно этот символ вынести в published property } var CurPos, J: Integer; CurStr: string; begin SetLength(Titles, FTitleLines); { Определяем, сколько реально строк присутсвует в заголовке. Просто считается количество символов TitleSeparator } J := 0; CurStr:= TitleText; repeat CurPos:= Pos(TitleSeparator, CurStr); if (CurPos > 0) and (J < Pred(FTitleLines)) then begin Titles[J] := Copy(CurStr, 1, Pred(CurPos)); CurStr:= Copy(CurStr, CurPos+Length(TitleSeparator), Length(CurStr)-CurPos-Length(TitleSeparator)+1); Inc(J); end else begin Titles[J] := CurStr; if J >= Pred(FTitleLines) then { Не надо копировать больше, чем может вместить заголовок } Break; end; until CurPos=0; Result := J+1; end; var DataCol, I, TitleParts : Integer; TextRect : TRect; LineHeight : Integer; begin if (dgTitles in Options) AND (gdFixed in State) AND (ARow = 0) AND (ACol <> 0) then begin { Должна быть нарисована ячейка заголовка } { Стандартное действие DBGrid } if csLoading in ComponentState then begin Canvas.Brush.Color := Color; Canvas.FillRect(ARect); Exit; end; DataCol := ACol; if dgIndicator in Options then Dec(DataCol); { Изменение размеров области заголовка под окантовку, если хочется сделать плоские заголовки, то InflateRect надо пропустить } if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then InflateRect(ARect, -1, -1); TitleText := Columns[DataCol].Title.Caption; Canvas.Brush.Color := FixedColor; { Если захочется сделать прозрачный заголовок, то вызов FillRect надо будет пропустить } { Если будет желание рисовать фоновую картинку в области заголовка, то нарисовать ее можно здесь } Canvas.FillRect(ARect); { Теперь можно нарисовать собственно текст } Canvas.Font := Font; if FTitleLines = 1 then begin WriteText (Canvas, ARect, 1, 1, TitleText, Columns[DataCol].Title.Alignment); end else begin TitleParts := SplitTitle(); TextRect := ARect; LineHeight := RectHeight(ARect) DIV TitleParts; TextRect.Bottom := TextRect.Top + LineHeight; for I:=0 to Pred(TitleParts) do begin WriteText (Canvas, TextRect, 1, 0, Titles[I], Columns[DataCol].Title.Alignment); OffsetRect(TextRect, 0, LineHeight); end; end; { Окантовка ячейки заголовка, если хочется сделать плоские заголовки, то DrawEdge надо пропустить } if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then begin InflateRect(ARect, 1, 1); DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT); DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT); end; DoDrawTitleCell (DataCol, Columns[DataCol], ARect); end else inherited; end; |
Кроме того, появляется возможность вызывать пользовательское событие при рисовании области заголовков, причем после того, как заголовок уже нарисован самим компонентом.
Задание высоты заголовков в наследнике также выполняется проще, так как имеется доступ к защищенным свойствам родительского компонента.
| procedure THSDBGrid.CalcTitleHeight; begin if dgTitles in Options then RowHeights[0] := (Canvas.TextHeight('gW') + 2) * FTitleLines; end; |
Высоту области заголовка необходимо задавать один раз при создании окна грида и каждый раз, при изменении свойств грида, влияющих на его внешний вид. При создании окна и при изменении свойств грида вызываются виртуальные методы CreateWnd и LayoutChanged, в перекрытые версии которых добавлен вызов процедуры CalcTitleHeight.
Рисование многострочных заголовков с использованием стандартного компонента TDBGrid.
При использовании стандартного компонента TDBGrid для рисования доступна только область данных колонок, изначально не включающая в себя фиксированные области TDBGrid, рисующиеся самим компонентом. Зная тот факт, что при событиях рисования доступна вся клиентская область окна, можно попробовать обмануть компонент и рисовать в другой области, чем та, которая передается процедуре рисования. Так как событие OnDrawCell вызывается для каждой ячейки Grid'а, а заголовки желательно рисовать один раз, заводим массив признаков нарисованных заголовков: GridTitles : : array of Boolean; Обработчик события OnDrawColumnCell выглядит достаточно просто:| procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin if not GridTitles[Column.Index] then DrawGridTitle(Column.Index); end; |
Если заголовок колонки не нарисован, то нарисовать его. Процедура рисования должна определить координаты области заголовка и ее размеры и заново перерисовать эту область. Сама процедура оформлена как локальная, для того, чтобы не передавать параметры, переданные обработчику события. Для простоты заголовок делается двухстрочным, но ничего не мешает рисовать произвольное количество строк. RowCount объявлено константой и равно 2.
| procedure DrawGridTitle(ColIndex : Integer); var Titles : array[1..RowCount] of String; ARect : TRect; { Собственно область заголовка } RH : Integer; { Высота области заголовка } BlankPos : Integer; { Позиция разбиения заголовка } begin BlankPos := Pos(' ', Column.Title.Caption); if BlankPos <> 0 then begin { Рисуем многострочный заголовок только для тех колонок, у которых есть пробел в названии. Заголовки остальных колонки DBGrid нарисует сам. } Titles[1] := Copy(Column.Title.Caption, 1, BlankPos-1); Titles[2] := Copy(Column.Title.Caption, BlankPos+1, Length(Column.Title.Caption) - BlankPos); RH := RectHeight(Rect); { В прямоугольнике Rect передаются координаты текущей ячейки, область для рисования заголовка можно получить, указывая в качестве вертикальной координаты 0. Высота области рисования сейчас равна высоте стандартной ячейки DBGrid, как раз на одну строку заголовка. } SetRect(ARect, Rect.Left, 0, Rect.Right, RH); InflateRect(ARect, -2, -2); { Поправка на окантовку Titles } Dec(RH, 2); { Смещение для отступа текста от края по вертикали } with DBGrid1.Canvas do begin Brush.Color := DBGrid1.FixedColor; FillRect(ARect); { Залить область заголовка, стерев все, что там нарисовано DBGrid'ом } { Рисование первой строки в заголовке } ARect.Bottom := RH; DrawText(Handle, PChar(Titles[1]), -1, ARect, DT_CENTER or DT_SINGLELINE); { Рисование второй строки в заголовке, предварительно сместив область рисования вниз на размер строки. } OffsetRect(ARect, 0, RH-2); DrawText(Handle, PChar(Titles[2]), -1, ARect,DT_CENTER or DT_SINGLELINE); end; end; GridTitles[ColIndex] := true; //Нарисовали заголовок для этой колонки end; |
Высота любой строки любого наследника TCustomGrid определяется свойством RowHeights[номер строки]. Так как это свойство объявлено protected, для того, чтобы высота области заголовков DBGrid'а была большая, чем стандартная, используется обычный прием доступа к защищенным свойствам компонента, с описанием наследника от требуемого класса и повышением области видимости требуемого свойства: type THackGrid = class(TCustomGrid) public property RowHeights; end; Высоту области надо задать один раз, что и делается в обработчике события FormShow
| procedure TForm1.FormShow(Sender: TObject); var .... H : Integer; { Определение необходимой высоты строки для многострочных заголовков } H := DbGrid1.Canvas.TextHeight('gW'); THackGrid(DBGrid1).RowHeights[0] := (H + 2) * RowCount; { RowCount принудительно объявлено 2 } end; |
рис. 1
После первого запуска программы обнаружен интересный эффект - при переключении на другое окно и обратном переключении на окно с Grid'ом многострочность заголовков пропадает. Аналогичным образом она пропадает при перемещении по гриду с помощью вертикального и горизонтального ScrollBar'ов. Для события переключения окна положение можно исправить, указав необходимость перерисовки заголовков в событии FormActivate, со ScrollBar'ами бороться придется подменой оконной процедуры DBGrid'а. Сделаем метод формы, сбрасывающий признаки рисования у всех заголовков:
| procedure TForm1.InvalidateGridTitles; var I : Integer; begin for I:=0 to Pred(DBGrid1.Columns.Count) do GridTitles[I] := false; end; |
| procedure TForm1.GridWndProc(var Message: TMessage); begin case Message.Msg of WM_ERASEBKGND, WM_VSCROLL: InvalidateGridTitles(); WM_HSCROLL: begin InvalidateGridTitles(); // сожалению, приходится мириться с необходимостью перерисовки всего // DBGrid'а при горизонтальном скроллинге, иначе, все усилия по рисованию // многострочных заголовков пропадают :-( InvalidateRect(GridWnd, nil, true); end; end; with Message do Result := CallWindowProc(OldWndProc, GridWnd, Msg, wParam, lParam); end; |
В первом варианте при обработке собщения WM_HSCROLL не был написан код для перерисовки всего окна DBGrid. Как я ни старался, победить ситуацию пропадания многострочных заголовков мне не удалось, поэтому и был добавлен код, принудительно перерисовывающий все окна DBGrid.
Рисуем ячейку в стиле заголовка в любом месте TDBGrid
Добавим нашему гриду еще один метод — DrawCellButton, который будет рисовать в любой ячейке 3D-окантовку, то есть делать имитацию заголовка. Передавать в нее будем прямоугольник этой ячейки, текст, выравнивание текста, шрифт, которым текст будет выведен и состояние (State) грида. Состояние нам понадобится для нормальной работы с фиксированными колонками.
| procedure TexDBGrid.DrawCellButton(Rect: TRect; Text: String; Style: TFontStyles; State: TGridDrawState; Alignment: TAlignment); Var Shift : Integer; begin //Очищаем ячейку Canvas.Brush.Color:=clBtnFace; Canvas.Font.Color:=clBtnText; Canvas.Font.Style:=Style; Canvas.FillRect(Rect); // Если ячейка фиксирована, то мы получим TRect меньшего размера, // чем для обычной ячейки. Это нужно учесть Shift:=-2 + ORD(gdFixed In State); // вписываем текст InflateRect(Rect,Shift,0); WriteText(Canvas, Rect, Text , Alignment ); InflateRect(Rect,(-1)*Shift,0); // рисуем по размеру ячейки button // только если это не фиксированная ячейка, так как для нее окантовка уже нарисована IF NOT (gdFixed in State) Then Begin // Рисуем аналог разделительных линий между фиксированными ячейками грида // (они рисуются черным цветом, в отличие от серых линий между ячейками // данных (grids.pas)) InflateRect(Rect, 1, 1); Rect.Top:=Rect.Top + 1; FrameRect(Canvas.Handle, Rect, GetStockObject(BLACK_BRUSH)); Rect.Top:=Rect.Top - 1; // Закончили имитацию линий между фиксированными ячейками. InflateRect(Rect, -2, -2); Paint3dRect(Canvas.Handle, Rect); End; end; |
рис. 4
Синхронизация размеров и положения колонок двух гридов
Задача состоит в том, чтобы заставить два TDBGrid, расположенных один под другим, полностью синхронизировать свою работу с колонками: изменение размеров колонок и их перемещение должно происходить в обоих гридах отдновременно. Самое распространенное применение этой задачи в отображении грида с данными и грида с итогами (см. рис. 3). Верхний грид содержит список всех стран с данными по площади и населению(MainGrid), нижний — список, где эти же данные сгруппированы по континентам(TotalGrid).
рис. 3
При синхронизации действий будем считать, что тот грид, который инициирует это действие — ведущий, а второй в этой ситуации — ведомый. Чтобы не зациклить синхронизацию, введем дополнительную переменную: SynchProccesed : Boolean; Для синхронизации необходимо обработать три события:
| //-------------------------------------------------------------------------------------------------- procedure TfExDBG.mainGridColumnMoved(Sender: TObject; FromIndex, ToIndex: Integer); Var Grid : TDBGrid; begin // TDBGrid(Sender) инициирует перемещение колонок, он — ведущий грид // определяем "ведомый" грид IF TDBGrid(Sender).Name = 'TotalGrid' Then Grid:=MainGrid Else Grid:=TotalGrid; // Сейчас ведомому гриду не нужно реагировать на изменение его колонок, // инициируя в свою очередь синхронизацию с другим гридом SynchProccesed:=True; Grid.Columns.Assign(TDBGrid(Sender).Columns); // Синхронизация завершена SynchProccesed:=False; end; //-------------------------------------------------------------------------------------------------- |
Для отслеживания горизонтального скролинга как нельзя лучше подходит метод TCustomDBGrid.TopLeftChanged. К сожалению, в стандартном TDBGrid этот метод не доступен (protected). Поэтому, лучшим вариантом будет не мучить стандартный грид, а создать собственного наследника. Положительные стороны этого способа уже описывались в начале статьи.
| TexDBGrid = class(TDBGrid) private FOnTopLeftChanged : TNotifyEvent; ... public Procedure TopLeftChanged; override; ... published Property OnTopLeftChanged : TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged; ... End; ... //-------------------------------------------------------------------------------------------------- Procedure TexDBGrid.TopLeftChanged; Begin Inherited; IF Assigned(FOnTopLeftChanged) then FOnTopLeftChanged(Self); End; |
Теперь нам доступно событие OnTopLeftChanged. Синхронизация заключается в том, чтобы сделать первой видимой колонкой ведомого грида ту же колонку, что и у ведущего. Для этого нам понадобится свойство TCustomGrid.LeftCol (см. help). Это свойство protected, но так как мы создаем собственного наследника от TDBGrid, то повысить его видимость нам не составит труда.
| //-------------------------------------------------------------------------------------------------- procedure TfExDBG.GridTopLeftChanged(Sender: TObject); Var Grid : TexDBGrid; begin IF NOT SynchProccesed Then Begin // TDBGrid(Sender) инициирует скролинг, он — ведущий грид // определяем "ведомый" грид IF TDBGrid(Sender).Name = 'TotalGrid' Then Grid:=MainGrid Else Grid:=TotalGrid; SynchProccesed:=True; Grid.LeftCol:=TexDBGrid(Sender).LeftCol; SynchProccesed:=False; End; end; //-------------------------------------------------------------------------------------------------- |
И, наконец, третий пункт: отслеживаем изменение ширины колонки. Синхронизация в этом случае будет заключаться только в том, чтобы ширину колонок ведомого грида сделать равной ширине колонок ведущего.
| //-------------------------------------------------------------------------------------------------- Procedure TfExDBG.SynchronizeGrids( MasterGrid , SlaveGrid : TDBGrid ); Var i : Integer; Begin IF NOT SynchProccesed Then Begin SynchProccesed:=True; For i:=0 To MasterGrid.Columns.Count - 1 Do SlaveGrid.Columns[i].Width:=MasterGrid.Columns[i].Width ; SynchProccesed:=False; End; End; //-------------------------------------------------------------------------------------------------- |
Этот метод автоматически вызывается всякий раз, когда изменяются настройки колонок, в том числе их ширина. Мы нашли то, что нам нужно! По аналогии с OnTopLeftChanged создадим в нашем гриде событие OnSetColumnAttr:
| TexDBGrid = class(TDBGrid) private FOnTopLeftChanged, FOnSetColumnAttr : TNotifyEvent; ... protected Procedure SetColumnAttributes; override; public Procedure TopLeftChanged; override; ... published Property OnTopLeftChanged : TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged; Property OnSetColumnAttr : TNotifyEvent read FOnSetColumnAttr write FOnSetColumnAttr; ... End; ... //-------------------------------------------------------------------------------------------------- procedure TexDBGrid.SetColumnAttributes; begin inherited; IF Assigned(FOnSetColumnAttr) Then FOnSetColumnAttr(Self); end; |
| //-------------------------------------------------------------------------------------------------- // Так как определять ведомый грид приходится не один раз, правильно выделить это в отдельный метод Function TfExDBG.GetSlaveGrid( MasterGrid : TexDBGrid) : TexDBGrid; Begin // MasterGrid инициирует синхронизацию, он — ведущий грид // определяем "ведомый" грид IF MasterGrid.Name = 'TotalGrid' Then Result:=MainGrid Else Result:=TotalGrid; End; //---------------------------------------------------------------------------------------- Procedure TfExDBG.OnSetColumnAttr(Sender: TObject); Begin IF NOT SynchProccesed Then SynchronizeGrids( TexDBGrid(Sender) ,GetSlaveGrid(TexDBGrid(Sender)) ); End; //---------------------------------------------------------------------------------------- |
Для того, чтобы расслабиться перед следующим "броском", пристроим к нашему гриду несколько простых, но приятных бантиков :о)
Сложные заголовки
Изначально наш грид выглядит вот так:
Для того, чтобы добавить объединяющие заголовки для существующих, совершенно явно следует увеличить по высоте область заголовков грида.
И в нужном месте дорисовать самим объединяющую часть заголовка.
Реализация описанной методики в нашем наследнике TexDBGrid:
| TexDBGrid = class(TDBGrid) private FSubHeader : Boolean; // подзаголовки ... published Property SubHeader : Boolean read FSubHeader write SetSubHeader; |
| ... Const TITLE_SUBHEADER = 2; TITLE_DEFAULT = 1; ... //******************************************************* procedure TexDBGrid.CalcTitle; begin RowHeights[0] := 19 * FTitleLines ; end; //******************************************************* procedure TexDBGrid.SetSubHeader(const Value: Boolean); begin FSubHeader := Value; IF FSubHeader Then FTitleLines:=TITLE_SUBHEADER Else FTitleLines:=TITLE_DEFAULT; CalcTitle; end; |
| IF FSubHeader Then Begin // Рисуем объединяющий заголовок Header к мелким заголовкам Title DrawSubHeader(DataCol, Canvas); // Рисуем заголовки Title FRect:=ARect; FRect.Top:=RectHeight(ARect) div FTitleLines; DrawTitleCell(FRect,Columns[DataCol]); End Else DrawTitleCell(FRect,Columns[DataCol]); |
| published Property OnGetHeaderText : TOnGetHeaderText read FOnGetHeaderText write FOnGetHeaderText; Property OnGetHeaderRect : TOnGetHeaderRect read FOnGetHeaderRect write FOnGetHeaderRect; |
| Procedure DrawSubHeader(ACol : Integer; Canvas : TCanvas); Var HRect : TRect; Begin // Получаем прямоугольник, объединяющий несколько колонок, // для которых рисуем сложный заголовок HRect:=GetHeaderRect(ACol); // По высоте берем только часть прямоугольника // так как вторая часть — обычный заголовок HRect.Bottom:=RectHeight(HRect) div TITLE_SUBHEADER; Canvas.FillRect(HRect); // Вписываем текст, // который получаем методом GetHeaderText InflateRect(HRect,-1,-1); WriteText(Canvas, HRect, GetHeaderText(ACol) , taCenter); // Рисуем 3D-окантовку Paint3dRect(Canvas.Handle,HRect); End; |
При этом, следует помнить, что в каждый момент могут быть видны не все колонки из объединенных в блок. Воспользуемся функцией TCustomDBGrid.CalcTitleRec, которая возвращает прямоугольник для определенной колонки и строки. Если в данный момент эта колонка не видна, то будет возвращен нулевой прямоугольник.
| Function TexDBGrid.GetHeaderRect(ACol : Integer) : TRect; Var MasterCol : TColumn; Index,Shift , Count,i : Integer; Begin // Если в опциях отключен показ сетки, это нужно учесть при расчете // общего прямоугольника IF [dgColLines] * Options = [dgColLines] Then Shift:=1 Else Shift:=0; Index:=ACol; Count:=1; // получаем информацию для текущей колонки грида: // в какой объединяющий блок она входит // Index — с какой колонки начинается объединяющий блок // Count — сколько колонок он включает IF Assigned(FOnGetHeaderRect) Then FOnGetHeaderRect(ACol, Index, Count); IF Index+Count-1 > Columns.Count-1 Then Begin Index:=ACol; Count:=1; End; // В результате нужно получить прямоугольник, состоящий из // всех, включенных в объединенный блок колонок Result:=CalcTitleRect(Columns[Index],0,MasterCol); For i:=Index+1 To Index + Count -1 Do Result.Right:=Result.Right + RectWidth(CalcTitleRect(Columns[i] ,0,MasterCol)) + Shift; End; |
| Const GeoColumns = 3; ParamColumns = 2; ... //---------------------------------------------------------------------------------------- // Получить для текущей колонки информацию о том, в какое объеденение колонок она попадает //---------------------------------------------------------------------------------------- procedure TfExDBG.GetHeaderRect(ACol: Integer; var IndexStart, Count: Integer); begin IF ACol < GeoColumns Then Begin IndexStart:=0; Count:=GeoColumns; End Else Begin IndexStart:=GeoColumns; Count:=ParamColumns; End end; //---------------------------------------------------------------------------------------- // Получить для текущей колонки текст заголовка объеденени //---------------------------------------------------------------------------------------- procedure TfExDBG.GetHeaderText(ACol: Integer; var Text: String); begin IF ACol < GeoColumns Then Text:='География' Else Text:='Параметры'; end; //---------------------------------------------------------------------------------------- |
Предложенный способ просто один из возможных, он не позволяет настраивать параметры объединяющих заголовков в design-time, рассчитан на использование двухуровневых заголовков и предполагает наличие сложных заголовков у всех колонок грида.
Например, для того, чтобы сделать так, как показано на рисунке ниже, следует свойство SubHeader привязывать не ко всему гриду, а к каждой его колонке.
Рассказать о реализации всех вариантов сложных заголовков не представляется возможным. Изучив наши примеры, Вы можете сами совершенствовать новый грид, по собственному усмотрению.
Выделение цветом текущей строки
А теперь снова вернемся к заголовкам и пойдем по дорожке, только что проложенной в самом начале статьи. Если мы умеем рисовать в заголовках, то мы можем очень многое, практически все :о)На изображен грид со сложными заголовками. Разберем один из возможных способов достижения такого результата.
Вызываем разные меню для заголовков и области данных
В момент нажатия правой кнопки мыши нам доступны ее координаты относительно самого грида (так называемые клиентские координаты). Для того, чтобы понять, в какой области мы оказались (в области заголовка или данных), нам необходимо получить номер столбца и строки той ячейки, в которую мы попали. Для этого создадим соответствующий метод в нашем наследнике:| procedure TexDBGrid.MouseToCell(X, Y: Integer; var ACol, ARow: Integer); Var Coord: TGridCoord; Begin Coord := MouseCoord(X, Y); ACol := Coord.X; ARow := Coord.Y; End; |
| //---------------------------------------------------------------------------------------- procedure TfExDBG.GridMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Var Row, Col : Integer; APoint : TPoint; Grid : TexDBGrid; begin Grid:=TexDBGrid(Sender); // Получим номер строки и столбца грида, над которыми произошел клик мышкой Grid.MouseToCell(X,Y,Col,Row); IF Button = mbRight Then // Если мышка не попала на незаполненную область грида IF (Col >= 0) AND (Row >=0 ) Then Begin // Нажатие правой кнопки мыши, проверяем какое меню требуется вызвать IF Row = 0 Then Grid.PopUpMenu:=pmTitle Else Grid.PopUpMenu:=pmData; // Получаем из координат мыши(относительно грида — клиентские координаты) // экранные координаты для всплывающего меню APoint := Grid.ClientToScreen(Point(X,Y)); Grid.PopUpMenu.Popup(APoint.X,APoint.Y); End; end; //-------------------------------------------------------------------------------------------------- |
Запрет перемещения колонок с разрешением менять их ширину
В случае использования сложных заголовков не следует забывать о том, что необходимо контролировать стандартную работу грида с колонками. Например, совершенно естественно, что колонки, которые входят в объединенный блок, не должны передвигаться за его пределы.В опциях грида объединены запрет/разрешение на передвижение колонок и на изменение их ширины (dbColumnResize). Если запретить перемещать колонки, тогда нельзя будет менять их ширину. В нашем случае это неудачное сочетание будет крайне неудобно с точки зрения пользователя. Введем еще одно поле, которое будет отдельно запрещать перемещение колонок:
| TexDBGrid = class(TDBGrid) private ... FAllowColumnMoved: Boolean; ... public Property AllowColumnMoved : Boolean read FAllowColumnMoved write SetAllowColumnMoved; |
Переопределим его в нашем наследнике:
| function TexDBGrid.BeginColumnDrag(var Origin, Destination: Integer; const MousePt: TPoint): Boolean; Begin Result:=FAllowColumnMoved; // Разрешить передвигать колонки только если это разрешено в настройках: AllowColumnMoved IF Result Then Result:= Inherited BeginColumnDrag(Origin,Destination,MousePt); End; |
Процедуры и функции для работы с OpenOffice
Владимир Ермаков, Королевство ДельфиВсе в мире развивается по спирали. Раньше программисты разрабатывали механизмы взаимодействия между Delphi и MSExcel, теперь они методом проб и ошибок создают приложения для создания документов в OpenOffice. Надеюсь, что эта статья сэкономит время и усилия для решения более важных проблем, чем открытие шаблона и поиск нужной ячейки.
Автор ни в коем случае не возлагает на себя лавры разработчика-первооткрывателя. Очень многое из данной статьи лежит в интернете на разных сайтах. Например — и др.
Другие процедуры и функции были созданы прямо в процессе работы над заданием. Все было проверено на работоспособность. Итак, начнем.
Для удобства работы, вынесем базовые функции и процедуры в новый класс type TopofCalc = class(TObject) при работе с таблицами, информация о типе документа может принимать следующие состояния: type TTipooCalc = (ttcError, ttcNone, ttcExcel, ttcOpenOffice); данные функции определяет тип приложения function TopofCalc.GetIsExcel: boolean; begin result:= (Tipoo=ttcExcel); end; function TopofCalc.GetIsOpenOffice: boolean; begin result:= (Tipoo=ttcOpenOffice); end; и произведена ли его загрузка function TopofCalc.GetProgLoaded: boolean; begin result:= not (VarIsEmpty(Programa) or VarIsNull(Programa)); end; function TopofCalc.GetDocLoaded: boolean; begin result:= not (VarIsEmpty(Document) or VarIsNull(Document)); end; запуск приложения… procedure TopofCalc.LoadProg; begin if ProgLoaded then CloseProg; if ((UpperCase(ExtractFileExt(FileName))='.XLS') or (UpperCase(ExtractFileExt(FileName))='.XLT')) then begin //Excel... Programa:= CreateOleObject('Excel.Application'); Programa.Application.EnableEvents:=false; Programa.displayAlerts:=false; if ProgLoaded then Tipoo:= ttcExcel; end; // Another filetype? Let's go with OpenOffice... if ((UpperCase(ExtractFileExt(FileName))='.ODS') or (UpperCase(ExtractFileExt(FileName))='.OTS')) then begin //OpenOffice.calc... Programa:= CreateOleObject('com.sun.star.ServiceManager'); if ProgLoaded then Tipoo:= ttcOpenOffice; end; //Still no program loaded? if not ProgLoaded then begin Tipoo:= ttcError; raise Exception.create('TopofCalc.create failed, may be no Office is installed?'); end; end; проведя все необходимые проверки, мы можем создать электронную таблицу procedure TopofCalc.NewDoc; var ooParams: variant; begin if not ProgLoaded then raise exception.create('No program loaded for the new document.'); if DocLoaded then CloseDoc; DeskTop:= Unassigned; if IsExcel then begin Programa.WorkBooks.Add(); Programa.Visible:= Visible; Document:= Programa.ActiveWorkBook; ActiveSheet:= Document.ActiveSheet; end; if IsOpenOffice then begin Desktop:= Programa.CreateInstance('com.sun.star.frame.Desktop'); ooParams:= VarArrayCreate([0, 0], varVariant); ooParams[0]:= ooCreateValue('Hidden', not Visible); Document:= Desktop.LoadComponentFromURL('private:factory/scalc', '_blank', 0, ooParams); ActivateSheetByIndex(1); end; end; а теперь закрыть таблицу procedure TopofCalc.CloseDoc; begin if DocLoaded then begin try if IsOpenOffice then Document.Dispose; if IsExcel then Document.close; finally //Clean up both "pointer"... Document:= Null; ActiveSheet:= Null; end; end; end; и само приложение procedure TopofCalc.CloseProg; begin if DocLoaded then CloseDoc; if ProgLoaded then begin try if IsExcel then Programa.Quit; Programa:= Unassigned; finally end; end; Tipoo:= ttcNone; end; вынесем последовательности команд создания таблицы в отдельную процедуру конструктора constructor TopofCalc.CreateTable(MyTipoo: TTipooCalc; MakeVisible: boolean); var i: integer; IsFirstTry: boolean; begin //Close all opened things first... if DocLoaded then CloseDoc; if ProgLoaded then CloseProg; IsFirstTry:= true; for i:= 1 to 2 do begin //Try to open OpenOffice... if (MyTipoo = ttcOpenOffice) or (MyTipoo = ttcNone)then begin Programa:= CreateOleObject('com.sun.star.ServiceManager'); if ProgLoaded then begin Tipoo:= ttcOpenOffice; break; end else begin if IsFirstTry then begin //Try Excel as my second choice MyTipoo:= ttcExcel; IsFirstTry:= false; end else begin //Both failed! break; end; end; end; //Try to open Excel... if (MyTipoo = ttcExcel) or (MyTipoo = ttcNone) then begin Programa:= CreateOleObject('Excel.Application'); if ProgLoaded then begin Tipoo:= ttcExcel; break; end else begin if IsFirstTry then begin //Try OpenOffice as my second choice MyTipoo:= ttcOpenOffice; IsFirstTry:= false; end else begin //Both failed! break; end; end; end; end; //Was it able to open any of them? if Tipoo = ttcNone then begin Tipoo:= ttcError; raise exception.create('TopofCalc.create failed, may be no OpenOffice is installed?'); end; //Add a blank document... fVisible:= MakeVisible; NewDoc; end; это – создание таблицы «с нуля». откроем существующую procedure TopofCalc.LoadDoc; var ooParams: variant; begin if FileName='' then exit; if not ProgLoaded then LoadProg; if DocLoaded then CloseDoc; DeskTop:= Unassigned; if IsExcel then begin Document:=Programa.WorkBooks.Add(FileName); Document.visible:=visible; Document:= Programa.ActiveWorkBook; ActiveSheet:= Document.ActiveSheet; end; if IsOpenOffice then begin Desktop:= Programa.CreateInstance('com.sun.star.frame.Desktop'); ooParams:= VarArrayCreate([0, 0], varVariant); ooParams[0]:= ooCreateValue('Hidden', not Visible); Document:= Desktop.LoadComponentFromURL(FileNameToURL(FileName), '_blank', 0, ooParams); ActivateSheetByIndex(1); end; if Tipoo=ttcNone then raise exception.create('File "'+FileName+'" is not loaded. Are you install OpenOffice?'); end; опишем еще один конструктор для открытия существующей таблицы constructor TopofCalc.OpenTable(Name: string; MakeVisible: boolean); begin //Store values... FileName:= Name; fVisible:= MakeVisible; //Open program and document... LoadProg; LoadDoc; end; кроме того, опишем уничтожение объекта destructor TopofCalc.Destroy; begin CloseDoc; CloseProg; inherited; end; по аналогии, опишем сохранение function TopofCalc.SaveDoc: boolean; begin result:= false; if DocLoaded then begin if IsExcel then begin Document.Save; result:= true; end; if IsOpenOffice then begin Document.Store; result:= true; end; end; end; печать function TopofCalc.PrintDoc: boolean; var ooParams: variant; begin result:= false; if DocLoaded then begin if IsExcel then begin Document.PrintOut; result:= true; end; if IsOpenOffice then begin //NOTE: OpenOffice will print all sheets with Printable areas, but if no //printable areas are defined in the doc, it will print all entire sheets. //Optional parameters (wait until fully sent to printer)... ooParams:= VarArrayCreate([0, 0], varVariant); ooParams[0]:= ooCreateValue('Wait', true); Document.Print(ooParams); result:= true; end; end; end; и режим предварительного просмотра procedure TopofCalc.ShowPrintPreview; begin if DocLoaded then begin Visible:= true; if IsExcel then Document.PrintOut(,,,true); if IsOpenOffice then ooDispatch('.uno:PrintPreview', Unassigned); end; end; нам также пригодится скрытие/отображение на экране procedure TopofCalc.SetVisible(v: boolean); begin if DocLoaded and (v<>fVisible) then begin if IsExcel then Programa.Visible:= v; if IsOpenOffice then Document.getCurrentController.getFrame.getContainerWindow.setVisible(v); fVisible:= v; end; end; теперь, мы можем получить информацию о таблице.
Начнем с количества листов function TopofCalc.GetCountSheets: integer; begin result:= 0; if DocLoaded then begin if IsExcel then result:= Document.Sheets.count; if IsOpenOffice then result:= Document.getSheets.GetCount; end; end; и сделаем один из листов активным. function TopofCalc.ActivateSheetByIndex(nIndex: integer): boolean; begin result:= false; if DocLoaded then begin if IsExcel then begin Document.Sheets[nIndex].activate; ActiveSheet:= Document.ActiveSheet; result:= true; end; //Index is 1 based in Excel, but OpenOffice uses it 0-based if IsOpenOffice then begin ActiveSheet:= Document.getSheets.getByIndex(nIndex-1); result:= true; end; sleep(100); //Asyncronus, so better give it time to make the change end; end; активным лист можно сделать не только по его индексу, но и по названию function TopofCalc.ActivateSheetByName(SheetName: string; CaseSensitive: boolean): boolean; var OldActiveSheet: variant; i: integer; begin result:= false; if DocLoaded then begin if CaseSensitive then begin //Find the EXACT name... if IsExcel then begin Document.Sheets[SheetName].Select; ActiveSheet:= Document.ActiveSheet; result:= true; end; if IsOpenOffice then begin ActiveSheet:= Document.getSheets.getByName(SheetName); result:= true; end; end else begin //Find the Sheet regardless of the case... OldActiveSheet:= ActiveSheet; for i:= 1 to GetCountSheets do begin ActivateSheetByIndex(i); if UpperCase(ActiveSheetName)=UpperCase(SheetName) then begin result:= true; Exit; end; end; //If not found, let the old active sheet active... ActiveSheet:= OldActiveSheet; end; end; end; getByName(string) имеет свойства для чтения и записи function TopofCalc.GetActiveSheetName: string; begin if DocLoaded then begin if IsExcel then result:= ActiveSheet.Name; if IsOpenOffice then result:= ActiveSheet.GetName; end; end; procedure TopofCalc.SetActiveSheetName(NewName: string); var ooParams:variant; begin if DocLoaded then begin if IsExcel then Programa.ActiveSheet.Name:= NewName; if IsOpenOffice then begin ActiveSheet.setName(NewName); //This code always changes the name of "visible" sheet, not active one! ooParams:= VarArrayCreate([0, 0], varVariant); ooParams[0]:= ooCreateValue('Name', NewName); ooDispatch('.uno:RenameTable', ooParams); end; end; end; пригодится проверка на защиту листа от записи function TopofCalc.IsActiveSheetProtected: boolean; begin result:= false; if DocLoaded then begin if IsExcel then result:= ActiveSheet.ProtectContents; if IsOpenOffice then result:= ActiveSheet.IsProtected; end; end; добваление листа procedure TopofCalc.AddNewSheet(NewName: string); var ooSheets: variant; begin if DocLoaded then begin if IsExcel then begin Document.WorkSheets.Add; Document.ActiveSheet.Name:= NewName; //Active sheet has move to this new one, so I need to update the var ActiveSheet:= Document.ActiveSheet; end; if IsOpenOffice then begin ooSheets:= Document.getSheets; ooSheets.insertNewByName(NewName, 1); //Redefine active sheet to this new one ActiveSheet:= ooSheets.getByName(NewName); end; end; end; перейдем от листов к ячейкам
получить значение ячейки //OpenOffice start at cell (0,0) while Excel at (1,1) function TopofCalc.GetCellText(row, col: integer): string; begin if DocLoaded then begin if IsExcel then result:= ActiveSheet.Cells[row, col].Formula; //.Text; if IsOpenOffice then result:= ActiveSheet.getCellByPosition(col-1, row-1).getFormula; end; end; установить значение procedure TopofCalc.SetCellText(row, col: integer; Txt: string); begin if DocLoaded then begin if IsExcel then ActiveSheet.Cells[row, col].Formula:= Txt; if IsOpenOffice then ActiveSheet.getCellByPosition(col-1, row-1).setFormula(Txt); end; end; то же самое, но по имени ячейки.
Обязательно указание номера листа function TopofCalc.GetCellTextByName(Range: string): string; var OldActiveSheet: variant; begin if DocLoaded then begin if IsExcel then begin result:= Programa.Range[Range].Text; //Set 'Formula' but Get 'Text'; end; if IsOpenOffice then begin OldActiveSheet:= ActiveSheet; //If range is in the form 'NewSheet!A1' then first change sheet to 'NewSheet' if pos('!', Range) > 0 then begin //Activate the proper sheet... if not ActivateSheetByName(Copy(Range, 1, pos('!', Range)-1), false) then raise exception.create('Sheet "'+Copy(Range, 1, pos('!', Range)-1)+ '" not present in the document.'); Range:= Copy(Range, pos('!', Range)+1, 999); end; result:= ActiveSheet.getCellRangeByName(Range).getCellByPosition(0,0).getFormula; ActiveSheet:= OldActiveSheet; end; end; end; procedure TopofCalc.SetCellTextByName(Range: string; Txt: string); var OldActiveSheet: variant; begin if DocLoaded then begin if IsExcel then begin Programa.Range[Range].formula:= Txt; end; if IsOpenOffice then begin OldActiveSheet:= ActiveSheet; //If range is in the form 'NewSheet!A1' then first change sheet to 'NewSheet' if pos('!', Range) > 0 then begin //Activate the proper sheet... if not ActivateSheetByName(Copy(Range, 1, pos('!', Range)-1), false) then raise exception.create('Sheet "'+Copy(Range, 1, pos('!', Range)-1)+ '" not present in the document.'); Range:= Copy(Range, pos('!', Range)+1, 999); end; ActiveSheet.getCellRangeByName(Range).getCellByPosition(0,0).SetFormula(Txt); ActiveSheet:= OldActiveSheet; end; end; end; а так же – размера шрифта. Можно установить его в шаблоне, а можно прямо в ходе работы программы. procedure TopofCalc.FontSize(row,col:integer;oosize:integer); begin if DocLoaded then begin if IsExcel then begin Programa.ActiveSheet.Cells[row,col].Font.Size:=oosize; end; if IsOpenOffice then begin ActiveSheet.getCellByPosition(col-1, row-1).getText.createTextCursor.CharHeight:= oosize; end; end; end; сделать шрифт жирным procedure TopofCalc.Bold(row,col: integer); const ooBold: integer = 150; //150 = com.sun.star.awt.FontWeight.BOLD begin if DocLoaded then begin if IsExcel then begin Programa.ActiveSheet.Cells[row,col].Font.Bold; end; if IsOpenOffice then begin ActiveSheet.getCellByPosition(col-1, row-1).getText.createTextCursor.CharWeight:= ooBold; end; end; end; изменить ширину столбца procedure TopofCalc.ColumnWidth(col, width: integer); //Width in 1/100 of mm. begin if DocLoaded then begin if IsExcel then begin //Excel use the width of '0' as the unit, we do an aproximation: Width '0' = 2 mm. Programa.ActiveSheet.Cells[col, 1].ColumnWidth:= width/100/3; end; if IsOpenOffice then begin ActiveSheet.getCellByPosition(col-1, 0).getColumns.getByIndex(0).Width:= width; end; end; end; в заключение, предлагаю функции, предназначенные именно для OpenOffice
преобразование имени //Change 'C:\File.txt' into 'file:///c:/File.txt' (for OpenOffice OpenURL) function TopofCalc.FileNameToURL(FileName: string): string; begin result:= ''; if LowerCase(copy(FileName,1,8))<>'file:///' then result:= 'file:///'; result:= result + StringReplace(FileName, '\', '/', [rfReplaceAll, rfIgnoreCase]); end; создание объекта function TopofCalc.ooCreateValue(ooName: string; ooData: variant): variant; var ooReflection: variant; begin if IsOpenOffice then begin ooReflection:= Programa.createInstance('com.sun.star.reflection.CoreReflection'); ooReflection.forName('com.sun.star.beans.PropertyValue').createObject(result); result.Name := ooName; result.Value:= ooData; end else begin raise exception.create('ooValue imposible to create, load OpenOffice first!'); end; end; запуск диспатчера procedure TopofCalc.ooDispatch(ooCommand: string; ooParams: variant); var ooDispatcher, ooFrame: variant; begin if DocLoaded and IsOpenOffice then begin if (VarIsEmpty(ooParams) or VarIsNull(ooParams)) then ooParams:= VarArrayCreate([0, -1], varVariant); ooFrame:= Document.getCurrentController.getFrame; ooDispatcher:= Programa.createInstance('com.sun.star.frame.DispatchHelper'); ooDispatcher.executeDispatch(ooFrame, ooCommand, '', 0, ooParams); end else begin raise exception.create('Dispatch imposible, load a OpenOffice doc first!'); end; end; end.
Delphi - сбориник статей
Формирование структуры HTML-документа
Поскольку TMIDASPageProducer (TCustomMIDASPageProducer) является генератором содержания HTML-документа, в его описание входит интерфейс IWebContent, который, собственно, это содержание и предоставляет. Заголовок соответствующего класса выглядит следующим образом:TCustomMIDASPageProducer = class(TPageItemProducer, IWebContent, IWebComponentEditor, IScriptEditor)
Помимо IWebContent, в описании класса участвуют еще два интерфейса: IWebComponentEditor и IScriptEditor, которые являются средствами связи с design-time редактором для компонентов типа TWebComponent и HTML-кода. НижДалее приведено краткое описание ключевых свойств TMidasPageProducer.
Следует отметить, что благодаря тому, что состав HTML-документа определяется стандартными компонентами, поставляемыми в исходных текстах, функциональные возможности InternetExpress становятся практически неограниченными – за счет создания специализированных наборов компонентов для построения интернет-приложений. Примеры подобного подхода есть в демонстрационном приложении InetXCenter из Delphi 5.
Невизуальный компонент TWebActionItem позволяет задать реакцию интернет-приложения на те или иные события, транслируемые протоколом HTTP от веб-клиента. Предоставляя специальные свойства для задания ссылок на компоненты TMIDASPageProducer и TPageProducer, а также URL, TWebActionItem позволяет описать алгоритм перемещения между HTML-документами, составляющими интернет-приложение, реагировать на передачу параметров и значений полей HTML-документа определенным образом и т. д. Создавая обработчик события TWebActionItem.OnAction, программист получает возможность возвращать необходимые данные в полях запросов, устанавливать идентификационные маркеры (cookies) для веб-клиентов, контролировать генерацию содержания HTML-документов и выполнять ряд других операций практически на самом нижнем уровне функционирования интернет-приложения. Далее описаны основные свойства компонента TWebActionItem.
Поговорим теперь о невизуальных компонентах категории PageItems, предназначенных для формирования структуры HTML-документа. Как и компоненты VCL, они делятся на средства отображения типовых элементов HTML-документа и элементов для обработки данных, получаемых от сервера приложений. У каждого из этих компонентов могут быть наследники, расширяющие их свойства или реализующие те элементы HTML, эквивалента которым нет в текущей версии InternetExpress. Компоненты PageItems находятся в модуле miditems.pas. При построении HTML-документа они объединяются в иерархические структуры. Например, компонент TDataNavigator содержит компоненты типа TDataSetButton.
При создании HTML-документа компонентом TMIDASPageProducer эти компоненты генерируют фрагменты HTML-кода, описывающего соответствующие HTML-элементы. Компонент TMIDASPageProducer объединяет их в единый поток и подставляет вместо соответствующих тэгов в шаблоне документа. К элементам HTML “привязываются” обработчики событий, написанные на JavaScript и являющиеся аналогами обработчиков событий для визуальных компонентов Delphi, таких как OnClick. Отдельные компоненты PageItems позволяют напрямую задать получателя сообщений (target) в формате URI (свойство Action), что дает возможность переходить от одного HTML-документа к другому и передавать между этими документами параметры в формате протокола HTTP.
Благодаря использованию в TMIDASPageProducer шаблонов для генерации HTML-документов появляется возможность создавать визуальные и невизуальные элементы HTML-документа прямым редактированием. Используя обработчики HTTP-событий, можно связывать такие элементы с генерируемыми шаблоном через компоненты TWebActionItem или при помощи создаваемых опять-таки прямым редактированием обработчиков на JavaScript внутри HTML-документа.
Компонент TXMLBroker передает пакеты данных в формате XML от сервера приложений к HTML-клиенту, получает от HTML-клиента измененные данные, расшифровывает разностные пакеты данных XML и передает сведения об изменении данных на сервер приложений. Этот компонент находится в модуле xmlbrokr.pas.
Компонент TXMLBroker можно использовать в приложении, которое одновременно является и MIDAS-клиентом, и серверным веб-приложением. Серверы такого класса, как правило, имеют две основные функции:
TXMLBroker автоматически регистрируется в веб-модуле (или веб-диспетчере) как автодиспетчеризуемый объект (auto-dispatching object). Это означает, что веб-модуль или веб-диспетчер будут перенаправлять все входящие HTTP-сообщения прямо к нему. Все входящие сообщения считаются данными для обновления, порождаемыми браузером в ответ на получение HTML-потока, порождаемого компонентом TApplyUpdatesButton. TXMLBroker автоматически передает пакет с XML-данными, содержащий сведения о различиях в данных, на сервер приложений и возвращает все ошибки, возникшие при обновлении данных, тому компоненту управления содержимым документа (TMIDASPageProducer), который имеет возможность генерации соответствующего ответного сообщения. Среди основных свойств компонента нужно выделить следующие.
InternetExpress вблизи
Что же позволяет делать InternetExpress?На вкладке панели компонентов InternetExpress расположены две пиктограммы, соответствующие двум компонентам базового набора: TXMLBroker и TMIDASPageProducer.
Первая из них “отвечает” за формирование XML-пакета. Также в ее функции входят реакция на изменение данных и оповещение о действиях, выполняемых клиентом. TMIDASPageProducer “отвечает” за формирование сборного DHTML-документа. Последний, собственно, и является клиентским приложением, поскольку содержит все те визуальные элементы, соответствующие структуре пакета данных XML. В этот документ передаются XML-пакеты, формируемые компонентом XMLBroker.
В тот момент, когда от клиентского приложения на сервер приложений приходит сообщение о необходимости изменить информацию, TMIDASPageProducer опрашивает все элементы управления HTML, формирует пакет с данными, подлежащими обновлению, и передает их на сервер приложений. Таким образом, обработка данных на клиенте происходит с использованием средств HTML, а передача структурированных данных к клиенту и изменений от него -- при помощи пакетов данных XML.
Эти компоненты помещаются в веб-модуль (WebModule) серверного приложения, для создания которого может быть использован специальный мастер (для этого нужно выбрать команду File -> New, а затем щелкнуть на пиктограмме Web Server Application).
WebModule является наследником TDataModule. По сравнению с “родителем” он обладает некоторыми дополнительными возможностями, которые позволяют обмениваться данными с веб-клиентами. Кроме базового набора InternetExpress, есть еще несколько компонентов, таких как TReconcilePageProducer, которые устанавливаются из дополнительных пакетов, входящих в комплект поставки Delphi. Естественно, существует возможность наследования базовых классов и создания на их основе собственных компонентов с расширенными возможностями.
Компонент TMIDASPageProducer отвечает за сборку HTML-документа, отображающего “живой” набор данных, получаемый от сервера приложений, или же от “типового” HTML-документа, вообще не обрабатывающего данные. Компонент может быть использован для создания веб-приложений на основе MIDAS, которые будут отображать информацию, получаемую из БД через сервер приложений, и передавать ее HTML-клиентам в пакетах XML-данных. При создании веб-модуля в соответствующих элементах TWebActionItem должна быть поставлена ссылка на один из таких компонентов (свойство Producer).
TMIDASPageProducer создает HTML-документ на основе шаблона. В отличие от других компонентов типа Producer, он имеет стандартный (default) шаблон, в котором содержатся несколько описаний верхнего уровня, на основе которых в других компонентах порождаются HTML-документы. Помимо шаблонов, содержание конечного документа может определяться данными, порождаемыми другими компонентами веб-модуля, другим компонентом TMIDASPageProducer через свойство TMIDASPageProducer.Content и т. д.
Связывание HTML-элементов с пакетами данных XML и обработчиками событий HTTP в TMIDASPageProducer осуществляется исключительно по именам HTML-объектов и соответствующих событий. Это позволяет редактировать сгенерированный HTML-шаблон в любом редакторе (специализированным для работы с HTML или нет), придавая ему необходимый внешний вид и дополняя логику обработки данных вставками JavaScript. Даже если свойства объектов, порожденных встроенным редактором TMIDASPageProducer, будут изменены другими средствами, эти изменения не будут потеряны, поскольку будут включены в шаблон.
Расширение функциональности обработчика шаблонов (свойство TMIDASPageProducer.HTMLdoc) возможно за счет реализации обработчика события TMIDASPageProducer.OnHTMLtag или перекрытия метода TMIDASPageProducer.DoTagEvent. Реализовав собственную версию обработчика этого события, программист получает возможность использовать в теле шаблона документа собственные тэги, заменяя их на этапе генерации HTML-документа соответствующими значениями. Пример такого подхода показан в демонстрационном приложении InetXCenter из состава Delphi 5 (модуль InetXCenterProd.pas).
Конечно, возможности InternetExpress можно расширять практически неограниченно, разрабатывая специальные компоненты-наследники класса TMIDASPageProducer и компонентов, используемых для формирования содержимого документа (TDataForm, TQueryForm и др.). Создавая на их основе специализированные компоненты, можно максимально упростить создание конечного решения на основе InternetExpress, реализуя специфические возможности, необходимые тому или иному интернет-приложению. Например, в демонстрационном приложении InetXCenter создание наследника компонента TMIDASPageProducer позволило реализовать такие возможности, как генерация полей заголовка HTML-документа , комментарии и описания, автоматически подставляемые в конечный HTML-документ, и другие расширения базового компонента.
Клиентская часть приложения InternetExpress
Клиентская часть приложения на основе InternetExpress представляет собой собственно HTML-документ, порожденный одним или несколькими компонентами TMIDASPageProducer (или их наследниками), интерпретируемый тем или иным браузером. Как уже говорилось, этот документ может содержать элементы отображения и управления, соответствующие структуре пакета данных XML. К ним также могут добавляться элементы управления, формирующие HTML-аналог DBnavigator из состава Delphi VCL, если соответствующие параметры были заданы при настройке PageProducer, а также другие элементы управления HTML, как связанные с обработкой данных, так и образующие независимые части интерфейса, например группу для ввода имени пользователя и пароля.Приложение InternetExpress работает следующим образом. Браузер обращается по ссылке (URL) к серверному приложению InternetExpress. Оно возвращает HTML-документ, который можно рассматривать как некую отправную точку в процессе обработки.
По запросу пользователя серверное приложение сначала возвращает очередной HTML-документ, содержащий (при необходимости) ссылки на библиотеки JavaScript, отвечающие за обработку XML-пакетов. Затем уже переданный пользователю документ посылает запрос серверной части приложения, которая возвращает клиенту данные в виде XML-пакетов, интерпретируемых соответствующими библиотеками JavaScript.
После того как пользователь просмотрит набор данных и, при необходимости, внесет в них изменения, он может передать изменения серверной части приложения. Этот процесс запускается событием, которое, как правило, связано с элементом управления -- кнопкой (например, Submit) и передается серверной части приложения InternetExpress, а именно компоненту TMIDASPageProducer. Все сведения об изменении данных передаются серверной части приложения в виде разностных пакетов XML (XML delta packets).
Серверная часть получает информацию об изменении данных и использует сервер приложений для внесения этих изменений в БД. В случае возникновения конфликта (reconcile error) имеется возможность сформировать HTML-вариант Reconcile Dialog из состава Delphi.
Передача данных в интернет при помощи InternetExpress
Сергей Кривошеев, InternetExpress - это входящее в состав Borland Delphi 5 интересное средство обработки и публикации данных в интернет, основанное на технологии MIDAS. В Delphi имеется набор компонентов, позволяющих реализовать полный цикл клиент-серверной обработки данных на базе интернет с применением как средств создания приложений на основе ISAPI/NSAPI, ASP и CGI, так и новых технологий, к примеру, стандарта XML.В InternetExpress используются средства поддержки XML из MIDAS 3. Поскольку в настоящее время не все интернет-браузеры поддерживают представление данных по стандарту XML, в InternetExpress реализована специальная технология поддержки XML на основе JavaScript и DHTML, позволяющая использовать InternetExpress браузерами, не поддерживающими XML. Кроме того, если приложение InternetExpress работает с IE 5, то порождаемый им XML-пакет будет специальным образом оптимизироваться. В браузерах без такой поддержки пакеты данных XML разбираются с использованием специального модуля JavaScript (xmldom.js), который реализует спецификацию DOM (Document Object Model).
Объектная модель XML-документов представляет его внутреннюю структуру в виде совокупности определенных объектов. Для удобства эти объекты организуются в древообразную структуру данных: каждый элемент документа может быть отнесен к отдельной ветви, а все его содержимое - в виде набора вложенных элементов, комментариев, секций CDATA и т. д. представляется в этой структуре поддеревьями. Поскольку в любом правильно составленном XML-документе обязательно есть главный элемент, то все его содержимое можно представит в виде поддеревьев этого основного элемента, называемого в данном случае корнем дерева документа.
Объектное представление структуры документа не является для разработчиков чем-то новым. Объектно-ориентированный подход давно используется в сценариях для доступа к содержимому HTML-страницы. Доступные для JavaScript или VBScript элементы веб-страницы и раньше можно было создавать, просматривать и редактировать при помощи соответствующих объектов. Но их список и набор методов постоянно изменяется и зависит от типа браузера и версии языка. Для того, чтобы обеспечить интерфейс доступа к содержимому структурированного документа, не зависящий от языка программирования и типа документа, консорциумом W3 была разработана и официально утверждена спецификация объектной модели DOM Level 1.
DOM - это спецификация универсального платформо- и программно-независимого доступа к содержимому документов. Она является просто своеобразным API для их обработчиков. DOM служит стандартным способом построения объектной модели любого документа HTML или XML, при помощи которой можно производить поиск нужных фрагментов, создавать, удалять и модифицировать отдельные элементы.
Для описания интерфейсов доступа к содержимому XML-документов в спецификации DOM применяется платформонезависимый язык IDL (Interface Definition Language). Для использования этих интерфейсов их необходимо “перевести” на какой-то конкретный язык программирования. Однако этим занимаются создатели самих анализаторов. Нам можно ничего не знать о способе реализации интерфейсов -- с точки зрения разработчиков прикладных программ DOM выглядит как набор объектов с определенными методами и свойствами.
Серверная часть приложения InternetExpress
Серверная часть интернет-приложения, созданного на основе InternetExpress, состоит из исполняемого модуля, написанного в данном случае на Delphi 5 и включающего в себя WebModule, а также файлов-библиотек JavaScript, которые, если браузер не поддерживает XML, передаются клиенту. НижДалее перечислены эти библиотеки.xmldom.js. XML-парзер, соответствующий стандарту DOM (Document Object Model), написанный на JavaScript. Позволяет браузерам без встроенной поддержки XML использовать пакеты данных этого стандарта. Для IE5 этот файл не передается, а XML-пакет оптимизируется специальными образом.
Ссылка на xmldom.js требуется только в том случае, если браузер не имеет встроенной поддержки XML.
Создание веб-приложения на основе InternetExpress
Как же построить веб-приложение на основе InternetExpress?Для создания веб-приложения необходим скомпилированный и зарегистрированный сервер данных. В данном примере используются данные из таблицы biolife.db, входящей в состав демонстрационной базы данных из комплекта Delphi 5. Данные публикуются через контейнер Remote Data Module.
Контейнер Remote Data Module
После создания и регистрации сервера данных необходимо создать клиента для этого сервера, который, в свою очередь, будет сервером для HTML-клиента. Для создания расширений веб-сервера в Delphi 5 есть специальный “мастер”. Он может быть вызван через меню File -> New -> Web Server Application.
В данном случае мы создаем CGI-приложение, выводящее порождаемый поток данных в устройство стандартного вывода (stdout). Поток данных этого приложения будет без изменений передаваться вызывающему документу через транспортный протокол.
Мастер автоматически создаст контейнер типа TWebModule, в который необходимо поместить компоненты TMIDASPageProducer и TXMLBroker. Сюда же мы поместим и компонент TDCOMConnection, который будем использовать для подключения к удаленному серверу данных, а также компонент TClientDataSet для доступа к удаленному модулю данных.
Определив необходимые для соединения с удаленным сервером свойства, переходим к созданию содержимого HTML-документа. Для этого необходимо назначить для объекта класса TXMLBroker свойства RemoteServer и ProviderName, а также создать хотя бы один компонент TWebActionItem, вызвав соответствующий редактор с помощью контекстного меню компонентов TXMLBroker и TMIDASPageProducer.
В примере используется только один такой компонент, свойству которого Default присвоено значение True, за счет чего все сообщения HTTP будут поступать на этот компонент, а от него -- на TXMLBroker и TMIDASPageProducer.
Далее необходимо вызвать редактор веб-страниц. Это можно сделать с помощью команды Web Page Editor контекстного меню компонента TMIDASPageProducer. Для работы этого элемента необходим Microsoft Internet Explorer 4.0 и выше.
После добавления необходимых элементов получаем готовое к применению приложение веб-сервера. При установке параметров отображения HTML-документа можно воспользоваться свойствами компонента DataGrid и других элементов HTML-документа для придания ему необходимого внешнего вида, а также вручную доработать HTML-код в соответствующем встроенном редакторе.
После компиляции исполняемый модуль (в нашем примере - XMLServerApp.exe) необходимо поместить в каталог веб-сервера, для которого выделены права на запуск приложений. В этот же каталог необходимо поместить библиотеки JavaScript. Для проверки правильности размещения библиотек можно воспользоваться специальным HTML-файлом scripttest.HTML, который находится в каталоге Demos\Midas\InternetExpress\TroubleShoot на компакт-диске Delphi 5 или в каталоге установки на жестком диске рабочей станции. Этот HTML-файл проверяет правильность размещения библиотек и настройки веб-сервера и в случае наличия тех или иных ошибок выдает некоторые рекомендации по разрешению проблем.
По окончании настройки можно обратиться к нашему приложению напрямую через протокол HTTP, поскольку оно порождает полноценный HTML-документ, не требующий дополнительной “обвязки”.
Рассматриваемое в рамках данной статьи демонстрационное приложение отнюдь не претендует на полноту и законченность. Для более полного ознакомления с возможностями InternetExpress я рекомендую обратиться к демонстрационным примерам из поставки Delphi 5 Enterprise, находящимеся в каталоге Runimage\Delphi50\Demos\Midas\InternetExpress на компакт-диске или в Demos\Midas\InternetExpress, расположенном в том каталоге на жестком диске, где находится Delphi 5. Внимательно прочитайте сопроводительные файлы к этим примерам, поскольку некоторые из них требуют специфических настроек Delphi и/или веб-сервера.
document.write('');
Архив новостей
2 Август, 17:53 (19)
2 Август, 17:51 (34)
2 Август, 15:40 (42)
2 Август, 15:35 (1)
2 Август, 14:54 (3)
2 Август, 14:34 (3)
2 Август, 14:15 (2)
2 Август, 13:34 (7)
2 Август, 13:04 (3)
2 Август, 12:28
Море работы для программистов, сисадминов, вебмастеров.
Иди и выбирай!
|
|
| IT-консалтинг | Software Engineering | Программирование | СУБД | Безопасность | Internet | Сети | Операционные системы | Hardware |
| PR-акции, размещение рекламы — , тел. +7 495 6608306, ICQ 232284597 | Пресс-релизы — |
|
|
|
| This Web server launched on February 24, 1997 Copyright © 1997-2000 CIT, © 2001-2009 |
|
|
| Внимание! Любой из материалов, опубликованных на этом сервере, не может быть воспроизведен в какой бы то ни было форме и какими бы то ни было средствами без письменного разрешения владельцев авторских прав. |
|
Предлагаем на любой вкус и цвет! |
Delphi - сбориник статей
К материалу прилагаются файлы:
Методы нахождения базового маршрута
Метод 1.1 («жадный», Greedily). Сначала на графе, образованном матрицей А, отыскивается и включается в маршрут вершина (город) T[k] , которая ближе всех к начальной. Далее отыскивается самая близкая к T[k] из числа еще не включенных в маршрут и т. д. В результате получается приближенное решение задачи – базовый маршрут. Метод 1.2 («деревянный», Woody). Сначала в маршрут включаются две вершины начальная T[0] и конечная T[N-1]. Далее отыскивается вершина, которая характеризуется наименьшим расстоянием D(T[i]+T[k]) + D(T[k]+T[j]) — D(T[i] + T[j]), где i = 0, j = N-1, k – номера еще не включенных в маршрут вершин. Найденная вершина помещается в маршрут (0, k, N-1). На следующем шаге отыскивается вершина L, которая характеризуется наименьшим расстоянием DL от звена (0, k), и вершина M, имеющая наименьшее расстояние DM от звена (k, N-1). Среди L и M выбирается та, которая имеет наименьшее из DL и DM, и включается внутрь своего звена (0, k) или (k, N-1). Пусть это вершина M с номером m. Теперь маршрут состоит из трех звеньев (0, k), (k, m), (m, N-1). Процесс продолжается до тех пор, пока есть не включенные в маршрут вершины.Метод 1.3 (простейший, Simply). Промежуточные вершины в маршрут включаются случайным образом. В частности, базовым будет допустимый маршрут G[i] = i.
Маршруты, построенные этими методами, вычисляются с очень высокой скоростью (практически мгновенно). Однако длина этих маршрутов в подавляющем большинстве случаев далека от практически приемлемой. Для этих целей применено несколько методов улучшения базового маршрута.
Методы улучшения базового маршрута
Метод 2.1 (перестановок, Permutations). Совершается последовательный проход по парам соседних вершин всех звеньев с перестановкой этих вершин. Если перестановка уменьшает длину маршрута, то этот маршрут считается текущим. Производятся новые попытки улучшить его тем же методом до тех пор, пока перестановки не дадут эффекта. Далее аналогичным образом выполняются перестановки по трем соседним вершинам из числа тех, которые не попали в число ранее проведенных операций с двумя соседними вершинами (перестановки более широкого диапазона, т. е. по 4 и более, не выполнялись). Эксперименты с графами показали, что процедура улучшения маршрута при помощи перестановок достаточно эффективна и быстродействие ее весьма высоко. Метод 2.2 (удаление петлей, CrossDeleting). Часто текущий маршрут содержит петли. Например, на рисунке 1 цепочка вершин 5-7-3-8-2-4 образуют петлю. Петля начинается с левой по ходу маршрута вершины отрезка 5-7 и заканчивается правой вершиной отрезка 2-4. Существование петли определяется наличием пересекающихся отрезков маршрута. Если внутреннюю цепочку петли повернуть в противоположном направлении, то есть заменить указанную цепочку на 5-2-8-3-7-4, то петля исчезнет (рисунок 2), а маршрут станет короче. Метод отличается чрезвычайно высоким быстродействием и высокой эффективностью. |
 |
|
| Рисунок 1.Маршрут с петлей | Рисунок 2. Улучшенный маршрут |
Метод 2.3 (разворот цепочек, ChainTurnings). Как показали эксперименты, отсутствие петлей еще не означает, что процедура разворота цепочек без петлей неэффективна. Для оптимизации текущего маршрута применялась процедура разворота всех возможных цепочек. Метод имеет самое низкое быстродействие в сравнении с другими методами улучшения. Поэтому на практике его применяли для цепочек с числом звеньев не более шести.
Метод 2.4 (комбинированный, CorrectPath). После нахождения какого-нибудь базового маршрута G к нему применялась комбинированная процедура улучшения по методам 2.1 – 2.3. Хотя метод 2.2 является частным случаем метода 2.3, его все равно применяли из-за высокого быстродействия и способности к эффективному разворота цепочек из любого числа звеньев. Метод имеет код: procedure CorrectPath(N: Integer; var G: TIntVec; var Path: Integer); begin repeat until not Permutations(N,G) and not ChainTurnings(N,G) and not CrossDeleting(N,G) and not MoveTops(N,G); Path:= PathByG(N,G); // расчет длины маршрута end;
Приближенные комбинированные методы нахождения кратчайшего маршрута
Применив три метода , , расчета базового маршрута и комбинированный метод их улучшения, получили три приближенных метода расчета маршрута: метод 3.1: procedure GreedilyCorrect(N: Integer; var G: TIntVec; var Path: Integer); begin Greedily(N,G); CorrectPath(N,G,Path); end;метод 3.2: procedure WoodyCorrect(N: Integer; var G: TIntVec; var Path: Integer); begin Woody(N,G); CorrectPath(N,G,Path); end;
и метод 3.3: procedure SimplyCorrect(N: Integer; var G: TIntVec; var Path: Integer); begin Simply(N,G); CorrectPath(N,G,Path); end;
В экспериментах с методами 3.1–3.3 установлено, что ни один из них не является предпочтительным. В зависимости от матрицы А лучший результат с равной вероятностью мог дать любой из этих методов (интересно, что даже простейший базовый маршрут G[i] = i после улучшений нередко трансформировался в самый короткий маршрут, что свидетельствует о том, что решение задачи практически не зависит от выбора базового маршрута). Поэтому в качестве рабочего применяли комбинированный метод 3.4 (комбинация всех), суть которого состоит в последовательном применении методов 3.1–3.3 к матрице А с последующим выбором лучшего маршрута среди сформированных этими методами.
Для того чтобы можно было оценить точность приближенной методики разработана рекурсивная процедура (RecoursiveMethod), позволяющая получить точное решение задачи переборным методом. Для повышения быстродействия в процедуру внесены некоторые очевидные эвристические усовершенствования. Процедура позволила получить точное решение за приемлемое для проведения необходимых оценок время (до 5 минут на вариант размещения городов) при N<23.
Для оценки точности метода при больших значениях N (N>22) процедуру RecoursiveMethod применить нельзя, поэтому составлена процедура Rand многократного применения метода к одной и той же матрице А с различными случайными базовыми маршрутами. Процедура последовательно формирует маршруты до тех пор, пока последний лучший маршрут не повторится 5 раз подряд. Нельзя сказать, что такой способ позволяет найти самый короткий маршрут. Однако результаты работы процедуры дают интуитивную уверенность в том, что сравнение «быстрого» результата с результатом длительной работы метода имеет достаточно высокую вероятность корректности за неимением точных методов. Уверенность в этом подкреплена весьма важным выводом, который получен после обработки сотен различных матриц для N<23. Он состоит в полном совпадении результатов, полученных с использованием точной процедуры RecoursiveMethod и приближенной Rand (т. е. для данных N процедура Rand всегда находила точное решение задачи).
Скриншот интерфейса разработанной в среде Delphi 6 программы показан на .
В качестве примера на рисунке представлен кратчайший маршрут из вершины 0 в вершину 13 (N = 14) для матрицы расстояний, которая показана на рисунке 4.
Рисунок 4. Матрица расстояний
На рисунках 5-10 показаны результаты расчета маршрутов и их протяженности (Комб и Rand) для случайного расположения городов при помощи быстрой процедуры комбинированного метода и процедуры Rand. В последней колонке таблиц приведена процентная погрешность метода , которую рассчитывали по формуле 100 (Комб-Rand)/Комб, %.
 |
 |
 |
||
| Рисунок 5 | Рисунок 6 | Рисунок 7 | ||
 |
 |
 |
||
| Рисунок 8 | Рисунок 9 | Рисунок 10 |
В результате экспериментов с несколькими сотнями матриц расстояний для различных N, получены данные, которые свидетельствуют, что независимо от количества N городов погрешность метода никогда не превосходила 8% при N<101. Средняя погрешность составила 2%, что вполне приемлемо для практики.
На основании обработки многочисленных расчетных данных получена формула ориентировочной оценки быстродействия метода . Среднее время t (с) расчета на компьютере с процессором Intel 1400 кратчайшего маршрута с N городами составило
Так, для N = 100 среднее время расчета маршрута составляет 4 секунды. Для практически используемых N<31 это время не превосходит 0,1 с.
Создание сводного отчета в Excel
Владимир Федченко,В списке обсуждаемых тем на Круглом столе Королевства Delphi часто возникает вопрос о построении сводных таблиц. Сводная таблица представляет собой очень удобный инструмент для отображения и анализа данных, возвращаемых запросом к базе данных. Можно, конечно, для этой цели использовать различные пакеты для построения отчетов (вроде FastReport). Но с генераторами отчетов возникает масса вопросов (отсутствие каких либо библиотек, проблемы с экспортом, отсутствие необходимой документации и т.д.). А начальник требует выдать ему отчет приблизительно такого вида: чтобы были видны все продажи, по всем сотрудникам, по всем регионам, по всем товарам за указанный период времени (скажем, за два года), но денег на покупку генератора отчетов не дает. А как бы было хорошо выдать что-нибудь типа вот такой формы:
Что тут остается делать. Варианта только два: либо пытаться создавать что-то свое, либо увольняться. Альтернативное решение проблемы предоставлено фирмой Microsoft уже очень давно. Называется оно PivotTable (Сводная таблица) и доступно в меню "Данные" приложения Excel. Осталось только научиться пользоваться этой возможностью. Для этого нам понадобиться:WB:_WorkBook;//рабочая книга WS:_WorkSheet;//лист Excel куда помещается сводная таблица PC:PivotCache;//кеш для данных сводной таблицы PT:PivotTable;//собственно сама сводная таблица i:byte; Отключим реакцию Excel на события (для ускорения работы): XLS.EnableEvents:=False; После предварительной подготовки создаем сводный отчет. Для этого необходимо создать кэш для хранения данных: PC:=WB.PivotCaches.Add(xlExternal,emptyparam) Этот метод имеет два параметра SourceType и SourceData. Но так как мы используем внешние данные (SourceType = xlExternal), то второй параметр нужно оставить пустым. Кэш создан, но не подключен к источнику данных. Надо восполнить этот пробел. Укажем строку подключения, тип подключения и зададим сам запрос:
PC.Connection:=Format('OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%snorthwind.mdb', [ExtractFilePath(ParamStr(0))]); В строке подключения указываем, что база данных находится в одном каталоге с проектом. PC.CommandType:=xlCmdSQL; PC.CommandText:='select salesperson, country, city, productname,'+ 'orderdate, year(orderdate) as yy, month (orderdate) as mm, '+ 'quantity, extendedPrice from invoices'; Данные определены и находятся практически в боевой готовности. Попытаемся их визуализировать. Как говорилось выше, визуализировать будем в PivotTable. Для начала создадим сводную таблицу, привязав ее к кэшу с данными, и получим ссылку на интерфейс. Делается это все очень элегантно:
PT:=PC.CreatePivotTable(WS.Range['A3',emptyparam], 'PivotTable1',emptyparam,xlPivotTableVersionCurrent). Три заданных параметра означают следующее: ячейка в которую поместим сводную таблицу, имя сводной таблицы и версия сводной таблицы (зависит от установленной версии M$ Office, в данном случае установлена текущая версия). Пустой параметр называется ReadData. Он указывает на то, читать ли в кэш все данные из внешнего источника (нам это не надо). Вот шаблон и готов. Но что такое шаблон без данных?
В сводной таблице существует несколько типов полей данных: поля колонок, поля строк, поля данных, поля страниц (в данной статье не рассматриваются).
Надо их разместить. Начнем с полей (колонок) таблицы. Тут стоит оговориться, что Excel имеет ограничения на количество полей на одном листе (255). Поскольку данные берутся из базы за период в три года, то количество полей будет существенно больше этого ограничения. Отсюда ясно, почему в запросе был выделен год и месяц. Наши данные будут группироваться сначала по году, затем - по месяцу, затем - по дате. Для того чтобы не возникло ошибки в связи в вышеуказанным ограничением будем прятать детализацию для каждого уровня группировки в цикле по всем полям детализации (кроме последнего, т.к. детализация по нему не предусмотрена):
with (PT.PivotFields('yy') as PivotField) do begin Caption:='Год'; Orientation:=xlColumnField; for i:=1 to PivotItems(emptyparam).Count do PivotItems(i).ShowDetail:=False; end; with (PT.PivotFields('mm') as PivotField) do begin Caption:='Месяц'; Orientation:=xlColumnField; for i:=1 to PivotItems(emptyparam).Count do PivotItems(i).ShowDetail:=False; end; with (PT.PivotFields('orderdate') as PivotField) do begin Caption:='Дата'; Orientation:=xlColumnField; end; Аналогично заполним строки. В них ограничения составляют 65535 записей на лист. По этой причине можно не сворачивать детализацию:
with (PT.PivotFields('salesperson') as PivotField) do begin Caption:='Сотрудник'; Orientation:=xlRowField; end; with (PT.PivotFields('country') as PivotField) do begin Caption:='Страна'; Orientation:=xlRowField; end; with (PT.PivotFields('city') as PivotField) do begin Caption:='Город'; Orientation:=xlRowField; end; with (PT.PivotFields('productname') as PivotField) do begin Caption:='Товар'; Orientation:=xlRowField; end; Осталось поместить сами данные в отчет: PT.AddDataField(PT.PivotFields('quantity'),'Кол-во',xlSum); with PT.AddDataField(PT.PivotFields('extendedPrice'),'Продано на сумму',xlSum) do begin //слегка отформатируем вывод суммы на экран if not XLS.UseSystemSeparators then NumberFormat:='#'+XLS.ThousandsSeparator+'##0'+XLS.DecimalSeparator+'00' else NumberFormat:='#'+ThousandSeparator+'##0'+DecimalSeparator+'00'; end; Ну и наконец, вернем к жизни сам Excel. PT.ManualUpdate:=True; Вот, собственно, и все. Осталось нажать кнопочку F9, немного подождать и порадовать начальника новой формой отчета. Пусть сидит и забавляется. Стоит отметить, что данный отчет абсолютно независим от данных из БД, т.к. все, что вернул запрос, храниться в самой книге Excel. Отчет можно отправить по сети, по электронной почте или перенести любым доступным способом. Сворачивать/разворачивать детализацию по дате можно двойным кликом по данным колонки/строки (только не по серым кнопочкам с заголовками полей). Нажатие на заголовок поля приводит к появлению фильтра по данным выбранной колонки/строки. Ниже приведен код на C# (перевод с Delphi сделал Shabal, за что ему большое спасибо):
using System; using System.Collections.Generic; using System.ComponentModel; using System.Data; using System.Drawing; using System.Text; using System.Windows.Forms; using System.Threading; using System.Globalization; using Excel = Microsoft.Office.Interop.Excel; namespace WinApp1 { public partial class Form1 : Form { public Form1() { InitializeComponent(); } private void button1_Click(object sender, EventArgs e) { const string cmdSelect = "select OrderDate, Year(OrderDate) as yy,\n" + "Month(OrderDate) as mm, Country, City, ProductName,\n" + "SalesPerson, Quantity, ExtendedPrice from Invoices"; Excel.PivotCache pivotCashe; Excel.PivotTable pivotTable; Excel.PivotField pivotField; Excel.Worksheet oSheet; Excel.Application xlApp = new Excel.Application(); string dataSource = Application.StartupPath + @"\..\..\Northwind.mdb"; button1.Enabled = false; label1.Visible = true; try { xlApp.Workbooks.Add(Type.Missing); xlApp.Visible = true; xlApp.Interactive = false; xlApp.EnableEvents = false; oSheet = (Excel.Worksheet)xlApp.ActiveSheet; oSheet.get_Range("A1", Type.Missing).Value2 = "Сводный отчет"; oSheet.get_Range("A1", Type.Missing).Font.Size = 12; oSheet.get_Range("A1", Type.Missing).Font.Bold = true; oSheet.get_Range("A1", Type.Missing).Font.Italic = true; oSheet.get_Range("A1", Type.Missing).Font.Underline = true; // создаем запрос pivotCashe = ((Excel.PivotCaches)xlApp.ActiveWorkbook.PivotCaches()). Add(Excel.XlPivotTableSourceType.xlExternal, Type.Missing); pivotCashe.Connection = string.Format("OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0}", dataSource); pivotCashe.CommandType = Microsoft.Office.Interop.Excel.XlCmdType.xlCmdSql; pivotCashe.CommandText = cmdSelect; // создаем сводную таблицу на основе запроса (пока без полей) pivotTable = pivotCashe.CreatePivotTable(oSheet.get_Range("A3", Type.Missing), "MyPivotTable1", Type.Missing, Excel.XlPivotTableVersionList.xlPivotTableVersionCurrent); pivotTable.DisplayImmediateItems = false; pivotTable.EnableDrilldown = true; pivotTable.ManualUpdate = true; // настраиваем поля // поля колонок pivotField = (Excel.PivotField)pivotTable.PivotFields("yy"); pivotField.Orientation = Microsoft.Office.Interop.Excel.XlPivotFieldOrientation.xlColumnField; pivotField.Caption = "Год"; // сворачиваем данные по годам, чтобы влезли все данные for (int i = 1; i <= ((Excel.PivotItems)pivotField.PivotItems(Type.Missing)).Count; i++) { ((Excel.PivotItem)pivotField.PivotItems(i)).ShowDetail = false; } pivotField = (Excel.PivotField)pivotTable.PivotFields("mm"); pivotField.Orientation = Microsoft.Office.Interop.Excel.XlPivotFieldOrientation.xlColumnField; // сворачиваем данные по месяцам, чтобы влезли все данные for (int i = 1; i <= ((Excel.PivotItems)pivotField.PivotItems(Type.Missing)).Count; i++) { ((Excel.PivotItem)pivotField.PivotItems(i)).ShowDetail = false; } pivotField.Caption = "Месяц"; pivotField = (Excel.PivotField)pivotTable.PivotFields("OrderDate"); pivotField.Orientation = Microsoft.Office.Interop.Excel.XlPivotFieldOrientation.xlColumnField; pivotField.Caption = "Дата заказа"; // поля строк pivotField = (Excel.PivotField)pivotTable.PivotFields("SalesPerson"); pivotField.Orientation = Microsoft.Office.Interop.Excel.XlPivotFieldOrientation.xlRowField; pivotField.Caption = "Продавец"; pivotField = (Excel.PivotField)pivotTable.PivotFields("Country"); pivotField.Orientation = Microsoft.Office.Interop.Excel.XlPivotFieldOrientation.xlRowField; pivotField.Caption = "Страна"; pivotField = (Excel.PivotField)pivotTable.PivotFields("City"); pivotField.Orientation = Microsoft.Office.Interop.Excel.XlPivotFieldOrientation.xlRowField; pivotField.Caption = "Город"; pivotField = (Excel.PivotField)pivotTable.PivotFields("ProductName"); pivotField.Orientation = Microsoft.Office.Interop.Excel.XlPivotFieldOrientation.xlRowField; pivotField.Caption = "Изделие"; // // поля данных pivotField = pivotTable.AddDataField(pivotTable.PivotFields("Quantity"), "Кол-во", Microsoft.Office.Interop.Excel.XlConsolidationFunction.xlSum); //pivotField.Function = Microsoft.Office.Interop.Excel.XlConsolidationFunction.xlSum; // возможна персональная настройка формата вывода данных (не забываем о "культуре") // pivotField = pivotTable.AddDataField(pivotTable.PivotFields("ExtendedPrice"), "Сумма продаж", Microsoft.Office.Interop.Excel.XlConsolidationFunction.xlSum); // настроим "культуру" на англ., чтоб не зависить от локальных настроек int savedCult = Thread.CurrentThread.CurrentCulture.LCID; Thread.CurrentThread.CurrentCulture = new CultureInfo(0x0409, false); Thread.CurrentThread.CurrentUICulture = new CultureInfo(0x0409, false); try { // установим "американский" формат данных pivotField.NumberFormat = "#,##0.00"; // возможно задать формат сразу всей области даных! //pivotTable.DataBodyRange.NumberFormat = "#,##0.00"; } finally { // восстановим пользовательскую "культуру" для отображения всех данных в // привычных глазу форматах Thread.CurrentThread.CurrentCulture = new CultureInfo(savedCult, true); Thread.CurrentThread.CurrentUICulture = new CultureInfo(savedCult, true); } // убираем спиcок полей с экрана xlApp.ActiveWorkbook.ShowPivotTableFieldList = !(pivotTable.Version == Microsoft.Office.Interop.Excel.XlPivotTableVersionList.xlPivotTableVersion10); // рассчитаем таблицу pivotTable.ManualUpdate = false; xlApp.ActiveWorkbook.Saved = true; } finally { // отсоединяемся от Excel'я pivotField = null; pivotTable = null; pivotCashe = null; oSheet = null; xlApp.Interactive = true; xlApp.ScreenUpdating = true; xlApp.UserControl = true; xlApp = null; button1.Enabled = true; label1.Visible = false; } } private void Form1_FormClosing(object sender, FormClosingEventArgs e) { e.Cancel = !button1.Enabled; } } } Статья показывает лишь небольшие возможности Сводного отчета. Незатронутыми остались вопросы по созданию расчетных полей, сводных диаграмм и т.д.
Проект создавался и тестировался на Delphi 7, BDS 2006 и Excel2003. Исходные тексты программы на Delphi, база данных и пример отчета находятся в архиве PivotTable.zip. Исходные тексты на C# (VS2005) и база данных находятся в архиве WinApp1.zip. Более детальную информацию можно получить из файла vbaxl9.chm для Microsoft Excel 2000 или vbaxl10.chm для Microsoft Excel 2002, или с сайтов:
К материалу прилагаются файлы:
Реализация простейшего алгоритма распознавания графических образов.
Юрий Кисляков, Королевство ДельфиНа написание данного материала меня подвигла одна, нередко встречающаяся в ответах на вопросы круглого стола, фраза: "Если задумал написать свой … - даже не берись. Дело безнадежное. Это не для одиночек, и тем более не для начинающих (нужна команда серьезных математиков и программистов). Что касается различных "know how", то вряд ли владеющий ими поделится с кем-либо. Такая информация стоит бооольших денег..." На реализацию предлагаемого алгоритма у меня ушло примерно 15 часов.
Вашему вниманию предлагается программа распознавания рукописных прописных русских букв и цифр на основе метода сравнения с эталонными изображениями соответствующих символов.
Данный подход может быть использован для написания собственных модулей распознавания символов (в том числе рукописных) в разрабатываемом прикладном ПО.
Ниже приведены основные моменты реализации предлагаемого алгоритма.
Шаг 1. Создание канвы для рисования и формирование ее образа в памяти.
В качестве канвы используем класс TBitmap (для простоты работы с битмапом используем режим 1 байт на пиксель, т.е. TBitmap.PixelFormat := pf8bit), визуализируем его на TPaintBox, отображаем в памяти при помощи структуры: type MasX = PByteArray; var MasY : array of MasX // массив пикселей, { где MasY[y-коорд][x-коорд] = номер цвета в палитре цветов (при 8 бит/пиксель). Отображение осуществляем с использованием TBitmap.ScanLine (быстро и просто): SetLength(MasY, TBitmap.Height); for j := 0 to TBitmap.Height - 1 do MasY[j] := TBitmap.ScanLine[j]; } Теперь с картинкой в виде матрицы XxY можно делать все что угодно…
Шаг 2. Формирование массива эталонных образцов символов.
Эталонные образцы будем формировать на основе матрицы размером 16х16. Для этого разработаем процедуру генерации такой матрицы по произвольному изображению эталона.
Процедура function Create_16x16(Img : TBitmap) : TMas16x16 получает в качестве параметра ссылку на картинку, на которой нарисован эталон символа (в нашем случае - программно), возвращает приведенную матрицу размером 16х16.
Кратко поясним работу процедуры (более полно см. комментарии в программе).
Шаг 3. Распознавание рисованных (от руки) символов.
Распознавание осуществляем путем сравнения матрицы 16х16 распознаваемого символа с матрицей эталона (путем перебора имеющихся в наличии). Сравнение производим поэлементно при помощи оператора XOR. Результат - матрица 16х16, содержащая единицы в местах несовпадений тест-символа и эталона. Путем подсчета количества несовпадений формируем вектор, содержащий эту информацию для каждого эталонного символа, и производим сортировку эго элементов по возрастанию количества несовпадений.
Параметр (1 - Result[i]/256)*100%, где Result[i] - кол-во несовпадений для i - го символа, показывает "вероятность" соответствия образа конкретному символу.
Демонстрационная программа.
Пример работы демонстрационной программы
Что дальше?
Данный алгоритм как простейший обладает рядом существенных ограничений.
Для повышения точности распознавания отдельных символов (не слов, - это другая задача, в каком-то смысле более простая), необходимо проводить дополнительный анализ значимых признаков, например симметричность образа (горизонтальная, вертикальная), наличие замкнутых областей (О, В, Д, Р и др.), количество отрезков и дуг, их взаимное расположение и ориентация (требуется векторизация изображения).
Буду рад, если этот материал кому-то пригодится.
К материалу прилагаются файлы:
Delphi - сбориник статей
Немного математики
Разумеется, для простоты мы будем рассматривать только черно-белые изображения. Пусть у нас рисунок состоит всего из двух пикселей. Тогда множество всех объектов, которое можно будет изобразить (универсальное множество), состоит из четырех объектов: (0,0), (0,1), (1,0), (1,1), где 1 — черный пиксель, 0 — белый.
Рисунок 1 Все объекты универсального множества можно разместить в вершинах единичного квадрата, таким образом, множеству фигур, изображенных на двухпиксельном поле, может быть сопоставлено множество точек в двумерном пространстве. Ребру этого квадрата будет соответствовать переход от одного изображения к другому. Для перехода от (1,1) к (0,0) нужно будет пройти два ребра, для перехода от (0,1) к (0,0) — одно. Отметим, что число ребер в нашем переходе — это количество несовпадающих пикселей двух изображений. Вывод интересный: расстояние от одного рисунка до другого равно числу несовпадающих пикселей в них. Это расстояние называется расстоянием по Хэммингу.
Рисунок 2 Теперь представим себе, что у нас рисунок состоит из трех пикселей. Коды изображений тогда будут состоять из трех значений, универсальное множество — из восьми элементов, которые мы разместим в вершинах единичного куба. Но принципиально ничего не изменится, и расстояние по Хэммингу вычисляется так же. В приложенной тестовой программе используется рисунок 50х70 = 3500 пикселей. Легко сообразить, что в этом случае код любого изображения состоит из 3500 значений, универсальное множество — из 23500 = 4,027 * 101053 элементов, которые мы будем размещать в вершинах единичного 3500-мерного куба. Представить себе такой 3500-мерный куб нелегко, но смысл от этого не меняется абсолютно. Основная идея заключается в том, что в этом многомерном кубе изображения, соответствующие какому-то определенному образу, лежат недалеко друг от друга. Эта идея получила название "Гипотеза о компактности образов".
Рисунок 3 Теперь можно сформулировать задачу: нужно универсальное множество разбить на "куски", компактные множества, каждому из которых соответствует образ.
Программа
Итак, при запуске программы в массив Data: array of array [0..9] of TBitmap; записываются цифры от 0 до 9, написанные следующими шрифтами: Arial, Century Gothic, Courier New Cyr, Goudy Old Style и Times New Roman — всего пять комплектов (можно легко увеличить). Все эти изображения были сохранены мною и заботливо выложены в папку \fonts (более опытный программист, нежели я, наверняка сделал бы отрисовку, чтобы не мучаться с файлами).| Procedure LoadData; var i,j:integer; path:string; begin SetLength(Data,5); for i := 0 to 4 do begin path := ExtractFilePath(Application.ExeName)+'\fonts\'; case i of 0: path := path + 'Arial\'; 1: path := path + 'Century Gothic\'; 2: path := path + 'Courier New Cyr\'; 3: path := path + 'Goudy Old Style\'; 4: path := path + 'Times New Roman\'; end; for j := 0 to 9 do begin Data[i,j] := TBitmap.Create; Data[i,j].LoadFromFile(path + IntToStr(j) + '.bmp'); end; end; end; |
После загрузки эталонных изображений пользователь рисует на поле размером 50х70 пикселей цифру, которую программа будет распознавать. При нажатии кнопки "распознать" высчитываются расстояния от распознаваемого рисунка до каждого из эталонных (расстояние по Хэммингу).
| function Compare( b1,b2:TBitmap):integer; var i,j,count:integer; begin count := 0; for i := 0 to 49 do for j := 0 to 69 do if b1.Canvas.Pixels[i,j] <> b2.Canvas.Pixels[i,j] then inc(count); Result := count; end; |
Зная это расстояние R, легко вычислить потенциал, создаваемый каждым эталонным рисунком в точке, соответствующей нарисованному пользователем изображению. Я немного изменил формулу расчета потенциала, чтобы избежать деления на 0 в случае R=0 и для лучшего восприятия домножил на 1 000 000:
Рисунок 5 Потенциалы, создаваемые нулями всех начертаний, суммируются в p[0], единицами — в р[1] и так далее.
| for i := 0 to 4 do for j := 0 to 9 do begin r := Compare(Image1.Picture.Bitmap,Data[i,j]); p[j] := p[j] + 1000000/(1+r*r); end; |
После всего этого остается найти, какому образу соответствует наибольший потенциал.
Рисунок 6
Реализация
А собственно реализация проста до безобразия, если вы разобрались в математической части. Программе в процессе обучения сообщаются изображения (точки многомерного куба) и указания, к какому образу каждое изображение относится. При распознавании программа просто смотрит, в какую из известных компактных областей попало входное изображение. Скорее всего, все указанные машине изображения лягут более-менее компактно, поэтому универсальное множество будет можно разделить. Собственно разделять универсальное множество мы не будем, а будем пользоваться некоторой характеристикой, которая показывает удаленность одного рисунка (точки в вершине многомерного куба) до группы таких же изображений. В качестве меры удаленности рисунка от группы рисунков используется потенциал.Известно, что электрический заряд создает вокруг себя поле, одной из характеристик которого является потенциал. В любой точке он может быть вычислен по формуле
Рисунок 4 где a — некоторый постоянный коэффициент, q — величина заряда, R — расстояние от данной точки до заряда. Если электрическое поле образовано двумя или более зарядами, то потенциал в данной точке равен сумме потенциалов каждого заряда. Аналогия очевидна — каждый рисунок, на котором программа обучалась, создает в пространстве универсального множества потенциал. После обучения программе дают распознать какой-либо рисунок (точку в вершине многомерного куба), программа вычисляет потенциал, создаваемый в этой точке всеми объектами образа "а", образа "б"… на которых программу учили и распознаваемый рисунок относится к образу, который создал наибольший потенциал.
Вступление
На написание этого опуса меня спровоцировала статья Юрия Кислякова , который, по моему скромному мнению очень удачно начал мысль о том, что распознавание образов не есть что-то сверхсуперсложное, не поддающееся разуму простых смертных. Давным-давно уже во многих областях техники используются различные автоматы и устройства, более или менее удачно решающие задачу распознавания (это и автомат для сортировки почтовых конвертов по индексу, и зенитная ракета, захватывающая горячее сопло самолетного двигателя, но игнорирующая солнце, и различные системы анализа спутниковых снимков, и голосовой вызов вашего мобильника, и многое-многое другое), тем не менее, людей, уверенных в непреодолимой сложности алгоритмов, очень много. В статье Юрия, однако, есть одно сильное, на мой взгляд, упущение: его программу невозможно обучать, т.к. у него сравнение происходит только с одним набором эталонов. Предложу вашему вниманию алгоритм, который можно обучать. Особую пикантность алгоритму придает тот факт, что его математическое обоснование было предложено советскими математиками в начале 60х годов (т.е. в то время, когда компьютер не всегда помещался в среднестатистической квартире), а еще лет через 15 была доказана его весьма глубокая аналогия с очень популярным в настоящее время нейросетевым методом. Итак,Предложенный метод дает весьма неплохие
Предложенный метод дает весьма неплохие результаты как на машинописных, так и на рукописных цифрах. Алгоритм легко может быть переобучен для различения других символов (латинских/русских букв, знаков препинания и т.п.). Для повышения надежности распознавания можно предусмотреть сильно различающиеся между собой эталоны (для того, чтобы как можно сильнее разбросать эталонные точки в пределах компактного множества). Для распознавания цифр я еще использовал такой прием: исходный рисунок разбивался на 7 участков по вертикали и 5 по горизонтали, участок целиком заливался белым либо черным в зависимости от того, каких пикселей участок содержал больше, после чего работа с каждым участком происходила как с пикселем. Очевидно, что после такого фокуса 99.9% восьмерок, написанных и от руки, и машинописных, будут иметь вид
Рисунок 7 после чего работать с таким изображением легко и приятно.
Буду очень рад, если моя статья кому-то будет полезна.
К материалу прилагаются файлы:
Delphi - сбориник статей
ДОПОЛНЕНИЯ
В этой части собраны дополнения, которые не вошли в стандарт Borland. Эти дополнения взяты из правил JCL и опыта российских разработчиков.Const, Var и Type
Зарезервированные слова var, const и type всегда пишутся на новой строке и не допускают появления на этой же строке какого-либо текста.
Правильно
| type TMyType = Integer; const MyConstant = 100; var MyVar: Integer; |
Неправильно
| type TMyType = Integer; const MyConstant = 100; var MyVar: Integer; |
Процедуры должны иметь только по одной секции type, const и var в следующем порядке:
| procedure SomeProcedure; type TMyType = Integer; const ArraySize = 100; var MyArray: array [1..ArraySize] of TMyType; begin ... end; |
Директивы условной компиляции
Все директивы условной компиляции должны быть собраны в одном модуле ХХX.INC. Этот файл предназначен для определения глобальных директив. Оператор include должен быть помещен между ключевыми словами unit и interface. Никто не может мождифицировать файл ХХX.INC по собственному желанию.
Строковые ресурсы
Все строковые ресурсы должны иметь вид "Rs"[Category][Name]. [Category] должно быть аббревиатурой или названием категории кода, где используется строка. [Name] должно быть именем строки ресурса. Например, конструктор TJclCriticalSectionEx.CreateEx вызывает исключительную ситуацию при ошибке инициализации. Сообщение об ошибке объявляется в глобальном модуле ХХXResources.pas с именем RsynchInitCriticalSection.
Все строки должны быть исключены из кода и заменены на константы. Исключением из этого правила являются строки, которые являются какими-либо командами или от них будет зависеть поведение экземпляров класса. Такие строки должны быть явно объявлены в каком-либо из методов класса.
Исключения
Все исключения должны начинаться с префикса EХХХ. Все исключения должны быть отнаследованны от класса ENхError. При возбуждении исключительной ситуации предпочтительным является ее создание с помощью метода CreateRes:
| raise EХХХSomeException.CreateRes(@RsSomeResourceString); |
Категории и разделение алгоритмов
Обычно, содержимое каждого созданного модуля есть набор классов, функций и процедур, принадлежащих к одной категории. Например, ХХХLogin содержит все, что относится к идентификации и персонификации пользователя. Для ясного восприятия исходного кода следует придерживаться следующего правила: в интерфейсной части модуля каждая группа функций, относящихся к одной субкатегории должны отделяться от другой группы функций тремя строками шириной 80 столбцов с описанием субкатегории на второй строке:
| 1 2 Информация о последней попытке идентификации 3 procedure GetLastUserName(var ZUser: string); procedure GetLastDatabase(var ZDatabase: string); |
В секции реализации каждая подкатегория или класс должен разделяться строкой, состоящей из символов равенства (=), закомментированных однострочным комментарием и пустой строкой перед и после группы функций:
| //================================================= procedure GetLastUserName(var ZUser: string); begin ... end; procedure GetLastDatabase(var ZDatabase: string); begin ... end; //================================================== |
Каждая функция из одной группы или методы класса должны разделяться между собой строкой, состоящей из символов минуса (-), закомментированных однострочным комментарием и пустой строкой перед и после функции или метода:
| //================================================== procedure GetLastUserName(var ZUser: string); begin ... end; //-------------------------------------------------- procedure GetLastDatabase(var ZDatabase: string); begin ... end; //================================================== |
Ассемблер
Локальные процедуры
Локальные функции и процедуры должны иметь стандартный отступ в два пробела вправо от их владельца и сама процедура должна выделяться пустыми строками по одной перед и после локальной процедуры. Если "внешняя" процедура имеет локальные переменные, то они должны декларироваться перед локальной процедурой, независимо от того, будет ли в локальной процедуре осуществляться доступ к ним или нет. Однако общие соображения таковы, что локальных процедур следует избегать.
| procedure SomeProcedure; var I: Integer; procedure LocalProcedure; begin ... end; begin ... LocalProcedure; ... end; |
Объявление параметров
Когда объявляется список параметров для процедуры, функции или метода пользуйтесь следующими рекомендациями:
Глобальные переменные, как и члены класса всегда инициализируются нулем. Это трудно для понимания в случае разных типов. Например Integer инициализируется в 0, а pointer в nil. Для этого рекомендуется указывать в комментарии как инициализируется переменная.
| var MyGlobalVariable: Pointer // = nil; |
Несмотря на то, что глобальные переменные разрешены языком Object Pascal, используйте их лишь в самых крайних случаях.
ФАЙЛЫ ИСХОДНОГО КОДА
Исходный код Object Pascal подразделяется на модули и файлы проекта, которые подчиняются одинаковым соглашениям. Файл проекта Delphi имеет расширение DPR. Этот файл является главным исходным файлом для всего проекта. Любые модули, используемые в проекте, всегда будут иметь расширение PAS. Дополнительные файлы, используемые в проекте (командные, html, DLL и т.д.) могут играть важную роль, но эта глава описывает форматирование только PAS и DPR файлов.Именование исходных файлов
Язык Object Pascal поддерживает длинные имена файлов. Если при создании имени Вы используете несколько слов, то необходимо использовать заглавную букву для каждого слова в имени: MyLongName.pas. Этот стиль оформления известен как InfixCaps или CamelCaps. Расширения файлов должны быть в нижнем регистре. Исторически, некоторые исходные файлы Delphi именуются по шаблону 8.3, но в настоящее время разработчики не обязаны придерживаться этого ограничения.
Если Вы осушествляете перевод заголовочных файлов C/C++, то паскалевский эквивалент должен иметь тоже самое имя и расширение PAS. Например Windows.pas. Если правила грамматики языка Object Pascal требуют объединения нескольких транслированных файлов в один, то используйте имя того файла, в который Вы вкладываете остальные. Например: если WinBase.h вкладывается в Windows.h, то результирующее имя будет Windows.pas.
Все файлы модулей, созданные в организации ХХХ должны иметь префикс ХХХ Организация исходных файлов
Все модули Object Pascal могут содержать следующие элементы в определенном порядке:
| {************************************************************} { } { Модуль ХХХ } { Copyright (c) 2001 ООО ХХХХ } { отдел/сектор } { } { Разработчик: ХХ ХХ } { Модифицирован: 25 июня 2001 } { } {************************************************************} unit Buttons; |
Директивы компилятора не следует напрямую включать в исходный код. Для этого следует воспользоваться определением включений и подключить глобальный для проекта файл с директивами компилятора:
| {$I NX.INC} interface |
В случае необходимости, можно напрямую переопределить глобальные директивы компилятора. Следует помнить, что переопределяющие директивы должны быть документированы и Вы должны постараться ограничиться только локальным переопределением. Например для одной процедуры:
| {$S-,W-,R-} {$C PRELOAD} interface uses Windows, Messages, Classes, Controls, Forms, Graphics, StdCtrls, ExtCtrls, CommCtrl; |
Секции определения типов и констант Вы можете располагать относительно друг друга как Вам угодно. Секция реализации должна начинаться с ключевого слова implementation, затем объявление используемых модулей (Uses clause), затем любые включение файлов или другие директивы.
| implementation uses Consts, SysUtils, ActnList, ImgList; {$R BUTTONS.RES} |
Копирайт и комментарий
Пример заголовка для модуля:
| {************************************************************} { } { Модуль ХХХ } { Copyright (c) 2001 ООО ХХХХ } { отдел/сектор } { } { Разработчик: ХХ ХХ } { Модифицирован: 25 июня 2001 } { } {************************************************************} |
Следует обратить внимание на элементы заголовка:
Каждый исходный файл должен содержать объявление модуля. Слово unit является ключевым, поэтому оно должно быть написано в нижнем регистре. Имя модуля может содержать символы как в верхнем, так и в нижнем регистре и должно быть таким же, как и имя используемое для этого файла операционной системой. Например:
unit MyUnit; Этот модуль будет назван MyUnit.pas, когда он будет сохранен операционной системой Объявление используемых модулей
Внутри модуля объявление используемых модулей должно начинаться со слова uses в нижнем регистре. Затем следуют наименования модулей с сохранением регистра символов:
uses MyUnit; Каждый используемый модуль должен отделяться от следующего с помощью запятой. Объявление используемых модулей должно заканчиваться точкой с запятой. Список используемых модулей необходимо располагать на следующей строке после слова uses. Если используются модули из разных проектов или производителей, то необходимо сгруппировать модули по проектам или производителям и каждую новую группу начинать с новой строки и снабжать комментариями:
| uses Windows, SysUtils, Classes, Graphics, Controls, Forms, TypInfo // модули Delphi , XХХMyUnit1, ХХXMyUnit2; // модули ХХХ |
Если список используемых модулей не умещается по ширине в 80 символов, то его необходимо перенести на следующую строку. Объявление классов и интерфейсов
Объявление класса начинается с двух пробелов, затем идет идентификатор класса с префиксом Т в нотации InfixCaps. Ни в коем случае в исходных файлах Object Pascal нельзя использовать табуляцию:
TMyClass Следом за идентификатором класса идет пробел, знак равенства, пробел и слово class в нижнем регистре: TMyClass = class Если необходимо определить родителя класса, то следует добавить открывающую скобку, имя класса-родителя и закрывающую скобку: TMyClass = class(TObject) Объявления областей видимости начинаются с двух пробелов и, следовательно, области видимости распологаются на одном уровне с идентификатором класса:
| TMyClass = class(TObject) private protected public published end; |
Данные всегда должны располагаться только в приватной секции и названия переменных должны всегда начинаться с префикса F. Все объявления внутри класса должны начинаться с четырех пробелов:
| TMyClass = class(TObject) private FMyData: Integer; function GetData: Integer; procedure SetData(Value: Integer); public published property MyData: Integer read GetData write SetData; end; |
Оформление объявлений интерфейсов подчиняется тем же правилам, что и оформление классов. Отличие будет в использовании ключевых слов специфичных для интерфейсов
ИНТЕРФЕЙСЫ
Все основные правила форматирования для классов применяются и для форматирования интерфейсов. Интерфейсы декларируются в той же манере, что и классы.| InterfaceName = interface([Inherited Interface]) InterfaceBody end; |
Отступ для интерфейса должен быть равен двум пробелам. Тело интерфейса имеет отступ четыре пробела. Закрывающий end должен иметь отступ в два пробела. Объявление класса заканчивается точкой с запятой. У интерфейса не существует полей, однако свойства могут присутствовать.
Все методы интерфейса являются абстрактными и общедоступными, поэтому не требуется включать слова public и abstract в объявление метода.
Структура тела интерфейса
Тело интерфейса при его декларации подчинено следующей структуре:
ИСПОЛЬЗОВАНИЕ ПРОБЕЛОВ
Использование пустых строкПустые строки могут повысить читабельность путем группирования секций кода, которые логически связаны между собой. Пустые строки должны использоваться в следующих местах:
Язык Object Pascal является очень легким для понимания языком, поэтому нет особой необходимости в использовании большого количества пробелов. Следующие пункты дадут Вам понимание того, в каком случае необходимо использовать пробелы.
Пробелы, запрещенные к использованию
Всегда необходимо использовать два пробела для всех уровней отступа. Другими словами, первый уровень отступает на два пробела, второй на четыре и так далее. Никогда не используйте символы табуляции.
Существует несколько исключений из этого правила. Зарезервированные слова unit, uses, type, interface, implementation, initialization и finalization всегда должны примыкать к левой границе. Также должны быть отформатированы финальный end и end, завершающий исходный модуль. В файле проекта выравнивание по левой границе применяется к словам program, главным begin и end. Код внутри блока begin..end должен иметь отступ два символа.
Перенос строк
Все строки должны быть ограничены 80 столбцами. Строки, длиннее чем 80 столбцов должны быть разделены и перенесены. Все перенесенные строки должны быть выровнены по первой строке и иметь отступ в два символа. Выражение begin всегда должно находиться на своей отдельной строке.
Пример:
Правильно
| function CreateWindowEx(dwExStyle: DWORD; lpClassName: PChar; lpWindowName: PChar; dwStyle: DWORD; X, Y, nWidth, nHeight: Integer; hWndParent: HWND; hMenu: HMENU; hInstance: HINST; lpParam: Pointer): HWND; stdcall; |
Никогда не разрывайте строку между параметром и его типом, кроме параметров, перечисляемых через запятую. Двоеточие для всех объявлений переменных не должно содержать перед собой пробелов и иметь один пробел после перед именем типа.
Правильно procedure Foo(Param1: Integer; Param2: Integer); Неправильно procedure Foo( Param :Integer; Param2:Integer ); Нельзя переносить строки в тех местах, где не допускаются пробелы, например между именем метода и открывающей скобкой или между именем массива и открывающей квадратной скобкой. Никогда нельзя помещать выражение begin на строку, содержащую другой код.
Неправильно
| while (LongExpression1 or LongExpression2) do begin // DoSomething // DoSomethingElse; end; |
Правильно while (LongExpression1 or LongExpression2) do begin // DoSomething // DoSomethingElse; end; if (LongExpression1) or (LongExpression2) or (LongExpression3) then В случае с логическими операторами предпочтительнее будет следующий вариант:
| if (LongExpression1) or (LongExpression2) or (LongExpression3) then |
КЛАССЫ
Структура тела классаТело класса при его декларации подчинено следующей структуре:
Исключая код, вставленный IDE, директивы видимости должны быть объявлены в следующем порядке:
Никогда не указывайте уровень доступа public для данных. Данные всегда должны быть объявлены в приватной секции и доступ к ним должен осуществляться с помощью методов или свойств.
Объявление конструктора
Все методы класса должны быть упорядочены по алфавиту. Однако Вы можете поместить объявления конструктора и деструктора перед всеми остальными методами. Если у класса существует более чем один конструктор и если они имеют одинаковые имена, то они должны располагаться в порядке увеличения числа параметров Объявление методов
По возможности, объявление метода должно располагаться на одной строке:
Например:
| procedure ImageUpdate(Image img, infoflags: Integer, x: Integer, y: Integer, w: Integer, h: Integer) |
Язык Object Pascal поддерживает два
Язык Object Pascal поддерживает два типа комментариев: блочные и однострочные. Общие соображение по использованию комментариев могут быть следующими:Object Pascal поддерживает два типа блочных комментариев. Наиболее часто используемый блочный комментарий - это пара фигурных скобок: { }. Команда разработчиков Delphi предпочитает использовать этот комментарий как можно проще и как запасной. Используйте в таких комментариях пробелы для форматирования текста и не используйте символы зведочка "*". При переносе строк необходимо сохранять отступы и выравнивание
Пример из DsgnIntf.pas:
| { TPropertyEditor Edits a property of a component, or list of components, selected into the Object Inspector. The property editor is created based on the type of the property being edited as determined by the types registered by... etc... GetXxxValue Gets the value of the first property in the Properties property. Calls the appropriate TProperty GetXxxValue method to retrieve the value. SetXxxValue Sets the value of all the properties in the Properties property. Calls the appropriate TProperty SetXxxxValue methods to set the value. } |
В блочный комментарий всегда заключается информация о модуле: копирайт, дата модификации и так далее. Блочный комментарий, описывающий метод должен идти перед объявлением метода.
Правильно
| { TMyObject.MyMethod This routine allows you to execute code. } procedure TMyObject.MyMethod; begin end; |
Неправильно
| procedure TMyObject.MyMethod; {****************************************************** TMyObject.MyMethod This routine allows you to execute code. *******************************************************} begin end; |
Второй тип блочного комментария содержит два символа: скобку и звездочку: (* *). Этот тип комментария используется при разработке исходного кода. Его преимуществом является то, что он поддерживает вложенные комментарии, правда комментарии должны быть разного типа. Вы можете использовать это свойство для комментирования больших кусков кода, в котором встречаются другие комментарии:
| (* procedure TForm1.Button1Click(Sender: TObject); begin DoThis; // Start the process DoThat; // Continue iteration { We need a way to report errors here, perhaps using a try finally block ??? } CallMoreCode; // Finalize the process end; *) |
Однострочные комментарии
Однострочный комментарий состоит из символов // со следующим за ними текстом комментария. После символов // должен идти пробел и затем текст. Однострочные комментарии должны иметь отступы такие же, как и код, в котором они встречаются. Однострочные комментарии можно сгруппировать, чтобы сформировать большой комментарий.
Однострочный комментарий может начинаться с новой строки и может продолжать код, который он комментирует. В этом случае между кодом и комментарием должен быть хотя бы один пробел. Если больше одного комментария следует за кодом, то они должны быть выровнены по одному столбцу.
Пример однострочного строкового комментария:
| // Open the table Table1.Open; |
Пример комментария в коде:
| if (not IsVisible) then Exit; // nothing to do Inc(StrLength); // reserve space for null terminator |
Необходимо избегать использовать комментарии в коде для каждой строки модуля.
ОПЕРАТОРЫ
Операторы - это одна или более строк кода, разделенных точкой с запятой. Простые операторы имеют одну точку с запятой, а составные могут иметь более чем одну точку с запятой и, таким образом, состоят из множества простых операторов.Это простой оператор: A := B; Это составной или структурированный оператор: begin B := C; A := B; end; Простые операторы
Простые операторы содержат одну точку с запятой. Если Вам необходимо разделить операторы, то перенесите продолжение оператора на следующую строку с отступом в два пробела:
MyValue := MyValue + (SomeVeryLongStatement / OtherLongStatement); Составные операторы
Составные операторы всегда заканчиваются точкой с запятой. begin MyStatement; MyNext Statement; MyLastStatement; end; Присвоения и выражения
Каждое присвоение и каждое выражение должно располагаться на разных строках.
Правильно a := b + c; Inc(Count); Неправильно a := b + c; Inc(Count); Объявление локальных переменных
Локальные переменные должны иметь стиль Camel Caps. Для локальных переменных префикс F не требуется. var MyData: Integer; MyString: string; Все переменные с их типами, особенно поля класса, должны быть объявлены на различных строках. Объявление массивов
В объявлении массива перед и после квадратных скобок должны стоять пробелы. type TMyArray = array [0..100] of Char; Оператор if
Оператор if всегда должен располагаться по крайней мере на двух строках
Неправильно if A < B then DoSomething; Правильно if A < B then DoSomething; В случае составного оператора необходимо поместить каждый оператор на новую строку.
Неправильно
| if A < B then begin DoSomething; DoSomethingElse; end else begin DoThis; DoThat; end; |
Правильно
| if A < B then begin DoSomething; DoSomethingElse; end else begin DoThis; DoThat; end; |
Все остальные варианты расположения операторов не рекомендуются и не одобряются, хотя и являются синтаксически правильными. Избегайте использования круглых скобок в простых проверках. Например:
Правильно if I > 0 then DoSomething; Неправильно if (I > 0) then DoSomething; Оператор for
Неправильно
| for i := 0 to 10 do begin DoSomething; DoSomethingElse; end; |
Правильно
| for i := 0 to 10 do begin DoSomething; DoSomethingElse; end; for I := 0 to 10 do DoSomething; |
Оператор while
Неправильно
| while x < j do begin DoSomething; DoSomethingElse; end; |
Правильно
| while x < j do begin DoSomething; DoSomethingElse; end; while x < j do Something; |
Оператор repeat until
Правильно
| repeat x := j; j := UpdateValue; until j > 25; |
Оператор case
Несмотря на то, что существует множество синтаксически правильных конструкций, одобренной и рекомендованной считается следующая:
Правильно
| case ScrollCode of SB_LINEUP, SB_LINEDOWN: begin Incr := FIncrement div FLineDiv; FinalIncr := FIncrement mod FLineDiv; Count := FLineDiv; end; SB_PAGEUP, SB_PAGEDOWN: begin Incr := FPageIncrement; FinalIncr := Incr mod FPageDiv; Incr := Incr div FPageDiv; Count := FPageDiv; end; else Count := 0; Incr := 0; FinalIncr := 0; end; |
Оператор try
Несмотря на то, что существует множество синтаксически правильных конструкций, одобренной и рекомендованной считается следующая:
Правильно
| try try EnumThreadWindows(CurrentThreadID, @Disable, 0); Result := TaskWindowList; except EnableTaskWindows(TaskWindowList); raise; end; finally TaskWindowList := SaveWindowList; TaskActiveWindow := SaveActiveWindow; end; |
СОГЛАШЕНИЕ ОБ ИМЕНОВАНИЯХ
Исключая зарезервированные слова и директивы, которые всегда пишутся в нижнем регистре, все идентификаторы Object Pascal должны использовать InfixCaps:MyIdentifier MyFTPClass Самое главное исключение для всех правил состоит в использовании оттранслированных заголовочных файлов С/С++. В этом случае всегда используются соглашения, принятые в файле источнике. Например будет использоваться WM_LBUTTONDOWN, а не wm_LButtonDown.
Для разделения слов нельзя использовать символ подчеркивания. Имя класса должно быть именем существительным или фразой с именем существительным. Имена интерфейсов или классов должны отражать главную цель их создания:
Правильно: AddressForm ArrayIndexOutOfBoundsException Неправильно: ManageLayout (глагол) delphi_is_new_to_me (подчерк) Именование модулей
Смотрите пункт 2.1. Именование классов и интерфейсов
Смотри объявление классов и интерфейсов. Именование полей
При именовании полей всегда необходимо использовать InfixCaps. Всегда объявлять переменные только в приватных частях и использователь свойства для доступа к переменным. Для переменных использовать префикс F.
Имена процедур для установки/получения значений свойств должны составляться по правилу: для получения - Get+имя свойства; для установки - Set+имя свойства.
Переменные цикла именуются I и J. Другие случаи использования однобуквенных переменных это S (строка) и R (результат). Однобуквенные имена должны всегда использовать символ в верхнем регистре, но лучше использовать боле значимые имена. Не рекомендуется использовать переменную l (эль), потому что она похожа на 1 (единица).
Именование методов
При именовании полей всегда необходимо использовать стиль InfixCaps. Не допускается использование символов подчеркивания для разделения слов. В имени метода всегда должна содержаться команда к действию или глагольная фраза
Правильно: ShowStatus DrawCircle AddLayoutComponent Неправильно: MouseButton (Существительное, не описывает функцию) drawCircle (Начинается с маленькой буквы) add_layout_component (Используются символы подчерка) ServerRunning (Глагольная фраза, но без команды) Обратите внимание на последний пример (ServerRunning) - непонятно, что делает этот метод. Этот метод может использоваться для запуска сервера (лучше StartServer) или для проверки работы сервера (лучше IsServerRunning).
Методы для установки или получения значений свойств должны именоваться Get+имя свойства и - Set+имя свойства.
Например: GetHeight, SetHeigh
Методы для теста/проверки булевских свойств класса должны именоваться с префиксом Is+имя свойства.
Например: IsResizable, IsVisible
Именование локальных переменных
Имена всех локальных переменных должны подчиняться тем же правилам, которые установлены для именования полей, исключая префикс F.
Зарезервированные слова
Зарезервированные слова и директивы должны быть все в нижнем регистре. Производные типы должны начинаться с большой буквы (Integer), однако string - это зарезервированное слово и оно должно быть в нижнем регистре.
Объявление типов
Все объявления типов должны начинаться с префикса Т и должны придерживаться правил, приведенных при описании оформления модуля или описании оформления класса.
Этот стандарт документирует стилевое оформление
Этот стандарт документирует стилевое оформление для форматирования исходного кода Delphi. Оригинал статьи создан Чарльзом Калвертом и расположен на . В стандарте использованы материалы команды разработчиков Delphi, сообщества разработчиков библиотеки JEDI. Стандарт так же дополнен некоторыми правилами, созданными на основе собственного опыта разработки.Object Pascal является замечательно спроектированным языком. Одним из его многочисленных достоинств является легкая читабельность. Предлагаемый стандарт позволит еще более повысить легкость чтения кода Object Pascal. Следование довольно простым соглашениям, приведенным в этом стандарте, позволит разработчикам понять, что унифицированное оформление намного повышает читабельность и понятность кода. Использование стандарта намного облегчит жизнь во время этапов разработки и тестирования, когда довольно часто приходится подменять друг друга и разбираться в чужом коде.
Процесс перехода с собственного стиля оформления на предлагаемый может оказаться непростым, но человеческий мозг довольно легко адаптируется к стандартам и находит пути для быстрого запоминания предлагаемых правил. В дальнейшем, следование стандарту не вызывает затруднений. Для более комфортабельного перехода на этот стандарт предагается воспользоваться свободно распространяемой утилитой для форматирования исходных текстов .
Хочется отметить, что в компании Borland, на Web-сайте компании Borland, на CD, купленных у компании Borland, везде где есть исходный код, стандарт форматирования является законом.
Этот документ не является попыткой определить грамматику языка Object Pascal. Например, если Вы попытаетесь поставить точку с запятой перед выражением else, то компилятор не позволит Вам этгого сделать. Этот документ говорит Вам, как нужно поступать, когда есть возможность выбора из многих вариантов при оформлении Вашего исходного кода.
Delphi - сбориник статей
Дальнейшие планы
Дальнейших планов много.Выражаю благодарность Шилову Сергею за комментарии к статье.
Скачать архив: (183 K)
и синтаксических анализаторов теперь станет
Давно назревавшие изменения наконец-то были сделаны.Изготовление лексических и синтаксических анализаторов теперь станет (на взгляд автора) несколько более удобным. Возможно, это изменит ситуацию, когда бытует мнение, что "компиляторы пишут только на C!" и можно будет теперь делать это на Delphi.
Автору будет очень приятно знать, что его работа кому-то оказалась полезной.
Изменение TP Lex & Yacc
Дмитрий Соломенников,Статья предполагает знакомство читателей с основами лексического и синтаксического анализа, пакетом TP Lex&Yacc, и, разумеется, Delphi.
Работая над несколькими проектами в Delphi, автору пришлось сделать немало лексических и синтаксических анализаторов с помощью пакета TP Lex/Yacc. Оставив за рамками статьи обсуждение вопроса "Почему это не сделать на C (C++)?", попробую показать проблемы, с которыми пришлось столкнулся и решение, которое позволило мне преодолеть большую часть из них. Сразу скажу, что я описываю готовое решение, которое работает в нескольких проектах. Название ему - OLex и OYacc. Название дано по аналогии с реализацией пакета TP Lex&Yacc для Linux под Free Pascal. Там программы называются plex и pyacc соответственно. Приставка "O" означает объекты.
Новые директивы OLex и OYacc
Ниже приведен список директив, реализующих нововведения.Директивы OLex
%scannername <имя>
Директива задает имя сканера. Имя <имя> будет вставлено везде, где появляется название сканера; название сканера будет T<имя>Scanner. Например, если указать в коде .L файла %scannername Advanced, то любое упоминание названия сканера будет выглядеть как TAdvancedScanner.
%useslist <список имен>
Директива задает список используемых сканером библиотек. <список имен> представляет собой список идентификаторов через пробел. Например, если указать в коде .L файла %useslist LexLib Unit1 Unit2, то в результирующем файле появится строка uses LexLib, Unit1, Unit2;. Директива рассчитана на то, что хотя бы одна библиотека (OLexLib) в этом списке будет, а потому она обязательно должна присутствовать в .L файле.
Директивы OYacc
%parsername <имя>
Директива задает имя парсера. Имя
%scannername
Директива задает название сканера, сгенерированного программой OLex. В результирующем файле создается инфраструктура использования сгенерированного сканера и указывается его имя. Формат такой же, как и у директивы %scannername в OLex.
%noscanner
Предполагается, что парсер использует поток токенов, поступающих от сканера. Сканер может генерироваться программой OLex, а может быть написан разработчиком транслятора. И в том, и в другом случае обращение парсера за следующим токеном происходит посредством обращения к свойству yylex сгенерированного класса. То, в свою очередь, вызывает метод чтения Getyylex. Директива %noscanner определяет, как реализуется метод Getyylex. В случае, если директива в .Y файле отсутствует, то будет использоваться метод, который обращается ко встроенному сканеру (сгенерированному OLex-ом); в противном случае разработчик должен сам объявить и реализовать метод. Делается это посредством включения нижеуказанного кода в .Y файл:
function T@@ParserName@@Parser.Getyylex: Integer;
begin
<Здесь должен быть код лексического анализатора>;
end;
Код этот должен располагаться после второго разделителя %%. Назначение символов @@ раскрывается ниже.
%tokenfile <имя>
Если в исходном .Y файле определены токены через директиву %token, то в генерируемый файл добавляются конструкции вида const token_name=<число>. Кроме того, если у токенов определить тип, то кроме списка токенов в генерируемый файл вставляется также и определение типа YYSType. И то, и другое требуется знать лексическому анализатору, чтобы выдавать и токен, и его значение (посредством поля yylval). Однако, возникла циклическая зависимость модулей сканера и парсера. Обоим надо иметь определения констант и типа YYSType; созданием же этой информации занимается генератор парсера. Поэтому было принято решение о выносе констант и определения файлов в отдельный файл. Имя этого файла и задает директива %tokenfile. Если директиву не задать, то будет сгенерирован файл tokens.pas, иначе будет сформирован файл с названием <имя>.pas. Файл токенов строится на основе нового файла-шаблона yyotoken.cod.
%useslist <список имен>
Директива имеет тот же смысл, что и в .L файле.
Подстановки второго этапа
Новые директивы относятся к первому этапу обработки входного файла. Второй этап состоит в том, что генератор раскрывает подстановки вида @@<текст>@@. Здесь <текст> зависит от генератора.Подстановки Lex
@@UNITNAME@@
Имя сгенерированного файла без расширения. Используется для записи имени модуля и берется из имени .L файла.
@@SCANNERNAME@@
Название сканера, задаваемое директивой %scannername. Заменяется на , указываемое после директивы.
@@USESLIST@@
Список библиотек, используемых сканером. Представляет собой строку вида "name1, name 2, name3". Здесь name1, name2, name3 - элементы списка "%useslist name1 name2 name3".
@@DATE@@
Текущая дата. Полезно для установки даты создания файла в шапке.
Подстановки Yacc
@@UNITNAME@@
Имя сгенерированного файла без расширения. Используется для записи имени модуля и берется из имени .Y файла.
@@PARSERNAME@@
Название парсера, задаваемое директивой %parsername. Заменяется на <имя>, указываемое после директивы.
@@SCANNERNAME@@
Название сканера, задаваемое директивой %scannername. Заменяется на , указываемое после директивы.
@@USESLIST@@
Список библиотек, используемых парсером. Представляет собой строку вида "name1, name 2, name3" Здесь name1, name2, name3 - элементы списка "%useslist name1 name2 name3".
@@USESCANNERDEFINE@@ Заменяется на строку "{$DEFINE UseOLexScanner}", если директива %noscanner НЕ задана и на строку "{.$.DEFINE UseOLexScanner}", если директива %noscanner задана.
@@DATE@@
Текущая дата. Полезно для установки даты создания файла в шапке.
История
Занимаясь разработкой трансляторов на Delphi, рано или поздно сталкиваешься с пакетом TP Lex and Yacc (автор Albert Graef). Пакет этот максимально повторяет оригинальные Lex и Yacc, генерирующие код на языке C. Этот факт при переходе на язык Pascal порождает ряд проблем, а точнее неудобств, которые связаны с различиями в трансляции и структуре языков C и Pascal. Оригинальный Yacc, равно как и TP Yacc, генерируют выходной файл, содержащий функцию yyparse. Тоже самое делает и Lex. И если в языке C полученный файл является самодостаточной синтаксической единицей, то в Pascal этот файл еще надо как-то "прикрутить" к проекту. Вариантов сделать это не так много. В Pascal объявление функции должно находиться в том же синтаксическом модуле, что и ее реализация, поэтому сгенерированный файл либо сам должен быть модулем, либо должен включаться в уже заготовленный модуль директивой {$I }.В первом случае .y файл выглядит примерно так:
%{
unit <имя файла>;
interface
uses
<список модулей>;
function yyparse: Integer;
implementation
%}
<Определения>
%%
<Продукции>
%%
end.
Во втором случае надо уже два (как минимум) файла:
файл модуля
unit <имя файла>;
interface
uses
<список модулей>;
function yyparse: Integer;
implementation
{$I
end.
и файл parser_y.y (этот файл нельзя называть parser.y, что было бы вполне логичным, из-за конфликта имен).
Оставив в стороне споры о том, на каком языке делать генераторы и тот факт, что в C включение файлов является встроенной возможностью, рассмотрим более внимательно то, что имеем.
В первом случае имеет место заметное замусоривание исходного файла анализатора, которое увеличивает сложность и без того непростого модуля транслятора. Во втором случае сильно усложняется отладка и сопровождение проекта (за счет увеличения количества файлов). В Pascal не очень приветствуются включаемые файлы - механизм их использования и отладки довольно слабый.
Проблемы
С этими сложностями можно было бы мириться, если бы не два НО.1) Генерируемые анализаторы слабо вписываются в объектную модель Delphi.
Генератор создает функцию, которая в своей работе использует дополнительный модуль (LexLib и YaccLib для лексического и синтаксического анализаторов соответственно). Встраивание анализатора-функции в проект, собранный сплошь из объектов, является весьма нетривиальной проектной задачей.
Кроме того, лексический анализатор использует консоль и текстовые файлы как источник символов. Это и медленно, и неудобно, учитывая, что сама среда Delphi и создаваемые ей программы используют механизм потоков .
Alexey Mahotkin в свое время предпринял попытку реализовать механизм потоков в Lex. Однако, на мой взгляд, этого недостаточно. Неудобства, описанные выше, все равно остаются.
2) Очень сложно сделать несколько анализаторов в одном проекте.
Использование общего кода из подключаемых модулей для нескольких анализаторов делает одновременное использование анализаторов очень проблематичным. Использовать-то их можно, но только попеременно, иначе будут нарушены все структуры, опираясь на которые ведется анализ (массивы состояний, хотя бы).
Работа с OLex и OYacc
Изменения коснулись и работы с кодом, включаемом в .L и .Y файлы. Ранее в исходном файле до первого разделителя %% можно было указывать директивы, определения и включаемый код (код вставлялся между скобок %{ %}). Теперь, в связи с тем, что генерируется класс, надо включать не исполняемый код, а некоторые определения, вставляемые в класс сканера (парсера) в раздел public.После второго разделителя можно было включать исполняемый код уже безо всяких скобок. И сейчас можно вставлять без скобок, однако, учитывая, что создается класс, код должен писаться, учитывая этот факт. В качестве примера можно посмотреть на реализацию калькулятора expr из примеров TP Lex & Yacc посредством OYacc (см. папку example)
expr.y:
...
%{
x : array [1..26] ofReal;
procedure Execute;
%}
%useslist OYaccLib ExprLex Tokens
...
%%
...
%%
procedure T@@ParserName@@Parser.Execute;
var
i : Integer;
begin
for i := 1 to 26 do x[i] := 0.0;
if yyparse=0 then { done };
end;
Код для процедуры Execute полностью копируется в генерируемый файл, и на втором этапе работы @@ParserName@@ будет заменено названием, заданным директивой %parsername (или удалено, если директива не указана).
Список подключаемых модулей должен включать модуль Tokens или модуль, определенный директивой %tokenfile последним для того, чтобы была определен тип YYSType. Delphi берет определения из того модуля, который указан в uses последним.
Кроме того, в генерирумых файлах создаются функции, которые позволяют создать экземпляры анализаторов. Для лексического анализатора функция имеет название New@@ScannerName@@Scanner, для синтаксического анализатора - New@@ParserName@@Parser.
Функция New@@ScannerName@@Scanner получает на вход три параметра: указатели входной и выходной потоки и Boolean параметр _UseConsole. Третий параметр имеет значение по умолчанию False, так что на входе используются потоки. Иначе - потоки игнорируются и на входе используется консоль (процедура Readln).
Функция New@@ParserName@@Parser имеет два варианта - с параметрами или без. Какой вариант будет рабочим, определяет директива %noscanner. Если директива не указана, то функция имеет такие же параметры, как и New@@ScannerName@@Scanner (при создании парсера создается экземпляр сканера, название которого задается директивой %scannername в .Y файле, и конструктору сканера передаются параметры функции). Если же директива %noscanner указана, то парсер использует реализацию сканера, предоставленную разработчиком, а потому никаких параметров конструктору не передается.
Как и у анализаторов в TP Lex & Yacc, у анализаторов OLex и OYacc наблюдается странная особенность - они в упор отказываются работать, если не установлены опции компилятора Range checking и Overflow checking.
Работа по созданию "внутренностей" транслятора не отличается от работы с TP Lex & Yacc - можно обратиться к документации пакета для дальнейшего изучения.
Проанализировав все имеющиеся реализованные автором
Проанализировав все имеющиеся реализованные автором анализаторы, были сделаны следующие наблюдения:Реализация задачи потребовала довольно значительных изменений в исходных кодах пакета.
Встраивание в механизм работы генераторов автору показалось весьма сложным, поэтому было принято решение вносить изменения, опираясь на существующий механизм работы.
Были произведены следующие изменения.
Для того, чтобы отличать оригинальные библиотеки от измененных, имена файлов были изменены:
| LexLib.pas | OLexLib.pas |
| YaccLib.pas | OYaccLib.pas |
| yylex.cod | yyolex.cod |
| yyparse.cod | yyoparse.cod |
Работа с генерируемым файлом была поделена на два этапа. Первый - это "честная" работа Lex (Yacc) по созданию генератора. Учитывая структуру шаблона, генераторы создают метод класса, yylex или yyparse, в зависимости от анализатора. Второй этап - это работа непосредственно с созданным файлом по его доводке. В шаблон встроены некоторые подстановочные символы, которые заменяются названием модуля, класса и т.д. (полный перечень приведен ниже). Для поддержки второго этапа были введены соответствующие изменения в генераторы.
Выбор источника символов был ограничен консолью и входящим потоком. Сделано это было из соображений практичности - работу с текстовыми файлами удобно проводить и с помощью потоков, а консоль иногда все-таки нужна для коротких фильтров. Собственно выбор осуществляется при помощи параметра _useconsole конструктора класса TBaseScanner.
Delphi - сбориник статей
Фиксированное дерево
Для того чтобы устранить недостатки простого дерева, нужно иметь указатель не только на непосредственного предка, но и на всех остальных предков выше по иерархии. Если максимальная глубина дерева ограничена, то это можно сделать в той же самой таблице путем введения дополнительных полей-ссылок. Если еще добавить поле для хранения уровня узла (что поможет в реализации операций с деревом), то получим следующую структуру (в данном случае максимальная глубина дерева равна 5): Таблица MainTable| ID | Autoincrement | Первичный ключ |
| Lev | Integer | Уровень текущего узла |
| Parent1 | Integer | Ссылка на родителя 1-го уровня (корень) |
| Parent2 | Integer | Ссылка на родителя 2-го уровня |
| Parent3 | Integer | Ссылка на родителя 3-го уровня |
| Parent4 | Integer | Ссылка на родителя 4-го уровня |
| Parent5 | Integer | Ссылка на родителя 5-го уровня |
| Name | Char | Название узла |
Поле Lev может принимать значения от 1 (корень дерева) до 5 (узел максимально возможной глубины). Значение поля ParentN для любого N равно:
Как видно из приведенных примеров, в реализации всех операций удалось уйти от рекурсии. Количество запросов не зависит ни от количества узлов в дереве, ни от его глубины. Да и сама реализация стала несколько проще за исключением процедуры SetParent. На самом деле в ней не так все страшно, как кажется. Просто я попытался в одну процедуру запихнуть обработку нескольких различных ситуаций, которые, по уму, должны обрабатываться самостоятельно. На всякий случай (если кому-то сложно разбирать мои паскалевские каракули) хочу привести примеры запросов, которые реализуют эту операцию для различных ситуаций (запросы не сработают на Local SQL).
Ситуация 1. При изменении родителя происходит уменьшение уровня узла. Пусть мы узлу Node уровня 3 назначаем родителем узел Parent уровня 1. В результате выполнения операции уровень всех узлов поддерева Node уменьшится на 1. UPDATE MainTable AS T1,MainTable AS T2 SET T1.Lev=T1.Lev-1,T1.Parent1=T2.Parent1,T1.Parent2=T1.Parent3, T1.Parent3=T1.Parent4,T1.Parent4=T1.Parent5,T1.Parent5=0 WHERE (T1.Parent3=Node) AND (T2.ID=Parent);
Ситуация 2. При изменении родителя происходит увеличение уровня узла. Пусть мы узлу Node уровня 2 назначаем родителем узел Parent уровня 2. В результате выполнения операции уровень всех узлов поддерева Node увеличится на 1. Если в поддереве узла Node имеются узлы уровня 5, то они должны быть предварительно удалены, так как выйдут за пределы допустимой глубины дерева. DELETE FROM MainTable WHERE (Parent2=Node) AND (Lev>=5); UPDATE MainTable AS T1,MainTable AS T2 SET T1.Parent5=T1.Parent4,T1.Parent4=T1.Parent3,T1.Parent3=T1.Parent2, T1.Parent2=T2.Parent2,T1.Parent1=T2.Parent1,T1.Lev=T1.Lev+1 WHERE (T1.Parent2=Node) AND (T2.ID=Parent);
Ситуация 3. При изменении родителя не происходит изменение уровня узла. Пусть мы узлу Node уровня 3 назначаем родителем узел Parent уровня 2. В результате выполнения операции уровень всех узлов поддерева Node не меняется. UPDATE MainTable AS T1,MainTable AS T2 SET T1.Parent1=T2.Parent1,T1.Parent2=T2.Parent2 WHERE (T1.Parent2=Node) AND (T2.ID=Parent);
Кстати, фиксированное дерево -- единственный вариант представления дерева, для которого мне удалось в полном объеме решить вставшую изначально проблему: вывести все узлы поддерева в нужном порядке одним запросом.
К материалу прилагаются файлы:
Неограниченное дерево
Фиксированное дерево очень удобно в работе. Но что делать, если по условию задачи невозможно ограничить максимальную глубину дерева? В этом случае придется задавать отношения между узлами более привычным способом. Родительские и дочерние узлы находятся в отношении many-to-many (каждому родительскому узлу может соответствовать множество дочерних, а каждому дочернему -- множество родительских, начиная с непосредственного предка и кончая корнем всего дерева). В соответствии с теорией, такое отношение реализуется вводом дополнительной таблицы. Таблица MainTable| ID | Autoincrement | Первичный ключ |
| Name | Char | Название узла |
Таблица LinkTable
| ParentID | Integer | Ссылка на родительский узел |
| ChildID | Integer | Ссылка на дочерний узел |
| Distance | Integer | Расстояние между узлами |
Значение поля Distance равно 0, если ParentID и ChildID совпадают. В противном случае оно равно порядковому номеру узла ChildID при движении к нему по дереву от узла ParentID. procedure OutTree(Root : Integer); var L : Integer; procedure MakeLevel(ParentID : Integer; const ParentName : String); var S : String; Q : TQuery; begin OutNode(ParentID,L,ParentName); Inc(L); S:='SELECT ID,Name FROM MainTable AS M JOIN LinkTable AS L ON (M.ID=L.ChildID) '+ 'WHERE (L.ParentID=%d) AND (L.Distance=1) ORDER BY ID'; Q:=OpenQuery(Format(S,[ParentID])); while NOT Q.Eof do begin MakeLevel(Q.FieldByName('ID').AsInteger,Q.FieldByName('Name').AsString); Q.Next; end; Dec(L); end; begin L:=0; with OpenQuery('SELECT Name FROM MainTable WHERE ID='+IntToStr(Root)) do MakeLevel(Root,FieldByName('Name').AsString); end; procedure AddNode(Parent : Integer; const Name : String); var S : String; NewNode : Integer; begin ExecQuery(Format('INSERT INTO MainTable (Name) VALUES ("%s")',[Name])); NewNode:=LastInsertID; // Следующий запрос не будет работать в Local SQL. S:='INSERT INTO LinkTable (ParentID,ChildID,Distance) '+ 'SELECT ParentID,%d,Distance FROM LinkTable '+ 'WHERE ChildID=%d'; ExecQuery(Format(S,[NewNode,Parent])); S:='INSERT INTO LinkTable (ParentID,ChildID,Distance) VALUES (%d,%0:d,0)'; ExecQuery(Format(S,[NewNode])); end; procedure DeleteNode(Node : Integer); var S : String; begin S:='DELETE FROM MainTable '+ 'WHERE ID IN (SELECT ChildID FROM LinkTable WHERE ParentID=%d)'; ExecQuery(Format(S,[Node])); S:='DELETE FROM LinkTable '+ 'WHERE ChildID IN (SELECT ChildID FROM LinkTable WHERE ParentID=%d)'; ExecQuery(Format(S,[Node])); end; function NodeInSubtree(Node,Parent : Integer) : Boolean; var S : String; Q : TQuery; begin S:='SELECT Count(*) FROM LinkTable WHERE (ParentID=%d) AND (ChildID=%d)'; Q:=OpenQuery(Format(S,[Parent,Node])); Result:=(Q.Fields[0].AsInteger > 0); end; procedure SetParent(Node,Parent : Integer); var S : String; Parents,Subtree : String; begin Parents:=Format('SELECT ParentID FROM LinkTable '+ 'WHERE (ChildID=%d) AND (ParentID<>%0:d)',[Node]); Subtree:=Format('SELECT ChildID FROM LinkTable '+ 'WHERE ParentID=%d',[Node]); S:='DELETE FROM LinkTable '+ 'WHERE (ParentID IN ('+Parents+')) AND (ChildID IN ('+Subtree+'))'; ExecQuery(S); // Следующий запрос не будет работать в Local SQL. S:='INSERT INTO LinkTable (ParentID,ChildID,Distance) '+ 'SELECT T1.ParentID,T2.ChildID,T1.Distance+T2.Distance+1 '+ 'FROM LinkTable AS T1,LinkTable AS T2 '+ 'WHERE (T1.ChildID=%d) AND (T2.ParentID=%d)'; ExecQuery(Format(S,[Parent,Node])); end;
Как нетрудно заметить, для неограниченного дерева хорошо реализуются все операции за исключением вывода поддерева: получить одним запросом все узлы, входящие в поддерево, достаточно легко, но вот упорядочить их так, чтобы получилось дерево, мне не удалось. Если кто знает способ, как можно представить неограниченное дерево в БД, чтобы любое поддерево можно было вывести одним запросом с учетом правильного порядка, то мне это по-прежнему очень интересно.
Ответы на предполагаемые часто задаваемые вопросы
1. Я скопировал кусок кода из статьи к себе в программу, после чего... (компилятор выдал ошибку, запрос не выполняется, компьютер виснет).Не копируйте код из статьи. Если хочется что-нибудь скопировать, то скачайте исходники демонстрационной программы и копируйте оттуда ;-)
2. Я решил поискать в интернете дополнительные материалы по этой теме. Нашел немного про фиксированное дерево, но там совсем про другое. А про простое и неограниченное дерево я вообще ничего не нашел.
Тысяча извинений. Термины Простое Дерево, Фиксированное Дерево и Неограниченное Дерево не являются общеупотребительными. Я их придумал для данной статьи, чтобы как-то называть различные варианты представления деревьев, которые я рассматриваю.
3. Не кажется ли Вам, что использование других вариантов представления (отличных от простого дерева) -- это избыточные затраты дискового пространства?
Нет, не кажется. Если Вы взялись за базы данных, то Вы заведомо приняли решение пожертвовать эффективностью использования дискового пространства ради повышения быстродействия обработки больших объемов данных. Например, в демонстрационной программе я отвел под название узла 40 символов, хотя при тестировании не использовал названий длиннее 10 символов. Итого, таблица на 75% состоит из "воздуха". Если Вас заботит дисковое пространство, то вместо баз данных используйте, например, формат Tab Delimited Text и будет Вам счастье ;-)
4. Приведенные структуры ... (недостаточны, неоптимальны). Будет лучше сделать...
Делайте ;-)
5. Почему Вы не используете параметры в запросах? Ведь это более правильно.
Есть два варианта ответа: короткий и длинный. Короткий: мне показалось, что так будет нагляднее. Длинный приводить не буду, чтобы не раздувать размер статьи.
6. Зачем вообще нужны эти хитрые структуры, ведь сервер СУБД оптимизирует выполнение хранимых процедур?
Если сервер СУБД действительно умеет оптимизировать хранимые процедуры, в которых выполняются рекурсивные вызовы запросов, то данная статья представляет исключительно академический интерес.
7. Вывод всего дерева целиком в реальных задачах не требуется.
Если этот так, то значит Вы и я всего лишь напрасно потратили время ;-)
И еще несколько слов, если можно. В процессе работы над статьей, я решил поискать по Королевству другие материалы аналогичной тематики. Статей похожих мне не попалось (может быть, плохо искал?), а вот на Круглом Столе я обнаружил ответы Елены Филипповой на один из вопросов (). Приятно видеть, что два умных человека могут независимо прийти к одним и тем же выводам ;-) Кстати, одну небольшую идейку я у Елены украл (так как ее вариант показался мне более интересным) в чем готов принародно покаяться.
Специально для
Постановка задачи
В этой статье я рассматриваю несколько различных вариантов представления деревьев в базах данных, то есть структуры таблиц и реализацию некоторых операций по работе с деревьями через SQL-запросы к этим таблицам. Подчеркиваю, что речь идет о структуре данных и об операциях обработки. Вопросы написания компонент для представления деревьев здесь не рассматриваются. Сразу уточню кое-какие моменты: эта статья написана для показа идеи, но не реализации. Отсюда несколько следствий. Я по возможности старался использовать максимально простые запросы, ориентируясь на Local SQL. Это сделано специально, чтобы идея была понятна как можно большему числу читателей. Если начать использовать более оптимальные конструкции, характерные для какой-либо продвинутой СУБД, это может привести к сложностям понимания для людей, работающих с другой СУБД. По той же причине вся программная обработка запросов в примерах написана на Delphi (то есть на стороне клиента), хотя на практике это лучше реализовать на сервере через хранимые процедуры и триггеры. Также в некоторых местах я, возможно, упускаю особенности обработки данных в некоторых экстремальных условиях (добавление первой записи в пустую таблицу, удаление последней записи из таблицы). Просто чтобы не загромождать код примера обработкой различных вариантов, которые усложнят понимание той самой идеи.В принципе, Паскаль достаточно прост и понятен. И его вполне можно использовать для описания алгоритмов. Но, чтобы еще лучше сконцентрироваться на главном, я при описании реализации операций исхожу из предположения, что у меня имеется несколько вспомогательных функций, реализация которых в рамках данной статьи не существенна. Для простоты понимания тех, кто привык к правильному коду, можно считать, что у меня имеется дополнительный модуль, в котором определены некоторые специальные функции: unit SpecialFunctions; interface uses DBTables; {Процедура выводит узел с идентификатором ID, текстом Name и уровнем номер Level} procedure OutNode(ID,Level : Integer; const Name : String); {Функция создает запрос с текстом, переданным через StrSQL, открывает и возвращает его. Подразумевается запрос SELECT} function OpenQuery(const StrSQL : String) : TQuery; {Процедура выполняет запросы UPDATE, INSERT и DELETE, текст которых передан через StrSQL} procedure ExecQuery(const StrSQL : String); {Функция возвращает идентификатор последней записи, добавленной через запрос INSERT} function LastInsertID : Integer;
Используя процедуру OutNode, мы последовательно выводим узлы дерева. Как и куда будут выводиться эти узлы, не важно. Параметр Level определяет уровень узла (для древовидного отображения). Предполагается также, что запросы, полученные от функции OpenQuery, автоматически уничтожаются, после использования. Чтобы не загромождать код вызовом метода Free, обработкой исключений и прочими деталями, не представляющими сейчас интереса.
В статье рассматриваются три варианта представления деревьев. Для каждого из них приведены реализации пяти операций, которые показались мне наиболее необходимыми. Вот эти операции: {Процедура выводит поддерево, начиная с узла Root (нижнее замыкание). Для вывода используется вспомогательная процедура OutNode. Как и куда осуществляется вывод, не важно) procedure OutTree(Root : Integer); {Процедура добавляет узел с названием Name, делая его потомком узла Parent.} procedure AddNode(Parent : Integer; const Name : String); {Процедура удаляет поддерево, начиная с узла Node} procedure DeleteNode(Node : Integer); {Функция возвращает true, если узел Node находится в поддереве узла Parent. Данная функция необходима для проверки того, можно ли изменить структуру дерева и сделать узел Parent потомком узла Node. Если проверку не проводить, то возможно появление циклов, которые в дереве недопустимы.} function NodeInSubtree(Node,Parent : Integer) : Boolean; {Процедура изменяет структуру дерева, назначая узел Parent родителем узла Node.} procedure SetParent(Node,Parent : Integer);
Пример реализации
В свое время у нас в институте ходила такая шутка, что "на экзамене по общей физике ответ со взрывом -- лучше, чем ответ без взрыва". Подразумевалось, что, если ответ сопровождается экспериментом, то больше шансов получить хорошую оценку. В соответствии с этим нехитрым правилом я решил написать к данной статье небольшую демонстрационную программу, хотя никакая программа изначально не подразумевалась, так как статья чисто теоретическая.
Программа достаточно проста. В выпадающем списке выбираем тип дерева и по данным из БД соответствующее дерево строится на главной панели (слегка модифицированный ListBox). Операции по изменению дерева выполняются из контекстного меню. Обращаю внимание, что команды относятся к текущему узлу дерева (выделенному цветом), а не к тому, над которым произведен клик мышью. Если текущего узла нет, то операции невозможны. Операция изменения родителя вызывается методом Drag and Drop (берем мышью узел и перетаскиваем его на нового родителя). Для вывода поддерева, начиная с некоторого узла, можно выполнить Double Click на этом узле. Обратного перехода (или возможности подняться выше по дереву) нет. Чтобы от поддерева вернуться к полному дереву, нужно снова выбрать дерево того же типа из выпадающего списка типов.
Все три дерева хранятся в БД на Paradox 7. Это было сделано, чтобы обеспечить максимальную совместимость с программным обеспечением всех желающих попробовать программу: не уверен, что у каждого жителя Королевства имеется на компьютере Oracle или MS SQL, но уж BDE наверняка проинсталлировали все. Для работы программы файлы БД должны находится в директории DATA, которая, в свою очередь, должна находится там же, где и исполняемый файл (DBTree.exe). База данных уже частично заполнена. Все необходимый файлы содержатся в том же архиве, что и исходники программы. На случай, если у кого-то возникнут проблемы с компиляцией (а побаловаться с программой захочется), в отдельном архиве выкладываю скомпилированный EXE-файл.
И еще, программа является довеском к статье, но никак не предметом рассмотрения. Отсюда несколько следствий. Во-первых, хотя я и старался писать код поаккуратнее, но вот комментариями, мягко выражаясь, не злоупотреблял. Так что возможны трудности при разборках с исходниками. Во-вторых, это все же не законченный программный продукт, ориентированный на конечного пользователя, а маленькая демонстрашка. Так что в ней не реализована в полной мере противодураковая защита. Заранее известные глюки: не проверяется длинна строки для имени узла (максимальное значение не должно быть более 40 символов), под первичный ключ отводится всего 16 бит (если попытаться создавать более 32767 узлов, то возникнут глюки), под последним добавленным узлом понимается узел с максимальным значением первичного ключа (возможны сбои при работе в многопользовательском режиме). Так что погонять дерево туда-сюда можно, но серьезно насиловать программу не стоит. Она для этого не предназначена.
Простое дерево
Наиболее простой и распространенный способ представления деревьев в базах данных состоит из одной таблицы примерно следующей структуры: Таблица MainTable| ID | Autoincrement | Первичный ключ |
| ParentID | Integer | Ссылка на родительский узел |
| Name | Char | Название узла |
Подобный подход очень прост, однако не позволяет сразу выделить все поддерево, начиная с заданного узла. Для работы с поддеревом требуется рекурсивная обработка данных. procedure OutTree(Root : Integer); var L : Integer; procedure MakeLevel(ParentID : Integer; const ParentName : String); var S : String; Q : TQuery; begin OutNode(ParentID,L,ParentName); Inc(L); S:='SELECT ID,Name FROM MainTable WHERE ParentID=%d ORDER BY ID'; Q:=OpenQuery(Format(S,[ParentID])); while NOT Q.Eof do begin MakeLevel(Q.FieldByName('ID').AsInteger,Q.FieldByName('Name').AsString); Q.Next; end; Dec(L); end; begin L:=0; with OpenQuery('SELECT Name FROM MainTable WHERE ID='+IntToStr(Root)) do MakeLevel(Root,FieldByName('Name').AsString); end; procedure AddNode(Parent : Integer; const Name : String); var S : String; begin S:='INSERT INTO MainTable (ParentID,Name) VALUES (%d,"%s")'; ExecQuery(Format(S,[Parent,Name])); end; procedure DeleteNode(Node : Integer); procedure DeleteLevel(Parent : Integer); var S : String; Q : TQuery; begin S:='SELECT ID FROM MainTable WHERE ParentID=%d'; Q:=OpenQuery(Format(S,[Parent])); while NOT Q.Eof do begin DeleteLevel(Q.FieldByName('ID').AsInteger); Q.Next; end; S:='DELETE FROM MainTable WHERE ID=%d'; ExecQuery(Format(S,[Parent])); end; begin DeleteLevel(Node); end; function NodeInSubtree(Node,Parent : Integer) : Boolean; var S : String; Q : TQuery; begin Result:=false; while Node <> Parent do begin S:='SELECT ParentID FROM MainTable WHERE ID=%d'; Q:=OpenQuery(Format(S,[Node])); Node:=Q.FieldByName('ParentID').AsInteger; if Node = 0 then Exit; end; Result:=true; end; procedure SetParent(Node,Parent : Integer); var S : String; begin S:='UPDATE MainTable SET ParentID=%d WHERE ID=%d'; ExecQuery(Format(S,[Parent,Node])); end;
При такой организации дерева, только добавление нового узла и назначение узлу нового родителя (то есть операции, для выполнения которых знание структуры дерева не требуется) реализуются достаточно эффективно. А вывод дерева и удаление поддерева требуют рекурсивной обработки. Проверка вхождения узла в поддерево хотя и реализуется без рекурсии, однако количество вызовов запросов также зависит от структуры дерева (от глубины, если быть точнее), что не является эффективным. Надо попробовать другие варианты представления дерева.
Сравнительный анализ
Проведем небольшой сравнительный анализ различных вариантов представления дерева с точки зрения качества реализации рассмотренных в статье операций. Будем считать, что операция реализуется хорошо, если количество запросов для реализации не зависит от характеристик дерева (количества узлов, глубины и др.). Если же зависимость есть, то будем считать, что операция реализуется плохо.| Простое | Фиксированное | Неограниченное | ||
| 1 | Вывод дерева | плохо | хорошо | плохо |
| 2 | Добавление узла | хорошо | хорошо | хорошо |
| 3 | Удаление узла | плохо | хорошо | хорошо |
| 4 | Вхождение узла в поддерево | плохо | хорошо | хорошо |
| 5 | Изменение родителя | хорошо | хорошо | хорошо |
Из таблицы видно, что простое дерево слабо годится для работы с ним на уровне БД. Только две операции из пяти будут выполняться эффективно. Но так как для изменения родителя нужно сначала определить, допустимо ли такое изменение, а операция проверки вхождения узла в поддерево также реализуется плохо, то остается одно лишь добавление нового узла. Для задачи, в которой в основном выполняется только операция добавления нового узла, а остальные операции выполняются крайне редко, такой вариант подойдет. Но я как-то слабо могу себе представить такую задачу (ведение древовидных логов что ли?). Так что применять простое дерево имеет смысл для сравнительно небольших деревьев, которые выгружаются из БД в какие-либо компоненты (например, TTreeView), а вся дальнейшая работа производится уже на уровне компонентов.
Для фиксированного дерева все операции реализуются хорошо. Так что, если по условиям задачи допустимо ограничить максимальную глубину дерева, то, возможно, это будет лучший вариант (если не будет придуман способ хорошей реализации вывода неограниченного дерева). Имейте в виду, что максимальную глубину для фиксированного дерева можно задать и побольше, чем 5. Можно взять с запасом. Главное -- чтобы глубину можно было хоть как-то ограничить.
Ну, а если таких ограничений задать невозможно (или если скорость вывода не критична), то можно воспользоваться вариантом неограниченного дерева.
Увидеть за лесом деревья
, Сидел я как-то раз на одном форуме, на котором темы отображались в виде полностью раскрытого дерева. И залезла мне в голову шальная мысль: а как можно сделать такой вот древовидный форум, чтобы данные хранились в БД, а список тем выдавался одним запросом. Причем, чтобы порядок записей тоже определялся в этом запросе, а не приходилось потом полученные темы отсортировывать руками. Попробовал решить задачу "кавалерийским наскоком". Не получилось. Наиболее простая структура, задающая дерево, требовала рекурсивного вызова запросов, а мне это не понравилось. Придумать же более сложную структуру, которая позволяла бы построить дерево с учетом моих требований, долго не получалось.Так как задача не была критичной, то я не просиживал ночи напролет, пытаясь ее решить, а просто возвращался к ней время от времени, когда хотелось поразмять мозги. И, в конце концов, что-то напридумывал. Этими придумками я и хочу поделиться.
На кого рассчитана данная статья? В основном, на программистов, которые более-менее знакомы с реляционными базами данных и языком SQL (плюс некоторое знакомство с Delphi), и которые имеют желание совершенствоваться в разработке баз данных. Начинающим, пожалуй, будет тяжеловато, так как я не опускаюсь до деталей. А вот профессионалы, возможно, найдут для себя кое-что интересное.
Delphi - сбориник статей
Что дальше?
Вы думаете это все? Кроме класса TRttiObject в прилагаемом файле Вы найдете следующие классы: TRttiList = class(TObjectList, IStreamPersist) Предназначен для составления и управления списками объектов типа TRttiObject. Кроме того, поддерживает интерфейс IStreamPersist и может сам являться свойством объекта TRttiObject. Таким образом, вы можете составлять из этих классов сколь угодно сложные структуры, массивы, деревья и т.д.TAsyncRttiList = class(TRttiList) Тоже самое, но процесс сохранения и загрузки позволяет выполнять асинхронно, т.е. сразу возвращает управление, а когда процессы завершены, оповещает главный поток (Thread).
Вот теперь все. Надеюсь, эти материалы будут для Вас полезны и возможно у Вас появятся какие-либо идей, как исправить/дополнить их. Буду очень признателен!
(zip-архив, 2.3 K) (обновление от 3/27/2006 2:10:00 AM)
Реализация
Класс TRttiObject // Сохраняет и читает из потока все Published свойства TRttiObject = class(TInterfacedPersistent, IStreamPersist) public procedure SaveToStream(Stream: TStream); procedure LoadFromStream(Stream: TStream); constructor Create; virtual; end; Тут нужно немного пояснить. Класс будет записывать/читать все свойства, тип которых целый (в том числе логический), перечислимый, вещественный, символьный, строковый, а также некоторые классы, которые поддерживают работу с потоками. Отличить эти классы от других, можно запросив у них интерфейс IStreamPersist, который объявлен в Classes.pas так:IStreamPersist = interface ['{B8CD12A3-267A-11D4-83DA-00C04F60B2DD}'] procedure LoadFromStream(Stream: TStream); procedure SaveToStream(Stream: TStream); end; Этот класс реализуют, например, все потомки TGraphic, такие как TBitmap, TIcon, TMetafile, а также наш класс TRttiObject.
Почему в качестве предка выбран TInterfacedPersistent, а не TObject или TInterfacedObject. Тут несколько причин: во-первых, он является потомком TPersistent, который объявлен с директивой {$M+} (правда ничего не мешало бы сделать это самим), а во-вторых, в нем наиболее удачно для нас реализованы методы интерфейса IInterface (подсчет ссылок, реализованный в TInterfacedObject, нам ни к чему, а если взять TObject, то эти методы нужно будет реализовать самому).
procedure TRttiObject.SaveToStream(Stream: TStream); var TypeData: PTypeData; PropList: PPropList; Count,i: Integer; // Локальные процедуры procedure WriteOrdProp; // Запись целых и перечислимых данных var Value: Integer; begin Value:=GetOrdProp(self,PropList[i]); Stream.Write(Value,SizeOf(Value)); end; procedure WriteFloatProp; // Запись вещественных данных var Value: Extended; begin Value:=GetFloatProp(self,PropList[i]); Stream.Write(Value,SizeOf(Value)); end; procedure WriteStringProp; // Запись строки var Value: String; L: Integer; begin Value:=GetStrProp(self,PropList[i]); L:=Length(Value); Stream.Write(L,SizeOf(L)); Stream.Write(PChar(Value)^,Length(Value)); end; procedure WriteClassProp; // Запись класса var Obj: TObject; SaveLoader: IStreamPersist; IsEmpty: Boolean; begin Obj:=GetObjectProp(self,PropList[i]); if (Obj is TGraphic) then begin IsEmpty:=TGraphic(Obj).Empty; Stream.Write(IsEmpty,SizeOf(Boolean)); end; if Supports(Obj,IStreamPersist,SaveLoader) then begin SaveLoader.SaveToStream(Stream); end; end; // Собственно сама процедура поиска свойств и записи begin TypeData:=GetTypeData(ClassInfo); // Получаем указатель на информацию Count:=TypeData.PropCount; // Получаем количество свойств if Count>0 then begin // Выделяем память для списка свойств GetMem(PropList,SizeOf(PPropInfo)*Count); Try // Получаем список свойств GetPropInfos(ClassInfo,PropList); // Перебираем все свойства из списка и сохраняем их // в поток в соответствии с их типом for i:=0 to Count - 1 do begin case PropList[i].PropType^.Kind of tkEnumeration, tkInteger, tkChar, tkWChar: WriteOrdProp; tkFloat: WriteFloatProp; tkString, tkLString: WriteStringProp; tkClass: WriteClassProp; end; end; finally // Освобождаем память FreeMem(PropList,SizeOf(PPropInfo)*Count); end; end; end; Я не буду подробно комментировать каждую функцию из TypInfo.pas, по комментариям сами разберетесь, прошу только обратить внимание на локальную процедуру записи класса. Сначала мы получаем экземпляр самого объекта. Потом проверяем, не является ли он потомком TGraphic. Далее записываем в поток, является ли графический объект пустым. Дело в том, что если объект (например Bitmap) пустой, то вызов SaveToStream не запишет в поток ничего. При чтении объект не сможет узнать о том, что он должен быть пустым, и будет, как ни в чем не бывало читать следующие по очереди данные из потока. Само собой это вызовет ошибку. Честно говоря, мне не очень нравится, как я решил эту проблему. Если у Вас есть идеи получше - пишите в обсуждении статьи.
И в конце процедуры WriteClassProp самое главное. Запрашиваем интерфейс IStreamPersist и заодно проверяем, поддерживает ли вообще его объект. Если да, то вызываем метод интерфейса SaveToStream.
Процесс чтения свойств из потока аналогичен. Я не буду его рассматривать в статье, в прилагаемом примере вы его найдете и сами сможете разобраться.
Совсем немного теории
Для тех, кто знает, что скрывается за страшной аббревиатурой RTTI, рекомендую пропустить этот раздел, ничего нового Вы здесь не найдете. А остальных попытаюсь немного ввести в курс дела. RTTI (Run-time type information) - как видно из названия, это механизм, позволяющий определить тип данных во время выполнения. Суть его в том, что компилятор генерирует расширенную информацию для почти всех классов, используемых в вашей программе. Я сказал почти? Да, только для классов, объявленных с директивой {$M+} и их потомков, а таким классом, в частности является TPersistent. Потомками этого класса являются все компоненты, графические классы (TFont, TBitmap, TIcon и т.д.) и многие другие. Так вот, я отвлекся, эта информация активно используется самой средой разработки (инспектор объектов, редакторы свойств) и может быть использована программистом. Необходимые средства для работы с RTTI находятся в модуле TypInfo.pas. Проблема лишь в том, что по неизвестным мне причинам, Borland решила не документировать эти возможности (в справке по Delphi7, не нашел ничего связанного с RTTI, кроме упомянутой ранее директивы {$M+/-}, метода TObject.ClassInfo и операторов is и as).И еще: RTTI позволяет получить информацию о свойствах и методах, объявленных ТОЛЬКО в разделе published. Зачем нам это нужно и как это нам поможет - увидите далее.
Ставим задачу
Поставим себе такую задачу: создать класс, который будет искать все свои published-свойства и сохранять их в поток (в файл, в частности). Программисту нужно только ОДИН раз написать код, который реализует сказанное выше, создать потомка этого класса, объявить в нем все необходимые свойства, и вызвать метод SaveToStream (его не надо будет перекрывать для каждого потомка) для сохранения самого себя в поток. Аналогично, метод LoadFromStream прочитает все свойства из потока. Ну-с, приступим-с.Упрощаем работу с потоками (TStream)
Юрий Спектор,Работа программиста невозможна без работы с данными, которые хранятся в файлах или в памяти. В Delphi введен механизм потокового ввода-вывода, значительно упрощающий наш нелегкий труд. Однако структура данных может быть достаточно сложна. К тому же, в разных проектах она наверняка будет различна. Все это заставляет нас снова и снова писать сотни строчек однообразного кода записи/чтения данных. Утомляет. В этой я покажу, как я решил эту проблему для себя.
Delphi - сбориник статей
CryptoAPI
Криптографические функции являются частью операционной системы Windows, и обратится к ним можно посредством интерфейса CryptoAPI. Основные возможности доступны еще с Windows 95, но со временем они расширялись. Описание функций CryptoAPI можно найти в , литературе[2] или в справочном файле к Delphi. Функции содержаться в библиотеках advapi32.dll и crypt32.dll. Их можно импортировать самостоятельно, а можно воспользоваться файлом Wcrypt2.pas, который прилагается к данной статье.Подключение к криптопровайдеру. Контейнеры ключей.
Первая функция, которую мы рассмотрим, будет function CryptAcquireContext(phProv :PHCRYPTPROV; pszContainer :LPAWSTR; pszProvider :LPAWSTR; dwProvType :DWORD; dwFlags :DWORD) :BOOL; stdcall; В большинстве случаев, работа с криптографическими возможностями Windows начинается с вызова именно этой функции, которая выполняет подключение к криптопровайдеру и возвращает его дескриптор в параметре phProv. Криптопровайдер представляет собой dll, независимый программный модуль, который фактически исполняет криптографические алгоритмы. Криптопровайдеры бывают различные и отличаются составом функций (например, некоторые криптопровайдеры ограничиваются лишь цифровыми подписями), используемыми алгоритмами (некоторые шифруют алгоритмом RC2, другие - DES) и другими возможностями. В каждой операционной системе свой состав криптопровайдеров, однако в каждой присутствует Microsoft Base Cryptographic Provider v1.0. При вызове функции CryptAcquireContext, необходимо указать имя провайдера и его тип (соответственно в параметрах pszProvider и dwProvType). Тип провайдера определяет состав функций и поддерживаемые криптоалгоритмы, например:
Тип PROV_RSA_FULL
Параметр dwFlags может быть нулевым или принимать одно из следующих значений: CRYPT_VERIFYCONTEXT - этот флаг предназначен для приложений, которые не должны иметь доступ к закрытым ключам контейнера. Такие приложения могут обращаться только к функциям хеширования, проверки цифровой подписи или симметричного шифрования. В этом случае параметр pszContainer должен быть равен nil. CRYPT_NEWKEYSET - создает новый контейнер ключей, но сами ключи не создаются. CRYPT_DELETEKEYSET - удаляет контейнер вместе с хранящимися там ключами. Если задан этот флаг, то подключение к криптопровайдеру не происходит и параметр phProv неопределен. CRYPT_MACHINE_KEYSET - по умолчанию контейнеры ключей сохраняются как пользовательские. Для основных криптопровайдеров это означает, что контейнеры ключей сохраняются в пользовательских профилях. Этот флаг можно устанавливать в комбинации с другими, чтобы указать, что контейнер является машинным, то есть хранится в профиле All Users. В случае успеха, функция возвращает true, в противном случае - false. GetLastError вернет код ошибки.
function CryptReleaseContext(hProv :HCRYPTPROV; dwFlags :DWORD) :BOOL; stdcall; Освобождает контекст криптопровайдера и контейнера ключей. hProv - дескриптор криптопровайдера, полученный при вызове CryptAcquireContext. dwFlags - зарезервирован и должен равняться нулю.
В случае успеха, функция возвращает true, в противном случае - false. GetLastError вернет код ошибки.
Приведем пример работы с этими функциями: uses Wcrypt2; ... procedure CryptProc; var Prov: HCRYPTPROV; begin CryptAcquireContext(@Prov,nil,nil,PROV_RSA_FULL,CRYPT_VERIFYCONTEXT); // Работаем с функциями CryptoAPI ... CryptReleaseContext(Prov,0); end; Прежде, чем перейти непосредственно к криптографическим функциям, упомяну еще о таких функциях как CryptSetProvider, CryptGetDefaultProvider, CryptGetProvParam, CryptSetProvParam, CryptEmunProviders, CryptEnumProviderTypes, описание которых вы найдете сами.
Хэширование и электронно-цифровая подпись.
function CryptCreateHash(hProv :HCRYPTPROV; Algid :ALG_ID; hKey :HCRYPTKEY; dwFlags :DWORD; phHash :PHCRYPTHASH) :BOOL; stdcall; Функция создает в системе хэш-объект и возвращает в параметре phHash его дескриптор. Данные, поступающие на вход хэш-объекта, там преобразуются, и их отпечаток сохраняется внутри хэш-объекта.
В параметре hProv нужно указать дескриптор провайдера, полученный с помощью CryptAcquireContext. Параметр Algid указывает на то, какой алгоритм хэширования будет использоваться. Для Microsoft Base Cryptographic Provider может принимать следующие значения: CALG_MAC, CALG_MD2, CALG_MD5, CALG_SHA. Смысл этих значений, думаю, понятен. Параметр hKey подробно рассматривать не будем, вы можете почитать о нем сами. Скажу лишь, что обычно (если не используется алгоритм с секретным ключом, такой как MAC) его указывают равным нулю. Параметр dwFlags зарезервирован на будущее и должен быть равен нулю.
В случае успеха, функция возвращает true, в противном случае - false. GetLastError вернет код ошибки.
function CryptDestroyHash(hHash :HCRYPTHASH) :BOOL; stdcall; Функция уничтожает хэш-объект, созданный с помощью CryptCreateHash. В параметре hHash указывается дескриптор хэш-объекта.
В случае успеха, функция возвращает true, в противном случае - false. GetLastError вернет код ошибки.
function CryptHashData(hHash :HCRYPTHASH; const pbData :PBYTE; dwDataLen :DWORD; dwFlags :DWORD) :BOOL; stdcall; Функция позволяет добавлять данные к объекту хэш-функции. Функция может вызываться несколько раз, данные, от которых мы вычисляем хэш, разбиты на порции. В параметре hHash указывается дескриптор хэш-объекта, созданный с помощью CryptCreateHash. pbData содержит указатель на данные, а dwDataLen содержит размер этих данных в байтах. Для Microsoft Base Cryptographic Provider параметр dwFlags должен быть равен нулю.
В случае успеха, функция возвращает true, в противном случае - false. GetLastError вернет код ошибки.
function CryptSignHash(hHash :HCRYPTHASH; dwKeySpec :DWORD; sDescription :LPAWSTR; dwFlags :DWORD; pbSignature :PBYTE; pdwSigLen :PDWORD) :BOOL; stdcall; Функция вычисляет значение электронно-цифровой подписи от значения хэша. В параметре hHash указывается дескриптор хэш-объекта, созданный с помощью CryptCreateHash. dwKeySpec указывает, какой ключ будет использован для создания подписи. Как уже говорилось, в хранилище ключей содержится две ключевые пары: для подписи и для обмена ключами. Соответственно этот параметр может принимать значения AT_SIGNATURE или AT_KEYEXCHANGE (логичнее использовать AT_SIGNATURE). Ключи должны существовать в контейнере. sDescription может содержать произвольную строку описания. Эта строка будет добавлена к хэшу и должна быть известна приемной стороне. Использовать этот параметр не рекомендуется, так как это снижает безопасность системы. Параметр dwFlags не поддерживается в Microsoft Base Cryptographic Provider и на его месте следует указать ноль. pbSignature указывает на буфер, куда будет помещена цифровая подпись, а pdwSigLen - размер этого буфера. Если размер заранее не известен, то можно указать pbSignature равным nil, и тогда в параметре pdwSigLen мы получим необходимый размер буфера.
В случае успеха, функция возвращает true, в противном случае - false. GetLastError вернет код ошибки.
function CryptVerifySignature(hHash :HCRYPTHASH; const pbSignature :PBYTE; dwSigLen :DWORD; hPubKey :HCRYPTKEY; sDescription :LPAWSTR; dwFlags :DWORD) :BOOL; stdcall; Функция осуществляет проверку цифровой подписи. hHash - дескриптор хэш-объекта, значение которого является отпечатком сообщения, подпись которого мы проверяем. pbSignature - указатель на буфер, содержащий подпись, dwSigLen - размер этого буфера. hPubKey - дескриптор открытого ключа, с помощью которого мы будем проверять подпись. Открытый ключ должен соответствовать закрытому, которым осуществлялась подпись. О том, как получить этот ключ, поговорим позже. Параметры sDescription и dwFlags должны соответствовать параметрам функции CryptSignHash при осуществлении подписи.
В случае успеха, функция возвращает true, в противном случае - false. GetLastError вернет код ошибки.
Приведу пример работы с этими функциями, упрощенно, без контроля возможных ошибок (в реальных приложениях на это не стоит закрывать глаза):
1. Создание подписи. uses Wcrypt2; ... function SignMessage(Message: String): String; var Prov: HCRYPTPROV; Hash: HCRYPTHASH; BufLen: DWORD; begin Result:=''; CryptAcquireContext(@Prov,nil,nil,PROV_RSA_FULL,0); CryptCreateHash(Prov,CALG_MD5,0,0,@Hash); CryptHashData(Hash,PByte(Message),Length(Message),0); BufLen:=0; CryptSignHash(Hash,AT_SIGNATURE,nil,0,nil,@BufLen); if BufLen>0 then begin SetLength(Result,BufLen); CryptSignHash(Hash,AT_SIGNATURE,nil,0,PByte(Result),@BufLen); end; CryptDestroyHash(Hash); CryptReleaseContext(Prov,0); end; 2. Проверка подписи. В коде будут упущены некоторые фрагменты, о которых мы поговорим позже.
function VerifySign(Message, Sign: String): Boolean; var Prov: HCRYPTPROV; Hash: HCRYPTHASH; PublicKey: HCRYPTKEY; begin CryptAcquireContext(@Prov,nil,nil,PROV_RSA_FULL,0); CryptCreateHash(Prov,CALG_MD5,0,0,@Hash); CryptHashData(Hash,PByte(Message),Length(Message),0); // Здесь должен быть импорт открытого ключа для проверки подписи ... Result:=CryptVerifySignature(Hash,PByte(Sign),Length(Sign), PublicKey,nil,0); // Здесь должно быть уничтожение открытого ключа ... CryptDestroyHash(Hash); CryptReleaseContext(Prov,0); end; Рекомендую ознакомиться самостоятельно с функциями CryptHashSessionKey, CryptGetHashParam и CryptSetHashParam.
Шифрование на основе пользовательских данных или пароля. Для шифрования в CryptoAPI используются симметричные алгоритмы, ключ для которых может быть получен двумя путями: случайным образом или на основе каких-либо пользовательских данных, например пароля. Причем к последнему варианту генерации ключа есть одно важное требование: при использовании одних и тех же паролей должны получаться идентичные ключи. Такая возможность предусмотрена в CryptoAPI.
function CryptDeriveKey(hProv :HCRYPTPROV; Algid :ALG_ID; hBaseData :HCRYPTHASH; dwFlags :DWORD; phKey :PHCRYPTKEY) :BOOL; stdcall; В параметре hProv нужно указать дескриптор провайдера, полученный с помощью CryptAcquireContext. Algid - идентификатор алгоритма, для которого генерируется ключ. Для Microsoft Base Cryptographic Provider может принимать следующие значения: CALG_RC2 и CALG_RC4. Пользовательские данные (пароль) предварительно хэшируются и дескриптор хэш-объекта передается в функцию в качестве параметра hBaseData. Старшие 16 бит параметра dwFlags могут содержать размер ключа в битах или быть нулевыми (в этом случае будет создан ключ с размером по умолчанию). Младшие 16 бит могут быть нулевыми или принимать следующие значения или их комбинации: CRYPT_EXPORTABLE, CRYPT_CREATE_SALT, CRYPT_USER_PROTECTED, CRYPT_UPDATE_KEY. К первым двум мы еще вернемся, а со смыслом остальных вы можете ознакомиться самостоятельно. В параметре phKey возвращается дескриптор созданного ключа.
В случае успеха, функция возвращает true, в противном случае - false. GetLastError вернет код ошибки.
Когда ключ есть, можно приступать непосредственно к шифрованию. Для этого нам понадобятся функции CryptEncrypt и CryptDecrypt.
function CryptEncrypt(hKey :HCRYPTKEY; hHash :HCRYPTHASH; Final :BOOL; dwFlags :DWORD; pbData :PBYTE; pdwDataLen :PDWORD; dwBufLen :DWORD) :BOOL; stdcall; В параметре hKey передается дескриптор ключа, необходимый для шифрования. Этот ключ также определяет алгоритм шифрования. Параметр hHash используется, если данные одновременно шифруются и хэшируются (шифроваться и хэшироваться будут исходные данные). В этом случае в параметре hHash передается дескриптор заранее созданного хэш-объекта. Эту возможность удобно использовать, если необходимо одновременно зашифровать и подписать сообщение. Иначе этот параметр следует установить в ноль. Параметр Final следует установить в true, если переданный в функцию блок данных является единственным или последним. В этом случае он будет дополнен до необходимого размера. Параметр dwFlags не используется в Microsoft Base Cryptographic Provider и на его месте следует указать ноль. pbData - указатель на буфер, в котором содержаться данные для зашифрования. Зашифрованыые данные помещаются в тот же буфер. pdwDataLen - размер данных, которые будут зашифрованы. dwBufLen - размер выходного буфера, для блочных шифров может быть больше, чем pdwDataLen. Узнать необходимый размер, можно передав в параметре pbData nil, в параметре pdwDataLen - размер данных, которые необходимо зашифровать, а в параметре dwBufLen - что угодно, например ноль. После такого вызова, необходимый размер буфера будет содержаться в параметре pdwDataLen (именно pdwDataLen, а не dwBufLen, немного нелогично, ну да ладно). Чтобы не было путаницы, приведу простой пример:
var Message: String; BufLen, DataLen: DWORD; ... begin ... Message:='Hello World!'; BufLen:=Length(Message); DataLen:=Length(Message); // Вычисляем необходимый размер выходного буфера CryptEncrypt(Key,0,true,0,nil,@BufLen,0); // Выделяем память для буфера и шифруем SetLength(Message,BufLen); CryptEncrypt(Key,0,true,0,PByte(Message),@DataLen,BufLen); Теперь, рассмотрим функцию, которая позволяет расшифровать сообщение. function CryptDecrypt(hKey :HCRYPTKEY; hHash :HCRYPTHASH; Final :BOOL; dwFlags :DWORD; pbData :PBYTE; pdwDataLen :PDWORD) :BOOL; stdcall; Даже не буду подробно описывать все параметры - тут все очевидно. Скажу лишь, что в параметр pdwDataLen нужно передать число байт шифротекста, а после вызова в него будет помещена длина открытого сообщения. Если используется параметр hHash, то данные после расшифровки хэшируются. Это удобно использовать, если нужно одновременно расшифровать сообщение и проверить подпись.
После того, как работа с ключом закончена, необходимо освободить дескриптор:
function CryptDestroyKey(hKey :HCRYPTKEY) :BOOL; stdcall; Если hKey относится к сеансовому ключу или импортированному открытому ключу (об этом ниже), то дескриптор освобождается, а ключ уничтожается. Если hKey относится к паре открытый/закрытый ключ, то дескриптор освобождается, а ключевая пара сохраняется в контейнере ключей.
В прилагаемом к статье архиве, вы найдете демонстрационный пример работы с этими функциями.
Генерация случайных ключей. Импорт/экспорт ключей.
Только что мы рассмотрели случай, когда для зашифровки и расшифровки сообщения отправитель и получатель использовали пароль, известный только им. Сейчас рассмотрим другой: отправитель генерирует ключ случайно и передает его получатель в зашифрованном виде вместе с сообщением. При этом для шифрования сеансового ключа используется открытый ключ получателя. А где отправитель его возьмет?
Как уже было сказано, при создании ключевого контейнера с помощью функции CryptAcquireContext, ключи в контейнере не создаются, их нужно сгенерировать отдельно. Рассмотрим функцию:
function CryptGenKey(hProv :HCRYPTPROV; Algid :ALG_ID; dwFlags :DWORD; phKey :PHCRYPTKEY) :BOOL; stdcall; Функция предназначена для генерации случайных сеансовых ключей и ключевых пар. Параметры этой функции аналогичны одноименным параметрам функции CryptDeriveKey, за исключением того, что Algid может также принимать значения AT_KEYEXCHANGE и AT_SIGNATURE. В этом случае будут сгенерированы ключевые пары соответственно для обмена ключами и цифровой подписи. Создание нового ключевого контейнера должно выглядеть примерно так:
uses Wcrypt2; ... var Prov: HCRYPTPROV; ExchangeKey, SignKey: HCRYPTKEY; begin CryptAcquireContext(@Prov,'My_Container',nil,PROV_RSA_FULL,CRYPT_NEWKEYSET); // Создаем ключевые пары CryptGenKey(Prov,AT_KEYEXCHANGE,0,@ExchangeKey); CryptGenKey(Prov,AT_SIGNATURE,0,@SignKey); // Работаем с функциями CryptoAPI ... // Освобождаем дескрипторы ключевых пар. Сами ключи сохраняются в контейнере CryptDestroyKey(SignKey); CryptDestroyKey(ExchangeKey); CryptReleaseContext(Prov,0); end; Созданные таким образом ключевые пары, впоследствии можно извлечь из контейнера, воспользовавшись функцией function CryptGetUserKey(hProv :HCRYPTPROV; dwKeySpec :DWORD; phUserKey :PHCRYPTKEY) :BOOL; stdcall; Параметр dwKeySpec может принимать два значения: AT_KEYEXCHANGE и AT_SIGNATURE, значения которых очевидны. Дескриптор ключа возвращается в параметре phUserKey.
Теперь ответим на вопрос, как отправитель сможет передать получателю свою открытую часть ключа.
function CryptExportKey(hKey :HCRYPTKEY; hExpKey :HCRYPTKEY; dwBlobType :DWORD; dwFlags :DWORD; pbData :PBYTE; pdwDataLen :PDWORD) :BOOL; stdcall; Функция позволяет экспортировать ключ в двоичный буфер, который впоследствии можно будет сохранить в файл и передать кому-либо. В параметре hKey должен содержаться дескриптор экспортируемого ключа. Экспортировать можно не только открытые ключи, а также ключевые пары целиком и сеансовые ключи. В последних двух случаях, ключи и ключевые пары должны быть созданы функциями CryptGenKey или CryptDeriveKey с параметрами dwFlags равными CRYPT_EXPORTABLE. Открытые же ключи всегда экспортируемы. Сеансовые ключи и ключевые пары экспортируются только в зашифрованном виде. Параметр hExpKey определяет ключ, которым они будут зашифрованы. Если экспортируется открытая часть ключа, то этот параметр следует установить в ноль, если экспортируется ключевая пара целиком, то здесь обычно передают дескриптор сеансового ключа (обычно полученный с помощью CryptDeriveKey), которым пара будет зашифрована, если экспортируется сеансовый ключ, то обычно он шифруется открытым ключом получателя (обычно используется ключ обмена, но никто не запрещает использовать ключ подписи). Параметр dwBlobType определяет тип экспортируемого ключа и может принимать следующие значения: SIMPLEBLOB - сеансовый ключ, PUBLICKEYBLOB - открытый ключ, PRIVATEKEYBLOB - ключевая пара целиком. Существуют и другие значения, но они не поддерживаются стандартным криптопровайдером. Параметр dwFlags для Microsoft Base Cryptographic Provider должен быть равен нулю. pbData - буфер, куда будут скопированы данные, pdwDataLen - размер этого буфера. Если он заранее не известен, то можно указать в качестве параметра pbData nil, и в pdwDataLen будет получен необходимый размер.
Вот пример экспорта открытого ключа: procedure ExportPublicKey(FileName: TFileName); var Prov: HCRYPTPROV; SignKey: HCRYPTKEY; Stream: TMemoryStream; BufSize: DWORD; begin CryptAcquireContext(@Prov,'My_Container',nil,PROV_RSA_FULL,0); CryptGetUserKey(Prov,AT_SIGNATURE,@SignKey); Stream:=TMemoryStream.Create; CryptExportKey(SignKey,0,PUBLICKEYBLOB,0,nil,@BufSize); Stream.SetSize(BufSize); CryptExportKey(SignKey,0,PUBLICKEYBLOB,0,PByte(Stream.Memory),@BufSize); Stream.SaveToFile(FileName); Stream.Free; CryptDestroyKey(SignKey); CryptReleaseContext(Prov,0); end; Импорт ключа осуществляется с помощью функции function CryptImportKey(hProv :HCRYPTPROV; pbData :PBYTE; dwDataLen :DWORD; hPubKey :HCRYPTKEY; dwFlags :DWORD; phKey :PHCRYPTKEY) :BOOL; stdcall; Тут практически все понятно. Поясню лишь, что в параметре hPubKey необходимо передать дескриптор ключа, которым будет расшифрован импортированный ключ. Если импортируется ключевая пара целиком, то параметр dwFlags можно установить в CRYPT_EXPORTABLE, тогда импортированная пара может быть впоследствии также экспортирована. В параметре phKey вернется дескриптор полученного ключа. Если это ключевая пара, то она будет сохранена в контейнере.
Вот пример импорта открытого ключа: function ImportPublicKey(FileName: TFileName): HCRYPTKEY; var Prov: HCRYPTPROV; Stream: TMemoryStream; begin Stream:=TMemoryStream.Create; Stream.LoadFromFile(FileName); CryptImportKey(Prov,PByte(Stream.Memory),Stream.Size,0,0,@Result); Stream.Free; end; Теперь, воспользовавшись этой информацией, вы без труда сможете восстановить пропущенные фрагменты в функции проверки цифровой подписи, описанной ранее.
Итак, как же передать собеседнику зашифрованное сообщение:
CryptGenKey(Prov,CALG_RC2,CRYPT_EXPORTABLE or CRYPT_CREATE_SALT,@Key); При экспорте ключа солт-значение не сохраняется, о нем должен позаботиться сам программист. var SaltLen: DWORD; Stream: TMemoryStream; ... begin ... // Определяем размер буфера для солт-значения CryptGetKeyParam(Key,KP_SALT,nil,@SaltLen,0); // Сохраняем его в файл Stream:=TMemoryStream.Create; Stream.SetSize(SaltLen); CryptGetKeyParam(Key,KP_SALT,PByte(Stream.Memory),@SaltLen,0); Stream.SaveToFile('Salt.dat'); Stream.Free; ... Сохраненное таким образом солт-значение необходимо передать вместе с сеансовым ключом, а на приемной стороне "вживить" его туда снова. var Stream: TMemoryStream; ... begin ... Stream:=TMemoryStream.Create; Stream.LoadFromFile('Salt.dat'); CryptSetKeyParam(Key,KP_SALT,PByte(Stream.Memory),Stream.Size); Stream.Free; ... Для работы с солт-значениями мы воспользовались функциями CryptGetKeyParam и CryptSetKeyParam, однако их возможности на этом не заканчиваются. Рекомендую ознакомиться с ними самостоятельно, а также с другими функциями, которые в данной статье не упоминались: CryptGenRandom, CryptDuplicateKey, CryptDublicateHash.
Другие полезности
К данной статье еще прилагаются некоторые бесплатные библиотеки и программы, которые не имеют отношения к CryptoAPI, но также работают со средствами криптографии и могут быть очень полезны:Использование инструментов криптографии в Delphi-приложениях
Юрий Спектор,Защита информации от несанкционированного доступа и распространения играет все более важную роль в современной жизни. Задача криптографии - обеспечить эту защиту. О том, чем могут быть полезны достижения этой науки для программиста, и как их использовать, и будет посвящена данная статья.
Оговорюсь, что тема, затрагиваемая в статье, весьма сложная и объемная. Приведенный здесь материал - лишь капля в море. Для тех, кого тема заинтересует, могу порекомендовать книги, например:
Основные понятия
Прежде всего, введем несколько понятий и терминов, чтобы в дальнейшем их смысл не вызывал у Вас вопросов или недопонимания.Открытый текст - собственно, это и есть та информация, которую мы будем пытаться защитить от несанкционированного доступа. "Открытый текст" - это вовсе не обязательно именно текст, это также могут быть двоичные данные, программный код, и т.д. Шифрованный текст - результат преобразования открытого текста, с использованием криптографических алгоритмов и дополнительного параметра (ключа) недоступный для восприятия. Шифрование - процесс создание шифрованного текста при наличии открытого текста и ключа. Дешифрование - процесс восстановления открытого текста из шифрованного при помощи ключа. Ключ - параметр шифра, необходимый для шифрования и/или дешифрования. Шифры подразделяются на две группы: Симметричные - для шифрования и дешифрования используется один и тот же ключ. Очевидно, что "секретность" шифрованного текста зависит от "секретности" ключа, поэтому такие ключи так и называются "секретными". Тут есть одна проблема: при передаче сообщения собеседнику, необходимо чтобы у него был тот же ключ, что и у Вас. А где гарантия, что при передаче ключа собеседнику, его никто не перехватит? Эта проблема решается с помощью асимметричных алгоритмов шифрования. Симметричные алгоритмы могут быть блочными (сообщение разбивается на блоки фиксированной длины, каждый из которых шифруется отдельно) и потоковыми (сообщение шифруется посимвольно). При использовании блочных шифров размер сообщения должен быть кратен размеру блока, в противном случае последний блок дополняется до необходимой длины. Блочные шифры считаются более надежными. Асимметричные - для шифрования и дешифрования используются разные ключи. Один из ключей держится в строжайшем секрете (он называется "закрытый"), другой - публикуется ("открытый"). Теперь представьте, что вы хотите передать какую-либо секретную информацию вашему другу или коллеге. Вы возьмете его открытый ключ (как уже было сказано - он не является секретным, и узнать его может кто угодно) и зашифруете с помощью его свое сообщение. Получив шифрованный текст, он попытается расшифровать его с помощью своего закрытого ключа. Так как закрытый ключ кроме него не известен никому, то полученное сообщение не сможет восстановить никто посторонний. Говоря об асимметричных шифрах, необходимо упомянуть еще одну замечательную возможность. Представьте, что вы зашифруете сообщение не открытым ключом получателя, а своим закрытым ключом. Расшифровать такое сообщение можно с помощью вашего открытого ключа, то есть все наоборот. Теперь получается, что расшифровать может кто угодно, а зашифровать - только вы. Кроме того, внести осмысленное изменение в сообщение (например, приписать нолик к денежной сумме) никто посторонний не сможет. Таким образом, получатель сможет аутентифицировать отправителя, т.е. он будет уверен, что отправитель сообщения именно вы и никто другой. Это называется электронно-цифровая подпись (ЭЦП) или просто цифровая подпись.
Какими бы замечательными асимметричные алгоритмы ни были, у них есть один существенный недостаток: по быстродействию они уступают симметричным раз в сто и используются в основном только для шифрования небольших сообщений. Поэтому на практике чаще всего применяют схемы, сочетающие в себе все достоинства и симметричных и асимметричных алгоритмов, например:
Хэш-функция - это такая функция, значение которой является необратимым преобразованием исходного значения. Другими словами, пусть у нас есть число A. Вычислим Y=H(A). Функция H будет необратимой, если зная значение Y восстановить A будет невозможно. Такому условию удовлетворяет, например, простейшая контрольная сумма, однако к хэш-функциям есть еще одно серьезное требование: очень сложной задачей должно являться нахождение такого числа B не равного A, что H(B) также будет равняться Y (такие случаи называются коллизиями). Число Y называют дайджестом или отпечатком сообщения. Где это может пригодиться? Например, хорошим решением будет хранить в базе данных паролей не сами пароли, а их отпечатки, при вводе пользователем пароля, высчитывать его отпечаток и сравнивать со значением в базе данных. Если злоумышленник получит доступ к этой базе, то пароли он узнать не сможет, так как хэш-функция необратима. Также он вряд ли сможет подобрать другой пароль с аналогичным отпечатком.
А теперь вернемся к цифровым подписям. Как уже было сказано, подписывать целое сообщение неразумно. В цифровой подписи главное не секретность самого сообщения, а гарантия того, что отправитель тот за кого себя выдает, и текст сообщения не был изменен после подписания. Обычно поступают так: высчитывается отпечаток сообщения (обычно он составляет 16-64 байт), шифруется закрытым ключом отправителя и передается вместе с самим сообщением. Получатель вычисляет отпечаток сообщения, расшифровывает подпись открытым ключом отправителя и сравнивает полученные значения. Эта процедура называется верификацией.
Популярные алгоритмы
До этого мы говорили о каких-то абстрактных алгоритмах, а теперь настало время назвать их по именам. Среди симметричных алгоритмов можно выделить алгоритм DES (разработанный фирмой IBM и утвержденный в 1977 году правительством США как официальный стандарт. Блочный алгоритм. Несмотря на популярность, алгоритм уязвим, истории известны случаи взлома), 3-DES, который на самом деле представляет собой ни что иное, как тройное шифрование DES тремя ключами, RC2 (блочный), RC4 (потоковый), IDEA (блочный). У каждого из них свои достоинства и недостатки.Среди асимметричных алгоритмов следует выделить RSA, названный в честь Рона Ривеста, Ади Шамира и Лена Адельмана, разработавших алгоритм в 1977 году. Идея алгоритма заключается в следующем: перемножить два числа намного проще, чем разложить произведение на множители. Об этом алгоритме я расскажу поподробнее.
Ну, и среди алгоритмов хеширования можно назвать следующие: MD4 (128-разрядный отпечаток), MD5 (Разработан в 1991 году, 128-разрядный отпечаток, пришел на смену MD4, в 2004 году в алгоритме обнаружена уязвимость, позволяющая довольно быстро находить коллизии), SHA-1 (Разработан в 1995 году, 160-разрядный отпечаток, долгое время был наиболее популярным, однако в начале 2005 года с ним произошло то же самое, что и с MD5. Брюс Шнайер заявил: " SHA-1 has been broken"), SHA-224, SHA-256, SHA-384, SHA-512.
Delphi - сбориник статей
I. Слежение за процессами
На первый взгляд, задача кажется малорешаемой. На второй - после поиска в MSDN - понимаешь, что она не решаема в User-mode в том смысле, что нет соответствующих API. А впрочем, когда это было проблемой для настоящих программистов?В режиме ядра задача решается тривиально - в драйвере регистрируешь callback функцией PsSetCreateProcessNotifyRoutine и он будет вызван при создании/удалении процесса. Но нам нужна реализация в user-mode...
Ограничимся тем, что будем отлавливать создание процессов. Первое, что приходит на ум, это следующий алгоритм:
Для Delphi порт заголовочных файлов существует в нескольких вариантах, наиболее распространен вариант JEDI. Только, при использовании JEDI, придется все Zw-функции заменить на их Nt-аналоги. Впрочем, в режиме пользователя эти функции абсолютно идентичны. Разница наблюдается только в режиме ядра, подробнее читайте статью http://www.osronline.com/article.cfm?article=257 (она доступна только по подписке, или в кэше Google )
program process_seeker; {$APPTYPE CONSOLE} uses SysUtils, windows, tintlist; type NTStatus = cardinal; PVOID = pointer; USHORT = WORD; UCHAR = byte; PWSTR = PWideChar; CONST //Статус константы STATUS_SUCCESS = NTStatus($00000000); STATUS_ACCESS_DENIED = NTStatus($C0000022); STATUS_INFO_LENGTH_MISMATCH = NTStatus($C0000004); const SystemProcessesAndThreadsInformation = 5; type PClientID = ^TClientID; TClientID = packed record UniqueProcess:cardinal; UniqueThread:cardinal; end; PUnicodeString = ^TUnicodeString; TUnicodeString = packed record Length: Word; MaximumLength: Word; Buffer: PWideChar; end; PVM_COUNTERS = ^VM_COUNTERS; VM_COUNTERS = packed record PeakVirtualSize, VirtualSize, PageFaultCount, PeakWorkingSetSize, WorkingSetSize, QuotaPeakPagedPoolUsage, QuotaPagedPoolUsage, QuotaPeakNonPagedPoolUsage, QuotaNonPagedPoolUsage, PagefileUsage, PeakPagefileUsage: dword; end; PIO_COUNTERS = ^IO_COUNTERS; IO_COUNTERS = packed record ReadOperationCount, WriteOperationCount, OtherOperationCount, ReadTransferCount, WriteTransferCount, OtherTransferCount: LARGE_INTEGER; end; PSYSTEM_THREADS = ^SYSTEM_THREADS; SYSTEM_THREADS = packed record KernelTime, UserTime, CreateTime: LARGE_INTEGER; WaitTime: dword; StartAddress: pointer; ClientId: TClientId; Priority, BasePriority, ContextSwitchCount: dword; State: dword; WaitReason: dword; end; PSYSTEM_PROCESSES = ^SYSTEM_PROCESSES; SYSTEM_PROCESSES = packed record NextEntryDelta, ThreadCount: dword; Reserved1 : array [0..5] of dword; CreateTime, UserTime, KernelTime: LARGE_INTEGER; ProcessName: TUnicodeString; BasePriority: dword; ProcessId, InheritedFromProcessId, HandleCount: dword; Reserved2: array [0..1] of dword; VmCounters: VM_COUNTERS; IoCounters: IO_COUNTERS; // Windows 2000 only Threads: array [0..0] of SYSTEM_THREADS; end; Function ZwQuerySystemInformation(ASystemInformationClass: dword; ASystemInformation: Pointer; ASystemInformationLength: dword; AReturnLength:PCardinal): NTStatus; stdcall;external 'ntdll.dll'; { Получение буфера с системной информацией } Function GetInfoTable(ATableType:dword):Pointer; var mSize: dword; mPtr: pointer; St: NTStatus; begin Result := nil; mSize := $4000; //начальный размер буфера repeat mPtr := VirtualAlloc(nil, mSize, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE); if mPtr = nil then Exit; St := ZwQuerySystemInformation(ATableType, mPtr, mSize, nil); if St = STATUS_INFO_LENGTH_MISMATCH then begin //надо больше памяти VirtualFree(mPtr, 0, MEM_RELEASE); mSize := mSize * 2; end; until St <> STATUS_INFO_LENGTH_MISMATCH; if St = STATUS_SUCCESS then Result := mPtr else VirtualFree(mPtr, 0, MEM_RELEASE); end; var info, info2: PSystem_Processes; i, j, k: integer; t, t1: LARGE_INTEGER; process_id: tintegerlist; begin process_id := TIntegerList.Create; //СОЗДАЕМ СПИСОК ПРОЦЕССОВ НА МОМЕНТ СОЗДАНИЯ НАШЕГО ПРОЦЕССА info := GetInfoTable(SystemProcessesAndThreadsInformation); info2 := info; while (info2^.NextEntryDelta <> 0) do begin if (process_id.IndexOf(info2^.ProcessId)=-1) then process_id.Add(info2^.ProcessId); info2 := Pointer(dword(info2)+info2^.NextEntryDelta); end; VirtualFree(info, 0, MEM_RELEASE); //А теперь смотрим что добавилось while true do begin Sleep(200); info := GetInfoTable(SystemProcessesAndThreadsInformation); info2 := info; while (info2^.NextEntryDelta <> 0) do begin if (process_id.IndexOf(info2^.ProcessId)=-1) then begin writeln(info2^.ProcessId, ' - created'); process_id.Add(info2^.ProcessId); end; info2 := Pointer(dword(info2)+info2^.NextEntryDelta); end; VirtualFree(info, 0, MEM_RELEASE); end; end. Вы можете легко переделать этот код для того, чтобы отслеживать также и терминирование процессов :) Оставим это читателю в качестве домашнего задания :)
II. Слежение за файлами
Здесь можно применить либо тот же подход что описан выше для процессов либо воспользоваться портами завершения.Приведем реализацию первого метода program file_seeker; {$APPTYPE CONSOLE} uses SysUtils, windows, tintlist; type NTStatus = cardinal; PVOID = pointer; USHORT = WORD; UCHAR = byte; PWSTR = PWideChar; CONST //Статус константы STATUS_SUCCESS = NTStatus($00000000); STATUS_ACCESS_DENIED = NTStatus($C0000022); STATUS_INFO_LENGTH_MISMATCH = NTStatus($C0000004); SEVERITY_ERROR = NTStatus($C0000000); const SystemHandleInformation = 16; OB_TYPE_FILE = 28; type PClientID = ^TClientID; TClientID = packed record UniqueProcess:cardinal; UniqueThread:cardinal; end; PUnicodeString = ^TUnicodeString; TUnicodeString = packed record Length: Word; MaximumLength: Word; Buffer: PWideChar; end; PSYSTEM_HANDLE_INFORMATION = ^SYSTEM_HANDLE_INFORMATION; SYSTEM_HANDLE_INFORMATION = packed record ProcessId: dword; ObjectTypeNumber: byte; Flags: byte; Handle: word; pObject: pointer; GrantedAccess: dword; end; PSYSTEM_HANDLE_INFORMATION_EX = ^SYSTEM_HANDLE_INFORMATION_EX; SYSTEM_HANDLE_INFORMATION_EX = packed record NumberOfHandles: dword; Information: array [0..0] of SYSTEM_HANDLE_INFORMATION; end; Function ZwQuerySystemInformation(ASystemInformationClass: dword; ASystemInformation: Pointer; ASystemInformationLength: dword; AReturnLength:PCardinal): NTStatus; stdcall;external 'ntdll.dll'; { Включение заданой привилегии для процесса } function EnablePrivilegeEx(Process: dword; lpPrivilegeName: PChar):Boolean; var hToken: dword; NameValue: Int64; tkp: TOKEN_PRIVILEGES; ReturnLength: dword; begin Result:=false; //Получаем токен нашего процесса OpenProcessToken(Process, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken); //Получаем LUID привилегии if not LookupPrivilegeValue(nil, lpPrivilegeName, NameValue) then begin CloseHandle(hToken); exit; end; tkp.PrivilegeCount := 1; tkp.Privileges[0].Luid := NameValue; tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; //Добавляем привилегию к процессу AdjustTokenPrivileges(hToken, false, tkp, SizeOf(TOKEN_PRIVILEGES), tkp, ReturnLength); if GetLastError() <> ERROR_SUCCESS then begin CloseHandle(hToken); exit; end; Result:=true; CloseHandle(hToken); end; { включение заданной привилегии для текущего процесса } function EnablePrivilege(lpPrivilegeName: PChar):Boolean; begin Result := EnablePrivilegeEx(INVALID_HANDLE_VALUE, lpPrivilegeName); end; { Включение привилегии SeDebugPrivilege для процесса } function EnableDebugPrivilegeEx(Process: dword):Boolean; begin Result := EnablePrivilegeEx(Process, 'SeDebugPrivilege'); end; { Включение привилегии SeDebugPrivilege для текущего процесса } function EnableDebugPrivilege():Boolean; begin Result := EnablePrivilegeEx(INVALID_HANDLE_VALUE, 'SeDebugPrivilege'); end; { Получение буфера с системной информацией } Function GetInfoTable(ATableType:dword):Pointer; var mSize: dword; mPtr: pointer; St: NTStatus; begin Result := nil; mSize := $4000; //начальный размер буфера repeat mPtr := VirtualAlloc(nil, mSize, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE); if mPtr = nil then Exit; St := ZwQuerySystemInformation(ATableType, mPtr, mSize, nil); if St = STATUS_INFO_LENGTH_MISMATCH then begin //надо больше памяти VirtualFree(mPtr, 0, MEM_RELEASE); mSize := mSize * 2; end; until St <> STATUS_INFO_LENGTH_MISMATCH; if St = STATUS_SUCCESS then Result := mPtr else VirtualFree(mPtr, 0, MEM_RELEASE); end; var HandlesInfo: PSYSTEM_HANDLE_INFORMATION_EX; r: integer; hProcess, tHandle: dword; file_h: tintegerlist; begin file_h := tintegerlist.Create; EnableDebugPrivilege(); HandlesInfo := GetInfoTable(SystemHandleInformation); for r := 0 to HandlesInfo^.NumberOfHandles do if HandlesInfo^.Information[r].ObjectTypeNumber = OB_TYPE_FILE then begin file_h.Add(HandlesInfo^.Information[r].Handle); end; VirtualFree(HandlesInfo, 0, MEM_RELEASE); //а теперь смотрим что изменилось while true do begin Sleep(200); HandlesInfo := GetInfoTable(SystemHandleInformation); for r := 0 to HandlesInfo^.NumberOfHandles do if HandlesInfo^.Information[r].ObjectTypeNumber = OB_TYPE_FILE then begin if file_h.IndexOf(HandlesInfo^.Information[r].Handle)=-1 then begin file_h.Add(HandlesInfo^.Information[r].Handle); writeln(HandlesInfo^.Information[r].Handle, ' - added a file handle'); end; end; VirtualFree(HandlesInfo, 0, MEM_RELEASE); end; readln; end. Вторая технология - использование ReadDirectoryChangesA(W) и портов завершения ввода/вывода, реализация несложная, исходники (не мои, откомментированные) брать здесь.
III. Outro
Безусловно, все эти решения - некие "полумеры", самое лучшее - писать драйвер. Но это достаточно нетривиальная задача, так что...Я надеюсь, что Вы найдете применение описанному в статье, или хотя бы, что эта статья была Вам интересна.
Возможно, в последующих статьях я опишу как это все можно реализовать с помощью перехвата API. Файлы и статья доступны с моего сайта
Delphi - сбориник статей
К материалу прилагаются файлы:
Перенос VBA-макросов в Delphi
Александр Шабля, Запись макроса (меню Excel "Сервис\Макрос\Начать запись…") незаменимая вещь при написании отчетов или создания диаграмм в Excel'е, особенно для тех, кто только начинает с ним работать. Но, записанный в Excel макрос, иногда выглядит довольно громоздко и читается с трудом. В данной статье я хочу рассмотреть методы перевода записанных макросов в более удобный вид для использования их в Delphi. Также будет рассмотрены некоторые нестыковки в объектной модели Excel'я в записанных макросах и методы их исправления.Для начала рассмотрим записанные в Excel'е макросы и попробуем сократить их VBA-код для переноса в Delphi. Откроем в Excel'e новую книгу и выполним, к примеру, простые действия - запустим запись макроса, выделим область "A1:D5" и в тулбаре "Границы" выберем "Все границы". Остановим запись макроса и посмотрим, что у нас получилось. Должен появиться примерно такой код (чтоб открыть VBA редактор в Excel'е нажмите Alt+F11): Sub Макрос1() ' Range("A1:D5").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End Sub Да, многовато… Давайте посмотрим, что содержит полученный VBA-код:
Очистим область "A1:D5" от границ и запустим наш макрос (перейдите в Excel из редактора, нажмите Alt+F8, выберите Макрос1_1 и нажмите "Выполнить"). Код намного короче, а результат тот же! Что мы сделали? Во-первых, убрали Select, просто указав какую область мы будем "обордюривать", во-вторых, вообще не указали какие границы будем заполнять, просто написав Borders без параметров (т.е. все). Почему понадобилось убирать Select? Потому что, во-первых, можно обойтись без него, а во-вторых, Select вызывает доп. перерисовку экрана, а это, как известно, самые долгие операции.
Теперь перейдем к другой "особенности" записи макроса, а именно к непонятному свойству объекта [Excel.]Application Selection. Что это такое? В данном макросе, как можно догадаться это область ячеек (Range). Давайте запишем еще один макрос: добавим окно инструментов "Рисование", включим запись макроса, выберем тулбар "Надпись", поместим ее на наш лист и наберем текст "Наша надпись". Выделим ячейку A1 и остановим запись макроса. Должен получиться примерно такой код: Sub Макрос2() ' ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 19.5, 88.5, _ 191.25, 86.25).Select Selection.Characters.Text = "Наша надпись" With Selection.Characters(Start:=1, Length:=7).Font .Name = "Arial" .FontStyle = "обычный" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("A1").Select End Sub Опять попробуем сократить код: Sub Макрос2_2() Dim MyShape As Shape Set MyShape = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _ 19.5, 88.5, 191.25, 86.25) MyShape.Characters.Text = "Наша надпись" End Sub
Перейдем в Excel, удалим нашу надпись и выполним макрос Макрос2_2. Получим ошибку "Объект не поддерживает данное свойство или метод" на строке с кодом MyShape.Characters.Text = "Наша надпись". Почему Selection его поддерживает, а Shape нет? Посмотрев на объект Shape мы не найдем свойства Characters. Что же скрывается за загадочным Selection? Для того чтобы это понять давайте в Макрос2, добавим строку MsgBox TypeName(Selection) после строки Selection.Characters.Text = "Наша надпись" и выполним макрос. Получим сообщение "TextBox".
Вот оно что! Значит Selection - это TextBox. Попробуем создать такой объект и… Нет такого объекта! Есть только TextFrame. Замена Shape на TextFrame тоже не увенчается успехом… Что же делать?
Посмотрим на свойства объекта Shape и увидим там свойство TextFrame, у которого уже есть свойство Characters… Посмотрев справку по VBA можно убедиться, что Characters - это метод и принадлежит объекту TextFrame. Пробуем: Sub Макрос2_2() ' Dim MyShape As Shape Set MyShape = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _ 19.5, 88.5, 191.25, 86.25) MyShape.TextFrame.Characters.Text = "Наша надпись" End Sub
Запустим макрос - работает! Оставим мифический TextBox на совести Microsoft… Примечание:
объект TextBox таки существует, но только как Control для Form.
Еще небольшой пример на VBA про Selection и займемся непосредственно переносом кода из VBA в Delphi. Откройте файл Книга1.xls, который приложен к статье и перейдите на Лист2. Там таблица и график. Включим запись макроса, выделим первый столбик, вызовем "Формат рядов данных" и изменим цвет на темно синий. Остановим запись. Должен получиться примерно такой код: Sub Макрос3() ' ActiveSheet.ChartObjects("Диагр. 1").Activate ActiveChart.SeriesCollection(1).Select With Selection.Border .Weight = xlThin .LineStyle = xlAutomatic End With Selection.InvertIfNegative = False With Selection.Interior .ColorIndex = 23 .Pattern = xlSolid End With End Sub
Проверим, как он работает - перейдем в Excel, вызовем макросы и запустим Макрос3… Ошибка на первой же строке! Записанный макрос не работает. Почему? Попробуем сделать так, чтоб он заработал. Напишем небольшой макрос (руками) и будем вставлять в него код и тестировать. Начнем с определения имен имеющихся на листе диаграмм: Sub Test1() Dim i As Integer For i = 1 To ActiveSheet.ChartObjects.Count MsgBox ActiveSheet.ChartObjects(i).Name Next i End Sub
Запустив макрос, получим имя диаграммы "Chart 1" - почему не "Диагр. 1", как в записанном макросе - это очередная загадка. Исправим макрос и проверим: Sub Макрос3() ' ActiveSheet.ChartObjects("Chart 1").Activate ActiveChart.SeriesCollection(1).Select With Selection.Border .Weight = xlThin .LineStyle = xlAutomatic End With Selection.InvertIfNegative = False With Selection.Interior .ColorIndex = 23 .Pattern = xlSolid End With End Sub Работает :o).
Дальше определим тип объекта после строки ActiveChart.SeriesCollection(1).Select известной строкой MsgBox TypeName(Selection). Получим Series. Сократим макрос и избавимся от Selection. Sub Макрос3_3() ' Dim ch As Chart, s As Series Set ch = ActiveSheet.ChartObjects("Chart 1").Chart Set s = ch.SeriesCollection(1) With s.Interior .ColorIndex = 23 .Pattern = xlSolid End With End Sub
Если посмотреть на код Макрос3 и Макрос3_3, то видно, что код в Макрос3 использует Selection как промежуточный буфер для передачи управления между объектами, т.е. Activate, Select и для "безликого" вызова свойств и методов. Чтобы получить объект типа Chart нам понадобилось добавить обращение к свойству ChartObject.Chart Set ch = ActiveSheet.ChartObjects("Chart 1").Chart Дальше мы просто поменяли цвет столбика без использования Select.
Конечно, это далеко не все загадки при записи макросов — их еще много, но нам сейчас нужно было понять, что это возможно и как с этим бороться. Перенесем наш код в Delphi и параллельно в C# (если не возражаете).
Сразу оговорюсь, что в статье не рассматриваются методы подключения к Excel'ю (по данному вопросу можно почитать здесь ), также используется раннее связывание (что это такое читайте здесь).
Я считаю позднее связывание не "паскалевким" подходом, так как везде используется один тип Variant (как в языке "Основняк"), что, по моему, сродни шаманизму — что-то происходит, что-то куда то записывается, но никто не понимает, почему это работает.
Начнем с Макрос1. Да, именно с него, а не сокращенного варианта. Попытаемся написать код для первых трех строк:
Delphi ASheet.Range['A1:D5', EmptyParam].Select; XL.Selection[lcid].Borders[xlDiagonalDown].LineStyle := xlNone; XL.Selection[lcid].Borders[xlDiagonalUp].LineStyle := xlNone;
Попробовав скомпилировать данный участок, сразу же получим ошибку компилятора "E2003 Undeclared identifier: 'Borders'". Посмотрим, какой тип имеет Selection (в данном примере смотрим файл Excel2000.pas): property ExcelApplication.Selection[lcid: Integer]: IDispatch;
Посмотрев на интерфейс IDispatch, мы в самом деле не найдем такого свойства и метода... Попробуем подправить код:
Delphi ASheet.Range['A1:D5', EmptyParam].Select; (XL.Selection[lcid] As ExcelRange).Borders[xlDiagonalDown].LineStyle := xlNone; (XL.Selection[lcid] As ExcelRange).Borders[xlDiagonalUp].LineStyle := xlNone; With (XL.Selection[lcid] As ExcelRange).Borders[xlEdgeLeft] do begin LineStyle := xlContinuous; Weight := xlThin; ColorIndex := xlAutomatic; End; With (XL.Selection[lcid] As ExcelRange).Borders[xlEdgeTop] do begin LineStyle := xlContinuous; Weight := xlThin; ColorIndex := xlAutomatic; End; With (XL.Selection[lcid] As ExcelRange).Borders[xlEdgeBottom] do begin LineStyle := xlContinuous; Weight := xlThin; ColorIndex := xlAutomatic; End; With (XL.Selection[lcid] As ExcelRange).Borders[xlEdgeRight] do begin LineStyle := xlContinuous; Weight := xlThin; ColorIndex := xlAutomatic; End;
C# ASheet.get_Range("A1:D5", Type.Missing).Select(); ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlDiagonalDown).LineStyle = Excel.XlLineStyle.xlLineStyleNone; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlDiagonalUp).LineStyle = Excel.XlLineStyle.xlLineStyleNone; // левая граница ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeLeft).LineStyle = Excel.XlLineStyle.xlContinuous; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeLeft).Weight = Excel.XlBorderWeight.xlThin; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeLeft).ColorIndex = Excel.XlColorIndex.xlColorIndexAutomatic; // верхняя граница ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeTop).LineStyle = Excel.XlLineStyle.xlContinuous; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeTop).Weight = Excel.XlBorderWeight.xlThin; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeTop).ColorIndex = Excel.XlColorIndex.xlColorIndexAutomatic; // нижняя граница ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlContinuous; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeBottom).Weight = Excel.XlBorderWeight.xlThin; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeBottom).ColorIndex = Excel.XlColorIndex.xlColorIndexAutomatic; // правая граница ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeRight).LineStyle = Excel.XlLineStyle.xlContinuous; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeRight).Weight = Excel.XlBorderWeight.xlThin; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeRight).ColorIndex = Excel.XlColorIndex.xlColorIndexAutomatic;
Работает… Что мы для этого сделали? Привели тип IDispatch к ExcelRange: XL.Selection[lcid] as ExcelRange). Но такой перевод записанного макроса в Delphi поистине героический труд, да и нужен ли нам Select для того чтоб нарисовать границы (а глядя на C# код, вообще можно сразу отказаться на нем программировать)? Ведь всякая перерисовка - лишняя трата времени и, следовательно, скорости. Поэтому займемся Макросом1_1:
Delphi With ASheet.Range['A1:D5', EmptyParam].Borders do begin LineStyle := xlContinuous; Weight := xlThin; ColorIndex := xlAutomatic; End;
C# oRng = ASheet.get_Range("A1:D5", Type.Missing); // установим две границы oRng.Borders.LineStyle = Excel.XlLineStyle.xlContinuous; oRng.Borders.Weight = Excel.XlBorderWeight.xlThin; oRng.Borders.ColorIndex = Excel.XlColorIndex.xlColorIndexAutomatic;
Различия есть? Мы не делали Select и не использовали безликий Selection, обратившись непосредственно к области ExcelRange. Или все же лучше с Selection? Сравните:
Delphi ASheet.Range['A1:D5', EmptyParam].Select; With (XL.Selection[lcid] As ExcelRange).Borders do begin LineStyle := xlContinuous; Weight := xlThin; ColorIndex := xlAutomatic; End;
Все то же самое, но что-то рябит в глазах при Select, не правда ли? И вроде как-то медленнее или мне показалось? Перейдем к Макрос2, вернее к уже подготовленному Макрос2_2:
Delphi MyShape := (XL.ActiveWorkbook.ActiveSheet As _Worksheet).Shapes.AddTextbox( msoTextOrientationHorizontal, 19.5, 88.5, 191.25, 86.25); MyShape.TextFrame.Characters(EmptyParam, EmptyParam).Text := 'Наша надпись';
C# myShape = (Excel.Shape) ASheet.Shapes.AddTextbox( Office.MsoTextOrientation.msoTextOrientationHorizontal, (float) 19.5, (float) 88.5, (float) 191.25, (float) 86.25); myShape.TextFrame.Characters(Type.Missing, Type.Missing).Text = "Наша надпись";
В коде на Delphi практически никаких отличий, кроме указания двух обязательных параметров: начала изменяемых символов и их длины. Мы написали EmptyParam, тем самым указав, что обрабатывается весь текст.
И, наконец, Макрос3_3. Усложним его - полностью создадим таблицу с данными, создадим график и изменим цвет первого столбца:
Delphi oSheet.Cells.Item[1, 1] := 'First Name'; oSheet.Cells.Item[1, 2] := 'Last Name'; oSheet.Cells.Item[1, 3] := 'Full Name'; oSheet.Cells.Item[1, 4] := 'Salary'; //Format A1:D1 as bold, vertical alignment := center. oSheet.Range['A1', 'D1'].Font.Bold := True; oSheet.Range['A1', 'D1'].VerticalAlignment := xlVAlignCenter; // Create an array to multiple values at once. saNames := VarArrayCreate([0, 4, 0, 1], varVariant); saNames[0, 0] := 'John'; saNames[0, 1] := 'Smith'; saNames[1, 0] := 'Tom'; saNames[1, 1] := 'Brown'; saNames[2, 0] := 'Sue'; saNames[2, 1] := 'Thomas'; saNames[3, 0] := 'Jane'; saNames[3, 1] := 'Jones'; saNames[4, 0] := 'Adam'; saNames[4, 1] := 'Johnson'; oSheet.Range['A2', 'B6'].Formula := saNames; oRng := oSheet.Range['C2', 'C6']; oRng.Formula := '=A2 & " " & B2'; oRng := oSheet.Range['D2', 'D6']; oRng.Formula := '=RAND()*100000'; oSheet.Range['A1', 'D1'].EntireColumn.AutoFit; // создадим график на листе в обласи E8:L29 Ch := (oSheet.ChartObjects As ChartObjects).Add( oSheet.Range['B8', EmptyParam].Left, oSheet.Range['B8', EmptyParam].Top, oSheet.Range['I8', EmptyParam].Left - oSheet.Range['B8', EmptyParam].Left, oSheet.Range['B30', EmptyParam].Top - oSheet.Range['B8', EmptyParam].Top).Chart As _Chart; oRng := oSheet.Range['C1', 'D6']; With Ch do begin SetSourceData(oRng, xlRows); ChartType := xl3DColumnClustered; HasTitle[lcid] := True; ChartTitle[lcid].Characters[EmptyParam, EmptyParam].Text := 'Диаграмма 1'; (Axes(xlCategory, xlPrimary, lcid) As Axis).HasTitle := False; (Axes(xlValue, xlPrimary, lcid) As Axis).HasTitle := True; (Axes(xlValue, xlPrimary, lcid) As Axis).AxisTitle. Characters[EmptyParam, EmptyParam].Text := 'Деньги'; (Axes(xlValue, xlPrimary, lcid) As Axis).AxisTitle.Orientation := xlUpward; End; // здесь код замены цвета у первого столбика // взятый из Макрос3_3 With (Ch.SeriesCollection(1, lcid) As Series) do begin Interior.ColorIndex := 23; Interior.Pattern := xlSolid; End;
C# oSheet.Cells[1, 1] = "First Name"; oSheet.Cells[1, 2] = "Last Name"; oSheet.Cells[1, 3] = "Full Name"; oSheet.Cells[1, 4] = "Salary"; //Format A1:D1 as bold, vertical alignment := center. oSheet.get_Range("A1", "D1").Font.Bold = true; oSheet.get_Range("A1", "D1").VerticalAlignment = Excel.XlVAlign.xlVAlignCenter; oSheet.get_Range("A1", "D1").HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter; // Create an array to multiple values at once. string[,] saNames = new string[5, 2]; saNames[0, 0] = "John"; saNames[0, 1] = "Smith"; saNames[1, 0] = "Tom"; saNames[1, 1] = "Brown"; saNames[2, 0] = "Sue"; saNames[2, 1] = "Thomas"; saNames[3, 0] = "Jane"; saNames[3, 1] = "Jones"; saNames[4, 0] = "Adam"; saNames[4, 1] = "Johnson"; oSheet.get_Range("A2", "B6").Formula = saNames; //Fill C2:C6 with a relative formula (=A2 & " " & B2). oRng = oSheet.get_Range("C2", "C6"); oRng.Formula = "=A2 & \" \" & B2"; //Fill D2:D6 with a formula(=RAND()*100000) and apply format. oRng = oSheet.get_Range("D2", "D6"); // oRng.Formula = "=RAND()*100000"; oRng.Formula = "=СЛЧИС()*100000"; // oRng.NumberFormat = "0.00"; //AutoFit columns A:D. oRng = oSheet.get_Range("A1", "D1"); oRng.EntireColumn.AutoFit(); // создадим график на листе в обласи E8:L29 Ch = ((Excel.ChartObjects) oSheet.ChartObjects(Type.Missing)).Add( (double) oSheet.get_Range("B8", Type.Missing).Left, (double) oSheet.get_Range("B8", Type.Missing).Top, (double) oSheet.get_Range("I8", Type.Missing).Left - (double) oSheet.get_Range("B8", Type.Missing).Left, (double) oSheet.get_Range("B30", Type.Missing).Top - (double) oSheet.get_Range("B8", Type.Missing).Top ).Chart; oRng = oSheet.get_Range("C1", "D6"); Ch.SetSourceData(oRng, Excel.XlRowCol.xlRows); Ch.ChartType = Excel.XlChartType.xl3DColumnClustered; Ch.HasTitle = true; Ch.ChartTitle.get_Characters(Type.Missing, Type.Missing).Text = "Диаграмма 1"; ((Excel.Axis) Ch.Axes(Excel.XlAxisType.xlCategory, Excel.XlAxisGroup.xlPrimary)).HasTitle = false; ((Excel.Axis) Ch.Axes(Excel.XlAxisType.xlValue, Excel.XlAxisGroup.xlPrimary)).HasTitle = true; ((Excel.Axis) Ch.Axes(Excel.XlAxisType.xlValue, Excel.XlAxisGroup.xlPrimary)).AxisTitle. get_Characters(Type.Missing, Type.Missing).Text = "Деньги"; ((Excel.Axis) Ch.Axes(Excel.XlAxisType.xlValue, Excel.XlAxisGroup.xlPrimary)).AxisTitle.Orientation = Excel.XlOrientation.xlUpward; // здесь код замены цвета у первого столбика // взятый из Макрос3_3 ((Excel.Series) Ch.SeriesCollection(1)).Interior.ColorIndex = 23; ((Excel.Series) Ch.SeriesCollection(1)).Interior.Pattern = Excel.XlPattern.xlPatternSolid;
Из перенесенных строк из Макрос3_3 видно, что коллекция Ch.SeriesCollection(1, lcid) тоже возвращает интерфейс IDispatch, поэтому мы привели ее к типу Series. Почему в библиотеке типов сразу не использован тип Series остается только гадать. Еще в только что описанном примере приведен код задания титулов для осей (axes) и здесь метаморфоза превращения Axes в Axis, т.е. Axes - это коллекция Axis, хотя в VBA это ни как не отображается.
Мы рассмотрели несколько примеров перевода
Мы рассмотрели несколько примеров перевода VBA кода, созданного записью макроса в Excel в Delphi. Увидели, как можно сократить ненужный код, избавившись от Select. Как уйти от безликого Selection (тип IDispatch) во избежание ошибок и возможных недоразумений. Также обнаружили несоответствие записанного кода (к примеру, имени объекта "Наша надпись") и типов реальным типам объектов. Т.е. записанный код VBA не всегда оказывается работоспособным. Для правильного перевода VBA в Delphi требуется представление об объектной модели Excel'я, обращение к справке Excel VBA, а также большое желание достигнуть результата.Delphi - сбориник статей
Используемая литература
| 1. | Круглински Д., Уингоу С., Шеферд Дж. Программирование на Microsoft Visual C++ 6.0 для профессионалов Пер. с англ. – СПб: Питер; М.:Издательско-торговый дом «Русская редакция», 2001 – 864 с.:ил. |
| 2. | Кэнту М. Delphi 6 для профессионалов (+СD). – Питер, 2002. – 1088с.: ил. |
| 3. | Лишнер Р. Delphi. Справочник. – Пер. с англ. – СПб: Символ-Плюс, 2001. – 640 с., ил. |
| 4. | С. Тейксейра, К. Пачеко Delphi 5. Руководство разработчика. |
| 5. | Озеров В. Delphi. Советы программистов. – СПб: Символ-Плюс, 2002.-912 с.,ил. |
Немного практики
Для примера будет использован несложный и бесполезный класс на С++, состряпанный на ходу. В MS VC++ создадим проект, используя MFC AppWizard(exe), без использования представления «Документ-вид», на основе диалога, и обзовем его «example_exe». Добавим два новых файла – example.cpp и example.h.Файл example.h:
//***************************************************************************** // традиционный финт ушами во избежание // повторного включения файла .h #if !defined(EXAMPLE__INCLUDED) #define EXAMPLE__INCLUDED // введем парочку структур для демонстрации работы с ними typedef struct { int n; int i; short j; char k; }struct_1; typedef struct { int n2; short a[3]; }struct_2; // Класс-пример. Ничего полезного, просто демонстрация. class CExample { private: int Field; CString Name; void Show(CString str); public: // конструктор и деструктор, как полагается CExample(int F, CString N); ~CExample(); // просто сообщение void Message(CString str, int Digit); // «процедура» и «функция» void Proc(int * Digit); int Func(int Number); // работа с закрытым полем void SetF(int F); int GetF(); // работа со структурами struct_2 * Struct1to2(struct_1 s1); }; #endif //if !defined(EXAMPLE__INCLUDED) //***************************************************************************** В классе есть пара закрытых полей, закрытая функция-член, набор открытых функций. Конструктор принимает два параметра. Строковый параметр будем интерпретировать, как имя объекта. Функция Message нужна для отображения на экране хоть каких-то сообщений, демонстрирующих, что что-то происходит. Proc имитирует процедуру, то есть, не возвращает значения, зато изменяет что-то в программе, в нашем случае, переданный параметр. Func и есть функция, то есть, ничего не изменяет, зато вычисляет некоторое значение и возвращает его. Плюс здесь же установщик и считыватель закрытого поля, а также простенькая демонстрация работы со структурами.
Файл example.срр:
//***************************************************************************** #include "stdafx.h" #include "Example.h" // конструктор инициализирует два закрытых поля // и выдает сообщение об успешном создании // при помощи закрытой функции CExample::CExample(int F, CString N) { this->Field = F; this->Name = N; this->Show(N + " Created successfully"); } // деструктор только сообщает о самоликвидации CExample::~CExample() { this->Show("Deleted successfully"); } // закрытая функция, по сути – оболочка MessageBox'а // заголовком бокса будет имя класса void CExample::Show(CString str) { ::MessageBox(NULL, str, this->Name, MB_OK); } // открытая функция, выводит строку и число в десятичном виде. void CExample::Message(CString str, int Digit) { str.Format(str + " %d", Digit); this->Show(str); } // "процедура" не возвращает значение, зато изменяет параметр void CExample::Proc(int * Digit) { *Digit *= 2; } // "функция" не изменяет параметр, зато возвращает значение int CExample::Func(int Number) { int Result; Result = Number * 2; return Result; } // банально присваиваем значение параметра закрытому полю. void CExample::SetF(int F) { this->Field = F; } // еще банальнее... int CExample::GetF() { return this->Field; } // присваиваем значения полей одной структуры полям другой struct_2 * CExample::Struct1to2(struct_1 s1) { struct_2 * s2 = new struct_2; s2->n2 = s1.n * 2; s2->a[0] = s1.i; s2->a[1] = s1.j; s2->a[2] = s1.k; return s2; } //***************************************************************************** Для примера более, чем достаточно. Теперь надо посмотреть, как это работает.
В файле Example_exeDlg.h в описании класса CExample_exeDlg где-нибудь в секции public надо вписать
CExample * ex;
то есть, объявить переменную-член, указатель на наш учебно-тренировочный класс, и в конструкторе Example_exeDlg вписать
ex = NULL;
Можно ex сделать и не членом, в принципе, и инициализировать при объявлении. И, конечно, не забыть наверху этого же файла вклеить заголовочный файл класса:
#include "Example.h"
На диалоговую форму накидаем кнопок и создадим их обработчики: void CExample_exeDlg::OnBtCreate()
{
if (ex == NULL)
ex = new CExample(7, "Example");
}
Если объект еще не создан – создаем и инициализируем пару закрытых полей.
void CExample_exeDlg::OnBtDestroy()
{
delete ex;
ex = NULL;
}
Освобождаем память и устанавливаем указатель в «пусто»
void CExample_exeDlg::OnBtMessage()
{
ex->Message("Any digit - ", 3);
}
Демонстрационное сообщение.
void CExample_exeDlg::OnBtProc()
{
int k = 5;
ex->Message("before K = ", k);
ex->Proc(&k);
ex->Message("after K = ", k);
}
Показываем в последовательных сообщениях, какое значение переменная имела до выполнения процедуры, и какое стала иметь после.
void CExample_exeDlg::OnBtFunc()
{
int k = 5, l;
ex->Message("before K = ", k);
l = ex->Func(k);
ex->Message("after K = ", k);
ex->Message("Result of Func = ", l);
}
Примерно то же самое – значение до выполнения, значение после выполнения и результат выполнения.
void CExample_exeDlg::OnBtGet()
{
ex->Message("", ex->GetF());
}
void CExample_exeDlg::OnBtSet()
{
ex->SetF(ex->GetF() + 1);
}
Эти две – без комментариев. Должно быть так все понятно... Функцию для работы со структурами в этом проекте не буду трогать, не интересно, тут весь фокус, как их передать через границу DLL. Кроме того, не будем возиться с полями ввода, а передадим параметры непосредственно в коде. Наглядность это уменьшает ненамного, а работы меньше. Еще момент – ID кнопок по-умолчанию поменял с BUTTON1 на BT_CREATE и так далее, для наглядности.
Всё! На форме только кнопки, вывод информации через MessageBox. Можно проверить работу.
Сделаем DLL для этого класса. В MS VC++ создадим проект, используя MFC AppWizard(dll), назовем «example_dll». В каталог этого проекта копируем готовые example.cpp и example.h, добавим их к проекту. Будем изменять, в соответствии с выясненными правилами. Начнем с объявления класса:
// Можно использовать AFX_EXT_CLASS, это синонимы.
class AFX_CLASS_EXPORT CExample
Затем из
void Message(CString str, int Digit);
делаем
virtual void __stdcall Message(CString str, int Digit);
и так со всеми открытыми методами, кроме конструктора и деструктора. И на этом бы всё, да CString – несовместимый, опасный тип. Меняем объявление:
virtual void __stdcall Message (char * str, int Digit);
и определение:
void CExample::Message (char* str, int Digit)
{
//добавляем CString:
CString s = str;
//и немного изменяем работу со строкой:
//str.Format(str + " %d", Digit);
s.Format(s + " %d", Digit);
//this->Show(str);
this->Show(s);
}
то есть, приходим к совместимому типу «указатель на нуль-терминальную строку», но, чтобы не потерять функциональность класса CString, объявляем локальную переменную этого класса и используем ее. Осталось еще полторы детали.
Первая деталь – в файле example_dll.cpp в конце пишем:
// вставляем функцию инициализации..
CExample * __stdcall InitExample(int F, char * N)
{
CExample * ex;
// транслируем конструктору принятые параметры
ex = new CExample(F, N);
// и возвращаем указатель на созданный объект
return ex;
}
// ..и ликвидации
void __stdcall DelExample(CExample * ex)
{
delete ex;
}
И половина детали – в файле EXAMPLE_DLL.def в конце дописываем пару строчек, так, чтобы получилось:
;*****************************************************************************
; EXAMPLE_DLL.def : Declares the module parameters for the DLL.
LIBRARY "EXAMPLE_DLL"
DESCRIPTION 'EXAMPLE_DLL Windows Dynamic Link Library'
EXPORTS
; Explicit exports can go here
InitExample
DelExample
;*****************************************************************************
После компиляции DLL готова. Подготовим проект в Delphi, чтобы продемонстрировать ее работу. Создадим проект «Example_Delphi», и в модуле главной формы, перед объявлением класса формы, впишем четыре типа. Два - структуры struct1 и 2:
TRec1 = record
n : integer;
i : integer;
j : smallint;
k : shortint;
end;
TRec2 = record
n2 : integer;
a : array[0..2] of smallint;
end;
Третий – указатель на вторую структуру:
PRec2 = ^TRec2;
А четвертый – наш класс, с которым будем работать:
TExample = class
public
procedure Mess_(str : PChar; Digit : integer); virtual; stdcall; abstract;
procedure Proc(var Digit : integer); virtual; stdcall; abstract;
function Func(Number : integer): integer; virtual; stdcall; abstract;
procedure SetF(F : integer); virtual; stdcall; abstract;
function GetF(): integer; virtual; stdcall; abstract;
function Struct1to2(rec1 : TRec1): PRec2; virtual; stdcall; abstract;
end;
Директивы virtual и stdcall в пояснениях не нуждаются. О них сказано выше. А зачем abstract? Очень просто. Без нее компилятор будет ругаться на неправильное упреждающее объявление функции, ведь описания ее у нас нет, описание – в DLL. Директивы должны идти именно в этом порядке. Иначе компилятору не нравится.
Обратите внимание на первый метод. Остальные названы так же, как и в С++, но слово Message в Delphi зарезервированное, и использовать его не по назначению не стоит. Хорошо, назовем иначе, важно, что она стоит на первом месте среди виртуальных функций, как и в С++, значит, ее найдут по номеру в VMT. Имя роли не играет.
Еще надо добавить объявление экспортируемых функций создания/ликвидации, в конце секции interface: function InitExample(F: integer; N : PChar) : TExample; stdcall;
external '..\Example_DLL\debug\Example_DLL.dll';
procedure DelExample(ex : TExample); stdcall;
external '..\Example_DLL\debug\Example_DLL.dll';
Здесь предполагается, что DLL лежит там, где и появилась после компиляции, а директории «Example_dll» и «Example_Delphi» имеют общую родительскую. Больше нигде ее искать не будут. Если же указать только имя, приложение будет искать библиотеку в своей папке, папках WINDOWS, SYSTEM32 и прописанных в переменной окружения PATH. Впрочем, это азбука.
Всё, класс можно использовать. Давайте опять наделаем кнопок, а вывод в поле Memo, благо, в Delphi с ним работать быстрее и проще, чем в MS VС++.
Вот обработчики кнопок: procedure TForm1.Button1Click(Sender: TObject); begin if not Assigned(Self.ex) then Self.ex := InitExample(10, 'Ex_Delphi'); end; procedure TForm1.Button2Click(Sender: TObject); begin DelExample(Self.ex); Self.ex := nil; end; procedure TForm1.Button3Click(Sender: TObject); begin Self.ex.Mess_(PChar('Некоторая цифра – '), 5); end; procedure TForm1.Button4Click(Sender: TObject); var j : integer; begin j := 15; Self.Memo1.Lines.Add('j До – ' + IntToStr(j)); Self.ex.Proc(j); Self.Memo1.Lines.Add('j После – ' + IntToStr(j)); end; procedure TForm1.Button5Click(Sender: TObject); var j : integer; begin j := 20; Self.Memo1.Lines.Add('j До – ' + IntToStr(j)); Self.Memo1.Lines.Add('Результат – ' + IntToStr(Self.ex.Func(j))); Self.Memo1.Lines.Add('j После – ' + IntToStr(j)); end; procedure TForm1.Button6Click(Sender: TObject); begin Self.Memo1.Lines.Add(IntToStr(Self.ex.GetF)); end; procedure TForm1.Button7Click(Sender: TObject); begin Self.ex.SetF(Self.ex.GetF + 1); end; То же самое, что и в С++, и работает так же. Что и требовалось. И добавим кнопку для функции, которая принимает и возвращает структуры. Вот ее обработчик:
procedure TForm1.Button8Click(Sender: TObject); var s1 : TRec1; s2 : PRec2; begin // здесь компилятор будет ругаться, но в данном // случае это не важно. Просто посмотрим, что // до инициализации s2 - это всякая чушь... Self.Memo1.Lines.Add('s2 до:' + #9 + IntToStr(s2.n2) + #9 + IntToStr(s2.a[0]) + #9 + IntToStr(s2.a[1]) + #9 + IntToStr(s2.a[2]) ); // инициализация s1 s1.n := 10; s1.i := 1; s1.j := 2; s1.k := 3; // если функция возвращает указатель на запись (структуру) - // надо подготовить указатель. Это вам не класс. // s2 - типа PRec2, а не TRec2 s2 := Self.ex.Struct1to2(s1); // ... а потом - то, что мы требовали. Self.Memo1.Lines.Add('s2 после:' + #9 + IntToStr(s2.n2) + #9 + IntToStr(s2.a[0]) + #9 + IntToStr(s2.a[1]) + #9 + IntToStr(s2.a[2]) ); end; Что делает функция – понятно, тут другая тонкость. Конструктор возвращает (в коде на С++) указатель на класс, а мы присваиваем возвращаемое значение переменной, которая, вроде бы, не указатель. Struct1to2 тоже возвращает указатель – и его надо подготовить. Это объясняется в []: «Объект – это динамический экземпляр класса. Объект всегда создается динамически, в «куче», поэтому ссылка на объект фактически является указателем (но при этом не требует обычного оператора разыменования «^»). Когда вы присваиваете переменной ссылку на объект, Delphi копирует только указатель, а не весь объект. Используемый объект должен быть освобожден явно.»
А в С++ структура отличается от класса несколько меньше, и работа с ними почти одинакова. И еще пара тонкостей. Если в DLL добавить еще виртуальную функцию-член, обязательно в конце, после имеющихся, такая DLL будет совместима со старой программой, где в абстрактном классе эта функция не объявлена. И если изменить имеющуюся функцию, добавив в конец параметров параметр по-умолчанию, такая DLL будет совместима со старой программой, где в абстрактном классе эта функция не имеет такого параметра.
Разумеется, можно вынести описание абстрактного класса, объявление экспортируемых функций, используемых типов и тому подобное в отдельный модуль. Возможно, это лучше, чем запихивать всё в один файл. По крайней мере, я так и делаю. Но это уже детали, касающиеся стиля, а не функциональности.
Немного теории
Передать, точнее, экспортировать несколько функций из DLL – не проблема. Приводим типы, соглашения о вызовах, заполняем список экспортируемых функций – и всё (в основном). Об этом написано немало, например, в [], в параграфе «Использование DLL, разработанных в С++».Экспортировать класс несколько сложнее. Даже если и DLL, и основная программа написаны на Delphi, возникают проблемы с распределением памяти, которые решаются использованием модуля ShаreMem, первым в списке uses как проекта, так и DLL [, ]. Причем, этот модуль можно, в принципе, заменить самодельным менеджером памяти []. Но как использовать ShаreMem, если DLL написана на другом языке, или написать собственный менеджер для двух языков? Наверное, можно и так, но, напоминаю, срок сдачи проекта – вчера. Если есть и другие возражения, часто время – определяющий фактор.
Можно создавать экземпляр класса при загрузке DLL, ликвидировать при выгрузке (используя события DLL_PROCESS_ATTACH/DETACH), а для методов класса (функций-членов, раз уж класс на С++) написать однострочные функции-обертки, не являющиеся членами, а просто вызывающие соответствующие функции-члены. Некрасиво, и много лишней работы. Попробуем все же экспортировать класс.
В [], сказано: «Библиотеки DLL не могут экспортировать классы и объекты, если только вы не используете специализированную технологию Microsoft под названием СОМ или какую-либо другую усовершенствованную технологию». Впрочем, там же есть замечание: «На самом деле объекты могут быть переданы из DLL в вызывающую программу в случае, если эти объекты спроектированы для использования в качестве интерфейсов или чистых абстрактных классов». Кроме этого замечания, в [] об экспорте объектов почти всё, но уже хорошо, что есть шанс «сделать это по-быстрому».
И, наконец, в [] находим параграф «Экспорт объектов из DLL». Там сказано: «К объекту и его методам можно получить доступ, даже если этот объект содержится внутри DLL. Но к определению такого объекта внутри DLL и его использованию предъявляются определенные требования. Иллюстрируемый здесь подход применяется в весьма специфических ситуациях, и, как правило, такого же эффекта можно достичь путем применения пакетов или интерфейсов». Наша ситуация вполне специфическая; пакеты здесь неприменимы, так как они все же для использования с Delphi, про использование интерфейсов и СОМ уже сказано, а использовать интерфейсы без СОМ вне Delphi, судя по [], нельзя.
И, пожалуй, самое важное из []:
«На экспорт объектов из DLL накладываются следующие ограничения:
Далее там рассказывается о работе с DLL, написанной в Delphi, но полученной информации достаточно для работы с DLL, создаваемой в MS VC++.
Мастер MS VC++ позволяет создать обычную (regular) DLL и DLL-расширение (extension). Обычная DLL может экспортировать только С-функции и не способна экспортировать С++-классы, функции-члены или переопределенные функции []. Стало быть, надо использовать DLL-расширение. Мастер создаст заготовку, затем в каталог проекта надо будет скопировать два файла – заголовочный и файл кода (*.h и *.cpp), содержащие класс, с экземпляром которого предстоит поработать. Затем подключить их к проекту DLL и немного доработать в соответствии с указанными ограничениями.
Во-первых, все экспортируемые открытые методы (ну, или функции-члены, как хотите) необходимо объявить с директивой __stdcall, по понятным причинам. Во-вторых, их также необходимо объявить виртуальными. Это делается для того, чтобы точки входа оказались записанными в таблицу виртуальных функций (VMT), через которую и будет осуществлятся экспорт-импорт. В-третьих, класс требуется объявить с макроопределенной директивой AFX_EXT_CLASS или AFX_CLASS_EXPORT, это синонимы. Сделанные изменения не влияют на работоспособность класса в ехе-проекте, даже директива экспортируемого класса.
Далее в файл .срр проекта DLL нужно добавить функции создания и ликвидации объекта. Пример в [] обходится без функции ликвидации, видимо, потому, что в приведенном там примере и DLL и импортирующее приложение написаны на Delphi, так что можно освободить память методом Free, который есть у всех наследников TObject и отсутствует у объектов С++, не имеющих общего класса-предка. Функция создания объекта должна просто вызывать конструктор, передать ему полученные от приложения параметры и вернуть указатель на созданный объект. Функция ликвидации принимает указатель на объект и вызывает деструктор. И обязятельно вписать эти функции в список экспортируемых.
И всё! Пятнадцать минут работы, при минимальном знании С++. Остальное в Delphi.
В импортирующей программе необходимо объявить класс, содержащий виртуальные открытые функции в том же порядке. Также необходимо объявить сложные структуры данных, используемые в DLL и передаваемые через ее границу в любом направлении. Имеются в виду структуры С++, они же записи Паскаля. И, конечно же, нужно объявить импортируемые функции создания и уничтожения класса. Теперь для создания экземпляра класса вызывается соответствующая функция DLL, когда объект перестает быть нужным – снова вызывается соответствующая функция DLL, а методы вызываются традиционно – «Объект.Метод(Параметры)». При этом обзывать методы в Delphi можно как угодно, важен лишь порядок их следования и списки параметров.
Если в С++ функция-член возвращает значение, в Delphi соответствующий метод должен быть тоже функцией. Если же функция-член возвращает void, в Delphi соответствующий метод – процедура.
Если в С++ параметр передается по значению, то и в Delphi тоже, если же по ссылке (то есть как указатель), то в Delphi такой параметр должен быть объявлен с ключевым словом var.
Чуть подробнее о параметрах и их типах. Практически везде, где говорится о DLL, упоминается, что, если хотите обеспечить совместимость DLL с программами на других языках, необходимо обеспечить совместимость типов. То есть, стремиться использовать стандартные типы ОС Windоws. Такие типы, как string или file вообще не совместимы с С++, с TDateTime можно поэкспериментировать, вообще-то, он соответствует стандарту, принятому в OLE-автоматизации ([]). Опять же, [] заявляет о соответствии типов single и double Delphi с float и double в С++ соответственно. Хотя в [] есть такой совет со ссылкой на News Group: «Если вы создаете DLL не с помощью Delphi, то избегайте чисел с плавающей точкой в возвращаемом значении. Вместо этого используйте var-параметр (указатель или ссылочный параметр в С++) Причина кроется в том, что Borland и Microsoft применяют различные способы возврата чисел с плавающей точкой. Borland С++ и Delphi могут использовать один и тот же метод».
| int | ?(4) | integer |
| unsigned int | ?(4) | cardinal |
| char, __int8 | 1 | shortint |
| short, __int16 | 2 | smallint |
| long, __int32 (int) | 4 | longint (integer) |
| __int64 | 8 | int64 |
| unsigned char | 1 | byte |
| unsigned short | 2 | word |
| unsigned long | 4 | longword |
| float | 4 | single |
| double | 8 | double |
| char * | PChar |
Обоснование
Необходимость использования чужого кода в своей программе возникает регулярно. Вставка готовых удачных решений позволяет не изобретать велосипед заново. В хороших случаях чужой код написан на том же языке, что и свой, либо решение оформлено в виде DLL или компонента. Однако, бывают случаи похуже. Например, приобретается PCI-плата расширения с программным обеспечением для нее, а это ПО оказывается файлами исходного кода на С или С++, в то время как проект уже начат на Delphi, и, кроме того, в команде разработчиков С++ знают плохо.Требования
Предполагается: знание Delphi на уровне использования DLL, а также написания собственных; знание С++ на уровне написания простейшего приложения в среде MS VC++.Желательно: общее понимание соглашений о вызове функций; общее представление о способах передачи параметров и возврата значения.
Используемые инструменты: Borland Delphi 6, MS VC++ 6.0
Варианты решения
В принципе, можно весь проект писать на С++. Если такая возможность есть – не исключено, что это лучший выход. Но пользовательский интерфейс в Delphi разрабатывается быстрее, чем в MS VC++ (не только мое мнение, но хорошую цитату не нашел), кроме того, в группе могут плохо знать С++. И если даже С++ знают хорошо, но проект уже начат на Delphi, переписывать готовое – значит, тратить неоплачиваемое время.Можно переписать код С++ на Delphi. Для этого требуется время, и, возможно, немалое, а главное – знание С++ на уровне существенно выше начального («читаю со словарем»). При этом, многие языковые конструкции С++ не имеют прямых аналогов в Delphi, и их перенос чреват появлением ошибок, в том числе, совершенно дурацких, и потому трудноотлавливаемых. В частности, прекрасный пример из обсуждения статьи «ЯП, ОПП и т.д. и т.п. в свете безопасности программирования»:
for(;P('\n'),R-;P('|')) for(e=C;e-;P('_'+(*u++/8)%2))P('| '+(*u/4)%2); Можно попробовать засечь время и перевести это на Pascal. Станет примерно понятно, сколько времени уйдет на перевод класса, где подобные конструкции не единичны.
Можно воспользоваться интерфейсами и технологией СОМ (пожалуй, точнее – моделью СОМ и технологией ActiveX). Но – вот цитата из [], глава «Модель многокомпонентных объектов»:
«И еще одно замечание: не думайте, что путь будет легким. Крейг Брокшмидт говорил, что перед тем, как он начал понимать эти концепции, у него был « шесть месяцев туман в голове.» Минимальная предпосылка – исчерпывающее знание языка С++.» Конец цитаты. И, хотя «модель СОМ предоставляет унифицированный, открытый, объектно-ориентированный протокол связи между программами» (цитата оттуда же), она требует такой квалификации от программиста, которая редко встречается в среде непрофессионалов.
Можно реализовать код, который необходимо использовать, в виде DLL. Один из существенных плюсов DLL – неважно, на каком языке она написана, если соблюдены некоторые условия, такие, как соглашение о вызове и совместимость типов.
С учетом того, что в группе разработчиков в основном о С++ поверхностные представления, а СОМ – незнакомая аббревиатура, и, при этом, срок сдачи проекта – традиционно – вчера, ничего лучше варианта с DLL у нас придумать не получилось.
При таком подходе нельзя обращаться
При таком подходе нельзя обращаться к полям данных напрямую. Хотя, это не проблема, можно использовать функции-считыватели и установщики. Нельзя использовать закрытые функции. А зачем их использовать? Для использования есть открытые. Те, кто знакомы с моделью СОМ, могут сказать, что это извращенный вариант нормальной технологии. Но для создания полноценного СОМ-сервера нужно несколько больше знаний. Показанный способ позволяет использовать открытые методы класса, не вдаваясь в подробности реализации класса и не затрачивая много времени. Это дает возможность быстро получить работоспособный вариант программы, и уже потом доводить ее до ума. А то и просто получить удовлетворительный результат.Delphi - сбориник статей
Дополнительные особенности.
В процессе работы, к стандартному механизму SOAP, были добавлены такие возможности как:Клиент
Клиент
1: unit Unit1; 2: 3: interface 4: 5: uses 6: Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7: Dialogs, StdCtrls, DB, DBClient, wssSoapConn; 8: 9: type 10: TForm1 = class(TForm) 11: wssSoapConnection1: TwssSoapConnection; 12: Button1: TButton; 13: Label1: TLabel; 14: Button3: TButton; 15: procedure Button1Click(Sender: TObject); 16: procedure Button2Click(Sender: TObject); 17: procedure Button3Click(Sender: TObject); 18: private 19: { Private declarations } 20: public 21: { Public declarations } 22: end; 23: 24: var 25: Form1: TForm1; 26: 27: implementation 28: 29: uses IWSSTest1; 30: 31: {$R *.dfm} 32: 33: procedure TForm1.Button1Click(Sender: TObject); 34: begin 35: wssSoapConnection1.Open; 36: Label1.Caption := wssSoapConnection1.SessionID; 37: end; 38: 39: procedure TForm1.Button2Click(Sender: TObject); 40: begin 41: wssSoapConnection1.Close; 42: end; 43: 44: procedure TForm1.Button3Click(Sender: TObject); 45: begin 46: ShowMessage( (wssSoapConnection1.RIO as IWSSTest).TestMethod('Client.')); 47: end; 48: 49: end.
Клиент:
Сервер:
Проблемы и их решения.
Основной проблемой, с которой приходится изначально бороться - это отсутствие сессионности между вызовами клиента. От кого пришел запрос, в общем случае, однозначно понять практически невозможно. В интернете содержится достаточно много публикаций на эту тему и подход (пример: , ), в общем-то, для решения проблемы един: создание на стороне сервера постоянно существующий объект: менеджер сессий. Как следствие - application server должен быть постоянно загружен на web-сервере или самостоятельно выполнять его функцию.Следующая проблема - это обеспечение прозрачного вызова базовых методов интерфейса IAppServer с клиента соответствующих методов требуемого провайдера(TCustomProvider) на сервере в контексте сессии. Решением данной проблемы является создание наследника от TCustomRemoteServer, который инкапсулирует данные(контекст сессии) и методы по взаимодействию с менеджером сессий средствами SOAP-протокола. На стороне сервера создается наследник от TInvokableClass (TSOAPSessionManeger), и соответствующий ему IInvokable интерфейс ISOAPSessionManeger, который реализует базовые, но модифицированные, методы интерфейса IAppServer, и дополнительные методы, необходимые для авторизации, контроля состояния и др. .
1: ISOAPSessionManeger = interface(IInvokable) 2: ['{59AD0E15-EF0F-4DF3-A782-18B5FEC70AC4}'] 3: {IAppServer support} 4: function WS_AS_ApplyUpdates(const SessionID:WideString; const ProviderName: WideString; Delta: OleVariant; 5: MaxErrors: Integer; out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant; stdcall; 6: function WS_AS_GetRecords(const SessionID:WideString; const ProviderName: WideString; Count: Integer; out RecsOut: Integer; 7: Options: Integer; const CommandText: WideString; 8: var Params: OleVariant; var OwnerData: OleVariant): OleVariant; stdcall; 9: function WS_AS_DataRequest(const SessionID:WideString; const ProviderName: WideString; Data: OleVariant): OleVariant; stdcall; 10: function WS_AS_GetProviderNames(const SessionID:WideString): TWideStringDynArray; stdcall; 11: function WS_AS_GetParams(const SessionID:WideString;const ProviderName: WideString; var OwnerData: OleVariant): OleVariant; stdcall; 12: function WS_AS_RowRequest(const SessionID:WideString; const ProviderName: WideString; Row: OleVariant; RequestType: Integer; 13: var OwnerData: OleVariant): OleVariant; stdcall; 14: procedure WS_AS_Execute(const SessionID:WideString; const ProviderName: WideString; const CommandText: WideString; 15: var Params: OleVariant; var OwnerData: OleVariant); stdcall; 16: {Authorithation support} 17: function WS_Login(const AUserName, APassword: WideString ; var SessionID, ErrMsg:WideString):Integer; stdcall; 18: function WS_Logout(const SessionID:WideString):Integer; stdcall; 19: function WS_GetSessionState(const SessionID:WideString):Integer;stdcall; 20: {Data-exchange support} 21: function WS_GetValue(const SessionID, AName: WideString):OleVariant;stdcall; 22: procedure WS_SetValue(const SessionID, AName: WideString; const AData: OleVariant);stdcall; 23: function WS_CallMethod(const SessionID, MethodName: WideString; const Params: OleVariant):OleVariant;stdcall; 24: end; Базовым понятием в данной модели является понятие сессии (класс TWSSession) . Сессия - это объект, который идентефицирует клиетское соединение на стороне сервера, ассоциирует с ним наборы модулей данных(наследники TDataModule), обеспечивает регистрацию провайдеров из соответствующих модулей, вызов базовых методов интерфейса IAppServer, и методы авторизации для конкретной сессии. Ключевые понятия сессии:
Вызов методов IInvokable интерфейсов в котнексте сессии. Для решения этой проблемы пришлось изменить стандартное поведение класса TSoapPascalInvoker. При определении экземпляра объекта для выполнения метода, запрашиваемого клиентом интерфейса, Delphi ищет в собственном реестре(объект InvRegistry) класс, его реализующий, а затем создает его экземпляр(Per request), или процедуру, возвращающую ссылку на этот объект(Global). Поскольку в каждом SOAP-сообщении содержится SessionID, можно определить сессиию клиента, и как следствие, получить ссылки на дата-модули, существующие в ее контексте. Далее находим дата-модуль, реализующий запрашиваемый интерфейс и возвращаем на него ссылку. Далее работает стандартная схема, а метод уже вызывается именно в контексте сессии. Поскольку предварительно мы реализуем стандартный код, вышеприведенные изменения ни в коем случае не изменяют установленного поведения компонентов и их методов. Таким образом задача создания своих собственных state-full объектов с поддержкой сессий становится тривиальной задачей: Создание наследника TDataModule TMyDM, объявление IInvokeble интерфейса IMyIntf и его регистрация в InvRegistry, включение интерфеса IMyIntf в класс TMyDM и его регистрация в системе(WSReg.RegisterDataModule(TMyDM,'MyApp')), реализация методов интерфейса.
Неожиданной оказалась проблема автоматического включения в каждый заголовок SOAP-сообщения идентификационной информации. Класс TRIO не содержит событий, которые позволили добавить в заголовок нужную информацию c использованием сдандартных для этого методов(Класс TSOAPHeader). Событие OnBeforeExecute вызывается уже полсе того, как заголовки упакованы в сообщение. Исходный код TRIO пришлось модифицировать, добавлением события OnBeforeRequest(добавить метод DoBeforeRequest) и полученный класс TWSRIO использовать в классе TwssSoapConnection(наследник TCustomRemoteServer, реализующий взаимодействие сервером приложений). Вызов удаленных методов интерфейсов предпочтительно осуществлять с использованием этого класса, или же, для компонента TRIO самостоятельно добавлять нужные заголовки(класс TWSSHeader).
Как следствие, вышеприведенных изменений вполне достаточно как для портации серверных приложений на базе TRemoteDataModule под Web Services, так и создания новых state-full, state-less Web Services приложений в привычных для программиста условиях.
Реализация
Исходники и примеры (112 Кб). Для реализации примера установите у себя пакет wss.dpk. Пропишите необходимые пути в Library Path.Сервер
Сервер
Сервер будем реализовывать как standalone Web Service(Требуется библиотека Indy).1: { Invokable interface IWSSTest } 2: 3: unit WSSTestIntf; 4: 5: interface 6: 7: uses InvokeRegistry, Types, XSBuiltIns; 8: 9: type 10: 11: { Invokable interfaces must derive from IInvokable } 12: IWSSTest = interface(IInvokable) 13: ['{15907745-68B1-47A3-86A6-9EF2A3530493}'] 14: 15: { Methods of Invokable interface must not use the default } 16: { calling convention; stdcall is recommended } 17: function TestMethod(const s : string): string ;stdcall; 18: end; 19: 20: implementation 21: 22: initialization 23: { Invokable interfaces must be registered } 24: InvRegistry.RegisterInterface(TypeInfo(IWSSTest)); 25: 26: end.
1: unit Unit2; 2: 3: interface 4: 5: uses 6: SysUtils, Classes, WSSTestIntf, 7: WSObj{WSS Core}; 8: 9: type 10: TDataModule2 = class(TDataModule, IWSSTest, IWSSessionNotifyEvents) 11: private 12: { Private declarations } 13: //добавление совершенно не обязательно, но удобно, а иногда и полезно:) 14: procedure WSSessionNotifyEvent(const SessionClient : TWSSesClient; 15: const EventName : string; 16: const Data: OleVariant); 17: public 18: { Public declarations } 19: function TestMethod(const s : string): string ;stdcall; 20: end; 21: 22: var 23: DataModule2: TDataModule2; 24: 25: implementation 26: 27: {$R *.dfm} 28: 29: { TDataModule2 } 30: 31: function TDataModule2.TestMethod(const s: string): string; 32: begin 33: Result := 'Hello from server: '+ s; 34: writeln('Method call: '+ s); 35: end; 36: 37: procedure TDataModule2.WSSessionNotifyEvent( 38: const SessionClient: TWSSesClient; const EventName: string; 39: const Data: OleVariant); 40: begin 41: writeln('EVENT:',EventName,' - sessionid:',SessionClient.SessionID); 42: end; 43: 44: end.
1: program Project2; 2: 3: {$APPTYPE CONSOLE} 4: 5: uses 6: SysUtils, 7: IndyHttpServerApp,{Под Apache2 заменить на Apache2ServerApp} 8: WSSTestIntf in 'WSSTestIntf.pas', 9: Unit2 in 'Unit2.pas' {DataModule2: TDataModule}; 10: 11: begin 12: { TODO -oUser -cConsole Main : Insert code here } 13: ServerApplication.Initialize; 14: {register TDataModule2 class for AppID="TEST"} 15: ServerApplication.RegisterDataModuleClass(TDataModule2,'TEST'); 16: ServerApplication.Run; 17: end.
State-full Web Services на Delphi
Александр Шагин, ведущий программист отдела "ИНФОВУЗ", Волгоградский Государственный Педагогический Университети 7) предоставляет достаточно удобные
Среда Borland Delphi (версии 6 и 7) предоставляет достаточно удобные инструменты по созданию Web Services application. В сочетании с технологией Midas у программиста есть очень эффективный инструмент по созданию N-звенных приложений доступа к корпоративным БД. Тем не менее реализация Web Services в Delphi содержит некоторые существенные ограничения, которые, в целом оправданы, но при переходе на новую платформу, будут вызывать у программистов, привыкших работать с TDCOMConnection, TSocketConnection и т.п. дополнительные сложности. SOAP Server applications - это, в общем случае, statelss приложения - сервер не хранит информацию о предыдущих вызовах клиента, что не позволяет использовать привычный подход и технологию программирования, а тем более говорить о прозрачном переходе на новый тип соединения(Например,так как это происходит при переходе с TDCOMConnection на TSocketConnection или наоборот). Конечно, отсутствие statefull-объектов на сервере оправдывается тем, что потенциально Web Services должны будут обрабатывать огромное количество входящих соединений, и выделение для каждого из них оперативной памяти приведет, в конце концов, к выводу сервера или сервиса из строя, но тем не менее отсутствие прозрачного механизма портации существующих проектов(если, конечно, таковая вообще требуется) может остановить от реализации этой идеи даже очень опытных программистов.В процессе работы у нас возникла следующая задача. Корпоративная система работала в пределах локальной сети. Соеденение клиентов осуществлялось с помощью SocketConnection, что обеспечивало вполне приличную скорость и масштабируемость. Со временем появились новые удаленные рабочие места, но соеденение по локальной сети установить уже не было возможности, только Internet. Требовалось обеспечить работу пользователей в точности с тем же набором приложений (чтобы не приходилость дополнительно тратить времени на обучение по работе с новым софтом или на дополнительную организацию их взаимодействия с основной корпоративной системой), который они использовали ранее. Для коммуникации клиентских приложений с основным сервером идеально подходил SOAP-протокол, но отсутствие statefull соединений могло сильно затянуть время адаптации серверов приложений. Посколько в параллельных проектах уже был опыт использования Web Services , и появление вышеобозначенных проблем вполне предсказывалось, велась разработка механизма прозрачного перевода MIDAS-серверов и клиентов на использование протокола SOAP. Детали, проблемы и подходы в решении этой задачи я бы и хотел осветить в этой статье.
это всего лишь субъективный взгляд
Все вышеизложенное - это всего лишь субъективный взгляд на решение этой задачи. Здесь приведен лишь беглый обзор достаточно большой работы. Кому же эта тема интересна или интересуют подробности работы предложенного механизма, есть что добавить, а особенно покритиковать (это основная цель публикации) просьба писать на
Delphi - сбориник статей
Архитектура WEB-сервиса
По большому счету WEB-сервис представляется всего одним файлом, с расширением Asmx, который должен как минимум иметь примерно такой заголовок: <%@ WebService Language="c#" Class="WebService1.TWebService1" %>Далее может идти код, собственно реализующий функциональность WEB-сервиса. Этот код должен быть написан на одном из языков .NET платформы (например C#).
К великому сожалению, создать WEB-сервис на Object-Pascal таким образом пока нельзя. Однако разработчики платформы .NET предусмотрели возможность перенести код WEB-сервиса в отдельно компилируемую DLL(фоновый код). Частично для того, чтобы была возможность разрабатывать WEB-приложения на языках, непосредственно не поддерживающих ASP.NET, частично для того, чтобы диагностировать ошибки компиляции до развертывания самого сервиса.
Как вы уже догадались, Delphi 8 создает проект, компилируемый в DLL( которая, в свою очередь, помещается в корневой каталог приложения) и состоящий из таких частей:
Как вы наверняка уже догадались для тестирования сервиса достаточно в браузере набрать строку
http://localhost/<путь к сервису>/<имя сервиса>.asmx
Для вызова метода
http://localhost/<путь к сервису>/
<имя сервиса>.asmx /? Op= <имя операции>.
Атрибут WebMethod
Как и было заявлено выше, обычный метод класса отличается от метода, публикуемого WEB-сервисом только наличием атрибута WebMethod. Данный атрибут имеет составной характер, т.е может содержать следующие податрибуты (Рассмотрим лишь некоторые из них):В качестве примера давайте добавим к нашему классу еще два метода и добавим описание к существующему методу HelloWorld:
TWebService1 = class(System.Web.Services.WebService) // Экономия места public constructor Create; // Sample Web Service Method [WebMethod (MessageName = 'HelloWorld' , Description = 'Простой метод')] function HelloWorld:String; [WebMethod (MessageName = 'IntegerSubstract')] function Substract(a,b:Integer):Integer;overload; [WebMethod (MessageName = 'FloatSubstract')] function Substract(a,b:Single):Single;overload; Реализация методов тривиальна: function TWebService1.Substract(a,b:Integer):Integer; begin Result := a - b; end; function TWebService1.Substract(a,b:Single):Single; begin Result:= a - b; end;
Запустите добавленные WEB-методы. Обратите внимание, что мы использовали механизм перегрузки функций, но при этом не пострадали от ограничений связанных с именованием WEB-методов: WEB-сервис предоставляет их как методы с различными именами.
Что такое WEB-сервис ?
Что такое WEB-сервис наверное знает каждый. WEB-сервисы не собственность компании Microsoft, а целый промышленный стандарт на основе открытых протоколов HTTP и SOAP, однако использование в качестве средства разработки платформы .NET позволит создавать WEB-сервисы очень быстро и просто.WEB-сервисы представляют собой специального типа WEB-приложения, не имеющие пользовательского интерфейса. Однако благодаря наличию WEB-методов могут в реальном времени предоставлять информацию о… да о чем угодно ! Будь то прогноз погоды или курс валют, информация о наличии свободных мест на утренний сеанс в Вашем любимом кинотеатре. Одним словом - WEB-сервис предоставляет услуги другим приложениям, причем последние могут быть любого типа, как WEB-приложениями так и обычными приложениями с графическим интерфейсом. WEB-сервис имеет следующие отличительные особенности:
На этом позволим себе временно отстраниться от теории и перейти к практике
Прокси WEB-сервиса
В общем-то, ничего особенно не изменилось, за исключением того, что в проект был добавлен файл localhost.WebService1.pas, содержащий в себе класс TWebService1. Этот класс называется прокси WEB-сервиса, это локальный представитель WEB-сервиса для нашего клиентского приложения. Файл localhost.WebService1.pas сгенерирован автоматически, и менять его реализацию не рекомендуется, однако если посмотреть на него ближе () можно сделать некоторые выводы.Итак:
Простейший WEB-сервис
Давайте запустим Delphi 8 и создадим WEB-сервис, который назовем SampleWebService
Рис.1 Выбор типа создаваемого приложения
Рис.2 Диалог создания проекта.
Delphi 8 создаст для нас простейший WEB-сервис. Состав файлов в проекте WEB-сервиса требует отдельного описания, которое будет дано немного позже. Сейчас же рассмотрим файл WebService1.pas, который содержит описание класса TWebService1 TWebService1 = class(System.Web.Services.WebService) {$REGION 'Designer Managed Code'} strict private ///
Обратите внимание на закомментированный метод WEB-метод HelloWorld, (WEB-метод он потому, что ему назначен атрибут [WebMethod]). Давайте попробуем раскоментировать его и его реализацию. Вот и все. Наш первый WEB-сервис готов. Как его протестировать? Очень просто, нажмите F9.
Результат не заставить себя долго ждать, вы увидите страницу подобную приведенной на рис. 3.
Рис 3. Автоматически сгенерированная страница-описание WEB-сервис
Как протестировать WEB-метод Вы наверное уже догадались? Если нет, то кликните по ссылке HelloWorld.
рис 4. Тестирование WEB-метода
После нажатия на кнопку "Invoke" наш WEB-сервис стартует и вернет потрясающий результат в виде XML:
Ну что ж, первой цели мы достигли: научились создавать простейший WEB-сервис, предоставляющий WEB-метод и все это успешно протестировано.
Сложные типы данных в WEB-методах
Все то, что было показано до этого, выглядело неплохо. Однако на практике не очень часто приходится оперировать простыми типами данных, как это было показано в предыдущих примерах. Очень часто возникает необходимость вернуть сложный тип данных (например, объект).На самом деле решение проблемы не представляет особых сложностей. Давайте попробуем ее решить. Итак, пусть нам необходимо создать сервис, возвращающий курс доллара за указанный промежуток времени.
Итак, курс доллара будет представлен следующим классом: TDollarRate = class public Cost:Integer; Date:TDateTime; constructor Create; end; constructor TDollarRate.Create; begin inherited Create; Cost:=20 + Random(5); Date:=DateToStr(DateTime.Now); end;
Перед добавлением WEB-метода объявим тип TDollarRates = Array of TDollarRate, в секцию uses добавим Borland.Vcl.SysUtils. Метод имеет вид:
[WebMethod] function GetRatesForDays (ADays:Integer):TDollarRates; function TWebService1.GetRatesForDays (ADays:Integer):TDollarRates; var i:Integer; begin SetLength(Result,ADays); for i:=ADays-1 downto 0 do Result[i]:=TDollarRate.Create; end;
Попробуем протестировать метод (рис 5).
Рис. 5 Тестирование метода, возвращающего массив объектов Результат превзошел все ожидания: -
В процессе разработки этого примера мы были неприятно удивлены одной деталью (версия Delphi 8 7.1.1146.610): мы попытались объявить новый конструктор с параметрами: TDollarRate = class public Cost:Integer; Date:TDateTime; constructor Create(Adays:Integer); end; constructor TDollarRate.Create(Adays:Integer); var sDate:TDateTime; begin inherited Create; {Код} end;
и получили следующую ошибку при старте WEB-сервиса:
рис 6. Как же переопределить конструктор ?
Как сделать новый конструктор Default public в Delphi 8 не совсем понятно, однако выручило переименование конструктора следующим образом: TDollarRate = class public Cost:Integer; Date:String; constructor TDollarRate(Adays:Integer); end;
Результат работы стал таким: "?xml version="1.0" encoding="utf-8" ?> -
На этом описание WEB-методов завершается. Перед тем, как рассказать о том, каким образом клиентское приложение может взаимодействовать с нашим WEB-сервисом, а также каким образом оно будет "понимать" не только простые, но и "сложные" типы данных рассмотрим подробнее, из каких частей состоит WEB-сервис.
Создание клиента для WEB-сервиса.
После стольких усилий по изучению WEB-сервисов пришло время научится их использовать. Как и всегда ничего сложного в этом нет. В качестве примера создадим VCL Forms приложение. Его главная и единственная форма должна выглядеть примерно так:
Рис. 7. Форма Веб-Калькулятора
Осталось только "оживить" нашу форму. Для этого выберите пункт меню Project/Web Reference.
В диалоге, который откроется, укажите URL к WSDL описанию нашего сервиса В нашем случае это -
http://localhost/SampleWebService/WebService1.asmx?WSDL
Нажмите кнопку "GO" а потом "AddReference".
Рис. 8. Добавление ссылки на WEB-сервис.
Вызов WEB-методов. Асинхронный режим.
Ниже приведен код нашего клиентского приложения, умеющего выполнить WEB-метод, и отобразить результат: unit Umain; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Borland.Vcl.StdCtrls, System.ComponentModel, localhost.WebService1; type TForm1 = class(TForm) Edit1: TEdit; Edit2: TEdit; Label1: TLabel; Label2: TLabel; Edit3: TEdit; Button1: TButton; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); private FWEBProxy:TWebService1; { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.nfm} procedure TForm1.FormCreate(Sender: TObject); begin FWEBProxy:=TWebService1.Create; end; procedure TForm1.Button1Click(Sender: TObject); begin Edit3.Text:= IntToStr(FWEBProxy.Substract (StrToInt(Edit1.Text),StrToInt(Edit2.Text) )); end; end.
Рис 9. Веб калькулятор в действии
Теперь давайте усложним задачу? Заставим метод Substract возвращать результат через определенное время? В этом случае наше клиентское приложение попросту будет "висеть" пока WEB-метод не отработает. Давай добавим в WEB-метод Substract нашего WEB-сервиса имитацию бурной деятельности:
function TWebService1.Substract(a,b:Integer):Integer; var i:Integer; begin Sleep(5000); Result := a - b; end;
Так вот теперь, если запустить наш калькулятор, он будет успешно зависать на почти пять секунд. Возможно, нам нужно выполнять программу дальше, даже если результат WEB-метода еще не получен? Для этого существует возможность вызвать метод асинхронно.
Обратите внимание на то что в описании интерфейса прокси класса есть методы Begin<имя WEB-метод> и End
Это означает, что метод BeginSubstract инициирует выполнение WEB-метода, но при этом не останавливает выполнение основного приложения. В момент вызова EndSubstract завершается выполнение WEB-метода. Если последний еще не отработал - клиентское приложение блокируется до завершения работы метода.
WSDL - язык описания WEB-сервисов.
Мы практически готовы к тому, чтобы перейти к созданию клиента для нашего WEB-сервиса. Нам осталось только узнать как сторонние разработчики (пользователи нашего сервиса) могут узнать какие методы поддерживает WEB-сервис, сигнатуры этим методов, URL сервиса, типы используемых данных. Вся эта информация описывается при помощи языка WSDL. Тем не менее, вам не придется его изучать, так как этот язык больше для компьютеров, не для людей. Как же получить описание нашего WEB-сервиса на языке WSDL? Да очень просто, достаточно ввести в браузереhttp://localhost/<путь к сервису>/<имя сервиса>.asmx?wsdl
Ниже приведено описание TDollarRates и TDollarRate нашего примера: -
Программирование: Языки - Технологии - Разработка
- Программирование
- Технологии программирования
- Разработка программ
- Работа с данными
- Методы программирования
- IDE интерфейс
- Графический интерфейс
- Программирование интерфейсов
- Отладка программ
- Тестирование программ
- Программирование на Delphi
- Программирование в ActionScript
- Assembler
- Basic
- Pascal
- Perl
- VBA
- VRML
- XML
- Ada
- Lisp
- Python
- UML
- Форт
- Языки программирования