Статьи по Delphi (028)…
| Использование табличных переменных |
Табличные переменные объявляются очень похоже на запрос по созданию таблиц и могут использоваться как обычные таблицы.
Code: -- ©Drkb v.3(2007): www.drkb.ru. Declare @MyMemoryTable Table (id int, Field1 varchar(30)). Insert into @MyMemoryTable. Select ID, Field1 From MyTable Where Field2=0. Select * From @MyMemoryTable.
Примечания:
1. Табличные переменные чрезвычайно эффективны как временное хранилище данных небольшого размера, они более эффективны чем временные таблицы. Следует их использовать везде где только можно вместо временных таблиц.
| Использование Web Services. |
Что такое Web Service.
Последний вид приложений для Web, о котором я хочу рассказать в данном цикле статей– это Web Services. Web Service – это приложение-сервер, предоставляющее клиенту свои функции через протоколы Internet. В отличие CGI и других подобных internet приложений, Web Services ориентируются не на предоставление информации человеку в удобной для восприятия форме, а на обмен информацией между приложениями. Общение клиента и сервера осуществляется путем обмена сообщениями. Web Service может представить клиенту описание своих возможностей в терминах принимаемых и генерируемых им сообщений. При этом детали реализации сервера скрыты от клиента. Таким образом, с точки зрения клиента Web service представляется «черным ящиком», с определенной функциональностью и заданными способами публикации описания этой функциональности. С другой стороны серверу безразлично как именно клиент формирует сообщения и использует полученные результаты. Налицо компонентно-ориентированный подход. Применение в качестве транспортного протокола доставки сообщений протокола HTTP позволяет взаимодействовать клиента и сервера вне зависимости от аппаратной платформы и ОС.
Протокол SOAP.
Помимо транспортного протокола для вызова методов сервера необходим единый протокол, описывающий формат сообщений вызова методов сервера. В качестве такого протокола используется SOAP – Simple Object Access Protocol. Спецификация SOAP 1.1 можно найти в Web по адресу www.w3.org/TR/SOAP. SOAP позволяет использовать вызов удаленных процедур (RPC) через HTTP. Запросы кодируются в формате XML. Это имеет свои достоинства и недостатки. Достоинства:
· Легкость восприятия текста запроса человеком («читабельность»);
· Наличие парсеров XML, позволяющих достаточно просто осуществлять анализ поступающих сообщений.
Из недостатков можно отметить больший объем сообщений по сравнению с бинарными форматами представления данных. Ниже представлен пример SOAP запроса:
POST /examples HTTP/1.1 User-Agent: Radio UserLand/7.0 (WinNT) Host: localhost:81 Content-Type: text/xml; charset=utf-8 Content-length: 474 SOAPAction: "/examples" <?xml version="1.0"?> <SOAP-ENV:Envelope SOAP-ENV:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/" xmlns:SOAP-ENV=”http://schemas.xmlsoap.org/soap/envelope/” xmlns:xsd="http://www.w3.org/1999/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"> <SOAP-ENV:Body> <m:getStateName xmlns:m="http://www.soapware.org/"> <statenum xsi:type="xsd:int">41</statenum> </m:getStateName> </SOAP-ENV:Body> </SOAP-ENV:Envelope>
Рассмотрим заголовок запроса. Формат URI в первой строке запроса не специфицирован. Например это может быть просто / или, как в нашем примере /examples. User Agent и Host должны быть указаны. Content-Type, т.е тип содержимого запроса, естественно, text/xml. Content-Length - lлина запроса. SoapAction – значение данного поля используется для передачи сообщения нужному обработчику сообщений сервера. Как правило, значение SoapAction совпадает с URI в первой строке запроса. Тело запроса представляет собой документ в формате XML. Корневой тег SOAP-ENV:Envelop содержит внутри себя тег SOAP-ENV:Body, содержащий описание вызываемой процедуры. В нашем примере сообщение описывает запрос на вызов процедуры getStateName с параметром statenum равным 41. Ответ сервера при успешном вызове выглядит так:
HTTP/1.1 200 OK Connection: close Content-Length: 499 Content-Type: text/xml; charset=utf-8 Date: Wed, 28 Mar 2001 05:05:04 GMT Server: UserLand Frontier/7.0-WinNT <?xml version="1.0"?> <SOAP-ENV:Envelope SOAP-ENV:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/" xmlns:SOAP-ENV=http://schemas.xmlsoap.org/soap/envelope/ xmlns:xsd=http://www.w3.org/1999/XMLSchema xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"> <SOAP-ENV:Body> <m:getStateNameResponse xmlns:m="http://www.soapware.org/"> <Result xsi:type="xsd:string">South Dakota</Result> </m:getStateNameResponse> </SOAP-ENV:Body> </SOAP-ENV:Envelope>
Отметим лишь наиболее важные моменты:
· Пространство имен в описании ответа (тег < m:getStateNameResponse >) должен совпадать с пространством имен в запросе. В нашем примере пространство имен – m
· Имя тега описания ответа формируемся добавлением слова Response к имени вызываемой процедуры. В нашем случае это m:getStateNameResponse
Разработка сервера Web Services в Delphi6.
Delphi 6 позволяет создавать как сервера, так и клиентов Web Services. Мы начнем рассмотрение с создания сервера. Создание сервера Web Services в Delphi6 состоит из следующих этапов:
1. Описание интерфейса сервера, то есть методов, которые будут доступны для вызова клиенту;
1. Реализация методов сервера;
1. Создание проекта Delphi и включение в него результатов первых двух шагов.
Последовательно опишем каждый из этапов.
Описание интерфейса сервера
В Delphi при создании сервера Web Services методы доступные для вызова клиенту описываются в виде invokable интерфейсов. Invokable интерфейс – это интерфейс для методов которого доступна RTTI (информация о типах на этапе выполнения). Для того чтобы из обычного интерфейса сделать invokable достаточно указать директиву компиляции {$M+}. После этого все потомки и сам интерфейс будут содержать RTTI. В иерархии VCL уже есть такой интерфейс IInvokable. Таким образом, при написании сервера проще всего унаследовать свой интерфейс от Iinvokable. Кроме того необходимо зарегистрировать свой интерфейс в invocation registry. Регистрация позволяет серверу определить класс, реализующий методы интерфейса, а клиенту получить описание методов, поддерживаемых сервером. Регистрация осуществляется вызовом метода InvRegistry.RegisterInterface в секции initialization модуля. Так как интерфейс используется не только сервером, но и клиентом, то желательно определить его в отдельном модуле Delphi. Для примера мы разработаем сервер, который будет осуществлять пересчет денег из долларов в рубли и обратно. В IDE Delphi выберем пункт меню File/New/Unit. В полученном пустом модуле определим интерфейс сервера:
Code: Unit u_Intrf; Interface. Type. IEncodeDecode = interface(IInvokable). ['{32B3312E-684C-444D-88DB-13DE6F535F6D}']. // Конвертация долларов в рубли. Function US2RUS(Value: Currency): Currency; stdcall; // Конвертация рублей в доллары. Function RUS2US(Value: Currency): Currency; Stdcall; End; Implementation. Uses InvokeRegistry; Initialization. InvRegistry.RegisterInterface(TypeInfo(IEncodeDecode)); End.
| Использованию в Delphi прямых обращений к ядру Btrieve. |
Введение. Данный документ - краткая инструкция по использованию в DELPHI прямых обращений к ядру CУБД Btrieve, написанная для людей с SQL-мышлением, которым судьба-индейка подсунула свинью в виде производственной необходимости временно (или, не дай Создатель, постоянно) использовать это чудо Pervasive-вской мысли. Мне самому пришлось долго и больно перестраиваться с незамутненных SQL-понятий работы с данными на суровую логику программирования более низкого уровня. Данная шпаргалка призвана облегчить этот процесс, и содержит параллели между основными SQL-командами (select/insert/update/delete) и вызовами функции BTRVID, описанной по принципу "черного ящика". Сразу скажу, что не являюсь специалистом по Btrievу (т.е. могу путаться в Btrievовских терминах), большая часть информации получена эмпирическим путем, все примеры использовались в жизни, отлажены и работают.
| Использовать TTime для более 24 часов |
ENoResultSet Error creating cursor handle.
Почему не работает Query.Open(Query.ExecSQL)?
Что значит "ENoResultSet Error creating cursor handle"?
1.Query.Open возвращает результат запроса в виде курсора(Cursor).
Когда мы выполняем запрос «select * from table1» мы получаем.
Набор данных (Cursor). Можете представит курсор как виртуальную таблицу, со строками и столбцами, определенными в запросе. В этом случае надо использовать Query.Open или Query.Active:=true;
2.Query.ExecSQL выполняет инструкции запроса и курсор не создается.
Если в запросах используются инструкции не создающие набор данных (курсор) – СRЕАТЕ TABLE, INSERT, DELETE, UPDATE , SELECT INTO и т.д. то нужно вызывать метод ExecSQL.
Автор: BAS.
©Drkb::02591.
| Шифрование в DELPHI. |
Шифрование в DELPHI.
Данные надо беречь. Сам посуди, обидно, если открытие ценой в сто миллионов енотов или рецепт безалкогольной водки, над которым ты корпел три вечера в мрачном подвале нелегального компьютерного клуба, уплывет к злостному ленивому конкуренту, который, пользуясь твоим похмельем, наложил грязную лапу на приватные дискеты с ценнейшей инфой?! Дальше можно не продолжать. Шифруем, шифруем, шифруем!.. Добрый дядюшка borland предоставил нам несколько занятных функций для работы со строками, о которых не все знают. Сосредоточены они в модуле strutils.pas. Такие функции, как rightstr, leftstr совмещают стандартные команды copy и delete: так, leftstr возвращает значение левой части строки до указанной вами позиции (что вытворяет rightstr, догадайся сам), а функция reversestring и вовсе делает зеркальное отображение данной строки: 321 вместо 123. Используем ее в особенности, чтобы осложнить жизнь хитрому дешифровщику. Алгоритм шифрования будет прост, как win 3.1. С каждым символом кодируемого документа проделаем следующее: 1. Преобразуем символ в число командой ord. 2. Преобразуем каждый символ пользовательского пароля в число и сумму этих чисел прибавим к полученному в пункте 1. 3. От результата отнимаем число, равное позиции данного символа. То есть буковки будут шифроваться по-разному в зависимости от их позиции в строке :). 4. То, что получилось, запишем обратно из чисел в символы командой chr. Как видишь, после всех наших манипуляций этот символ уже будет другим. 5. Запишем всю строку навыворот командой reversestring. Дешифровка, как ты догадываешься, будет производиться в обратном порядке. Теперь, когда алгоритм намертво засел в голове, реализуем соответствующую программу. Внимание! Не исключено, что это будет первая твоя программа с настоящим синтаксисом команд: <команда> <путь> <пароль> — так будет выглядеть он в консоли нашего приложения (да, оно будет консольным!). Команд всего две: crypt и decrypt соответственно зашифровать и дешифровать файл, путь к которому указывается после пробела, а затем — твой пароль. НЕ ЗАБУДЬ ЕГО! Предупреждаю совершенно серьезно. Запомнил? В бой! crypt c:file.txt linuxmustsurvive — закодируем file.txt. Результат (зашифрованный текст) сохраниться в той же директории, что и исполняемый файл нашего приложения под именем translated_file.txt. decrypt c:translated_file.txt linuxmustsurvive — дешифровка. Реализовывается это вот как:
Code: Program crypter; {$apptype console}. Uses. Sysutils, Strutils; //!! Var. F, //входящий файл. F1: textfile; //результат (файл с переводом). Todo, filename, passw, line, translatedfile: string; Position, iscrypt: integer; //находим сумму числовых значений символов пароля. Function password(psw: string): integer; Var. I,res: integer; Begin. Res:=0; For i:=1 to length(psw) do res:=res+ord(psw[i]); Result:=res; End; Function crypt(cryptstr: string): string; Var. S: string; I: integer; Begin. If cryptstr<>emptystr then. For i:=1 to length(cryptstr) do begin. S:=leftstr(cryptstr,1); Cryptstr:=rightstr(cryptstr,length(cryptstr)-1); //ШИФРОВКА: S:=chr(ord(s[1])+password(passw)-i); Result:=result+s; End; Result:=reversestring(result); End; Function decrypt(decryptstr: string): string; Var. I: integer; S: string; Begin. Decryptstr:=reversestring(decryptstr); If decryptstr<>emptystr then. For i:=1 to length(decryptstr) do begin. S:=leftstr(decryptstr,1); Decryptstr:=rightstr(decryptstr,length(decryptstr)-1); //ДЕШИФРОВКА: Result:=result+chr(ord(s[1])-password(passw)+i); End; End; Begin. While true do begin. Iscrypt:=0; Writeln(#10+'crypter >'+#10); //Какую команду ввел юзер? Readln(todo); If uppercase(todo)='exit' then exit; If ansicontainstext(todo,'decrypt') then iscrypt:=1. Else if ansicontainstext(todo,'crypt') then iscrypt:=2; //прочитав команду, удаляем ее из строки и читаем дальше. Position:=pos(' ',todo); If position>0 then todo:=rightstr(todo,length(todo)-position); //Читаем путь к файлу. Position:=pos(' ',todo); If position>0 then filename:=leftstr(todo,position-1); //Читаем пароль. Passw:=rightstr(todo,length(todo)-position); //Всё правильно? Начинаем! If (iscrypt<=0) or (passw=emptystr) or. (not fileexists(filename)) then writeln('wrong command'). Else begin. Translatedfile:=extractfilepath(paramstr(0)) + 'translated_' + extractfilename(filename); //соединяемся с файлами. Assignfile(f, filename); Assignfile(f1, translatedfile); //переходим в начало файла. Rewrite(f1); Reset(f); //читаем строки, пока не дойдем до конца файла. While not eof(f) do begin. //читаем из переводимого файла. Readln(f, line); If iscrypt=1 then line:=decrypt(line); If iscrypt=2 then line:=crypt(line); //записываем в файл с переводом. Writeln(f1, line); End; //отсоединямся от файлов. Closefile(f); Closefile(f1); End; End; End.
| Шифрование исполняемого файла |
Code: { **** UBPFD *********** by kladovka.net.ru **** >> Шифрование исполняемого файла. В данном примере реализована процедура шифрования и расшифрования одной. Только процедуры "вывода сообщения".Процедура изночально не зашифровано, Что ни есть хорошо.Для того что бы процедура была при запуске программы. Уже зашифрована надо написать внешнюю программку,которая ба сканировала. Ехе-шник и находила определенные метки(начальную и конечную)и шифровала. Бы всё между ними.Таким образом вы получите готовый ехе-шник с уже. Зашифрованой(зашифроваными)процедурой. Для того чтоб некоторым умным. Людям (crackers)жить было не легко,после расшифровки и выполнения процедуры. Можно её опять зашифровать. Более потробную информацию читайте в статье на «Королевства Delphi». Http://delphi.vitpc.com/mastering/safe/safe.htm. Там же читайте Открытый проект "Анти крэковые мучения". Http://delphi.vitpc.com/mastering/safe/index.htm. Зависимости: Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls; Автор: DDA, Vologda. Copyright: «Королевства Delphi» Защита от несанкционированного. Использования программ, написанных на Delphi. Дата: 3 марта 2004 г. ********************************************** } Unit Unit1; Interface. Uses. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; Type. TForm1 = class(TForm). Button1: TButton; Button2: TButton; Procedure Button1Click(Sender: TObject); Procedure Button2Click(Sender: TObject); Private. { Private declarations }. Public. { Public declarations }. End; Var. Form1: TForm1; Implementation. {$R *.dfm}. Procedure metka1; //Начальная метка - нужна что бы находить потом в exe файле эти символы и знать. //откуда начинать шифровать. //Здесь метка представляет из себя десятичные числа от 0 до 256 через запятые. //Если метка 50,60,70,80,90 то это соответствует символам 2<FPZ. //Кстати, такого кол-во символов в метке может быть мало и лучше использовать больше. //Т.к если программа большая то такие последовательности могут встретиться не один раз. Begin. Asm. DB 50,60,70,80,90 //2<FPZ это метка начальная. End; End; Procedure TForm1.Button1Click(Sender: TObject); Begin. Beep; ShowMessage('Период использования программы истёк!'); End; Procedure metka2; //Конечная метка - нужна чтобы знать до куда нужно шифровать в файле и. //докуда расшифровывать в памяти. Begin. Asm. DB 68,68,67,45,61 //DDA-= это метка конечная. End; End; Procedure TForm1.Button2Click(Sender: TObject); //Процедура Расшифрования(В даном примере и зашифрования). Var. PtrAddr: Pointer; {для Адреса процедуры вывода сообщения}. DwOldProtect: DWORD; Begin. PtrAddr := @TForm1.Button1Click;//Получаем адрес процедуры вывода сообщения. VirtualProtect(@TForm1.Button1Click, 2048, PAGE_READWRITE, @dwOldProtect); //2048 это размер в байтах с которыми можно работать(по моему). //Если процедура большая то нужно подбирать соответствующий размер. While ptrAddr <> @metka2 do //шифрование(слабое) выполняем пока не дойдем то конечной метки. Begin. Byte(ptrAddr^) := Byte(ptrAddr^) xor $41; //каждый байт в памяти ксорится с кодом 65'A'(к примеру). //Используйте более надёжные алгоритмы шифрования. Inc(Integer(ptrAddr)); End; Exit; //нужно так сделать что б компилятор включил эти процедуры. Metka1;//в код,т.к Delphi не вставляет в результирующий код процедуры, Metka2;//которые никогда не используются. End; //Такое шифрование взято для примера и не рекомендуется для использования серьёзной защиты. //Также рекомендуется использовать и проверочную контрольную сумму для проверки. //целостности кода программы. //Теперь осталось только сделать отдельную программу которая искала бы. //в этом exe файле начальную и конечную метки и шифровало бы всё между ними. // //Но для демонстрации можно посмотреть результат и сейчас. //Запустите программу и нажмите на кнопку 1 -Должно вывестись сообщение и звук.сигнал. //А если нажать на кнопку 2 - то прцедура нажатия на кнопку 1 зашифруется. //И если после этого нажать на кнопку 1 -то должно произойти что-то не предсказуемое. //т.к процедура зашифрованна и что-то нормального вы не увидите. //Источник информации: CopyRight «Королевства Delphi». //"Защита от несанкционированного использования программ, написанных на Delphi". End.
| Шифрование исполняемого файла |
Code: { **** UBPFD *********** by delphibase.endimus.com **** >> Шифрование исполняемого файла. В данном примере реализована процедура шифрования и расшифрования. Одной только процедуры "вывода сообщения".Процедура изночально. Не зашифровано ,что ни есть хорошо.Для того что бы процедура была. При запуске программы уже зашифрована надо написать внешнюю программку, Которая ба сканировала ехе-шник и находила определенные метки. (начальную и конечную) и шифровала бы всё между ними.Таким образом. Вы получите готовый ехе-шник с уже зашифрованой(зашифроваными)процедурой. Для того чтоб некоторым умным людям (crackers)жить было не легко, После расшифровки и выполнения процедуры можно её опять зашифровать. Более потробную информацию читайте в статье на «Королевства Delphi». Http://delphi.vitpc.com/mastering/safe/safe.htm. Там же читайте Открытый проект "Анти крэковые мучения". Http://delphi.vitpc.com/mastering/safe/index.htm. Зависимости: Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls; Автор: DDA, Vologda. Copyright: «Королевства Delphi» Защита от несанкционированного. Использования программ, написанных на Delphi. Дата: 3 марта 2004 г. ***************************************************** } Unit Unit1; Interface. Uses. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; Type. TForm1 = class(TForm). Button1: TButton; Button2: TButton; Procedure Button1Click(Sender: TObject); Procedure Button2Click(Sender: TObject); Private. { Private declarations }. Public. { Public declarations }. End; Var. Form1: TForm1; Implementation. {$R *.dfm}. Procedure metka1; //Начальная метка - нужна что бы находить потом в exe файле эти символы и знать. //откуда начинать шифровать. //Здесь метка представляет из себя десятичные числа от 0 до 256 через запятые. //Если метка 50,60,70,80,90 то это соответствует символам 2<FPZ. //Кстати, такого кол-во символов в метке может быть мало и лучше использовать больше. //Т.к если программа большая то такие последовательности могут встретиться не один раз. Begin. Asm. DB 50,60,70,80,90 //2<FPZ это метка начальная. End; End; Procedure TForm1.Button1Click(Sender: TObject); Begin. Beep; ShowMessage('Период использования программы истёк!'); End; Procedure metka2; //Конечная метка - нужна чтобы знать до куда нужно шифровать в файле и. //докуда расшифровывать в памяти. Begin. Asm. DB 68,68,67,45,61 //DDA-= это метка конечная. End; End; Procedure TForm1.Button2Click(Sender: TObject); //Процедура Расшифрования(В даном примере и зашифрования). Var. PtrAddr: Pointer; {для Адреса процедуры вывода сообщения}. DwOldProtect: DWORD; Begin. PtrAddr := @TForm1.Button1Click; //Получаем адрес процедуры вывода сообщения. VirtualProtect(@TForm1.Button1Click, 2048, PAGE_READWRITE, @dwOldProtect); //2048 это размер в байтах с которыми можно работать(по моему). //Если процедура большая то нужно подбирать соответствующий размер. While ptrAddr <> @metka2 do. //шифрование(слабое) выполняем пока не дойдем то конечной метки. Begin. Byte(ptrAddr^) := Byte(ptrAddr^) xor $41; //каждый байт в памяти ксорится с кодом 65'A'(к примеру). //Используйте более надёжные алгоритмы шифрования. Inc(Integer(ptrAddr)); End; Exit; //нужно так сделать что б компилятор включил эти процедуры. Metka1; //в код,т.к Delphi не вставляет в результирующий код процедуры, Metka2; //которые никогда не используются. End; //Такое шифрование взято для примера и не рекомендуется для использования серьёзной защиты. //Также рекомендуется использовать и проверочную контрольную сумму для проверки. //целостности кода программы. //Теперь осталось только сделать отдельную программу которая искала бы. //в этом exe файле начальную и конечную метки и шифровало бы всё между ними. //Но для демонстрации можно посмотреть результат и сейчас. //Запустите программу и нажмите на кнопку 1 -Должно вывестись сообщение и звук.сигнал. //А если нажать на кнопку 2 - то прцедура нажатия на кнопку 1 зашифруется. //И если после этого нажать на кнопку 1 -то должно произойти что-то не предсказуемое. //т.к процедура зашифрованна и что-то нормального вы не увидите. //Источник информации: CopyRight «Королевства Delphi». //"Защита от несанкционированного использования программ, написанных на Delphi". End.
| Шифрование и дешифрование текстов по принципу S-Coder со скрытым ключом |
Code: { **** UBPFD *********** by kladovka.net.ru **** >> Шифрование и дешифрование текстов по принципу S-Coder со скрытым ключом. После прменения выполнения функции Encrypt с входным исходным. Текстом, результат будет иметь символы в диапазоне от. 0 - 255 в ASCII таблице, следовательно если вам надо сохранить. Где либо шифровку, то лучше преобразовать в числовой вид - 16разрядный hex из ASCII таблицы (функция Write). Зависимости: Windows, SysUtils. Автор: Yuri Btr, btr1978@rambler.ru, ICQ:125988632, Керчь. Copyright: EFD Systems http://www.mindspring.com/~efd. Дата: 23 мая 2002 г. ********************************************** } Procedure EnCipher(var Source:AnsiString); {Low order, 7-bit ASCII (char. 32-127) encryption designed for database use. Control and high order (8 bit) characters are passed through unchanged. Uses a hybrid method...random table substitution with bit-mangled output. No passwords to worry with (the built-in table is the password). Not industrial. Strength but enough to deter the casual hacker or snoop. Even repeating char. Sequences have little discernable pattern once encrypted. NOTE: When displaying encrypted strings, remember that some characters. Within the output range are interpreted by VCL components; for. Example, '&'.}. Asm. Push ESI //Save the good stuff. Push EDI. Or EAX,EAX. Jz @Done. Push EAX. Call UniqueString. Pop EAX. Mov ESI,[EAX] //String address into ESI. Or ESI,ESI. Jz @Done. Mov ECX,[ESI-4] //String Length into ECX. Jecxz @Done //Abort on null string. Mov EDX,ECX //initialize EDX with length. Lea EDI,@ECTbl //Table address into EDI. Cld //make sure we go forward. @L1: Xor EAX,EAX. Lodsb //Load a byte from string. Sub AX,32 //Adjust to zero base. Js @Next //Ignore if control char. Cmp AX,95. Jg @Next //Ignore if high order char. Mov AL,[EDI+EAX] //get the table value. Test CX,3 //screw it up some. Jz @L2. Rol EDX,3. @L2: And DL,31. Xor AL,DL. Add EDX,ECX. Add EDX,EAX. Add AL,32 //adjust to output range. Mov [ESI-1],AL //write it back into string. @Next: Dec ECX. Jnz @L1. // Loop @L1 //do it again if necessary. @Done: Pop EDI. Pop ESI. Jmp @Exit. // Ret //this does not work with Delphi 3 - EFD 971022. @ECTbl: //The encipher table. DB 75,85,86,92,93,95,74,76,84,87,91,94. DB 63,73,77,83,88,90,62,64,72,78,82,89. DB 51,61,65,71,79,81,50,52,60,66,70,80. DB 39,49,53,59,67,69,38,40,48,54,58,68. DB 27,37,41,47,55,57,26,28,36,42,46,56. DB 15,25,29,35,43,45,14,16,24,30,34,44. DB 06,13,17,23,31,33,05,07,12,18,22,32. DB 01,04,08,11,19,21,00,02,03,09,10,20. @Exit: End; Procedure DeCipher(var Source:AnsiString); {Decrypts a string previously encrypted with EnCipher.}. Asm. Push ESI //Save the good stuff. Push EDI. Push EBX. Or EAX,EAX. Jz @Done. Push EAX. Call UniqueString. Pop EAX. Mov ESI,[EAX] //String address into ESI. Or ESI,ESI. Jz @Done. Mov ECX,[ESI-4] //String Length into ECX. Jecxz @Done //Abort on null string. Mov EDX,ECX //Initialize EDX with length. Lea EDI,@DCTbl //Table address into EDI. Cld //make sure we go forward. @L1: Xor EAX,EAX. Lodsb //Load a byte from string. Sub AX,32 //Adjust to zero base. Js @Next //Ignore if control char. Cmp AX,95. Jg @Next //Ignore if high order char. Mov EBX,EAX //save to accumulate below. Test CX,3 //unscrew it. Jz @L2. Rol EDX,3. @L2: And DL,31. Xor AL,DL. Add EDX,ECX. Add EDX,EBX. Mov AL,[EDI+EAX] //get the table value. Add AL,32 //adjust to output range. Mov [ESI-1],AL //store it back in string. @Next: Dec ECX. Jnz @L1. // Loop @L1 //do it again if necessary. @Done: Pop EBX. Pop EDI. Pop ESI. Jmp @Exit. // Ret Does not work with Delphi3 - EFD 971022. @DCTbl: //The decryption table. DB 90,84,91,92,85,78,72,79,86,93,94,87. DB 80,73,66,60,67,74,81,88,95,89,82,75. DB 68,61,54,48,55,62,69,76,83,77,70,63. DB 56,49,42,36,43,50,57,64,71,65,58,51. DB 44,37,30,24,31,38,45,52,59,53,46,39. DB 32,25,18,12,19,26,33,40,47,41,34,27. DB 20,13,06,00,07,14,21,28,35,29,22,15. DB 08,01,02,09,16,23,17,10,03,04,11,05. @Exit: End; Procedure Crypt(var Source:Ansistring;const Key:AnsiString); {Encrypt AND decrypt strings using an enhanced XOR technique similar to. S-Coder (DDJ, Jan. 1990). To decrypt, simply re-apply the procedure. Using the same password key. This algorithm is reasonably secure on. It's own; however,there are steps you can take to make it even more. Secure. 1) Use a long key that is not easily guessed. 2) Double or triple encrypt the string using different keys. To decrypt, re-apply the passwords in reverse order. 3) Use EnCipher before using Crypt. To decrypt, re-apply Crypt. First then use DeCipher. 4) Some unique combination of the above. NOTE: The resultant string may contain any character, 0..255.}. Asm. Push ESI //Save the good stuff. Push EDI. Push EBX. Or EAX,EAX. Jz @Done. Push EAX. Push EDX. Call UniqueString. Pop EDX. Pop EAX. Mov EDI,[EAX] //String address into EDI. Or EDI,EDI. Jz @Done. Mov ECX,[EDI-4] //String Length into ECX. Jecxz @Done //Abort on null string. Mov ESI,EDX //Key address into ESI. Or ESI,ESI. Jz @Done. Mov EDX,[ESI-4] //Key Length into EDX. Dec EDX //make zero based. Js @Done //abort if zero key length. Mov EBX,EDX //use EBX for rotation offset. Mov AH,DL //seed with key length. Cld //make sure we go forward. @L1: Test AH,8 //build stream char. Jnz @L3. Xor AH,1. @L3: Not AH. Ror AH,1. Mov AL,[ESI+EBX] //Get next char. from Key. Xor AL,AH //XOR key with stream to make pseudo-key. Xor AL,[EDI] //XOR pseudo-key with Source. Stosb //store it back. Dec EBX //less than zero ? Jns @L2 //no, then skip. Mov EBX,EDX //re-initialize Key offset. @L2: Dec ECX. Jnz @L1. @Done: Pop EBX //restore the world. Pop EDI. Pop ESI. End; Function Encrypt(text:Ansistring):Ansistring; //Это прсто интерфейс функций EnCipher и Crypt для шифрования строки текста. Begin. {шифруем текст}. EnCipher(Text); {зашифровываем ключом в Edit1}. Crypt(Text,Form1.Edit1.Text); Result:=Text; End; Function Decrypt(text:Ansistring):Ansistring; //Это прсто интерфейс функций EnCipher и Crypt для дешифрования строки текста begin. Begin. {расшифровываем ключом в Edit1}. Crypt(Text,Form1.Edit1.Text); {расшифровываем результат}. DeCipher(Text); Result:=Text; End; Function Write(text:Ansistring):Ansistring; Var. I:integer; Begin. Result:=''; For i:=1 to Length(text). Do. {получаем hex код из текста}. Result:=Result+InttoHex(ord(text[i]),2); End; Function Read(text:Ansistring):Ansistring; Var. I:integer; Begin. Result:=''; For I:=1 to Length(text). Do. If odd(i). Then. {получаем текст из hex кода}. Result:=Result+Chr(StrtoInt('$'+text[i]+text[i+1])); End;
| Шифрование текстовых полей таблицы Interbase. |
Автор: Vemer.
WEB-сайт: http://delphibase.endimus.com.
Code: { **** UBPFD *********** by delphibase.endimus.com **** >> Шифрование текстовых полей таблицы Interbase. Простенько но шустро шифрует текстовую строку VarChar в текстовую. Строку VarChar, пригодную для сохранения в текстовом поле базы Interbase. НЕ ЗАТРАГИВАЕТ ПРОБЕЛЫ! Метод генерации (в начале) и изменения ключа (в 2-местах!) в вашей программе. Лучше изменить от исходного в сторону усложнения, но не трогать "And 127" в конце. Для работы с Char возможно стоит добавить "Trim(S1);" в самое начало. Зависимости: Windows, SysUtils, DB. Автор: Vemer, Vemer@List.Ru, Петрозаводск. Copyright: Vemer. Дата: 16 ноября 2003 г. ***************************************************** } Function Morf(S1: string; T: Boolean): string; Var. LS: Byte; //длина строки. KB: Byte; //ключ, байт. I: Byte; //Счетчик. B: Byte; //байт строки. W: Smallint; //буфер для ключа. S2: string; //результат. Begin. LS := Length(S1); S2 := ''; KB := LS * LS; //-------Изменить/Усложнить!And 127 не трогать! If T = False then // Выбор между шифрованием и дешифрованием. Begin. For I := 1 to LS do. Begin //шифрование. B := Byte(S1[I]); If B > 32 then. Begin. W := B + KB; If W > 255 then. W := W - 223; B := W; End; //If. S2 := S2 + Chr(B); KB := (KB + (I * 2)) and 127; //-(1) Изменить/Усложнить! And 127 не трогать! End; //For. End. Else. Begin //дешифровка. For I := 1 to LS do. Begin. B := Byte(S1[I]); If B > 32 then. Begin. W := B - KB; If W < 33 then. W := W + 223; B := W; End; //If. S2 := S2 + Chr(B); KB := (KB + (I * 2)) and 127; //---(2) Сделать как в (1)! And 127 не трогать! End; //For. End; //Else. Result := S2; End; Пример использования: // В вычисляемом поле для отображения текста в нормальном виде: TableNewName.Value := Morf(TableName.Value, True); // Для занесения в таблицу в зашифрованном виде например из Edit: TableName.Value := Morf(Edit.Text, False);
| Шифрование SHA-1. |
Code: Unit main; Interface. Uses. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, Dialogs; Type. TForm1 = class(TForm). Memo1: TMemo; Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; CheckBox1: TCheckBox; CheckBox2: TCheckBox; CheckBox3: TCheckBox; BStop: TButton; SaveDialog1: TSaveDialog; OpenDialog1: TOpenDialog; Procedure FormCreate(Sender: TObject); Procedure Button1Click(Sender: TObject); Procedure Button2Click(Sender: TObject); Procedure FormResize(Sender: TObject); Procedure Button3Click(Sender: TObject); Procedure Button4Click(Sender: TObject); Procedure BStopClick(Sender: TObject); Private { Private declarations }. Public { Public declarations }. End; Var. Form1: TForm1; // - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Const. HC0=$67452301; HC1=$EFCDAB89; HC2=$98BADCFE; HC3=$10325476; HC4=$C3D2E1F0; K1=$5A827999; K2=$6ED9EBA1; K3=$8F1BBCDC; K4=$CA62C1D6; Var H0,H1,H2,H3,H4:integer; Hout:string; //Hout - результат. StopScan:boolean; Implementation. {$R *.DFM}. Function rol(const x:integer;const y:byte):integer ; //сдвиг числа x на y бит влево. Begin. Asm. Mov eax,x. Mov cl, y. Rol eax,cl. Mov x, eax. End; Result:=x; End; Procedure INIT; //Инициализация - присвоить пересенным значения констант. Begin. H0:=HC0;//$67452301; H1:=HC1;//$EFCDAB89; H2:=HC2;//$98BADCFE; H3:=HC3;//$10325476; H4:=HC4;//$C3D2E1F0; Hout:=''; End; Function PADDING(s:string;FS:integer):string; //добавление одного бита (1000000=128) и добавление нулей до кратности 64 байтам. Var size,i:integer; Begin. Size:=Length(s)*8; //size -входной размер в битах. S:=s+char(128); //добавление одного бита (1000000=128). While (Length(s) mod 64) <>0 do s:=s+#0; //добавление нулей до кратности 64 байтам. //############ ############# // IF ((size) >= 448) then // OLD. IF ((size mod 512) >= 448) then // если хвост превышает 48 байт то добавить пустой блок из 64 нулей. Begin. S:=s+#0; //добавление нулей до кратности 64. While (Length(s) mod 64) <>0 do s:=s+#0; End; I:=Length(s);size:=FS*8; While size > 0 do //запись в конец строки её размер. Begin. S[i]:=char(byte(size)); //получение младшего байта. Size:=size shr 8; //сдвиг вправо на 8 бит - перенос старшего байта на место младшего. I:=i-1; End; Result:=s; End; Procedure START(const S_IN:string); Var A,B,C,D,E,TEMP:integer; t,i:byte; W:array[0..79] of integer; Begin. T:=1; For i:=1 to ((Length(S_IN)) div 4) do. Begin. // W[i-1]:=ord(S_IN[t])*256*256*256+ord(S_IN[t+1])*256*256+ord(S_IN[t+2])*256+ord(S_IN[t+3]); W[i-1]:=(ord(S_IN[t]) shl 24) +(ord(S_IN[t+1]) shl 16)+(ord(S_IN[t+2]) shl 8)+ord(S_IN[t+3]); T:=t+4; End; For t:=16 to 79 do W[t]:=ROL(W[t-3] XOR W[t-8] XOR W[t-14] XOR W[t-16],1); A:=H0;B:=H1;C:=H2;D:=H3;E:=H4; { for t:=0 to 79 do // Разделить на 4 цикла !!! * * * * * * * * * * * * * * * Begin. If (t>=0) AND (t<=19) then TEMP:=ROL(A,5)+((B AND C) OR ((NOT B) AND D)) +E+K1+W[t]; If (t>=20) AND (t<=39) then TEMP:=ROL(A,5)+(B XOR C XOR D) +E+K2+W[t]; If (t>=40) AND (t<=59) then TEMP:=ROL(A,5)+((B AND C) OR (B AND D) OR (C AND D))+E+K3+W[t]; If (t>=60) AND (t<=79) then TEMP:=ROL(A,5)+(B XOR C XOR D) +E+K4+W[t]; E:=D; D:=C; C:=ROL(B,30); B:=A; A:=TEMP; End; } For t:=0 to 19 do. Begin. TEMP:=ROL(A,5)+((B AND C) OR ((NOT B) AND D)) +E+K1+W[t]; E:=D; D:=C; C:=ROL(B,30); B:=A; A:=TEMP; End; For t:=20 to 39 do. Begin. TEMP:=ROL(A,5)+(B XOR C XOR D) +E+K2+W[t]; E:=D; D:=C; C:=ROL(B,30); B:=A; A:=TEMP; End; For t:=40 to 59 do. Begin. TEMP:=ROL(A,5)+((B AND C) OR (B AND D) OR (C AND D))+E+K3+W[t]; E:=D; D:=C; C:=ROL(B,30); B:=A; A:=TEMP; End; For t:=60 to 79 do. Begin. TEMP:=ROL(A,5)+(B XOR C XOR D) +E+K4+W[t]; E:=D; D:=C; C:=ROL(B,30); B:=A; A:=TEMP; End; H0:=A+H0; H1:=B+H1; H2:=C+H2; H3:=D+H3; H4:=E+H4; //Form1.memo1.Lines.Add(inttohex(H0,8)+' '+inttohex(H1,8)+' '+inttohex(H2,8)+' '+inttohex(H3,8)+' '+inttohex(H4,8)); End; Procedure TForm1.FormCreate(Sender: TObject); Begin. WindowState:=wsMaximized; Form1.Memo1.Clear; Button2.Enabled:=false ; Form1.SaveDialog1.Filter := 'Text Files (*.txt)|*.TXT|All Files (*.*)|*.*'; CheckBox1.Checked:=true; CheckBox2.Checked:=true; Application.Title:='SHA-1'; Caption:='SHA-1'; End; Procedure Work(Z:string); Var s,s1:string; i,L,FS:integer; F:file; n:integer; Buf: array[1..65536] of char; Begin. Application.ProcessMessages; IF StopScan then exit; S:=''; AssignFile(F,Z); FileMode := FmOpenRead; Reset(F,1); FS:=FileSize(F); INIT; Repeat. BlockRead(F,Buf,sizeOf(Buf),n); SetLength(s1,n); For i:=1 to n do s1[i]:=Buf[i]; // s:=s+s1; S:=s1; L:=length(s1); IF ((L<65536) and (L>0)) then. Begin. S1:= PADDING(s,FS) ; I:=1; L:=length(s1); While i<L do. Begin. START(copy(s1,i,64)); I:=i+64; End; End; IF L =65536 then begin. I:=1; L:=length(s1); While i<L do. Begin. START(copy(s1,i,64)); I:=i+64; End; End; Until n=0; CloseFile(F); { INIT; S:=PADDING(s,FS) ; L:=length(s); I:=1; While i<L do. Begin. START(copy(s,i,64)); I:=i+64; End; } Hout:=inttohex(H0,8)+' '+inttohex(H1,8)+' '+inttohex(H2,8)+' '+inttohex(H3,8)+' '+inttohex(H4,8); S1:=Hout; If (Form1.CheckBox1.Checked AND Form1.CheckBox2.Checked) then. Form1.memo1.Lines.Add(s1+' '+inttostr(FS)+' '+ExtractFileName(Z)); If NOT ((Form1.CheckBox1.Checked AND Form1.CheckBox2.Checked)) then. Form1.memo1.Lines.Add(s1); If (Form1.CheckBox1.Checked AND NOT Form1.CheckBox2.Checked) then. Form1.memo1.Lines.Add(s1+' '+inttostr(FS)); If (NOT Form1.CheckBox1.Checked AND Form1.CheckBox2.Checked) then. Form1.memo1.Lines.Add(s1+' '+ExtractFileName(Z)); // abc.....opq = 84983E44 1C3BD26E BAAE4AA1 F95129E5 E54670F1. // abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopqW = 39958831d7dd0a53e9bfba578cdf45e5ec542e8c. //abc = A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D; //abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnop = 47B17281 0795699F E739197D 1A1F5960 700242F1. End; Procedure TForm1.Button1Click(Sender: TObject); Begin. If Form1.OpenDialog1.Execute then. Begin. StopScan:=false; Work(OpenDialog1.FileName); Button2.Enabled:=true; End; End; Function ScanDir(Dir:string):string; Var SearchRec:TSearchRec; //scan_result :string; Begin. Application.ProcessMessages; IF StopScan then exit; If Dir<>'' then if Dir[length(Dir)]<>'\' then Dir:=Dir+'\'; If FindFirst(Dir+'*.*', faAnyFile, SearchRec)=0 then. Repeat. If (SearchRec.name='.') or (SearchRec.name='..') then continue; If ( (SearchRec.Attr and faDirectory)<>0) then. Begin. IF Form1.CheckBox3.Checked then ScanDir(Dir+SearchRec.name). End. Else Work(Dir+SearchRec.name); Until FindNext(SearchRec)<>0; FindClose(SearchRec); End; Procedure TForm1.Button2Click(Sender: TObject); //Scan Button pressed. Begin. IF Button2.Enabled=false then exit; StopScan:=false; Caption:='Scanning ...'; ScanDir(ExtractFileDir(Form1.OpenDialog1.FileName)); Caption:='SHA-1'; End; Procedure TForm1.FormResize(Sender: TObject); Begin. Memo1.Height:=Height-70; End; Procedure TForm1.Button3Click(Sender: TObject); Begin. If SaveDialog1.Execute then. Begin. If FileExists(SaveDialog1.FileName) then. IF MessageDlg('File'+#13+SaveDialog1.FileName+#13+'already exists!' +#13+#13+'Overwrite (Yes/No) ?',mtWarning, [mbYes, mbNo], 0) = mrNo then exit; Memo1.Lines.SaveToFile(SaveDialog1.FileName); End; End; Procedure TForm1.Button4Click(Sender: TObject); Begin. Form1.Memo1.Clear; End; Procedure TForm1.BStopClick(Sender: TObject); Begin. StopScan:=true; End; End.
Курсоры: доступ к отдельным строкам.
| Курсоры: доступ к отдельным строкам |
Курсоры: доступ к отдельным строкам.
Оператор выбора (select) возвращает обычно несколько строк, либо ничего не возвращает. Если оператор выбора возвращает в результате несколько строк, то с помощью курсоров можно получить доступ к каждой строке в отдельности.
В этой главе рассматриваются следующие темы:
· Дается общий обзор курсоров;
· Описывается, как объявить и открыть курсор;
· Объясняется, как получить данные с помощью курсора;
· Объясняется, как обновить или удалить данные с помощью курсора;
· Описывается, как закрыть курсор и освободить занимаемую им память;
· Даются примеры использования курсоров;
· Описывается,как нейтрализовать воздействие (locking affects) курсоров;
· Описывается, как получить информацию о курсорах.
Что такое курсор ?
Курсор - это символическое название объекта, который связан с оператором выбора с помощью декларативного оператора. Он состоит из следующих частей:
· Результирующего множества курсора - множества (таблицы) строк, которое получено в результате запроса и с которым связывается курсор;
· Позиции курсора - указателя на одну из строк результирующего множества.
Позиция курсора указывает на текущую строку курсора. Пользователь может непосредственно модифицировать или удалять эту строку операторами update или delete, используя конструкцию с названием курсора. Можно изменить текущую позицию курсора с помощью операции fetch (передвинуть и загрузить). Эта операция переводит курсор на одну или несколько строк ниже в результирующем множестве.
Курсор аналогичен указателю на записи файла. Однако курсор можно сдвигать только вперед по результирующему множеству (последовательный доступ). Если несколько строк уже пройдены, то нельзя вернуться назад и снова получить к ним доступ, переведя на них курсор. Этот процесс позволяет просматривать строки друг за другом.
После объявления курсора он может находиться в двух состояниях:
· Закрытом - В этом случае не существует результирующего множества, поэтому нельзя считывать из него информацию. Первоначально курсор находится в этом состоянии. Чтобы использовать курсор, его необходимо явно открыть. После окончания работы курсор необходимо явно закрыть. SQL Сервер может неявно закрыть курсор в некоторых случаях, которые будут далее перечислены;
· Открытом - В этом случае с помощью курсора можно считывать и модифицировать строки.
Курсор можно закрыть и затем снова отрыть его. Повторное открытие курсора вновь создает результирующее множество и курсор устанавливается непосредственно перед первой строкой в этом множестве. Это позволяет пройти по результирующему множеству столько раз, сколько это необходимо. Курсор можно закрыть в любое время; необязательно проходить все результирующее множество.
Все операции с курсором, такие как передвижение и модификация, выполняются по отношению к текущей позиции курсора. Обновление курсорной строки включает в себя изменение данных в этой строке и полное удаление этой строки. Курсор нельзя использовать для вставки строк. Все обновления через курсор выполняются в соответствующих базовых таблицах, откуда выбирается результирующее множество.
Как SQL Сервер обрабатывает курсоры
Когда доступ к данным осуществляется через курсор, SQL Сервер разбивает процесс на следующие шаги:
· Объявление курсора;
SQL Сервер создает структуру курсора и компилирует запрос, определенный для курсора. Он сохраняет скомпилированный план, но не выполняет его.
· Открытие курсора;
SQL Сервер выполняет план запроса. Он просматривает базовые таблицы (столько, сколько это необходимо как в обычном операторе выбора) и создает результирующее множество курсора. Он подготавливает необходимые временные таблицы, порожденные запросом, и выделяет ресурсы (такие как память) для реализации курсора. Он также располагает курсор перед первой строкой результирующего множества.
· Передвижение курсора;
SQL Сервер передвигает курсор на одну или несколько позиций по результирующему множеству. Он выбирает данные из строки и сохраняет позицию курсора, чтобы в дальнейшем достичь конца результирующего множества.
· Обновление или удаление данных через курсор;
SQL Сервер обновляет или удаляет данные в указанной курсором строке результирующего множества (и в соответствующих базовых таблицах, откуда были выбраны данные). Этот шаг необязателен.
· Закрытие курсора;
SQL Сервер закрывает результирующее множества курсора, удаляет все временные таблицы и освобождает ресурсы, занятые курсором. Однако он сохраняет план выполнения запроса, чтобы снова можно было открыть курсор.
· Удаление курсора.
SQL Сервер удаляет план выполнения курсора из памяти и все ссылки на структуру курсора. После этого нужно объявить курсор, чтобы снова использовать его.
Объявление курсоров
Пользователь должен объявить курсор прежде, чем можно будет его использовать. В объявлении указывается запрос, который определяет результирующее множество курсора. Пользователь может явно объявить курсор для обновления или только для чтения с помощью ключевых слов for update (для обновления) или for read only (только для чтения). Если эти слова не указаны, то SQL Сервер определяет можно ли обновлять через курсор, основываясь на типе запроса, который формирует результирующее множество курсора. Нельзя использовать операторы update и delete в формирующем запросе для курсора, объявленного только для чтения.
Синтаксис объявления курсора
Синтаксис оператора declare cursor (объявление курсора) имеет следующий вид:
Declare название_курсора cursor.
For оператор_выбора.
[for {read only | update [of список_столбцов]}].
Оператор declare cursor должен предшествовать любому оператору open (открыть) для этого курсора. Оператор declare cursor нельзя совмещать с другими операторами в одном Transact-SQL пакете за исключением случая, когда курсор используется в сохраненной процедуре.
Оператор_выбора (select) является запросом, который определяет результирующее множество данного курсора. Вообще говоря, в этом операторе можно использовать весь синтаксис и семантику оператора select, включая ключевое слово holdlock. Однако, в нем нельзя использовать конструкции compute, for browse и into.
Например, в следующем операторе объявляется курсор authors_crsr на результирующем множестве, которое содержит всех авторов, которые не живут в Калифорнии:
Declare authors_crsr cursor.
For select au_id, au_lname, au_fname.
From authors.
Where state != 'CA'
Оператор выбора в объявлении курсора может содержать ссылки на названия параметров и локальные переменные. Однако эти параметры и локальные переменные должны быть определены в сохраненной процедуре, которая содержит оператор объявления курсора declare cursor. Если курсор используется в триггере, то в соответствующем операторе выбора можно ссылаться на временные триггерные таблицы inserted и deleted. Более подробную информацию об операторе выбора можно посмотреть в главе 2 «Запросы: выбор данных из таблицы».
Области действия курсора
Курсор определяется своей областью (диапазоном) действия, которая определяет временной промежуток (region), в течении которого курсор существует. Вне этого промежутка курсор перестает существовать. Области действия курсора определяются следующим образом:
· Сессия - В этом случае область действия курсора начинается в момент регистрации клиента SQL Сервера и заканчивается, когда клиент заканчивает работу. Эта область действия отличается от областей, определяемых сохраненными процедурами и триггерами;
· Сохраненная процедура - В этом случае область действия курсора начинается с момента начала выполнения сохраненной процедуры и заканчивается, когда она заканчивает выполнение. Когда сохраненная процедура вызывает другую процедуру, то SQL Сервер начинает отсчет новой области действия и рассматривает ее, как подобласть области действия первой процедуры;
· Триггер - В этом случае область действия курсора начинается с момента начала выполнения триггера и заканчивается, когда триггер заканчивает свою работу.
Название курсора должно быть уникально в области его действия. В различных областях названия курсоров могут совпадать. Курсор определенный для одной области недоступен из других областей (диапазонов) действия. Однако, SQL Сервер позволяет использовать курсор в подобласти, если в ней не был определен курсор с тем же названием.
SQL Сервер определяет конфликты в названиях курсоров лишь в процессе выполнения. В сохраненной процедуре или триггере можно определить два курсора с одним названием, если в процессе исполнения они используются раздельно, как в следующем примере:
Create procedure proc1 (@flag int).
As.
If (@flag).
Declare names_crsr cursor.
For select au_fname from authors.
Else.
Declare names_crsr cursor.
For select au_lname from authors.
Return.
Эта процедура будет успешно выполнена, поскольку только один из курсоров names_crsr будет определен в процессе выполнения этой процедуры.
Развертывание курсора и результирующее множество
Результирующее множество курсора может не совпадать с данными из базовых таблиц. Например, курсор объявленный с конструкцией order by (упорядочить по) обычно требует создания внутренней таблицы для упорядочения строк результирующего множества. Кроме того, SQL Сервер не блокирует строки базовых таблиц, которые соответствуют строкам внутренней таблицы, что позволяет другим клиентам обновлять эти строки в базовых таблицах. В этом случае строки, которые видит клиент в результирующем множестве могут не отражать последних изменений, произошедших в базовых таблицах.
Результирующее множество курсора порождается по мере его продвижения. Это означает, что оператор выбора курсора выполняется как обычный запрос на выбор. Этот процесс известный как развертывание курсора (cursor scans) обеспечивает быстрое время ответа и не требует считывания строк, которые не нужны приложению в данный момент.
SQL Сервер требует, чтобы при развертывании курсора использовался уникальный индекс таблицы, особенно на нулевом уровне изоляции считывания (isolation level 0 reads). Если таблица содержит столбец-счетчик и необходимо создать неуникальный индекс для этой таблицы, то следует использовать опцию базы данных identity in nonunique index (счетчик в неуникальном индексе), что позволит автоматически включать столбец-счетчик в ключи табличных индексов и поэтому все они будут уникальными. Таким образом, эта опция делает логически неуникальные индексы внутренне уникальными, что позволяет использовать их в обновляемых курсорах на нулевом уровне изоляции считывания.
Можно также использовать курсор для таблиц без индексов, если эти таблицы не обновляются другими процессами, что приводит к изменению позиций строк. Например:
Declare storinfo_crsr cursor.
For select stor_id, stor_name, payterms.
From stores.
Where state = 'CA'
Таблица stores, указанная в этом курсоре, вообще не содержит индексов. SQL Сервер допускает объявление курсора в таблице без уникальных индексов, но при обновлении или удалении из нее строк закрываются все курсоры в таких таблицах.
Создание обновляемых курсоров
Если курсор является обновляемым, то через него можно обновлять содержимое строк или удалять строки полностью. Если курсор предназначен только для чтения, то через него можно только считывать данные. По умолчанию SQL Сервер пытается сделать курсор обновляемым и если это не удается, то курсор предназначается для чтения.
Можно явно указать, является ли курсор обновляемым с помощью ключевых слов read only или update в операторе declare. Например, в следующем операторе определяется обновляемое результирующее множество для курсора pubs_crsr:
Declare pubs_crsr cursor.
For select pub_name, city, state.
From publishers.
For update of city, state.
В этом примере результирующее множество будет включать все строки из таблицы publishers, но только поля city и state явно указаны как обновляемые.
Если через курсор не нужно обновлять или удалять, то его следует объявить только для чтения. Если явно не указано является ли курсор обновляемым или предназначенным только для чтения, то SQL Сервер по умолчанию считает курсор обновляемым, если соответствующий оператор выбора не содержит следующих конструкций:
· опции distinct (различные);
· предложения group by (группировка);
· агрегирующих функций;
· подзапросов;
· оператора union (объединить);
· предложения at isolation read uncommitted.
Нельзя указывать предложение for update, если оператор выбора курсора содержит одну из вышеперечисленных конструкций. SQL Сервер устанавливает курсор только для чтения, если предложение order by содержится в операторе выбора этого курсора. Дополнительная информация о курсорах содержится в главе «Курсоры» Справочного руководства SQL Сервера.
Если в предложении for update не указывается список столбцов, то все столбцы будут обновляемыми. Как было отмечено ранее при описании развертывания курсора, SQL Сервер пытается использовать уникальные индексы для обновляемых курсоров, когда развертывает базовую таблицу. При наличии курсора SQL Сервер рассматривает индекс, содержащий столбец-счетчик, как уникальный, даже если он и не объявлен таковым.
SQL Сервер позволяет указывать в списке столбцов предложения for update названия столбцов, которых нет в операторе выбора курсора.
В следующем примере SQL Сервер использует уникальный индекс в столбце pub_id таблицы publishers (несмотря на то, что этого столбца нет в определении курсора newpubs_crsr):
Declare newpubs_crsr cursor.
For select pub_name, city, state.
From publishers.
For update.
Если предложение for update не указано, то SQL Сервер может выбрать любой уникальный индекс или, при его отсутствии, любую комбинацию индексов для развертывания таблицы. Однако, если явно указано предложение for update, то должен существовать уникальный индекс, необходимый для развертывания базовой таблицы. В противном случае будет выдано сообщение об ошибке.
В списке столбцов предложения for update следует указывать столбцы, в которых необходимо обновлять данные, и в этом списке не должно быть столбцов, включенных в уникальные индексы. Это позволяет SQL Серверу использовать уникальные индексы для развертки таблицы и позволяет избежать аномального обновления известного как Проблема привидений (Halloween Problem).
Эта проблема возникает, когда клиент обновляет поле строки результирующего множества курсора, которое влияет на порядок расположения строк базовой таблицы. Например, если SQL Сервер получает доступ к базовой таблице используя индекс, и ключ (значение) индекса обновляется клиентом, то измененная строка может переместиться и следовательно может быть снова считана через курсор. Это результат того, что обновляющий курсор лишь логически создает результирующее множество. На самом деле это множество является подмножеством базовой таблицы, на основе которой получен курсор.
Открытие курсоров
После объявления курсора его необходимо открыть, чтобы получить доступ к отдельным строкам. Открытие курсора состоит из вычисления оператора выбора, указанного в определении курсора, и формирования его результирующего множества. Операция открытия имеет следующий вид:
Open название_курсора.
После открытия курсор располагается перед первой строкой результирующего множества. Теперь можно использовать операцию fetch (загрузка) для считывания первой строки результирующего множества.
SQL Сервер не позволяет открывать курсор, если он уже открыт или еще не объявлен. Можно снова открыть ранее закрытый курсор, чтобы вернуть курсор в начало результирующего множества.
Считывание строк данных с помощью курсоров
После объявления и открытия курсора можно выбирать строки из результирующего множества с помощью команды fetch (загрузить, сдвинуть). Эта команда возвращает клиенту одну или несколько строк. Можно включить в эту команду Transact-SQL параметры или локальные переменные для сохранения возвращаемых данных.
Синтаксис оператора fetch
Оператор fetch имеет следующий синтаксис:
Fetch название_курсора [into список_переменных].
Например, после объявления и открытия курсора authors_crsr можно считать первую строку результирующего множества следующим образом:
Fetch authors_crsr.
Au_id au_lname au_fname.
--------------- ------------------- ---------------
341-22-1782 Smith Meander.
Каждый последующий оператор fetch выбирает следующую строку результирующего множества. Например:
Fetch authors_crsr.
Au_id au_lname au_fname.
-------------- -------------- ---------------
527-72-3246 Greene Morningstar.
После прохода всех строк курсор будет указывать на последнюю строку результирующего множества. Если вновь попытаться выполнить команду fetch, то SQL Сервер выдаст предупреждающее сообщение о состоянии переменной sqlstatus (описанной далее), которая указывает на отсутствие данных. Позиция курсора при этом не изменится.
Нельзя вновь прочитать строку, которая была уже пройдена, т.е. нельзя передвигаться по результирующему множеству в обратном направлении. Чтобы вернуться к началу, необходимо закрыть и затем вновь открыть результирующее множество, т.е. сгенерировать его снова.
В конструкции into указываются переменные, в которых SQL Сервер должен сохранить возвращаемые данные. Список_переменных должен состоять из ранее объявленных Transact-SQL параметров или локальных переменных.
Например, после объявления переменных @name, @city и @state можно сохранить в них поля строки, возвращаемой через курсор pubs_crsr:
Fetch pubs_crsr into @name, @city, @state.
SQL Сервер ожидает взаимно однозначного соответствия между переменными из списка и полями строки, возвращаемой через курсор. Типы переменных и параметров должны быть совместимы с типами данных столбцов результирующего множества.
Проверка состояния курсора
SQL Сервер возвращает информацию о состоянии (статусе) курсора после каждого чтения (загрузки). Информацию о состоянии можно также получить через глобальную переменную @@sqlstatus. В следующей таблице перечислены возможные значения этой переменной и их смысл:
Таблица 16-1: Значения переменной @sqlstatus.
Величина. Смысл. 0. Указывает на успешное окончание оператора fetch. 1. Указывает на ошибочное завершение оператора fetch. 2. Указывает, что в результирующем множестве больше нет данных для чтения. Это предупреждение выдается, если курсор находится на последней строке и клиент выдает команду fetch.
Следующий оператор определяет статус переменной @@sqlstatus для текущего открытого курсора authors_crsr:
Select @@sqlstatus.
-------------------
0.
(Выбрана 1 строка).
Только оператор fetch может устанавливать переменную @@sqlstatus. Другие операторы не затрагивают эту переменную.
Проверка количества загруженных строк
У SQL Сервера имеется также глобальная переменная @@rowcount. Она позволяет увидеть количество строк результирующего множества, возвращенных клиенту операторами fetch. Другими словами, в ней запоминается общее количество строк, просмотренных через курсор до текущего момента времени.
После чтения всех строк результирующего множества значение переменной @@rowcount совпадает с общим числом строк в этом множестве. Заметим, что на каждый открытый курсор заводится своя переменная @@rowcount. Эта переменная удаляется вместе с удалением курсора. Проверка значения переменной @@rowcount позволяет определить общее число строк, считанных через курсор операторами fetch.
В следующем примере определяется значение переменной @@rowcount для текущего открытого курсора authors_crsr:
Select @@rowcount.
-------------------
1.
(Выбрана 1 строка).
Получение нескольких строк одним оператором fetch
По умолчанию команда fetch позволяет получить одну строку данных за один раз. Пользователь может установить опцию cursor rows (курсорные строки), чтобы изменить число строк, возвращаемых одной командой fetch. Однако эта опция не влияет на операторы fetch, содержащие конструкцию into.
Команда установки этой опции имеет следующий вид:
Set cursor rows число for название_курсора.
Где параметр число указывает на число возвращаемых через курсор строк. По умолчанию этот парметр равен 1 для каждого объявленного курсора. Установку этой опции можно сделать и при открытом и при закрытом курсоре.
Например, можно следующим образом изменить количество строк, возвращаемых через курсор authors_crsr:
Set cursor rows 3 for authors_crsr.
Теперь после каждого считывания оператор fetch будет возвращать три строки:
Fetch authors_crsr.
Au_id au_lname au_fname.
----------- ------------------- ---------------
648-92-1872 Blotchet-Halls Reginald.
712-45-1867 del Castillo Innes.
722-51-5424 DeFrance Michel.
После считывания курсор будет расположен на последней переданной строке (в данном примере на авторе Michel DeFrance).
Передача нескольких строк за один раз особенно удобна для приложений клиента. Если пользователь считывает более одной строки за раз, то Открытый Клиент или Встроенный SQL (Open Client or Embedded SQL) автоматически буферизуют строки, переданные приложению клиента. Клиент по-прежнему имеет построчный доступ к данным, но при выполнении операторов fetch обращение к SQL Серверу происходит реже, что повышает производительность системы.
Обновление и удаление строк с помощью курсора
Если курсор является обновляемым, то через него можно обновлять и удалять строки. SQL Сервер анализирует оператор выбора, определяющий курсор, чтобы выяснить можно ли обновлять через этот курсор. Можно также явно указать на обновляющий курсор с помощью предложения for update в операторе объявления курсора declare cursor. Дополнительную информацию по этому поводу можно посмотреть в разделе "Создание обновляемых курсоров".
Удаление строк из результирующего множества курсора
С помощью конструкции where current of в операторе delete можно удалять строку, где находится курсор. Если строка удаляется из результирующего множества, то она также удаляется из соответствующей базовой таблицы. С помощью курсора за один раз можно удалить только одну строку.
Предложение delete... where current of имеет следующий синтаксис:
Delete [from] [[база_данных.]владелец.]{название_таблицы | название_вьювера}.
Where current of название_курсора.
Название таблицы или вьювера, указанные в этом предложении, должна совпадать с названием таблицы или вьювера, указанных в предложении from оператора выбора, определяющего курсор.
Например, можно удалить строку, на которую указывает курсор authors_crsr с помощью следующего оператора:
Delete from authors.
Where current of authors_crsr.
Ключевое слово from здесь можно не указывать.
Замечание: Нельзя удалять строки с помощью курсора, который определен через соединение, даже если он объявлен как обновляемый.
После удаление строки с помощью курсора SQL Сервер располагает курсор перед строкой, которая следует за удаленной строкой в результирующем множестве. Нужно по-прежнему использовать оператор fetch, чтобы получить доступ к следующей строке. Если была удалена последняя строка, то SQL Сервер располагает курсор за последней строкой результирующего множества.
Например, после удаления строки в предыдущем примере (которая соответствует Мишелю ДеФрансу) можно просчитать следующие три строки результирующего множества следующим образом:
Fetch authors_crsr.
Au_id au_lname au_fname.
--------------- ------------------- ---------------
807-91-6654 Panteley Sylvia.
899-46-2035 Ringer Anne.
998-72-3567 Ringer Albert.
Конечно, можно удалить строку базовой таблицы и не обращаясь к курсору. Результирующее множество курсора будет изменяться в соответствии с изменением базовой таблицы.
Обновление строк результирующего множества курсора
Используя конструкцию where current of в операторе update, можно обновить содержимое строки, на которую указывает курсор. Каждое обновление результирующего множества курсора приводит к обновлению содержимого базовой таблицы, из которой получено множество курсора.
Оператор update... where current of имеет следующий синтаксис:
Update [[база_данных.]владелец.]{название_таблицы | название_вьювера}.
Set [[[база_данных.]владелец.]{название_таблицы | название_вьювера}].
Название_столбца1 = { выражение1 | NULL | (оператор_выбора)}.
[, название_столбца2 = { выражение2 | NULL | (оператор_выбора)}] ...
Where current of название_курсора.
В предложении set указываются названия столбцов и их новые (обновляемые) значения. Если здесь указывается несколько столбцов, то они должны разделяться запятыми.
Название таблицы или вьювера, указанное в этом операторе, должно совпадать с названием таблицы или вьювера, указанным в предложении from оператора выбора, определяющего курсор. Если в предложении from указано несколько таблиц или вьюверов (в случае соединения), то можно указать только ту таблицу (вьювер), которая действительно обновляется.
Например, можно обновить строку, на которую указывает курсор pubs_crsr, следующим образом:
Update publishers.
Set city = "Pasadena",
State = "CA".
Where current of pubs_crsr.
После обновления позиция курсора остается неизменной. Можно продолжать обновление строки, на которую указывает курсор, до тех пор, пока другой SQL оператор не изменит позицию курсора.
SQL позволяет обновлять столбцы базовой таблицы, которые не были указаны в списке столбцов оператора выбора, определяющего курсор. Однако, если в предложении for update указывается список столбцов, то обновлять можно содержимое только этих столбцов.
Закрытие и удаление курсора
Когда работа с результирующем множеством закончена, курсор можно закрыть. Команда закрытия имеет следующий вид:
Close название_курсора.
Закрытие курсора не изменяет его определения. После этого можно вновь открыть курсор, тогда SQL Сервер создаст новое результирующее множество с помощью того же запроса. Например:
Close authors_crsr.
Open authors_crsr.
После этого можно считывать данные через курсор authors_crsr, начиная с начала результирующего множества. Все условия, связанные с этим курсором (такие как число строк считываемых за один раз) остаются в силе.
Например:
Fetch authors_crsr.
Au_id au_lname au_fname.
----------- ------------------- ---------------
341-22-1782 Smith Meander.
527-72-3246 Greene Morningstar.
648-92-1872 Blotchet-Halls Reginald.
Если курсор больше не нужен, то его следует удалить (deallocate). Синтаксис оператора deallocate имеет следующий вид:
Deallocate cursor название_курсора.
Удаление курсора освобождает все ресурсы с ним связанные, включая название курсора. Нельзя вновь использовать название курсора до тех пор, пока курсор не удален. Если удаляется открытый курсор, SQL Сервер автоматически закрывает его. По окончанию соединения пользователя с сервером также закрываются и удаляются все курсоры.
Примеры использования курсора
Последующие примеры использования курсоров будут базироваться на следующем запросе:
Select author = au_fname + " " + au_lname, au_id.
From authors.
Order by au_lname.
Результат этого запроса имеет следующий вид:
Author au_id.
------------------------------ ----------------
Abraham Bennet 409-56-7008.
Reginald Blotchet-Halls 648-92-1872.
Cheryl Carson 238-95-7766.
Michel DeFrance 722-51-5454.
Ann Dull 427-17-2319.
Marjorie Green 213-46-8915.
Morningstar Greene 527-72-3246.
Burt Gringlesby 472-27-2349.
Sheryl Hunter 846-92-7186.
Livia Karsen 756-30-7391.
Chastity Locksley 486-29-1786.
Stearns MacFeather 724-80-9391.
Heather McBadden 893-72-1158.
Michael O'Leary 267-41-2394.
Sylvia Panteley 807-91-6654.
Anne Ringer 899-46-2035.
Albert Ringer 998-72-3567.
Meander Smith 341-22-1782.
Dick Straight 274-80-9391.
Dirk Stringer 724-08-9931.
Johnson White 172-32-1176.
Akiko Yokomoto 672-71-3249.
Innes del Castillo 712-45-1867.
В следующих пунктах показано как использовать курсор в этом запросе:
1. Сначала необходимо объявить курсор. В операторе declare курсор определяется с помощью вышеприведенного оператора выбора:
Declare newauthors_crsr cursor for.
Select author = au_fname + " " + au_lname, au_id.
From authors.
Order by au_lname.
2. После объявления курсор можно открыть:
Open newauthors_crsr.
3. Теперь можно считывать строки, используя курсор:
Fetch newauthors_crsr.
Author au_id.
------------------------- ---------------
Abraham Bennet 409-56-7008.
4. Можно считывать несколько строк за один раз, установив число с помощью команды set:
Set cursor rows 5 for newauthors_crsr.
Fetch newauthors_crsr.
Author au_id.
------------------------- ----------------
Reginald Blotchet-Halls 648-92-1872.
Cheryl Carson 238-95-7766.
Michel DeFrance 722-51-5454.
Ann Dull 427-17-2319.
Marjorie Green 213-46-8915.
Каждое последующее считывание будет сдвигать курсор еще на пять строк:
Fetch newauthors_crsr.
Author au_id.
------------------------- -----------------
Morningstar Greene 527-72-3246.
Burt Gringlesby 472-27-2349.
Sheryl Hunter 846-92-7186.
Livia Karsen 756-30-7391.
Chastity Locksley 486-29-1786.
5. После окончания работы с курсором его можно закрыть:
Close newauthors_crsr.
Закрытие курсора приводит к закрытию (releases) результирующего множества, но курсор остается определенным. Если его снова открыть командой open, то SQL Сервер снова выполняет запрос для формирования результирующего множества и устанавливает курсор перед первой строкой этого множества. По прежнему каждый оператор fetch будет считывать по пять строк.
Для полного удаления курсора следует выполнить команду deallocate:
Deallocate cursor newauthors_crsr.
Нельзя использовать название курсора до тех пор, пока курсор не удален командой deallocate:
Курсоры в сохраненных процедурах
Курсоры особенно полезны в сохраненных процедурах. С их помощью можно выполнить задание, требующее несколько запросов, всего одним запросом. Однако, все операции с курсором должны быть выполнены в одной процедуре. В сохраненной процедуре нельзя открывать, считывать или закрывать курсор, который не был объявлен в этой процедуре. Курсор не определен за пределами области действия (scope) сохраненной процедуры.
Например, следующая сохраненная процедура au_sales проверяет таблицу продаж, чтобы определить, продается ли у данного автора достаточно хорошо хотя бы одна книга:
Create procedure au_sales (@author_id id).
As.
/* declare local variables used for fetch */
Declare @title_id tid.
Declare @title varchar(80).
Declare @ytd_sales int.
Declare @msg varchar(120).
/* declare the cursor to get each book written by given author */
Declare author_sales cursor for.
Select ta.title_id, t.title, t.total_sales.
From titleauthor ta, titles t.
Where ta.title_id = t.title_id.
And ta.au_id = @author_id.
Open author_sales.
Fetch author_sales.
Into @title_id, @title, @ytd_sales.
If (@@sqlstatus = 2).
Begin.
Print "We do not sell books by this author.".
Close author_sales.
Return.
End.
/* if cursor result set is not empty, then process each row of information */
While (@@sqlstatus = 0).
Begin.
If (@ytd_sales = NULL).
Begin.
Select @msg = @title +
" had no sales this year.".
Print @msg.
End.
Else if (@ytd_sales < 500).
Begin.
Select @msg = @title +
" had poor sales this year.".
Print @msg.
End.
Else if (@ytd_sales < 1000).
Begin.
Select @msg = @title +
" had mediocre sales this year.".
Print @msg.
End.
Else.
Begin.
Select @msg = @title +
" had good sales this year.".
Print @msg.
End.
Fetch author_sales into @title_id, @title,
@ytd_sales.
End.
/* if error occurred, call a designated handler */
If (@@sqlstatus = 1) exec error_handle.
Close author_sales.
Deallocate cursor author_sales.
Return.
Дополнительную информацию о сохраненных процедурах можно получить в главе 14 "Использование сохраненных процедур".
Курсоры и блокировка
Методы блокировки при работе с курсором аналогичны обычным методам блокировки для SQL Сервера. Вообще говоря, операторы, считывающие данные (такие как select или readtext), используют разделяющую (shared) блокировку каждой страницы данных, чтобы предотвратить изменение данных со стороны неподтвержденных транзакций. Операторы обновления используют исключающую (exclusive) блокировку каждой страницы, которую они изменяют. Чтобы уменьшить вероятность тупиков (deadlocks) и улучшить производительность, SQL Сервер часто предваряет исключающую блокировку обновляющей блокировкой, которая указывает, что клиент собирается изменить данные на странице.
Для обновляющих курсоров SQL Сервер использует по умолчанию обновляющую блокировку при просмотре таблиц и вьюверов, указанных в предложении for update оператора declare cursor. Если предложение for update включено, но список таблиц пуст, то при обращении ко всем таблицам и вьюверам, указанным в предложении from оператора select, по умолчанию устанавливается обновляющая блокировка. Если предложение for update не указано, то при обращении ко всем таблицам и вьюверам устанавливается разделяющая блокировка. Чтобы использовалась разделяющая блокировка вместо обновляющей, необходимо добавить ключевое слово shared в предложении from. В частности, можно добавить слово shared к названию таблицы, для которой предпочтительна разделяющая блокировка.
Информация о блокировках SQL Сервера дается в Руководстве системного администратора SQL Сервера. Дополнительную информацию о курсорах и блокировках можно посмотреть в Справочном руководстве SQL Сервера.
Получение информации о курсорах
SQL Сервер предоставляет системную процедуру sp_cursorinfo, которая дает информацию о названии курсора, его текущем состоянии (таком как открыт или закрыт) и столбцах результирующего множества. В следующем примере дается информация о курсоре authors_crsr:
Sp_cursorinfo 0, authors_crsr.
Cursor name 'authors_crsr' is declared at nesting level '0'.
The cursor id is 327681.
The cursor has been successfully opened 1 times.
The cursor was compiled at isolation level 1.
The cursor is not open.
The cursor will remain open when a transaction is committed or rolled back.
The number of rows returned for each FETCH is 1.
The cursor is updatable.
There are 3 columns returned by this cursor.
The result columns are:
Name = 'au_id', Table = 'authors', Type = ID,
Length = 11 (updatable).
Name = 'au_lname', Table = 'authors', Type =
VARCHAR, Length = 40 (updatable).
Name = 'au_fname', Table = 'authors', Type =
VARCHAR, Length = 20 (updatable).
©Drkb::02996.
Error: Interface not supported.
I receive an "Interface is not supported" error when trying to use an interface.
Verify that STDVCL32.DLL and your type library are registered. If casting an interface, you must be using DCOM and the type library must be registered on the client.
©Drkb::00021.
Error permission denied when trying to run Kylix.
If you installed as root and accepted the defaults then Kylix was installed under the /root directory. By default the permissions for this directory are 700 so only the root user can access this directory tree for read, write or execute. If users besides root are to use Kylix it must be installed in a directory all will have access to. See the file INSTALL that comes with Kylix for more information.
©Drkb::04609.
| Error reading symbol file. |
This usually occurs when you move a project to another drive or directory. Simply deleting the project's .DSM and .DSK files should remedy the situation.
| Error: RPC Server is unavailable. |
The error is usually caused because the server can't be located. Make sure you can ping the server machine using the string you typed into the ComputerName property of the TRemoteServer. You might also want to try using an IP address instead in case there is some problem with your DNS configuration or the hosts file. Try setting the "Default Authentication Level" to (Run DCOMCNFG on the server to do this.) Lastly, check the Microsoft Developer's Network on the Web for the latest information on this Microsoft transport. The MSDN can be located at the time of the writing at www.microsoft.com/msdn.
Error -10 when trying to install Kylix.
The Error -10 is a generic install error. The usual cause of this is due to a previous version of Kylix that wasn't uninstalled completely. You will need to check the RPM database to see if there are still components from Kylix installed. This can be done with command rpm -qa | grep kylix. For each of the resulting packages (if there are none, then Kylix is completely uninstalled), use rpm -e PackageName to remove them. Then, try reinstalling Kylix.
If you have Kylix completely uninstalled (the rpm -qa | grep kylix command returns nothing), and after choosing "Begin Install" from the installation, the installer aborts with an error code -10, then the problem may be do with the your locale settings. Typing the command "locale" may show LC_NUMERIC="de_DE" (the German locale, in this case). Some versions of RPM (mostly newer ones) respect this setting and will use a comma as the decimal separator. This causes a problem for the Kylix installer. The installer needs a period as the decimal separator. The workaround is to reset the LC_NUMERIC environment like this:
Export LC_NUMERIC="en_US".
Once installation is finished, you can reset this value by setting it to the original locale. This problem can occur for any locale which does not use a period as the decimal separator.
It's possible that a previous version of Kylix was not uninstalled completely or that there is a problem with the RPM. [{more info}]. There are a couple ways to work around this. The first is to install as a user other than root. If you would rather not do this you can use the "-m" option on the setup script. So you would enter: ./setup.sh -m from a vterm. This tells the script to not use the RPM.
Примечание от Vit: обычно ошибка возникает при попытке установить Kylix от имени root и разрешается простой установкой Kylix от имени обычного пользователя.
©Drkb::04605.
| Example of Skip List source code. |
Code: {* Example of Skip List source code for Pascal: Skip Lists are a probabilistic alternative to balanced trees, as. Described in the June 1990 issue of CACM and were invented by. William Pugh in 1987. This file contains source code to implement a dictionary using. Skip lists and a test driver to test the routines. A couple of comments about this implementation: The routine randomLevel has been hard-coded to generate random. Levels using p=0.25. It can be easily changed. The insertion routine has been implemented so as to use the. Dirty hack described in the CACM paper: if a random level is. Generated that is more than the current maximum level, the. Current maximum level plus one is used instead. The code, as presented, allows duplicate entries which act in a FIFO. Manner. To disallow duplicates, the insert procedure needs to be modified. As indicated in the insert procedure. The library includes an adaptation of the Unix C random number generator, Since the standard Pascal random number generator is unsuitable. An attempt has been made to make sure that no integer overflow occurs. In the random number generator. However, this could not be tested. RandomBits is defined to be the number of bits returned by a call to. Random(). For most all machines with 32-bit integers, this is 31 bits. As currently set. The routines defined in this file are: Init: defines terminator and initializes the random bit source. NewList: returns a new, empty list. FreeList(l): deallocates the list l. RandomLevel: Returns a random level. Insert(l,key,value): inserts the binding (key,value) into l. If. AllowDuplicates is undefined, returns true if key was newly. Inserted into the list, false if key already existed. Delete(l,key): deletes any binding of key from the l. Returns. False if key was not defined. Search(l,key,value): Searches for key in l and returns true if found. If found, the value associated with key is stored in value. *} Program test(input,output); Const. SampleSize = 65536; (* The following constants are associated with the random number generator *). DifferentRandoms = 1073741824; (* 2^30 *). RandomTableSize = 31; (* size of table used *). (* The follow constants are associated with the routines to procedure. Random levels *). ChunkSize = 4; (* ChunkSize = 1/p *). RandomChucksInAWord = 15; (* = log(base ChunkSize) differentRandoms *). MaxLevel = 16; Type. RandomStuff = 0..maxint; KeyType= 0..maxint; ValueType = 0..maxint; LevelNum = 1..MaxLevel; Node = ^nodeRec; List = ^listRec; ListRec = record. Level : integer; Header : node; End; NodeRec = record. Key: keyType; Value: valueType; Case levelNum of. 1: (fwd1: array [1..1] of node;); 2: (fwd2: array [1..2] of node;); 3: (fwd3: array [1..3] of node;); 4: (fwd4: array [1..4] of node;); 5: (fwd5: array [1..5] of node;); 6: (fwd6: array [1..6] of node;); 7: (fwd7: array [1..7] of node;); 8: (fwd8: array [1..8] of node;); 9: (fwd9: array [1..9] of node;); 10: (fwd10: array [1..10] of node;); 11: (fwd11: array [1..11] of node;); 12: (fwd12: array [1..12] of node;); 13: (fwd13: array [1..13] of node;); 14: (fwd14: array [1..14] of node;); 15: (fwd15: array [1..15] of node;); 16: (fwd: array [1..16] of node;). End; Var randomChunksLeft : integer; RandomBits : randomStuff; L : list; I,k : integer; V : valueType; Keys : array [1..sampleSize] of keyType; Terminator:node; Head,tail : integer; RandomTable : array[1..31] of randomStuff; Function randomNumber: integer; Begin. RandomTable[head] := (randomTable[head] + randomTable[tail]). Mod differentRandoms; Head := (head mod randomTableSize) + 1; Tail := (tail mod randomTableSize) + 1; RandomNumber := randomTable[head]; End; Procedure initRandom; Begin. Head := 4; Tail := 1; RandomTable[1] := 1005175229; RandomTable[2] := 143302914; RandomTable[3] := 1027100827; RandomTable[4] := 879468478; RandomTable[5] := 755253631; RandomTable[6] := 928858961; RandomTable[7] := 331648406; RandomTable[8] := 45248011; RandomTable[9] := 26209743; RandomTable[10] := 433832350; RandomTable[11] := 944843483; RandomTable[12] := 438263339; RandomTable[13] := 813528929; RandomTable[14] := 629457392; RandomTable[15] := 618906479; RandomTable[16] := 573714703; RandomTable[17] := 766270699; RandomTable[18] := 275680090; RandomTable[19] := 436578616; RandomTable[20] := 509842102; RandomTable[21] := 649659208; RandomTable[22] := 891701505; RandomTable[23] := 24441858; RandomTable[24] := 562763940; RandomTable[25] := 980071615; RandomTable[26] := 1011597961; RandomTable[27] := 643279273; RandomTable[28] := 241719451; RandomTable[29] := 157584038; RandomTable[30] := 1069844923; RandomTable[31] := 471560540; End; Function randomLevel:integer; Var newLevel : integer; ShiftedBits : randomStuff; Done : boolean; Begin. NewLevel := 0; Done := false; Repeat. ShiftedBits := randomBits div ChunkSize; Done := (shiftedBits * ChunkSize) <> randomBits; NewLevel := newLevel + 1; RandomBits := shiftedBits; RandomChunksLeft := randomChunksLeft -1; If randomChunksLeft = 0 then. Begin. RandomBits := randomNumber; RandomChunksLeft := randomChucksInAWord; End; Until done; If newLevel > MaxLevel then newLevel := MaxLevel; RandomLevel := newLevel; End; Procedure init; Begin. New(terminator,1); Terminator^.key := (256*256*256*64-1)*2+1; RandomBits := randomNumber; RandomChunksLeft := randomChucksInAWord; End; Function newList:list; Var l : list; I : integer; Begin. New(l); L^.level := 1; New(l^.header,MaxLevel); For i := 1 to MaxLevel do l^.header^.fwd[i] := terminator; NewList := l; End; Procedure freeList(l:list); Var. K : levelNum; Done : boolean; P : node; Begin. P := l^.header^.fwd[1]; While (p <> terminator) do begin. K := 1; Done := false; While not done do begin. L^.header^.fwd[k] := p^.fwd[k]; K := k+1; If k > l^.level then done := true. Else done := l^.header^.fwd[k] <> p; End; Case k-1 of. 1 : dispose(p,1); 2 : dispose(p,2); 3 : dispose(p,3); 4 : dispose(p,4); 5 : dispose(p,5); 6 : dispose(p,6); 7 : dispose(p,7); 8 : dispose(p,8); 9 : dispose(p,9); 10 : dispose(p,10); 11 : dispose(p,11); 12 : dispose(p,12); 13 : dispose(p,13); 14 : dispose(p,14); 15 : dispose(p,15); 16 : dispose(p,16). End; P := l^.header^.fwd[1]; End; Dispose(l^.header,MaxLevel); Dispose(l); End; Procedure insert(l:list;key:keyType;value:valueType); Var. K : levelNum; Update : array[1..MaxLevel] of node; P,q : node; Begin. P := l^.header; For k:= l^.level downto 1 do begin. Q := p^.fwd[k]; While q^.key < key do begin. P := q; Q := p^.fwd[k]; End; Update[k] := p; End; (* The insert routine currently allows duplicate entries. To make. It update previous entries instead, put in the following code: If q^.key == key then begin. Q^.value = value; End; Else. *) Begin. K := randomLevel; If k>l^.level then begin. K := l^.level+1; L^.level := k; Update[k] := l^.header; End; Case k of. 1 : new(q,1); 2 : new(q,2); 3 : new(q,3); 4 : new(q,4); 5 : new(q,5); 6 : new(q,6); 7 : new(q,7); 8 : new(q,8); 9 : new(q,9); 10 : new(q,10); 11 : new(q,11); 12 : new(q,12); 13 : new(q,13); 14 : new(q,14); 15 : new(q,15); 16 : new(q,16). End; Q^.key := key; Q^.value := value; For k := k downto 1 do begin. P := update[k]; Q^.fwd[k] := p^.fwd[k]; P^.fwd[k] := q; End; End; End; Procedure delete(l:list;key:keyType); Var. K : levelNum; Update : array[1..MaxLevel] of node; P,q : node; Done : boolean; Begin. P := l^.header; For k:= l^.level downto 1 do begin. Q := p^.fwd[k]; While q^.key < key do begin. P := q; Q := p^.fwd[k]; End; Update[k] := p; End; If (q^.key = key) then begin. K := 1; Done := false; While not done do begin. Update[k]^.fwd[k] := q^.fwd[k]; K := k+1; If k > l^.level then done := true. Else done := update[k]^.fwd[k] <> q; End; Case k-1 of. 1 : dispose(q,1); 2 : dispose(q,2); 3 : dispose(q,3); 4 : dispose(q,4); 5 : dispose(q,5); 6 : dispose(q,6); 7 : dispose(q,7); 8 : dispose(q,8); 9 : dispose(q,9); 10 : dispose(q,10); 11 : dispose(q,11); 12 : dispose(q,12); 13 : dispose(q,13); 14 : dispose(q,14); 15 : dispose(q,15); 16 : dispose(q,16). End; End; End; Function search(l : list; key : keyType; var value : valueType) : boolean; Var k : integer; P,q : node; Begin. P := l^.header; For k:= l^.level downto 1 do begin. Q := p^.fwd[k]; While q^.key < key do begin. P := q; Q := p^.fwd[k]; End; End; If (q^.key <> key) then search := false. Else begin. Value := q^.value; Search := true; End; End; Begin. InitRandom; Init; L := newList; For k := 1 to sampleSize do begin. Keys[k]:=randomNumber; Insert(l,keys[k],keys[k]); End; For i := 1 to 4 do begin. For k := 1 to sampleSize do. If not search(l,keys[k],v) then writeln('not found'); For k := 1 to sampleSize do begin. Delete(l,keys[k]); Keys[k] := randomNumber; Insert(l,keys[k],keys[k]); End; End; FreeList(l); End.
| Explode / Implode a String? |
// 1. ...............................................
Code: Type. TStrArray = array of string; Function Explode(var a: TStrArray; Border, S: string): Integer; Var. S2: string; Begin. Result := 0; S2 := S + Border; Repeat. SetLength(A, Length(A) + 1); A[Result] := Copy(S2, 0,Pos(Border, S2) - 1); Delete(S2, 1,Length(a[Result] + Border)); Inc(Result); Until S2 = ''; End;
Extreme Programming и руководство пользователя.
| Extreme Programming и руководство пользователя |
"Extreme Programming и руководство пользователя", Рон Джеффриз
Рон Джеффриз 11/21/2001. Original text at www.xprogramming.com.
Какое-то время назад я набросал несколько идей на тему того, что руководства в ХР-проекте технические писатели должны создавать, работая как часть команды разработчиков. Это вполне серьезное предложение, хотя и написано в несколько вольной форме.
Давайте поразмыслим о методологии Extreme Programming, программных продуктах и руководствах к ним. Начнем со следующего:
· Каждый, кто когда-либо участвовал в создании программных продуктов, знает, что практически никто не читает руководств пользователя. Это подтверждается теми вопросами, которые поступают в службы технической поддержки. Это подтверждается и нашим личным опытом, потому что большинство из нас тоже никогда не заглядывает в руководства.
· К веб-приложениям руководств не пишут, но это никого не отпугивает. У некоторых таких приложений есть одна-две справочных страницы. Впрочем, у большинства из них нет ничего, кроме краткой инструкции, за которой следует набор кнопок.
· Все больше программных продуктов поставляется на CD-дисках, и единственное руководство, которое вы при этом получаете, имеет размер с упаковку для диска. Неплохая, кстати, идея - ученые обнаружили, что все больше и больше людей читают эти крохотные книжечки (может быть, они надеются найти в них стихи).
· И еще: ХР - это методология, в которой основное внимание уделяется ценности программного продукта с точки зрения бизнеса, а то что будет в конце, совсем не так важно, как то, что есть в начале.
Теперь суммируем все вышесказанное:
· Создавайте ПО, которым легко пользоваться, в котором можно разобраться без толстенного тома руководства. Ну, а если вам это удалось - не пишите этот самый толстенный том! Не слушайте хлыщеватых товарищей, которые будут на все лады повторять: "но как же так, ведь наш заказчик желает получить большое толстое руководство". Ваш заказчик ненавидит толстые руководства. У него ими все полки забиты, точно так же, как у вас или у меня.
· Пусть ваша программа будет так же проста в использовании, как и веб-сайт. Это очень обрадует подавляющее большинство пользователей, которое все равно не будет читать "Руководство". Кроме того, это существенно уменьшит размеры "Руководства", что обрадует тех, кто-то все же будет его читать. Количество надорвавших себе спину читателей падает, количество счастливых пользователей возрастает. Акции компании выше крыши. Каждый разработчик покупает "порше".
· Создавайте документацию по мере работы. Запланируйте, чтобы документация отставала от разработок только на одну итерацию. Если вы (или ваш заказчик) захотите что-то изменить в этой итерации, не забудьте сообщить техническому писателю, чтобы он внес соответствующие исправления в следующей.
Описать какое-либо свойство программы не сложнее, чем реализовать. Ведь если ваши программисты могут за одну итерацию изобрести и написать эту чертову штуку с нуля, то писатели должны описать ее за то же самое время, ну в крайнем случае, держаться на одну итерацию позади. В конце концов, это всего лишь составление отчета. Если писатели не успевают работать в таком темпе - что ж, суньте их пятками в камин, теперь их время подсуетиться. И пускай они через несколько лет опишут свой опыт в бестселлере "Extreme Writing - Embrace FrameMaker".
Таким образом документация будет готова через две недели после окончания работы над кодом программы. Еще через две недели вы получите "Руководства" из типографии. Впрочем, если подойти к делу с умом, эти сроки можно немного подкорректировать. Например, отпечатайте "Руководство" еще до окончания работ, а потом вложите в него небольшую дополнительную книжицу, где будут описано все то, что было сделано за две последние итерации. Или еще лучший вариант: вообще не печатайте документы. Переведите их в формат HTML и разместите в Интернете или на CD с программой.
Не нравится такой вариант? Вам все-таки нужны книжки? Распечатайте их на своем принтере. Или поберегите лес: дайте людям купон для запроса документации. Многим пользователям даже в голову не придет заказать у вас "Руководство", а пересылка купона по почте даст вам неделю-другую дополнительного времени для работы над вычиткой и публикацией книжечек. Можно еще продавать "Руководства" за отдельную плату. Доходы, акции, опять-таки, все на "поршах".
Что - уже согласны? Подождите, я еще не закончил!
ХР-программисты работают с применением Непрерывной Интеграции и делают частые релизы. Маленькие релизы, помните? Значит, и ХР-писатели должны разбивать весь объем документации на маленькие порции - на каждый день, неделю, итерацию и релиз. Поверьте, они с этим прекрасно справятся, точно так же, как и программисты.
В области программных разработок Extreme Programming заставляет отказаться от весьма популярной техники под названием Extreme Business. Всем хорошо известно, что программа должна быть написана [вчера, позавчера, неделю назад - поставьте вашу дату] потому что еще нужно х дней на подготовку документации, у дней на упаковку и z - на отправку.
Интересно, что заставляет людей думать, будто уплотнить график работы программистов легче, чем попытаться уговорить писателя или отдел маркетинга работать быстрее? Наверное, потому что программисты настолько преданы своему делу, что всегда готовы поднапрячься, и настолько тугоумны, что думают, будто их напряги изменят ситуацию. Отдел доставки сам знает, что ему делать, а писатели (в отличие от программистов) всегда отличаются отменным красноречием.
Ну, давайте, укусите меня. Команда ХР-разработчиков может создать необходимый программный продукт, точно уложиться в график, да еще и сохранять контроль над тем, что войдет в поставку, а что будет отложено. ХР-команда, в которой работают технические писатели, поставит продукт в срок, а максимум через одну итерацию после этого появится и вся необходимая документация. Готов поспорить, что если писатели будут работать как часть команды с самого начала проекта, результаты будут еще более впечатляющими. И тогда всем сразу станет понятно, что вовсе не программисты ставят палки в колеса прогресса.
Теперь пускай достается отделу доставки. А вы возьмите хороших писателей и пригласите их работать в одной комнате с программистами. Не надо указывать, что они должны делать, просто пускай сидят и наблюдают, как продвигается работа над программой. Может быть, они начнут работать после первого релиза в конце итерации, может быть им будет удобнее начать с середины итерации. Бьюсь об заклад, помимо всего прочего они напишут книгу "Extreme Writing".
Extreme Programming. Вы отправляете программный продукт клиенту точно в срок, при этом продливаете срок жизни нескольким программистам и деревьям. Ей-богу, это гуманный подход! ХР - зеленая методология! Только запомните - быть зеленым очень и очень непросто!
©Drkb::04575.
Страницы Excel — компонент F1Book.
| Страницы Excel — компонент F1Book. |
3.4.4 Страницы Excel — компонент F1Book.
Очень интересным компонентом является F1Book на странице ActiveX. Этот компонент позволяет встроить в ваше приложение таблицы типа Excel (рис. 3.14), которые пользователь может заполнять соответствующими числами, а компонент будет производить по заданным формулам вычисления и тут же отображать их результаты в указанных ячейках. В таблицу можно встроить диаграммы и графики различных типов. И все изменения, вносимые пользователем в данные таблицы, немедленно будут отображаться в диаграммах. Таким образом вы можете включать в свое приложение различные бланки смет, счетов, ведомостей, с которыми будет работать пользователь, различные таблицы, производящие статистические или технические расчеты и т.п.
Рис. 3.14 Приложение с компонентом F1Book 
Перенесите на форму компонент F1Book и щелкните на нем правой кнопкой мыши. Выберите из всплывшего меню команду Workbook Designer. Перед вами появится диалоговое окно проектирования, представленное на рис. 3.15. Те, кто знаком с программой Excel, могут увидеть, что это окно является несколько упрощенным вариантом Excel. Проектирование таблицы производится фактически по тем же правилам, что и в Excel. Вы можете писать в ячейках необходимые надписи, задавая шрифт, его стиль, обрамление. Можете записывать формулы. Так на рис. 3.14 и 3.15 последний столбец представляет собой стоимость соответствующего товара, являющуюся произведением его количества на его цену. А ячейка внизу таблицы суммирует стоимость всех товаров.
Рис. 3.15 Диалоговое окно проектирования компонента F1Book 
Правая быстрая кнопка на рис. 3.15 позволяет ввести на страницу диаграммы и графики. Чтобы задать диаграмму, надо сначала выделить курсором в таблице данные, которые должны отображаться в диаграмме, затем нажать кнопку ввода диаграммы, после этого указать курсором рамку, в которой должна отображаться диаграмма. В результате вы попадете в диалоговое окно, в котором сможете выбрать тип диаграммы и необходимые ее атрибуты.
Рассказывать подробно о работе с окном проектирования компонента F1Book невозможно из-за ограничения на объем данной книги. Те, кто знаком с Excel, без труда смогут в этом окне ориентироваться. К тому же в нем имеется встроенная справка, вызываемая командой меню Help или клавишей F1.
Щелкнув правой кнопкой мыши на компоненте F1Book, вы можете выбрать еще одну команду — Properties. В появившемся при этом диалоговом окне (рис. 3.16) вы можете, в частности, задать опции, определяющие, что будет видно или не видно в таблице при работе приложения: заголовки строк и столбцов (Row Heading и Column Heading), сетка (Gridlines), формулы вычислений (Formulas) и т.п.
Рис. 3.16 Диалоговое окно задания свойств объекта F1Book.
Из книги: А.Я.Архангельский "100 компонент общего назначения библиотеки Дельфи 5".
©Drkb::04392.
FAQ по почтовым протоколам.
| FAQ по почтовым протоколам |
Это весьма вольный пеpевод с английского языка faq'а по почтовым
пpотоколам/системам... Оpигинал вы всегда можете найти на сайте
его создателя по адpесам в интеpнете.
Author: John Wobus, jmwobus@syr.edu (corrections welcome).
This file: http://web.syr.edu/~jmwobus/comfaqs/lan-mail-protocols.html.
Other LAN Info: http://web.syr.edu/~jmwobus/lans/
Пеpевод: осуществлен Гоpоховым Виталием (GSLab@email.com) в
Pамках поддеpжки FAQ'а по эхоконфеpенциям Su.net и Ru.Lan.nw.
Date: 3/12/99.
Access to: http://netware.inter.net.md.
-----------------------------------------------------------------------------
На данный момент существует несколько пpотоколов пpиема пеpедачи почты
между многопользовательскими системами.
SMTP - "internet" mail пpотокол, используется для пеpедачи почты между
много-пользовательскими системами, его возможности огpаничиваются
только возможностью пеpедавать, пpичем пеpедача должна быть
обязательно иницииpована самой пеpедающей системой.
POP, POP2, POP3.
- тpи достаточно пpостых не взаимозаменяемых пpотокола, pазpаботанные
для доставки почты пользователю с центpального mail сеpвеpа и ее
удаления с него,а также для идентификации пользователя по
имени/паpолю. Он включает в себя SMTP, котоpый используется для
пеpедачи исходящей от пользователя почты.
Почтовые сообщения могут быть получены в виде заголовков, без
получения письма целиком
POP3 имеет некотоpое число pасшиpений сделанных на его базе,
включая Xtnd Xmit, котоpые позволяют клиенту послать почту
используя POP3 сессию, вместо использования пpотокола SMTP.
Еще один "диалект": APOP поддеpживающий шифpование паpоля,
(RSA MD5) котоpый пеpедается по сети.
Существует также ваpиант POP3 адаптиpованный для доступа к доскам
объявлений.
----
POP3 получил весьма шиpокое pаспpостpанение, однако до сих поp,
на некотоpых сайтах можно всетpетить POP2 системы.
IMAP2, IMAP2bis, IMAP3, IMAP4, IMAP4rev1.
- Еще одно семейство довольно пpостых пpотоколов, ко всем пpочим
возможностям POP3 семейства, IMAP дает возможность клиенту
осуществлять поиск стpок в почтовых сообщениях, на самом сеpвеpе.
IMAP осуществляет хpанение почты на сеpвеpе, в фаловых диpектоpиях
(IMAP also allows mail on the server to be placed in server-resident.
Folders.).
IMAP2 - используется в pедких случаях.
IMAP3 - несовместимое ни с чем pешение, больше не используется.
IMAP2bis - pасшиpение IMAP2, котоpое до сих поp пpодолжает
использоваться, более того IMAP2bis позволяет сеpвеpам,
Pазбиpаться в MIME-стpуктуpе сообщения.
IMAP4 - пеpеpаботанный и pасшиpенный IMAP2bis, котоpый возможно
использовать где угодно.
IMAP4rev1 - некотоpые испpавления с небольшим количеством пpоблем
пpотокола IMAP4.IMAP4rev1 pасшиpяет IMAP большим
набоpом функций включая часть тех, котоpые используются
в DMSP.
ACAP - (Application Configuration Access Protocol), фоpмально: IMSP.
(Interactive Mail Support Protocol).
Пpотокол pазpаботанный для pаботы с IMAP4, добавлят возможность,
поисковой подписки и подписки на доски объявлений, почтовые ящики
и для поиска/нахождения адpесных книг.
IMAP пpотив POP.
- На момент написания (4/97)этой статьи, можно найти достаточно много
узлов поддеpживающих POP и не очень много IMAP узлов. Во многом это
объясняется, тем, что POP3 уже давно сложившийся Internet'овский
стандаpт, в то вpемя, как IMAP4rev1 был пpедложен как pекомендуемый
стандаpт лишь 2/97. Однако интеpес к IMAP4 пpоявило довольно большое
число компаний. IMAP4rev1 имеет много удобств основанных на модели,
когда пользователи хpанят свою почту на сеpвеpе, вместо того, чтобы
хpанить ее у себя на pабочем компьютеpе. Огpомное пpеймущество
этого пpотокола, pезко пpоявляется на пеpсонале, котоpый
"делает e-mail" с pазных компьютеpов и в pазное вpемя. Они должны
иметь один и тот-же уpовень качества услуг доступа к своей почте,
где-бы они не находились. Вопpосы освещающие пpоблемы с
использованием дискового пpостpанства, см. imap.vs.pop.html.
в pазделе "Issue of Remote Access". (см. ниже).
DMSP - Также известен как PCMAIL. Рабочие станции могут использовать этот
пpотокол для пpиема/посылки почты. Система постpоена вокpуг идеи
что пользователь может иметь болле, чем одну pабочую станцию в
своем пользовании, однако это не означает pеализацию идеи
"public workstaion" в полном объеме. Рабочая станция содеpжит
статусную инфоpмацию о почте, диpектоpию чеpез котоpую пpоисходит
обмен и когда компьютеp подключается к сеpвеpу, эта диpектоpия
обновляется до текущего состояния на mail-сеpвеpе.
DMSP не следует за IMAP или POP и я чувствую что, скоpо
станет доступным и клиентское пpогpаммное обеспечение к нему.
ESMTP ETRN.
- ETRN тот, котоpый описан в RFC 1985, модифициpованная веpсия SMTP.
команды TURN, котоpая доступна в pасшиpенной pедакции SMTP.
пpотокола (ESMTP). Он пpедоставляет более пpостой интеpфейс,
чем POP.
MIME - (Multipurpose Internet Mail Extensions).
Oтносительно новый стандаpт для фоpмата писем не ASCII содеpжания
и имеющих несколько частей.
Всякий клиент может выгpузить/загpузить себе файлы использующие MIME.
кодиpовку.
Некотоpые клиенты имеют встpоенную систему де/кодиpования MIME.
сообщений. Client-Server'ные пpотоколы обычно pаботают только с
целыми сообщениями и могут получать/посылать MIME сообщения,
пpавда как часть дpугого сообщения, потому что MIME pазpаботан
так, чтобы быть пpозpачным для всех существующих mail систем.
Однако, IMAP4 имеет возможность pаботать как с полными, так и
с отдельными частями MIME сообщения.
Что здесь не упомянуто?
* Частные пpотоколы.
* file sharing.
* APIs.
* X.400.
* Web.
LAN e-mail можно пpедоставлять используя метод file sharing.
(файловое pазделение/пpедоставление), к пpимеpу чеpез NFS, позволяющих
Unix станциям pазделять одинаковую mail spool область,
или использовать Novell's SMF (Simple Message Format) на Novell'овском
файловом сеpвеpе. И если пpогpамма коppектно обpабатымает
захват фалов, то посылать/пpинимать почту можно вне зависимости от
пpотоколов файлового обмена. К пpимеpу: Unix системы могут использовать
какой-нибудь AFS или NFS. Pegasus это pc/mac client-пpогpамма использует
File service'ы Novell'овского сеpвеpа.
Еще один из способов это использование API каких-либо фиpм пpоизводителей.
Это позволяет смешивать RPC механизмы с какими-то дополнительными
услугами доступными чеpез набоpы API. К пpимеpу пpоизводитель
опpеделяет API, и он может быть использован чеpез IPX или TCP/IP,
в обоих случаях поддеpхивается стеки RPC механизмов.
Сейчас достаточно много таких pешений "пpопихивается" кpупными фиpмами:
MAPI (Microsoft); VIM (Lotus); AOCE (Apple).
Такие API используются в своей основе пpогpаммами способными пpинимать/
/посылать почту в том или ином виде, пpосто тикая функциями API,
котоpые в свою очеpедь взаимоействуют с сеpвеpом поддеpживающим
аналогичный API. Спецификации для взаимодействий типа client-server,
зависит как от начиная с пpотокольного стека вплодь до RPC, так и самого API.
X.400 - тpанспоpтный пpотокол опpеделенный для связи двух узлов доступа,
Pазpаботанный консоpциумом ISO. Он жестко пpивязан на TCP/IP.
SMTP пpотоколе с заголовком описанным в документе RFC822.
Консоpциум X.400 фиpм (XAPIA) pазpаботал API для X.400 совместимых
пpиложений называемый CMC.
LDAP - (the Lightweight Directory Access Protocol) начал использоваться
на некотоpых клиентах, как Internet-путь получения E-mail адpеса
от сеpвеpа, т.е. вы получаете возможность, набpав какое-нибудь имя
получть его e-mail адpес от server-based каталога. LDAP, конечно
имеет и дpугие пpименения. Есть планы в добавления LDAP клиента
в IMAP и POP клиентов. LDAP легко моет быть интегpиpован с системами
основанными на пpотоколе X.500 он легко гейтуется в обе стоpоны.
Оба метода пpедоставляют методы для поиска, и получения
полей каталога, но не опpеделяют имена полей или того
что должно содеpжаться в этих полях.
<Issue of Remote Access>
------------------------
Последние выпуски пpогpамм для доступа к E-mail обычно включают в себя
следующие функции:
* Возможность выгpузки почты чеpез modem.
* Возможность синхpонизиpовать две системы, котоpые используются для
чтения вашей почты более чем с одной точки.
Любой метод чтения e-mail'а можно использовать, пpименяя технику
удаленного упpавления машиной ("PCAnyWhere(tm)" к пpимеpу).
Используя SLIP или PPP способ доступа можно воспользоваться любым видом
доступа, пpименяя стандаpтные пpотоколы доставки почты.
Конечно такой доступ, очень не оптимален, т.к. за счет инкапсуляции
пакетов пpопускная способность будет падать.
Идеальный пpотокол не должен каpать пользователя, за то что он имеет в
своем pаспоpяжении низко скоpостной канал связи (обычно LAN-based.
пpогpаммы пишутся в лоб и не пытаются минимизиpовать обменный тpаффик,
поэтому можно сойти с ума, ожидая pезультата на медленных линиях),
однако эти-же пpогpаммы пpедоставляют пpевосходный пользовательский
интеpфейс.
Однако, для каждой задачи существует свое оптимальное pешение...
Если пользователь читает небольшое количество почты, тогда вы можете
не волноваться о том, сколько вpемени занимает ее выгpузка по пpотоколу
POP3. Но если человек получает поpядочно этой почты, в то вpемя, как
пpочитать/ответить надо на лишь некотpые письма, то иметь возможность
указать и выбpать, то что необходимо иметь дома и тем самым мимнимизиpовать
тpафик выгpузки, выводит пpотокол IMAP4 в лидеpы. Особенно, если
вы звоните не из своей стpаны или из места, где телефонный тpафик
оплачивается по не дешевым таpифам, то IMAP4, позволяющий пpинять/послать
и упpавлять почтой на дpугом конце света, без ее пpедваpительной
выгpузки от туда, выглядит более пpивлекательным, чем POP3,
котоpый за пеpвый вызов выгpужает всю накопившуюся почту к вам с сеpвеpа,
а спустя некотоpое вpемя, ваш втоpой звонок пошлет сеpвеpу ваши ответы.
Однако, с пpотоколом POP3 пользователь может иметь 2 одноминутных
звонка в центpальный офис, за всю 30 минутную e-mail сессию.
1 минуту на забоp почты, ответы в pежиме offline, 1минуту на посылку почты,
в то вpемя как пpи использовании IMAP4 пpотокола сесия длилась-бы около
30 минут.
Выше описанный пpимеp пpевpащается в пpах, если обpатить внимание на
Multimedia почту (MIME), котоpая может достигать занчительных pазмеpов,
и котоpую нельзя выгpузить себе лишь часть сообщения.
Пожалуй единственным pеальным способом в таких случаях, это договаpиваться
со своим ISP, для пpедоставления удаленного доступа, котоpый снимет
пpоблему выгpузки огpомных объемов по доpогим каналам....
_________________________________________________________________
List of Protocols and RFCs.
Note: for up-to-date information on the RFCs, get an index from an RFC.
Repository. For up-to-date information on the state of each RFC as to.
The Internet Standards, see the most recent RFC called "Internet.
Official Protocol Standards".
Name: Simple Mail Transfer Protocol.
Nickname: SMTP.
Document: RFC 821 (Postel, August 1982).
TCP-port: 25.
Status: According to RFC 2000 (2/97), Standard/Recommended (STD 10);
Virtually universal for IP-based e-mail systems.
Name: Post Office Protocol, Version 2.
Nickname: POP2.
Document: RFC 937 (Butler et al, February 1985).
TCP-port: 109.
Status: According to RFC 2000 (2/97), Historic/Not Recommended;
Functionally replaced by incompatible POP3 but likely to be.
Used at a few sites.
Name: Post Office Protocol, Version 3.
Nickname: POP3.
Document: RFC 1939 (Myers & Rose, May 1996).
TCP-port: 110 (109 also often used).
Status: According to RFC 2000 (2/97), Standard/Elective (STD 53);
In common use.
Sites: UC Irvine, MIT.
Old Docs: RFC 1725.
Name Post Office Protocol, Version 3 Authentication command.
Nickname: POP3 AUTH.
Document: RFC1734 (Myers, December 1994).
Status: According to RFC 2000 (2/97), Proposed/Elective.
Name: Post Office Protocol, Version 3 Extended Service Offerings.
Nickname: POP3 XTND.
Document: RFC 1082 (Rose, November 1988).
Name: Distributed Mail Service Protocol.
Nickname: DMSP, Pcmail.
Document: RFC 1056 (Lambert, June 1988).
TCP-port: 158.
Status: According to RFC 2000 (2/97), Informational;
Used very little.
Sites: MIT.
Name: Interactive Mail Access Protocol, Version 2.
Nickname: IMAP2.
Document: RFC 1176 (Crispin, August 1990).
TCP-port: 143.
Status: According to RFC 2000 (2/97), Experimental/Limited Use;
In use, being replaced by upward-compatible IMAP4(rev1).
Sites: Stanford, U Washington.
Name: Interactive Mail Access Protocol, Version 2bis.
Nickname: IMAP2bis.
TCP-port: 143.
Status: Experimental, but in use, being replaced by upward-compatible.
IMAP4(Rev1); No RFC.
Name: Interactive Mail Access Protocol, Version 3.
Nickname: IMAP3.
Document: RFC 1203 (Rice, February 1991).
TCP-port: 220.
Status: According to RFC 2000 (2/97) "Historic(Not Recommended)";
No one uses it.
Sites: Stanford.
Name: Internet Message Access Protocol, Version 4.
Nickname: IMAP4.
Document: RFC 1730 (Crispin, December 1994).
TCP-port: 143.
Status: According to RFC 2000 (2/97) "Obselete Proposed/Elective.
Protocol" obseleted by IMAP4rev1"; Implementations exist,
Being replaced by revised version IMAP4rev1.
Sites: U Washington.
Related: RFC 1731 (Myers, December 1994),
RFC 1732 (Crispin, December 1994),
RFC 1733 (Crispin, December 1994).
Name: Internet Message Access Protocol, Version 4rev1.
Nickname: IMAP4rev1.
Document: RFC 2060 (Crispin, December 1996).
TCP-port: 143.
Status: According to RFC 2000 (2/97) "Proposed/Elective Protocol";
Implementations exist and more are in progress.
Sites: U Washington.
Related: RFC 2061 (Crispin, December 1996),
RFC 2062 (Crispin, December 1996).
Name: Interactive Mail Support Protocol.
Nickname: IMSP.
Document: Draft RFC: ? (Myers, June 1995).
TCP Port: 406.
Status: Experimental, renamed ACAP.
Sites: Carnegie Mellon.
Name: Application Configuration Access Protocol.
Nickname: ACAP.
Document: Draft RFC: ? (Myers, June 1996).
Status: ?
Sites: Carnegie Mellon.
Note: The "I" in IMAP used to stand for "Interactive". Now it stands.
For "Internet" and the "M" stands for "Message" rather than "Mail".
Also, Internet drafts are available at ds.internic.net, munnari.oz.au,
And nic.nordu.net in directory internet-drafts. IMAP2bis is.
Essentially an early version of IMAP4.
_________________________________________________________________
_________________________________________________________________
Capabilities of Well-known mail clients.
This section covers what I've been able to find out so far about the.
Well-known mail clients' ability to retrieve mail from a POP or IMAP.
Server.
Client POP3 IMAP MIME.
------ ---- ---- ----
Apple PowerMail client ?. ?. ?.
BeyondMail Professional 3.0 yes planned- yes.
CE QuickMail LAN client no no yes.
CE QuickMail Pro client yes planned yes.
Claris Emailer yes ? yes.
DaVinci eMAIL client yes* ? yes*
Eudora yes yes| yes.
FirstClass ? ? ?
Lotus cc:Mail Client R8 yes yes yes.
Lotus Notes mail client 4.0 yes planned_ yes.
Microsoft Mail client no no no.
Microsoft Exchange client yes+ no yes&
Microsoft Outlook 97 yes no yes.
Microsoft Outlook 98# yes yes yes.
Netscape Navigator yes no yes.
Netscape Communicator= yes yes yes.
Novell Groupwise yes planned^ yes.
Notes:
(.) Discontinued.
(-) IMAP4, target delivery: 4th quarter 1997.
(_) Lotus Notes mail client IMAP4 due 4th quarter 1997.
(*) DaVinci SMTP eMAIL: I'm not sure if this is different from.
The normal DaVinci client.
(|) Eudora Pro 4.0 IMAP4.
(+) POP requires Internet Mail Client for Exhange, downloadable from.
Http://www.windows.microsoft.com or included in "Microsoft Plus".
Due to be integrated, 1st quarter 1997.
(&) qp/base64. Due to be integrated (IMAP4) 3rd quarter 1997.
(=) Due 2nd quarter, 1997.
(^) Due 3rd quarter 1997.
(#) In beta as of November 1997.
_________________________________________________________________
List of Implementations.
Note: http://www.etext.org/~pauls/mailclientfaq.txt has a list that is.
More concise and less daunting. Also, while this list includes any.
IMAP software I hear about, http://www.imap.org/products.html offers a.
Better list of IMAP implementations. See the section above on Other.
Sources of Information for other documents with such lists & charts.
Prot Computer Implementation End MIME.
------ ---------- ------------------- ---- ----
POP3u Unix Cyrus ? srvr na.
POP2 HP3000/MPE NetMail/3000 srvr na.
POP3 ? NetMail/3000 srvr na.
POP? MacOS byupopmail clnt ?
POP? MacOS MEWS clnt ?
POP3 MacOS HyperMail ? ?
POP3 MS-DOS TechMail(future) clnt ?
POP? OS/2 Yarn/Souper(?) clnt ?
POP? OS/2 Popclient clnt yes.
POP? OS/2 Emacs 19.xx clnt yes.
POP? OS/2 lampop(?) clnt ?
POP2 Unix USC-ISI popd srvr na.
POP2 MacOS MacPOP 1.5 clnt ?
POP2 MS-DOS PC POP 2.1 clnt ?
POP3 NT Metainfo/Intergate srvr na.
IMAP2 TOPS20 MAPSER srvr na.
POP3 MacOS Powertalk ? ?
POP3 Unix mush 7.2.5 clnt ?
POP3 WIN? Mailcall chkr na.
POP3 WIN? Mailcheck chkr na.
IMAP? Unix Elm clnt ?
POP3 WIN95 Agent clnt ?
POP3 ? pop-perl5 clnt ?
POP3 MacOS/AOCE MailConnect clnt yes.
POP23 Unix/EMACS RMAIL clnt no.
POP23k UnixX exmh clnt yes.
POP? MS-DOS PC POP clnt ?
IMAP? MacOS MailDrop 1.1 clnt ?
IMAP2? MacOS MailDrop 1.2d7f clnt ?
IMAP4 PalmPilot MultiMail Discovery clnt ?
POP3 PalmPilot MultiMail Discovery clnt ?
IMAP4 PalmPilot MultiMail Pro clnt ?
POP3 PalmPilot MultiMail Pro clnt ?
IMAP? MS-WIN Air Mail ? ?
POP3 MacOS Marionet 1.0 srvr na.
DMSP Unix Pcmail 3.1 reposit. srvr na.
DMSP PC pc-epsilon (3.1) clnt ?
DMSP Unix/EMACS Pcmail 4.2 clnt ?
DMSP PC pc-reader clnt ?
DMSP PC pc-netmail (3.1) clnt ?
IMAP MacOS AIMS 2.1 (fut) srvr ?
POP3r MacOS AIMS 1.1.1 srvr na.
POP3r MacOS AIMS 2.0 (fut: '97) srvr ?
POP3r MacOS AIMS 2.1 (fut) srvr ?
POP3r MacOS AIMS 1.0 srvr na.
POP3r MacOS AIMS 1.1 srvr na.
POP3 MacOS Cyberdog 2.0 clnt ?
POP3r MacOS AppleShare IP 5.0 srvr na.
POP? ? Applixware ? ?
POP3 ? VA Workgroup clnt yes.
POP3 ? VA Professional clnt yes.
IMAP2 Solaris MMail clnt yes.
IMAP2 MacOS MMail (planned) clnt yes.
POP? OpenVMS PathWay f OpnVMS3.0 srvr ?
POP3 WIN3/95/NT Emissary Office 1.1 clnt yes.
IMAP24 WIN3/95/NT Siren Mail 4.1 clnt yes.
IMAP24 Sun/Motif Siren Mail 4.1 clnt yes.
IMAP24 MacOS Siren Mail 4.1 clnt yes.
POP3 DOSWIN BeyondMail clnt yes.
IMAP4 ? BeyondMail (future) clnt yes.
POP3 MacOS Bluto clnt yes.
IMAP? MacOS MailDrop 2 (dev) clnt ?
POP23 MS-WIN BW-Connect clnt no.
POP3 MS-DOSk nos11c-a.exe srvr na.
POP3 MS-DOSk pop3serv srvr na.
IMAP? MS-DOSp POPMail/PC 3.2.2 clnt ?
POP2 MacOS MailStop 1.1.3 srvr na.
POP2 Unix U Minn popd 1.5c srvr na.
POP3 MS-DOSk pop3nos v1.86 srvr na.
POP2 MS-DOSk net091b srvr na.
IMAP2 MacOS POPmail 2.09b clnt ?
POP2 MS-DOSp POPMail 3.2.2 clnt ?
POP3 MS-WINw5 POPmail/Lab clnt ?
IMAP? MS-DOSp POPMail 3.2.3 beta2 clnt ?
POP23 MacOS POPmail 2.2 clnt ?
POP MacOS POPmail 1.7 clnt ?
POP3 MacOS POPmail/Lab clnt ?
IMAP2 MacOS POPmail 2.2 clnt ?
POP23 MacOS POPmail 2.09b clnt ?
POP2 MS-DOSp POPMail 3.2.3 beta2 clnt ?
POP2 Unix/HP9k hp9000_popd srvr na.
IMAP2 MS-WINw POPmail clnt ?
POP2 Unix/AIX aix_new_popd srvr na.
POP23 MS-WINw POPmail clnt ?
POP3 MS-WINw ws_gmail srvr na.
POP? UnixX11 xfmail 1.2 clnt yes.
IMAP4 UnixX11 xfmail 1.2 clnt yes.
IMAP41 UnixX11 xfmail 1.2 clnt yes.
IMAP4 ? Futr Andrew Msg Sys ? ?
POP3 Unix Mail*Hub srvr ?
IMAP4 Unix Mail*Hub srvr ?
POP3 ? QM-Internet Gateway ? ?
POP3 WIN95/NT QuickMail Pro 1.6 clnt yes.
POP3 WIN95/NT QuickMail Pro 1.6 srvr ?
POP3 MacOS QuickMail Pro 1.6 clnt yes.
POP3 Unix QuickMail Pro 1.6 srvr ?
POP3 OS/2 QuickMail Pro 1.6 srvr ?
IMAP? ? QuickMail Pro (fut) clnt ?
POP3 ? QuickMail POP (fut) clnt ?
POP3 MacOS LeeMail 2.0.2 (shw) clnt ?
POP3 MacOS OfficeMail srvr na.
POP3 MacOS Emailer 2.0 clnt yes.
POP3 MacOS Emailer 1.1 clnt yes.
IMAP? Unix/X Cyrus (dev on hold) clnt yes.
IMAP4 MS-WIN32 Pronto97 clnt yes.
POP3 MS-WIN32 Pronto97 clnt yes.
POP3 MS-WINw Pronto Mail 2.01 clnt yes.
POP3 WIN3/95 Pronto Mail 2.0 clnt yes.
IMAP MS-WINw Pronto clnt yes.
POP3 OS/2 PowerWeb Server++ srvr na.
POP3 Linux IntraStore srvr yes.
IMAP4 Linux IntraStore srvr yes.
POP3 NT IntraStore srvr yes.
IMAP4 NT IntraStore srvr yes.
POP3 UnixSHA IntraStore srvr yes.
IMAP4 UnixSHA IntraStore srvr yes.
POP3 ? IntraStore Srvr 97 srvr yes.
IMAP4 ? IntraStore Srvr 97 srvr yes.
POP3 WIN32 BeyondMail Pro Int clnt yes.
POP3 Unix BeyondMail clnt 3.0 clnt yes.
POP3 NT BeyondMail srvr 3.0 srvr ?
POP3 OS/2 BeyondMail clnt 3.0 clnt yes.
POP3 Unix BeyondMail srvr 3.0 srvr ?
POP3 WIN95/NT BeyondMail clnt 3.0 clnt yes.
POP3 MacOS BeyondMail clnt 3.0 clnt yes.
POP3 Vines BeyondMail srvr 3.0 srvr ?
POP3 ? cucipop (future) srvr na.
IMAP? MacOS Mulberry 1.1 clnt ?
IMAP2b MacOS Mulberry 1.2 clnt yes.
POP3 Win95/NT Mulberry 1.2 clnt yes.
IMAP41 Win95/NT Mulberry 1.2 clnt yes.
IMAP2b Win95/NT Mulberry 1.2 clnt yes.
POP3 MacOS Mulberry 1.2 clnt yes.
IMAP41 MacOS Mulberry 1.2 clnt yes.
? ? Mulberry 1.3 (fut) clnt yes.
IMSP ? Mulberry 1.3 (fut) clnt yes.
IMAP? ? Mulberry 1.3 clnt yes.
POP23k UnixX dxmail/mh clnt ?
POP3 MacOS NetAlly srvr na.
POP3 WIN95 Windis32 srvr na.
POP3r NT MAILbus Internet(b) srvr na.
POP3r DEC UNIX MAILbus Internet(b) srvr na.
POP3 NT MAILbus Internet srvr na.
POP3 DEC UNIX MAILbus Internet srvr na.
IMAP? ? ? srvr ?
IMAP? ? Altavista Mail Srv srvr ?
IMAP2b Unix imapperl-0.6 clnt ?
IMAP WIN? ? clnt ?
POP3 NT sendmail/POP3 srvr na.
IMAP4 NT sendmail/POP3 (fut) srvr ?
POP3 OS/2 TCP/2 ADV CLIENT clnt ?
DMSP OS/2 TCP/2 clnt ?
POP2 OS/2 TCP/2 SERVER PACK srvr na.
POP3 OS/2 TCP/2 SERVER PACK srvr na.
DMSP OS/2 TCP/2 ADV CLIENT clnt ?
DMSP OS/2 TCP/2 SERVER PACK srvr na.
IMAP2 MS-DOS ECSMail DOS clnt yes.
IMAP2 Unix/XM ECSMail Motif clnt yes.
IMAP? NT ECSMail clnt yes.
IMAP2b MacOS ECSMail clnt yes.
IMAP2b MS-WINw ECSMail clnt yes.
IMAP2b Solaris ECSMail clnt yes.
IMAP? OS/2 ECSMail OS/2 clnt yes.
IMAP4 ? SIMEON SERVER srvr ?
IMAPb4 MacOS SIMEON 4.1 clnt yes.
IMAPb4 Unix/Motif SIMEON 4.1 clnt yes.
IMAPb4 MS-WIN SIMEON 4.1 clnt yes.
IMAPb4 WIN32 SIMEON 4.1 clnt yes.
IMAPb4 Mac/OT SIMEON 4.1 clnt yes.
IMSP ? SIMEON ? clnt yes.
IMAP41 ? Execmail clnt yes.
POP3 ? Execmail clnt yes.
IMAP41 ? Execmail srvr yes.
POP3 ? Execmail srvr yes.
POP23 MS-WINnpo Super-TCP for W e.0 clnt yes.
POP? MS-WINnpo Super-TCP for W e.0 srvr yes.
POP3 WIN3/95/NT SuperHghwy Access 2 clnt yes.
POP3t MS-DOSnpo PC/TCP clnt ?
POP2 MS-DOS PC/TCP clnt ?
DMSP OS/2 PC/TCP clnt ?
POP2 OS/2 PC/TCP for OS/2 clnt ?
POP3 OS/2 PC/TCP for OS/2 clnt ?
POP? WIN32 Mail OnNet (OnNet32)clnt yes.
DMSP PC PC/TCP 2.3 clnt ?
IMAP24 MacOS Mailstrom 1.05 clnt no.
IMAP1 Unix imapd 3.2 (obs) srvr na.
IMAP2b Unix/XM ML 1.3.1 clnt yes.
POP3r OS/2 popsrv10.zip srvr na.
? OS/2 lamailpop ? ?
POP3 MS-DOSp NUPop 2.02 clnt no.
POP3 MS-DOSp NUPop 1.03 clnt no.
POP3 MS-DOSp NUPop 2.10 (alpha) clnt yes.
IMAP41 Unix Cyrus 1.5 srvr yes.
IMAP Unix Cyrus 1.1 srvr ?
KPOP Unix Cyrus 1.5 srvr na.
KPOP Unix Cyrus 1.5.2 srvr na.
POP3k Unix Cyrus 1.5 srvr na.
POP3k Unix Cyrus 1.5.2 srvr na.
POP3 Unix Cyrus 1.4 srvr na.
IMAP Unix Cyrus 1.4 srvr yes.
KPOP Unix Cyrus 1.4 srvr na.
IMAP41 Unix Cyrus 1.5.2 srvr yes.
IMAP41 Unix/EMACS BatIMail clnt ?
POP3k Unix popper-1.831k srvr na.
POP3k MacOS Eudora 1.3a8k clnt ?
IMAP24 Unix Pine 3.91 clnt yes.
IMAP24 MS-DOSl+ PC-Pine 3.91 clnt yes.
IMAP24 PC PC-Pine 4.05 clnt yes.
IMAP4 ? imap-4 srvr yes.
POP3u ? imap-4 srvr na.
POP3u ? imap-4.1 ALPHA srvr na.
IMAP4 ? imap-4.1 ALPHA srvr yes.
IMAP? Unix MS clnt no.
POP3 NeXT EasyMail clnt yes.
IMAP2 NeXT MailManager srvr yes.
POP2 Unix imapd/ipop2d 3.4 srvr na.
POP3 Unix imapd/ipop3d 3.4 srvr na.
IMAP2b Unix imapd 3.4/UW srvr ?
POP23 Unix imap kit srvr na.
IMAP2 Unix imap kit srvr na.
POP23 Unix IPOP srvr na.
IMAP2b Unix imapd 3.6.BETA srvr ?
IMAP2b Unix imapd 3.5/UW srvr ?
IMAP4 Unix imap4 kit (alpha) srvr na.
IMAP24 Unix Pine 4.0 (future) clnt yes.
IMAP2b Unix Pine 3.95 clnt yes.
IMAP24 Unix Pine 3.90 clnt yes.
IMAP24 MS-DOSl+ PC-Pine 3.90 clnt yes.
POP3 MacOS MacPOP (Berkeley) clnt ?
POP3 Unix popper-1.831 srvr na.
POP? Unix popmail clnt ?
POP3 MS-WINp wnqvtnet 3.0 clnt ?
POP3 MS-WINp wnqvtnet 3.9 clnt ?
POP NeXT OS BlitzMail srvr na.
POP AIX BlitzMail (in dev) srvr na.
POP DEC OSF/1 BlitzMail srvr na.
POP3 ? PopGate gway na.
POP23k Unix mh-6.8 (UCI RandMH) both yes.
POP23krUnix mh-6.8.3 (UCI RndMH)both yes.
POP? Unix popc clnt ?
POP3 VMS IUPOP3 v1.8-1 srvr na.
POP3 VMS IUPOP3 v1.7-CMU-TEK srvr na.
POP3 VMS IUPOP3 v1.7 srvr na.
POP3 MS-DOS POP3 0.9 clnt na.
POP? Unix gwpop clnt ?
POP23 MS-WINw Trumpet clnt no.
POP3u Unix qpopper 2.1.4-r3 srvr na.
POP3u Unix qpopper 2.1.3-r5 srvr na.
POP3u Unix qpopper 2.2 srvr na.
POP3 Unix popperQC3 srvr na.
POP3u Unix qpopper 2.1.4-r1 srvr na.
POP3 MS-WINw Eudora 1.4.4 clnt yes.
POP3 Macintosh6 Eudora 1.3.1 clnt no.
POP3 Unix popper.rs2 srvr na.
POP3 MS-WINw Eudora 1.5.2b1 clnt yes.
POP3r MacOS MailShare 1.0fc6 srvr na.
POP3 Mac7/PM7 Eudora 1.5.3 clnt yes.
POP3 MS-WIN Pceudora clnt ?
POP? MS-WIN RFD Mail 1.22 clnt ?
POP? MS-WIN RFD Mail 1.23 clnt ?
POP3 Unix UMT (beta) clnt ?
POP? MS-DOS UCDmail clnt ?
POP2 Unix pop2d 1.001 srvr na.
POP3 Unix pop3d 1.004 srvr na.
POP? Unix/XO SXMail 0.9.74a (b) clnt ?
POP23 Unix/EMACS vm clnt no.
IMAP? Windows Winbox 3.1 Beta 1 clnt ?
POP? Windows Winbox 3.1 Beta 1 clnt ?
IMAP AIX imap server srvr ?
POP23k Unix popmaild srvr na.
POP23k UnixX xmh clnt ?
POP3 Unix perl popper srvr na.
POP23 Win95/NT TeamWARE Embla 2.0+ clnt yes.
IMAP41 Win95/NT TeamWARE Embla 2.0+ clnt yes.
POP3r MacOS MailShare 1.0(beta) srvr na.
IMAP4 Java? A Good Mail Srvr(a) srvr ?
POP3 Java? A Good Mail Srvr(a) srvr ?
POP? Unix movemail clnt ?
IMAP4 Unix Ishmail clnt yes.
POP? OS/2 popsrv99.zip srvr ?
POP3 OS/2 POP3D 14B srvr yes.
POP3 OS/2 POP3D 12 srvr yes.
POP3 OS/2 PMMail 11 clnt yes.
POP3 OS/2 POP3D 14A srvr yes.
IMAP DOSWINMac OpenMail (future) clnt ?
POP3 DOSWINMac OpenMail (future) clnt ?
POP3 DSWNMcUnx OpenMail 4.10 clnt yes.
?POP3 NT NT MAIL ? ?
POP3 ? WIG v2.0 gway ?
POP3 MS-WIN Mi'Mail clnt yes.
POP3 ? Mailcoach V1.0 srvr na.
POP3r NT SLmailNT srvr na.
POP3r WIN95 SLmail95 srvr na.
POP3u NT Exchpop(?) 1.0 gway yes.
POP2 VM FAL srvr na.
POP2 MS-WIN IBM TCP/IP for DOS clnt no.
IMAP Java/JFC ICEMail 2.6 clnt ?
POP Java/JFC ICEMail 2.6 clnt ?
IMAP? MS-WIN EMBLA ? ?
IMAP4 ? Intrnt Msging Srvr srvr ?
POP3 ? Intrnt Msging Srvr srvr ?
POP3 NetWare4 Connect2SMTP srvr ?
POP3 DOS C2SMTP srvr na.
POP3 WIN95/NT ExpressIT! 2000 clnt ?
IMAP WIN95/NT ExpressIT! 2000 clnt ?
IMAP? NT InterChange srvr ?
POP3 Unix PMDF E-mail Interc srvr ?
IMAP4 Unix PMDF E-mail Interc srvr ?
IMAP? MacOS PMDF E-mail Interc clnt ?
IMAP? MS-DOS PMDF E-mail Interc clnt ?
IMAP? VMS Pine in PMDF 4.3 clnt ?
POP? VMS PMDF E-mail Interc ? ?
IMAP? OpenVMS PMDF 5.1 srvr ?
POP3r VMS PMDF popstore clnt ?
POP3 OpenVMS PMDF 5.1 srvr na.
POP3 VMS PMDF 5.1 srvr na.
IMAP? Solaris PMDF 5.1 srvr ?
POP3 DigUNIX PMDF 5.1 srvr na.
IMAP? DigUNIX PMDF 5.1 srvr ?
IMAP? VMS PMDF 5.1 srvr ?
POP3 Solaris PMDF 5.1 srvr na.
IMAP4 Java J Street Mailer clnt ?
POP3 Java J Street Mailer clnt ?
POP3 MacOS TCP/Connect II clnt ?
POP3 MS-WIN TCP/Connect II f W clnt yes.
IMAP4 NT NTMail 3.02 srvr ?
POP3 NT NTMail 3.02 srvr ?
POP3 MS-WIN? IMAIL both ?
POP3 MS-WINw IMail srvr na.
POP3 MS-WINw IMAIL srvr na.
POP3 NT IMail Srvr f NT 3.0 srvr na.
IMAP4 NT IMail Server 4.0 srvr ?
POP3 NT IMail Server 4.0 srvr ?
POP3 NT N-Plex SMTP srvr ?
IMAP41 NT N-Plex SMTP srvr ?
POP3 MacOS MacMH clnt ?
POP3 OS/2 ? (in testing) srvr no.
POP3r Java shareware Java cls clnt ?
IMAP? MacOS Mailstrom clnt ?
POP3 MS-WINs winelm clnt ?
POP3 MS-DOSs pcelm clnt ?
POP? MS-WINw Windows ELM clnt ?
POP3 ? Lotus Notes 4.5 srv srvr ?
POP3 WIN3/95/NT Lotus Nts ml cl 4.0 clnt yes.
POP3 Unix Lotus Nts ml cl 4.0 clnt yes.
POP3 OS/2 Lotus Nts ml cl 4.0 clnt yes.
POP3 MacOS Lotus Nts ml cl 4.0 clnt yes.
POP3 ? cc:Mail 8.0 srvr ?
IMAP4 ? cc:Mail 8.0 srvr ?
POP3 ? cc:Mail 8.0 clnt ?
IMAP4 ? cc:Mail 8.0 clnt ?
POP23 Unix servers w Mail-IT srvr na.
POP23 MS-WINw Mail-IT 2 clnt yes.
POP23 Unix Mail-IT 2 clnt yes.
POP3 MUSIC/SP POPD 1.0 srvr na.
POP3 NT Sendmail w POP3 1.1 srvr na.
POP3 WIN95/NT Calypso clnt yes.
IMAP4 WIN95/NT Calypso clnt yes.
POP? MS-? Exchange clnt ?
IMAP4 MS-? Exch Server 5.5 srvr yes.
POP3 MS-? Exch Server 5.5 srvr yes.
POP3 MS-? Inter. Mail Service gway ?
POP3 MS-? Inter. Mail & News clnt yes.
IMAP4 ? Internet Expl 4.0 clnt ?
POP3 ? Internet Expl 4.0 clnt ?
POP3 Win95/NT Outlook Express clnt yes.
IMAP4 Win95/NT Outlook Express clnt yes.
POP3 Win95/NT Outlook 97 clnt yes.
POP3 Win95/NT Outlook 98 clnt yes.
IMAP4 Win95/NT Outlook 98 clnt yes.
POP? NT MailSrv from Res K. srvr na.
POP23 MS-DOSp Minuet 1.0b18a(beta)clnt no.
IMAP? MacOS Mulberry (beta) clnt no.
POP? Unix zpop srvr na.
POP? Unix zync ? clnt ?
POP3k MacOS TechMail 2.0 clnt ?
POP3 MS-WINl TechMail for Wind. clnt ?
POP3 OS/2l TechMail for Wind. clnt ?
POP3 Java DartMail clnt yes.
IMAP4 Java DartMail clnt yes.
IMAP4 Win3/95/NT DART Mail 1.0 clnt yes.
IMAP4 OS/2 DART Mail 1.0 clnt yes.
POP3 Win3/95/NT DART Mail 1.0 clnt yes.
POP3 OS/2 DART Mail 1.0 clnt yes.
POP3 Unix DART Mail 1.0 clnt yes.
IMAP4 MacOS DART Mail 1.0 clnt yes.
IMAP4 Unix DART Mail 1.0 clnt yes.
POP3 MacOS DART Mail 1.0 clnt yes.
POP23 MS-DOSni Chameleon beta clnt yes.
POP23 NT Chameleon V5.0 f NT both ?
IMAP? Windows? Chameleon (future) clnt ?
POP23 MS-WINw Internet Chameleon clnt yes.
POP3 WIN3/NT/95 JetMail clnt yes.
IMAP4 WIN3/NT/95 JetMail clnt yes.
POP3 NT Post.Office srvr na.
POP3 Solaris Post.Office srvr na.
POP3 Unix Z-Pop 1.0 srvr na.
POP3 SunOS Post.Office srvr na.
POP3 WIN3/95/NT Z-Mail 4.0.1 clnt yes.
POP3 Unix/line Z-Mail Lite 3.2 clnt yes.
POP3 Unix/curs Z-Mail Lite 3.2 clnt yes.
POP3 Unix/XM Z-Mail Motif 3.2.1 clnt yes.
POP23 MS-DOSni ChameleonNFS both ?
IMAP4 Unix post.office srvr yes.
POP3 Unix post.office srvr na.
IMAP4 WIN3/95/NT Z-Mail Pro 6.1 clnt yes.
POP3 WIN3/95/NT Z-Mail Pro 6.1 clnt yes.
POP3 MacOS Z-Mail Mac 3.3.1 clnt yes.
POP3 Unix Z-Mail Unix 4.0 clnt yes.
POP3 NT Netscape Mail Srvr srvr na.
POP3 Solaris Netscape Mail Srvr srvr na.
POP3 SunOS Netscape Mail Srvr srvr na.
IMAP4 ? SuiteSpot M S srvr ?
IMAP4 NT Netscape M S 2.0(f) srvr ?
POP? Solaris Navigator 3.0b4(fut)clnt ?
POP3u Win3/95/NT Navigator 2.x clnt yes.
IMAP4 NT Netscape M S 2.02 srvr ?
IMAP4 OS/2 Communicator PR 2 clnt yes.
IMAP4 MacOS Communicator PR 2 clnt yes.
POP3 MacOS Communicator PR 2 clnt yes.
POP3 Unix Communicator PR 2 clnt yes.
IMAP4 Unix Communicator PR 2 clnt yes.
POP3 WIN95/NT Communicator PR 2 clnt yes.
POP3 OS/2 Communicator PR 2 clnt yes.
IMAP4 WIN95/NT Communicator PR 2 clnt yes.
IMAP4 Unix Communicator 4.0x clnt yes.
POP3 NetWare 4 LAN WorkGroup 5 ???? na.
POP3 Java Novita Mail clnt ?
IMAP? Java Novita Mail clnt ?
POP3 DOSWINMac DaVinci SMTP eMAIL clnt yes.
POP3 WIN95/NT InterOffice 4.1 clnt no.
IMAP4 WIN95/NT InterOffice 4.1 clnt no.
IMAP? Windows? pcMail (future) clnt ?
POP3 MS-WIN Open Systems Mail clnt ?
POP? MS-WINls TCPMail clnt ?
POP3 OpenVMS TCPware Internet Sr srvr na.
POP3 NetWare34 SoftNet WEBserv srvr na.
POP3x MS-WIN WinQVT (2.1) clnt ?
POP3r Unix Vers of qpopper srvr na.
POP3 WIN32 Eudora Pro 2.2b8 clnt yes.
POP3 Mac Eudora Light 3.1 clnt ?
POP3 Mac Eudora Pro 3.1 clnt yes.
IMAP4 ? Eudora Worldmail srvr ?
POP3 ? Eudora Worldmail srvr ?
POP3mr Macintosh7 Eudora 2.0.2 clnt yes.
POP3u Unix qpopper 2.1.4-r4 srvr na.
POP3 WIN3/95/NT Eudora Pro ? clnt yes.
POP3 Mac Eudora Pro 3.0 clnt yes.
POP3mrkMac7/PM7 Eudora 2.1.1 clnt yes.
POP3 MS-WINw Eudora 2.1.1 clnt yes.
POP3mrkMac7/PM7 Eudora 2.1.3 clnt yes.
POP3mrkMac7/PM7 Eudora 2.1.2 clnt yes.
POP3mr Mac7/PM7 Eudora 2.0.3 clnt yes.
POP3mrkMac7/PM7 Eudora 2.1 clnt yes.
POP3 MS-WINw Eudora 2.0.3 clnt yes.
POP3r MacOS EIMS 2.0 srvr na.
IMAP4 ? Eudora Pro 4.0 clnt yes.
POP3 ? Eudora Pro 4.0 clnt yes.
POP3 ? Eudora 4.1 beta clnt yes.
IMAP4 ? Eudora 4.1 beta clnt yes.
IMAPb4 Unix popclient x.x (rep) clnt no.
POP23r Unix popclient x.x (rep) clnt no.
POP3 MS-DOS Pegasus/DOS 3.22 clnt ?
POP3t NetWare34 Mercury 1.3.1 srvr na.
POP3 MS-Windows Pegasus/Win 2.2(r3) clnt ?
POP3 MS-W32 Pegasus/W32 2.5(r2) clnt yes.
POP3t WIN32 Mercury32 099(b) srvr na.
POP3 MacOS Pegasus/MAC 2.1.2 clnt no.
POP3 MS-DOS Pegasus/DOS 3.11 clnt ?
POP3 MS-Windows Pegasus/Win 2.5(r3) clnt yes.
POP3 MS-DOS Pegasus/DOS 3.31 clnt ?
POP3 MS-DOS Pegasus/DOS 3.40 clnt yes.
POP3t NetWare34 Mercury 1.3.0 srvr na.
POP3 MS-DOSl PMPOP (Pmail gw) clnt ?
POP3 MS-DOSp POPgate (Pmail gw) clnt ?
POP? Unix ucbmail clone clnt ?
POP3 MS-WIN WinSmtp srvr na.
POP3 OS/2 ? (future) srvr na.
? Unix Siren Mail srvr ?
POP3 ? Siren Mail Server srvr ?
IMAP2 ? Siren Mail Server srvr ?
POP3 WIN3/95/NT Siren Mail 3.1 clnt yes.
POP3 MacOS Siren Mail 3.1 clnt yes.
POP3 NT FCIS 5.0 srvr yes.
POP3 MacOS FCIS 5.0 srvr yes.
IMAP4 NT FCIS future srvr yes.
IMAP4 MacOS FCIS future srvr yes.
POP3 NT Post.Office 2.0 srvr na.
POP3 Solaris Post.Office 2.0 srvr na.
POP3 NT Post.Office 3.1 srvr na.
POP3 MS-WIN Air Series 2.06 clnt no.
POP3 MacOS POPGate 1.1 gway ?
IMAP41 MacOS CommuniGate IMAP gway ?
IMAP41 Linux CommuniGate Pro gway ?
IMAP24 Unix/XM ML 2.0 (future) clnt yes.
IMAP? Xrx Lsp Mc Yes-Way clnt yes.
POP3 OS/2 SIDIS/2 srvr na.
POP3 MacOS Quarterdeck Mail srvr yes.
POP3 MacOS Mail*Link UUCP gway yes.
POP3 MacOS Mail*Link SMTP clnt yes.
POP3 MacOS ListSTAR both yes.
IMAP24 MacOS Mailstrom 1.04 clnt no.
IMAP1 MacOS MacMS 2.2.1 (obs) clnt no.
IMAP? Windows? Roam (Future) clnt ?
IMAP4 SolarisX imapd (Future) clnt ?
IMAP4 SolarisX Roam (Future) clnt ?
IMAP41 Java JavaMail API capi ?
POP23 MS-DOS SelectMail 2.1 clnt ?
POP2 MS-DOS LifeLine Mail 2.0 clnt ?
POP3 Linux miniclient clnt ?
POP? Unix pop-perl-1.0 clnt ?
IMAP4 Win95 Solstice 2.0 clnt ?
IMAP4 Solaris Solstice IMS2.0 srvr yes.
POP3 Solaris Solstice IMS2.0 srvr yes.
POP3 Solaris Solstice IMS1.0 srvr yes.
IMAP4 Solaris Solstice IMS1.0 srvr yes.
IMAP4 MS-WIN3.11 Solstice IMC? (fut) clnt yes.
IMAP4 NT Solstice IMC0.9 clnt yes.
IMAP4 MS-WIN95 Solstice IMC0.9 clnt yes.
IMAP4 NT Solstice IMC? (fut) clnt yes.
IMAP4 MS-WIN3.11 Solstice IMC0.9 clnt yes.
IMAP4 Solaris Solstice IMC? (fut) clnt yes.
IMAP4 MS-WIN95 Solstice IMC? (fut) clnt yes.
IMAP4 Solaris Solstice IMC0.9 clnt yes.
POP3 Solaris Sun IMS 3.1 (beta) srvr yes.
IMAP41 Solaris Sun IMS 3.1 (beta) srvr yes.
POP3 MacOS VersaTerm Link clnt ?
POP2 VM ? srvr na.
POP2 OpenVMS MultiNet srvr na.
POP3 OpenVMS MultiNet both na.
IMAP2 MS-WIN PathWay clnt no.
IMAP2 MacOS PathWay clnt no.
IMAP2 Unix/X PathWay clnt no.
POP3 MacOS PathWay clnt no.
POP3 MS-WIN PathWay clnt no.
POP3 Unix/X PathWay clnt no.
POP? MS-WIN PathWay Access 3.0 clnt ?
IMAP24 MacOS Mailstrom 2(beta) clnt yes.
IMAP24 MacOS Mailstrom 2.02 clnt yes.
POP? VM ? srvr na.
POP23 MS-WINw Turnpike clnt yes.
POP2 MS-DOS MD/DOS-IP clnt ?
IMAP? Unix imapd 8.0(124) srvr ?
IMAP? Unix imapd 9.0(161) srvr ?
IMAP41 Unix imapd v10.164 srvr ?
IMAP2b Unix imapd 7.8(100) srvr ?
IMAP2b Unix imapd 4.0/UW (fut) srvr ?
POP3k Unix hacked ucbmail clnt no.
POP3k Unix hacked pine clnt yes.
POP2 MS-DOSk ? srvr na.
IMAP? Unix UMAIL clnt no.
IMAP? Unix/X Palm (in dev) clnt ?
POP3 NetWare Unoverica MT 2.90 srvr na.
POP3 VM vmpop3.200 srvr na.
IMAP2 Amiga Pine 3.8x (in dev) clnt yes.
POP23 NT Mail Serv f W NT srvr ?
IMAP4 NT Mail Serv f W NT srvr ?
POP? VM ?POPD srvr na.
IMAP2 VMS ImapD port srvr yes.
IMAP2 VMS Pine 3.88 port clnt yes.
POP3 NIN95/NT Rumba Mail clnt yes.
POP3 WIN16/32 Virtual Access clnt yes.
POP3 Be BeMail clnt ?
POP3s Unix fetchmail 4.7.9 clnt no.
IMAP2b Unix fetchmail 4.7.9 clnt no.
POP3u Unix fetchmail 4.7.9 clnt no.
POP23r Unix fetchmail 4.7.9 clnt no.
POP3k Unix fetchmail 4.7.9 clnt no.
IMAP41 Unix fetchmail 4.7.9 clnt no.
POP3 Unix mutt-0.91 (alpha) clnt yes.
IMAP Unix mutt clnt yes.
IMAP4 UnixX11 TkRat clnt yes.
POP? UnixX11 TkRat clnt yes.
POP3 ? gcMail 081b (beta) clnt ?
IMAP? ? ELM patches clnt ?
POP3 Java Aplt Yamp clnt ?
POP? NT NTMail clnt ?
POP3 NT NT Mail gway ?
POP3rutOS/2 POP3s v1.01 srvr ?
------ ---------- ------------------- ---- ----
_________________________________________________________________
Some web-based clients.
Probably properly called 'gateways', they are or work in conjunction.
With web servers, but act as a client to the IMAP or POP-based mail.
Server.
------ ---------- ------------------- ---- ----
POP3 Perl WWW-Mail clnt ?
IMAP? Perl WWW-Mail clnt ?
? Win32 Webmail clnt ?
IMAP? Unix VisualMail clnt yes.
POP3 Unix VisualMail clnt yes.
IMAP? Win32 Xwebmail clnt yes.
IMAP? Apache/PHP IMP clnt ?
------ ---------- ------------------- ---- ----
_________________________________________________________________
Some other packages for desktop systems.
------ ---------- ------------------- ---- ----
Uucp MS-DOS waffle peer ?
Uucp MS-DOS UUPC peer ?
MAPI MS-WIN Air Mail ? ?
? MacOS PowerMail clnt ?
MHS/G DOSWIN BeyondMail clnt yes.
SMTP MS-WINw ws_gmail peer ?
? DOS QuickMail 3.0 clnt ?
? MacOS QuickMail 4.0 (fut) clnt ?
? MacOS QuickMail 3.6 clnt ?
? MS-WIN QuickMail 3.5 clnt ?
? ? QuickMail ? clnt yes.
SMTP MacOS LeeMail 2.0.2 (shw) peer ?
? MS-DOSs CMM peer ?
PSS MS-DOS pMail 3.0 clnt no.
PSS MS-Win pMail 3.0 clnt no.
? DOSMac MailWorks clnt ?
Uucp MacOS UUPC peer ?
? DOSOS/2 Higgins Mail clnt ?
MAPI MS-WIN SIMEON 4.1 clnt ?
MAPI ? ECSmail clnt ?
VIM ? ECSmail clnt ?
SMTP OS/2 PC/TCP v1.3 peer ?
? MS-WINw Panda ? ?
PROP MacOS BlitzMail clnt no.
PROP AIX BlitzMail (in dev) srvr no.
PROP NeXT OS BlitzMail srvr no.
PROP DEC OSF/1 BlitzMail srvr no.
Waffle MS-WIN Boxer clnt ?
Prop MacOS MacPost both ?
Uucp MacOS Eudora >1.3.1 peer yes.
? MS-WIN Team clnt ?
P7uucp DOSWINMac OpenMail clnt ?
SMTP MS-WINw Internt Ex for cc:m gway yes.
MAPI WIN95/NT ExpressIT! 2000 clnt ?
VIM WIN95/NT ExpressIT! 2000 clnt ?
MHS WIN95/NT ExpressIT! 2000 clnt ?
? DOSWIN ExpressIT! clnt ?
Uucp MacOS gnuucp peer ?
? MS-? elm-pc clnt ?
VIM DOSWINMac cc:mail clnt ?
? DOSWINMac Lotus Notes clnt ?
SMTP MS-WINw Mail-IT 2 peer yes.
MAPI MS-WINw Mail-IT 2 clnt yes.
? MacOS Microsoft Mail clnt ?
MAPI MS-DOS? Microsoft Mail clnt ?
SMTP MS-DOSni ChameleonNFS peer ?
MAPI WIN3/95/NT Z-Mail 4.0.1 clnt yes.
? ? GroupWise cnlt ?
? MS-DOSs WinMail 1.1a peer ?
MHS/G DOSWINMac DaVinci eMAIL clnt ?
MAPI WIN3/95/NT Eudora Pro ? clnt yes.
SMTP MS-DOS Charon gway ?
Fshare MS-DOS Pegasus/DOS 3.31 clnt ?
Fshare MacOS Pegasus/MAC 2.1.2 clnt no.
Fshare MS-Windows Pegasus/Win 2.2(r3) clnt ?
Fshare MS-W32 Pegasus/W32 2.5(r2) clnt yes.
Fshare MS-DOS Pegasus/DOS 2.35 clnt ?
Fshare MS-DOS Pegasus/DOS 3.22 clnt ?
SMTP NetWare34 Mercury 1.3.0 gway ?
Fshare MS-DOS Pegasus/DOS 3.11 clnt ?
Fshare MS-Windows Pegasus/Win 2.5(r3) clnt yes.
Fshare MS-DOS Pegasus/DOS 3.40 clnt yes.
SMTP NetWare34 Mercury 1.3.1 gway ?
SMTP WIN32 Mercury32 099(b) gway ?
Uucp MacOS FernMail peer ?
SMTP MacOS LeeMail 1.2.4 peer ?
? MS-? pcelm clnt ?
MAPIs MS-WIN Siren Mail ? ?
MAPIs WIN95 Siren Mail ? ?
MAPIs NTclient Siren Mail ? ?
FCP WIN95/NT FCIC 5.0 clnt no.
FCP MS-WIN FCIC 5.0 clnt no.
FCP MacOS FCIC 5.0 clnt no.
FCP NT FCIS 5.0 srvr no.
FCP MacOS FCIS 5.0 srvr no.
HTTP NT FCIS 5.0 srvr no.
HTTP MacOS FCIS 5.0 srvr no.
SMPT MacOS SMTPGate gway ?
UUCP MacOS UUCPGate gway ?
PROP MacOS CommuniGate both ?
PROP MacOS Quarterdeck Mail both yes.
PROP ? FreeMail ? ?
? DOSWINMac WordPerfect Office clnt ?
------ ---------- ------------------- ---- ----
_________________________________________________________________
Key and Other Issues.
(a) What are the common extensions to POP3 and which clients/servers.
Support them?
POP3k - Kerberos.
POP3a - AFS Kerberos.
POP3x - ?
POP3t - xtnd xmit facility--allows client to send mail through additional.
POP commands, thus allowing server to verify/log source of mail.
POP3r - APOP.
POP3s - RPOP.
POP3m - ?
POP3u - with UIDL command.
(b) What DOS protocol stacks are supported?
MS-DOSm - Lan Manager.
MS-DOSn - NDIS Drivers.
MS-DOSl - Lan Workplace for Dos.
MS-DOSs - Sun PCNFS.
MS-DOSp - Packet Drivers.
MS-DOSo - ODI Drivers.
MS-DOSi - IPXLink.
MS-DOSf - FTP Software PC/TCP.
MS-DOSk - KA9Q I think.
MS-WIN? - similar.
MS-WINw - WinSock compliant.
MS-WIN5 - Windows 95.
WIN3 - Windows 3.x winsock.
WIN3/95/NT - Windows 3.x Winsock, Windows 95 and Windows NT.
WIN3/95 - Windows 3.x Winsock and WIndows 95.
NetWare3 - NetWare 3.x.
NetWare4 - NetWare 4.x.
NetWare34 - NetWare 3.x and 4.x.
PHP3 - written in PHP scripting language.
Perl - written in Perl scripting language.
Java - written in Java programming language.
JavaApp - written as a Java Applet.
(c) Other notes.
IMAP1 - Original IMAP: I've heard that MacMS actually uses a unique.
Dialect of it. Definitely obselete, unsupported, discouraged.
IMAP2b - IMAP2bis: name applied to various improved versions of IMAP2.
This development effort culminated in IMAP4.
IMAP24 - IMAP2 or IMAP4.
Fshare - uses file sharing.
IMAPb4 - IMAP2, IMAP2bis, or IMAP4.
IMAP41 - IMAP4rev1.
MAPI - Microsoft's Messaging API.
HTTP - Web-based e-mail.
MAPIs - Simple MAPI.
VIM - Lotus's Vendor Independent Messaging API.
CMC - XAPIA's Common Message Calls API.
AOCE - Apple Open Collaborative Environment.
PROP - System-specific proprietary protocol.
FCP - SoftArc's proprietary client-server protocol.
Unix/X - X Windows based.
Unix/XM - Motif based.
Unix/XO - OpenWindows based.
UnixSHA - Solaris, HPUX & AIX.
PSS - PROFS Screen Scraper.
©Drkb::03412.
| FastReport - сумма прописью |
Автор: Виталий Кубекин WEB-сайт: http://www.delphiplus.org.
Если задать вопрос программисту: "что делала Ваша первая программа", то половина, наверное, ответит, что она печатала платежные поручения. Какие проблемы встают обычно при написании такой программы? А проблемы возникают следующие: как хранить платежные поручения, как их вводить и изменять, как их распечатывать. Если бы Вы сейчас стали писать такую программу, то какой генератор отчетов вы бы стали использовать? Я думаю, половина ответов была бы – FastReport. Не секрет, что генератор отчетов FastReport является одним из самых популярных генераторов отчетов в нашей стране. И эта популярность легко объяснить удобством его использования. Но в нем не хватает такой мелочи, как сумма прописью. Эта проблема опытным программистом обычно решаются очень быстро или не встает вообще. Но каждый опытный программист когда-то был начинающим. Написанием процедуры вывода суммы прописью мы и займемся.
Code: // Для начала напишем несколько вспомогательных процедур. // Итак, процедура номер один: Procedure Num(Value: byte); Begin. Case Value of. 1: if Rend = true then Result := Result + 'один ' else Result := Result + 'одна '; 2: if Rend = true then Result := Result + 'два ' else Result := Result + 'две '; 3: Result := Result + 'три '; 4: Result := Result + 'четыре '; 5: Result := Result + 'пять '; 6: Result := Result + 'шесть '; 7: Result := Result + 'семь '; 8: Result := Result + 'восемь '; 9: Result := Result + 'девять '; 10: Result := Result + 'десять '; 11: Result := Result + 'одиннадцать '; 12: Result := Result + 'двенадцать '; 13: Result := Result + 'тринадцать '; 14: Result := Result + 'четырнадцать '; 15: Result := Result + 'пятнадцать '; 16: Result := Result + 'шестнадцать '; 17: Result := Result + 'семнадцать '; 18: Result := Result + 'восемнадцать '; 19: Result := Result + 'девятнадцать '; End. End; // Эта процедура добавляет число прописью в диапазоне от 1 до 19 к результату. // Процедура номер два: Procedure Num10(Value: byte); Begin. Case Value of. 2: Result := Result + 'двадцать '; 3: Result := Result + 'тридцать '; 4: Result := Result + 'сорок '; 5: Result := Result + 'пятьдесят '; 6: Result := Result + 'шестьдесят '; 7: Result := Result + 'семьдесят '; 8: Result := Result + 'восемьдесят '; 9: Result := Result + 'девяносто '; End; End; // Эта процедура добавляет десятки в диапазоне от 20 до 90 к результату. // Процедура номер три: Procedure Num100(Value: byte); Begin. Case Value of. 1: Result := Result + 'сто '; 2: Result := Result + 'двести '; 3: Result := Result + 'триста '; 4: Result := Result + 'четыреста '; 5: Result := Result + 'пятьсот '; 6: Result := Result + 'шестьсот '; 7: Result := Result + 'семьсот '; 8: Result := Result + 'восемьсот '; 9: Result := Result + 'девятьсот '; End. End; // Эта процедура добавляет сотни в диапазоне от 100 до 900 к результату. // Дальше немного подробнее. Итак, процедура номер четыре: // На входе число от 1 до 999. Procedure Num00; Begin. //Добавляем сотни если они есть. Num100(ValueTemp div 100); //Отбрасываем сотни. ValueTemp := ValueTemp mod 100; //Если меньше 20, то добавляем число прописью от 1 до 19. If ValueTemp < 20. Then Num(ValueTemp). Else begin. //Добавляем десятки. Num10(ValueTemp div 10); //Отбрасываем десятки. ValueTemp := ValueTemp mod 10; //Добавляем число прописью от 1 до 9. Num(ValueTemp); End; End; // Процедура номер пять: //Mult-Предел обработки числа. //s1- единственное число, именительный падеж (например ‘миллион’). //s2- единственное число, родительный падеж (например ‘миллиона’). //s3- множественное число, родительный падеж (например ‘миллионов’). Procedure NumMult(Mult: int64; s1, s2, s3: string); Var ValueRes: int64; Begin. //Если число больше предела обработки, то обрабатываем. If Value >= Mult then. Begin. //Выделяем число в диапазоне от 1 до 999. ValueTemp := Value div Mult; ValueRes := ValueTemp; //Добавляем число прописью в диапазоне от 1 до 999. Num00; //Добавляем обозначение числа в диапазоне от 1 до 999 (например, миллионов). If ValueTemp = 1 then Result := Result + s1. Else if (ValueTemp > 1) and (ValueTemp < 5) then Result := Result + s2. Else Result := Result + s3; //Вычитаем обработанное число. Value := Value - Mult * ValueRes; End; End; // Собственно, сама функция "сумма прописью": Function TfrCalc.Propis(Value: int64): string; Var. Rend: boolean; ValueTemp, ValueOst: int64; //Описанные выше функции. Begin. //Определяем если ноль. If (Value = 0). Then Result := 'ноль' Else begin. Result := ''; //устанавливаем окончания мужского рода (триллион, миллиард, миллион). Rend := true; //обрабатываем триллионы. NumMult(1000000000000, 'триллион ', 'триллиона ', 'триллионов '); //обрабатываем миллиарды. NumMult(1000000000, 'миллиард ', 'миллиарда ', 'миллиардов '); //обрабатываем миллионы. NumMult(1000000, 'миллион ', 'миллиона ', 'миллионов '); //устанавливаем окончания женского рода (тысячи). Rend := false; //обрабатываем тысячи. NumMult(1000, 'тысяча ', 'тысячи ', 'тысяч '); //устанавливаем окончания мужского рода. Rend := true; ValueTemp := Value; Num00; End; End; // Я думаю, в самой функции ничего сложного нет, а если есть то можно разобраться. // Теперь необходимо подключить нашу функцию к FastReport. // Добавим обработчик события OnUserFuncton класса TfrReport: Procedure TForm1.frReport1UserFunction(const Name: string; P1, p2, p3: Variant; var Val: Variant); Begin. If AnsiCompareText('Пропись', Name) = 0 then. Val := Propis(Trunc(frParser.Calc(p1))); End; // Для того чтобы функция появилась в списке функций: FrAddFunctionDesc(nil, 'Пропись', 'Дополнительные функции', 'Пропись(<Число>)/Возвращает Число прописью'); // Итак, функцию мы написали, но не хватает одной мелочи- названия валюты. // Итак, напишем еще тройку функций. // Функция номер один записывает в S1,S2,S3 строки разделенные ';', // например 'рубль;рубля;рублей'. Procedure Fst(S: string; var S1: string; var S2: string; var S3: string); Var. Pos: integer; Begin. S1 := ''; S2 := ''; S3 := ''; pos := 1; While ((pos <= Length(S)) and (S[pos] <> ';')) do. Begin. S1 := S1 + S[pos]; Inc(pos); End; Inc(pos); While ((pos <= Length(S)) and (S[pos] <> ';')) do. Begin. S2 := S2 + S[pos]; Inc(pos); End; Inc(pos); While ((pos <= Length(S)) and (S[pos] <> ';')) do. Begin. S3 := S3 + S[pos]; Inc(pos); End; Inc(pos); End; // Функция номер два возвращает запись о валюте с нужным склонением. //Value – число для склонения. //Skl1- единственное число, именительный падеж (рубль). //Skl2- единственное число, родительный падеж (рубля). //Skl3- множественное число, родительный падеж (рублей). Function Ruble(Value: int64; Skl: string): string; Var. Hk10, hk20: integer; Skl1, Skl2, Skl3: string; Begin. Fst(Skl, Skl1, Skl2, Skl3); Hk10 := Value mod 10; Hk20 := Value mod 100; If (hk20 > 10) and (hk20 < 20). Then result := result + Skl3. Else if (hk10 = 1) then result := result + Skl1. Else if (hk10 > 1) and (hk10 < 5) then result := result + Skl2. Else result := result + Skl3; End; // И то же самое для копеек. // Функция номер три возвращает запись о копейках с нужным склонением. //Value – число для склонения. //Skp1- единственное число, именительный падеж (копейка). //Skp2- единственное число, родительный падеж (копейки). //Skp3- множественное число, родительный падеж (копеек). Function Kopeika(Value: integer; Skp: string): string; Var. Hk10, hk20: integer; Skp1, Skp2, Skp3: string; Begin. Fst(Skp, Skp1, Skp2, Skp3); Hk10 := Value mod 10; Hk20 := Value mod 100; If (hk20 > 10) and (hk20 < 20). Then result := result + Skp3. Else if (hk10 = 1) then result := result + Skp1. Else if (hk10 > 1) and (hk10 < 5) then result := result + Skp2. Else result := result + Skp3; End; // Подключаем все это к FastReport. // Добавляем обработчик события OnUserFuncton класса TfrReport: Procedure TForm1.frReport1UserFunction(const Name: string; P1, p2, p3: Variant; var Val: Variant); Begin. If AnsiCompareText('Рубль', Name) = 0 then. Val := Ruble(Trunc(frParser.Calc(p1)), frParser.Calc(p2)); If AnsiCompareText('Копейка', Name) = 0 then. Val := Kopeika(Trunc(frParser.Calc(p1)), frParser.Calc(p2)); End; // Для того чтобы функция появилась в списке функций:
Fast Report для CLX.
| Fast Report для CLX. |
Http://www.fastreport.ru/ru/frclx.php.
©Drkb::04633.
| File List View in File Dialogs. |
Code: // If an application asks user to select an icon, it's. // more convenient for the user to see list of files as. // large icons instead of small icons. Also, for selecting. // an image file, user will be happier to choose an image. // by seeing the thumbnails. // The standard file dialog initialy shows the files in. // the LIST (small icon) style, and there is no documented. // way to change this behavior. So, if user wants to see. // the file list in another style, she/he should change. // it manually by selecting the desired view style form. // the provided popup menu. // Here is a workaround for this limitation to select the. // reasonable view style for a file dialog. Type. TFileViewStyle = (fvsIcons, fvsList, fvsDetails, fvsThumbnails, fvsTiles); Function SetFileDialogViewStyle(Handle: THandle; ViewStyle: TFileViewStyle): Boolean; Const. CommandIDs: array[TFileViewStyle] of Word = ($7029, $702B, $702C, $702D, $702E); Var. NotifyWnd: THandle; Begin. Result := False; NotifyWnd := FindWindowEx(GetParent(Handle), 0, 'SHELLDLL_DefView', nil); If NotifyWnd <> 0 then. Begin. SendMessage(NotifyWnd, WM_COMMAND, CommandIDs[ViewStyle], 0); Result := True; End; End; // Each time the file dialog opens, the above function should. // be called to set the desired view style. The OnShow event. // of the file dialogs seems to be the right place for this. // purpose, however at that time the list is not created yet. // and the function fails. // When the file list is created, the dialog raises two events: // OnFolderChange and OnSelectionChange events. We can use one. // of these events for our purpose. However, we have to consider. // that the function should be called just once for each show. // Here is a sample usage of the introduced function: Procedure TForm1.Button1Click(Sender: TObject); Begin. OpenDialog1.Tag := 0; OpenDialog1.Execute; End; Procedure TForm1.OpenDialog1FolderChange(Sender: TObject); Begin. If OpenDialog1.Tag = 0 then. Begin. SetFileDialogViewStyle(OpenDialog1.Handle, fvsIcons). OpenDialog1.Tag := 1; End; End;
| Find the convex hull of 2D points? |
Code: Uses. Math; Type. TPointArray = array of TPoint; TPointFloat = record. X: Real; Y: Real; End; // return the boundary points of the convex hull of a set of points using Grahams scan. // over-writes the input array - so make a copy first. Function FindConvexHull(var APoints: TPointArray): Boolean; Var. LAngles: array of Real; Lindex, LMinY, LMaxX, LPivotIndex: Integer; LPivot: TPoint; LBehind, LInfront: TPoint; LRightTurn: Boolean; LVecPoint: TPointFloat; Begin. Result := True; If Length(Points) = 3 then Exit; // already a convex hull. If Length(Points) < 3 then. Begin // not enough points. Result := False; Exit; End; // find pivot point, which is known to be on the hull. // point with lowest y - if there are multiple, point with highest x. LMinY := 1000; LMaxX := 1000; LPivotIndex := 0; For Lindex := 0 to High(APoints) do. Begin. If APoints[Lindex].Y = LMinY then. Begin. If APoints[Lindex].X > LMaxX then. Begin. LMaxX := APoints[Lindex].X; LPivotIndex := Lindex; End; End. Else if APoints[Lindex].Y < LMinY then. Begin. LMinY := APoints[Lindex].Y; LMaxX := APoints[Lindex].X; LPivotIndex := Lindex; End; End; // put pivot into seperate variable and remove from array. LPivot := APoints[LPivotIndex]; APoints[LPivotIndex] := APoints[High(APoints)]; SetLength(APoints, High(APoints)); // calculate angle to pivot for each point in the array. // quicker to calculate dot product of point with a horizontal comparison vector. SetLength(LAngles, Length(APoints)); For Lindex := 0 to High(APoints) do. Begin. LVecPoint.X := LPivot.X - APoints[Lindex].X; // point vector. LVecPoint.Y := LPivot.Y - APoints[Lindex].Y; // reduce to a unit-vector - length 1. LAngles[Lindex] := LVecPoint.X / Hypot(LVecPoint.X, LVecPoint.Y); End; // sort the points by angle. QuickSortAngle(APoints, LAngles, 0, High(APoints)); // step through array to remove points that are not part of the convex hull. Lindex := 1; Repeat. // assign points behind and infront of current point. If Lindex = 0 then LRightTurn := True. Else. Begin. LBehind := APoints[Lindex - 1]; If Lindex = High(APoints) then LInfront := LPivot. Else. LInfront := APoints[Lindex + 1]; // work out if we are making a right or left turn using vector product. If ((LBehind.X - APoints[Lindex].X) * (LInfront.Y - APoints[Lindex].Y)) - ((LInfront.X - APoints[Lindex].X) * (LBehind.Y - APoints[Lindex].Y)) < 0 then. LRightTurn := True. Else. LRightTurn := False; End; If LRightTurn then. Begin // point is currently considered part of the hull. Inc(Lindex); // go to next point. End. Else. Begin // point is not part of the hull. // remove point from convex hull. If Lindex = High(APoints) then. Begin. SetLength(APoints, High(APoints)); End. Else. Begin. Move(APoints[Lindex + 1], APoints[Lindex], (High(APoints) - Lindex) * SizeOf(TPoint) + 1); SetLength(APoints, High(APoints)); End; Dec(Lindex); // backtrack to previous point. End; Until Lindex = High(APoints); // add pivot back into points array. SetLength(APoints, Length(APoints) + 1); APoints[High(APoints)] := LPivot; End; // sort an array of points by angle. Procedure QuickSortAngle(var A: TPointArray; Angles: array of Real; iLo, iHi: Integer); Var. Lo, Hi: Integer; Mid: Real; TempPoint: TPoint; TempAngle: Real; Begin. Lo := iLo; Hi := iHi; Mid := Angles[(Lo + Hi) div 2]; Repeat. While Angles[Lo] < Mid do Inc(Lo); While Angles[Hi] > Mid do Dec(Hi); If Lo <= Hi then. Begin. // swap points. TempPoint := A[Lo]; A[Lo] := A[Hi]; A[Hi] := TempPoint; // swap angles. TempAngle := Angles[Lo]; Angles[Lo] := Angles[Hi]; Angles[Hi] := TempAngle; Inc(Lo); Dec(Hi); End; Until Lo > Hi; // perform quicksorts on subsections. If Hi > iLo then QuickSortAngle(A, Angles, iLo, Hi); If Lo < iHi then QuickSortAngle(A, Angles, Lo, iHi); End;
| Flash SWF --> EXE. |
Code: Function Swf2Exe(S, D, F: string): string; //S = Source file (swf). //D = Destionation file (exe). //F = Flash Player. Var. SourceStream, DestinyStream, LinkStream: TFileStream; Flag: Cardinal; SwfFileSize: Integer; Begin. Result := 'something error'; DestinyStream := TFileStream.Create(D, fmCreate); Try. LinkStream := TFileStream.Create(F, fmOpenRead or fmShareExclusive); Try. DestinyStream.CopyFrom(LinkStream, 0); Finally. LinkStream.Free; End; SourceStream := TFileStream.Create(S, fmOpenRead or fmShareExclusive); Try. DestinyStream.CopyFrom(SourceStream, 0); Flag := $FA123456; DestinyStream.WriteBuffer(flag, SizeOf(Integer)); SwfFileSize := SourceStream.Size; DestinyStream.WriteBuffer(SwfFileSize, SizeOf(Integer)); Result := ''; Finally. SourceStream.Free; End; Finally. DestinyStream.Free; End; End; Procedure TForm1.Button1Click(Sender: TObject); Begin. Swf2Exe('c:\somefile.swf', 'c:\somefile.exe', 'c:\Program Files\Macromedia\Flash MX\Players\SAFlashPlayer.exe'); End;
Краткое описание Foxpro.
Visual FoxPro последняя версия 8.0.
Производитель: Microsoft.
Домашняя страница: http://msdn.microsoft.com/vfoxpro/
После выпуска 7-ой версии Microsoft заявил о прекращении развития данного продукта, однако через год после этого была выпущена 8-ая версия.
Цена лицензионной 8-ой версии: полной версии по данным сайта производителя $649 US; для пользователей ранними версиями $349 US.
В Москве 7-ая версия стоит ок. $600 US с доставкой по Москве.
Ограничения VFoxPro 7.0.
Для людей имеющих представление, что такое БД привожу некоторые ограничения для 7-го Фокса (это лучше любых хар-тик), выводы сами напросятся. Для остальных распишу все позже.
Ограничения работы с базами.
Максимум записей в файл таблицы...................................................1 миллиард.
Максимальный размер файла таблицы.............................................2 гигабайта.
Максимум символов в записи (MEMO).................................................65,500.
Максимум символов в поле таблицы..................................................254.
Максимальный размер числовых (и с плавающей точкой) полей....20.
Максимум полей записей...................................................................255.
Максимум таблиц открывается в одно время...................................255.
(ограниченно памятью и доступными дескрипторами файла.).
Максимум байтов в индексном ключе в некомпактном индексе.....100.
Максимум байтов в индексную ключе в компактном индексе.........240.
Максимум открытых индексных файлов в таблице.........................неограниченно.
Максимум открытых индексов во всех базах...............................неограниченно.
Максимум отношений.......................................................................неограниченно.
Максимальные поля, которые могут быть выбраны SQL SELECT........255.
Ограничения языка.
Минимальное значение целого числа............................-2,147,483,647.
Максимальное значение целого числа............................2,147,483,647.
Цифры точности в числовых вычислениях: VFoxPro может обрабатывать числа до 9007199254740992 (2^53) в точных вычислениях.
Значение по умолчанию переменных............................1,024.
Максимум переменных.....................................................65,000.
Максимум массивов...........................................................65,000.
Максимум элементов в массив.........................................65,000.
Максимум вложений DO...................................................128.
Максимум вложенных структурированных команд программирования....384.
Максимум транзакций......................................................5.
Максимальная длина символьной переменой.................255.
Максимум открытых окон.................................................неограниченно.
Максимум открытых окон Browse....................................255.
Максимум символов в макроподстановке........................8,192.
Общие сведения.
FoxPro работает с таблицами формата *.dbf.
Visual FoxPro 7.0 снабжено мощным набором мастеров, которые позволяют новичку достаточно быстро создать мощное работоспособное приложение, однако не могу рекомендовать использовать эту возможность людям, желающим, создать рациональное приложение, т.к. мастера используют навороченные библиотеки и не рационально используют память. Программы созданные с помощью мастеров очень грамозки.
FoxPro сильно интегрирован с SQL, позволяет вставлять блоки SQL-комманд непосредственно в тело основного кода и использовать в SQL-запросах собственные (фоксовские) функции. Что позволяет быстро и эффективно обробатывать большие базы, даже если таблицы не индексированы. Кроме того, FoxPro облодает собственными, очень мощными, и главное, удобными средствами работы с БД.
Наиболее крупные БД созданные на FoxPro (из мне известных):
База данных ГУВД г. Москвы.
База данных МГТС.
База данных Пенсионного фонда России.
Это основной язык написания программ Главного Научно-Вычеслительного Центра (ГНИВЦ) Министерства РФ по налогам и сборам.
К достоинствам VFoxPro можно так же отнести: возможность создания составного индекса, работа с курсорами (виртуальными таблицами, не отличающимися от обычных, но исчезающих после завершения сеанса работа, т.е. не остаются ни в памяти ни на диске), возможность экспортировать\импортировать данные в\из XML, VFoxPro работает с другими базами по средствам драйвера ODBC, VFoxPro обладает высокой надежностью при работе с БД (в т.ч. и с индексами) и полность соответствует объявленным возможностям.
На VFoxPro можно создавать и клиент-серверные БД, однако в этой области VFoxPro значительно уступает большинству из известных серверов БД.
Резюме VFoxPro мощнейшее средство для работы с локальными базами данных, значительно превосходящее, по эффективности, все остальные системы БД.
Недостатки VFoxPro.
Все вышесказанное относится к VFoxPro как средству разработки баз данных, однако на нем не представляется интересным создавать приложения не связанные с БД, хотя сам FoxPro является языком самодостаточным. Это связано с тем, что с VFoxPro поставляется очень убогий класс для работы с визуальными компонентами, а исходник этого класса закрыт. Поэтому разработчик ограничен в возможностях "украшать" свою программу. Следующее, в FoxPro не происходит объявления типа переменных, это лишает возможности контролировать правильность обращения к переменной и, главное, под переменную отводится максимальное кол-во памяти, поэтому программы написанные на VFoxPro очень ресурсоемкие. Большой недостаток VFoxPro - это крайне слабый конструктор отчетов, крайне осложняющий разработку приложения. Для работы программы, созданной на VFoxPro, необходимы библиотеки поддержки, что увеличивает размер поставляемой программы еще, примерно, на 4 Mb. Есть еще более мелкие недостатки.
Резюме Основными недостатками VFoxPro являются: большие требования к памяти, программами созданными на VFoxPro и слабые возможности по работе с визуальными компонентами.
Рекомендации для выбора Могу порекомендовать выбрать VFoxPro, тем кому требуется ввести и обрабатывать большие базы данных на локальных компьютерах или в небольших сетях. Т.к. VFoxPro позволяет создавать запросы, практически любой сложности. Разумеется не рекомендую использовать этот язык для составления больших серверных баз и для написания программ не связанных с ведением баз данных.
Обращаю внимание еще раз: FoxPro - это не только средство работы с базами данных, но это еще и язык программирования высокого уровня.
Типы данных Visual FoxPro.
Тип данных Описание Размер Диапазон.
Character Произвольный текст. 1 байт на символ; до 254 байтов Любые символы.
Currency Денежная сумма. 8 байтов от -922337203685477.5808 до 922337203685477.5807.
Date Хронологическая дата, состоящая из месяца, года и числа. 8 байтов от 01/01/100 до 12/31/9999.
DateTime Хронологическая дата, состоящая из месяца, года, числа и времени. 8 байтов от 01/01/100 до 12/31/9999, плюс от 00:00:00 утра до 11:59:59 вечера.
Logical Логическое значение истинности. 1 байт Истина (.T.) или Ложь (.F.).
Numeric Целое или с дробной частью число. 8 байтов в памяти;
От 1 до 20 байтов в таблице от.
- .9999999999E+19.
До.
.9999999999E+20.
Variant размер и диапазон принимает в соответствии с веденными данными.
Типы данных полей таблиц Visual FoxPro.
Тип поля Описание Размер Диапазон.
Double Число с плавающей запятой двойной точности. 8 байтов от.
+/-4.94065645841247E-324 до +/-1.79769313486232E308.
Float Такое же, как Numeric. 8 байтов в памяти;
От 1 до 20 байтов в таблице от.
- .9999999999E+19.
До.
.9999999999E+20.
General Ссылка на OLE-объект. 4 байта в таблице. Ограничен только доступной памятью.
Integer Целочисленные значения 4 байта от -2147483647 до 2147483646.
Memo Ссылка на блок данных 4 байта в таблице Ограничен только доступной памятью.
Character (Двоичный) Любые символьные данные, которые нужно сопровождать без изменения кодовых страниц 1 байт на символ до 254 байтов Любые символы.
Memo (Двоичный) Любые memo-поля, которые нужно сопровождать без изменения кодовых страниц 4 байта в таблице Ограничен только доступной памятью.
Вот пример работы с ADO.
Зависимость от сервера не велика.
Conado=CREATEOBJECT(`adodb.connection`).
Conado.
TYPE(`conado`).
Conado.open(`ora_ado`).
Rd=CREATEOBJECT(`adodb.recordset`).
Rd.Open(`select * from prof`,conado).
TYPE(`rd.Fields`).
Rd.Fields(`pro`).Value.
Rd.MoveNext().
Rd.Fields(1).Type.
Пример работы через ODBC.
Con=sqlconnect('oradsn','scott','tiger').
If con>0 and sqlexec(con,'select * from scott.dept')>0.
Copy to dept.
Endif.
Если необходимо сделать параметризованный запрос:
M.depno=10.
Con=sqlconnect('oradsn','scott','tiger').
If con>0 and sqlexec(con,'select * from scott.dept where depno=? m.depno')>0.
Copy to dept.
Endif.
Системные требования (для Visual FoxPro 7).
Процессор Pentium 133 или выше.
Минимальный объем оперативной памяти - 64Mb, рекомендуется не менее 128Mb.
Жесткий диск не менее 115Mb, до 200Mb, при полной установке.
Операционная система MS Windows98, ME, NT4, 2000, XP.
Видеорижим - SVGA.
Кроме того, необходимо, что бы на компьютере были установленны Internet Explorer 5.5 и Service Pack 1 (для Win2000).
Поддержка триггеров - да.
Поддержка хранимых процедур - да.
Поддержка транзакций - да.
Защита данных, шифрование - нет, шифрование данных осуществляется перед занесением данных в таблицу.
Возможность удалённого и Web администрирования - нет.
Возможность импорта данных из.
- MS Excell 2.0 - 97.
- Lotus 1-3.
- Paradox (до версии 4.0).
- Symphony.
- FrameWork II.
- MultiPlan 4.01.
- RapidFile.
Возможность экспорта данных в.
- FoxBase+ (DBF).
- dBase IV (DBF).
- текстовый файл (txt).
- Lotus 1-2-3 1-A (WK1, WRK).
- Symphony (WR1, WRK).
- MultiPlan 4.01 (MOD).
System Data Format (SDF).
И некоторые другие, мало кому известные.
Наличие утилит для автоматизации операций для работы в командной строке, наличие собственных утилит для отладки запросов (выполнение SQL, построение плана выполнения кверей, профайлер и т.п.), утилиты для слежения за производительностью сервера. - Сам FoxPro.
Автор Cashey.
©Drkb::02935.
Взято с Vingrad.ru http://forum.vingrad.ru.
FreeUserPhysicalPages.
Функция FreeUserPhysicalPages освобождает физические страницы памяти, которые были ранее выделены при помощи вызова {AllocateUserPhysicalPages}. Если текущие страницы были спроецированы в AWE-регион, то при вызове автоматически произойдет очишение проецирования. Заметим, что указанный вызов никак не затронет виртуальное адресное пространство, занимающее AWE-регион.
Function FreeUserPhysicalPages(
HProcess: THandle, // дескриптор процесса.
Var NumberOfPages: Cardinal, // количество страниц для освобождения.
Var UserPfnArray: DWORD // виртуальный адрес фреймов освобождаемых страниц.
): Boolean; stdcall;
Параметры.
HProcess [in].
Дескриптор процесса. Функция освобождает память в виртуальном адресном пространстве этого процесса.
NumberOfPages [in/out].
Указывает размер физической памяти в страницах, которая будет освобождена. При возвращении с случае ошибки возвращает количество страниц в памяти, которые действительно были освобождены.
UserPfnArray [in].
Задает виртуальное адресное пространство, которое содержит фреймы страниц, которые должны быть освобождены.
Возвращаемое значение.
При удачном завершении функция возвращает True.
В случае возникновения ошибки функция вернет False. В этом случае параметр NumberOfPages показывает, сколько страниц было освобождено в действительности. Для получения расширенной информации об ошибке выполните вызов GetLastError.
Описание.
В случае нескольких процессоров эта функция поддерживает согласованное выполнение на уровне аппаратного переводного буфера. При выходе из этой функции, для всех потоков и процессов гарантируется корректное проецирование.
Требования.
Windows NT/2000: Требуется Windows NT 2000 или более поздняя версия.
Windows 95/98: Не поддерживается.
Бибиотека: Kernel32.dll.
Подключаемый модуль: Не описана.
© Mystic, 2002.
| FTP. |
Как я сказал во введении, FTP означает File Transfer Protocol, который описан в RFC 959. Модель связи FTP может быть реализована с помощью сокетов, но это более низкоуровневое решение и если вы посмотрите спецификацию, то поймети, что написание программы FTP клиента с нуля не такая уж простая задача. С другой стороны, мы можем использовать NetManage TFTP компонент из Delphi 2.01 (и выше) и C++Builder. Я пробовал использовать этот компонент несколько раз, и нашел его просто глюкавым, особенно для файлов свыше 10 Kb. Я могу понять, почему Microsoft (первый разработчик Internet Solutions Pack) не захотела использовать его и продала затем NetManage, которая тоже не справилась с ним и продала далее фирме NetMasters. Проблема в том, что Internet Solutions Pack - хотя и бесплатный - основан на наборе с ограничениями ActiveX, и каждая компания которая использует его также имеет более лучшее решение (обычно не бесплатно). Поддержка и документация всегда отвратительная...
Так что же, назад к низкоуровневому программированию? Ни в коем случае. Как всегда на помощь приходит Microsoft.
3.2. WinInet.
Некоторое время назад, Microsoft выпустила WinInet, который ни что иное как промежуточный слой между высоким и нижним уровнем программирования Internet API специально для Win32 программистов. WinInet Является интерфейсом высокого уровня для протоколов нижнего уровня, таких как HTTP и FTP. Использование его действительно просто, и хорошо, что модуль WinInet.PAS с API определениями уже включен в Delphi 2.x и выше!
Имеется также большой документ, описывающий все детали WinInet API, который может быть найден на сайте Microsoft (но его местонахождение постоянно меняется, так что нужно использовать систему поиска, для загрузки последней версии документа).
От переводчика: можно взять на моем сайте со страницы http://nps.vnet.ee/internet.html.
3.3. DrBob FTP.
WinInet использует не что, что они назвали Интернет хендл "internet handle" (очень похоже на Windows handles), и все API функции или нуждаются или возвращают Интернет хендл. Например, что бы открыть новую WinInet сессию, нам нужно вызвать функцию InternetOpen, которая вернет Интернет хендл, который мы должны использовать до конца сессии (и передавать другим API функциям). Для освобождения хендла, мы всегда должны вызывать функцию InternetCloseHandle (после получения хендла мы можем его использовать, но мы обязаны написать блок try-finally, где должны освободить хендл в разделе finally).
Для открытия удаленного файла (или URL) в Интернете, мы должны вызвать функцию InternetOpenURL, которая опять вернет нам хендл. Теперь, для загрузки удаленного файла (URL) на нашу локальную машину, нам осталось сделать только некоторое количество вызовов функции InternetReadFile, очень похожей на функцию BlockRead, которая копирует данные из удаленного файла в буфер данных. Мы можем использовать BlockWrite для записи из буфера в локальный файл, и все это с помощью всего лишь трех WinInet функций (четыре, если считать функцию InternetCloseHandle), мы можем написать простую, но очень быструю FTP программу следующим образом:
Code: Program DrBobFTP; {$APPTYPE CONSOLE}. {$I+}. Uses. Windows, WinInet; Procedure CopyURL(const URL, OutputFile: String); Const. BufferSize = 1024; Var. HSession, hURL: HInternet; Buffer: Array[0..Pred(BufferSize)] of Byte; BufferLength: DWORD; F: File; Begin. HSession := InternetOpen('DrBob',INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,0); Try. HURL := InternetOpenURL(hSession, PChar(URL), nil,0,0,0); Try. Assign(f, OutputFile); Rewrite(f,1); Repeat. InternetReadFile(hURL, @Buffer, BufferSize, BufferLength); Write('.'); BlockWrite(f, Buffer, BufferLength). Until BufferLength = 0; Close(f); Writeln('OK') { if we get here, we succeeded }. Finally. InternetCloseHandle(hURL). End. Finally. InternetCloseHandle(hSession). End. End; Begin. If ParamCount <2 >then. Begin. Writeln('Usage: DrBobFTP URL Filename'); Writeln('Example: DrBobFTP http://www.drbob42.com/ftp/headconv.zip hc.zip'). End. Else. CopyURL(ParamStr(1), ParamStr(2)). End.
| Ftpsock.pas. |
Code: Unit FtpSock; { CrtSocket for Delphi 32. Copyright (C) 1999-2001 Paul Toth <tothpaul@free.fr> Http://tothpaul.free.fr. This program is free software; you can redistribute it and/or. Modify it under the terms of the GNU General Public License. As published by the Free Software Foundation; either version 2. Of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, But WITHOUT ANY WARRANTY; without even the implied warranty of. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the. GNU General Public License for more details. You should have received a copy of the GNU General Public License. Along with this program; if not, write to the Free Software. Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. } Interface. Uses. CrtSock,SysUtils; Function FtpLogon(Server,User,Password:string):integer; Procedure FtpLogoff; Function FtpQuote(cmd:string):boolean; Function FtpOpenWrite(FileName:string):integer; Function FtpOpenRead(FileName:string):integer; Function FtpClose(FileHandle:integer):boolean; Function FtpError:string; Implementation. Var. Ftpin,ftpout:TextFile; Last:string; Read:boolean; Function FtpError:string; Begin. Result:=last; End; Function ReadString:string; Begin. Repeat. Readln(ftpin,Result); // writeln(result); Until (Length(Result)<4)or(Result[4]<>'-'); Last:=Result; End; Procedure WriteString(s:string); Begin. // writeln('>>>',s); WriteLn(ftpout,s); End; Function Status:char; Var. S:string; Begin. S:=ReadString; If s='' then Status:='?' else Status:=s[1]; End; Function Exec(cmd:string):char; Begin. Writestring(cmd); Result:=Status; End; Function FtpLogon(Server,User,Password:string):integer; Begin. Result:=CallServer(Server,21); If Result>0 then begin. AssignCrtSock(Result,ftpin,ftpout); If Status='2' then begin. If (Exec('USER '+User)='3') and (Exec('PASS '+Password)='2') then exit; Disconnect(Result); Result:=-3; End else begin. Disconnect(Result); Result:=-2; End; End; End; Procedure FtpLogoff; Begin. Exec('QUIT'); CloseFile(ftpout); End; Function FtpQuote(cmd:string):boolean; Begin. Writestring(Cmd); Result:=(Status='2'); End; Function GetValue(var s:string):integer; Var. I:integer; Begin. I:=length(s); while s[i]<>',' do dec(i); Result:=StrToInt(copy(s,i+1,3)); SetLength(s,i-1); End; Function FtpOpenWrite(FileName:string):integer; Var. S:string; B,e:integer; Port:word; Begin. Read:=false; Result:=-1; If Exec('PASV')<>'2' then exit; B:=4; while (b<length(last)) and (not (last[b] in ['0'..'9'])) do inc(b); E:=Length(last); while (e>0) and (not (last[b] in ['0'..'9'])) do dec(b); S:=copy(last,b,e-b-1); Port:=getvalue(s); Port:=256*getvalue(s)+port; For e:=1 to Length(s) do if s[e]=',' then s[e]:='.'; // replace "," by "." in IP address. WriteString('STOR '+FileName); // writeln('call ',s,':',port); Result:=CallServer(s,port); If (Status<>'1')and(Result>=0) then begin. Disconnect(Result); Result:=-1; End; End; Function FtpOpenRead(FileName:string):integer; Var. S:string; B,e:integer; Port:word; Begin. Read:=true; Result:=-1; If Exec('PASV')<>'2' then exit; B:=4; while (b<length(last)) and (not (last[b] in ['0'..'9'])) do inc(b); E:=Length(last); while (e>0) and (not (last[b] in ['0'..'9'])) do dec(b); S:=copy(last,b,e-b-1); Port:=getvalue(s); Port:=256*getvalue(s)+port; For e:=1 to Length(s) do if s[e]=',' then s[e]:='.'; // replace "," by "." in IP address. WriteString('RETR '+FileName); Result:=CallServer(s,port); If (Status<>'1')and(Result>=0) then begin. Disconnect(Result); Result:=-1; End; End; Function FtpClose(FileHandle:integer):boolean; Begin. Disconnect(FileHandle); Result:=Status='2'; End; End.
| Часть 2. Работа с примитивами и изображениями |
Доброе время суток, уважаемые коллеги. В данной статье мы разберем вывод графических примитивов и вывод изображений. GDI+ предоставляет программисту огромный выбор методов для вывода графики, в данной статье мы рассмотрим вывод примитивов с заливкой и без, вывод примитивов с своим стилем линии, использование групп (путей) для группировки примитивов и вывода их на экран, также мы рассмотрим операции по загрузке и выводу изображений, создание на основе изображения - мини-просмотра (Thumbnail), вывода изображения в область (растягивание), вывод изображения в параллелограмм. В данной статье я не буду специально рассматривать трансформацию изображений и примитивов, а так же заливку примитивов различными градиентами и изображениями, так как в первой части данного цикла статей я дал простые примеры по данным вопросам, а применить их к изображению иль к примитивам не составляет особого труда. Итак, что в данной части мы получим -
вот такой пример.
Итак, сверху - вниз :
· 1. Вывод примитивов без заливки (для этого в GDI+ предусмотрены функции начинающиеся с Draw…)
· 2. Вывод примитивов с заливкой (для этого в GDI+ предусмотрены функции начинающиеся с Fill…)
· 3. Создание мини-просмотра
· 4.Вывод оригинального изображения, вывод растянутого и вывод изображения в параллелограмм.
Рассмотрим это в коде :
Code: Procedure TForm1.PaintBox1Paint(Sender: TObject); Const. Dash : array[0..3] of single = (1, 1, 5, 4); Grani : array[0..2] of TPoint = ((x: 620; y: 180), // Верхняя грань. (x: 560; y: 200), // Правая грань. (x: 600; y: 260)); // Нижяя грань. Var. R : TRect; Pen : TGPPen; // Кисть. SolidBrush : TGPSolidBrush; // Заливка непрерывным цветом. Path : TGPGraphicsPath; // Пути. Image, pThumbnail: TGPImage; // Рисунок. Begin. GraphicsGDIPlus := TGPGraphics.Create(PaintBox1.Canvas.Handle); // Рисование примитивов без заливки. Pen:= TGPPen.Create(MakeColor(255, 0, 0, 0), 1); R.X := 0; R.Y := 0; R.Width := 50; R.Height := 50; GraphicsGDIPlus.DrawRectangle(Pen,R); GraphicsGDIPlus.DrawLine(Pen,R.X,R.Y,R.X+R.Width,R.Y+R.Height); Pen.Free; // Рисование примитивов без заливки c толщиной линии 5. Pen:= TGPPen.Create(MakeColor(255, 0, 0, 0), 5); R.X := 60; R.Y := 0; R.Width := 50; R.Height := 50; GraphicsGDIPlus.DrawRectangle(Pen,R); GraphicsGDIPlus.DrawLine(Pen,R.X,R.Y,R.X+R.Width,R.Y+R.Height); Pen.Free; // Рисование примитивов без заливки c толщиной линии 5 и собственным стилем Dash. Pen:= TGPPen.Create(MakeColor(255, 0, 0, 0), 5); Pen.SetDashPattern(@dash, 4); R.X := 120; R.Y := 0; R.Width := 50; R.Height := 50; GraphicsGDIPlus.DrawRectangle(Pen,R); GraphicsGDIPlus.DrawLine(Pen,R.X,R.Y,R.X+R.Width,R.Y+R.Height); Pen.Free; // Использование графических путей. Path := TGPGraphicsPath.Create; Pen:= TGPPen.Create(MakeColor(255, 0, 0, 0), 1); Path.Reset; R.X := 180 ; R.Y := 0; R.Width := 50; R.Height := 50; Path.StartFigure(); Path.AddArc(R, 0.0, -180.0); Path.AddLine(R.X, R.Y+25, R.X+25, R.Y+R.Height); Path.AddLine(R.X+25, R.Y+R.Height,R.X+R.Width, R.Y+25); Path.CloseFigure(); GraphicsGDIPlus.DrawPath(pen, path); Pen.Free; // Рисование примитивов с заливкой непрерывным цветом. // Создаем объект для непрерывной заливки. SolidBrush := TGPSolidBrush.Create(MakeColor(255, 255, 255, 0)); R.X := 0 ; R.Y := 60; R.Width := 50; R.Height := 50; GraphicsGDIPlus.FillRectangle(SolidBrush,R); SolidBrush.Free; SolidBrush := TGPSolidBrush.Create(MakeColor(255, 255, 255, 0)); R.X := 60 ; R.Y := 60; R.Width := 50; R.Height := 50; GraphicsGDIPlus.FillEllipse(SolidBrush,R); SolidBrush.Free; // Использование графических путей. Path := TGPGraphicsPath.Create; SolidBrush := TGPSolidBrush.Create(MakeColor(255, 255, 255, 0)); Path.Reset; R.X := 120 ; R.Y := 60; R.Width := 50; R.Height := 50; Path.StartFigure(); Path.AddArc(R, 0.0, -180.0); Path.AddLine(R.X, R.Y+25, R.X+25, R.Y+R.Height); Path.AddLine(R.X+25, R.Y+R.Height,R.X+R.Width, R.Y+25); Path.CloseFigure(); GraphicsGDIPlus.FillPath(SolidBrush, path); SolidBrush.Free; // РАБОТА С ИЗОБРАЖЕНИЕМ // Создаем Thumbnail (Мини просмотр). Image:= TGPImage.Create('FRUIT.JPG'); PThumbnail := Image.GetThumbnailImage(60, 48, nil, nil); GraphicsGDIPlus.DrawImage(pThumbnail, 0, 120, pThumbnail.GetWidth, pThumbnail.GetHeight); PThumbnail.Free; PThumbnail := Image.GetThumbnailImage(20, 20, nil, nil); GraphicsGDIPlus.DrawImage(pThumbnail, 70, 120, pThumbnail.GetWidth, pThumbnail.GetHeight); PThumbnail.Free; // Вывести изображение как есть. GraphicsGDIPlus.DrawImage(image, 0, 180); // Вывести изображение в область. R := MakeRect(220, 180, 320, 200); GraphicsGDIPlus.DrawImage(Image,R); // Вывести изображение в парралелограмм. GraphicsGDIPlus.DrawImage(Image, PPoint(@Grani), 3); Image.Free; GraphicsGDIPlus.Free; End;
| GDI+ — графическое ядро нового поколения |
Доброе время суток, уважаемые коллеги. В данной статье пойдет речь о многообещающем потомке стандартного графического интерфейса GDI имеющим соответствующее имя GDI+. Данное графическое ядро и основанный на ней графический интерфейс широко используется в новых операционных системах Windows XP и .NET Server.
Итак Что же такое GDI+ ?
Не вдаваясь в тонкости сразу скажу что GDI+ на самом деле является динамической библиотекой GdiPlus.dll. в которой реализованы команды и функции по работе с графикой, начиная от рисования линий заканчивая координатными преобразованиями и работой с прозрачностью. Как говорится на любой вкус. Более подробную информацию вы можете просмотреть в статье Виталия Брусенцева "GDI+: графика нового поколения" (если Вас не смущает реализация на C++).
Итак, после десятка лет царствования интерфейса GDI, появилась библиотека, призванная заменить устаревшую версию ядра и предоставляющею разработчикам все достоинства своего предшественника вкупе со множеством новых мощных возможностей. Как вы все знаете в DELPHI до сих пор используется библиотека GDI предоставляющая разработчику скудный (по сегодняшним меркам) набор функций для рисования, поэтому программистам приходится идти на всякие ухищрения при работе с графикой, используя DirectX, OpenGL или библиотеки доступа непосредственно к видеопамяти. Данная библиотека существенно упростить создание графических офисных приложений ( я намеренно сделал ставку на офисные, дабы избежать апологетов DirectX, OpenGL и пр.) Как я и говорил к сожалению в DELPHI не включили заголовки этой библиотеки, но это не беда силами сторонних разработчиков данные заголовки были созданы и для DELPHI.
Итак, для что нам надо чтобы использовать все прелести данной библиотеки.
Для начала давайте определимся, те кто работает на Windows XP и .NET Server. могут не беспокоится - данная библиотека уже включена в данные операционные системы. Для других увы - придется скачать с официального сервера Microsoft файл gdiplus_dnld.exe (размером чуть более 1 Mb) и при помощи него установить данную библиотеку в системный каталог Windows 98/ME, Windows NT SP6 или Windows 2000. Сразу-же оговорюсь что поддержка Windows 95 не предусмотрена и о ней нет никакого упоминания на сайте Microsoftа. Причем теоретически я могу предположить что данная библиотека может будет работать. Ну еще раз оговорюсь в Windows 95 пробуйте сами.
Итак файл успешно скачан, установлен и предвидя следующий вопрос сразу же говорю для работы с библиотекой вам потребуются заголовочные файлы для Delphi взять свежие можно с http://www.progdigy.com или скачать архив Header_pas.zip прилагаемый со статьей.
Ну, если у Вас все готово - продолжим.
Ниже приведена иерархия классов GDI+, опубликованная в статье Виталия Брусенцева. Там же можно прочесть некоторые подробности о классах, ее составляющих.
Итак для начала подключим заголовочные файлы GDI+ в uses модуль вашей программы
Code: Uses. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, ExtCtrls, ToolWin, GDIPAPI,GDIPOBJ; Как видите их всего два - GDIPAPI,GDIPOBJ; Продолжим , инициализируем библиотеку к работе - Для начала опишем ее. Var. GraphicsGDIPlus : TGPGraphics;
| GLScene. |
Легкий путь в GLScene.
Автор: gamebiztalk.
Первый материал в рубрике "Технологии" ставит своей целью рассказать о возможностях GLScene и оценить (качественно, на уровне кода и примеров) трудоемкость кодирования на примере демосцены или игры.
Конечно, GLScene сложно назвать игровым движком - это всего лишь объектная надстройка над OpenGL для Borland Delphi версий 4.0-7.0. Тем не менее, в ней есть все необходимые инструменты для управления камерами, текстурами, графическими моделями, анимацией, звуком, обработки коллизий и создания интерфейса пользователя. К несомненным плюсам GLScene относятся расширяемость, доступность исходных текстов графической библиотеки и качественная поддержка. Потому пусть вас не смущают мнения о том, что Borland Delphi не самое лучшее средство для разработки игр - по силам GLScene игры с вполне современной графикой. Библиотека поддерживает большое число функций от мультитекстурирования объектов различной формы, манипуляции осями координат и рендеринга ландшафтов по карте высот до трассировки лучей, теней в реальном времени и непременно шейдеров. Иными словами, с интересной идеей, опытным 3D-дизайнером и желанием довести проект до финала система Delphi и библиотека GLScene - не самые худшие варианты для Shareware- и недорогих коммерческих игр.
В GLScene, пожалуй, не все возможности удобны: дизайнер 3D-сцен, доступный в IDE, ограничен функционально, а, скажем, рендеринг ландшафтов довольно громоздок и запутан. С другой стороны, эта библиотека интересна тем, что в программах допускается использовать функции OpenGL и, как следствие, расширять и без того не маленькие ее возможности.
Внутри сцены
Стабильная версия библиотека GLScene и множество примеров доступна на сайте http://www.glscene.org/. Мы рекомендуем вам воспользоваться CVS-клиентом и получить самые последние версии модулей. Дело в том, что над совершенствованием библиотеки трудится множество программистов, и компоненты обновляются практически еженедельно. Следующее, что нужно сделать, загрузить документацию с сайта http://www.caperaven.co.za/ - в ней содержится краткое описание модулей и классов GLScene.
Установить GLScene довольно просто; надо лишь открыть соответствующий версии Delphi DPK-файл и нажать кнопку Install. Все модули будут скомпилированы, и в панели компонентов появится секция GLScene с множеством значков-компонентов. Основными являются компоненты GLScene для хранения иерархии визуальных 3D-объектов, GLSceneViewer для отображения сцены в оконном режиме и GLFullScreenViewer - в полноэкранном, GLCadencer для обновления сцены и обработки команд. Кроме того, вам могут понадобиться компоненты GLMaterialLibrary для хранения текстур и материалов и GLGuiLayout для построения интерфейса пользователя. Информация о прочих полезных компонентах собрана в списке.
GLMemoryViewer - служебный компонент для "невидимого" рендеринга 3D-объектов; этот компонент используется для некоторых специальных объектов, например, для расчета теней
ScreenSaver- компонент для создания экранных заставок
GLSDLViewer-компонент для отображения SDL-информации
GLPolygonPFXManager, GLPointLightPFXManager, GLFireFXManager, GLThorFXManager компоненты для управления визуальными эффектами
GLBitmapFont, GLWindowsBitmapFont компоненты для описания растрового или Windows-шрифта
GLBitmapHDS, GLCustomHDS, GLHeightTileFileHDS служебные компоненты для рендеринга ландшафтов
GLCollision компонент для обработки столкновений
GLSoundLibrary, GLSMWaveOut, GLSMFMMod, GLSMBass компоненты для работы со звуком
GLNavigator, GLUserInterface компоненты управление сценой и GUI-программы
Сконструировать простую сцену можно без программирования - пользуясь лишь инспектором свойств и редактором GLScene. Для каждой сцены надо определить объект-камеру, задать положение источника света и затем создать необходимое число 3D-объектов: плоскостей, кубов, сфер, торусов, порталов, ландшафтов и т.д. Ваши действия при этом таковы:
1. Создать новое приложение и поместить в форму компоненты GLScene и GLSceneViewer. Визуальный компонент при этом можно растянуть по всей области окна, задав значение alClient в свойстве Align.
2. Дважды щелкнуть по компоненту GLScene и в появившемся окне создать необходимые объекты: камеру, освещение и невидимый объект DummyCube. DummyCube позволяет группировать 3D-объекты по категориям. Например, все статичные наземные объекты можно расположить в одном DummyCube, а динамичные - в другом. Создание объектов выполняется из контекстного меню или кнопками Add camera/Add object.
Следует иметь ввиду, что каждый объект появляется в координатах с точками (0,0,0), Это не абсолютные, а относительные координаты. Скажем, если вы объявите объект DummyCube, сместите его в точку (2,3,4), а затем создадите объект GLCube, вложенный в DummyCube, то координаты (0,0,0) куба-наследника будут отсчитываться от точки (2,3,4) объекта-предка.
3. Для каждого объекта можно задать направление осей координат (свойство Direction), положение в пространстве (свойство Position) и ряд вспомогательных свойств, которые зависят от его типа. Например, вид проекции, способ освещения, размеры 3D-объекта и т.п.
4. Настроить свойство Material, в котором определяется цвет объекта или текстура, накладываемая на него. Для каждого объекта материалы можно настроить по отдельности, но лучше создать библиотеку материалов GLMaterialLibrary и ссылаться на нее при необходимости в свойствах MaterialLibrary и LibMaterialName.
5. Задать свойство Camera для GLSceneViewer - т.е. указать на одну из существующих камер (в GLScene можно определить несколько камер, но активной может быть только одна).
После этого можно запускать приложение и любоваться созданными вами 3D-объектами. Конечно, пока они неподвижно замерли в пространстве. Чтобы анимировать их - заставить вращаться по осям координат, менять размеры и положение в пространстве, надо ввести дополнительный код.
6. Добавить к форме компонент GLCadencer и в свойстве Scene сослаться на компонент GLScene.
7. Определить событие OnProgress и затем в нем задавать какие-то действия. Например, вращение объекта на 1 градус: object.Turn(1).
Подобным образом созданы многочисленные примеры к объектной библиотеке GLScene. Они сгруппированы по нескольким папкам - в каждой находятся несколько программ, объясняющих, как управлять 3D-объектами (папка Mesh) и материалами (папка Materials), создавать визуальные эффекты с помощью партиклов (папка SpecialFX), обрабатывать столкновения (папка Collision) и т.д. Знакомство с GLScene лучше начать с этих примеров - они позволяют разобраться с координатной системой, преобразованиями и перемещениями объектов в пространстве. Дополнительные примеры и даже небольшие игры доступны на сайте www.caperaven.co.za, а также в news-конференции на сервере talkto.net.
Тонкая ручная работа
Конструировать сцену можно и при исполнении программы. Это бывает необходимо для динамических сцен, когда геометрия уровня загружается из файлов или массивов и постоянно меняется. Инициализировать объекты GLScene можно в событии OnCreate главной формы, например:
Code. GLCameraMain:=TGLCamera(GLDummyCube1.AddNewChild(TGLCamera)); GLCameraMain.DepthOfView:=1000; GLCameraMain.FocalLength:=100; GLCameraMain.Direction.SetVector(0,0,-1); GLCameraMain.Position.SetPoint(0,128,0); GLCameraMain.Pitch(-45); GLLightMain:=TGLLightSource(GLCameraMain.AddNewChild(TGLLightSource)); GLLightMain.Position.SetPosition(5,15,-15);
Инициализацию объектов, загрузку моделей и текстур можно выделить в отдельные процедуры. Скажем, процедура LoadTextures загружает текстуры в память, а InitGLObjects - создает объекты с помощью метода AddNewChild. Состояние сцены, как уже говорилось, изменяется в событии OnProgress объекта GLCadencer. Здесь не только можно вращать объекты, но и обрабатывать нажатия клавиш. Если подключить к программе модуль Keyboard, то функцией IsKeyDown можно фиксировать нажатия и перемещать камеру:
Code. Speed:=0.1; If IsKeyDown(VK_UP) then. GLCamera1.Translate(speed, 0, speed); If IsKeyDown(VK_DOWN) then. GLCamera1.Translate(-speed, 0, speed);
| GROUPFILE и ADDITEM для групп |
Вот код для создания файла группы и добавления в группу файла-элемента. Чтобы использовать эту процедуру, определите DDE clientconv App как ProgMan.
| WinWord через DDE. |
Кто-нибудь пробовал использовать WinWord в качестве DDE-сервера? Поделитесь результатами, если они, конечно, успешны.
| Hапечатать все перестановки чисел 1..N. |
First = (1,2,...,N) Last = (N,N-1,...,1).
Всего таких перестановок будет N!=N*(N-1)*...*2*1 (докажите!). Для составления алгоритма Next зададимся вопросом: в каком случае i-ый член перестановки можно увеличить, не меняя предыдущих? Ответ: если он меньше какого-либо из следующих членов (членов с номерами больше i).
Мы должны найти наибольшее i, при котором это так, т.е. такое i, что X[i]<X[i+1]>...>X[N] (если такого i нет, то перестановка последняя). После этого X[i] нужно увеличить минимально возможным способом, т.е. найти среди X[i+1],...,X[N] наименьшее число, большее его. Поменяв X[i] с ним, остается расположить числа с номерами i+1,...,N так, чтобы перестановка была наименьшей, то есть в возрастающем порядке. Это облегчается тем, что они уже расположены в убывающем порядке:
Code: Procedure Next; Begin. {найти i: X[i]<X[i+1]>X[i+2]>...>X[N]}; {найти j: X[j]>X[i]>X[j+1]>...>X[N]}; {обменять X[i] и X[j]}; {X[i+1]>X[i+2]>...>X[N]}; {перевернуть X[i+1],X[i+2],...,X[N]}; End;
| Hапечатать все последовательности длины N из чисел 1,2..M. |
First = (1,1,...,1) Last = (M,M,...,M).
Всего таких последовательностей будет M^N (докажите!). Чтобы понять. как должна действовать процедура Next, начнем с примеров. Пусть N=4,M=3. Тогда:
Next(1,1,1,1) -> (1,1,1,2) Next(1,1,1,3) -> (1,1,2,1) Next(3,1,3,3) -> (3,2,1,1).
Теперь можно написать общую процедуру Next:
Code: Procedure Next; Begin. {найти i: X[i]<M,X[i+1]=M,...,X[N]=M}; X[i]:=X[i]+1; X[i+1]:=...:=X[N]:=1. End;
HeaderControl с дополнительной возможностью отображения стрелок.
| HeaderControl с дополнительной возможностью отображения стрелок |
Code: //////////////////////////////////////////////////////////////////////////////// // // **************************************************************************** // * Unit Name : GSHeaderControl. // * Purpose : Обычный HeaderControl с дополнительной возможностью отображения стрелок. // * Author : Александр (Rouse_) Багель. // * Version : 1.00. // **************************************************************************** // {©Drkb v.3(2007): www.drkb.ru}. Unit GSHeaderControl; Interface. Uses. Windows, Messages, SysUtils, Classes, Controls, ComCtrls, CommCtrl, Themes, Graphics; Const. HDF_SORTDOWN = $0200; HDF_SORTUP = $0400; Type. TGSSortDirection = (sdUp, sdDown); TGSHeaderControl = class(THeaderControl). Private. FSortSection: Integer; FSortDirection: TGSSortDirection; FUpDownBitmap: array [sdUp..sdDown] of TBitmap; Procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; Procedure SetSortDirection(const Value: TGSSortDirection); Procedure SetSortSection(const Value: Integer); Public. Constructor Create(AOwner: TComponent); override; Destructor Destroy; override; // Отрисовка стрелок через эти 2 свойства. // Секция в которой будем рисовать стрелку (для отключения стрелок, SortedSection := -1). Property SortedSection: Integer read FSortSection write SetSortSection; // Направление стрелки (вверх - вниз). Property SortDirection: TGSSortDirection read FSortDirection write SetSortDirection; End; Procedure Register; Implementation. Procedure Register; Begin. RegisterComponents('Samlpes', [TGSHeaderControl]); End; { TGSHeaderControl }. Constructor TGSHeaderControl.Create(AOwner: TComponent); Var. I: TGSSortDirection; Begin. Inherited; FSortSection := -1; FSortDirection := sdDown; For I := sdUp to sdDown do. Begin. FUpDownBitmap[I] := TBitmap.Create; FUpDownBitmap[I].Width := 14; FUpDownBitmap[I].Height := 14; FUpDownBitmap[I].Canvas.Brush.Color := clBtnFace; FUpDownBitmap[I].Canvas.Fillrect(Rect(0, 0, 14, 14)); FUpDownBitmap[I].Canvas.Font.Size := 14; FUpDownBitmap[I].Canvas.Font.Name := 'Marlett'; End; // Эти битматы для рисования стрелки при отключенных темах ХР. FUpDownBitmap[sdUp].Canvas.TextOut(0, -2, #53); FUpDownBitmap[sdDown].Canvas.TextOut(0, -2, #54); End; Destructor TGSHeaderControl.Destroy; Begin. FUpDownBitmap[sdUp].Free; FUpDownBitmap[sdDown].Free; Inherited; End; // Указываем направление стрелки (вверх - вниз). Procedure TGSHeaderControl.SetSortDirection(const Value: TGSSortDirection); Begin. FSortDirection := Value; SetSortSection(FSortSection); End; // Включаем стили для отрисовки стрелок. Procedure TGSHeaderControl.SetSortSection(const Value: Integer); Var. Item: THDItem; PreviosSelected: Integer; Direction: Integer; Begin. PreviosSelected := FSortSection; FSortSection := Value; If Sections.Count = 0 then Exit; If Value >= Sections.Count then Exit; // При включенных темах будем рисовать вот так: If ThemeServices.ThemesEnabled then. Begin. If FSortDirection = sdUp then. Direction := HDF_SORTUP. Else. Direction := HDF_SORTDOWN; Item.Mask := HDI_FORMAT; // Убираем предыдущую стрелку. If Header_GetItem(Handle, PreviosSelected, Item) then. If (Item.fmt and HDF_SORTUP) = HDF_SORTUP then. Begin. Item.fmt := Item.fmt xor HDF_SORTUP; Header_SetItem(Handle, PreviosSelected, Item); End; If (Item.fmt and HDF_SORTDOWN) = HDF_SORTDOWN then. Begin. Item.fmt := Item.fmt xor HDF_SORTDOWN; Header_SetItem(Handle, PreviosSelected, Item); End; // Рисуем новую. Item.Mask := HDI_FORMAT; Header_GetItem(Handle, FSortSection, Item); Item.fmt := Item.fmt or Direction; Header_SetItem(Handle, FSortSection, Item); End. Else. Begin // При выключенных темах, рисуем вот так: // Убираем предыдущую стрелку. Item.Mask := HDI_FORMAT or HDI_BITMAP; Header_GetItem(Handle, PreviosSelected, Item); If (Item.fmt and HDF_BITMAP_ON_RIGHT) = HDF_BITMAP_ON_RIGHT then. Item.fmt := Item.fmt xor HDF_BITMAP_ON_RIGHT; If (Item.fmt and HDF_BITMAP) = HDF_BITMAP then. Item.fmt := Item.fmt xor HDF_BITMAP; Header_SetItem(Handle, PreviosSelected, Item); // Рисуем новую. Item.Mask := HDI_FORMAT or HDI_BITMAP; Header_GetItem(Handle, FSortSection, Item); If (Item.fmt and HDF_BITMAP_ON_RIGHT) = HDF_BITMAP_ON_RIGHT then. Item.fmt := Item.fmt xor HDF_BITMAP_ON_RIGHT; If (Item.fmt and HDF_BITMAP) = HDF_BITMAP then. Item.fmt := Item.fmt xor HDF_BITMAP; Item.fmt := Item.fmt or HDF_BITMAP_ON_RIGHT or HDF_BITMAP; Item.hbm := FUpDownBitmap[FSortDirection].Handle; Header_SetItem(Handle, FSortSection, Item); End; End; // Включаем обработчик OnSectionClick при стиле hsFlat. Procedure TGSHeaderControl.WMLButtonDown(var Message: TWMLButtonDown); Var. Index: Integer; Info: THDHitTestInfo; Begin. Info.Point.X := Message.Pos.X; Info.Point.Y := Message.Pos.Y; Index := SendMessage(Handle, HDM_HITTEST, 0, Integer(@Info)); If (Index < 0) or (Info.Flags and HHT_ONHEADER = 0) or. Sections[Index].AllowClick then. Begin. Inherited; If Style = hsFlat then. If Index in [0 .. Sections.Count - 1] then. Self.OnSectionClick(Self, Sections[Index]); End; End; End.
©Drkb::00769.
Взято из http://forum.sources.ru.
Автор: Rouse_
Hello ISAPI.
© Delphi Web Development.
На этой страничке вы узнаете как создать и запустить простейшее ISAPI приложение сервера.
1. Запустите Delphi, нажмите на меню File | New.
2. В диалоговом окне New Items выберите Web Server Application и нажмите OK.
3. Появится диалоговое окно New Web Server Application. Пункт ISAPI/NSAPI Dynamic Link Library выбран по умолчанию, поэтому просто нажмите OK.
4. Вы попали в интерактивную среду разработки ISAPI расширения сервера.
В вашем проекте содержится специальный модуль WebModule, он позволяет помещать в него различные компоненты и обеспечивает работу с ними.
5. Дважды щелкните мышкой на WebModule, появится окно Action Editor, предназначенное для создания и редактирования обработчиков событий ActionItem.
6. В диалоговом окне Action Editor нажмите кнопку Add New, при этом в окне Object Inspector отобразятся свойства и события созданного ActionItem.
7. Установите свойство Default созданного ActionItem равным true.
8. Создайте обработчик события OnAction для созданного ActionItem и напишите в него код:
Response.Content := '<html><body>Hello ISAPI!</body></html>';
У вас должен получиться код приведенный в примере 1.
Пример 1.
Procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse;
Var Handled: Boolean);
Begin.
Response.Content := '<html><body>Hello ISAPI!</body></html>';
End;
9. Нажмите на меню File | Save All, выберите имена main.pas и helloisapi.dpr для файлов проекта и сохраните их на диск.
10. Нажмите на меню Project | Build helloisapi. Будет скомпилирован файл helloisapi.dll.
11. Поместите полученный файл в каталог для ISAPI DLL вашего веб сервера. Для IIS 4.0 это каталог /cgi-bin/. Проверьте установлено ли право execute на этот каталог в веб сервере и установите доступ на чтение и запуск для соответствующих пользователей в NTFS.
12.Запустите на выполнение ваше приложение, набрав в браузере полный URL. Например, если ваш сервер имеет URL http://localhost, вы положили DLL в каталог /cgi-bin/, то полный URL будет http://localhost/cgi-bin/helloisapi.dll.
©Drkb::03437.
| Hex --> BIN. |
Code: Function HexToBin(Hexadecimal: string): string; Const. BCD: array [0..15] of string = ('0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111', '1000', '1001', '1010', '1011', '1100', '1101', '1110', '1111'); Var. I: integer; Begin. For i := Length(Hexadecimal) downto 1 do. Result := BCD[StrToInt('$' + Hexadecimal[i])] + Result; End; Procedure TForm1.Button1Click(Sender: TObject); Begin. ShowMessage(HexToBin('FFA1')); // Returns 1111111110100001. End;
©Drkb::00943.
Взято с сайта: http://www.swissdelphicenter.ch.
Hex --> Char.
Code: Var. Str: Char; Begin. Str := 'В'; Form1.Caption := Format('%x', [Ord(Str)]); End;
©Drkb::00930.
DelphiWorld 6.0.
Hex --> Integer.
Code: Var. I : integer. S : string; Begin. S := '$'+'20FF'; I := StrToInt(a); End;
©Drkb::00937.
Взято из http://forum.sources.ru.
Code: CONST HEX : ARRAY['A'..'F'] OF INTEGER = (10,11,12,13,14,15); VAR. Str : String; Int, I : integer; BEGIN. READLN(str); Int := 0; FOR i := 1 TO Length(str) DO. IF str[i] < 'A' THEN. Int := Int * 16 + ORD(str[i]) - 48. ELSE. Int := Int * 16 + HEX[str[i]]; WRITELN(Int); READLN; END.
©Drkb::00938.
DelphiWorld 6.0.
Hidden or missing IDE.
Occasionally in Delphi 5 the IDE will 'disappear'. This is to say you will launch Delphi, and most or all of your IDE will not be visible. Delphi is clearly running and working, as you can still use your hot keys and run and compile a program, you just can't see such useful items such as the object inspector or your component tool bar.
This is caused by Delphi saving bogus information in its desktop preference files, or '.dsk' files. Delphi saves information about your environment options and settings in these files. In order to see your IDE again, all you need to do is delete these offending files. This will in no way harm Delphi or your project, as Delphi will dynamically generate these files as it needs them. You will however lose any environment settings that you had set previously.
©Drkb::00006.
Hint на системных кнопках, Как енто делается?
| Hint на системных кнопках, Как енто делается? |
Довольно сложный вопрос. Так просто не сделаешь. Нужно отлавливать WM_NCMOUSEMOVE и WM_NCHITTEST в них блокировать системный хинт и отрисовывать свой. Нет временипример делать. Но тут еще одно - если ты их решил модифицировать, то тебе нужно еще и два системных меню русифицировать. то которое в заголовке формы и то которое в тулбаре внизу. Это на порядок проще и делается вот таким кодом:
Code: Unit Unit1; {©Drkb v.3(2007): www.drkb.ru}. Interface. Uses. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; Type. TForm1 = class(TForm). Procedure FormCreate(Sender: TObject); End; Var. Form1: TForm1; Implementation. {$R *.dfm}. Procedure ChangeMenuLanguage(AHandle: THandle); Const. RusTranscriptionCount = 6; SysMenuID: array [0..RusTranscriptionCount - 1] of UINT = (SC_RESTORE, SC_MOVE, SC_SIZE, SC_MINIMIZE, SC_MAXIMIZE, SC_CLOSE); RusTranscription: array [0..RusTranscriptionCount - 1] of String = ( '&Восстановить', '&Переместить', '&Размер', '&Свернуть', 'Р&азвернуть', '&Закрыть'#9'Alt+F4'); Var. SysMenu: HMENU; MenuItem: TMenuItemInfo; ItemCount, I, A: Integer; MenuString: array [0..MAXCHAR - 1] of Char; Begin. SysMenu := GetSystemMenu(AHandle, False); If SysMenu <> 0 then. Begin. ItemCount := GetMenuItemCount(SysMenu); For I := 0 to ItemCount - 1 do. Begin. ZeroMemory(@MenuItem, SizeOf(TMenuItemInfo)); MenuItem.cbSize := SizeOf(TMenuItemInfo); MenuItem.fMask := MIIM_ID or MIIM_STRING or MIIM_BITMAP; MenuItem.dwTypeData := MenuString; MenuItem.cch := MAXCHAR; If GetMenuItemInfo(SysMenu, I, True, MenuItem) then. For A := 0 to RusTranscriptionCount - 1 do. If SysMenuID[A] = MenuItem.wID then. Begin. MenuItem.dwTypeData := PChar(RusTranscription[A]); MenuItem.cch := Length(RusTranscription[A]); If not SetMenuItemInfo(SysMenu, I, True, MenuItem) then RaiseLastOSError; End; End; End; End; Procedure TForm1.FormCreate(Sender: TObject); Begin. ChangeMenuLanguage(Handle); ChangeMenuLanguage(Application.Handle); End;
Взято из http://forum.sources.ru.
Автор: Rouse_
©Drkb::01285.
| HKey --> String? |
Code: Const. HKEYNames: array[0..6] of string = ('HKEY_CLASSES_ROOT', 'HKEY_CURRENT_USER', 'HKEY_LOCAL_MACHINE', 'HKEY_USERS', 'HKEY_PERFORMANCE_DATA', 'HKEY_CURRENT_CONFIG', 'HKEY_DYN_DATA'); Function HKEYToStr(const Key: HKEY): string; Begin. If (key < HKEY_CLASSES_ROOT) or (key > HKEY_CLASSES_ROOT+6) then. Result := '' Else. Result := HKEYNames[key - HKEY_CLASSES_ROOT]; End;
| Hook на буфер обмена |
Code: { *Just create a new form and call it ClipFormats. *Drop a TButton and call it btnUpdate. *Drop a TListBox and call it lbFormats. Then just add the code below and hook up all the event handlers. All it does is display all the formats currently on the clipboard and. Updates as soon as the clipboard changes. } Unit DynaClip; Interface. Uses. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; Type. TClipFormats = class(TForm). BtnUpdate: TButton; LbFormats: TListBox; Procedure FormCreate(Sender: TObject); Procedure FormDestroy(Sender: TObject); Procedure btnUpdateClick(Sender: TObject); Private. { Private declarations }. NextWindow: HWND; Procedure WMChangeCBChain(var Message: TWMChangeCBChain); message. WM_CHANGECBCHAIN; Procedure WMDrawClipboard(var Message: TWMDrawClipboard); message. WM_DRAWCLIPBOARD; Public. { Public declarations }. End; Var. ClipFormats: TClipFormats; Implementation. {$R *.DFM}. Procedure TMDIChildClipFormats.FormCreate(Sender: TObject); Begin. NextWindow := SetClipboardViewer(Handle); End; Procedure TClipFormats.FormDestroy(Sender: TObject); Begin. ChangeClipboardChain(Handle, NextWindow); End; Procedure TClipFormats.WMChangeCBChain(var Message: TWMChangeCBChain); Begin. With Message do. Begin. If (Remove = NextWindow) then. Begin. NextWindow := Next; End. Else. Begin. SendMessage(NextWindow, WM_CHANGECBCHAIN, Remove, Next); End; End; End; Procedure TClipFormats.WMDrawClipboard(var Message: TWMDrawClipboard); Begin. BtnUpdate.Click; SendMessage(NextWindow, WM_DRAWCLIPBOARD, 0, 0); End; Procedure TClipFormats.btnUpdateClick(Sender: TObject); Const. PreDefinedFormats: array[1..16] of string = ('CF_TEXT', 'CF_BITMAP', 'CF_METAFILEPICT', 'CF_SYLK', 'CF_DIF', 'CF_TIFF', 'CF_OEMTEXT', 'CF_DIB', 'CF_PALETTE', 'CF_PENDATA', 'CF_RIFF', 'CF_WAVE', 'CF_UNICODETEXT', 'CF_ENHMETAFILE', 'CF_HDROP', 'CF_LOCALE'); Var. ClipFormat: TClipFormat; SzBuffer: array[0..511] of Char; FormatID: string; Begin. If not OpenClipboard(Handle) then Exit; Try. LbFormats.Items.BeginUpdate; Try. LbFormats.Items.Clear; ClipFormat := EnumClipboardFormats(0); While (ClipFormat <> 0) do. Begin. If (ClipFormat in [1..16]) then. Begin. FormatID := PreDefinedFormats[ClipFormat]; End. Else. Begin. GetClipboardFormatName(ClipFormat, szBuffer, SizeOf(szBuffer)); FormatID := string(szBuffer); End; LbFormats.Items.Add(Format('%s [%d]', [FormatID, ClipFormat])); ClipFormat := EnumClipboardFormats(ClipFormat); End; Finally. LbFormats.Items.EndUpdate; End; Finally. CloseClipboard; End; End; End.
| How do I create an executible file using the command line directive in Linux with Kylix? |
How do I create an executable file, i.e. foo.exe, using dcc in Kylix?
Create the project file, i.e. foo.dpr, using VI, Pico or some other text writing tool. Next, at the command line type: dcc foo. You can pass in flags like -BE: dcc -BE foo, the will build and execute the file. There are a number of different flags you can pass in, look at the help for dcc for a full listing and description.
Code: Program foo. Uses. SysUtils; Begin. Writeln('Hello World'); Readln; End.
| How immediately start a service after its installation? |
Code: { To automatically start a service after its installation use this code }. Procedure TMyService.ServiceAfterInstall(Sender: TService); Var. Sm: TServiceManager; Begin. Sm := TServiceManager.Create; Try. If sm.Connect then. If sm.OpenServiceConnection(self.name) then. Sm.StartService; Finally. Sm.Free; End; End;
| How to add alternative text to a Webbrowser image? |
Code: { Alternative Text for a image of a TWebBrowser }. Procedure TForm1.Button1Click(Sender: TObject); Var. HTMLDocument2Ifc: IHTMLDocument2; HTMLSelectionObjectIfc: IHTMLSelectionObject; HTMLTxtRangeIfc: IHTMLTxtRange; Begin. HTMLDocument2Ifc := WebBrowser1.Document as IHTMLDocument2; HTMLDocument2Ifc.execCommand('InsertImage', False, ''); HTMLSelectionObjectIfc := HTMLDocument2Ifc.selection; If HTMLSelectionObjectIfc.type_ = 'Control' then HTMLSelectionObjectIfc.Clear; HTMLTxtRangeIfc := HTMLSelectionObjectIfc.createRange as IHTMLTxtRange; HTMLTxtRangeIfc.pasteHTML('<image alt="Hello" src="c:\test.gif"> '); End;
How to check, if a CD-Recorder is available? (WinXP).
Code: {....} Uses Registry; {....} Function HasCDRecorder: Boolean; Var. Reg: TRegistry; Begin. Reg := TRegistry.Create; Try. // set the the Mainkey, Reg.RootKey := HKEY_CURRENT_USER; // Open a key. Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\CD Burning', False); // Check if the Key exists. Result := reg.ValueExists('CD Recorder Drive'); // Close the key. Reg.CloseKey; Finally. // and free the TRegistry Object. Reg.Free; End; End; // Example: Procedure TForm1.Button1Click(Sender: TObject); Begin. If HasCDRecorder then. ShowMessage('CD-Recorder available.'). Else. ShowMessage('CD-Recorder NOT available.'); End;
©Drkb::01407.
Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php.
How to check if the Workstation is locked?
Code: Function IsWorkstationLocked: Boolean; Var. HDesktop: HDESK; Begin. Result := False; HDesktop := OpenDesktop('default', 0, False, DESKTOP_SWITCHDESKTOP); If hDesktop <> 0 then. Begin. Result := not SwitchDesktop(hDesktop); CloseDesktop(hDesktop); End; End;
©Drkb::01698.
Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php.
How to debug an Apache Shared Module.
I am running Apache on Windows and want to know how to debug Apache Shared Modules?
It is a straight forward task to debug Shared Modules in Delphi. The only thing that needs to be done is to set the Host Application and Parameters for the Shared Module's Project. From the Delphi menu bar go to Run | Parameters. Set the Host Application to point to Apache.exe, and specify the following parameters: -X -w -f "c:\path tohttpd.conf".
When you run the project be sure that IIS is not running. If you need IIS to run while Apache is running then change the Port value stored in httpd.conf.
©Drkb::03429.
| How to get all the resource names that are loaded in a given application? |
Code: Type. TForm1 = class(TForm). Button1: TButton; Memo1: TMemo; Procedure Button1Click(Sender: TObject); Private. End; Var. Form1: TForm1; Implementation. {$R *.dfm}. Function enumResNamesProc(module: HMODULE; restype, resname: PChar; List: TStrings): Integer; stdcall; Begin. If HiWord(Cardinal(resname)) <> 0 then. List.Add(' ' + resname). Else. List.Add(Format(' #%d', [loword(Cardinal(resname))])); Result := 1; End; Function StockResourceType(restype: PChar): string; Const. Restypenames: Array [1..22] of String = ( 'RT_CURSOR', // = MakeIntResource(1); 'RT_BITMAP', // = MakeIntResource(2); 'RT_ICON', // = MakeIntResource(3); 'RT_MENU', // = MakeIntResource(4); 'RT_DIALOG', // = MakeIntResource(5); 'RT_STRING', // = MakeIntResource(6); 'RT_FONTDIR',// = MakeIntResource(7); 'RT_FONT', // = MakeIntResource(8); 'RT_ACCELERATOR',// = MakeIntResource(9); 'RT_RCDATA', // = MakeIntResource(10); 'RT_MESSAGETABLE',// = MakeIntResource(11); // DIFFERENCE = 11; 'RT_GROUP_CURSOR',// = MakeIntResource(DWORD(RT_CURSOR +7DIFFERENCE)); 'UNKNOWN', // 13 not used. 'RT_GROUP_ICON', // = MakeIntResource(DWORD(RT_ICON +DIFFERENCE)); 'UNKNOWN', // 15 not used. 'RT_VERSION', // = MakeIntResource(16); 'RT_DLGINCLUDE', // = MakeIntResource(17); 'UNKNOWN', 'RT_PLUGPLAY', // = MakeIntResource(19); 'RT_VXD', // = MakeIntResource(20); 'RT_ANICURSOR', // = MakeIntResource(21); 'RT_ANIICON' // = MakeIntResource(22); ); Var. Resid: Cardinal absolute restype; Begin. If resid in [1..22] then. Result := restypenames[resid]. Else. Result := 'UNKNOWN'; End; Function enumResTypesProc(module: HMODULE; restype: PChar; list: TStrings): Integer; stdcall; Begin. If HiWord(Cardinal(restype)) <> 0 then. List.Add(restype). Else. List.Add(Format('Stock type %d: %s', [LoWord(Cardinal(restype)), StockResourcetype(restype)])); EnumResourceNames(module, restype, @enumResNamesProc, Integer(list)); Result := 1; End; Procedure TForm1.Button1Click(Sender: TObject); Begin. Memo1.Clear; If not EnumResourceTypes(hinstance, @enumResTypesProc, Integer(memo1.Lines)) then. Memo1.Lines.Add(Format('GetLastError= %8.8x', [GetLastError])). Else. Memo1.Lines.Add('Successful'); End; End.
| How to get the NT Domain and UserName of a Process? |
Code: Uses. TlHelp32; Type. PTOKEN_USER = ^TOKEN_USER; _TOKEN_USER = record. User: TSidAndAttributes; End; TOKEN_USER = _TOKEN_USER; Function GetUserAndDomainFromPID(ProcessId: DWORD; Var User, Domain: string): Boolean; Var. HToken: THandle; CbBuf: Cardinal; PtiUser: PTOKEN_USER; Snu: SID_NAME_USE; ProcessHandle: THandle; UserSize, DomainSize: DWORD; BSuccess: Boolean; Begin. Result := False; ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId); If ProcessHandle <> 0 then. Begin. // EnableProcessPrivilege(ProcessHandle, 'SeSecurityPrivilege', True); If OpenProcessToken(ProcessHandle, TOKEN_QUERY, hToken) then. Begin. BSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf); PtiUser := nil; While (not bSuccess) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) do. Begin. ReallocMem(ptiUser, cbBuf); BSuccess := GetTokenInformation(hToken, TokenUser, ptiUser, cbBuf, cbBuf); End; CloseHandle(hToken); If not bSuccess then. Begin. Exit; End; UserSize := 0; DomainSize := 0; LookupAccountSid(nil, ptiUser.User.Sid, nil, UserSize, nil, DomainSize, snu); If (UserSize <> 0) and (DomainSize <> 0) then. Begin. SetLength(User, UserSize); SetLength(Domain, DomainSize); If LookupAccountSid(nil, ptiUser.User.Sid, PChar(User), UserSize, PChar(Domain), DomainSize, snu) then. Begin. Result := True; User := StrPas(PChar(User)); Domain := StrPas(PChar(Domain)); End; End; If bSuccess then. Begin. FreeMem(ptiUser); End; End; CloseHandle(ProcessHandle); End; End; Procedure TForm1.Button1Click(Sender: TObject); Var. HProcSnap: THandle; Pe32: TProcessEntry32; Domain, User: string; S: string; Begin. HProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPALL, 0); If hProcSnap = INVALID_HANDLE_VALUE then Exit; Pe32.dwSize := SizeOf(ProcessEntry32); If Process32First(hProcSnap, pe32) = True then. While Process32Next(hProcSnap, pe32) = True do. Begin. If GetUserAndDomainFromPID(pe32.th32ProcessID, User, Domain) then. Begin. S := Format('%s User: %s ; Domain: %s',[StrPas(pe32.szExeFile), User, Domain]); Listbox1.Items.Add(s); End else. Listbox1.Items.Add(StrPas(pe32.szExeFile)); End; CloseHandle(hProcSnap); End;
| How to implement a microsecond resolution Delay? |
Code: // Wait 0.2ms. Procedure PerformanceDelay; Var. HrRes, hrT1, hrT2, dif: Int64; Begin. If QueryPerformanceFrequency(hrRes) then. Begin. QueryPerformanceCounter(hrT1); Repeat. QueryPerformanceCounter(hrT2); Dif := (hrT2 - hrT1) * 10000000 div hrRes; Until dif > 2; End; End;
| How to patch a process? |
Code: {....} Var. WindowName: Integer; ProcessId: Integer; ThreadId: Integer; Buf: PChar; HandleWindow: Integer; Write: Cardinal; {....} Const. WindowTitle = 'a program name'; Address = $A662D6; PokeValue = $4A; NumberOfBytes = 2; {....} Procedure TForm1.Button1Click(Sender: TObject); Begin. WindowName := FindWindow(nil, WindowTitle); If WindowName = 0 then. Begin. MessageDlg('Program not running.', mtWarning, [mbOK], 0); End; ThreadId := GetWindowThreadProcessId(WindowName, @ProcessId); HandleWindow := OpenProcess(PROCESS_ALL_ACCESS, False, ProcessId); GetMem(buf, 1); Buf^ := Chr(PokeValue); WriteProcessMemory(HandleWindow, ptr(Address), buf, NumberOfBytes, Write); FreeMem(buf); CloseHandle(HandleWindow); End;
| How to render a TRichEdit text onto a canvas? |
Code: Procedure RichEditToCanvas(RichEdit: TRichEdit; Canvas: TCanvas; PixelsPerInch: Integer); Var. ImageCanvas: TCanvas; Fmt: TFormatRange; Begin. ImageCanvas := Canvas; With fmt do. Begin. Hdc:= ImageCanvas.Handle; HdcTarget:= hdc; // rect needs to be specified in twips (1/1440 inch) as unit. Rc:= Rect(0, 0, ImageCanvas.ClipRect.Right * 1440 div PixelsPerInch, ImageCanvas.ClipRect.Bottom * 1440 div PixelsPerInch. ); RcPage:= rc; Chrg.cpMin := 0; Chrg.cpMax := RichEdit.GetTextLen; End; SetBkMode(ImageCanvas.Handle, TRANSPARENT); RichEdit.Perform(EM_FORMATRANGE, 1, Integer(@fmt)); // next call frees some cached data. RichEdit.Perform(EM_FORMATRANGE, 0, 0); End; Procedure TForm1.Button1Click(Sender: TObject); Begin. RichEditToCanvas(RichEdit1, Image1.Canvas, Self.PixelsPerInch); Image1.Refresh; End;
How to run executables created in Kylix.
Kylix produces ELF binaries so in order to run them outside the IDE you need to first run 'source kylixpath' in the kylix2/bin directory. This sets up the necessary environment variables. Then, in a command window, go the directory where your compiled binary is and enter ./Project1 if your executable is called Project1.
©Drkb::04603.
| How to scale bitmap by percent? |
Code: { .... } Private. Function ScalePercentBmp(bitmp: TBitmap; iPercent: Integer): Boolean; { .... } Function TForm1.ScalePercentBmp(bitmp: TBitmap; IPercent: Integer): Boolean; Var. TmpBmp: TBitmap; ARect: TRect; H, w: Real; Hi, wi: Integer; Begin. Result := False; Try. TmpBmp := TBitmap.Create; Try. H := bitmp.Height * (iPercent / 100); W := bitmp.Width * (iPercent / 100); Hi := StrToInt(FormatFloat('#', h)) + bitmp.Height; Wi := StrToInt(FormatFloat('#', w)) + bitmp.Width; TmpBmp.Width := wi; TmpBmp.Height := hi; ARect := Rect(0, 0, wi, hi); TmpBmp.Canvas.StretchDraw(ARect, Bitmp); Bitmp.Assign(TmpBmp); Finally. TmpBmp.Free; End; Result := True; Except. Result := False; End; End;
How to turn off ISAPI DLL caching on Windows 2000 and IIS5.
You may want to turn off DLL caching to allow you to better debug ISAPI DLL's. Note that if you do turn it off, it is best to turn it back on when you are ready to use your DLL as it greatly improves performance.
Click on Start->Settings->Control Panel->Administrative Tools->Internet Services Manager. Right click on your website and select Properties:
[IIS Manager Screen Shot].
Select the "Home Directory" tab, and click on Configuration...:
[Configuration].
Uncheck "Cache ISAPI applications":
[uncheck cache extensions].
©Drkb::03430.
| How to check for unread email. |
Code: Var. Inbox: MAPIFolder; NewMail: boolean; ... Inbox := NmSpace.GetDefaultFolder(olFolderInbox); NewMail := (Inbox.UnreadItemCount > 0); If NewMail then. ShowMessage(Format('Unread items in Inbox: %d', [Inbox.UnreadItemCount]));
| How to check for unsent email. |
Code: Var. Outbox: MAPIFolder; UnsentMail: integer; ... Outbox := NmSpace.GetDefaultFolder(olFolderOutbox); UnsentMail := Outbox.Items.Count; If (UnsentMail > 0) then. ShowMessage(Format('Unsent items in Outbox: %d', [UnsentMail]));
How to close a database.
Access.CloseCurrentDatabase;
©Drkb::02743.
How to close a presentation.
PowerPoint.ActivePresentation.Close;
©Drkb::04458.
| How to close PowerPoint. |
Early binding:
Code: PowerPoint.Quit; PowerPoint := nil;
| How to list all reports and forms. |
Once you've opened a database, you can use the Access application's Reports and Forms properties to list the open reports and forms:
Code: For i := 0 to Access.Reports.Count - 1 do. Memo1.Lines.Add(Access.Reports[i].Name); For i := 0 to Access.Forms.Count - 1 do. Memo1.Lines.Add(Access.Forms[i].Name);
| How to open a database. |
Assuming an application variable, Access:
Code: Access.OpenCurrentDatabase('C:\My Documents\Books.mdb', True);
How to open a presentation.
PowerPoint.Presentations.Open('PresName.ppt', msoFalse, msoFalse, msoTrue);
The second parameter specifies whether the presentation should be opened in read-only mode. If the third parameter is True, an untitled copy of the file is made. The last parameter specifies whether the opened presentation should be visible. You can miss these parameters out in late binding if you're happy with the defaults (False, False, True, respectively, as in the code shown.).
©Drkb::04460.
How to open a report.
Access.DoCmd.OpenReport('Titles by Author', acViewPreview, EmptyParam, EmptyParam);
{
Const.
AcViewNormal = $00000000;
AcViewDesign = $00000001;
AcViewPreview = $00000002;
}
©Drkb::02744.
| How to save a presentation. |
PowerPoint.Save;
Or for SaveAs:
Code: Var. EmbedFonts: OleVariant; Begin. EmbedFonts := False; PowerPoint.ActivePresentation.SaveAs('PresName.ppt', ppSaveAsPresentation, EmbedFonts);
| How to send and receive email. |
This code activates the Tools|Send and Receive|All accounts menu item:
Code: Uses Office_TLB; // Office97 for D5 users. Var. ToolsMenu: CommandBar; SendRecMenuItem, AllAccs: CommandBarControl; Begin. ToolsMenu := (Outlook.ActiveExplorer.CommandBars as CommandBars).Item['Tools']; // D5 users can omit the underscore after 'Controls' in the next two lines. SendRecMenuItem := ToolsMenu.Controls_['Send and Receive']; AllAccs := (SendRecMenuItem.Control as CommandBarPopup).Controls_['All Accounts']; AllAccs.Execute;
How to start a new presentation.
PowerPoint.Presentations.Open('PresName.ppt', msoFalse, msoFalse, msoTrue);
The second parameter specifies whether the presentation should be opened in read-only mode. If the third parameter is True, an untitled copy of the file is made. The last parameter specifies whether the opened presentation should be visible. You can miss these parameters out in late binding if you're happy with the defaults (False, False, True, respectively, as in the code shown.).
©Drkb::04461.
| How to start Outlook. |
There are several different ways to start Outlook from your Delphi app.
· Using D5's components
· Using the type library (early binding)
· Without using the type library (late binding)
You'll notice that just starting up the Outlook application is not enough to get going - you also have to get the namespace and call its Logon method, like this:
NmSpace.Logon('', '', False, False);
I've used this line in the following code snippets, but note that you may have to supply different arguments to this method if you have user profiles set up on your computer. The Logon method takes four parameters: the first two, Profile and Password, are self-explanatory. The third, ShowDialog, lets you display a logon dialog for the user. If the fourth, NewSession, is set to True, a new MAPI session is started, rather than connecting to an existing one.
Bear in mind that when you've logged on you still won't see Outlook - until you display a folder, as shown in the following examples.
Using Delphi 5's components.
Drop an OutlookApplication component on your form. When you want Outlook to start, use its Connect method:
Code: Var. NmSpace: NameSpace; Folder: MAPIFolder; ... OutlookApplication1.Connect; NmSpace := OutlookApplication1.GetNamespace('MAPI'); NmSpace.Logon('', '', False, False); Folder := NmSpace.GetDefaultFolder(olFolderInbox); Folder.Display;
| HTML --> RTF. |
Code: { HTML to RTF by Falk Schulze }. Procedure HTMLtoRTF(html: string; var rtf: TRichedit); Var. I, dummy, row: Integer; Cfont: TFont; Tag, tagparams: string; Params: TStringList; Function GetTag(s: string; var i: Integer; var Tag, tagparams: string): Boolean; Var. A_tag: Boolean; Begin. GetTag := False; Tag := ''; Tagparams := ''; A_tag := False; While i <= Length(s) do. Begin. Inc(i); If s[i] = '<' then. Begin. GetTag := False; Exit; End; If s[i] = '>' then. Begin. GetTag := True; Exit; End; If not a_tag then. Begin. If s[i] = ' ' then. Begin. If Tag <> '' then a_tag := True; End. Else. Tag := Tag + s[i]; End. Else. Tagparams := tagparams + s[i]; End; End; Procedure GetTagParams(tagparams: string; var params: TStringList); Var. I: Integer; S: string; Gleich: Boolean; Function notGleich(s: string; i: Integer): Boolean; Begin. NotGleich := True; While i <= Length(s) do. Begin. Inc(i); If s[i] = '=' then. Begin. NotGleich := False; Exit; End. Else if s[i] <> ' ' then Exit; End; End; Begin. Params.Clear; S := ''; For i := 1 to Length(tagparams) do. Begin. If (tagparams[i] <> ' ') then. Begin. If tagparams[i] <> '=' then gleich := False; If (tagparams[i] <> '''') and (tagparams[i] <> '"') then s := s + tagparams[i]. End. Else. Begin. If (notGleich(tagparams, i)) and (not Gleich) then. Begin. Params.Add(s); S := ''; End. Else. Gleich := True; End; End; Params.Add(s); End; Function HtmlToColor(Color: string): TColor; Begin. Result := StringToColor('$' + Copy(Color, 6, 2) + Copy(Color, 4, 2) + Copy(Color, 2, 2)); End; Procedure TransformSpecialChars(var s: string; i: Integer); Var. C: string; Z, z2: Byte; I2: Integer; Const. Nchars = 9; Chars: array[1..nchars, 1..2] of string = (('O', 'O'), ('o', 'o'), ('A', 'A'), ('a', 'a'), ('U', 'U'), ('u', 'u'), ('?', '?'), ('<', '<'), ('>', '>')); Begin. C := ''; I2 := i; For z := 1 to 7 do. Begin. C := c + s[i2]; For z2 := 1 to nchars do. Begin. If chars[z2, 1] = c then. Begin. Delete(s, i, Length(c)); Insert(chars[z2, 2], s, i); Exit; End; End; Inc(i2); End; End; Function CalculateRTFSize(pt: Integer): Integer; Begin. Case pt of. 1: Result := 6; 2: Result := 9; 3: Result := 12; 4: Result := 15; 5: Result := 18; 6: Result := 22; Else. Result := 30; End; End; Type. Fontstack = record. Font: array[1..100] of tfont; Pos: Byte; End; Procedure CreateFontStack(var s: fontstack); Begin. S.Pos := 0; End; Procedure PushFontStack(var s: Fontstack; fnt: TFont); Begin. Inc(s.Pos); S.Font[s.Pos] := TFont.Create; S.Font[s.Pos].Assign(fnt); End; Procedure PopFontStack(var s: Fontstack; var fnt: TFont); Begin. If (s.Font[s.Pos] <> nil) and (s.Pos > 0) then. Begin. Fnt.Assign(s.Font[s.Pos]); S.Font[s.Pos].Free; Dec(s.Pos); End; End; Procedure FreeFontStack(var s: Fontstack); Begin. While s.Pos > 0 do. Begin. S.Font[s.Pos].Free; Dec(s.Pos); End; End; Var. Fo_cnt: array[1..1000] of tfont; Fo_liste: array[1..1000] of Boolean; Fo_pos: TStringList; Fo_stk: FontStack; Wordwrap, liste: Boolean; Begin. CreateFontStack(fo_Stk); Fo_Pos := TStringList.Create; Rtf.Lines.BeginUpdate; Rtf.Lines.Clear; Wordwrap := rtf.wordwrap; Rtf.WordWrap := False; Rtf.Lines.Add(''); Params := TStringList.Create; Cfont := TFont.Create; Cfont.Assign(rtf.Font); I := 1; Row := 0; Liste := False; Rtf.selstart := 0; If Length(html) = 0 then Exit; Repeat; If html[i] = '<' then. Begin. Dummy := i; GetTag(html, i, Tag, tagparams); GetTagParams(tagparams, params); If Uppercase(Tag) = 'FONT' then. Begin. PushFontstack(fo_stk, cfont); If params.Values['size'] <> '' then. Cfont.Size := CalculateRTFSize(StrToInt(params.Values['size'])); If params.Values['color'] <> '' then cfont.Color := Htmltocolor(params.Values['color']); End. Else if Uppercase(Tag) = '/FONT' then popFontstack(fo_stk, cfont). Else. If Uppercase(Tag) = 'H1' then. Begin. PushFontstack(fo_stk, cfont); Cfont.Size := 6; End. Else if Uppercase(Tag) = '/H1' then popFontstack(fo_stk, cfont). Else. If Uppercase(Tag) = 'H2' then. Begin. PushFontstack(fo_stk, cfont); Cfont.Size := 9; End. Else if Uppercase(Tag) = '/H2' then popFontstack(fo_stk, cfont). Else. If Uppercase(Tag) = 'H3' then. Begin. PushFontstack(fo_stk, cfont); Cfont.Size := 12; End. Else if Uppercase(Tag) = '/H3' then popFontstack(fo_stk, cfont). Else. If Uppercase(Tag) = 'H4' then. Begin. PushFontstack(fo_stk, cfont); Cfont.Size := 15; End. Else if Uppercase(Tag) = '/H4' then popFontstack(fo_stk, cfont). Else. If Uppercase(Tag) = 'H5' then. Begin. PushFontstack(fo_stk, cfont); Cfont.Size := 18; End. Else if Uppercase(Tag) = '/H5' then popFontstack(fo_stk, cfont). Else. If Uppercase(Tag) = 'H6' then. Begin. PushFontstack(fo_stk, cfont); Cfont.Size := 22; End. Else if Uppercase(Tag) = '/H6' then popFontstack(fo_stk, cfont). Else. If Uppercase(Tag) = 'H7' then. Begin. PushFontstack(fo_stk, cfont); Cfont.Size := 27; End. Else if Uppercase(Tag) = '/H7' then popFontstack(fo_stk, cfont). Else. If Uppercase(Tag) = 'B' then cfont.Style := cfont.Style + [fsbold]. Else if Uppercase(Tag) = '/B' then cfont.Style := cfont.Style - [fsbold]. Else. If Uppercase(Tag) = 'I' then cfont.Style := cfont.Style + [fsitalic]. Else if Uppercase(Tag) = '/I' then cfont.Style := cfont.Style - [fsitalic]. Else. If Uppercase(Tag) = 'U' then cfont.Style := cfont.Style + [fsunderline]. Else if Uppercase(Tag) = '/U' then cfont.Style := cfont.Style - [fsunderline]. Else. If Uppercase(Tag) = 'UL' then liste := True. Else if Uppercase(Tag) = '/UL' then. Begin. Liste := False; Rtf.Lines.Add(''); Inc(row); Rtf.Lines.Add(''); Inc(row); End. Else. If (Uppercase(Tag) = 'BR') or (Uppercase(Tag) = 'LI') then. Begin. Rtf.Lines.Add(''); Inc(row); End; // else rtf.Lines[row]:=RTF.lines[row]+'<'+tag+' '+tagparams+'>'; Fo_pos.Add(IntToStr(rtf.selstart)); Fo_cnt[fo_pos.Count] := TFont.Create; Fo_cnt[fo_pos.Count].Assign(cfont); Fo_liste[fo_pos.Count] := liste; End. Else. Begin. If html[i] = '&' then Transformspecialchars(html, i); If (Ord(html[i]) <> 13) and (Ord(html[i]) <> 10) then. Rtf.Lines[row] := RTF.Lines[row] + html[i]; End; Inc(i); Until i >= Length(html); Fo_pos.Add('999999'); For i := 0 to fo_pos.Count - 2 do. Begin. Rtf.SelStart := StrToInt(fo_pos[i]); Rtf.SelLength := StrToInt(fo_pos[i + 1]) - rtf.SelStart; Rtf.SelAttributes.Style := fo_cnt[i + 1].Style; Rtf.SelAttributes.Size := fo_cnt[i + 1].Size; Rtf.SelAttributes.Color := fo_cnt[i + 1].Color; Fo_cnt[i + 1].Free; End; I := 0; While i <= fo_pos.Count - 2 do. Begin. If fo_liste[i + 1] then. Begin. Rtf.SelStart := StrToInt(fo_pos[i + 1]); While fo_liste[i + 1] do Inc(i); Rtf.SelLength := StrToInt(fo_pos[i - 1]) - rtf.SelStart; Rtf.Paragraph.Numbering := nsBullet; End; Inc(i); End; Rtf.Lines.EndUpdate; Params.Free; Cfont.Free; Rtf.WordWrap := wordwrap; FreeFontStack(fo_stk); End;
| Пример HTTP Get - загружаем файлы и страницы из Интернета. |
Code: {*************************************************************} { HTTPGet component for Delphi 32 }. { Version: 1.94 }. { E-Mail: info@utilmind.com }. { WWW: http://www.utilmind.com }. { Created: October 19, 1999 }. { Modified: June 6, 2000 }. { Legal: Copyright (c) 1999-2000, UtilMind Solutions }. {*************************************************************} { PROPERTIES: }. { Agent: String - User Agent }. { } {* BinaryData: Boolean - This setting specifies which type }. {* of data will taken from the web. }. {* If you set this property TRUE then }. {* component will determinee the size }. {* of files *before* getting them from }. {* the web. }. {* If this property is FALSE then as we}. {* do not knows the file size the }. {* OnProgress event will doesn't work. }. {* Also please remember that is you set}. {* this property as TRUE you will not }. {* capable to get from the web ASCII }. {* data and ofter got OnError event. }. { } { FileName: String - Path to local file to store the data }. { taken from the web }. { Password, UserName - set this properties if you trying to }. { get data from password protected }. { directories. }. { Referer: String - Additional data about referer document }. { URL: String - The url to file or document }. { UseCache: Boolean - Get file from the Internet Explorer's }. { cache if requested file is cached. }. {*************************************************************} { METHODS: }. { GetFile - Get the file from the web specified in the URL }. { property and store it to the file specified in }. { the FileName property }. { GetString - Get the data from web and return it as usual }. { String. You can receive this string hooking }. { the OnDoneString event. }. { Abort - Stop the current session }. {*************************************************************} { EVENTS: }. { OnDoneFile - Occurs when the file is downloaded }. { OnDoneString - Occurs when the string is received }. { OnError - Occurs when error happend }. { OnProgress - Occurs at the receiving of the BINARY DATA }. {*************************************************************} { Please see demo program for more information. }. {*************************************************************} { IMPORTANT NOTE: }. { This software is provided 'as-is', without any express or }. { implied warranty. In no event will the author be held }. { liable for any damages arising from the use of this }. { software. }. { Permission is granted to anyone to use this software for }. { any purpose, including commercial applications, and to }. { alter it and redistribute it freely, subject to the }. { following restrictions: }. { 1. The origin of this software must not be misrepresented, }. { you must not claim that you wrote the original software. }. { If you use this software in a product, an acknowledgment }. { in the product documentation would be appreciated but is }. { not required. }. { 2. Altered source versions must be plainly marked as such, }. { and must not be misrepresented as being the original }. { software. }. { 3. This notice may not be removed or altered from any }. { source distribution. }. {*************************************************************} Unit HTTPGet; Interface. Uses. Windows, Messages, SysUtils, Classes, WinInet; Type. TOnProgressEvent = procedure(Sender: TObject; TotalSize, Readed: Integer) of object; TOnDoneFileEvent = procedure(Sender: TObject; FileName: String; FileSize: Integer) of object; TOnDoneStringEvent = procedure(Sender: TObject; Result: String) of object; THTTPGetThread = class(TThread). Private. FTAcceptTypes, FTAgent, FTURL, FTFileName, FTStringResult, FTUserName, FTPassword, FTPostQuery, FTReferer: String; FTBinaryData, FTUseCache: Boolean; FTResult: Boolean; FTFileSize: Integer; FTToFile: Boolean; BytesToRead, BytesReaded: DWord; FTProgress: TOnProgressEvent; Procedure UpdateProgress; Protected. Procedure Execute; override; Public. Constructor Create(aAcceptTypes, aAgent, aURL, aFileName, aUserName, aPassword, APostQuery, aReferer: String; aBinaryData, aUseCache: Boolean; aProgress: TOnProgressEvent; aToFile: Boolean); End; THTTPGet = class(TComponent). Private. FAcceptTypes: String; FAgent: String; FBinaryData: Boolean; FURL: String; FUseCache: Boolean; FFileName: String; FUserName: String; FPassword: String; FPostQuery: String; FReferer: String; FWaitThread: Boolean; FThread: THTTPGetThread; FError: TNotifyEvent; FResult: Boolean; FProgress: TOnProgressEvent; FDoneFile: TOnDoneFileEvent; FDoneString: TOnDoneStringEvent; Procedure ThreadDone(Sender: TObject); Public. Constructor Create(aOwner: TComponent); override; Destructor Destroy; override; Procedure GetFile; Procedure GetString; Procedure Abort; Published. Property AcceptTypes: String read FAcceptTypes write FAcceptTypes; Property Agent: String read FAgent write FAgent; Property BinaryData: Boolean read FBinaryData write FBinaryData; Property URL: String read FURL write FURL; Property UseCache: Boolean read FUseCache write FUseCache; Property FileName: String read FFileName write FFileName; Property UserName: String read FUserName write FUserName; Property Password: String read FPassword write FPassword; Property PostQuery: String read FPostQuery write FPostQuery; Property Referer: String read FReferer write FReferer; Property WaitThread: Boolean read FWaitThread write FWaitThread; Property OnProgress: TOnProgressEvent read FProgress write FProgress; Property OnDoneFile: TOnDoneFileEvent read FDoneFile write FDoneFile; Property OnDoneString: TOnDoneStringEvent read FDoneString write FDoneString; Property OnError: TNotifyEvent read FError write FError; End; Procedure Register; Implementation. // THTTPGetThread. Constructor THTTPGetThread.Create(aAcceptTypes, aAgent, aURL, aFileName, aUserName, APassword, aPostQuery, aReferer: String; aBinaryData, aUseCache: Boolean; aProgress: TOnProgressEvent; aToFile: Boolean); Begin. FreeOnTerminate := True; Inherited Create(True); FTAcceptTypes := aAcceptTypes; FTAgent := aAgent; FTURL := aURL; FTFileName := aFileName; FTUserName := aUserName; FTPassword := aPassword; FTPostQuery := aPostQuery; FTReferer := aReferer; FTProgress := aProgress; FTBinaryData := aBinaryData; FTUseCache := aUseCache; FTToFile := aToFile; Resume; End; Procedure THTTPGetThread.UpdateProgress; Begin. FTProgress(Self, FTFileSize, BytesReaded); End; Procedure THTTPGetThread.Execute; Var. HSession, hConnect, hRequest: hInternet; HostName, FileName: String; F: File; Buf: Pointer; DwBufLen, dwIndex: DWord; Data: Array[0..$400] of Char; TempStr: String; RequestMethod: PChar; InternetFlag: DWord; AcceptType: LPStr; Procedure ParseURL(URL: String; var HostName, FileName: String); Procedure ReplaceChar(c1, c2: Char; var St: String); Var. P: Integer; Begin. While True do. Begin. P := Pos(c1, St); If p = 0 then Break. Else St[p] := c2; End; End; Var. I: Integer; Begin. If Pos('http://', LowerCase(URL)) <> 0 then. System.Delete(URL, 1, 7); I := Pos('/', URL); HostName := Copy(URL, 1, i); FileName := Copy(URL, i, Length(URL) - i + 1); If (Length(HostName) > 0) and (HostName[Length(HostName)] = '/') then. SetLength(HostName, Length(HostName) - 1); End; Procedure CloseHandles; Begin. InternetCloseHandle(hRequest); InternetCloseHandle(hConnect); InternetCloseHandle(hSession); End; Begin. Try. ParseURL(FTURL, HostName, FileName); If Terminated then. Begin. FTResult := False; Exit; End; If FTAgent <> '' then. HSession := InternetOpen(PChar(FTAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0). Else. HSession := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); HConnect := InternetConnect(hSession, PChar(HostName), INTERNET_DEFAULT_HTTP_PORT, PChar(FTUserName), PChar(FTPassword), INTERNET_SERVICE_HTTP, 0, 0); If FTPostQuery = '' then RequestMethod := 'GET' Else RequestMethod := 'POST'; If FTUseCache then InternetFlag := 0. Else InternetFlag := INTERNET_FLAG_RELOAD; AcceptType := PChar('Accept: ' + FTAcceptTypes); HRequest := HttpOpenRequest(hConnect, RequestMethod, PChar(FileName), 'HTTP/1.0', PChar(FTReferer), @AcceptType, InternetFlag, 0); If FTPostQuery = '' then. HttpSendRequest(hRequest, nil, 0, nil, 0). Else. HttpSendRequest(hRequest, 'Content-Type: application/x-www-form-urlencoded', 47, PChar(FTPostQuery), Length(FTPostQuery)); If Terminated then. Begin. CloseHandles; FTResult := False; Exit; End; DwIndex := 0; DwBufLen := 1024; GetMem(Buf, dwBufLen); FTResult := HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH, Buf, dwBufLen, dwIndex); If Terminated then. Begin. FreeMem(Buf); CloseHandles; FTResult := False; Exit; End; If FTResult or not FTBinaryData then. Begin. If FTResult then. FTFileSize := StrToInt(StrPas(Buf)); BytesReaded := 0; If FTToFile then. Begin. AssignFile(f, FTFileName); Rewrite(f, 1); End. Else FTStringResult := ''; While True do. Begin. If Terminated then. Begin. If FTToFile then CloseFile(f); FreeMem(Buf); CloseHandles; FTResult := False; Exit; End; If not InternetReadFile(hRequest, @Data, SizeOf(Data), BytesToRead) then Break. Else. If BytesToRead = 0 then Break. Else. Begin. If FTToFile then. BlockWrite(f, Data, BytesToRead). Else. Begin. TempStr := Data; SetLength(TempStr, BytesToRead); FTStringResult := FTStringResult + TempStr; End; Inc(BytesReaded, BytesToRead); If Assigned(FTProgress) then. Synchronize(UpdateProgress); End; End; If FTToFile then. FTResult := FTFileSize = Integer(BytesReaded). Else. Begin. SetLength(FTStringResult, BytesReaded); FTResult := BytesReaded <> 0; End; If FTToFile then CloseFile(f); End; FreeMem(Buf); CloseHandles; Except. End; End; // HTTPGet. Constructor THTTPGet.Create(aOwner: TComponent); Begin. Inherited Create(aOwner); FAcceptTypes := '*/*'; FAgent := 'UtilMind HTTPGet'; End; Destructor THTTPGet.Destroy; Begin. Abort; Inherited Destroy; End; Procedure THTTPGet.GetFile; Var. Msg: TMsg; Begin. If not Assigned(FThread) then. Begin. FThread := THTTPGetThread.Create(FAcceptTypes, FAgent, FURL, FFileName, FUserName, FPassword, FPostQuery, FReferer, FBinaryData, FUseCache, FProgress, True); FThread.OnTerminate := ThreadDone; If FWaitThread then. While Assigned(FThread) do. While PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do. Begin. TranslateMessage(Msg); DispatchMessage(Msg); End; End. End; Procedure THTTPGet.GetString; Var. Msg: TMsg; Begin. If not Assigned(FThread) then. Begin. FThread := THTTPGetThread.Create(FAcceptTypes, FAgent, FURL, FFileName, FUserName, FPassword, FPostQuery, FReferer, FBinaryData, FUseCache, FProgress, False); FThread.OnTerminate := ThreadDone; If FWaitThread then. While PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do. Begin. TranslateMessage(Msg); DispatchMessage(Msg); End; End. End; Procedure THTTPGet.Abort; Begin. If Assigned(FThread) then. Begin. FThread.Terminate; FThread.FTResult := False; End; End; Procedure THTTPGet.ThreadDone(Sender: TObject); Begin. FResult := FThread.FTResult; If FResult then. If FThread.FTToFile then. If Assigned(FDoneFile) then FDoneFile(Self, FThread.FTFileName, FThread.FTFileSize) else. Else. If Assigned(FDoneString) then FDoneString(Self, FThread.FTStringResult) else. Else. If Assigned(FError) then FError(Self); FThread := nil; End; Procedure Register; Begin. RegisterComponents('UtilMind', [THTTPGet]); End; End.
| ADO.OLEDB.JET - Access Violation при передаче неполного параметра |
Автор: Дмитрий Померанцев
Проблема обнаружена под операционной системой Windows 2000 SP3, в среде Delphi6, Delphi7 (скорее всего не зависит от версии Delphi) с использованием Microsoft Jet DB Engine версия 4, SP3.
Некоторый, вполне типичный, код заполнения запроса в процессе выполнения вызывает Access Violation, притом, что согласно документации все должно работать корректно.
Пример кода:
Допустим, есть база данных в MS Access 2000, имеющая таблицу main и в ней целочисленное (INT) поле id в качестве главного ключа. Так же есть компонент ADOQuery1: TADOQuery, для доступа к базе данных. Максимальное значение поля id может быть получено следующим кодом:
Code: ADOQuery1.Active := false; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('SELECT max(id)'); // -- Сбой здесь !!! ADOQuery1.SQL.Add('AS idmax'); ADOQuery1.SQL.Add('FROM main'); ADOQuery1.Active := true;
| Httpsock.pas. |
Code: Unit HttpSock; { CrtSocket for Delphi 32. Copyright (C) 1999-2001 Paul Toth <tothpaul@free.fr> Http://tothpaul.free.fr. This program is free software; you can redistribute it and/or. Modify it under the terms of the GNU General Public License. As published by the Free Software Foundation; either version 2. Of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, But WITHOUT ANY WARRANTY; without even the implied warranty of. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the. GNU General Public License for more details. You should have received a copy of the GNU General Public License. Along with this program; if not, write to the Free Software. Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. } Interface. Function URLEncode(s:string):string; Function URLDecode(s:string):string; Function HttpGet(server,url:string; var header:string):string; Function HttpPost(server,url,data:string; var header:string):string; Implementation. Uses. Crtsock,sysutils; Function URLEncode(s:string):string; // http://www.cis.ohio-state.edu/cgi-bin/rfc/rfc1738.html. Var. I:integer; C:char; Begin. Result:=''; For i:=1 to length(s) do begin. C:=s[i]; Case c of. // non-ASCII. #$00..#$1F,#$7F,#$80..#$FF, // unsafe. {' ',}'<','>','"','#','%','}','|','\','^','~', '[', ']', '`', // reserved. ';','/','?',':','@','=','&', '$','-','_','.','+','!','*','''','(',')': Result:=result+'%'+IntToHex(ord(c),2); ' ' :result:=result+'+'; Else result:=result+c; End; End; End; Function URLDecode(s:string):string; Var. I:integer; Begin. Result:=''; I:=1; While i<=length(s) do begin. Case s[i] of. '+':result:=result+' '; '%':begin. S[i]:='$'; Result:=result+chr(StrToInt(copy(s,i,3))); Inc(i,2); End; Else result:=result+s[i]; End; Inc(i); End; End; Function HttpGet(server,url:string; var header:string):string; Var. Handle:integer; Sin,sout:textfile; S:string; Begin. Handle:=callserver(server,80); If handle<=0 then begin. Result:=''; Exit; End; Assigncrtsock(handle,sin,sout); Writeln(sout,'GET ',url,' HTTP/1.0'); Writeln(sout,'Accept: */*'); Writeln(sout,'Accept-Language: fr'); Writeln(sout,'User-Agent: Mozilla/4.0 (compatible; MSIE 5.5; Windows 98; FREE)'); // writeln(sout,'User-Agent: MySoft/1.0 (Delphi)'); Writeln(sout,'Connection: Keep-Alive'); If header<>'' then writeln(sout,header); Writeln(sout); Header:=''; Result:=''; Readln(sin,s); While s<>'' do begin. Header:=header+s; Readln(sin,s); End; While not eof(sin) do begin. Readln(sin,s); Result:=result+s; End; Disconnect(handle); End; Function HttpPost(server,url,data:string; var header:string):string; Var. Handle:integer; Sin,sout:textfile; S:string; Begin. Handle:=callserver(server,80); If handle<=0 then begin. Result:=''; Exit; End; Assigncrtsock(handle,sin,sout); Writeln(sout,'POST ',url,' HTTP/1.0'); Writeln(sout,'Accept: */*'); Writeln(sout,'Accept-Language: fr'); Writeln(sout,'User-Agent: Mozilla/4.0 (compatible; MSIE 5.5; Windows 98; FREE)'); // writeln(sout,'User-Agent: MySoft/1.0 (Delphi)'); Writeln(sout,'Content-length: ',Length(data)); Writeln(sout,'Connection: Keep-Alive'); If header<>'' then writeln(sout,header); Writeln(sout); Write(sout,data); Header:=''; Result:=''; Readln(sin,s); While s<>'' do begin. Header:=header+s; Readln(sin,s); End; While not eof(sin) do begin. Readln(sin,s); Result:=result+s; End; Disconnect(handle); End; End.
| HTTP кодирование строки |
Code: Function HTTPEncode(const AStr: string): string; Const. NoConversion = ['A'..'Z', 'a'..'z', '*', '@', '.', '_', '-']; Var. Sp, Rp: PChar; Begin. SetLength(Result, Length(AStr) * 3); Sp := PChar(AStr); Rp := PChar(Result); While Sp^ <> #0 do. Begin. If Sp^ in NoConversion then. Rp^ := Sp^ Else if Sp^ = ' ' then. Rp^ := '+' Else. Begin. FormatBuf(Rp^, 3, '%%%.2x', 6, [Ord(Sp^)]); Inc(Rp, 2); End; Inc(Rp); Inc(Sp); End; SetLength(Result, Rp - PChar(Result)); End; Procedure TForm1.Button1Click(Sender: TObject); Begin. Edit1.Text := HTTPEncode(Edit1.Text); End;
HyperText Transfer Protocol - протокол обмена WWW-серверов.
HyperText Transfer Protocol (HTTP) - это протокол прикладного уровня, применяемый в распределенных информационных системах гипермедиа. HTTP используется проектом World Wide Web с 1990 года.
HTTP/1.0 предоставляет открытое множество методов, которые могут быть использованы для указания целей запроса. Они построены на дисциплине ссылок, где для указания ресурса, к которому должен быть применен данный метод, используется Универсальный Идентификатор Ресурсов (Universal Resource Identifier - URI), в виде местонахождения (URL) или имени (URN). Формат сообщений сходен с форматом Internet Mail или Multipurpose Internet Mail Extensions (MIME-Многоцелевое Расширение Почты Internet).
HTTP/1.0 используется также для коммуникаций между различными пользовательскими просмотрщиками и шлюзами, дающими гипермедиа доступ к существующим Internet протоколам, таким как SMTP, NNTP, FTP, Gopher и WAIS. HTTP/1.0 разработан, чтобы позволять таким шлюзам через proxy серверы, без какой-либо потери передавать данные с помощью упомянутых протоколов более ранних версий.
Общая Структура.
HTTP основывается на парадигме запросов/ответов. Запрашивающая программа (обычно она называется клиент) устанавливает связь с обслуживающей программой-получателем (обычно называется сервер) и посылает запрос серверу в следующей форме: метод запроса, URI, версия протокола, за которой следует MIME-подобное сообщение, содержащее управляющую информацию запроса, информацию о клиенте и, может быть, тело сообщения. Сервер отвечает сообщением, содержащим строку статуса (включая версию протокола и код статуса - успех или ошибка), за которой следует MIME-подобное сообщение, включающее в себя информацию о сервере, метаинформацию о содержании ответа, и, вероятно, само тело ответа. Следует отметить, что одна программа может быть одновременно и клиентом и сервером. Использование этих терминов в данном тексте относится только к роли, выполняемой программой в течение данного конкретного сеанса связи, а не к общим функциям программы.
В Internet коммуникации обычно основываются на TCP/IP протоколах. Для WWW номер порта по умолчанию - TCP 80, но также могут быть использованы и другие номера портов - это не исключает возможности использовать HTTP в качестве протокола верхнего уровня.
Для большинства приложений сеанс связи открывается клиентом для каждого запроса и закрывается сервером после окончания ответа на запрос. Тем не менее, это не является особенностью протокола. И клиент, и сервер должны иметь возможность закрывать сеанс связи, например, в результате какого-нибудь действия пользователя. В любом случае, разрыв связи, инициированный любой стороной, прерывает текущий запрос, независимо от его статуса.
©Drkb::03369.
Взято с http://delphiworld.narod.ru.
| Перевернуть строку |
Автор: ___Nikolay.
| Перевернуть текст в TStringGrid на 90 градусов |
Code: Uses. {...} Grids; Type. TForm1 = class(TForm). StringGrid1: TStringGrid; Procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); End; {...} Implementation. {...} // Display text vertically in StringGrid cells. // Vertikale Textausgabe in den Zellen eines StringGrid. Procedure StringGridRotateTextOut(Grid: TStringGrid; ARow, ACol: Integer; Rect: TRect; Schriftart: string; Size: Integer; Color: TColor; Alignment: TAlignment); Var. Lf: TLogFont; Tf: TFont; Begin. // if the font is to big, resize it. // wenn Schrift zu gro? dann anpassen. If (Size > Grid.ColWidths[ACol] div 2) then. Size := Grid.ColWidths[ACol] div 2; With Grid.Canvas do. Begin. // Replace the font. // Font setzen. Font.Name := Schriftart; Font.Size := Size; Font.Color := Color; Tf := TFont.Create; Try. Tf.Assign(Font); GetObject(tf.Handle, SizeOf(lf), @lf); Lf.lfEscapement := 900; Lf.lfOrientation := 0; Tf.Handle := CreateFontIndirect(lf); Font.Assign(tf); Finally. Tf.Free; End; // fill the rectangle. // Rechteck fullen. FillRect(Rect); // Align text and write it. // Text nach Ausrichtung ausgeben. If Alignment = taLeftJustify then. TextRect(Rect, Rect.Left + 2,Rect.Bottom - 2,Grid.Cells[ACol, ARow]); If Alignment = taCenter then. TextRect(Rect, Rect.Left + Grid.ColWidths[ACol] div 2 - Size + Size div 3,Rect.Bottom - 2,Grid.Cells[ACol, ARow]); If Alignment = taRightJustify then. TextRect(Rect, Rect.Right - Size - Size div 2 - 2,Rect.Bottom - 2,Grid.Cells[ACol, ARow]); End; End; // 2. Alternative: Display text vertically in StringGrid cells. // 2. Variante: Vertikale Textausgabe in den Zellen eines StringGrid. Procedure StringGridRotateTextOut2(Grid:TStringGrid;ARow,ACol:Integer;Rect:TRect; Schriftart:String;Size:Integer;Color:TColor;Alignment:TAlignment); Var. NewFont, OldFont : Integer; FontStyle, FontItalic, FontUnderline, FontStrikeout: Integer; Begin. // if the font is to big, resize it. // wenn Schrift zu gro? dann anpassen. If (Size > Grid.ColWidths[ACol] DIV 2) Then. Size := Grid.ColWidths[ACol] DIV 2; With Grid.Canvas do. Begin. // Set font. // Font setzen. If (fsBold IN Font.Style) Then. FontStyle := FW_BOLD. Else. FontStyle := FW_NORMAL; If (fsItalic IN Font.Style) Then. FontItalic := 1. Else. FontItalic := 0; If (fsUnderline IN Font.Style) Then. FontUnderline := 1. Else. FontUnderline := 0; If (fsStrikeOut IN Font.Style) Then. FontStrikeout:=1. Else. FontStrikeout:=0; Font.Color := Color; NewFont := CreateFont(Size, 0, 900, 0, FontStyle, FontItalic, FontUnderline, FontStrikeout, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, PChar(Schriftart)); OldFont := SelectObject(Handle, NewFont); // fill the rectangle. // Rechteck fullen. FillRect(Rect); // Write text depending on the alignment. // Text nach Ausrichtung ausgeben. If Alignment = taLeftJustify Then. TextRect(Rect,Rect.Left+2,Rect.Bottom-2,Grid.Cells[ACol,ARow]); If Alignment = taCenter Then. TextRect(Rect,Rect.Left+Grid.ColWidths[ACol] DIV 2 - Size + Size DIV 3, Rect.Bottom-2,Grid.Cells[ACol,ARow]); If Alignment = taRightJustify Then. TextRect(Rect,Rect.Right-Size - Size DIV 2 - 2,Rect.Bottom-2,Grid.Cells[ACol,ARow]); // Recreate reference to the old font. // Referenz auf alten Font wiederherstellen. SelectObject(Handle, OldFont); // Recreate reference to the new font. // Referenz auf neuen Font loschen. DeleteObject(NewFont); End; End; // Call the method in OnDrawCell. // Methode im OnDrawCell aufrufen. Procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); Begin. // In the second column: Rotate Text by 90° and left align the text. // Text um 90°gedreht ausgeben, linksbundig in der zweiten Spalte. If ACol = 1 then. StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12,clRed, taLeftJustify); // In the third column: Center the text. // Ausgabe zentriert in der dritten Spalte. If ACol = 2 then. StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12, clBlue, taCenter); // In all other columns third row: right align the text. // Ausgabe rechtsbundig in den restlichen Spalten. If ACol > 2 then. StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12,clGreen, TaRightJustify); End; End.
Перевести коды ошибок WinSock'a в текстовый вид.
| Перевести коды ошибок WinSock'a в текстовый вид |
Вот функция, аналогичная SysErrorMessage, принемает на вход код ошибки socket'a , возвращает строковое сообщение об ошибке..
Code: Function WSAErrorMessage(ErrorCode: Integer): string; Var. Buffer: array[0..255] of Char; Var. Len: Integer; Begin. Len := FormatMessage(FORMAT_MESSAGE_FROM_HMODULE or FORMAT_MESSAGE_IGNORE_INSERTS or. FORMAT_MESSAGE_ARGUMENT_ARRAY, Pointer(GetModuleHandle('wsock32.dll')), ErrorCode, 0, Buffer, SizeOf(Buffer), nil); While (Len > 0) and (Buffer[Len - 1] in [#0..#32, '.']) do Dec(Len); SetString(Result, Buffer, Len); End;
©Drkb::03560.
Автор: jack128.
Взято из http://forum.sources.ru.
Некоторые коды сразу на русском:
10004 Выполнение операции с сокетом, блокирующей выполнение программы, прервано вызовом специальной функции. 10013 Нет разрешения на доступ к сокету. 10014 Неверный адрес указателя при вызове функции. 10022 Неправильный аргумент при вызове функции для работы с сокетами. 10024 Слишком много открытых сокетов на нить, процесс или глобальных. 10035 Ресурс временно недоступен, при выполнении функции работы с сокетом, которая не может выполнить операцию немедленно. 10036 Одна блокирующая операция сейчас уже выполняется. 10037 Одна операция с неблокирующим сокетом уже выполняется. 10038 Попытка вызвать функцию, работающую с сокетами, при передаче ей в аргументе значения, которое не является правильным значением сокета. Обычно возникает, при попытке работы с уже закрытым сокетом. 10039 Требуется адрес назначения 10040 Сообщение слишком длинное при передаче дейтаграммы. 10041 Тип протокол не поддерживается для данного сокета. 10042 Неправильная опция или уровень заданы в функциях опций сокетов 10043 Запрошенный протокол не сконфигурирован для работы с системе 10044 Тип сокета не поддерживается 10045 Операция с сокетом не поддерживается 10046 Семейство протоколов не поддерживается 10047 Адрес не поддерживается на выбранном протоколе сокета 10048 Адрес+порт уже используется на этом хосте. Очень распространённая ошибка, когда две программы-серверы пытаются использовать один и тот же порт для приема запросов клиентов. 10049 Невозможно использовать запрошенный адрес для привязки в порту 10050 Сеть неработоспособна 10051 Сеть недоступна, аппаратура не знает как туда переслать пакет, возможно из-за ненастроенной маршрутизации. 10052 Соединение разорвано из-за сбоя при выполнении операции 10053 Программное обеспечение компьютера, на котором выполняется данная программа, разорвало соединение. 10054 Соединение разорвано с удаленного компьютера, возможно, что так оно и задумано было, и клиент завершил всю передачу информации по сокету. 10055 Не места в буфере или очереди. 10056 Сокет уже подсоединен. 10057 Сокет не подсоединенный 10058 Невозможно послать или получить данные по сокету, из-за того, что эта операция уже запрещена функцией shutdown 10060 Timeout 10061 Удаленный компьютер отказал в соединении, возможно не нём не запущен соответствующая программа сервер. 10064 Компьютер, с которым производится попытка соединения выключен. 10065 К удаленному компьютеру не найдет маршрут пересылки пакетов. 10067 Запущено слишком много процессов, использующих Windows Socket 10091 Сетевая подсистема недоступна. 10092 Неверная версия winsock.dll 10093 Не выполнена функция WSAStartup перед использованием любой другой фукнции работы с сокетами. 10109 Запрошенный тип класса не найден. 10101 Удаленный компьютер инициировал завершение соединения 11001 Запрошенное имя компьютера не найдено 11002 Временная ошибка при разрешении имени компьютера в адрес, возможно её не будет при повторе операции через некоторое время. 11003 Невосстанавливаемая ошибка при разрешении имени в адрес. 11004 С запрошенным именем компьютера не связано никакой правильной информации об адресе, хотя само имя присутствует в соответствующих базах данных имён.
Автор: Miscђka.
Взято из http://forum.sources.ru.
©Drkb::03561.
| Перевести секунды в формат времени |
| Передача массива записей символов в Memo. |
Обработка больших строк в 16-битной версии Delphi задача далеко непростая. Особенно когда строки являются частью структуры записи и вы хотите передать их в TMemo. В данном совете показано как создать структуру записи размером 1000 символов, прочесть в нее содержимое Memo и затем записать ее обратно в Memo. Основной метод, который мы здесь используем - метод Memo GetTextBuf. Используемая структура записи представляет собой простую строку и массив из 1000 символов, но структура могла бы быть сложнее.
Передача текста любому окну, где стоит фокус.
| Передача текста любому окну, где стоит фокус |
Code: Procedure TForm1.Timer1Timer(Sender: TObject); {©Drkb v.3(2007): www.drkb.ru}. Var. Pgui: TGUIThreadinfo; Begin. Pgui.cbSize := SizeOf(TGUIThreadinfo); GetGUIThreadInfo(GetWindowThreadProcessId(GetForegroundWindow), pgui); SendMessage(pgui.hwndFocus, WM_SETTEXT, Length(Edit1.Text), Integer(@Edit1.Text[1])); End;
Взято из http://forum.sources.ru.
Автор: Rouse_
©Drkb::02124.
| Переворачиваем рабочий стол |
Автор: William Egge.
Перевод чисел из десятичной, в любую другую систему счисления.
| Перевод чисел из десятичной, в любую другую систему счисления |
Code: { Фунция представляет число Value в Base-ричной системе счисления, Base должно находиться в пределах [1..36] и представляется. 10-ю цифрами [0..9] и 26-ю буквами английского алфавита ['A'..'Z'] }. Function Dec2X(const Value, Base: Cardinal): string; // Функция возвращает символ, соответствующий числу в N-ричной системе. Function GetChar(const N: Cardinal): Char; Begin. If N < 10 then. // для систем счисления от 1 до 10. Result := Char(N + Ord('0')). Else. // для систем счисления выше 10, но не больше 36 ([0..9] + ['A'..'Z']). Result := Char(N - 10 + Ord('A')); End; Var. V, R: Cardinal; Begin. Result := ''; If Base <= 1 then. Begin. // числа можно и в системе, состоящей из одного символа, представлять ;). If Base = 1 then. Begin. // реализуем это. SetLength(Result, Value); FillChar(Result[1], Value, Ord('0')); Exit; End else. // а вот других систем счисления быть не может. Raise EConvertError.Create('Основание системы счисления должно быть больше 0'); End else. // ограничиваем представление систем счисления 10-ю цифрами и 26-ю буквами. // английского алфавита. If Base > 10 + (Ord('Z') + 1) - Ord('A') then. Raise EConvertError.Create('Основание системы счисления должно лежать в пределах от 1 до 36'); // Выполняем преобразование в нужную систему виртуальным делением в столбик. V := Value; Repeat. R := V mod Base; V := V div Base; Result := GetChar(R) + Result; Until V < 2; // 2 - минимальная база, // то есть в любом случае когда-то "V div Base" будет равно 1. If V <> 0 then Result := IntToStr(V) + Result; End;
©Drkb::04060 Автор: s-mike.
| Перевод символа в верхний регистр для русского алфавита |
| Перевод символа в нижний регистр для русского алфавита |
| Перевод ODS API mssql2000 на Delphi (написание extended stored procedures). |
Code: { **** UBPFD *********** by delphibase.endimus.com **** >> перевод ODS API mssql2000 на Delphi (написание extended stored procedures). Перевод (как я понял, один из многих) заголовочных файлов. ODS API mssql2000 на object pascal.... для успешной работы необходима opends60.dll... Выполнен с помощью утилиты c2p, её комментарии я оставил... Часть функций, помеченные как устаревшие, не были переведены... Имхо перевод не лишен недостатков, поэтому используйте as is... Добавлю, что у меня всё работает... :). Зависимости: windows. Автор: wicked, wilk@ua.fm, ICQ:92356239, Тернополь. Copyright: (1) Microsoft (srv.h), (2) Oleg Bulychov, (3) wicked aka Andy Wilk. Дата: 15 ноября 2002 г. ***************************************************** } {*********************************} { Generated by c2pas32 v0.9b }. { (c) 2001 Oleg Bulychov }. { Gladiators Software }. { http://www.astonshell.com/ }. {*********************************} {(c) 2002 corrections by andy wilk }. Unit srv_h; Interface. Uses windows; //------------------------------------------------------------ // Open Data Services header file: srv.h. // Copyright (c) 1989, 1990, 1991, 1997 by Microsoft Corp. // // Avoid double inclusion. // ODS uses pack(4) on all CPU types. {$A+ }. // define model. //dll name. Const. Opends_dll = 'opends60.dll'; //------------------------------------------------------------ // Formats of data types. Type. DBBOOL = boolean; DBBYTE = byte; DBTINYINT = byte; DBSMALLINT = smallint; DBUSMALLINT = word; DBINT = integer; DBCHAR = char; PDBCHAR = ^DBCHAR; DBBINARY = byte; DBBIT = byte; DBFLT8 = double; Pinteger = ^integer; USHORT = word; Srv_datetime = record // Format for SRVDATETIME. Dtdays: integer; // number of days since 1/1/1900. Dttime: UINT; // number 300th second since mid. End; DBDATETIME = srv_datetime; Srv_money = record // Format for SRVMONEY. Mnyhigh: integer; Mnylow: UINT; End; DBMONEY = srv_money; DBFLT4 = single; DBMONEY4 = integer; Dbdatetime4 = record // Format for SRVDATETIM4. Numdays: word; // number of days since 1/1/1900. Nummins: word; // number of minutes sicne midnight. End; DBDATETIM4 = dbdatetime4; Const. MAXNUMERICLEN = 16; Type. Dbnumeric = record // Format for SRVNUMERIC,SRVNUMERICN,SRVDECIMAL,SRVDECIMALN. Precision: BYTE; Scale: BYTE; Sign: BYTE; Val: array[0..Pred(MAXNUMERICLEN)] of BYTE; End; //DBNUMERIC = dbnumeric; DBDECIMAL = DBNUMERIC; //------------------------------------------------------------ // Constants used by APIs. // Type Tokens. Const. SRV_TDS_NULL = {!!!a type cast? =>} {BYTE(} $1F; SRV_TDS_TEXT = {!!!a type cast? =>} {BYTE(} $23; SRV_TDS_GUID = {!!!a type cast? =>} {BYTE(} $24; SRV_TDS_VARBINARY = {!!!a type cast? =>} {BYTE(} $25; SRV_TDS_INTN = {!!!a type cast? =>} {BYTE(} $26; SRV_TDS_VARCHAR = {!!!a type cast? =>} {BYTE(} $27; SRV_TDS_BINARY = {!!!a type cast? =>} {BYTE(} $2D; SRV_TDS_IMAGE = {!!!a type cast? =>} {BYTE(} $22; SRV_TDS_CHAR = {!!!a type cast? =>} {BYTE(} $2F; SRV_TDS_INT1 = {!!!a type cast? =>} {BYTE(} $30; SRV_TDS_BIT = {!!!a type cast? =>} {BYTE(} $32; SRV_TDS_INT2 = {!!!a type cast? =>} {BYTE(} $34; SRV_TDS_DECIMAL = {!!!a type cast? =>} {BYTE(} $37; SRV_TDS_INT4 = {!!!a type cast? =>} {BYTE(} $38; SRV_TDS_DATETIM4 = {!!!a type cast? =>} {BYTE(} $3A; SRV_TDS_FLT4 = {!!!a type cast? =>} {BYTE(} $3B; SRV_TDS_MONEY = {!!!a type cast? =>} {BYTE(} $3C; SRV_TDS_DATETIME = {!!!a type cast? =>} {BYTE(} $3D; SRV_TDS_FLT8 = {!!!a type cast? =>} {BYTE(} $3E; SRV_TDS_NUMERIC = {!!!a type cast? =>} {BYTE(} $3F; SRV_TDS_SSVARIANT = {!!!a type cast? =>} {BYTE(} $62; SRV_TDS_NTEXT = {!!!a type cast? =>} {BYTE(} $63; SRV_TDS_BITN = {!!!a type cast? =>} {BYTE(} $68; SRV_TDS_DECIMALN = {!!!a type cast? =>} {BYTE(} $6A; SRV_TDS_NUMERICN = {!!!a type cast? =>} {BYTE(} $6C; SRV_TDS_FLTN = {!!!a type cast? =>} {BYTE(} $6D; SRV_TDS_MONEYN = {!!!a type cast? =>} {BYTE(} $6E; SRV_TDS_DATETIMN = {!!!a type cast? =>} {BYTE(} $6F; SRV_TDS_MONEY4 = {!!!a type cast? =>} {BYTE(} $7A; SRV_TDS_INT8 = {!!!a type cast? =>} {BYTE(} $7F; SRV_TDS_BIGVARBINARY = {!!!a type cast? =>} {BYTE(} $A5; SRV_TDS_BIGVARCHAR = {!!!a type cast? =>} {BYTE(} $A7; SRV_TDS_BIGBINARY = {!!!a type cast? =>} {BYTE(} $AD; SRV_TDS_BIGCHAR = {!!!a type cast? =>} {BYTE(} $AF; SRV_TDS_NVARCHAR = {!!!a type cast? =>} {BYTE(} $E7; SRV_TDS_NCHAR = {!!!a type cast? =>} {BYTE(} $EF; // Datatypes. // Also: values of symbol parameter to srv_symbol when type = SRV_DATATYPE. SRVNULL = SRV_TDS_NULL; SRVTEXT = SRV_TDS_TEXT; SRVGUID = SRV_TDS_GUID; SRVVARBINARY = SRV_TDS_VARBINARY; SRVINTN = SRV_TDS_INTN; SRVVARCHAR = SRV_TDS_VARCHAR; SRVBINARY = SRV_TDS_BINARY; SRVIMAGE = SRV_TDS_IMAGE; SRVCHAR = SRV_TDS_CHAR; SRVINT1 = SRV_TDS_INT1; SRVBIT = SRV_TDS_BIT; SRVINT2 = SRV_TDS_INT2; SRVDECIMAL = SRV_TDS_DECIMAL; SRVINT4 = SRV_TDS_INT4; SRVDATETIM4 = SRV_TDS_DATETIM4; SRVFLT4 = SRV_TDS_FLT4; SRVMONEY = SRV_TDS_MONEY; SRVDATETIME = SRV_TDS_DATETIME; SRVFLT8 = SRV_TDS_FLT8; SRVNUMERIC = SRV_TDS_NUMERIC; SRVSSVARIANT = SRV_TDS_SSVARIANT; SRVNTEXT = SRV_TDS_NTEXT; SRVBITN = SRV_TDS_BITN; SRVDECIMALN = SRV_TDS_DECIMALN; SRVNUMERICN = SRV_TDS_NUMERICN; SRVFLTN = SRV_TDS_FLTN; SRVMONEYN = SRV_TDS_MONEYN; SRVDATETIMN = SRV_TDS_DATETIMN; SRVMONEY4 = SRV_TDS_MONEY4; SRVINT8 = SRV_TDS_INT8; SRVBIGVARBINARY = SRV_TDS_BIGVARBINARY; SRVBIGVARCHAR = SRV_TDS_BIGVARCHAR; SRVBIGBINARY = SRV_TDS_BIGBINARY; SRVBIGCHAR = SRV_TDS_BIGCHAR; SRVNVARCHAR = SRV_TDS_NVARCHAR; SRVNCHAR = SRV_TDS_NCHAR; // values for srv_symbol type parameter. SRV_ERROR = 0; SRV_DONE = 1; SRV_DATATYPE = 2; SRV_EVENT = 4; // values for srv_symbol symbol parameter, when type = SRV_ERROR. SRV_ENO_OS_ERR = 0; SRV_INFO = 1; SRV_FATAL_PROCESS = 10; SRV_FATAL_SERVER = 19; // Types of server events. // Also: values for srv_symbol symbol parameter, when type = SRV_EVENT. SRV_CONTINUE = 0; SRV_LANGUAGE = 1; SRV_CONNECT = 2; SRV_RPC = 3; SRV_RESTART = 4; SRV_DISCONNECT = 5; SRV_ATTENTION = 6; SRV_SLEEP = 7; SRV_START = 8; SRV_STOP = 9; SRV_EXIT = 10; SRV_CANCEL = 11; SRV_SETUP = 12; SRV_CLOSE = 13; SRV_PRACK = 14; SRV_PRERROR = 15; SRV_ATTENTION_ACK = 16; SRV_CONNECT_V7 = 16; // TDS type for TDS 7 clients. Overloaded with SRV_ATTENTION_ACK. SRV_SKIP = 17; SRV_TRANSMGR = 18; SRV_PRELOGIN = 19; SRV_OLEDB = 20; SRV_INTERNAL_HANDLER = 99; SRV_PROGRAMMER_DEFINED = 100; // values for srv_sfield field parameter. SRV_SERVERNAME = 0; SRV_VERSION = 6; // Length to indicate string is null terminated. SRV_NULLTERM = -1; // values of msgtype parameter to srv_sendmsg. SRV_MSG_INFO = 1; SRV_MSG_ERROR = 2; // values of status parameter to srv_senddone. // Also: values for symbol parameters to srv_symbol when type = SRV_DONE. SRV_DONE_FINAL = {!!!a type cast? =>} {USHORT(} $0000; SRV_DONE_MORE = {!!!a type cast? =>} {USHORT(} $0001; SRV_DONE_ERROR = {!!!a type cast? =>} {USHORT(} $0002; SRV_DONE_COUNT = {!!!a type cast? =>} {USHORT(} $0010; SRV_DONE_RPC_IN_BATCH = {!!!a type cast? =>} {USHORT(} $0080; // return values of srv_paramstatus. SRV_PARAMRETURN = $0001; SRV_PARAMDEFAULT = $0002; SRV_PARAMSORTORDER = $0004; // This is sent by clients in RPC, unset in processRPC. // return values of srv_rpcoptions. SRV_RECOMPILE = $0001; SRV_NOMETADATA = $0002; // values of field parameter to srv_pfield. //#define SRV_LANGUAGE 1 already defined above. //#define SRV_EVENT 4 already defined above. SRV_SPID = 10; SRV_NETSPID = 11; SRV_TYPE = 12; SRV_STATUS = 13; SRV_RMTSERVER = 14; SRV_HOST = 15; SRV_USER = 16; SRV_PWD = 17; SRV_CPID = 18; SRV_APPLNAME = 19; SRV_TDS = 20; SRV_CLIB = 21; SRV_LIBVERS = 22; SRV_ROWSENT = 23; SRV_BCPFLAG = 24; SRV_NATLANG = 25; SRV_PIPEHANDLE = 26; SRV_NETWORK_MODULE = 27; SRV_NETWORK_VERSION = 28; SRV_NETWORK_CONNECTION = 29; SRV_LSECURE = 30; SRV_SAXP = 31; SRV_UNICODE_USER = 33; SRV_UNICODE_PWD = 35; SRV_SPROC_CODEPAGE = 36; SRV_MSGLCID = 37; SRV_INSTANCENAME = 38; SRV_HASHPWD = 39; // return value of SRV_TDSVERSION macro. SRV_TDS_NONE = 0; SRV_TDS_2_0 = 1; SRV_TDS_3_4 = 2; SRV_TDS_4_2 = 3; SRV_TDS_6_0 = 4; SRV_TDS_7_0 = 5; // Return values from APIs. Type. SRVRETCODE = integer; // SUCCEED or FAIL. //{$ifndef ODBCVER}. RETCODE = integer; //{$endif}. //{$if !defined( SUCCEED )}. Const. _SUCCEED = 1; // Successful return value. //{$endif}. //{$if !defined( FAIL )}. _FAIL = 0; // Unsuccessful return value. //{$endif}. SRV_DUPLICATE_HANDLER = 2; // additional return value for srv_pre/post_handle. //------------------------------------------------ //PreDeclare structures. // Type. Srv_server = record. End; PSRV_SERVER = ^srv_server; Srv_config = record. End; PSRV_CONFIG = ^srv_config; Srv_proc = record. End; PSRV_PROC = ^srv_proc; //------------------------------------------------ //------------------------------------------------ // ODS MACROs & APIs. // Describing and sending a result set. Function srv_describe(srvproc: pSRV_PROC; Colnumber: integer; Column_name: pchar; Namelen: integer; Desttype: integer; Destlen: integer; Srctype: integer; Srclen: integer; Srcdata: pointer): integer; cdecl; external opends_dll name 'srv_describe'; Function srv_setutype(srvproc: pSRV_PROC; column: integer; usertype: integer): Integer; cdecl; external opends_dll name 'srv_setutype'; Function srv_setcoldata(srvproc: pSRV_PROC; column: integer; data: pinteger): Integer; cdecl; external opends_dll name 'srv_setcoldata'; Function srv_setcollen(srvproc: pSRV_PROC; column: integer; len: integer): Integer; cdecl; external opends_dll name 'srv_setcollen'; Function srv_sendrow(srvproc: pSRV_PROC): integer; cdecl; external opends_dll. Name 'srv_sendrow'; Function srv_senddone(srvproc: pSRV_PROC; status: USHORT; curcmd: USHORT; count: Integer): integer; cdecl; external opends_dll name 'srv_senddone'; // Dealing with Extended Procedure parameters. Function srv_rpcparams(srvproc: pSRV_PROC): integer; cdecl; external opends_dll. Name 'srv_rpcparams'; Function srv_paraminfo(srvproc: pSRV_PROC; N: integer; Var pbType: integer; Var pcbMaxLen: integer; Var pcbActualLen: integer; PbData: pointer; Var pfNull: byte): integer; cdecl; external opends_dll name 'srv_paraminfo'; Function srv_paramsetoutput(srvproc: pSRV_PROC; N: integer; PbData: pointer; CbLen: integer; FNull: boolean): integer; cdecl; external opends_dll name. 'srv_paramsetoutput'; //procedure srv_paramdata{!!!3 unknown typedef}; cdecl; external opends_dll name 'srv_paramdata'; //function srv_paramlen{!!!3 unknown typedef}: integer; cdecl; external opends_dll name 'srv_paramlen'; //function srv_parammaxlen{!!!3 unknown typedef}: integer; cdecl; external opends_dll name 'srv_parammaxlen'; //function srv_paramtype{!!!3 unknown typedef}: integer; cdecl; external opends_dll name 'srv_paramtype'; //function srv_paramset{!!!3 unknown typedef}: integer; cdecl; external opends_dll name 'srv_paramset'; Function srv_paramname(srvproc: pSRV_PROC; N: integer; Len: integer): pchar; cdecl; external opends_dll name 'srv_paramname'; Function srv_paramnumber(srvproc: pSRV_PROC; Name: pchar; Namelen: integer): integer; cdecl; external opends_dll name 'srv_paramnumber'; //-------------------------------------------------------------- //-------------------------------------------------------------- // The rest of these APIs are still supported, in SQL Server 7.0, // but may not be supported after SQL Server 7.0. // MACROs. //function SRV_GETSERVER(a: integer): integer; {<= !!!6 unknown macro}. //function SRV_GOT_ATTENTION(a: integer): integer; {<= !!!6 unknown macro}. //function SRV_TDSVERSION(a: integer): integer; {<= !!!6 unknown macro}. //function srv_getserver(srvproc: pSRV_PROC): pSRV_SERVER; cdecl; external opends_dll name 'srv_getserver'; //function srv_got_attention(srvproc: pSRV_PROC): boolean; cdecl; external opends_dll name 'srv_got_attention'; // Memory. //function srv_alloc(ulSize: integer): pointer; cdecl; external opends_dll name 'srv_alloc'; //function srv_bmove(from: pinteger; to: pinteger; count: integer): integer; cdecl; external opends_dll name 'srv_bmove'; //function srv_bzero(location: pinteger; count: integer): integer; cdecl; external opends_dll name 'srv_bzero'; //function srv_free(ptr: pinteger): integer; cdecl; external opends_dll name 'srv_free'; Function srv_convert(srvproc: pSRV_PROC; Srctype: integer; Src: pointer; Srclen: DBINT; Desttype: integer; Dest: pointer; Destlen: DBINT): integer; cdecl; external opends_dll name 'srv_convert'; Function srv_getuserdata(srvproc: pSRV_PROC): pointer; cdecl; external opends_dll. Name 'srv_getuserdata'; Function srv_getbindtoken(srvproc: pSRV_PROC; token_buf: pchar): integer; cdecl; External opends_dll name 'srv_getbindtoken'; //function srv_getdtcxact(srvproc: pSRV_PROC; {!!!3 unknown typedef}): integer; cdecl; external opends_dll name 'srv_getdtcxact'; Type. EventHandler = function(p: pointer): integer; //function srv_impersonate_client(srvproc: pSRV_PROC): integer; cdecl; external opends_dll name 'srv_impersonate_client'; //function srv_langcpy(srvproc: pSRV_PROC; start: integer; nbytes: integer; buffer: pchar): integer; cdecl; external opends_dll name 'srv_langcpy'; //function srv_langlen(srvproc: pSRV_PROC): integer; cdecl; external opends_dll name 'srv_langlen'; //function srv_langptr(srvproc: pSRV_PROC): pointer; cdecl; external opends_dll name 'srv_langptr'; //function srv_log(server: pSRV_SERVER; datestamp: BOOL; msg: pchar; msglen: integer): integer; cdecl; external opends_dll name 'srv_log'; Function srv_paramstatus(srvproc: pSRV_PROC; N: integer): integer; cdecl; external opends_dll name 'srv_paramstatus'; Function srv_pfieldex(srvproc: pSRV_PROC; field: integer; len: pinteger): Pointer; cdecl; external opends_dll name 'srv_pfieldex'; Function srv_pfield(srvproc: pSRV_PROC; field: integer; len: pinteger): pchar; Cdecl; external opends_dll name 'srv_pfield'; Function srv_returnval(srvproc: pSRV_PROC; valuename: pchar; len: integer; Status: BYTE; _type: integer; maxlen: integer; datalen: integer; value: Pinteger): integer; cdecl; external opends_dll name 'srv_returnval'; Function srv_revert_to_self(srvproc: pSRV_PROC): integer; cdecl; external. Opends_dll name 'srv_revert_to_self'; Function srv_rpcdb(srvproc: pSRV_PROC; len: pinteger): pchar; cdecl; external. Opends_dll name 'srv_rpcdb'; Function srv_rpcname(srvproc: pSRV_PROC; len: pinteger): pchar; cdecl; external. Opends_dll name 'srv_rpcname'; Function srv_rpcnumber(srvproc: pSRV_PROC): integer; cdecl; external opends_dll. Name 'srv_rpcnumber'; Function srv_rpcoptions(srvproc: pSRV_PROC): USHORT; cdecl; external opends_dll. Name 'srv_rpcoptions'; Function srv_rpcowner(srvproc: pSRV_PROC; len: pinteger): pchar; cdecl; external. Opends_dll name 'srv_rpcowner'; // message text. Function srv_wsendmsg(srvproc: pSRV_PROC; Msgnum: integer; Msgclass: BYTE; Msg: pwidestring; Msglen: integer): integer; cdecl; external opends_dll name 'srv_wsendmsg'; Function srv_sendmsg(srvproc: pSRV_PROC; Msgtype: integer; Msgnum: integer; Msgclass: BYTE; State: BYTE; Rpcname: pchar; Rpcnamelen: integer; Linenum: USHORT; Msg: pchar; Msglen: integer): integer; cdecl; external opends_dll name 'srv_sendmsg'; Function srv_sendstatus(srvproc: pSRV_PROC; status: integer): integer; cdecl; External opends_dll name 'srv_sendstatus'; Function srv_setuserdata(srvproc: pSRV_PROC; _ptr: pointer): integer; cdecl; External opends_dll name 'srv_setuserdata'; Function srv_sfield(server: pSRV_SERVER; field: integer; len: pinteger): pchar; Cdecl; external opends_dll name 'srv_sfield'; Function srv_symbol(_type: integer; symbol: integer; len: pinteger): pchar; Cdecl; external opends_dll name 'srv_symbol'; Function srv_tdsversion(srvproc: pSRV_PROC): integer; cdecl; external opends_dll. Name 'srv_tdsversion'; Function srv_willconvert(srctype: integer; desttype: integer): BOOL; cdecl; External opends_dll name 'srv_willconvert'; Function srv_terminatethread(srvproc: pSRV_PROC): integer; cdecl; external. Opends_dll name 'srv_terminatethread'; Function srv_sendstatistics(srvproc: pSRV_PROC): integer; cdecl; external. Opends_dll name 'srv_sendstatistics'; Function srv_clearstatistics(srvproc: pSRV_PROC): integer; cdecl; external. Opends_dll name 'srv_clearstatistics'; Function srv_message_handler(srvproc: pSRV_PROC; Errornum: integer; Severity: BYTE; State: BYTE; Oserrnum: integer; Errtext: pchar; Errtextlen: integer; Oserrtext: pchar; Oserrtextlen: integer): integer; cdecl; external opends_dll name. 'srv_message_handler'; Function srv_pre_handle(server: pSRV_SERVER; srvproc: pSRV_PROC; event: integer; Handler: EventHandler; remove: boolean): integer; cdecl; external opends_dll. Name. 'srv_pre_handle'; Function srv_post_handle(server: pSRV_SERVER; srvproc: pSRV_PROC; event: Integer; handler: EventHandler; remove: boolean): integer; cdecl; external. Opends_dll name 'srv_post_handle'; Function srv_IgnoreAnsiToOem(srvproc: pSRV_PROC; bTF: boolean): integer; cdecl; External opends_dll name 'srv_IgnoreAnsiToOem'; {!!!1 => pragma pack()}. Const. SS_MAJOR_VERSION = 7; SS_MINOR_VERSION = 0; SS_LEVEL_VERSION = 0; SS_MINIMUM_VERSION = '7.00.00.0000'; ODS_VERSION = ((SS_MAJOR_VERSION shl 24) or (SS_MINOR_VERSION shl 16)); //_ODS_SRV_H_ ////////////////////////////////////////////////////////////////// // Suggested implementation of __GetXpVersion. // //__declspec(dllexport) ULONG __GetXpVersion(). // { // return ODS_VERSION; // }. ////////////////////////////////////////////////////////////////// Implementation. End.
| Обработать момент вставки и вытаскивания CD. |
Code: { Some applications need to know when the user inserts or. Removes a compact disc or DVD from a CD-ROM drive without. Polling for media changes. Windows provide a way to notify these. Applications through the WM_DEVICECHANGE message. } Type. TForm1 = class(TForm). Private. Procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE; Public. End; {...} Implementation. {$R *.DFM}. Procedure TForm1.WMDeviceChange(var Msg: TMessage); Const. DBT_DEVICEARRIVAL = $8000; // system detected a new device. DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone. Var. MyMsg: string; Begin. Inherited; Case Msg.wParam of. DBT_DEVICEARRIVAL: myMsg := 'CD inserted!'; DBT_DEVICEREMOVECOMPLETE: myMsg := 'CD removed!'; End; ShowMessage(myMsg); End; {*********************************************} // Advanced Code: // When the device is of type volume, then we can get some device specific. // information, namely specific information about a logical volume. // by Juergen Kantz. Unit Unit1; Interface. Uses. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; Type. TForm1 = class(TForm). Button1: TButton; Label1: TLabel; Private. Procedure WMDeviceChange(var Msg: TMessage); message WM_DeviceChange; { Private declarations }. Public. { Public declarations }. End; Const. DBT_DeviceArrival = $8000; DBT_DeviceRemoveComplete = $8004; DBTF_Media = $0001; DBT_DevTyp_Volume = $0002; Type. PDevBroadcastHdr = ^TDevBroadcastHdr; TDevBroadcastHdr = packed record. Dbcd_size: DWORD; Dbcd_devicetype: DWORD; Dbcd_reserved: DWORD; End; Type. PDevBroadcastVolume = ^TDevBroadcastVolume; TDevBroadcastVolume = packed record. Dbcv_size: DWORD; Dbcv_devicetype: DWORD; Dbcv_reserved: DWORD; Dbcv_unitmask: DWORD; Dbcv_flags: Word; End; Var. Form1: TForm1; Implementation. {$R *.dfm}. Function GetDrive(pDBVol: PDevBroadcastVolume): string; Var. I: Byte; Maske: DWORD; Begin. If (pDBVol^.dbcv_flags and DBTF_Media) = DBTF_Media then. Begin. Maske := pDBVol^.dbcv_unitmask; For i := 0 to 25 do. Begin. If (Maske and 1) = 1 then. Result := Char(i + Ord('A')) + ':'; Maske := Maske shr 1; End; End; End; Procedure TForm1.WMDeviceChange(var Msg: TMessage); Var. Drive: string; Begin. Case Msg.wParam of. DBT_DeviceArrival: If PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then. Begin. Drive := GetDrive(PDevBroadcastVolume(Msg.lParam)); Label1.Caption := 'CD inserted in Drive ' + Drive; End; DBT_DeviceRemoveComplete: If PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then. Begin. Drive := GetDrive(PDevBroadcastVolume(Msg.lParam)); Label1.Caption := 'CD removed from Drive ' + Drive; End; End; End; End.
| Обработка событий клавиш в DelphiX. |
Этот урок не совсем посвящен ДельфИксу. Сейчас вы научитесь обрабатывать такие события, как, например, нажатия клавиш. Но делать мы это будем не при помощи DXInput, так как я все ещё не знаю как с ним работать, делать мы это будем при помощи трех обычных событий: onKeyDown, onKeyUp и onKeyPreesed. Эти свойства есть и у формы и у DXDraw. Я буду работать с формой, кому больше нравится - могут работать с DXDraw, это ничего не меняет. Итак, в прошлый раз у нас была тарелка, летящая по уже заданной траектории. Теперь, я думаю было бы неплохо сделать спрайт стенки квадратным и небольшим, размножить их и добавить гравитацию, чтобы можно было летать по лабиринту и избегать столкновения со стенкой. Теперь стенка будет такой:
Можно будет размножить её, зная, что её размеры 23х23 и выстроить лабиринт. Кроме того не помешает создать спрайт "посадочной площадки", чтобы в лабиринте была цель. У меня она будет такой:
Теперь о том, как мы будем изменять координаты спрайта при создании. Конструктор Twall.Create теперь будет выглядеть так:(wx и wy - переменные типа Integer).
Code: Constructor Twall.Create(AParent: TSprite); Begin. Inherited Create(AParent); Image := Form1.ImageList.Items.Find('wall'); X := wx; Y := wy; Z := 0; Width := Image.Width; Height := Image.Height; PixelCheck := True; End;
| Обработчики ввода/вывода (IOHandlers). |
12. Обработчики ввода/вывода (IOHandlers).
Indy может настраиваться и расширяться многими путями, без необходимости напрямую модифицировать исходный код. Примером такой расширяемости являются обработчики ввода/вывода (IOHandlers). Обработчики ввода/вывода позволяют вам использовать любой источник ввода/вывода I/O в Indy. Обработчики ввода/вывода должны использоваться, когда вы желаете использовать альтернативный механизм ввода/вывода или создание нового транспортного механизма.
Обработчики ввода/вывода выполняют весь ввод/вывод (Input/Output) для Indy. Indy не выполняет ни какого своего ввода/вывода, за пределами обработчика ввода/вывода. Обработчик ввода/вывода используется для посылки сырых TCP данных для компонент Indy.
Обработчики ввода/вывода позволяют классам обрабатывать весь ввод/вывод в Indy. Обычно, весь ввод/вывод делается через сокет и обслуживается обработчиком по умолчанию - TIdIOHandlerSocket.
Каждый TCP клиент имеет свойство IOHandler, которое может быть назначено обработчику IOHandler, как это делает каждое серверное соединение. Если обработчик IOHandler не указан, то неявно используется TIdIOHandlerSocket, который создается автоматически и используется TCP клиентом. TIdIOHandlerSocket реализует ввод/вывод используя TCP сокет. Indy также включает дополнительные обработчики ввода/вывода: TIdIOHandlerStream и TIdSSLIOHandlerSocket.
Другие обработчики ввода/вывода могут быть созданы, позволяя Indy использовать любые источники ввода/вывода, которые вы только можете вообразить. В данный момент Indy поддерживает только сокеты, потоки и SSL как источники ввода/вывода, но источники ввода/вывода позволяют и другие возможности. Пока нет других планов, но обработчики ввода/вывода могут быть созданы для поддержки туннелей, IPX/SPX, RS-232, USB или Firewire. Indy не ограничивает вас в выборе вашего источника ввода/вывода и использование обработчиков ввода/вывода позволяет это сделать.
12.1. Компоненты IOHandler.
12.1.1. Компонент TIdIOHandlerSocket.
Компонент TIdIOHandlerSocket это обработчик IOHandler по умолчанию. Если обработчик не указан явно, то он создается неявно для вас. Компонент TIdIOHandlerSocket обрабатывает весь ввод/вывод, относящийся к TCP сокетам.
Обычно, компонент TIdIOHandlerSocket не используется явно, пока не потребуются расширенные способности.
12.1.2. Компонент TIdIOHandlerStream.
Компонент TIdIOHandlerStream используется для отладки и тестирования. При его использовании все взаимодействие с сервером в TCP сессии может быть записаны. Позже вся сессия может быть «проиграна». Компоненты Indy не знают, работают ли они с реальным сервером и реальным соединением.
Это очень мощное средство отладки в дополнение к инструменту QA отладки. Если у пользователя есть проблемы, то специальная версия программы может быть послана пользователю или включены средства отладки для ведения лога сессии. Используя лог файлы, вы можете затем реконструировать сессию пользователя в локальной отладочной среде.
12.1.3. Компонент TIdSSLIOHandlerSocket.
Компонент TIdSSLIOHandlerSocket используется для поддержки SSL. Обычно компрессия и декомпрессия данных может быть реализована с использованием перехватчиков (Intercepts) вместо IOHandlers. Но SSL библиотека используемая Indy (OpenSSL), работает напрямую с сокетом, вместо трансляции данных посылаемых Indy. Поэтому реализация выполнена как IOHandler. . TIdSSLIOHandlerSocket является наследником TIdIOHandlerSocket.
12.2. Пример - Speed Debugger.
Пример Speed Debugger демонстрирует как симулировать медленное соединение. Это полезно, как для отладки, так и для тестирования ваших приложений при симуляции медленных сетей, таких как модемы.
Пример Speed Debugger состоит из главной формы и пользовательского обработчика IOHandler. Speed Debugger использует компонент «маппированый порт» для передачи данных конкретному web серверу. Браузер соединяется со Speed Debugger и Speed Debugger пробует получить страницу с указанного web сервера, затем возвращает ее web браузеру замедленно, с указанной скоростью.
Поле текстового ввода используется для указания web сервера.
Примечание: не указывайте URL и не указывайте протокол http:// или web страницу. Оно предназначено только для указания имени сервера или его IP адреса. Если у вас есть локальный web сервер, то вы можете просто указать 127.0.0.1 и использовать локальный web сервер.
Комбо-бокс используется для выбора скорости и состоит из следующих выборов. Симулируемая скорость указывается в скобках.
· Apache (Unlimited)
· Dial Up (28.8k baud)
· IBM PC XT (9600 baud)
· Commodore 64 (2400 baud)
· Microsoft IIS on a PIII-750 & 1GB RAM (300 baud) (Боже как же он его ненавидит! :-))
После нажатия кнопки Test - Speed Debugger загружает браузер по умолчанию с URL http://127.0.0.1:8081/. В данном случае браузер делает запрос из Speed Debugger. Speed Debugger слушает на порту 8081, который может конфликтовать с некоторым существующими локальными web серверами.
Пример Speed Debugger может быть загружен с Indy Demo Playground.
12.2.1. Пользовательский обработчик IOHandler.
Работа Speed Debugger делается на основе пользовательского IOHandler. Маппированый порт компонент имеет событие OnConnect, и данное событие используется как хук в нашем IOHandler для каждого исходящего клиента, который создает маппированый порт. Это выглядит так:
Code: Procedure TformMain.IdMappedPortTCP1Connect(AThread: TIdMappedPortThread); Var. LClient: TIdTCPConnection; LDebugger: TMyDebugger; Begin. LClient := AThread.OutboundClient; LDebugger := TMyDebugger.Create(LClient); LDebugger.BytesPerSecond := GSpeed; LClient.IOHandler := LDebugger; End;
Перебор вариантов.
| Перебор вариантов |
Code: { Если Х - количество видов букв, из которых состоит генеримое слово, А Y - максимальная длинна слова, то общее количество сгенеренных. Слов равно: Z = Y^1 + Y^2 + ... + Y^X }. Var. Gen_Length: Byte; { максимальная длинна слова для генерации }. Gen_CharArray: String; { массив символов, из которых будет сгенерированы слова }. InS: String; { строка, из которой будет создан массив Gen_CharArray }. I: Byte; { счётчик }. F: Text; { файл для сохранения сгенерированных слов }. { рекурсивная процедура генерации слова }. Procedure GenNext(Gen_LastCharNo: Byte; Gen_Str: String); Var. I: Byte; { счётчик }. Begin. { генерируем до тех пор, пока не достигнем последнего символа в массиве генерации }. For I := 1 to Byte(Gen_CharArray[0]) do. Begin. { устанавливаем длинну строки слова, которое сейчас сгенерируем }. Byte(Gen_Str[0]) := Gen_LastCharNo; { изменяем последний символ генерируемого слова, которое нам передано. В заголовке процедуры }. Gen_Str[Gen_LastCharNo] := Gen_CharArray[I]; { слово сгенерировано, записываем в файл }. WriteLn(F, Gen_Str); { если мы не достигли максимальной длинны слова, вызываем себя рекурсивно, Указав, что уже следующи символ будет последним и передавая уже. Сгенерированный кусок строки }. If Gen_Length > Gen_LastCharNo then GenNext(Gen_LastCharNo+1, Gen_Str); End; End; Begin. Gen_CharArray := 'DELPHI'; { в примере максимальная длинна слова для генерации равна длинне массива символов }. Gen_Length := Byte(Gen_CharArray[0]); Assign(F, 'OUTPUT.TXT'); ReWrite(F); { запускаем генерацию. Gen_LastCharNo - последний символ будет иметь номер 1. Gen_Str - пока строка пуста }. GenNext(1, ''); Close(F); End.
Автор: --= Eagle =--
©Drkb::04182.
Права доступа NTFS.
| Права доступа NTFS. |
Code: Uses ..., Aclapi, AccCtrl; Function SetFileAccessRights(AFile, AUser: String; AMask: DWORD): Boolean; Var. Psd : PSECURITY_DESCRIPTOR; DwSize, dwError : DWord; BDaclPresent : Bool; BDaclDefaulted : Bool; OldAcl : PACL; NewAcl : PACL; Sd : SECURITY_DESCRIPTOR; Ea : EXPLICIT_ACCESS; Begin. Result := False; If WIN32Platform <> VER_PLATFORM_WIN32_NT then Exit; Psd := nil; NewAcl := nil; BDaclDefaulted := True; If not GetFileSecurity(PChar(AFile), DACL_SECURITY_INFORMATION, Pointer(1), 0, dwSize) and (GetLastError = ERROR_INSUFFICIENT_BUFFER). Then. Try. Psd := HeapAlloc(GetProcessHeap, 8, dwSize); If psd <> nil then. Begin. BuildExplicitAccessWithName(@ea, PChar(AUser), AMask, SET_ACCESS, SUB_CONTAINERS_AND_OBJECTS_INHERIT{NO_INHERITANCE}); Result := GetFileSecurity(PChar(AFile), DACL_SECURITY_INFORMATION, psd, dwSize, dwSize) and. GetSecurityDescriptorDacl(psd, bDaclPresent, OldAcl, bDaclDefaulted) and. (SetEntriesInAcl(1, @ea, OldAcl, NewAcl) = ERROR_SUCCESS) and. InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION) and. SetSecurityDescriptorDacl(@sd, True, NewAcl, False) and. SetFileSecurity(PChar(AFile), DACL_SECURITY_INFORMATION, @sd); End; Finally. If NewAcl <> nil then LocalFree(HLocal(NewAcl)); If psd <> nil then HeapFree(GetProcessHeap, 0, psd); End; End;
Параметры: путь к объекту, имя пользователя, маска доступа, ее расчитываешь вот так: http://msdn.microsoft.com/library/default....access_mask.asp
Автор: Александр (Rouse_) Багель
Взято из http://forum.sources.ru ©Drkb::03119.
| Первая буква каждого слова в верхнем регистре |
| Обрезание строки по длине |
Автор: ___Nikolay.
Code: // Обрезание строки по длине. Function TfmDW6Main.BeautyStr(s: string; iLength: integer): string; Var. Bm: TBitmap; SResult: string; IStrLen: integer; BAdd: boolean; Begin. Result := s; If Trim(s) = '' then. Exit; BAdd := false; SResult := s; Bm := TBitmap.Create; Bm.Width := 100; Bm.Height := 100; IStrLen := bm.Canvas.TextWidth(sResult); While iStrLen > iLength do. Begin. If Length(sResult) < 4 then. Break; Delete(sResult, Length(sResult) - 2, 3); BAdd := true; IStrLen := bm.Canvas.TextWidth(sResult); End; If (iStrLen <= iLength) and bAdd then. SResult := sResult + '...'; Bm.Free; Result := sResult; End;
©Drkb::00858.
DelphiWorld 6.0.
Нажатия клавиши и звук.
| Нажатия клавиши и звук |
Code: Procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Begin. PlaySound('wmpaud7.wav', 0, SND_NOSTOP + SND_ASYNC); End; Procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Begin. PlaySound(nil, 0, 0); End;
Автор: Smike.
Взято из http://forum.sources.ru.
©Drkb::03620.
| Невизуальное дерево |
Code:
Unit EctoSoftTree;
{===============================================================================
Класс TEctoSoftTree представляет собой невизуальное дерево для манипулирования.
Древоподобными структурами в памяти. Мной в очередной раз из любви к искусству.
Был изобретен велосипед :))), который тем не менее получился вполне съедобным.
И несмотря на наличие других вариантов решения задачи будет использоваться мной.
Хотя бы назло врагам :) Буду рад если еще кому-то он придется по вкусу.
Просьба при внесении изменений и дополнений в код, а также обнаружении ошибок.
(которых здесь нет ;) уведомить автора, т.е. меня.
Малышев Владимир aka "мыш".
Feedback@ectosoft.com.
Http://www.EctoSoft.com.
================================================================================}
| Параллельное выполнение (Concurrency). |
15. Параллельное выполнение (Concurrency).
В многопоточной среде ресурсы должны быть защищены так, чтобы они не были разрушены при одновременном доступе.
Параллельное выполнение и потоки переплетаются и выбор, что изучать сначала может быть сложным. В данном разделе мы рассмотрим параллельное выполнение и попытаемся дать понятия для изучения потоков.
15.1. Терминология.
15.1.1. Параллельное выполнение.
Параллельное выполнение – это состояние, когда много задач возникает в одно и тоже время. Когда конкурирование реализовано правильно это может рассматривать как «гармония», а если плохо, то как «хаос» .
В большинстве случаев, задача выполняется в потоке (thread). Но также это могут быть процессы (process) или волокна (fiber). Разделение очень условное, но использование правильной адстракции является ключем к успеху.
15.1.2. Борьба (споры) за ресурсы (Contention).
Что же такое точно борьба за ресурсы? Борьба за ресурсы – это когда более чем одна задача пытается получить доступ к одному и тому же ресурсу, в то же самое время.
Для тех, кто живет в большой семье обычно понятно, о чем идет речь, и может дать пример споров. Представим себе семью с шестью маленькими детьми, когда мама ставит на сто маленькую пиццу. Будет драка.
Когда множеству конкурирующих задач требуется доступ к данным режиме чтения/записи, то данные должны быть защищены. Если доступ не контролируется, две или более задач могут разрушить их, когда одна задача пытается писать, а другая читать одновременно. Если одна задача записывает во время чтения другой, то возможно чтение и запись несогласованных данных.
Обычно в этом случае не возникает исключения, и ошибка проявится позже в программе.
Проблемы борьбы за ресурсы не возникают в приложениях при малой нагрузке и поэтому не обнаруживают себя во время разработки. По этому правильное тестирование должно производиться на большой нагрузке. Иначе это подобно «русской рулетке” и проблемы будут возникать редко во время разработки и часто в рабочей среде.
15.1.3. Защита ресурсов (Resource Protection).
Защита ресурсов – это способ разрешения проблемы борьбы за ресурсы. К функциям защиты ресурсов относится разрешение доступа только одной задаче в одно и то же время.
15.2. Разрешение споров (Resolving Contention).
Когда множеству потоков требуется доступ до ресурсов в режиме чтения/записи, данные должны контролироваться для защиты их целостности. Это может наводить ужас на программиста не умеющего работать с потоками.
Как правило, большинство серверов не нуждаются в глобальных данных. Обычно им требуется читать данные только во время инициализации программы. Так как здесь нет доступа по записи потоки могут читать глобальные данные без побочных эффектов.
Общи пути разрешения споров приведены ниже.
15.2.1. Только чтение (Read Only).
Самый простой метод – это режим только чтение. Все простые типы (integers, strings, memory), которые используются в режиме только чтения - не требуют защиты. Это также относится и к таким сложным типам как TList и другие. Классы безопасны если только не используют глобальные переменные или глобальные поля классов в режиме чтения/записи.
В дополнение, ресурсы должны быть записаны перед любыми попытками чтения. Это делается путем инициализацией ресурсов во время запуска, до того как задачи будут к ним обращаться.
15.2.2. Атомарные операции (Atomic Operations).
Методология утверждает, что атомарные операции не требуют защиты. Атомарные операции – это такие операции, которые очень малы для деления в процессоре. Поскольку, их размер маленький, то это не приводит к спорам, так как они выполняются разом и не могут быть прерваны во время исполнения. Обычно атомарные операции – это строки кода компилируемые в одну иструкцию ассемблера.
Обычно задачи, такие как чтение или запись целых чисел (integer) или логических полей (boolean field) являются атомарными операциями, так как они выполняются с помощью единственной инструкции move. Тем не менее моя рекомендация, такая – никогда не рассчитывайте на атомарность операций, поскольку в некоторых случаях, даже при записи целого (integer) или логического (Boolean) может быть выполнено более одной инструкции, в зависимости от того, откуда данные читались. В дополнение, это требует знания внутренней природы компилятора, которое является предметом для изменения в любое время, без вашего оповещения. Закладываясь на атомарные операции вы можете написать код, который будет неоднозначным в некоторых случаях и может работать по разному на многопроцессорных машинах или других операционных системах.
Я до недавнего времени считал атомарные операции очень защищенными. Тем не менее, приход .NET принесет серьезную проблему. Когда наш код был компилирован в IL, и затем перекомпилирован в машинный код на платформах различных производителей, можете ли вы быть уверены, что каждая строка вашего кода будет атомарной операцией в конце концов?
Выбор конечно ваш, и конечно есть аргументы как за, так и против атомарных операций. Атомарные операции в большинстве случаев сохраняют только несколько микросекунд и несколько байт кода. Я настоятельно рекомендую не использовать атомарные операции, так как они дают мало преимуществ и являются потенциальным источником неприятонстей .
15.2.3. Поддержка Операционной Системы (Operating System Support).
Многие операционные системы имеют поддержку базовых потоко-безопасных операций.
Windows поддерживает набор функций, известных как, блочные (Interlocked) функции. Польза от этих функций очень маленькая и состоит в поддержке только простой функциональности для целых чисел, как увеличение, уменьшение, добавление, обмен и обмен со сравнением.
Количество функций варьируется от версии Windows и может быть причиной замораживания (deadlocks) в старых версиях Windows. В большинстве приложений они имеют малые плюсы.
Поскольку их функциональность ограничена, не поддерживается повсюду, и дает лишь некоторое увеличение производительности, вместо них в Indy рекомендуется использовать потоко-безопасные эквиваленты (заменители). (threadsafe).
Windows также имеет поддержку объектов IPC (interprocess communication), обертка вокруг которых имеется в Delphi. Данные объекты особенно полезны для программирования потоков и IPC.
15.2.4. Явная защита (Explicit Protection).
Явная защита заставляет каждую задачу знать, что ресурсы защищены и требуют явных шагов по доступу к ресурсу. Обычно такой код расположен в отдельной подпрограмме, которая используется многими задачами конкурентно и работает как потоко-безопасная обертка.
Явная защита обычно использует для синхронизации доступа к ресурсу специальный объект. Вкратце, защита ресурса ограничивает доступ к ресурсу для одной задачи за раз. Защита ресурса не ограничивает доступ к ресурсу, это требует знания специфики каждого ресурса. Вместо этого она подобна сигналам движения и код адаптирован так чтобы следовать и управлять сигналам трафика. Каждый объект защиты ресурса реализует определенный тип сигнала, используя различную логику управления и налагая различные ограничения на производительность . Это позволяет выбрать подходяший объект защиты в зависимости от ситуации.
Существует несколько типов объектов защиты ресурсов и они будут отдельно рассмотрены позже.
15.2.4.1. Критические секции (Critical Sections).
Критические секции могут быть использованы для управления доступом к глобальным ресурсам. Критические секции требуют мало ресурсов и реализованы в VCL как TCriticalSection. Вкратце, критические секции позволяют отдельному потоку в многопоточном приложении, временно блокировать доступ к ресурсу для других потоков исаользующих эту же критическую секцию. Критические секции подобны светофорам, которые зажинают зеленый сигнал только если впереди нет ни одной другой машины. Критические секции могут быть использованы, чтобы быть уверенным, что только один поток может исполняться в одно время. Поэтому, защищенные блоки должны быть минимального размера, так как они могут сильно понизить производительность, если будут неправильно использованы. Поэтому, каждый уникальный блок должен также использовать свою собственную критическую секцию (TCriticalSection) вместо использования единой для всего приложения.
Для входа в критическую секцию вызовите метод Enter и затем метод Leave для выхода из секции. Класс TCriticalSection также имеет методы Acquire и Release, которые аналогичны Enter и Leave соответственно.
Предположим, что сервер должен вести лог клиентов и отображать информацию в главном потоке. Мнение, что это должно быть синхронизироваться. Тем не менее, использование данного метода может негативно сказаться на производительности потока соединения, если много клиентов будут подключаться одновременно. В зависимости от потребностей сервера, лучшим решением был бы лог информации, а главный поток мог бы читать ее по таймеру. Следующий код является примером данной техники, которая использует критические секции.
Code: Var. GLogCS: TCriticalSection; GUserLog: TStringList; Procedure TformMain.IdTCPServer1Connect(AThread: TIdPeerThread); Var. S: string; Begin. // Username. S := ReadLn; GLogCS.Enter; Try. GUserLog.Add('User logged in: ' + s); Finally. GLogCS.Leave; End; End; Procedure TformMain.Timer1Timer(Sender: TObject); Begin. GLogCS.Enter; Try. Listbox1.Items.AddStrings(GUserLog); GUserLog.Clear; Finally. GLogCS.Leave; End; End; Initialization. GLogCS := TCriticalSection.Create; GUserLog := TStringList.Create; Finalization. FreeAndNil(GUserLog); FreeAndNil(GLogCS); End.
| Переключение раскладки клавиатуры для приложения |
Code: { **** UBPFD *********** by kladovka.net.ru **** >> Переключение раскладки клавиатуры для приложения. Зависимости: Windows. Автор: Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург. Copyright: Dimka Maslov. Дата: 21 мая 2002 г. ********************************************** } Function ChangeLayout(LANG: Integer): Boolean; Var. Layouts: array [0..16] of HKL; I, Count: Integer; Begin. Result:=False; Count:=GetKeyboardLayoutList(High(Layouts)+1, Layouts)-1; For i:=0 to Count do if (LoWord(Layouts[i]) and $FF) = LANG then. Result:=ActivateKeyboardLayout(Layouts[i], 0)<>0; End;
Правильные диалоги от Борланда.
| Правильные диалоги от Борланда |
Если покопаться в фирменных "Дельфовых" примерах, можно найти ГОРАЗДО более удачную конструкцию (которую, кстати, я уже давно использую).
Еще раз подчеркну - это не моя придумка, а ребят из Борланда.
Эта конструкция позволяет:
· Возвращать ЛЮБЫЕ значения;
· ДИНАМИЧЕСКИ создавать форму;
· Еще куча всяких "бонусов", просто лень описывать :-)
Итак, смотрим исходники... В этом примере я привел два наиболее типичных случая. 1-й - InputString - просто ввод, без анализа отмены, второй - MrInputString - с анализом отмены ввода (ModalResult). Оба случая используют начальные значения. Без них - Еще проще... В принципе - ваша фантазия ничем не ограничивается. Я, например, храню последние вводившиеся значения в реестре и читаю их оттуда после создания формы. Удобно. Пользователь не мается вводя по 10 раз одно и то же, а у меня не болит голова с инициализацией полей (есть специальный класс, который этим занимается, но это отдельная тема...).
ИСХОДНИКИ:
Code: //************************************************************** //Основной модуль Обратите Внимание! "uses Dialog;". Implementation. {$R *.dfm}. Uses. Dialog; Procedure TForm1.BitBtn1Click(Sender: TObject); Begin. ShowMessage('Вы ввели '+InputString('Начальное значение')); End; Procedure TForm1.BitBtn2Click(Sender: TObject); Var. Str: String; Begin. Str:='Начальное значение'; If MrInputString(Str) = mrOk Then. ShowMessage('Вы ввели '+Str). Else. ShowMessage('Вы отменили ввод'); End; //******************************************************** //Модуль диалога. Unit Dialog; Interface. Uses. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Buttons; Type. TOptionsDlg = class(TForm). Bevel1: TBevel; BitBtn1: TBitBtn; BitBtn2: TBitBtn; Edit1: TEdit; Label1: TLabel; Bevel2: TBevel; Label3: TLabel; Procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Private. { Private declarations }. Public. { Public declarations }. End; Var. OptionsDlg: TOptionsDlg; Function InputString(BeginVal: String): String; Function MrInputString(Var Str: String): TModalResult; Implementation. {$R *.dfm}. Function InputString(BeginVal: String): String; Begin. With TOptionsDlg.Create(Application.MainForm) do. Try. Edit1.Text:=BeginVal; If ShowModal = mrOk Then. Result:=Edit1.Text. Else. Result:='"Отмена"'; Finally. Free; End; End; Function MrInputString(Var Str: String): TModalResult; Begin. With TOptionsDlg.Create(Application.MainForm) do. Try. Edit1.Text:=Str; Result:=ShowModal; Str:=Edit1.Text; Finally. Free; End; End; Procedure TOptionsDlg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Begin. Case Key of. 27: ModalResult:=mrCancel; 13: ModalResult:=mrOk; End; End; End.
Сергей Горбань
©Drkb::01224.
| Перекодировка в Code 128. |
Code: /* Перекодировка символа Widows в code128. */ CREATE FUNCTION dbo.Win2code128. (@winchar as varchar(1)). RETURNS int. AS. BEGIN. DECLARE @code as int. DECLARE @T TABLE( a int, b VARCHAR(1) ). Insert into @T. Select 0 a,' ' b. Union all. Select 1 a,'!' b. Union all. Select 2 a,'"' b. Union all. Select 3 a,'#' b. Union all. Select 4 a,'$' b. Union all. Select 5 a,'%' b. Union all. Select 6 a,'&' b. Union all. Select 7 a,'''' b. Union all. Select 8 a,'(' b. Union all. Select 9 a,')' b. Union all. Select 10 a,'*' b. Union all. Select 11 a,'+' b. Union all. Select 12 a,',' b. Union all. Select 13 a,'-' b. Union all. Select 14 a,'.' b. Union all. Select 15 a,'/' b. Union all. Select 16 a,'0' b. Union all. Select 17 a,'1' b. Union all. Select 18 a,'2' b. Union all. Select 19 a,'3' b. Union all. Select 20 a,'4' b. Union all. Select 21 a,'5' b. Union all. Select 22 a,'6' b. Union all. Select 23 a,'7' b. Union all. Select 24 a,'8' b. Union all. Select 25 a,'9' b. Union all. Select 26 a,':' b. Union all. Select 27 a,';' b. Union all. Select 28 a,'<' b. Union all. Select 29 a,'=' b. Union all. Select 30 a,'>' b. Union all. Select 31 a,'?' b. Union all. Select 32 a,'@' b. Union all. Select 33 a,'A' b. Union all. Select 34 a,'B' b. Union all. Select 35 a,'C' b. Union all. Select 36 a,'D' b. Union all. Select 37 a,'E' b. Union all. Select 38 a,'F' b. Union all. Select 39 a,'G' b. Union all. Select 40 a,'H' b. Union all. Select 41 a,'I' b. Union all. Select 42 a,'J' b. Union all. Select 43 a,'K' b. Union all. Select 44 a,'L' b. Union all. Select 45 a,'M' b. Union all. Select 46 a,'N' b. Union all. Select 47 a,'O' b. Union all. Select 48 a,'P' b. Union all. Select 49 a,'Q' b. Union all. Select 50 a,'R' b. Union all. Select 51 a,'S' b. Union all. Select 52 a,'T' b. Union all. Select 53 a,'U' b. Union all. Select 54 a,'V' b. Union all. Select 55 a,'W' b. Union all. Select 56 a,'X' b. Union all. Select 57 a,'Y' b. Union all. Select 58 a,'Z' b. Union all. Select 59 a,'[' b. Union all. Select 60 a,'\' b. Union all. Select 61 a,']' b. Union all. Select 62 a,'^' b. Union all. Select 63 a,'_' b. Union all. Select 64 a,'`' b. Union all. Select 65 a,'a' b. Union all. Select 66 a,'b' b. Union all. Select 67 a,'c' b. Union all. Select 68 a,'d' b. Union all. Select 69 a,'e' b. Union all. Select 70 a,'f' b. Union all. Select 71 a,'g' b. Union all. Select 72 a,'h' b. Union all. Select 73 a,'i' b. Union all. Select 74 a,'j' b. Union all. Select 75 a,'k' b. Union all. Select 76 a,'l' b. Union all. Select 77 a,'m' b. Union all. Select 78 a,'n' b. Union all. Select 79 a,'o' b. Union all. Select 80 a,'p' b. Union all. Select 81 a,'q' b. Union all. Select 82 a,'r' b. Union all. Select 83 a,'s' b. Union all. Select 84 a,'t' b. Union all. Select 85 a,'u' b. Union all. Select 86 a,'v' b. Union all. Select 87 a,'w' b. Union all. Select 88 a,'x' b. Union all. Select 89 a,'y' b. Union all. Select 90 a,'z' b. Union all. Select 91 a,'{' b. Union all. Select 92 a,'|' b. Union all. Select 93 a,'}' b. Union all. Select 94 a,'~' b. Union all. Select 95 a,char(161) b. Union all. Select 96 a,char(162) b. Union all. Select 97 a,char(163) b. Union all. Select 98 a,char(164) b. Union all. Select 99 a,char(165) b. Union all. Select 100 a,char(166) b. Union all. Select 101 a,char(167) b. Union all. Select 102 a,char(168) b. Union all. Select 103 a,char(169) b. Union all. Select 104 a,char(170) b. Union all. Select 105 a,char(171) b. Union all. Select 106 a,char(172) b. Select @code=a. From @T. Where ascii(b)=ascii(@winchar). Set @code=isnull(@code,0). Return (@code). END.
Автор: Sh@dow.
©Drkb::02867.
Взято с Vingrad.ru http://forum.vingrad.ru.
| "Межплатформенный" Drag and Drop. |
"Межплатформенный" Drag & Drop.
Сначала рассмотрим технологию Drag&Drop в Windows так как большинство знакомых мне программистов работает именно в этой ОС.
Немного Windows API.
Итак, чтоб заставить приложение реагировать на события Drag&Drop, нам нужно воспользоваться функциями DragAcceptFiles, DragQueryFile и DragFinish из модуля ShellAPI.pas.
Первая из них имеет вид:
Procedure DragAcceptFiles (Wnd: HWND; Accept: BOOL); stdcall;
· Wnd - дескриптор окна, для которого будет установлено разрешение на прием перетаскиваемых объектов;
· Accept - собственно разрешение (True - разрешить прем объектов; False - запретить).
При установленном флаге Accept реакция приложения распространяется на все файлы и папки, расположенные на любых дисках. Реакция приложения не распространяется на метаелементы оболочки - то есть на Панель управления, Принтеры, Сетевое окружение, иконки дисков в Моем компьютере…После этого при перетаскивании файлов или папок на "допущенный" элемент приложения курсор меняет свою форму При "отпускании" объекта на элементе тому посылается сообщение WM_DROPFILES, которое оповещает о произошедшем событии Drag&Drop. Параметр wParam сообщения содержит идентификатор события и потребуется нам дальше.
Вторая функция используется для получения списка файлов (как мы помним, перетаскивать можно несколько файлов, папок…), которые были передвинуты на наш компонент:
Function DragQueryFile (Drop: HDROP; FileIndex: UINT; FileName: PChar; cb: UINT): UINT; stdcall;
· Drop - идентификатор, который был передан нам через сообщение WM_DROPFILES;
· FileIndex - номер запрашиваемого файла;
· FileName - указатель на строку, которая содержит имя файла с индексом (FileIndex);
· Cb - размер буфера FileName.
При передаче параметру FileIndex значения $FFFFFFFF DragQueryFile возвращает количество файлов, которые были перетащены на компонент; в других случаях возвращаемое значение - количество скопированных в буфер FileName символов.
DragFinish - используется для освобождения памяти занятой при перетаскивании. Формат функции:
Procedure DragFinish (Drop: HDROP); stdcall;
Алгоритм работы
Во-первых, мы разрешим "системное" перетаскивание на какой-нибудь компонент посредством DragAcceptFiles. Далее мы каким-либо образом должны отследить возникновение сообщения WM_DROPFILES и записать из полученных при его отправке данных значение wParam, которое потом используем вместе с DragQueryFile, для того чтоб вывести список перетасканных файлов. Ну и под конец - завершаем эту процедуру освобождением памяти (DragFinish).
В первом приближении все очень просто. Трудности начинают возникать, когда мы доходим до отлавливания сообщения WM_DROPFILES. И тут есть несколько вариантов. Во-первых, можно создать новый класс, в котором перехватывается это сообщение. Например, так:
Code: TMyListBox = class (TListBox). Private. FOnDropFiles:TNotifyEvent; FDrop:THandle; Protected. Procedure WMDropFiles (var Message:TMessage); message WM_DROPFILES; Public. Property Drop:THandle read FDrop write FDrop; Property OnDropFiles:TNotifyEvent read FOnDropFiles write FOnDropFiles; End;
Надпись на часах в трее.
| Надпись на часах в трее |
Code: Var. {©Drkb v.3(2007): www.drkb.ru}. HTrayClock : HWND; DC:HDC; R:TRect; Begin. HTrayClock := FindWindowEx(FindWindowEx(FindWindow('Shell_TrayWnd',nil),0,'TrayNotifyWnd',nil),0,'TrayClockWClass',nil); GetWindowRect(hTrayClock,r); DC := GetDC(0); // SetBkMode(DC, TRANSPARENT); // можно сделать прозрачный фон. SetTextColor(DC, RGB($0FF,0,0)); SetBkColor(DC,RGB($0FF,$0FF,0)); TextOut(DC, r.Left+((r.Right-r.Left) div 4), r.Top+((r.Bottom-r.Top) div 4), '>:-(', 4); ReleaseDC(hTrayClock, DC); End.
При следующем обновлении часов надпись исчезнет. Так что можно делать это по таймеру.
Взято из http://forum.sources.ru.
Автор: Krid.
©Drkb::01765.
| Недоступная закладка в компоненте TabbedNotebook. |
Есть ли возможность в компоненте Tabbednotebook сделать какую-либо страницу недоступной? То есть не позволять пользователю щелкать на ней и видеть ее содержимое?
Да, такая возможность существует. Самый простой путь - удалить страницу, например так:
| Предотвратить работу с командами буфера обмена в TEdit. |
Code: Unit MyEdit; Interface. Uses. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, stdctrls, clipbrd; Type. TPreventNotifyEvent = procedure(Sender: TObject; Text: string; var Accept: Boolean) of object; Type. TMyEdit = class(TCustomEdit). Private. FPreventCut: Boolean; FPreventCopy: Boolean; FPreventPaste: Boolean; FPreventClear: Boolean; FOnCut: TPreventNotifyEvent; FOnCopy: TPreventNotifyEvent; FOnPaste: TPreventNotifyEvent; FOnClear: TPreventNotifyEvent; Procedure WMCut(var Message: TMessage); message WM_CUT; Procedure WMCopy(var Message: TMessage); message WM_COPY; Procedure WMPaste(var Message: TMessage); message WM_PASTE; Procedure WMClear(var Message: TMessage); message WM_CLEAR; Protected. { Protected declarations }. Public. { Public declarations }. Published. Property PreventCut: Boolean read FPreventCut write FPreventCut default False; Property PreventCopy: Boolean read FPreventCopy write FPreventCopy default False; Property PreventPaste: Boolean read FPreventPaste write FPreventPaste default False; Property PreventClear: Boolean read FPreventClear write FPreventClear default False; Property OnCut: TPreventNotifyEvent read FOnCut write FOnCut; Property OnCopy: TPreventNotifyEvent read FOnCopy write FOnCopy; Property OnPaste: TPreventNotifyEvent read FOnPaste write FOnPaste; Property OnClear: TPreventNotifyEvent read FOnClear write FOnClear; End; Procedure Register; Implementation. Procedure TMyEdit.WMCut(var Message: TMessage); Var. Accept: Boolean; Handle: THandle; HandlePtr: Pointer; CText: string; Begin. If FPreventCut then. Exit; If SelLength = 0 then. Exit; CText := Copy(Text, SelStart + 1, SelLength); Try. OpenClipBoard(Self.Handle); Accept := True; If Assigned(FOnCut) then. FOnCut(Self, CText, Accept); If not Accept then. Exit; Handle := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, Length(CText) + 1); If Handle = 0 then. Exit; HandlePtr := GlobalLock(Handle); Move((PChar(CText))^, HandlePtr^, Length(CText)); SetClipboardData(CF_TEXT, Handle); GlobalUnlock(Handle); CText := Text; Delete(CText, SelStart + 1, SelLength); Text := CText; Finally. CloseClipBoard; End; End; Procedure TMyEdit.WMCopy(var Message: TMessage); Var. Accept: Boolean; Handle: THandle; HandlePtr: Pointer; CText: string; Begin. If FPreventCopy then. Exit; If SelLength = 0 then. Exit; CText := Copy(Text, SelStart + 1, SelLength); Try. OpenClipBoard(Self.Handle); Accept := True; If Assigned(FOnCopy) then. FOnCopy(Self, CText, Accept); If not Accept then. Exit; Handle := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, Length(CText) + 1); If Handle = 0 then. Exit; HandlePtr := GlobalLock(Handle); Move((PChar(CText))^, HandlePtr^, Length(CText)); SetClipboardData(CF_TEXT, Handle); GlobalUnlock(Handle); Finally. CloseClipBoard; End; End; Procedure TMyEdit.WMPaste(var Message: TMessage); Var. Accept: Boolean; Handle: THandle; CText: string; LText: string; AText: string; Begin. If FPreventPaste then. Exit; If IsClipboardFormatAvailable(CF_TEXT) then. Begin. Try. OpenClipBoard(Self.Handle); Handle := GetClipboardData(CF_TEXT); If Handle = 0 then. Exit; CText := StrPas(GlobalLock(Handle)); GlobalUnlock(Handle); Accept := True; If Assigned(FOnPaste) then. FOnPaste(Self, CText, Accept); If not Accept then. Exit; LText := ''; If SelStart > 0 then. LText := Copy(Text, 1, SelStart); LText := LText + CText; AText := ''; If (SelStart + 1) < Length(Text) then. AText := Copy(Text, SelStart + SelLength + 1, Length(Text) - SelStart + SelLength + 1); Text := LText + AText; Finally. CloseClipBoard; End; End; End; Procedure TMyEdit.WMClear(var Message: TMessage); Var. Accept: Boolean; CText: string; Begin. If FPreventClear then. Exit; If SelStart = 0 then. Exit; CText := Copy(Text, SelStart + 1, SelLength); Accept := True; If Assigned(FOnClear) then. FOnClear(Self, CText, Accept); If not Accept then. Exit; CText := Text; Delete(CText, SelStart + 1, SelLength); Text := CText; End; Procedure Register; Begin. RegisterComponents('Samples', [TMyEdit]); End; End.
| Предотвратить запуск Screen Saver при работе программы |
Code: Interface. Private. Procedure AppMessage(var Msg: TMsg; var handled: Boolean); End; Implementation. Procedure TForm1.AppMessage(var Msg: TMsg; var handled: Boolean); Begin. If (Msg.Message = WM_SYSCOMMAND) and (Msg.wParam = SC_SCREENSAVE) then. Handled := True; End; Procedure TForm1.FormCreate(Sender: TObject); Begin. Application.OnMessage := AppMessage; End; { Note: The Screensaver is only disabled during the lifespan of. Your application. }
| Предотвратить изменение ширины колонки для TListView. |
Code: Private. FListViewOldWndProc: TWndMethod; Procedure ListViewNewWndProc(var Msg: TMessage); End; {....} Implementation. Uses. CommCtrl; Procedure TForm1.FormCreate(Sender: TObject); Begin. //Sichern der ursprunglichen WindowProc der Listview. FListViewOldWndProc := ListView1.WindowProc; //Subclassing: Umleiten der WindowProc auf unsere eigene Procedur. Listview1.WindowProc := ListViewNewWndProc; End; Procedure TForm1.ListViewNewWndProc(var Msg: TMessage); Var. Hdn: ^THDNotify; Begin. If Msg.Msg = WM_NOTIFY then. Begin. Hdn := Pointer(Msg.lParam); //Abfangen und loschen der HDN_BeginTrack Botschaft. If (hdn.hdr.code = HDN_BeginTrackW) or (hdn.hdr.code = HDN_BeginTrackA) then. Msg.Result := 1. Else. FListViewOldWndProc(Msg); End. // ansonsten Botschaft an die ursprungliche WindowProc weiterreichen. Else. FListViewOldWndProc(Msg); End; Procedure TForm1.FormDestroy(Sender: TObject); Begin. //vor dem Beenden Original WindowProc wiederherstellen. ListView1.WindowProc := FlistViewOldWndProc; FListViewOldWndProc := nil; End;
Перечисление служб.
| Перечисление служб |
Code: //////////////////////////////////////////////////////////////////////////////// // // **************************************************************************** // * Project : Project1. // * Unit Name : Unit1. // * Purpose : Демо получения информации по сервисам. // * Author : Александр (Rouse_) Багель. // * Version : 1.00. // **************************************************************************** // Unit Unit1; Interface. Uses. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls, ExtCtrls, WinSvc; Type. TfrmMain = class(TForm). LvReport: TListView; RgServiceState: TRadioGroup; SbCount: TStatusBar; OpenDialog1: TOpenDialog; Procedure FormCreate(Sender: TObject); Procedure rgServiceStateClick(Sender: TObject); Private. Procedure EnumServices(const State: DWORD); End; Var. FrmMain: TfrmMain; Implementation. {$R *.dfm}. Procedure TfrmMain.EnumServices(const State: DWORD); Var. HSCObject, hService: SC_HANDLE; LpServices, TmpEnum: PEnumServiceStatus; LpServiceConfig: PQueryServiceConfig; I, cbBuffSize, pcbBytesNeeded, LpServicesReturned, lpResumeHandle: DWORD; Begin. LvReport.Items.BeginUpdate; Try. LvReport.Items.Clear; // Открываем менеджер сервисов. HSCObject := OpenSCManager(nil, nil, SC_MANAGER_ENUMERATE_SERVICE); If hSCObject <> 0 then. Try. LpResumeHandle := 0; LpServices := nil; // Смотрим сколько нужно памяти чтобы получить информацию. EnumServicesStatus(hSCObject, SERVICE_WIN32, State, LpServices^, 0, pcbBytesNeeded, lpServicesReturned, lpResumeHandle); If GetLastError = ERROR_MORE_DATA then. Begin. // Выделяем нужную память. GetMem(lpServices, pcbBytesNeeded); Try. CbBuffSize := pcbBytesNeeded; // Получаем требуемую информацию по установленным сервисам. If EnumServicesStatus(hSCObject, SERVICE_WIN32, State, LpServices^, cbBuffSize, pcbBytesNeeded, lpServicesReturned, lpResumeHandle) then. Begin. TmpEnum := lpServices; // Бежим в цикле по записям. For I := 0 to lpServicesReturned - 1 do. Begin. // Выводим данные на экран. With lvReport.Items.Add do. Begin. // Наименование сервиса. Caption := TmpEnum^.lpServiceName; // Описание сервиса. SubItems.Add(TmpEnum^.lpDisplayName); // Состояние. Case TmpEnum^.ServiceStatus.dwCurrentState of. SERVICE_RUNNING: SubItems.Add('Работает'); SERVICE_STOPPED: SubItems.Add('Остановлен'); Else. SubItems.Add('Неизвестно'); End; // Для дополнительной информаци по сервису получаем описатель сервиса. HService := OpenService(hSCObject, TmpEnum^.lpServiceName, SERVICE_QUERY_CONFIG); If hService <> 0 then. Try. // Смотрим сколько нужно памяти. QueryServiceConfig(hService, nil, 0, pcbBytesNeeded); If GetLastError = ERROR_INSUFFICIENT_BUFFER then. Begin. CbBuffSize := pcbBytesNeeded; // Берем память. GetMem(lpServiceConfig, pcbBytesNeeded); Try. // Получаем расширенную информацию по сервису. If QueryServiceConfig(hService, lpServiceConfig, CbBuffSize, pcbBytesNeeded) then. Begin. // Путь к сервису. SubItems.Add(lpServiceConfig^.lpBinaryPathName); // Доступ к рабочему столу. If (lpServiceConfig^.dwServiceType and SERVICE_INTERACTIVE_PROCESS) = SERVICE_INTERACTIVE_PROCESS then. Begin. SubItems.Add('Да'); LpServiceConfig^.dwServiceType := LpServiceConfig^.dwServiceType - SERVICE_INTERACTIVE_PROCESS; End. Else. SubItems.Add('Нет'); // Тип сервиса. Case lpServiceConfig^.dwServiceType of. SERVICE_WIN32_OWN_PROCESS: SubItems.Add('Одиночный'); SERVICE_WIN32_SHARE_PROCESS: SubItems.Add('Не одиночный'); Else. SubItems.Add('Неизвестный тип службы'); End; // Группа. SubItems.Add(lpServiceConfig^.lpLoadOrderGroup); // Тип запуска. Case lpServiceConfig^.dwStartType of. SERVICE_AUTO_START: SubItems.Add('Автоматический'); SERVICE_DEMAND_START: SubItems.Add('Вручную'); SERVICE_DISABLED: SubItems.Add('Отключен'); End; End; // Завершающее освобождение памяти. Finally. FreeMem(lpServiceConfig); End; End; Finally. CloseServiceHandle(hService); End; End; Inc(TmpEnum); End; End; Finally. FreeMem(lpServices); End; End; Finally. CloseServiceHandle(hSCObject); End; Finally. LvReport.Items.EndUpdate; SbCount.Panels.Items[0].Text := ' Общее количество: ' + IntToStr(lvReport.Items.Count); End; End; Procedure TfrmMain.FormCreate(Sender: TObject); Begin. RgServiceState.OnClick(nil); End; Procedure TfrmMain.rgServiceStateClick(Sender: TObject); Begin. // В зависимости от выбранного RadioItem перечисляем - // все сервисы, только активные или неактивные. If rgServiceState.ItemIndex = 0 then. EnumServices(SERVICE_STATE_ALL). Else. EnumServices(rgServiceState.ItemIndex); End; End.
Взято из http://forum.sources.ru.
Автор: Rouse_
©Drkb::02242.
| Перечислить все разбиения N на целые положительные слагаемые |
Пример: N=4, разбиения: 1+1+1+1, 2+1+1, 2+2, 3+1, 4.
First = (1,1,...,1) - N единиц Last = (N).
Чтобы разбиения не повторялись, договоримся перечислять слагаемые в невозрастающем порядке. Сказать, сколько их будет всего, не так-то просто (см.следующий пункт). Для составления алгоритма Next зададимся тем же вопросом: в каком случае i-ый член разбиения можно увеличить, не меняя предыдущих?
Во-первых, должно быть X[i-1]>X[i] или i=1. Во-вторых, i должно быть не последним эле ментом (увеличение i надо компенсировать уменьшением следующих). Если такого i нет, то данное разбиение последнее. Увеличив i, все следующие элементы надо взять минимально возможными, т.е. равными единице:
Code: Procedure Next; Begin. {найти i: (i<L) and ( (X[i-1]>X[i]) or (i=1) )}. X[i]:=X[i]+1; { L:= i + X[i+1]+...+X[L] - 1 }. X[i+1]:=...:=X[L]:=1. End;
| Перечислить все расстановки 8-ми ферзей на шахматной доске, при которых они не бьют друг друга |
Классической задачей, которая решается методом перебора с отходом назад считается задача о восьми ферзях: требуется перечислить все способы расстановки 8-ми ферзей на шахматной доске 8 на 8, при которых они не бьют друг друга. Эту задачу решил больше 200 лет тому назад великий математик Леонард Эйлер. Заметьте, что у него не было компьютера, но тем не менее он абсолютно верно нашел все 92 таких расстановки!
Очевидно, на каждой из 8 вертикалей должно стоять по ферзю. Каждую такую расстановку можно закодировать одномерным массивом
X[1],...,X[8],
где X[i] - номер горизонтали для i-го ферзя. Поскольку никакие два ферзя не могут стоять на одной горизонтали (тогда они бьют друг друга), то все X[i] различны, т.е. образуют перестановку из чисел 1..8. Можно, конечно, перебрать все 8! таких перестановок и выбрать среди них те 92, которые нас интересуют. Hо число 8!=40320 довольно большое.
Поэтому мы воспользуемся алгоритмом перебора с отходом назад, который позволит значительно сократить перебор и даст ответ намного быстрее:
Code: Program Queens; Const N=8; Type Index=1..N; Rasstanovka=array [Index] of 0..N; Var X:Rasstanovka; Count:word; Function P(var X:Rasstanovka;k,y:Index):boolean; Var i:Index; Begin. I:=1; While (i<k)and(y<>X[i])and(abs(k-i)<>abs(y-X[i])) do inc(i); P:=i=k. End; Procedure Backtracking(k:Index); Var i,y:Index; Begin. For y:=1 to N do. If P(X,k,y) then. Begin. X[k]:=y; If k=N then. Begin. For i:=1 to N do write(X[i]);writeln;inc(Count). End; Backtracking(k+1). End. End; Begin. Count:=0; Writeln('Расстановки ',N,' ферзей:'); Backtracking(1); Writeln('Всего ',Count,' расстановок'). End.
| Перечислить измененные ключи реестра в определенный диапазон времени |
Code: Unit Main; Interface. Uses. Windows, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Registry, StdCtrls, ComCtrls, ExtCtrls; Type. TFrmMain = class(TForm). Memo1: TMemo; BtEnumReg: TButton; DtBeginDate: TDateTimePicker; DtEndDate: TDateTimePicker; DtBeginTime: TDateTimePicker; DtEndTime: TDateTimePicker; Panel1: TPanel; Label1: TLabel; Label2: TLabel; Procedure btEnumRegClick(Sender: TObject); Private. { Private declarations }. RegDate: TDateTime; RegKeyInfo: TRegKeyInfo; TimeZoneInfo: TTimeZoneInformation; Function DateTimeToLocalDateTime(DateTime: TDateTime): TDateTime; Procedure FileTimeToDateTime(ft: TFileTime; var dt: TDateTime); Public. { Public declarations }. End; Var. FrmMain: TFrmMain; Implementation. {$R *.dfm}. Function TFrmMain.DateTimeToLocalDateTime(DateTime: TDateTime): TDateTime; Begin. Case GetTimeZoneInformation(TimeZoneInfo) of. TIME_ZONE_ID_STANDARD: Result := DateTime - (TimeZoneInfo.Bias / 60 / 24); TIME_ZONE_ID_DAYLIGHT: Result := DateTime - ((TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias) / 60 / 24); Else. Result := 0; End; End; Procedure TFrmMain.FileTimeToDateTime(ft: TFileTime; var dt: TDateTime); Var. SystemTime: TSystemTime; FileTime: TFileTime; Begin. If FileTimeToLocalFileTime(ft, FileTime) then. Begin. FileTimeToSystemTime(ft, SystemTime); Dt := SystemTimeToDateTime(SystemTime); End; End; Procedure TFrmMain.btEnumRegClick(Sender: TObject); Var. Inizio, Fine: TDateTime; Procedure EnumAllKeys(hkey: THandle; KeyName: string); Var. L: TStringList; N: Integer; KeyName_: string; Begin. KeyName_ := KeyName; With TRegistry.Create do. Try. RootKey := hkey; OpenKey(EmptyStr, False); L := TStringList.Create; Try. GetKeynames(l); CloseKey; For n := 0 to l.Count - 1 do. Begin. If OpenKey(l[n], False) then. Begin. GetKeyInfo(RegKeyInfo); With RegKeyInfo do. Begin. FileTimeToDateTime(FileTime, RegDate); RegDate := DateTimeToLocalDateTime(RegDate); End; If (RegDate <= Fine) and (RegDate >= Inizio) then. Memo1.Lines.Add(DateTimeToStr(RegDate) + ' --- ' + KeyName_ + '\' + l[n]); EnumAllKeys(CurrentKey, KeyName_ + '\' + l[n]); CloseKey; End; End; Finally. L.Free. End; Finally. Free; End; End; Begin. Memo1.Clear; Memo1.Lines.BeginUpdate; Inizio := int(dtBeginDate.DateTime) + frac(dtBeginTime.DateTime); Fine := int(dtEndDate.Date) + frac(dtEndTime.DateTime); Try. EnumAllKeys(HKEY_CURRENT_USER, 'HKey_Current_User'); Finally. Memo1.Lines.EndUpdate; End; MessageDlg('Enumeration ended', mtInformation, [mbOK], 0); End; End.
| Перечислить ключи реестра |
Code: { This example demonstrates how to enumerate all registry keys from. A certain key (here: HKEY_CURRENT_USER). } Uses. Registry; Procedure TForm1.Button1Click(Sender: TObject); Var. Indent: Integer; Procedure EnumAllKeys(hkey: THandle); Var. L: TStringList; N: Integer; Begin. Inc(indent, 2); With TRegistry.Create do. Try. RootKey := hkey; OpenKey(EmptyStr, False); L := TStringList.Create; Try. GetKeynames(l); CloseKey; For n := 0 to l.Count - 1 do. Begin. Memo1.Lines.Add(StringOfChar(' ', indent) + l[n]); If OpenKey(l[n], False) then. Begin. EnumAllKeys(CurrentKey); CloseKey; End; End; Finally. L.Free. End; Finally. Free; End; Dec(indent, 2); End; Begin. Memo1.Clear; Memo1.Lines.Add('Keys under HKEY_CURRENT_USER'); Indent := 0; Memo1.Lines.BeginUpdate; Try. EnumAllKEys(HKEY_CURRENT_USER); Finally. Memo1.Lines.EndUpdate; End; End;
Представление "TINY".
| Представление "TINY". |
10. Представление "TINY".
ВВЕДЕНИЕ.
В последней главе я показал вам основную идею нисходящей разработки компилятора. Я показал вам первые несколько шагов этого процесса для компиляторов Pascal и C, но я остановился далеко от его завершения. Причина была проста: если мы собираемся построить настоящий, функциональный компилятор для какого-нибудь языка, я предпочел бы сделать это для KISS, языка, который я определил в этой обучающей серии.
В этой главе мы собираемся сделать это же для подмножества KISS, которое я решил назвать TINY.
Этот процесс по существу будет аналогичен выделенному в главе 9, за исключением одного заметного различия. В той главе я предложил вам начать с полного БНФ описания языка. Это было бы прекрасно для какого-нибудь языка типа Pascal или C, определения которого устоялись. В случае же с TINY, однако, мы еще не имеем полного описания... мы будем определять язык по ходу дела. Это нормально. Фактически, это предпочтительней, так как мы можем немного подстраивать язык по ходу дела для сохранения простоты анализа.
Так что в последующей разработке мы фактически будем выполнять нисходящую разработку и языка и его компилятора. БНФ описание будет расти вместе с компилятором.
В ходе этого будет принят ряд решений, каждое из которых будет влиять на БНФ и, следовательно, характер языка. В каждой решающей точке я попытаюсь не забывать объяснять решение и разумное обоснование своего выбора. Если вам случится придерживаться другого мнения и вы предпочтете другой вариант, вы можете пойти своим путем. Сейчас вы имеет базу для этого. Я полагаю важно отметить, что ничего из того, что мы здесь делаем не подчинено каким-либо жесткими правилами. Когда вы разрабатываете свой язык вы не должны стесняться делать это своим способом.
Многие из вас могут сейчас спросить: зачем нужно начинать с самого начала? У нас есть работающее подмножество KISS как результат главы 7 (лексический анализ). Почему бы просто не расширить его как нужно? Ответ тройной. Прежде всего, я сделал несколько изменений для упрощения программы... типа изоляции процедур генерации кода, в результате чего мы можем более легко выполнять преобразование для различных машин. Во-вторых, я хочу, чтобы вы увидели что разработка действительно может быть выполнена сверху вниз как это подчеркнуто в последней главе. Наконец, нам всем нужна практика. Каждый раз, когда я прохожу через эти упражнения, я начинаю понимать немного больше, и вы будете тоже.
ПОДГОТОВКА.
Много лет назад существовали языки, называемые Tiny BASIC, Tiny Pascal и Tiny C, каждый из которых был подмножеством своего полного родительского языка. Tiny BASIC, к примеру, имел только одно-символьные имена переменных и глобальные переменные. Он поддерживал только один тип данных. Звучит знакомо? К этому моменту мы имеем почти все инструменты, необходимые для создания компилятора подобного этому.
Однако язык, называемый Tiny-такой-то все же несет некоторый багаж, унаследованный от своего родительского языка. Я часто задавался вопросом, хорошая ли это идея. Согласен, язык, основанный на каком-то родительском языке, будет иметь преимущество знакомости, но может также существовать некоторый особенный синтаксис, перенесенный из родительского языка, который может приводить к появлению ненужной сложности в компиляторе. (Нигде это не является большей истиной, чем в Small C).
Я задавался вопросом, насколько маленьким и простым может быть создан компилятор и при этом все еще быть полезным, если он разрабатывался из условия быть легким и для использования и для синтаксического анализа. Давайте выясним. Этот язык будет называться просто "TINY". Он является подмножеством KISS, который я также еще полностью не определил, что по крайней мере делает нас последовательными (!). Я полагаю вы могли бы назвать его TINY KISS. Но это открывает целую кучу проблем, так что давайте просто придерживаться имени TINY.
Главные ограничения TINY будут возникать из-за тех вещей, которые мы еще не рассмотрели, таких как типы данных. Подобно своим кузенам Tiny C и Tiny BASIC, TINY будет иметь только один тип данных, 16-разрядное целое число. Первая версия, которую мы разработаем, не будет также иметь вызовов процедур и будет использовать одно-символьные имена переменных, хотя, как вы увидите, мы можем удалить эти ограничения без особых усилий.
Язык, который я придумал, разделит некоторые хорошие особенности Pascal, C и Ada. Получив урок из сравнения компиляторов Pascal и C в предыдущей главе, TINY все же будет иметь преимущественно вкус Паскаля. Везде, где возможно, структура языка будет ограничена ключевыми словами или символами, так что синтаксический анализатор будет знать, что происходит без догадок.
Другое основное правило: Я хотел бы чтобы в течение всей разработки компилятор производил настоящий выполнимый код. Даже если его не может быть слишком много в самом начале, но по крайней мере он должен быть корректным.
Наконец, я буду использовать пару ограничений Pascal, которые имеют смысл: Все данные и процедуры должны быть объявлены перед тем, как они используются. Это имеет большой смысл, даже если сейчас единственным типом данных, который мы будем использовать, будет слово. Это правило, в свою очередь, означает, что единственное приемлемое место для размещения выполнимого кода основной программы - в конце листинга.
Определение верхнего уровня будет аналогично Pascal:
<program> ::= PROGRAM <top-level decl> <main> '.'
Мы уже достигли решающей точки. Моей первой мыслью было сделать основной блок необязательным. Кажется бессмысленным писать "программу" без основной программы, но это имеет смысл, если мы разрешим множественные модули, связанные вместе. Фактически я предполагаю учесть это в KISS. Но тогда мы столкнемся с кучей проблем, которые я предпочел бы сейчас не затрагивать. Например, термин "PROGRAM" в действительности становится неправильно употребляемым. MODULE из Modula-2 или UNIT из Turbo Pascal были бы более подходящими. Во-вторых, как насчет правил видимости? Нам необходимо соглашение для работы с видимостью имен в модулях. На данный момент лучше просто сохранить простоту и совершенно игнорировать эту идею.
Также необходимо определиться с требованием, чтобы основная программа была последней. Я играл с идеей сделать ее размещение нефиксированным как в C. Характер SK*DOS, ОС под которую я компилирую, позволяет сделать это очень просто. Но это в действительности не имеет большого смысла принимая во внимание Pascal-подобное требование, что все данные и процедуры должны быть объявлены прежде чем они используются. Так как основная программа может вызывать только те процедуры, которые уже были объявлены, единственное местоположение, имеющее смысл - в конце, a la Pascal.
По данной выше БНФ давайте напишем синтаксический анализатор, который просто распознает скобки:
Code: { Parse and Translate a Program }. Procedure Prog; Begin. Match('p'); Header; Prolog; Match('.'); Epilog; End;
Процедура Header просто выдает инициализационный код, необходимый ассемблеру:
Code: { Write Header Info }. Procedure Header; Begin. WriteLn('WARMST', TAB, 'EQU $A01E'); End;
Процедуры Prolog и Epilog выдают код для идентификации основной программы и для возвращения в ОС:
Code: { Write the Prolog }. Procedure Prolog; Begin. PostLabel('MAIN'); End; { Write the Epilog }. Procedure Epilog; Begin. EmitLn('DC WARMST'); EmitLn('END MAIN'); End;
Основная программа просто вызывает Prog и затем выполняет проверку на чистое завершение:
{ Main Program }.
Begin Init; Prog; if Look <> CR then Abort('Unexpected data after ''.'''); end.
Сейчас TINY примет только одну "программу" - пустую:
PROGRAM . (или 'p.' в нашей стенографии).
Заметьте, тем не менее, что компилятор генерирует для этой программы корректный код. Она будет выполняться и делать то, что можно ожидать от пустой программы, т.е. ничего кроме элегантного возвращения в ОС.
Один из моих любимых бенчмарков для компиляторов заключается в компиляции, связывании и выполнении пустой программы для любого языка. Вы можете многое узнать о реализации измеряя предел времени, необходимый для компиляции тривиальной программы. Также интересно измерить количество полученного кода. Во многих компиляторах код может быть довольно большим, потому что они всегда включают целую run-time библиотеку независимо от того, нуждаются они в ней или нет. Ранние версии Turbo Pascal в этом случае производили объектный файл 12К. VAX C генерирует 50К!
Самые маленькие пустые программы какие я видел, получены компиляторами Модула-2 и они занимают примерно 200-800 байт.
В случае TINY у нас еще нет run-time библиотеки, так что объектный код действительно крошечный (tiny): два байта. Это стало рекордом, и вероятно останется таковым, так как это минимальный размер, требуемый ОС.
Следующим шагом будет обработка кода для основной программы. Я буду использовать блок BEGIN из Pascal:
<main> ::= BEGIN <block> END.
Здесь мы снова приняли решение. Мы могли бы потребовать использовать объявление вида "PROCEDURE MAIN", подобно C. Я должен допустить, что это совсем неплохая идея... Мне не особенно нравится подход Паскаля так как я предпочитаю не иметь проблем с определением местоположения основной программы в листинге Паскаля. Но альтернатива тоже немного неудобна, так как вы должны работать с проверкой ошибок когда пользователь опустит основную программу или сделает орфографическую ошибку в ее названии. Здесь я использую простой выход.
Другое решение проблемы "где расположена основная программа" может заключаться в требовании имени для программы и заключения основной программы в скобки:
BEGIN <name>
END <name>
Аналогично соглашению Модула-2. Это добавляет в язык немного "синтаксического сахара". Подобные вещи легко добавлять и изменять по вашим симпатиям если вы сами проектируете язык.
Для синтаксического анализа такого определения основного блока измените процедуру Prog следующим образом:
Code: { Parse and Translate a Program }. Procedure Prog; Begin. Match('p'); Header; Main; Match('.'); End; И добавьте новую процедуру: { Parse and Translate a Main Program }. Procedure Main; Begin. Match('b'); Prolog; Match('e'); Epilog; End;
Теперь единственной допустимой программой является программа:
PROGRAM BEGIN END. (или 'pbe.').
Разве мы не делаем успехи??? Хорошо, как обычно это становится лучше. Вы могли бы попробовать сделать здесь некоторые преднамеренные ошибки подобные пропуску 'b' или 'e' и посмотреть что случится. Как всегда компилятор должен отметить все недопустимые входные символы.
ОБЪЯВЛЕНИЯ.
Очевидно на следующем шаге необходимо решить, что мы подразумеваем под объявлением. Я намереваюсь иметь два вида объявлений: переменных и процедур/функций. На верхнем уровне разрешены только глобальные объявления, точно как в C.
Сейчас здесь могут быть только объявления переменных, идентифицируемые по ключевому слову VAR (сокращенно "v").
<top-level decls> ::= ( <data declaration> )*
<data declaration> ::= VAR <var-list>
Обратите внимание, что так как имеется только один тип переменных, нет необходимости объявлять этот тип. Позднее, для полной версии KISS, мы сможем легко добавить описание типа.
Процедура Prog становится:
Code: { Parse and Translate a Program }. Procedure Prog; Begin. Match('p'); Header; TopDecls; Main; Match('.'); End; Теперь добавьте две новые процедуры: { Process a Data Declaration }. Procedure Decl; Begin. Match('v'); GetChar; End; { Parse and Translate Global Declarations }. Procedure TopDecls; Begin. While Look <> 'b' do. Case Look of. 'v': Decl; Else Abort('Unrecognized Keyword ''' + Look + ''''); End; End;
Заметьте, что на данный момент Decl - просто заглушка. Она не генерирует никакого кода и не обрабатывает список... каждая переменная должна быть в отдельном утверждении VAR.
ОК, теперь у нас может быть любое число объявлений данных, каждое начинается с "v" вместо VAR, перед блоком BEGIN. Попробуйте несколько вариантов и посмотрите, что происходит.
ОБЪЯВЛЕНИЯ И ИДЕНТИФИКАТОРЫ.
Это выглядит довольно хорошо, но мы все еще генерируем только пустую программу. Настоящий ассемблер должен выдавать директивы ассемблера для распределения памяти под переменные. Пришло время действительно получить какой-нибудь код.
С небольшим дополнительным кодом это легко сделать в процедуре Decl. Измените ее следующим образом:
Code: { Parse and Translate a Data Declaration }. Procedure Decl; Var Name: char; Begin. Match('v'); Alloc(GetName); End;
Процедура Alloc просто выдает команду ассемблеру для распределения памяти:
Code: { Allocate Storage for a Variable }. Procedure Alloc(N: char); Begin. WriteLn(N, ':', TAB, 'DC 0'); End;
Погоняйте программу. Попробуйте входную последовательность, которая объявляет какие-нибудь переменные, например:
Pvxvyvzbe.
Видите, как распределяется память? Просто, да? Заметьте также, что точка входа "MAIN" появляется в правильном месте.
Кстати, "настоящий" компилятор имел бы также таблицу идентификаторов для записи используемых переменных. Обычно, таблица идентификаторов необходима для записи типа каждой переменной. Но так как в нашем случае все переменные имеют один и тот же тип, нам не нужна таблица идентификаторов. Оказывается, мы смогли бы находить идентификатор даже без различия типов, но давайте отложим это пока не возникнет такая необходимость.
Конечно, в действительности мы не анализировали правильный синтаксис для объявления данных, так как он включает список переменных. Наша версия разрешает только одну переменную. Это также легко исправить.
БНФ для <var-list> следующая:
<var-list> ::= <ident> (, <ident>)*
Добавление этого синтаксиса в Decl дает новую версию:
Code: { Parse and Translate a Data Declaration }. Procedure Decl; Var Name: char; Begin. Match('v'); Alloc(GetName); While Look = ',' do begin. GetChar; Alloc(GetName); End; End;
ОК, теперь откомпилируйте этот код и испытайте его. Попробуйте ряд строк с объявлениями VAR, попробуйте список из нескольких переменных в одной строке и комбинации этих двух.
Работает?
ИНИЦИАЛИЗАТОРЫ.
Пока мы работали с объявлениями данных, меня беспокоила одна вещь - то, что Pascal не позволяет инициализировать данные в объявлении. Эта возможность по общему признанию является своего рода излишеством, и ее может не быть в языке, который считается минимальным языком. Но ее также настолько просто добавить, что было бы позором не сделать этого. БНФ становится:
<var-list> ::= <var> ( <var> )*
<var> ::= <ident> [ = <integer> ].
Измените Alloc как показано ниже:
Code: { Allocate Storage for a Variable }. Procedure Alloc(N: char); Begin. Write(N, ':', TAB, 'DC '); If Look = '=' then begin. Match('='); WriteLn(GetNum); End. Else. WriteLn('0'); End;
Вот оно: инициализатор в шесть дополнительных строк Pascal.
Испытайте эту версию TINY и проверьте, что вы действительно можете задавать начальное значение переменных.
Ей богу, он начинает походить на настоящий компилятор! Конечно, он все еще ничего не делает, но выглядит хорошо, не так ли?
Перед тем как оставить этот раздел я должен подчеркнуть, что мы использовали две версии GetNum. Одна, более ранняя, возвращала символьное значение, одиночную цифру. Другая принимала многозначное целое число и возвращала целочисленное значение. Любая из них будет работать здесь, так как WriteLn поддерживает оба типа. Но нет никакой причины ограничивать себя одноразрядными значениями, так что правильной версией для использования будет та, которая возвращает целое число. Вот она:
Code: { Get a Number }. Function GetNum: integer; Var Val: integer; Begin. Val := 0; If not IsDigit(Look) then Expected('Integer'); While IsDigit(Look) do begin. Val := 10 * Val + Ord(Look) - Ord('0'); GetChar; End; GetNum := Val; End;
Строго говоря, мы должны разрешить выражения в поле данных инициализатора, или, по крайней мере, отрицательные значения. Сейчас давайте просто разрешим отрицательные значения изменив код для Alloc следующим образом:
Code: { Allocate Storage for a Variable }. Procedure Alloc(N: char); Begin. If InTable(N) then Abort('Duplicate Variable Name ' + N); ST[N] := 'v'; Write(N, ':', TAB, 'DC '); If Look = '=' then begin. Match('='); If Look = '-' then begin. Write(Look); Match('-'); End; WriteLn(GetNum); End. Else. WriteLn('0'); End;
Теперь у вас есть возможность инициализировать переменные отрицательными и/или многозначными значениями.
ТАБЛИЦА ИДЕНТИФИКАТОРОВ.
Существует одна проблема с компилятором в его текущем состоянии: он ничего не делает для сохранения переменной когда мы ее объявляем. Так что компилятор совершенно спокойно распределит память для нескольких переменных с тем же самым именем. Вы можете легко убедиться в этом набрав строку типа.
Pvavavabe.
Здесь мы объявили переменную A три раза. Как вы можете видеть, компилятор бодро принимает это и генерирует три идентичных метки. Не хорошо.
Позднее, когда мы начнем ссылаться на переменные, компилятор также будет позволять нам ссылаться на переменные, которые не существуют. Ассемблер отловит обе эти ошибки, но это совсем не кажется дружественным поведением - передавать такую ошибку ассемблеру. Компилятор должен отлавливать такие вещи на уровне исходного языка.
Так что даже притом, что нам не нужна таблица идентификаторов для записи типов данных, мы должны установить ее только для того, чтобы проверять эти два условия. Так как пока мы все еще ограничены одно-символьными именами переменных таблица идентификаторов может быть тривиальной. Чтобы предусмотреть ее сначала добавьте следующее объявление в начало вашей программы:
Var ST: array['A'..'Z'] of char;
И вставьте следующую функцию:
Code: { Look for Symbol in Table }. Function InTable(n: char): Boolean; Begin. InTable := ST[n] <> ' '; End;
Нам также необходимо инициализировать таблицу пробелами. Следующие строки в Init сделают эту работу:
Var i: char;
Begin for i := 'A' to 'Z' do ST[i] := ' ';
...
Наконец, вставьте следующие две строки в начало Alloc:
If InTable(N) then Abort('Duplicate Variable Name ' + N);
ST[N] := 'v';
Это должно все решить. Теперь компилятор будет отлавливать двойные объявления. Позднее мы также сможем использовать InTable при генерации ссылок на переменные.
ВЫПОЛНИМЫЕ УТВЕРЖДЕНИЯ.
К этому времени мы можем генерировать пустую программу, которая имеет несколько объявленных переменных и возможно инициализированных. Но пока мы не генерировали ни строки выполнимого кода.
Верите ли вы или нет, но мы почти имеем пригодный для использования компилятор! Отсутствует только выполнимый код, который должен входить в основную программу. Но этот код - это только операции присваивания и операторы управления... все вещи, которые мы сделали раньше. Так что у нас не должно занять слишком много времени предусмотреть также и их.
БНФ определение, данное раньше для основной программы, включало операторный блок, который мы пока что игнорировали:
<main> ::= BEGIN <block> END.
Сейчас мы можем рассматривать блок просто как серию операций присваивания:
<block> ::= (Assignment)*
Давайте начнем с добавления синтаксического анализатора для блока. Мы начнем с процедуры-заглушки для операции присваивания:
Code: { Parse and Translate an Assignment Statement }. Procedure Assignment; Begin. GetChar; End; { Parse and Translate a Block of Statements }. Procedure Block; Begin. While Look <> 'e' do. Assignment; End;
Измените процедуру Main чтобы она вызывала Block как показано ниже:
Code: { Parse and Translate a Main Program }. Procedure Main; Begin. Match('b'); Prolog; Block; Match('e'); Epilog; End;
Эта версия все еще не генерирует никакого кода для "операций присваивания"... все что она делает это съедает символы до тех пор, пока не увидит "e", означающее "END". Но она устанавливает основу для того, что следует дальше.
Следующий шаг, конечно, - это расширение кода для операций присваивания. Это то, что мы делали много раз до этого, поэтому я не буду задерживаться на этом. На этот раз, однако, я хотел бы работать с генерацией кода немного по-другому. До настоящего времени мы всегда просто вставляли Emits, которые генерируют выходной код в соответствии с подпрограммами синтаксического анализа. Немного неструктурно, возможно, но это кажется самым простым способом и помогает видеть, какой код должен быть выдан для каждой конструкции.
Однако, я понимаю, что большинство из вас используют компьютер 80x86, так что от кода, сгенерированного для 68000 вам мало пользы. Некоторые из вас спрашивали меня, что если бы машиннозависимый код мог бы быть собран в одном месте, то было бы проще перенастроить его на другой ЦПУ. Ответ конечно да.
Чтобы сделать это вставьте следующие подпрограммы "генерации кода":
Code: {---------------------------------------------------------------} { Clear the Primary Register }. Procedure Clear; Begin. EmitLn('CLR D0'); End; {---------------------------------------------------------------} { Negate the Primary Register }. Procedure Negate; Begin. EmitLn('NEG D0'); End; {---------------------------------------------------------------} { Load a Constant Value to Primary Register }. Procedure LoadConst(n: integer); Begin. Emit('MOVE #'); WriteLn(n, ',D0'); End; {---------------------------------------------------------------} { Load a Variable to Primary Register }. Procedure LoadVar(Name: char); Begin. If not InTable(Name) then Undefined(Name); EmitLn('MOVE ' + Name + '(PC),D0'); End; {---------------------------------------------------------------} { Push Primary onto Stack }. Procedure Push; Begin. EmitLn('MOVE D0,-(SP)'); End; {---------------------------------------------------------------} { Add Top of Stack to Primary }. Procedure PopAdd; Begin. EmitLn('ADD (SP)+,D0'); End; {---------------------------------------------------------------} { Subtract Primary from Top of Stack }. Procedure PopSub; Begin. EmitLn('SUB (SP)+,D0'); EmitLn('NEG D0'); End; {---------------------------------------------------------------} { Multiply Top of Stack by Primary }. Procedure PopMul; Begin. EmitLn('MULS (SP)+,D0'); End; {---------------------------------------------------------------} { Divide Top of Stack by Primary }. Procedure PopDiv; Begin. EmitLn('MOVE (SP)+,D7'); EmitLn('EXT.L D7'); EmitLn('DIVS D0,D7'); EmitLn('MOVE D7,D0'); End; {---------------------------------------------------------------} { Store Primary to Variable }. Procedure Store(Name: char); Begin. If not InTable(Name) then Undefined(Name); EmitLn('LEA ' + Name + '(PC),A0'); EmitLn('MOVE D0,(A0)'). End; {---------------------------------------------------------------}
Приятная особенность такого подхода, конечно, в том что мы можем перенастроить компилятор на новый ЦПУ просто переписав эти процедуры "генератора кода". Кроме того, позднее мы обнаружим что можем улучшить качество кода немного подправляя эти процедуры без необходимости изменения компилятора.
Обратите внимание, что и LoadVar и Store проверяют таблицу идентификаторов чтобы удостовериться, что переменная определена. Обработчик ошибки Undefined просто вызывает Abort:
Code: { Report an Undefined Identifier }. Procedure Undefined(n: string); Begin. Abort('Undefined Identifier ' + n); End;
Итак, теперь мы наконец готовы начать обработку выполнимого кода. Мы сделаем это заменив пустую версию процедуры Assignment.
Мы проходили этот путь много раз прежде, так что все это должно быть вам знакомо. Фактически, если бы не изменения, связанные с генерацией кода, мы могли бы просто скопировать процедуры из седьмой части. Так как мы сделали некоторые изменения я не буду их просто копировать, но мы пройдем немного быстрее, чем обычно.
БНФ для операций присваивания:
<assignment> ::= <ident> = <expression>
<expression> ::= <first term> ( <addop> <term> )*
<first term> ::= <first factor> <rest>
<term> ::= <factor> <rest>
<rest> ::= ( <mulop> <factor> )*
<first factor> ::= [ <addop> ] <factor>
<factor> ::= <var> | <number> | ( <expression> ).
Эта БНФ также немного отличается от той, что мы использовали раньше... еще одна "вариация на тему выражений". Эта специфичная версия имеет то, что я считаю лучшей обработкой унарного минуса. Как вы увидите позднее, это позволит нам очень эффективно обрабатывать отрицательные константы. Здесь стоит упомянуть, что мы часто видели преимущества "подстраивания" БНФ по ходу дела, с цель сделать язык легким для анализа. То, что вы видите здесь, немного другое: мы подстраиваем БНФ для того, чтобы сделать генерацию кода более эффективной! Это происходит впервые в этой серии.
Во всяком случае, следующий код реализует эту БНФ:
Code: {---------------------------------------------------------------} { Parse and Translate a Math Factor }. Procedure Expression; Forward; Procedure Factor; Begin. If Look = '(' then begin. Match('('); Expression; Match(')'); End. Else if IsAlpha(Look) then. LoadVar(GetName). Else. LoadConst(GetNum); End; { Parse and Translate a Negative Factor }. Procedure NegFactor; Begin. Match('-'); If IsDigit(Look) then. LoadConst(-GetNum). Else begin. Factor; Negate; End; End; { Parse and Translate a Leading Factor }. Procedure FirstFactor; Begin. Case Look of. '+': begin. Match('+'); Factor; End; '-': NegFactor; Else Factor; End; End; { Recognize and Translate a Multiply }. Procedure Multiply; Begin. Match('*'); Factor; PopMul; End; {-------------------------------------------------------------} { Recognize and Translate a Divide }. Procedure Divide; Begin. Match('/'); Factor; PopDiv; End; {---------------------------------------------------------------} { Common Code Used by Term and FirstTerm }. Procedure Term1; Begin. While IsMulop(Look) do begin. Push; Case Look of. '*': Multiply; '/': Divide; End; End; End; {---------------------------------------------------------------} { Parse and Translate a Math Term }. Procedure Term; Begin. Factor; Term1; End; {---------------------------------------------------------------} { Parse and Translate a Leading Term }. Procedure FirstTerm; Begin. FirstFactor; Term1; End; { Recognize and Translate an Add }. Procedure Add; Begin. Match('+'); Term; PopAdd; End; {-------------------------------------------------------------} { Recognize and Translate a Subtract }. Procedure Subtract; Begin. Match('-'); Term; PopSub; End; {---------------------------------------------------------------} { Parse and Translate an Expression }. Procedure Expression; Begin. FirstTerm; While IsAddop(Look) do begin. Push; Case Look of. '+': Add; '-': Subtract; End; End; End; { Parse and Translate an Assignment Statement }. Procedure Assignment; Var Name: char; Begin. Name := GetName; Match('='); Expression; Store(Name); End;
ОК, если вы вставили весь этот код, тогда откомпилируйте и проверьте его. Вы должны увидеть приемлемо выглядящий код, представляющий собой законченную программу, которая будет ассемблироваться и выполняться. У нас есть компилятор!
БУЛЕВА ЛОГИКА.
Следующий шаг также должен быть вам знаком. Мы должны добавить булевы выражения и операторы отношений. Снова, так как мы работали с ними не один раз, я не буду подробно разбирать их за исключением моментов, в которых они отличаются от того, что мы делали прежде. Снова, мы не будем просто копировать их из других файлов потому что я немного изменил некоторые вещи. Большинство изменений просто включают изоляцию машинно-зависимых частей как мы делали для арифметических операций. Я также несколько изменил процедуру NotFactor для соответствия структуре FirstFactor. Наконец я исправил ошибку в объектном коде для операторов отношений: в инструкции Scc я использовал только младшие 8 бит D0. Нам нужно установить логическую истину для всех 16 битов поэтому я добавил инструкцию для изменения младшего байта.
Для начала нам понадобятся несколько подпрограмм распознавания:
Code: { Recognize a Boolean Orop }. Function IsOrop(c: char): boolean; Begin. IsOrop := c in ['|', '~']; End; { Recognize a Relop }. Function IsRelop(c: char): boolean; Begin. IsRelop := c in ['=', '#', '<', '>']; End;
Также нам понадобятся несколько подпрограмм генерации кода:
Code: {---------------------------------------------------------------} { Complement the Primary Register }. Procedure NotIt; Begin. EmitLn('NOT D0'); End; {---------------------------------------------------------------} . . . {---------------------------------------------------------------} { AND Top of Stack with Primary }. Procedure PopAnd; Begin. EmitLn('AND (SP)+,D0'); End; {---------------------------------------------------------------} { OR Top of Stack with Primary }. Procedure PopOr; Begin. EmitLn('OR (SP)+,D0'); End; {---------------------------------------------------------------} { XOR Top of Stack with Primary }. Procedure PopXor; Begin. EmitLn('EOR (SP)+,D0'); End; {---------------------------------------------------------------} { Compare Top of Stack with Primary }. Procedure PopCompare; Begin. EmitLn('CMP (SP)+,D0'); End; {---------------------------------------------------------------} { Set D0 If Compare was = }. Procedure SetEqual; Begin. EmitLn('SEQ D0'); EmitLn('EXT D0'); End; {---------------------------------------------------------------} { Set D0 If Compare was != }. Procedure SetNEqual; Begin. EmitLn('SNE D0'); EmitLn('EXT D0'); End; {---------------------------------------------------------------} { Set D0 If Compare was > }. Procedure SetGreater; Begin. EmitLn('SLT D0'); EmitLn('EXT D0'); End; {---------------------------------------------------------------} { Set D0 If Compare was < }. Procedure SetLess; Begin. EmitLn('SGT D0'); EmitLn('EXT D0'); End; {---------------------------------------------------------------}
Все это дает нам необходимые инструменты. БНФ для булевых выражений такая:
<bool-expr> ::= <bool-term> ( <orop> <bool-term> )*
<bool-term> ::= <not-factor> ( <andop> <not-factor> )*
<not-factor> ::= [ '!' ] <relation>
<relation> ::= <expression> [ <relop> <expression> ].
Зоркие читатели могли бы заметить, что этот синтаксис не включает нетерминал "bool-factor" используемый в ранних версиях. Тогда он был необходим потому, что я также разрешал булевы константы TRUE и FALSE. Но не забудьте, что в TINY нет никакого различия между булевыми и арифметическими типами... они могут свободно смешиваться. Так что нет нужды в этих предопределенных значениях... мы можем просто использовать -1 и 0 соответственно.
В терминологии C мы могли бы всегда использовать определения:
#define TRUE -1.
#define FALSE 0.
(Так было бы, если бы TINY имел препроцессор.) Позднее, когда мы разрешим объявление констант, эти два значения будут предопределены языком.
Причина того, что я заостряю на этом ваше внимание, в том что я пытался использовать альтернативный путь, который заключался в использовании TRUE и FALSE как ключевых слов. Проблема с этим подходом в том, что он требует лексического анализа каждого имени переменной в каждом выражении. Как вы помните, я указал в главе 7, что это значительно замедляет компилятор. Пока ключевые слова не могут быть в выражениях нам нужно выполнять сканирование только в начале каждого нового оператора... значительное улучшение. Так что использование вышеуказанного синтаксиса не только упрощает синтаксический анализ, но также ускоряет сканирование.
Итак, если мы удовлетворены синтаксисом, представленным выше, то соответствующий код показан ниже:
Code: {---------------------------------------------------------------} { Recognize and Translate a Relational "Equals" }. Procedure Equals; Begin. Match('='); Expression; PopCompare; SetEqual; End; {---------------------------------------------------------------} { Recognize and Translate a Relational "Not Equals" }. Procedure NotEquals; Begin. Match('#'); Expression; PopCompare; SetNEqual; End; {---------------------------------------------------------------} { Recognize and Translate a Relational "Less Than" }. Procedure Less; Begin. Match('<'); Expression; PopCompare; SetLess; End; {---------------------------------------------------------------} { Recognize and Translate a Relational "Greater Than" }. Procedure Greater; Begin. Match('>'); Expression; PopCompare; SetGreater; End; {---------------------------------------------------------------} { Parse and Translate a Relation }. Procedure Relation; Begin. Expression; If IsRelop(Look) then begin. Push; Case Look of. '=': Equals; '#': NotEquals; '<': Less; '>': Greater; End; End; End; {---------------------------------------------------------------} { Parse and Translate a Boolean Factor with Leading NOT }. Procedure NotFactor; Begin. If Look = '!' then begin. Match('!'); Relation; NotIt; End. Else. Relation; End; {---------------------------------------------------------------} { Parse and Translate a Boolean Term }. Procedure BoolTerm; Begin. NotFactor; While Look = '&' do begin. Push; Match('&'); NotFactor; PopAnd; End; End; { Recognize and Translate a Boolean OR }. Procedure BoolOr; Begin. Match('|'); BoolTerm; PopOr; End; { Recognize and Translate an Exclusive Or }. Procedure BoolXor; Begin. Match('~'); BoolTerm; PopXor; End; {---------------------------------------------------------------} { Parse and Translate a Boolean Expression }. Procedure BoolExpression; Begin. BoolTerm; While IsOrOp(Look) do begin. Push; Case Look of. '|': BoolOr; '~': BoolXor; End; End; End;
Чтобы связать все это вместе не забудьте изменить обращение к Expression в процедурах Factor и Assignment на вызов BoolExpression.
Хорошо, если вы набрали все это, откомпилируйте и погоняйте эту версию. Сначала удостоверьтесь, что вы все еще можете анализировать обычные арифметические выражения. Затем попробуйте булевские. Наконец удостоверьтесь, что вы можете присваивать результат сравнения. Попробуйте к примеру:
Pvx,y,zbx=z>ye.
Что означает.
PROGRAM.
VAR X,Y,Z.
BEGIN.
X = Z > Y.
END.
Видите как происходит присваивание булевского значения X?
УПРАВЛЯЮЩИЕ СТРУКТУРЫ.
Мы почти дома. Имея булевы выражения легко добавить управляющие структуры. Для TINY мы разрешим только две из них, IF и WHILE:
<if> ::= IF <bool-expression> <block> [ ELSE <block>] ENDIF.
<while> ::= WHILE <bool-expression> <block> ENDWHILE.
Еще раз позвольте мне разъяснить решения, подразумевающиеся в этом синтаксисе, который сильно отличается от синтаксиса C или Pascal. В обоих этих языках "тело" IF или WHILE расценивается как одиночный оператор. Если вы предполагаете использовать блок из более чем одного оператора вы должны создать составной утверждение использую BEGIN-END (в Pascal) или '{}' (в C). В TINY (и KISS) нет таких вещей как составное утверждение... одиночное или множественное, они являются в этом языке просто блоками.
В KISS все управляющие структуры имеют явные и уникальные ключевые слова, выделяющие операторный блок поэтому не может быть никакой путаницы где он начинается и заканчивается. Это современный подход, используемый в таких уважаемых языках, как Ada и Modula-2 и он полностью устраняет проблему "висячих else".
Обратите внимание, что я мог бы использовать то же самое ключевое слово END для завершения всех конструкций, как это сделано в Pascal. (Закрывающая '}' в C служит той же самой цели.) Но это всегда вело к неразберихе, вот почему программисты на Pascal предпочитают писать так:
End { loop }.
Или end { if }.
Как я объяснил в пятой части, использование уникальных терминальных ключевых слов увеличивает размер списка ключевых слов и, следовательно, замедляет лексический анализ, но в данном случае это кажется небольшой ценой за дополнительную подстраховку. Лучше обнаруживать ошибки во время компиляции, чем во время выполнения.
Одна последняя мысль: каждая из двух конструкций выше имеют нетерминалы.
<bool-expression> и <block>,
Расположенные рядом без разделяющих ключевых слов. В Паскале мы ожидали бы в этом месте ключевые слова THEN и DO.
Я не вижу проблем в том, чтобы опустить эти ключевые слова, и синтаксический анализатор также не будет иметь проблем, при условии, что мы не сделаем ошибок в bool-expression. С другой стороны, если мы включим эти дополнительные ключевые слова мы получили бы еще один уровень подстраховки за малые деньги, и с этим у меня также нет проблем. Примите правильное решение, каким путем пойти.
ОК, после этого небольшого объяснения давайте продолжим. Как обычно нам понадобятся несколько новых подпрограмм генерации кода. Они генерируют код для условных и безусловных переходов:
Code: {---------------------------------------------------------------} { Branch Unconditional }. Procedure Branch(L: string); Begin. EmitLn('BRA ' + L); End; {---------------------------------------------------------------} { Branch False }. Procedure BranchFalse(L: string); Begin. EmitLn('TST D0'); EmitLn('BEQ ' + L); End;
Исключая изоляцию подпрограмм генератора кода, код для анализа управляющих конструкций такой же, как вы видели прежде:
Code: {---------------------------------------------------------------} { Recognize and Translate an IF Construct }. Procedure Block; Forward; Procedure DoIf; Var L1, L2: string; Begin. Match('i'); BoolExpression; L1 := NewLabel; L2 := L1; BranchFalse(L1); Block; If Look = 'l' then begin. Match('l'); L2 := NewLabel; Branch(L2); PostLabel(L1); Block; End; PostLabel(L2); Match('e'); End; { Parse and Translate a WHILE Statement }. Procedure DoWhile; Var L1, L2: string; Begin. Match('w'); L1 := NewLabel; L2 := NewLabel; PostLabel(L1); BoolExpression; BranchFalse(L2); Block; Match('e'); Branch(L1); PostLabel(L2); End;
Чтобы связать все это вместе нам нужно только изменить процедуру Block чтобы распознавать ключевые слова IF и WHILE. Как обычно мы расширим определение блока так:
<block> ::= ( <statement> )*
Где.
<statement> ::= <if> | <while> | <assignment>
Соответствующий код:
Code: { Parse and Translate a Block of Statements }. Procedure Block; Begin. While not(Look in ['e', 'l']) do begin. Case Look of. 'i': DoIf; 'w': DoWhile; Else Assignment; End; End; End;
Добавьте подпрограммы, которые я дал, откомпилируйте и протестируйте их. У вас должна быть возможность анализировать одно-символьные версии любых управляющих конструкции. Выглядит довольно хорошо!
Фактически, за исключением одно-символьного ограничения, мы получили практически полную версию TINY. Я назову его TINY Version 0.1.
ЛЕКСИЧЕСКИЙ АНАЛИЗ.
Конечно, вы знаете, что будет дальше: Мы должны преобразовать программу так, чтобы она могла работать с много символьными ключевыми словами, переводами строк и пробелами. Мы только что прошли все это в седьмой главе. Мы будем использовать метод распределенного сканера, который я показал вам в этой главе. Фактическая реализация немного отличается, потому что различается способ, которым я обрабатываю переводы строк.
Для начала, давайте просто разрешим пробелы. Для этого необходимо только добавить вызовы SkipWhite в конец трех подпрограмм GetName, GetNum и Match. Вызов SkipWhite в Init запускает помпу в случае если есть ведущие пробелы.
Затем мы должны обрабатывать переводы строк. Это в действительности двух шаговый процесс так как обработка переносов с одно-символьными токенами отличается от таковой для много символьных токенов. Мы можем устранить часть работы сделав оба шага одновременно, но я чувствую себя спокойней, работая последовательно.
Вставьте новую процедуру:
Code: { Skip Over an End-of-Line }. Procedure NewLine; Begin. While Look = CR do begin. GetChar; If Look = LF then GetChar; SkipWhite; End; End;
Заметьте, что мы видели эту процедуру раньше в виде процедуры Fin. Я изменил имя, так как новое кажется более соответствующим фактическому назначению. Я также изменил код чтобы учесть множественные переносы и строки только с пробелами.
Следующим шагом будет вставка вызовов NewLine везде, где мы посчитаем перенос допустимым. Как я подчеркивал ранее, этот момент может очень различаться для разных языков. В TINY я решил разрешить их практически в любом месте. Это означает, что нам нужно вызывать NewLine в начале (не в конце как с SkipWhite) процедур GetName, GetNum и Match.
Для процедур, которые имеют циклы While, таких как TopDecl, нам нужен вызов NewLine в начале процедуры и в конце каждого цикла. Таким способом мы можем быть уверены, что NewLine вызывается в начале каждого прохода через цикл.
Если вы все это сделали, испытайте программу и проверьте, что она действительно обрабатывает пробелы и переносы.
Если это так, тогда мы готовы работать с много символьными токенами и ключевыми словами. Для начала, добавьте дополнительные объявления (скопированные почти дословно из главы 7):
Code: { Type Declarations }. Type Symbol = string[8]; SymTab = array[1..1000] of Symbol; TabPtr = ^SymTab; { Variable Declarations }. Var Look : char; { Lookahead Character }. Token: char; { Encoded Token }. Value: string[16]; { Unencoded Token }. ST: Array['A'..'Z'] of char; { Definition of Keywords and Token Types }. Const NKW = 9; NKW1 = 10; Const KWlist: array[1..NKW] of Symbol = ('IF', 'ELSE', 'ENDIF', 'WHILE', 'ENDWHILE', 'VAR', 'BEGIN', 'END', 'PROGRAM'); Const KWcode: string[NKW1] = 'xilewevbep';
Затем добавьте три процедуры, также из седьмой главы:
Code: { Table Lookup }. Function Lookup(T: TabPtr; s: string; n: integer): integer; Var i: integer; Found: Boolean; Begin. Found := false; I := n; While (i > 0) and not found do. If s = T^[i] then. Found := true. Else. Dec(i); Lookup := i; End; . . { Get an Identifier and Scan it for Keywords }. Procedure Scan; Begin. GetName; Token := KWcode[Lookup(Addr(KWlist), Value, NKW) + 1]; End; . . { Match a Specific Input String }. Procedure MatchString(x: string); Begin. If Value <> x then Expected('''' + x + ''''); End;
Теперь мы должны сделать довольно много тонких изменений в оставшихся процедурах. Сначала мы должны изменить функцию GetName на процедуру, снова как в главе 7:
Code: { Get an Identifier }. Procedure GetName; Begin. NewLine; If not IsAlpha(Look) then Expected('Name'); Value := ''; While IsAlNum(Look) do begin. Value := Value + UpCase(Look); GetChar; End; SkipWhite; End;
Обратите внимание, что эта процедура оставляет свой результат в глобальной строковой переменной Value.
Затем, мы должны изменить каждую обращение к GetName чтобы отразить ее новую форму. Они происходят в Factor, Assignment и Decl:
Code: {---------------------------------------------------------------} { Parse and Translate a Math Factor }. Procedure BoolExpression; Forward; Procedure Factor; Begin. If Look = '(' then begin. Match('('); BoolExpression; Match(')'); End. Else if IsAlpha(Look) then begin. GetName; LoadVar(Value[1]); End. Else. LoadConst(GetNum); End; . . { Parse and Translate an Assignment Statement }. Procedure Assignment; Var Name: char; Begin. Name := Value[1]; Match('='); BoolExpression; Store(Name); End; {---------------------------------------------------------------} . . { Parse and Translate a Data Declaration }. Procedure Decl; Begin. GetName; Alloc(Value[1]); While Look = ',' do begin. Match(','); GetName; Alloc(Value[1]); End; End;
(Заметьте, что мы все еще разрешаем только одно-символьные имена переменных поэтому мы используем здесь простое решение и просто используем первый символ строки.).
Наконец, мы должны внести изменения, позволяющие использовать Token вместо Look как символа для проверки и вызывать Scan в подходящих местах. По большей части это включает удаление вызовов Match, редкие замены вызовов Match на вызовы MatchString, и замену вызовов NewLine на вызовы Scan. Вот затронутые подпрограммы:
Code: {---------------------------------------------------------------} { Recognize and Translate an IF Construct }. Procedure Block; Forward; Procedure DoIf; Var L1, L2: string; Begin. BoolExpression; L1 := NewLabel; L2 := L1; BranchFalse(L1); Block; If Token = 'l' then begin. L2 := NewLabel; Branch(L2); PostLabel(L1); Block; End; PostLabel(L2); MatchString('ENDIF'); End; { Parse and Translate a WHILE Statement }. Procedure DoWhile; Var L1, L2: string; Begin. L1 := NewLabel; L2 := NewLabel; PostLabel(L1); BoolExpression; BranchFalse(L2); Block; MatchString('ENDWHILE'); Branch(L1); PostLabel(L2); End; { Parse and Translate a Block of Statements }. Procedure Block; Begin. Scan; While not(Token in ['e', 'l']) do begin. Case Token of. 'i': DoIf; 'w': DoWhile; Else Assignment; End; Scan; End; End; { Parse and Translate Global Declarations }. Procedure TopDecls; Begin. Scan; While Token <> 'b' do begin. Case Token of. 'v': Decl; Else Abort('Unrecognized Keyword ' + Value); End; Scan; End; End; { Parse and Translate a Main Program }. Procedure Main; Begin. MatchString('BEGIN'); Prolog; Block; MatchString('END'); Epilog; End; { Parse and Translate a Program }. Procedure Prog; Begin. MatchString('PROGRAM'); Header; TopDecls; Main; Match('.'); End; { Initialize }. Procedure Init; Var i: char; Begin. For i := 'A' to 'Z' do. ST[i] := ' '; GetChar; Scan; End;
Это должно работать. Если все изменения сделаны правильно, вы должны теперь анализировать программы, которые выглядят как программы. (Если вы не сделали всех изменений, не отчаивайтесь. Полный листинг конечной формы дан ниже.).
Работает? Если да, то мы почти дома. Фактически, с несколькими небольшими исключениями, мы уже получили компилятор, пригодный для использования. Имеются еще несколько областей, требующих усовершенствования.
МНОГОСИМВОЛЬНЫЕ ИМЕНА ПЕРЕМЕННЫХ.
Одна из них - ограничение, требующее использования одно-символьных имен переменных. Теперь, когда мы можем обрабатывать много символьные ключевые слова, это ограничение начинает казаться произвольным и ненужным. И действительно это так. В основном, единственное его достоинство в том, что он позволяет получить тривиально простую реализацию таблицы идентификаторов. Но это просто удобство для создателей компиляторов и оно должно быть уничтожено.
Мы уже делали этот шаг прежде. На этот раз, как обычно, я сделаю это немного по-другому. Я думаю подход, примененный здесь, сохранит простоту настолько, насколько это возможно.
Естественным путем реализации таблицы идентификаторов на Pascal является объявление переменной типа запись и создание таблицы идентификаторов как массива таких записей. Здесь, однако, нам в действительности пока не нужно поле типа (существует пока что только один разрешенный тип), так что нам нужен только массив символов. Это имеет свое преимущество, потому что мы можем использовать существующую процедуру Lookup для поиска в таблице идентификаторов также как и в списке ключевых слов. Оказывается, даже когда нам нужны больше полей, мы все равно можем использовать тот же самый подход, просто сохраняя другие поля в отдельных массивах.
Вот изменения, которые необходимо сделать. С начала добавьте новую типизированную константу:
NEntry: integer = 0;
Затем измените определение таблицы идентификаторов как показано ниже:
Const MaxEntry = 100;
Var ST : array[1..MaxEntry] of Symbol;
(Обратите внимание, что ST не объявлен как SymTab. Это объявление липовое, чтобы заставить Lookup работать. SymTab заняли бы слишком много памяти и поэтому фактически никогда не объявляется).
Затем мы должны заменить InTable.
Code: { Look for Symbol in Table }. Function InTable(n: Symbol): Boolean; Begin. InTable := Lookup(@ST, n, MaxEntry) <> 0; End;
Нам также необходима новая процедура AddEntry, которая добавляет новый элемент в таблицу:
Code: { Add a New Entry to Symbol Table }. Procedure AddEntry(N: Symbol; T: char); Begin. If InTable(N) then Abort('Duplicate Identifier ' + N); If NEntry = MaxEntry then Abort('Symbol Table Full'); Inc(NEntry); ST[NEntry] := N; SType[NEntry] := T; End;
Эта процедура вызывается из Alloc:
Code: { Allocate Storage for a Variable }. Procedure Alloc(N: Symbol); Begin. If InTable(N) then Abort('Duplicate Variable Name ' + N); AddEntry(N, 'v'); . . .
Наконец, мы должны изменить все подпрограммы, которые в настоящее время обрабатывают имена переменных как одиночный символ. Они включают LoadVar и Store (просто измените тип с char на string) и Factor, Assignment и Decl (просто измените Value[1] на Value).
Последняя вещь: измените процедуру Init для очистки массива как показано ниже:
Code: { Initialize }. Procedure Init; Var i: integer; Begin. For i := 1 to MaxEntry do begin. ST[i] := ''; SType[i] := ' '; End; GetChar; Scan; End;
Это должно работать. Испытайте ее и проверьте, что вы действительно можете использовать много символьные имена переменных.
СНОВА ОПЕРАТОРЫ ОТНОШЕНИЙ.
У нас осталось последнее одно-символьное ограничение - ограничение операторов отношений. Некоторые из операторов отношений действительно состоят из одиночных символов, но другие требуют двух. Это '<=' и '>='. Я также предпочитаю Паскалевское '<>' для "не равно" вместо '#'.
Как вы помните, в главе 7 я указал, что стандартный способ работы с операторами отношений - включить их в список ключевых слов и позволить лексическому анализатору отыскивать их. Но, опять, это требует выполнение полного анализа выражения, тогда как до этого мы у нас была возможность ограничить использование сканера началом утверждения.
Я упомянул тогда, что мы все же можем избежать неприятностей с этим, так как много символьных операторов отношений немного и они ограничены в применении. Было бы легко обрабатывать их просто как специальные случаи и поддерживать их специальным способом.
Требуемые изменения влияют только на подпрограммы генерации кода и процедуры Relation и ее друзей. С начала, нам понадобятся еще две подпрограммы генерации кода:
Code: {---------------------------------------------------------------} { Set D0 If Compare was <= }. Procedure SetLessOrEqual; Begin. EmitLn('SGE D0'); EmitLn('EXT D0'); End; {---------------------------------------------------------------} { Set D0 If Compare was >= }. Procedure SetGreaterOrEqual; Begin. EmitLn('SLE D0'); EmitLn('EXT D0'); End; {---------------------------------------------------------------}
Затем измените подпрограммы анализа отношений как показано ниже:
Code: {---------------------------------------------------------------} { Recognize and Translate a Relational "Less Than or Equal" }. Procedure LessOrEqual; Begin. Match('='); Expression; PopCompare; SetLessOrEqual; End; {---------------------------------------------------------------} { Recognize and Translate a Relational "Not Equals" }. Procedure NotEqual; Begin. Match('>'); Expression; PopCompare; SetNEqual; End; {---------------------------------------------------------------} { Recognize and Translate a Relational "Less Than" }. Procedure Less; Begin. Match('<'); Case Look of. '=': LessOrEqual; '>': NotEqual; Else begin. Expression; PopCompare; SetLess; End; End; End; {---------------------------------------------------------------} { Recognize and Translate a Relational "Greater Than" }. Procedure Greater; Begin. Match('>'); If Look = '=' then begin. Match('='); Expression; PopCompare; SetGreaterOrEqual; End. Else begin. Expression; PopCompare; SetGreater; End; End; {---------------------------------------------------------------}
Это все, что требуется. Теперь вы можете обрабатывать все операторы отношений. Попробуйте.
ВВОД/ВЫВОД.
Теперь у нас есть полный, работающий язык, за исключением одного небольшого смущающего факта: у нас нет никакого способа получить или вывести данные. Нам нужны подпрограммы ввода/вывода.
Современное соглашение, установленное в C и продолженное в Ada и Modula-2, состоит в том, чтобы вывести I/O операторы из самого языка и просто включить их в библиотеку подпрограмм. Это было бы прекрасно, за исключением того, что мы пока не имеем никаких средств поддержки подпрограмм. В любом случае, с этим подходом вы столкнетесь с проблемой переменной длины списка параметров. В Паскале I/O операторы встроены в язык, поэтому это единственные операторы, для которых список параметров может иметь переменное число элементов. В C мы примиряемся с клуджами типа scanf и printf и должны передавать количество параметров в вызываемую процедуру. В Ada и Modula-2 мы должны использовать неудобный (и медленный!) способ отдельного вызова для каждого аргумента.
Так что я думаю, что предпочитаю Паскалевский подход встраивания подпрограмм ввода/вывода, даже если мы не нуждаемся в этом.
Как обычно, для этого нам нужны еще несколько подпрограмм генерации кода. Они, оказывается, самые простые из всех, потому что все, что мы делаем это вызываем библиотечные процедуры для выполнения работы.
Code: {---------------------------------------------------------------} { Read Variable to Primary Register }. Procedure ReadVar; Begin. EmitLn('BSR READ'); Store(Value); End; {---------------------------------------------------------------} { Write Variable from Primary Register }. Procedure WriteVar; Begin. EmitLn('BSR WRITE'); End;
Идея состоит в том, что READ загружает значение из входного потока в D0, а WRITE выводит его оттуда.
Эти две процедуры представляют собой нашу первую встречу с потребностью в библиотечных процедурах... компонентах Run Time Library (RTL). Конечно кто-то (а именно мы) должен написать эти подпрограммы, но они не являются непосредственно частью компилятора. Я даже не буду беспокоиться о том, чтобы показать здесь эти подпрограммы, так как они очевидно очень ОС-зависимы. Я просто скажу, что для SK*DOS они особенно просты... почти тривиальны. Одна из причин, по которым я не буду показывать их здесь в том, что вы можете добавлять новые виды возможностей, например приглашение в READ или возможность пользователю повторить ошибочный ввод.
Но это действительно отдельный от компилятора проект, так что теперь я буду подразумевать что библиотека, называемая TINYLIB.LIB, существует.
Так как нам теперь нужно загружать ее, мы должны добавить ее загрузку в процедуру Header:
Code: { Write Header Info }. Procedure Header; Begin. WriteLn('WARMST', TAB, 'EQU $A01E'); EmitLn('LIB TINYLIB'); End;
Она возьмет на себя эту часть работы. Теперь нам также необходимо распознавать команды ввода и вывода. Мы можем сделать это добавив еще два ключевых слова в наш список:
Code: { Definition of Keywords and Token Types }. Const NKW = 11; NKW1 = 12; Const KWlist: array[1..NKW] of Symbol = ('IF', 'ELSE', 'ENDIF', 'WHILE', 'ENDWHILE', 'READ', 'WRITE', 'VAR', 'BEGIN', 'END', 'PROGRAM'); Const KWcode: string[NKW1] = 'xileweRWvbep';
(Обратите внимание, что здесь я использую кода в верхнем регистре чтобы избежать конфликта с 'w' из WHILE.).
Затем нам нужны процедуры для обработки оператора ввода/вывода и его списка параметров:
Code: { Process a Read Statement }. Procedure DoRead; Begin. Match('('); GetName; ReadVar; While Look = ',' do begin. Match(','); GetName; ReadVar; End; Match(')'); End; { Process a Write Statement }. Procedure DoWrite; Begin. Match('('); Expression; WriteVar; While Look = ',' do begin. Match(','); Expression; WriteVar; End; Match(')'); End;
Наконец, мы должны расширить процедуру Block для поддержки новых типов операторов:
Code: { Parse and Translate a Block of Statements }. Procedure Block; Begin. Scan; While not(Token in ['e', 'l']) do begin. Case Token of. 'i': DoIf; 'w': DoWhile; 'R': DoRead; 'W': DoWrite; Else Assignment; End; Scan; End; End;
На этом все. Теперь у нас есть язык!
ЗАКЛЮЧЕНИЕ.
К этому моменту мы полностью определили TINY. Он не слишком значителен... в действительности игрушечный компилятор. TINY имеет только один тип данных и не имеет подпрограмм... но это законченный, пригодный для использования язык. Пока что вы не имеете возможности написать на нем другой компилятор или сделать что-нибудь еще очень серьезное, но вы могли бы писать программы для чтения входных данных, выполнения вычислений и вывода результатов. Не слишком плохо для игрушки.
Более важно, что мы имеем твердую основу для дальнейшего развития. Я знаю, что вы будете рады слышать это: в последний раз я начал с создания синтаксического анализатора заново... с этого момента я предполагаю просто добавлять возможности в TINY пока он не превратится в KISS. Ох, будет время, когда нам понадобится попробовать некоторые вещи с новыми копиями Cradle, но как только мы разузнаем как они делаются, они будут встроены в TINY.
Какие это будут возможности? Хорошо, для начала нам понадобятся подпрограммы и функции. Затем нам нужна возможность обрабатывать различные типы, включая массивы, строки и другие структуры. Затем нам нужно работать с идеей указателей. Все это будет в следующих главах.
Увидимся.
В справочных целях полный листинг TINY версии 1.0 показан ниже:
Code: Program Tiny10; { Constant Declarations }. Const TAB = ^I; CR = ^M; LF = ^J; LCount: integer = 0; NEntry: integer = 0; { Type Declarations }. Type Symbol = string[8]; SymTab = array[1..1000] of Symbol; TabPtr = ^SymTab; { Variable Declarations }. Var Look : char; { Lookahead Character }. Token: char; { Encoded Token }. Value: string[16]; { Unencoded Token }. Const MaxEntry = 100; Var ST : array[1..MaxEntry] of Symbol; SType: array[1..MaxEntry] of char; { Definition of Keywords and Token Types }. Const NKW = 11; NKW1 = 12; Const KWlist: array[1..NKW] of Symbol = ('IF', 'ELSE', 'ENDIF', 'WHILE', 'ENDWHILE', 'READ', 'WRITE', 'VAR', 'BEGIN', 'END', 'PROGRAM'); Const KWcode: string[NKW1] = 'xileweRWvbep'; { Read New Character From Input Stream }. Procedure GetChar; Begin. Read(Look); End; { Report an Error }. Procedure Error(s: string); Begin. WriteLn; WriteLn(^G, 'Error: ', s, '.'); End; { Report Error and Halt }. Procedure Abort(s: string); Begin. Error(s); Halt; End; { Report What Was Expected }. Procedure Expected(s: string); Begin. Abort(s + ' Expected'); End; { Report an Undefined Identifier }. Procedure Undefined(n: string); Begin. Abort('Undefined Identifier ' + n); End; { Recognize an Alpha Character }. Function IsAlpha(c: char): boolean; Begin. IsAlpha := UpCase(c) in ['A'..'Z']; End; { Recognize a Decimal Digit }. Function IsDigit(c: char): boolean; Begin. IsDigit := c in ['0'..'9']; End; { Recognize an AlphaNumeric Character }. Function IsAlNum(c: char): boolean; Begin. IsAlNum := IsAlpha(c) or IsDigit(c); End; { Recognize an Addop }. Function IsAddop(c: char): boolean; Begin. IsAddop := c in ['+', '-']; End; { Recognize a Mulop }. Function IsMulop(c: char): boolean; Begin. IsMulop := c in ['*', '/']; End; { Recognize a Boolean Orop }. Function IsOrop(c: char): boolean; Begin. IsOrop := c in ['|', '~']; End; { Recognize a Relop }. Function IsRelop(c: char): boolean; Begin. IsRelop := c in ['=', '#', '<', '>']; End; { Recognize White Space }. Function IsWhite(c: char): boolean; Begin. IsWhite := c in [' ', TAB]; End; { Skip Over Leading White Space }. Procedure SkipWhite; Begin. While IsWhite(Look) do. GetChar; End; { Skip Over an End-of-Line }. Procedure NewLine; Begin. While Look = CR do begin. GetChar; If Look = LF then GetChar; SkipWhite; End; End; { Match a Specific Input Character }. Procedure Match(x: char); Begin. NewLine; If Look = x then GetChar. Else Expected('''' + x + ''''); SkipWhite; End; { Table Lookup }. Function Lookup(T: TabPtr; s: string; n: integer): integer; Var i: integer; Found: Boolean; Begin. Found := false; I := n; While (i > 0) and not found do. If s = T^[i] then. Found := true. Else. Dec(i); Lookup := i; End; { Locate a Symbol in Table }. { Returns the index of the entry. Zero if not present. }. Function Locate(N: Symbol): integer; Begin. Locate := Lookup(@ST, n, MaxEntry); End; { Look for Symbol in Table }. Function InTable(n: Symbol): Boolean; Begin. InTable := Lookup(@ST, n, MaxEntry) <> 0; End; { Add a New Entry to Symbol Table }. Procedure AddEntry(N: Symbol; T: char); Begin. If InTable(N) then Abort('Duplicate Identifier ' + N); If NEntry = MaxEntry then Abort('Symbol Table Full'); Inc(NEntry); ST[NEntry] := N; SType[NEntry] := T; End; { Get an Identifier }. Procedure GetName; Begin. NewLine; If not IsAlpha(Look) then Expected('Name'); Value := ''; While IsAlNum(Look) do begin. Value := Value + UpCase(Look); GetChar; End; SkipWhite; End; { Get a Number }. Function GetNum: integer; Var Val: integer; Begin. NewLine; If not IsDigit(Look) then Expected('Integer'); Val := 0; While IsDigit(Look) do begin. Val := 10 * Val + Ord(Look) - Ord('0'); GetChar; End; GetNum := Val; SkipWhite; End; { Get an Identifier and Scan it for Keywords }. Procedure Scan; Begin. GetName; Token := KWcode[Lookup(Addr(KWlist), Value, NKW) + 1]; End; { Match a Specific Input String }. Procedure MatchString(x: string); Begin. If Value <> x then Expected('''' + x + ''''); End; { Output a String with Tab }. Procedure Emit(s: string); Begin. Write(TAB, s); End; { Output a String with Tab and CRLF }. Procedure EmitLn(s: string); Begin. Emit(s); WriteLn; End; { Generate a Unique Label }. Function NewLabel: string; Var S: string; Begin. Str(LCount, S); NewLabel := 'L' + S; Inc(LCount); End; { Post a Label To Output }. Procedure PostLabel(L: string); Begin. WriteLn(L, ':'); End; {---------------------------------------------------------------} { Clear the Primary Register }. Procedure Clear; Begin. EmitLn('CLR D0'); End; {---------------------------------------------------------------} { Negate the Primary Register }. Procedure Negate; Begin. EmitLn('NEG D0'); End; {---------------------------------------------------------------} { Complement the Primary Register }. Procedure NotIt; Begin. EmitLn('NOT D0'); End; {---------------------------------------------------------------} { Load a Constant Value to Primary Register }. Procedure LoadConst(n: integer); Begin. Emit('MOVE #'); WriteLn(n, ',D0'); End; {---------------------------------------------------------------} { Load a Variable to Primary Register }. Procedure LoadVar(Name: string); Begin. If not InTable(Name) then Undefined(Name); EmitLn('MOVE ' + Name + '(PC),D0'); End; {---------------------------------------------------------------} { Push Primary onto Stack }. Procedure Push; Begin. EmitLn('MOVE D0,-(SP)'); End; {---------------------------------------------------------------} { Add Top of Stack to Primary }. Procedure PopAdd; Begin. EmitLn('ADD (SP)+,D0'); End; {---------------------------------------------------------------} { Subtract Primary from Top of Stack }. Procedure PopSub; Begin. EmitLn('SUB (SP)+,D0'); EmitLn('NEG D0'); End; {---------------------------------------------------------------} { Multiply Top of Stack by Primary }. Procedure PopMul; Begin. EmitLn('MULS (SP)+,D0'); End; {---------------------------------------------------------------} { Divide Top of Stack by Primary }. Procedure PopDiv; Begin. EmitLn('MOVE (SP)+,D7'); EmitLn('EXT.L D7'); EmitLn('DIVS D0,D7'); EmitLn('MOVE D7,D0'); End; {---------------------------------------------------------------} { AND Top of Stack with Primary }. Procedure PopAnd; Begin. EmitLn('AND (SP)+,D0'); End; {---------------------------------------------------------------} { OR Top of Stack with Primary }. Procedure PopOr; Begin. EmitLn('OR (SP)+,D0'); End; {---------------------------------------------------------------} { XOR Top of Stack with Primary }. Procedure PopXor; Begin. EmitLn('EOR (SP)+,D0'); End; {---------------------------------------------------------------} { Compare Top of Stack with Primary }. Procedure PopCompare; Begin. EmitLn('CMP (SP)+,D0'); End; {---------------------------------------------------------------} { Set D0 If Compare was = }. Procedure SetEqual; Begin. EmitLn('SEQ D0'); EmitLn('EXT D0'); End; {---------------------------------------------------------------} { Set D0 If Compare was != }. Procedure SetNEqual; Begin. EmitLn('SNE D0'); EmitLn('EXT D0'); End; {---------------------------------------------------------------} { Set D0 If Compare was > }. Procedure SetGreater; Begin. EmitLn('SLT D0'); EmitLn('EXT D0'); End; {---------------------------------------------------------------} { Set D0 If Compare was < }. Procedure SetLess; Begin. EmitLn('SGT D0'); EmitLn('EXT D0'); End; {---------------------------------------------------------------} { Set D0 If Compare was <= }. Procedure SetLessOrEqual; Begin. EmitLn('SGE D0'); EmitLn('EXT D0'); End; {---------------------------------------------------------------} { Set D0 If Compare was >= }. Procedure SetGreaterOrEqual; Begin. EmitLn('SLE D0'); EmitLn('EXT D0'); End; {---------------------------------------------------------------} { Store Primary to Variable }. Procedure Store(Name: string); Begin. If not InTable(Name) then Undefined(Name); EmitLn('LEA ' + Name + '(PC),A0'); EmitLn('MOVE D0,(A0)'). End; {---------------------------------------------------------------} { Branch Unconditional }. Procedure Branch(L: string); Begin. EmitLn('BRA ' + L); End; {---------------------------------------------------------------} { Branch False }. Procedure BranchFalse(L: string); Begin. EmitLn('TST D0'); EmitLn('BEQ ' + L); End; {---------------------------------------------------------------} { Read Variable to Primary Register }. Procedure ReadVar; Begin. EmitLn('BSR READ'); Store(Value[1]); End; { Write Variable from Primary Register }. Procedure WriteVar; Begin. EmitLn('BSR WRITE'); End; { Write Header Info }. Procedure Header; Begin. WriteLn('WARMST', TAB, 'EQU $A01E'); End; { Write the Prolog }. Procedure Prolog; Begin. PostLabel('MAIN'); End; { Write the Epilog }. Procedure Epilog; Begin. EmitLn('DC WARMST'); EmitLn('END MAIN'); End; {---------------------------------------------------------------} { Parse and Translate a Math Factor }. Procedure BoolExpression; Forward; Procedure Factor; Begin. If Look = '(' then begin. Match('('); BoolExpression; Match(')'); End. Else if IsAlpha(Look) then begin. GetName; LoadVar(Value); End. Else. LoadConst(GetNum); End; { Parse and Translate a Negative Factor }. Procedure NegFactor; Begin. Match('-'); If IsDigit(Look) then. LoadConst(-GetNum). Else begin. Factor; Negate; End; End; { Parse and Translate a Leading Factor }. Procedure FirstFactor; Begin. Case Look of. '+': begin. Match('+'); Factor; End; '-': NegFactor; Else Factor; End; End; { Recognize and Translate a Multiply }. Procedure Multiply; Begin. Match('*'); Factor; PopMul; End; {-------------------------------------------------------------} { Recognize and Translate a Divide }. Procedure Divide; Begin. Match('/'); Factor; PopDiv; End; {---------------------------------------------------------------} { Common Code Used by Term and FirstTerm }. Procedure Term1; Begin. While IsMulop(Look) do begin. Push; Case Look of. '*': Multiply; '/': Divide; End; End; End; {---------------------------------------------------------------} { Parse and Translate a Math Term }. Procedure Term; Begin. Factor; Term1; End; {---------------------------------------------------------------} { Parse and Translate a Leading Term }. Procedure FirstTerm; Begin. FirstFactor; Term1; End; { Recognize and Translate an Add }. Procedure Add; Begin. Match('+'); Term; PopAdd; End; {-------------------------------------------------------------} { Recognize and Translate a Subtract }. Procedure Subtract; Begin. Match('-'); Term; PopSub; End; {---------------------------------------------------------------} { Parse and Translate an Expression }. Procedure Expression; Begin. FirstTerm; While IsAddop(Look) do begin. Push; Case Look of. '+': Add; '-': Subtract; End; End; End; {---------------------------------------------------------------} { Recognize and Translate a Relational "Equals" }. Procedure Equal; Begin. Match('='); Expression; PopCompare; SetEqual; End; {---------------------------------------------------------------} { Recognize and Translate a Relational "Less Than or Equal" }. Procedure LessOrEqual; Begin. Match('='); Expression; PopCompare; SetLessOrEqual; End; {---------------------------------------------------------------} { Recognize and Translate a Relational "Not Equals" }. Procedure NotEqual; Begin. Match('>'); Expression; PopCompare; SetNEqual; End; {---------------------------------------------------------------} { Recognize and Translate a Relational "Less Than" }. Procedure Less; Begin. Match('<'); Case Look of. '=': LessOrEqual; '>': NotEqual; Else begin. Expression; PopCompare; SetLess; End; End; End; {---------------------------------------------------------------} { Recognize and Translate a Relational "Greater Than" }. Procedure Greater; Begin. Match('>'); If Look = '=' then begin. Match('='); Expression; PopCompare; SetGreaterOrEqual; End. Else begin. Expression; PopCompare; SetGreater; End; End; {---------------------------------------------------------------} { Parse and Translate a Relation }. Procedure Relation; Begin. Expression; If IsRelop(Look) then begin. Push; Case Look of. '=': Equal; '<': Less; '>': Greater; End; End; End; {---------------------------------------------------------------} { Parse and Translate a Boolean Factor with Leading NOT }. Procedure NotFactor; Begin. If Look = '!' then begin. Match('!'); Relation; NotIt; End. Else. Relation; End; {---------------------------------------------------------------} { Parse and Translate a Boolean Term }. Procedure BoolTerm; Begin. NotFactor; While Look = '&' do begin. Push; Match('&'); NotFactor; PopAnd; End; End; { Recognize and Translate a Boolean OR }. Procedure BoolOr; Begin. Match('|'); BoolTerm; PopOr; End; { Recognize and Translate an Exclusive Or }. Procedure BoolXor; Begin. Match('~'); BoolTerm; PopXor; End; {---------------------------------------------------------------} { Parse and Translate a Boolean Expression }. Procedure BoolExpression; Begin. BoolTerm; While IsOrOp(Look) do begin. Push; Case Look of. '|': BoolOr; '~': BoolXor; End; End; End; { Parse and Translate an Assignment Statement }. Procedure Assignment; Var Name: string; Begin. Name := Value; Match('='); BoolExpression; Store(Name); End; {---------------------------------------------------------------} { Recognize and Translate an IF Construct }. Procedure Block; Forward; Procedure DoIf; Var L1, L2: string; Begin. BoolExpression; L1 := NewLabel; L2 := L1; BranchFalse(L1); Block; If Token = 'l' then begin. L2 := NewLabel; Branch(L2); PostLabel(L1); Block; End; PostLabel(L2); MatchString('ENDIF'); End; { Parse and Translate a WHILE Statement }. Procedure DoWhile; Var L1, L2: string; Begin. L1 := NewLabel; L2 := NewLabel; PostLabel(L1); BoolExpression; BranchFalse(L2); Block; MatchString('ENDWHILE'); Branch(L1); PostLabel(L2); End; { Process a Read Statement }. Procedure DoRead; Begin. Match('('); GetName; ReadVar; While Look = ',' do begin. Match(','); GetName; ReadVar; End; Match(')'); End; { Process a Write Statement }. Procedure DoWrite; Begin. Match('('); Expression; WriteVar; While Look = ',' do begin. Match(','); Expression; WriteVar; End; Match(')'); End; { Parse and Translate a Block of Statements }. Procedure Block; Begin. Scan; While not(Token in ['e', 'l']) do begin. Case Token of. 'i': DoIf; 'w': DoWhile; 'R': DoRead; 'W': DoWrite; Else Assignment; End; Scan; End; End; { Allocate Storage for a Variable }. Procedure Alloc(N: Symbol); Begin. If InTable(N) then Abort('Duplicate Variable Name ' + N); AddEntry(N, 'v'); Write(N, ':', TAB, 'DC '); If Look = '=' then begin. Match('='); If Look = '-' then begin. Write(Look); Match('-'); End; WriteLn(GetNum); End. Else. WriteLn('0'); End; { Parse and Translate a Data Declaration }. Procedure Decl; Begin. GetName; Alloc(Value); While Look = ',' do begin. Match(','); GetName; Alloc(Value); End; End; { Parse and Translate Global Declarations }. Procedure TopDecls; Begin. Scan; While Token <> 'b' do begin. Case Token of. 'v': Decl; Else Abort('Unrecognized Keyword ' + Value); End; Scan; End; End; { Parse and Translate a Main Program }. Procedure Main; Begin. MatchString('BEGIN'); Prolog; Block; MatchString('END'); Epilog; End; { Parse and Translate a Program }. Procedure Prog; Begin. MatchString('PROGRAM'); Header; TopDecls; Main; Match('.'); End; { Initialize }. Procedure Init; Var i: integer; Begin. For i := 1 to MaxEntry do begin. ST[i] := ''; SType[i] := ' '; End; GetChar; Scan; End; { Main Program }. Begin. Init; Prog; If Look <> CR then Abort('Unexpected data after ''.'''); End.
| Перейти на строку в RichEdit. |
Code: With Richedit1 do. Begin. Selstart := perform( EM_LINEINDEX, linenumber, 0 ); Perform( EM_SCROLLCARET, 0, 0 ); End; { The EM_LINEINDEX message returns the character index of the first character. On a given line, assigning that to selstart moves the caret to that position. The control will only automatically scroll the caret into view if it has. The focus, thus the EM_SCROLLCARET. }
| Над какой закладкой курсор в TabControl. |
Автор: YoungHacker.
| Перенаправление стандартного ввода и вывода |
Автор: Горбань С.В.
| Переместить элемент в TListView. |
Code: // Move item 1 after item 4. Function MoveListViewItem(listView: TListView; ItemFrom, ItemTo: Word): Boolean; Var. Source, Target: TListItem; Begin. Result := False; Listview.Items.BeginUpdate; Try. Source := listview.Items[ItemFrom]; Target := listview.Items.Insert(ItemTo); Target.Assign(Source); Source.Free; Result := True; Finally. Listview.Items.EndUpdate; End; End; Procedure TForm1.Button1Click(Sender: TObject); Begin. // Listview1.ViewStyle := vsReport; If MoveListViewItem(Listview1, 1, 4) then. ShowMessage('Moved!'); End;
| Перемещение изображений по форме с помощью мыши |
Автор: Павел
| Перемещение иконок между несколькими TImageLists. |
Code: Procedure TForm1.Button1Click(Sender: TObject); Var. Ico: TIcon; Begin. Ico := TIcon.Create; Try. Imagelist1.GetIcon(0, ico); // Get first icon from Imagelist1. Imagelist2.AddIcon(ico); // Add the icon to Imagelist2. Finally. Ico.Free; End; End;
| Перемещение на страницу TabSet по имени |
Разместите компоненты Tabset(TabSet1) и Edit (Edit1) на вашей форме. Измените свойство компонента Tabset Tabs для размещения в списке строк следующих четерых закладок:
| Перемещать объект на сложном фоне |
Написать графический редактор, как Paint Brush, в Delphi очень просто. Но встает одна проблема. Чтобы нарисовать линию, пользователь нажимает мышью на поле, двигает ее, и отпускает кнопку. Во время движения мыши линия все время перерисовывается. Причем фон, после того, как линия переместилась, должен восстановиться. Для этого можно использовать логическую операцию XOR. Важное свойство этой операции заключается в том, что при любых A и B, A XOR B XOR B = A. Это означает, что если воспользоваться этой операцией для рисования линии, то при повторном ее рисовании на этом месте этим же цветом она сотрется, оставив за собой прежний фон.
| Правое выравнивание ячеек TStringGrid. |
Code: Procedure TForm1.GridSumaDrawCell(Sender: TObject; ACol, ARow: Longint; ARect: TRect; State: TGridDrawState); Var. Dx: integer; Begin. With (Sender as TStringGrid).Canvas do. Begin. Font := GridSuma.Font; Pen.Color := clBlack; If (ACol = 0) or (ARow = 0) then. Begin. { Рисуем заголовок }. Brush.Color := clBtnFace; FillRect(ARect); TextOut(ARect.Left, ARect.Top, GridSuma.Cells[ACol, ARow]). End. Else. Begin. { Рисуем ячейку с правым выравниванием }. Brush.Color := clWhite; FillRect(ARect); Dx := TextWidth(GridSuma.Cells[ACol, ARow]) + 2; TextOut(ARect.Right - dx, ARect.Top, GridSuma.Cells[ACol, ARow]). End. End. End;
©Drkb::01072.
DelphiWorld 6.0.
| Ограничение ввода в текстовое поле |
Code: { In this exemple, the only keys allowed are the. Same allowed in e-mail adresses. } Procedure TForm1.Edit1KeyPress(Sender: TObject; Var Key: Char); Const. AllowedChars: string = 'abcdefghijklmnopq' + 'rstuvwxyz01234567_.@'; Var. I: Integer; Ok: Boolean; Begin. I := 0; Ok := False; { If you erase next line, user won't be able to type backspace }. If Key = #8 then Ok := True; Repeat. I := i + 1; If Key = AllowedChars[i] then Ok := True; Until (Ok) or (i = Length(AllowedChars)); If not Ok then Key := #0; End;
| Ограничение длины и количества строк компонента Memo. |
Code: Unit Unit1; Interface. Uses. SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, StdCtrls, ExtCtrls, Forms; Type. TForm1 = class(TForm). Memo1: TMemo; Procedure FormCreate(Sender: TObject); Procedure Memo1KeyPress(Sender: TObject; var Key: Char); Public. MaxCharsPerLine, MaxLines: Integer; Function MemoLine: Integer; Function LineLen(r: Integer): Integer; Function NRows: Integer; End; Var. Form1: TForm1; Implementation. {$R *.DFM}. Function TForm1.NRows: Integer; Begin. With Memo1 do. Result := 1 + SendMessage(Handle, EM_LINEFROMCHAR, GetTextLen - 1, 0); End; Function TForm1.LineLen(r: Integer): Integer; Var. R1, r2: Integer; Begin. With Memo1 do. Begin. R1 := SendMessage(Handle, EM_LINEINDEX, r, 0); If (r > NRows - 1) then. R2 := SendMessage(Handle, EM_LINEINDEX, r + 1, 0) - 2 {-CR/LF}. Else. R2 := GetTextLen; End; Result := r2 - r1; End; Function TForm1.MemoLine: Integer; Begin. With Memo1 do. Result := SendMessage(Handle, EM_LINEFROMCHAR, SelStart, 0); End; Procedure TForm1.FormCreate(Sender: TObject); Begin. MaxCharsPerLine := 8; MaxLines := 4; End; Procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char); Begin. With Memo1 do. Begin. Case Key of. ' '..#255: if (LineLen(MemoLine) >= MaxCharsPerLine) then. Key := #0; #10, #13: if (NRows >= MaxLines) then. Key := #0; #8: if (SelStart = SendMessage(Handle, EM_LINEINDEX, MemoLine, 0)) then. Key := #0; End; End; End; End.
| Ограничение длины поля TStringGrid. |
Вероятно, это не очень эффективное решение, но оно будет работать: поместите следующий код в обработчик события onKeyPress:
| Небольшой модуль для работы со строками |
Code: { **** UBPFD *********** by delphibase.endimus.com **** >> Небольшой модуль для работы со строками. Function CompMask(S, Mask: string):string; //выбор строки по маске. // удаление из строки count символов начиная с posit. Function deleteStr(s:string;posit,count:integer):string; //Удаление из строки s сначала first и с конца last символов. Function deleteFaskaStr(s:string; first,last:integer):string; Запись в стринлист strg всех вхождений по маске mask из строки source. Procedure getStrings(var strg: TStringList; mask,source: string); Зависимости: classes,sysutils. Автор: SuMaga, sumaga@mail.ru, ICQ:721602488, Махачкала. Copyright: Сам состряпал :). Дата: 24 января 2003 г. ***************************************************** } Unit StrMask; Interface. Uses classes, sysutils; Function CompMask(S, Mask: string): string; Function deleteStr(s: string; posit, count: integer): string; Function deleteFaskaStr(s: string; first, last: integer): string; Procedure getStrings(var strg: TStringList; mask, source: string); Implementation. Type. TmaskObj = class. Constructor open; Public. Maschr: tstringlist; Masposish: TStringList; Destructor close; End; Procedure getStrings(var strg: TStringList; mask, source: string); Var. S, s2: string; Begin. S2 := source; S := CompMask(s2, mask); While s <> '' do. Begin. Strg.Add(s); S2 := StringReplace(s2, s, '', []); S := CompMask(s2, mask); If pos(s, s2) = 0 then. Break; End; End; Function eraseMask(inpstr: TStrings): TStrings; Var. I: integer; E: boolean; Begin. E := false; For i := 0 to inpstr.Count - 1 do. If (i <> inpstr.Count - 1) and (i < inpstr.Count - 1) then. If ((inpstr[i] = '`') and (inpstr[i + 1] = '|')) or. ((inpstr[i] = '|') and (inpstr[i + 1] = '`')) or. ((inpstr[i] = '`') and (inpstr[i + 1] = '`')) then. Begin. E := true; End; If (e = false) or (i <= inpstr.Count - 1) then. Begin. Result := inpstr; Exit; End; For i := 0 to inpstr.Count - 1 do. If (i <> inpstr.Count - 1) and (i < inpstr.Count - 1) then. If ((inpstr[i] = '`') and (inpstr[i + 1] = '|')) or. ((inpstr[i] = '`') and (inpstr[i + 1] = '`')) or. ((inpstr[i] = '|') and (inpstr[i + 1] = '`')) then. Begin. Inpstr.Delete(i + 1); Inpstr[i] := '`'; End; Result := eraseMask(inpstr); End; { `<---- Эквивалентна----->* |<---- Эквивалентна----->? } Function SplitMask(mask: string; MaskList: TStringList): TStringList; Var. I, j, k: integer; S1: string; Mch: TmaskObj; Begin. Mch := TmaskObj.open; For i := 1 to length(Mask) do. Begin. If Mask[i] = '`' then. Begin. Mch.Maschr.Add('`'); Mch.Masposish.Add(inttostr(i)). End; If Mask[i] = '|' then. Begin. Mch.Maschr.Add('|'); Mch.Masposish.Add(inttostr(i)). End; End; K := 0; For i := 0 to mch.Maschr.Count - 1 do. Begin. J := strtoint(mch.Masposish.Strings[i]) - k; If j - 1 <> 0 then. S1 := copy(Mask, 1, j - 1). Else. S1 := ''; Delete(Mask, 1, j); K := length(s1) + 1 + k; If (s1 <> mch.Maschr.Strings[i]) and (length(s1) <> 0) then. MaskList.Add(s1); MaskList.Add(mch.Maschr.Strings[i]); End; If Mask <> '' then. MaskList.Add(Mask); Mch.close; Result := TStringList(eraseMask(MaskList)); End; Function deleteStr(s: string; posit, count: integer): string; Begin. Delete(s, posit, count); Result := s; End; Function deleteFaskaStr(s: string; first, last: integer): string; Begin. Result := deleteStr(s, 1, first); Result := deleteStr(Result, length(Result) - last + 1, length(Result) - (length(Result) - last)); End; Function CompMask(S, Mask: string): string; Var. I, j, k, y: integer; S1, s2, s3, s4, s5: string; MaskList: TStringList; PrPos: integer; Var. Fm: boolean; Label. 1, 2, 3; Begin. 2: If length(s) = 0 then. Exit; If length(Mask) = 0 then. Exit; If length(s) < length(Mask) then. Exit; //if Assigned(MaskList) then. Begin. MaskList := TStringList.Create; MaskList := SplitMask(Mask, MaskList); End; PrPos := 0; S4 := s; Fm := false; S3 := ''; I := 0; Result := ''; If MaskList.Count - 1 = 0 then. Begin. If (MaskList[0] = '`') then. Begin. S3 := s; Fm := true; End; If (MaskList[0] = '|') then. Begin. S3 := s[1]; Fm := true; Result := s3; Exit; End; If (MaskList[0] <> '`') and (MaskList[0] <> '|') then. Begin. If pos(MaskList[0], s) = 0 then. Exit; S3 := copy(s, pos(MaskList[0], s), length(MaskList[0])); Fm := true; End; I := MaskList.Count + 1; End; //Начало цикла. While i <= MaskList.Count - 1 do. Begin. If (MaskList[i] = '`') and (PrPos = 0) and (i + 1 <= MaskList.Count - 1). Then. Begin. If pos(MaskList[i + 1], s) = 0 then. Goto 2; J := pos(MaskList[i + 1], s) + length(MaskList[i + 1]) - 1; S3 := copy(s, 1, j); Delete(s, 1, j); Fm := true; PrPos := j; I := i + 1; Goto 1; End; If (MaskList[i] = '|') and (PrPos = 0) and (i + 1 <= MaskList.Count - 1). Then. Begin. K := i; Y := 0; If i + 1 <= MaskList.Count - 1 then. While (MaskList[k] = '|') do. Begin. K := k + 1; Y := y + 1; If k >= MaskList.Count - 1 then. Break; End; If pos(MaskList[k], s) = 0 then. Goto 2; J := pos(MaskList[k], s); S3 := copy(s, j - y, length(MaskList[k]) + y); Delete(s, 1, j + length(MaskList[k]) - 1); Fm := true; PrPos := j - 1; I := k; Goto 1; End; If (PrPos = 0) and (MaskList[i] <> '|') and (MaskList[i] <> '`') then. Begin. If pos(MaskList[i], s) = 0 then. Break; J := pos(MaskList[i], s); S3 := copy(s, j, length(MaskList[i])); Delete(s, 1, j + length(MaskList[i]) - 1); Fm := true; PrPos := length(MaskList[i]); Goto 1; End; Fm := false; If (PrPos <> 0) and (i < MaskList.Count - 1) then. Begin. If (MaskList[i] = '`') then. Begin. If pos(MaskList[i + 1], s) = 0 then. Goto 2; J := pos(MaskList[i + 1], s); S3 := s3 + copy(s, 1, j + length(MaskList[i + 1]) - 1); Fm := true; Delete(s, 1, j + length(MaskList[i + 1]) - 1); PrPos := j + length(MaskList[i + 1]); I := i + 1; Goto 1; End; If (MaskList[i] = '|') then. Begin. If i + 1 <= MaskList.Count - 1 then. If MaskList[i + 1] <> '|' then. Begin. If pos(MaskList[i + 1], s) > 2 then. Begin. //break; Goto 2; End; S3 := s3 + copy(s, 1, length(MaskList[i + 1]) + 1); Delete(s, 1, length(MaskList[i + 1]) + 1); Fm := true; I := i + 1; Goto 1; End; S3 := s3 + copy(s, 1, 1); Delete(s, 1, 1); Fm := true; PrPos := 1; End; If (MaskList[i] <> '`') and (MaskList[i] <> '|') then. Begin. If pos(MaskList[i], s) = 0 then. Goto 2; J := pos(MaskList[i], s); S3 := s3 + copy(s, j, length(MaskList[i])); Delete(s, 1, j + length(MaskList[i]) - 1); Fm := true; PrPos := length(MaskList[i]); Fm := true. End; End; If (PrPos <> 0) and (i = MaskList.Count - 1) then. Begin. If (MaskList[i] = '`') then. Begin. S3 := s3 + s; S := ''; Fm := true; PrPos := j; End; If (MaskList[i] = '|') then. Begin. S3 := s3 + copy(s, 1, 1); Delete(s, 1, 1); Fm := true; PrPos := 1; End; If (MaskList[i] <> '`') and (MaskList[i] <> '|') then. Begin. If pos(MaskList[i], s) <> 0 then. J := pos(MaskList[i], s) + length(MaskList[i]) - 1. Else. Goto 2; S3 := s3 + copy(s, 1, j); Delete(s, 1, j); Fm := true; PrPos := j + length(s3); End; End; 1: inc(i); End; S5 := s3; If s3 <> '' then. For i := 0 to MaskList.Count - 1 do. If (MaskList[i] <> '`') and (MaskList[i] <> '|') then. Begin. If pos(MaskList[i], s3) = 0 then. Goto 2; S3 := StringReplace(s3, MaskList[i], '', []); End; S3 := s5; MaskList.Free; If fm then. Begin. Result := s3; End. { {result:=''; Else. If length(s)>=length(Mask) then. Result:=CompMask(s,Mask). Else Result:='';}. End; Destructor TmaskObj.close; Begin. Maschr.free; Masposish.free; End; Constructor TmaskObj.open; Begin. Maschr := TStringList.Create; Masposish := TStringList.Create; End; End. Пример использования: S := 'asd r'; S := CompMask(s, 'd |'); //в результате s='d r';
©Drkb::00854.
Набор инструментов для оперирования с дисками на физическом уровне.
| Набор инструментов для оперирования с дисками на физическом уровне |
В данном сборнике есть три примера, которые называться UnErase, PartitionView, BootView UnErase – Программа для восстановления удаленных файлов PartitionView – показывает структуру разделов жесткого диска BootView – показывает загрузочную запись визуально А также модули uFAT, DISK. uFAT – готовый код для полноценной работы с файловой системой FAT uDISK – ф-ций для работы с дисковыми драйверами R/W для секторов ВНИМАНИЕ! Если вы не понимайте и не вникайте в эти понятия как слово сектор или Partition/Boot/FAT1/FAT2/RootDir/DATA то лучше вообще не запускайте с этого модуля нечего!!! Ваша безопасность в ваших руках!
Автор : NikNet.
E-MAIL : NikNet@Yandex.ru.
©Drkb::03196.
| Переслать данные в другую программу методом Drag-and-Drop. |
Code: // Autor: Hagen Reddmann. Uses. ShellAPI; Function MakeDrop(const FileNames: array of string): THandle; // Creates a hDrop Object. // erzeugt ein hDrop Object. Var. I, Size: Integer; Data: PDragInfoA; P: PChar; Begin. // Calculate memory size needed. // berechne notwendig Speichergro?e. Size := SizeOf(TDragInfoA) + 1; For I := 0 to High(FileNames) do. Inc(Size, Length(FileNames[I]) + 1); // allocate the memory. // alloziere den speicher. Result := GlobalAlloc(GHND or GMEM_SHARE, Size); If Result <> 0 then. Begin. Data := GlobalLock(Result); If Data <> nil then. Try. // fill up with data. // fulle daten. Data.uSize := SizeOf(TDragInfoA); P := PChar(@Data.grfKeyState) + 4; Data.lpFileList := P; // filenames at the at of the header (separated with #0). // am ende des headers nun die filenamen getrennt mit #0. For I := 0 to High(FileNames) do. Begin. Size := Length(FileNames[I]); Move(Pointer(FileNames[I])^, P^, Size); Inc(P, Size + 1); End; Finally. GlobalUnlock(Result); End. Else. Begin. GlobalFree(Result); Result := 0; End; End; End; Function MyEnum(Wnd: hWnd; Res: PInteger): Bool; stdcall; // search for a edit control with classname 'TEditControl' // suche ein child fenster mit klassennamen 'TEditControl' Var. N: string; Begin. SetLength(N, MAX_PATH); SetLength(N, GetClassName(Wnd, Pointer(N), Length(N))); Result := AnsiCompareText('TEditControl', N) <> 0; If not Result then Res^ := Wnd; End; // Example: Open msdos.sys in Delphi's Editor window. // Beispiel: msdos.sys im Delphi Editor offnen. Procedure TForm1.Button1Click(Sender: TObject); Var. Wnd: HWnd; Drop: hDrop; Begin. // search for Delphi's Editor. // suche Delphis Editor Fenster. EnumChildWindows(FindWindow('TEditWindow', nil), @MyEnum, Integer(@Wnd)); If IsWindow(Wnd) then. Begin. // Delphi's Editor found. Open msdos.sys. // Delphis editor gefunden, also offne msdos.sys. Drop := MakeDrop(['c:\msdos.sys']); If Drop <> 0 then PostMessage(Wnd, wm_DropFiles, Drop, 0); // Free the memory? // Speicher wieder freigeben? GlobalFree(Drop); End; End;
Пересмотр лексического анализа.
| Пересмотр лексического анализа |
11. Пересмотр лексического анализа.
ВВЕДЕНИЕ.
У меня есть хорошие и плохие новости. Плохие новости - эта глава не та, которую я вам обещал последний раз. Более того, и следующая глава также.
Хорошие новости в причине появления этой главы: я нашел способ упростить и улучшить лексический анализатор компилятора. Позвольте мне объяснить.
ПРЕДПОСЫЛКА.
Если вы помните, мы подробно говорили на тему лексических анализаторов в Главе 7 и я оставил вас с проектом распределенного сканера который, я чувствовал, был почти настолько простым, насколько я смог сделать... более чем большинство из того, что я где-либо видел. Мы использовали эту идею в Главе 10. Полученная структура компилятора была простой и она делала свою работу.
Однако недавно я начал испытывать проблемы такого рода, которые подсказывают, что возможно вы делаете что-то неправильно.
Проблемы достигли критической стадии когда я попытался обратиться к вопросу точек с запятой. Некоторые люди спрашивали меня, действительно ли KISS будет использовать их для разделения операторов. Я не намеревался использовать точки с запятой просто потому, что они мне не нравятся и, как вы можете видеть, они не доказали своей необходимости.
Но я знаю, что многие из вас, как и я, привыкли к ним, так что я намеревался написать короткую главу чтобы показать вам, как легко они могут быть добавлены раз вы так склонны к ним.
Что ж, оказалось что их совсем непросто добавить. Фактически это было чрезвычайно трудно.
Я полагаю, что должен был понять что что-то было неправильно из-за проблемы переносов строк. В последних двух главах мы обращались к этому вопросу и я показал вам, как работать с переносами с помощью процедуры, названной достаточно соответствующе NewLine. В TINY Version 1.0 я расставил вызовы этой процедуры в стратегических местах кода.
Кажется, что всякий раз, когда я обращался к проблеме переносов, я, однако, находил этот вопрос сложным и полученный синтаксически анализатор оказывался очень ненадежным... одно удаление или добавление здесь или там и все разваливалось. Оглядываясь назад, я понимаю, что это было предупреждение, на которое я просто не обращал внимания.
Когда я попробовал добавить точку с запятой к переносам строк это стало последней каплей. Я получил слишком сложное решение. Я начал понимать, что необходимо что-то менять коренным образом.
Итак, в некотором отношении эта глава заставить нас возвратиться немного назад и пересмотреть заново вопрос лексического анализа. Сожалею об этом. Это цена, которую вы платите за возможность следить за мной в режиме реального времени. Но новая версия определенно усовершенствована и хорошо послужит нам дальше.
Как я сказал, сканер, использованный нами в Главе 10, был почти настолько простым, насколько возможно. Но все может быть улучшено. Новый сканер более похож на классический сканер и не так прост как прежде. Но общая структура компилятора даже проще чем раньше. Она также более надежная и проще для добавления и/или модификации. Я думаю, что она стоит времени, потраченного на это отклонение. Так что в этой главе я покажу вам новую структуру. Без сомнения вы будете счастливы узнать, что хотя изменения влияют на многие процедуры, они не очень глубоки и поэтому мы теряем не очень многое из того что было сделано до этого.
Как ни странно, новый сканер намного более стандартен чем старый и он очень похож на более общий сканер, показанный мной ранее в главе 7. Вы должны помнить день, когда я сказал: K-I-S-S!
ПРОБЛЕМА.
Проблема начинает проявлять себя в процедуре Block, которую я воспроизвел ниже:
Code: { Parse and Translate a Block of Statements }. Procedure Block; Begin. Scan; While not(Token in ['e', 'l']) do begin. Case Token of. 'i': DoIf; 'w': DoWhile; 'R': DoRead; 'W': DoWrite; Else Assignment; End; Scan; End; End;
Как вы можете видеть, Block ориентирован на индивидуальные утверждения программы. При каждом проходе цикла мы знаем, что мы находимся в начале утверждения. Мы выходим из блока когда обнаруживаем END или ELSE.
Но предположим, что вместо этого мы встретили точку с запятой. Вышеуказанная процедура не может ее обработать, так как процедура Scan ожидает и может принимать только токены, начинающиеся с буквы.
Я повозился с этим немного чтобы найти исправление. Я нашел множество возможных подходов, но ни один из них меня не удовлетворял. В конце концов я выяснил причину.
Вспомните, что когда мы начинали с наших одно-символьных синтаксических анализаторов, мы приняли соглашение, по которому предсказывающий символ должен быть всегда предварительно считан. То есть, мы имели бы символ, соответствующий нашей текущей позиции во входном потоке, помещенный в глобальной символьной переменной Look, так что мы могли проверять его столько раз, сколько необходимо. По правилу, которое мы приняли, каждый распознаватель, если он находил предназначенный ему символ, перемещал бы Look на следующий символ во входном потоке.
Это простое и фиксированное соглашение служило нам очень хорошо когда мы имели одно-символьные токены, и все еще служит. Был бы большой смысл применить то же самое правило и к много символьным токенам.
Но когда мы залезли в лексический анализ, я начал нарушать это простое правило. Сканер из Главы 10 действительно продвигался к следующему токену если он находил идентификатор или ключевое слово, но он не делал этого если находил возврат каретки, символ пробела или оператор.
Теперь, такой смешанный режим работы ввергает нас в глубокую проблему в процедуре Block, потому что был или нет входной поток продвинут зависит от вида встреченного нами токена. Если это ключевое слово или левая часть операции присваивания, "курсор", как определено содержимым Look, был продвинут к следующему символу или к началу незаполненного пространства. Если, с другой стороны, токен является точкой с запятой, или если мы нажали возврат каретки курсор не был продвинут.
Само собой разумеется, мы можем добавить достаточно логики чтобы удержаться на правильном пути. Но это сложно и делает весь анализатор очень ненадежным.
Существует гораздо лучший способ - просто принять то же самое правило, которое так хорошо работало раньше, и относиться к токенам так же как одиночным символам. Другими словами, мы будем заранее считывать токен подобно тому, как мы всегда считывали символ. Это кажется таким очевидным как только вы подумаете об этом способе.
Достаточно интересно, что если мы поступим таким образом, существующая проблема с символами перевода строки исчезнет. Мы можем просто рассматривать их как символы пробела, таким образом обработка переносов становится тривиальной и значительно менее склонной к ошибкам чем раньше.
РЕШЕНИЕ.
Давайте начнем решение проблемы с пересмотра двух процедуры:
Code: { Get an Identifier }. Procedure GetName; Begin. SkipWhite; If Not IsAlpha(Look) then Expected('Identifier'); Token := 'x'; Value := ''; Repeat. Value := Value + UpCase(Look); GetChar; Until not IsAlNum(Look); End; { Get a Number }. Procedure GetNum; Begin. SkipWhite; If not IsDigit(Look) then Expected('Number'); Token := '#'; Value := ''; Repeat. Value := Value + Look; GetChar; Until not IsDigit(Look); End;
Эти две процедуры функционально почти идентичны тем, которые я показал вам в Главе 7. Каждая из них выбирает текущий токен, или идентификатор или число, в глобальную строковую переменную Value. Они также присваивают кодированной версии, Token, соответствующий код. Входной поток останавливается на Look, содержащем первый символ, не являющийся частью токена.
Мы можем сделать то же самое для операторов, даже много символьных, с помощью процедуры типа:
Code: { Get an Operator }. Procedure GetOp; Begin. Token := Look; Value := ''; Repeat. Value := Value + Look; GetChar; Until IsAlpha(Look) or IsDigit(Look) or IsWhite(Look); End;
Обратите внимание, что GetOps возвращает в качестве закодированного токена первый символ оператора. Это важно, потому что это означает, что теперь мы можем использовать этот одиночный символ для управления синтаксическим анализатором вместо предсказывающего символа.
Нам нужно связать эти процедуры вместе в одну процедуру, которая может обрабатывать все три случая. Следующая процедура будет считывать любой из этих типов токенов и всегда оставлять входной поток за ним:
Code: { Get the Next Input Token }. Procedure Next; Begin. SkipWhite; If IsAlpha(Look) then GetName. Else if IsDigit(Look) then GetNum. Else GetOp; End;
Обратите внимание, что здесь я поместил SkipWhite перед вызовами а не после. Это означает в основном, что переменная Look не будет содержать значимого значения и, следовательно, мы не должны использовать ее как тестируемое значение при синтаксическом анализе, как мы делали до этого. Это большое отклонение от нашего нормального подхода.
Теперь, не забудьте, что раньше я избегал обработки символов возврата каретки (CR) и перевода строки (LF) как незаполненного пространства. Причина была в том, что так как SkipWhite вызывается последней в сканере, встреча с LF инициировала бы чтение из входного потока. Если бы мы были на последней строке программы, мы не могли бы выйти до тех пор, пока мы не введем другую строку с отличным от пробела символом. Именно поэтому мне требовалась вторая процедура NewLine для обработки CRLF.
Но сейчас, когда первым происходит вызов SkipWhite, это то поведение, которое нам нужно. Компилятор должен знать, что появился другой токен или он не должен вызывать Next. Другими словами, он еще не обнаружил завершающий END. Поэтому мы будем настаивать на дополнительных данных до тех пор, пока не найдем что-либо.
Все это означает, что мы можем значительно упростить и программу и концепции, обрабатывая CR и LF как незаполненное пространство и убрав NewLine. Вы можете сделать это просто изменив функцию IsWhite:
Code: { Recognize White Space }. Function IsWhite(c: char): boolean; Begin. IsWhite := c in [' ', TAB, CR, LF]; End;
Мы уже пробовали аналогичные подпрограммы в Главе 7, но вы могли бы также попробовать и эти. Добавьте их к копии Cradle и вызовите Next в основной программе:
Code: { Main Program }. Begin. Init; Repeat. Next; WriteLn(Token, ' ', Value); Until Token = '.'; End.
Откомпилируйте и проверьте, что вы можете разделять программу на серии токенов и вы получаете правильные кода для каждого токена.
Почти работает, но не совсем. Существуют две потенциальные проблемы: Во-первых, в KISS/TINY почти все наши операторы - одно-символьные. Единственное исключение составляют операторы отношений >=, <= и <>. Было бы позором обрабатывать все операторы как строки и выполнять сравнение строк когда почти всегда удовлетворит сравнение одиночных символов. Второе, и более важное, программа не работает, когда два оператора появляются вместе как в (a+b)*(c+d). Здесь строка после b была бы интерпретирована как один оператор ")*(".
Можно устранить эту проблему. К примеру мы могли бы просто дать GetOp список допустимых символов и обрабатывать скобки как отличный от других тип операторов. Но это хлопотное дело.
К счастью, имеется лучший способ, который решает все эти проблемы. Так как почти все операторы одно-символьные, давайте просто позволим GetOp получать только один символ одновременно. Это не только упрощает GetOp, но также немного ускоряет программу. У нас все еще остается проблема операторов отношений, но мы в любом случае обрабатывали их как специальные случаи.
Так что вот финальная версия GetOp:
Code: { Get an Operator }. Procedure GetOp; Begin. SkipWhite; Token := Look; Value := Look; GetChar; End;
Обратите внимание, что я все еще присваиваю Value значение. Если вас действительно затрагивает эффективность, вы могли бы это опустить. Когда мы ожидаем оператор, мы в любом случае будем проверять только Token, так что значение этой строки не будет иметь значение. Но мне кажется хорошая практика дать ей значение на всякий случай.
Испытайте эту версию с каким-нибудь реалистично выглядящим кодом. Вы должны быть способны разделять любую программу на ее индивидуальные токены, но предупреждаю, что двух символьные операторы отношений будут отсканированы как два раздельных токена. Это нормально... мы будем выполнять их синтаксический анализ таким способом.
Теперь, в главе 7 функция Next была объединена с процедурой Scan, которая также сверяла каждый идентификатор со списком ключевых слов и кодировала каждый найденный. Как я упомянул тогда, последнее, что мы захотели бы сделать - использовать такую процедуру в местах, где ключевые слова не должны появляться, таких как выражения. Если бы мы сделали это, список ключевых слов просматривался бы для каждого идентификатора, появляющегося в коде. Нехорошо.
Правильней было бы в этом случае просто разделить функции выборки токенов и поиска ключевых слов. Версия Scan, показанная ниже, только проверяет ключевые слова. Обратите внимание, что она оперирует текущим токеном и не продвигает входной поток.
Code: { Scan the Current Identifier for Keywords }. Procedure Scan; Begin. If Token = 'x' then. Token := KWcode[Lookup(Addr(KWlist), Value, NKW) + 1]; End;
Последняя деталь. В компиляторе есть несколько мест, в которых мы должны фактически проверить строковое значение токена. В основном это сделано для того, чтобы различать разные END, но есть и пара других мест. (Я должен заметить, между прочим, что мы могли бы навсегда устранить потребность в сравнении символов END кодируя каждый из них различными символами. Прямо сейчас мы определенно идем маршрутом ленивого человека.).
Следующая версия MatchString замещает символьно-ориентированную Match. Заметьте, что как и Match она не продвигает входной поток.
{ Match a Specific Input String }.
Procedure MatchString(x: string); begin if Value <> x then Expected('''' + x + ''''); Next; end;
ИСПРАВЛЕНИЕ КОМПИЛЯТОРА.
Вооружившись этими новыми процедурами лексического анализа мы можем теперь начать исправлять компилятор. Изменения весьма незначительные, но есть довольно много мест, где они необходимы. Вместо того, чтобы показывать вам каждое место я дам вам общую идею а затем просто покажу готовый продукт.
Прежде всего, код процедуры Block не изменяется, но меняется ее назначение:
Code: { Parse and Translate a Block of Statements }. Procedure Block; Begin. Scan; While not(Token in ['e', 'l']) do begin. Case Token of. 'i': DoIf; 'w': DoWhile; 'R': DoRead; 'W': DoWrite; Else Assignment; End; Scan; End; End;
Не забудьте, что новая версия Scan не продвигает входной поток, она только сканирует ключевые слова. Входной поток должен продвигаться каждой процедурой, которую вызывает Block.
В общих чертах, мы должны заменить каждую проверку Look на аналогичную проверку Token. Например:
Code: {---------------------------------------------------------------} { Parse and Translate a Boolean Expression }. Procedure BoolExpression; Begin. BoolTerm; While IsOrOp(Token) do begin. Push; Case Token of. '|': BoolOr; '~': BoolXor; End; End; End;
В процедурах типа Add мы больше не должны использовать Match. Нам необходимо только вызывать Next для продвижения входного потока:
Code: { Recognize and Translate an Add }. Procedure Add; Begin. Next; Term; PopAdd; End;
Управляющие структуры фактически более простые. Мы просто вызываем Next для продвижения через ключевые слова управляющих конструкций:
Code: { Recognize and Translate an IF Construct }. Procedure Block; Forward; Procedure DoIf; Var L1, L2: string; Begin. Next; BoolExpression; L1 := NewLabel; L2 := L1; BranchFalse(L1); Block; If Token = 'l' then begin. Next; L2 := NewLabel; Branch(L2); PostLabel(L1); Block; End; PostLabel(L2); MatchString('ENDIF'); End;
Это все необходимые изменения. В листинге Tiny Version 1.1, данном ниже, я также сделал ряд других "усовершенствований", которые в действительности не нужны. Позвольте мне кратко разъяснить их:
1. Я удалил две процедуры Prog и Main и объединил их функции в основной программе. Они кажется не добавляли ясности... фактически они просто немного загрязняли программу.
2. Я удалил ключевые слова PROGRAM и BEGIN из списка ключевых слов. Каждое из них появляется в одном месте, так что нет необходимости искать его.
3. Обжегшись однажды на чрезмерной дозе сообразительности, я напомнил себе, что TINY предназначен быть минималистским языком. Поэтому я заменил причудливую обработку унарного минуса на самую простую какую мог придумать. Гигантский шаг назад в качестве кода, но огромное упрощение компилятора. Для использования другой версии правильным местом был бы KISS.
4. Я добавил несколько подпрограмм проверок ошибок типа CheckTable и CheckDup и заменил встроенный код на их вызовы. Это навело порядок во многих подпрограммах.
5. Я убрал проверку ошибок из подпрограмм генерации кода типа Store и поместил их в подпрограммы анализа, к которым они относятся. Смотрите например Assignment.
6. Существовала ошибка в InTable и Locate которая заставляла их проверять все позиции вместо позиций только с достоверными данными. Теперь они проверяют только допустимые ячейки. Это позволяет нам устранить необходимость инициализации таблицы идентификаторов, которая была в Init.
7. Процедура AddEntry теперь имеет два параметра, что помогает сделать программу немного более модульной.
8. Я подчистил код для операторов отношений добавив новые процедуры CompareExpression и NextExpression.
9. Я устранил ошибку в подпрограмме Read... старая версия не выполняла проверку на правильность имени переменной.
ЗАКЛЮЧЕНИЕ.
Полученный компилятор Tiny показан ниже. Не считая удаленного ключевого слова PROGRAM он анализирует тот же самый язык что и раньше. Он просто немного чище и, что более важно, значительно более надежный. Он мне нравится.
В следующей главе будет другое отклонение: с начала обсуждение точек с запятой и все, что привело меня такому беспорядку. Затем мы займемся процедурами и типами. Добавление этих возможностей далеко продвинет нас на пути к выведению KISS из категории "игрушечных языков". Мы подобрались очень близко к возможности написать серьезный компилятор.
TINY VERSION 1.1.
Code: Program Tiny11; { Constant Declarations }. Const TAB = ^I; CR = ^M; LF = ^J; LCount: integer = 0; NEntry: integer = 0; { Type Declarations }. Type Symbol = string[8]; SymTab = array[1..1000] of Symbol; TabPtr = ^SymTab; { Variable Declarations }. Var Look : char; { Lookahead Character }. Token: char; { Encoded Token }. Value: string[16]; { Unencoded Token }. Const MaxEntry = 100; Var ST : array[1..MaxEntry] of Symbol; SType: array[1..MaxEntry] of char; { Definition of Keywords and Token Types }. Const NKW = 9; NKW1 = 10; Const KWlist: array[1..NKW] of Symbol = ('IF', 'ELSE', 'ENDIF', 'WHILE', 'ENDWHILE', 'READ', 'WRITE', 'VAR', 'END'); Const KWcode: string[NKW1] = 'xileweRWve'; { Read New Character From Input Stream }. Procedure GetChar; Begin. Read(Look); End; { Report an Error }. Procedure Error(s: string); Begin. WriteLn; WriteLn(^G, 'Error: ', s, '.'); End; { Report Error and Halt }. Procedure Abort(s: string); Begin. Error(s); Halt; End; { Report What Was Expected }. Procedure Expected(s: string); Begin. Abort(s + ' Expected'); End; { Report an Undefined Identifier }. Procedure Undefined(n: string); Begin. Abort('Undefined Identifier ' + n); End; { Report a Duplicate Identifier }. Procedure Duplicate(n: string); Begin. Abort('Duplicate Identifier ' + n); End; { Check to Make Sure the Current Token is an Identifier }. Procedure CheckIdent; Begin. If Token <> 'x' then Expected('Identifier'); End; { Recognize an Alpha Character }. Function IsAlpha(c: char): boolean; Begin. IsAlpha := UpCase(c) in ['A'..'Z']; End; { Recognize a Decimal Digit }. Function IsDigit(c: char): boolean; Begin. IsDigit := c in ['0'..'9']; End; { Recognize an AlphaNumeric Character }. Function IsAlNum(c: char): boolean; Begin. IsAlNum := IsAlpha(c) or IsDigit(c); End; { Recognize an Addop }. Function IsAddop(c: char): boolean; Begin. IsAddop := c in ['+', '-']; End; { Recognize a Mulop }. Function IsMulop(c: char): boolean; Begin. IsMulop := c in ['*', '/']; End; { Recognize a Boolean Orop }. Function IsOrop(c: char): boolean; Begin. IsOrop := c in ['|', '~']; End; { Recognize a Relop }. Function IsRelop(c: char): boolean; Begin. IsRelop := c in ['=', '#', '<', '>']; End; { Recognize White Space }. Function IsWhite(c: char): boolean; Begin. IsWhite := c in [' ', TAB, CR, LF]; End; { Skip Over Leading White Space }. Procedure SkipWhite; Begin. While IsWhite(Look) do. GetChar; End; { Table Lookup }. Function Lookup(T: TabPtr; s: string; n: integer): integer; Var i: integer; Found: Boolean; Begin. Found := false; I := n; While (i > 0) and not found do. If s = T^[i] then. Found := true. Else. Dec(i); Lookup := i; End; { Locate a Symbol in Table }. { Returns the index of the entry. Zero if not present. }. Function Locate(N: Symbol): integer; Begin. Locate := Lookup(@ST, n, NEntry); End; { Look for Symbol in Table }. Function InTable(n: Symbol): Boolean; Begin. InTable := Lookup(@ST, n, NEntry) <> 0; End; { Check to See if an Identifier is in the Symbol Table }. { Report an error if it's not. }. Procedure CheckTable(N: Symbol); Begin. If not InTable(N) then Undefined(N); End; { Check the Symbol Table for a Duplicate Identifier }. { Report an error if identifier is already in table. }. Procedure CheckDup(N: Symbol); Begin. If InTable(N) then Duplicate(N); End; { Add a New Entry to Symbol Table }. Procedure AddEntry(N: Symbol; T: char); Begin. CheckDup(N); If NEntry = MaxEntry then Abort('Symbol Table Full'); Inc(NEntry); ST[NEntry] := N; SType[NEntry] := T; End; { Get an Identifier }. Procedure GetName; Begin. SkipWhite; If Not IsAlpha(Look) then Expected('Identifier'); Token := 'x'; Value := ''; Repeat. Value := Value + UpCase(Look); GetChar; Until not IsAlNum(Look); End; { Get a Number }. Procedure GetNum; Begin. SkipWhite; If not IsDigit(Look) then Expected('Number'); Token := '#'; Value := ''; Repeat. Value := Value + Look; GetChar; Until not IsDigit(Look); End; { Get an Operator }. Procedure GetOp; Begin. SkipWhite; Token := Look; Value := Look; GetChar; End; { Get the Next Input Token }. Procedure Next; Begin. SkipWhite; If IsAlpha(Look) then GetName. Else if IsDigit(Look) then GetNum. Else GetOp; End; { Scan the Current Identifier for Keywords }. Procedure Scan; Begin. If Token = 'x' then. Token := KWcode[Lookup(Addr(KWlist), Value, NKW) + 1]; End; { Match a Specific Input String }. Procedure MatchString(x: string); Begin. If Value <> x then Expected('''' + x + ''''); Next; End; { Output a String with Tab }. Procedure Emit(s: string); Begin. Write(TAB, s); End; { Output a String with Tab and CRLF }. Procedure EmitLn(s: string); Begin. Emit(s); WriteLn; End; { Generate a Unique Label }. Function NewLabel: string; Var S: string; Begin. Str(LCount, S); NewLabel := 'L' + S; Inc(LCount); End; { Post a Label To Output }. Procedure PostLabel(L: string); Begin. WriteLn(L, ':'); End; {---------------------------------------------------------------} { Clear the Primary Register }. Procedure Clear; Begin. EmitLn('CLR D0'); End; {---------------------------------------------------------------} { Negate the Primary Register }. Procedure Negate; Begin. EmitLn('NEG D0'); End; {---------------------------------------------------------------} { Complement the Primary Register }. Procedure NotIt; Begin. EmitLn('NOT D0'); End; {---------------------------------------------------------------} { Load a Constant Value to Primary Register }. Procedure LoadConst(n: string); Begin. Emit('MOVE #'); WriteLn(n, ',D0'); End; {---------------------------------------------------------------} { Load a Variable to Primary Register }. Procedure LoadVar(Name: string); Begin. If not InTable(Name) then Undefined(Name); EmitLn('MOVE ' + Name + '(PC),D0'); End; {---------------------------------------------------------------} { Push Primary onto Stack }. Procedure Push; Begin. EmitLn('MOVE D0,-(SP)'); End; {---------------------------------------------------------------} { Add Top of Stack to Primary }. Procedure PopAdd; Begin. EmitLn('ADD (SP)+,D0'); End; {---------------------------------------------------------------} { Subtract Primary from Top of Stack }. Procedure PopSub; Begin. EmitLn('SUB (SP)+,D0'); EmitLn('NEG D0'); End; {---------------------------------------------------------------} { Multiply Top of Stack by Primary }. Procedure PopMul; Begin. EmitLn('MULS (SP)+,D0'); End; {---------------------------------------------------------------} { Divide Top of Stack by Primary }. Procedure PopDiv; Begin. EmitLn('MOVE (SP)+,D7'); EmitLn('EXT.L D7'); EmitLn('DIVS D0,D7'); EmitLn('MOVE D7,D0'); End; {---------------------------------------------------------------} { AND Top of Stack with Primary }. Procedure PopAnd; Begin. EmitLn('AND (SP)+,D0'); End; {---------------------------------------------------------------} { OR Top of Stack with Primary }. Procedure PopOr; Begin. EmitLn('OR (SP)+,D0'); End; {---------------------------------------------------------------} { XOR Top of Stack with Primary }. Procedure PopXor; Begin. EmitLn('EOR (SP)+,D0'); End; {---------------------------------------------------------------} { Compare Top of Stack with Primary }. Procedure PopCompare; Begin. EmitLn('CMP (SP)+,D0'); End; {---------------------------------------------------------------} { Set D0 If Compare was = }. Procedure SetEqual; Begin. EmitLn('SEQ D0'); EmitLn('EXT D0'); End; {---------------------------------------------------------------} { Set D0 If Compare was != }. Procedure SetNEqual; Begin. EmitLn('SNE D0'); EmitLn('EXT D0'); End; {---------------------------------------------------------------} { Set D0 If Compare was > }. Procedure SetGreater; Begin. EmitLn('SLT D0'); EmitLn('EXT D0'); End; {---------------------------------------------------------------} { Set D0 If Compare was < }. Procedure SetLess; Begin. EmitLn('SGT D0'); EmitLn('EXT D0'); End; {---------------------------------------------------------------} { Set D0 If Compare was <= }. Procedure SetLessOrEqual; Begin. EmitLn('SGE D0'); EmitLn('EXT D0'); End; {---------------------------------------------------------------} { Set D0 If Compare was >= }. Procedure SetGreaterOrEqual; Begin. EmitLn('SLE D0'); EmitLn('EXT D0'); End; {---------------------------------------------------------------} { Store Primary to Variable }. Procedure Store(Name: string); Begin. EmitLn('LEA ' + Name + '(PC),A0'); EmitLn('MOVE D0,(A0)'). End; {---------------------------------------------------------------} { Branch Unconditional }. Procedure Branch(L: string); Begin. EmitLn('BRA ' + L); End; {---------------------------------------------------------------} { Branch False }. Procedure BranchFalse(L: string); Begin. EmitLn('TST D0'); EmitLn('BEQ ' + L); End; {---------------------------------------------------------------} { Read Variable to Primary Register }. Procedure ReadIt(Name: string); Begin. EmitLn('BSR READ'); Store(Name); End; { Write from Primary Register }. Procedure WriteIt; Begin. EmitLn('BSR WRITE'); End; { Write Header Info }. Procedure Header; Begin. WriteLn('WARMST', TAB, 'EQU $A01E'); End; { Write the Prolog }. Procedure Prolog; Begin. PostLabel('MAIN'); End; { Write the Epilog }. Procedure Epilog; Begin. EmitLn('DC WARMST'); EmitLn('END MAIN'); End; {---------------------------------------------------------------} { Allocate Storage for a Static Variable }. Procedure Allocate(Name, Val: string); Begin. WriteLn(Name, ':', TAB, 'DC ', Val); End; {---------------------------------------------------------------} { Parse and Translate a Math Factor }. Procedure BoolExpression; Forward; Procedure Factor; Begin. If Token = '(' then begin. Next; BoolExpression; MatchString(')'); End. Else begin. If Token = 'x' then. LoadVar(Value). Else if Token = '#' then. LoadConst(Value). Else Expected('Math Factor'); Next; End; End; { Recognize and Translate a Multiply }. Procedure Multiply; Begin. Next; Factor; PopMul; End; {-------------------------------------------------------------} { Recognize and Translate a Divide }. Procedure Divide; Begin. Next; Factor; PopDiv; End; {---------------------------------------------------------------} { Parse and Translate a Math Term }. Procedure Term; Begin. Factor; While IsMulop(Token) do begin. Push; Case Token of. '*': Multiply; '/': Divide; End; End; End; { Recognize and Translate an Add }. Procedure Add; Begin. Next; Term; PopAdd; End; {-------------------------------------------------------------} { Recognize and Translate a Subtract }. Procedure Subtract; Begin. Next; Term; PopSub; End; {---------------------------------------------------------------} { Parse and Translate an Expression }. Procedure Expression; Begin. If IsAddop(Token) then. Clear. Else. Term; While IsAddop(Token) do begin. Push; Case Token of. '+': Add; '-': Subtract; End; End; End; {---------------------------------------------------------------} { Get Another Expression and Compare }. Procedure CompareExpression; Begin. Expression; PopCompare; End; {---------------------------------------------------------------} { Get The Next Expression and Compare }. Procedure NextExpression; Begin. Next; CompareExpression; End; {---------------------------------------------------------------} { Recognize and Translate a Relational "Equals" }. Procedure Equal; Begin. NextExpression; SetEqual; End; {---------------------------------------------------------------} { Recognize and Translate a Relational "Less Than or Equal" }. Procedure LessOrEqual; Begin. NextExpression; SetLessOrEqual; End; {---------------------------------------------------------------} { Recognize and Translate a Relational "Not Equals" }. Procedure NotEqual; Begin. NextExpression; SetNEqual; End; {---------------------------------------------------------------} { Recognize and Translate a Relational "Less Than" }. Procedure Less; Begin. Next; Case Token of. '=': LessOrEqual; '>': NotEqual; Else begin. CompareExpression; SetLess; End; End; End; {---------------------------------------------------------------} { Recognize and Translate a Relational "Greater Than" }. Procedure Greater; Begin. Next; If Token = '=' then begin. NextExpression; SetGreaterOrEqual; End. Else begin. CompareExpression; SetGreater; End; End; {---------------------------------------------------------------} { Parse and Translate a Relation }. Procedure Relation; Begin. Expression; If IsRelop(Token) then begin. Push; Case Token of. '=': Equal; '<': Less; '>': Greater; End; End; End; {---------------------------------------------------------------} { Parse and Translate a Boolean Factor with Leading NOT }. Procedure NotFactor; Begin. If Token = '!' then begin. Next; Relation; NotIt; End. Else. Relation; End; {---------------------------------------------------------------} { Parse and Translate a Boolean Term }. Procedure BoolTerm; Begin. NotFactor; While Token = '&' do begin. Push; Next; NotFactor; PopAnd; End; End; { Recognize and Translate a Boolean OR }. Procedure BoolOr; Begin. Next; BoolTerm; PopOr; End; { Recognize and Translate an Exclusive Or }. Procedure BoolXor; Begin. Next; BoolTerm; PopXor; End; {---------------------------------------------------------------} { Parse and Translate a Boolean Expression }. Procedure BoolExpression; Begin. BoolTerm; While IsOrOp(Token) do begin. Push; Case Token of. '|': BoolOr; '~': BoolXor; End; End; End; { Parse and Translate an Assignment Statement }. Procedure Assignment; Var Name: string; Begin. CheckTable(Value); Name := Value; Next; MatchString('='); BoolExpression; Store(Name); End; {---------------------------------------------------------------} { Recognize and Translate an IF Construct }. Procedure Block; Forward; Procedure DoIf; Var L1, L2: string; Begin. Next; BoolExpression; L1 := NewLabel; L2 := L1; BranchFalse(L1); Block; If Token = 'l' then begin. Next; L2 := NewLabel; Branch(L2); PostLabel(L1); Block; End; PostLabel(L2); MatchString('ENDIF'); End; { Parse and Translate a WHILE Statement }. Procedure DoWhile; Var L1, L2: string; Begin. Next; L1 := NewLabel; L2 := NewLabel; PostLabel(L1); BoolExpression; BranchFalse(L2); Block; MatchString('ENDWHILE'); Branch(L1); PostLabel(L2); End; { Read a Single Variable }. Procedure ReadVar; Begin. CheckIdent; CheckTable(Value); ReadIt(Value); Next; End; { Process a Read Statement }. Procedure DoRead; Begin. Next; MatchString('('); ReadVar; While Token = ',' do begin. Next; ReadVar; End; MatchString(')'); End; { Process a Write Statement }. Procedure DoWrite; Begin. Next; MatchString('('); Expression; WriteIt; While Token = ',' do begin. Next; Expression; WriteIt; End; MatchString(')'); End; { Parse and Translate a Block of Statements }. Procedure Block; Begin. Scan; While not(Token in ['e', 'l']) do begin. Case Token of. 'i': DoIf; 'w': DoWhile; 'R': DoRead; 'W': DoWrite; Else Assignment; End; Scan; End; End; { Allocate Storage for a Variable }. Procedure Alloc; Begin. Next; If Token <> 'x' then Expected('Variable Name'); CheckDup(Value); AddEntry(Value, 'v'); Allocate(Value, '0'); Next; End; { Parse and Translate Global Declarations }. Procedure TopDecls; Begin. Scan; While Token = 'v' do. Alloc; While Token = ',' do. Alloc; End; { Initialize }. Procedure Init; Begin. GetChar; Next; End; { Main Program }. Begin. Init; MatchString('PROGRAM'); Header; TopDecls; MatchString('BEGIN'); Prolog; Block; MatchString('END'); Epilog; End.
| Пример Drag and Drop между двумя DBGRID. |
Данный пример компонента и демонстрационный проект показывают простой путь осуществления операции "drag and drop" (перетащи и брось) между двумя полями различных табличных сеток.
Перехватчики паролей.
| Перехватчики паролей |
Задача защиты информации, хранимой в компьютерных системах, от несанкционированного доступа (НСД), является весьма актуальной. Для решения этой задачи используется целый комплекс средств, включающий в себя технические, программно-аппаратные средства и административные меры защиты информации. По мере развития средств защиты компьютерных систем развиваются и средства нападения. Злоумышленники-хакеры изобретают все новые и новые атаки на различные элементы подсистем защиты компьютерных систем. Одной из наиболее опасных является атака защищенной системы посредством программных закладок. Программная закладка - это программа или фрагмент программы, скрытно внедряемый в защищенную систему и позволяющий злоумышленнику, внедрившему его, осуществлять в дальнейшем НСД к тем или иным ресурсам защищенной системы. Основная опасность программных закладок заключается в том, что, программная закладка, являясь частью защищенной системы, способна принимать активные меры по маскировке своего присутствия в системе. При внедрении в систему закладки в защищенной системе создается скрытый канал информационного обмена, который, как правило, остается незамеченным для администраторов системы в течение длительного времени. Практически все известные программные закладки, применявшиеся в разное время различными злоумышленниками, были выявлены либо из-за ошибок, допущенных при программировании закладки, либо чисто случайно. В предлагаемой работе рассматривается один из наиболее распространенных классов программных закладок - закладки, перехватывающие пароли пользователей операционных систем (перехватчики паролей). Перехватчики паролей были разработаны в разное время для целого ряда операционных систем, включая OS/370, MS-DOS и многие версии Windows и UNIX. Перехватчик паролей, внедренный в операционную систему, тем или иным способом получает доступ к паролям, вводимым пользователями при входе в систему. Перехватив очередной пароль, закладка записывает его в специальный файл или в любое другое место, доступное злоумышленнику, внедрившему закладку в систему. Данная статья посвящена классификации перехватчиков паролей, описанию архитектуры типичных перехватчиков паролей, а также методов защиты от них. Перехватчики паролей первого рода. Перехватчики паролей первого рода действуют по следующему алгоритму. Злоумышленник запускает программу, которая имитирует приглашение пользователю для входа в систему и ждет ввода. Когда пользователь вводит имя и пароль, закладка сохраняет их в доступном злоумышленнику месте, после чего завершает работу и осуществляет выход из системы пользователя-злоумышленника (в большинстве операционных систем выход пользователя из системы можно осуществить программно). По окончании работы закладки на экране появляется настоящее приглашение для входа пользователя в систему. Пользователь, ставший жертвой закладки, видит, что он не вошел в систему, и что ему снова предлагается ввести имя и пароль. Пользователь предполагает, что при вводе пароля произошла ошибка, и вводит имя и пароль повторно. После этого пользователь входит в систему, и дальнейшая его работа протекает нормально. Некоторые закладки, функционирующие по данной схеме, перед завершением работы выдают на экран правдоподобное сообщение об ошибке, например: "Пароль введен неправильно. Попробуйте еще раз". Основным достоинством этого класса перехватчиков паролей является то, что написание подобной программной закладки не требует от злоумышленника никакой специальной квалификации. Любой пользователь, умеющий программировать хотя бы на языке BASIC, может написать такую программу за считанные часы. Единственная проблема, которая может здесь возникнуть, заключается в программной реализации выхода пользователя из системы. Однако соответствующий системный вызов документирован для всех многопользовательских операционных систем, известных автору. Если злоумышленник не поленится внимательно изучить документацию по операционной системе, то он решит данную проблему очень быстро. Перехватчики паролей первого рода представляют наибольшую опасность для тех операционных систем, в которых приглашение пользователю на вход имеет очень простой вид. Например, в большинстве версий ОС UNIX это приглашение выглядит следующим образом: login: user password: Задача создания программы, подделывающей такое приглашение, тривиальна. Защита от перехватчиков паролей первого рода. Усложнение внешнего вида приглашения на вход в систему несколько затрудняет решение задачи перехвата паролей, однако не создает для злоумышленника никаких принципиальных трудностей. Для того, чтобы существенно затруднить внедрение в систему перехватчиков паролей первого рода, необходимы более сложные меры защиты. Примером операционной системы, где такие меры реализованы, является Windows NT. В Windows NT обычная работа пользователя и аутентификация пользователя при входе в систему осуществляются на разных рабочих полях (desktops). Рабочее поле Windows NT представляет собой совокупность окон, одновременно видимых на экране. Только процессы, окна которых расположены на одном рабочем поле, могут взаимодействовать между собой, используя средства Windows GUI. Понятие рабочего поля Windows NT близко к понятию терминала UNIX. Процесс Winlogon, получающий от пользователя имя и пароль, выполняется на отдельном рабочем поле (рабочем поле аутентификации). Никакой другой процесс, в том числе и перехватчик паролей, не имеет доступа к этому рабочему полю. Поэтому приглашение пользователю на вход в систему, выводимое перехватчиком паролей первого рода, может располагаться только на рабочем поле прикладных программ, где выполняются все программ, запущенные пользователем. Переключение экрана компьютера с одного рабочего поля на другое производится при нажатии комбинации клавиш Ctrl-Alt-Del. Win32-подсистема Windows NT обрабатывает эту комбинацию по-особому - сообщение о нажатии Ctrl-Alt-Del посылается только процессу Winlogon. Для всех других процессов, в частности, для всех прикладных программ, запущенных пользователем, нажатие этой комбинации клавиш совершенно незаметно. При старте системы на экран компьютера вначале отображается рабочее поле аутентификации. Однако пользователь вводит имя и пароль не сразу, а только после нажатия Ctrl-Alt-Del. Когда пользователь завершает сеанс работы с системой, на экран также выводится рабочее поле аутентификации, и, так же как и в предыдущем случае, новый пользователь может ввести пароль для входа в систему только после нажатия Ctrl-Alt-Del. Если в систему внедрен перехватчик паролей первого рода, то, для того, чтобы он смог перехватить пароль пользователя, он должен по крайней мере обработать нажатие пользователем Ctrl-Alt-Del. В противном случае при нажатии пользователем этой комбинации клавиш произойдет переключение на рабочее поле аутентификации, рабочее поле прикладных программ станет неактивным, и перехватчик паролей просто не сможет ничего перехватить - сообщения о нажатии пользователем клавиш будут приходить на другое рабочее поле. Однако для всех прикладных программ факт нажатия пользователем Ctrl-Alt-Del всегда остается незамеченным. Поэтому пароль будет воспринят не программной закладкой, а процессом Winlogon. Конечно, перехватчик паролей может имитировать не первое приглашение операционной системы, где пользователю предлагается нажать Ctrl-Alt-Del, а то приглашение, которое высвечивается после нажатия пользователем этой комбинации. Однако в обычных условиях (при отсутствии программной закладки) это второе приглашение автоматически отменяется через достаточно короткое время (от 30 секунд до 1 минуты, зависит от версии Windows NT). Если второе приглашение присутствует на экране компьютера долгое время, этот факт должен насторожить пользователя. Кроме того, как показывает опыт, пользователи, долгое время работающие с Windows NT, приобретают привычку начинать работу с системой с нажатия Ctrl-Alt-Del независимо от того, что отображается на экране. Защита Windows NT от перехватчиков паролей первого рода весьма надежна. Видимо, при разработке мер защиты операционной системы от перехватчиков паролей первого рода следует ориентироваться на механизм, подобный вышеописанному. Следует обратить особое внимание на следующие два условия, выполнение которых обязательно для обеспечения надежной защиты от перехватчиков паролей первого рода: Программа, получающая от пользователя имя и пароль при входе в систему, выполняется на изолированном терминале (терминале аутентификации), недоступном прикладным программам. Факт переключения пользовательской консоли на терминал аутентификации незаметен прикладным программам. Прикладные программы не могут запретить переключение консоли на терминал аутентификации. Если операционная система не поддерживает эти возможности (а ни одна операционная система, известная автору, кроме Windows NT, эти возможности не поддерживает), защищенность системы от перехватчиков паролей первого рода можно повысить административными мерами. Каждый пользователь системы должен быть проинструктирован, что если он несколько раз подряд не может войти в систему с первого раза, он должен обратиться к администратору. Перехватчики паролей второго рода. Перехватчики паролей второго рода перехватывают все данные, вводимые пользователем с клавиатуры. Простейшие программные закладки данного типа просто сбрасывают все эти данные на жесткий диск компьютера или в любое другое место, доступное злоумышленнику. Более совершенные закладки анализируют перехваченные данные и отсеивают информацию, заведомо не имеющую отношения к паролям. Несколько подобных закладок были в разное время написаны для операционной системы MS-DOS, некоторые из них использовались на практике, причем весьма эффективно. Одна из таких закладок и пример ее эффективного использования описаны в [6]. Эти закладки представляют собой резидентные программы, перехватывающие одно или несколько прерываний процессора, имеющих отношение к работе с клавиатурой. Информация о нажатой клавише и введенном символе, возвращаемая этими прерываниями, используется закладками для своих целей. В конце 1997 года на хакерских серверах Internet появились перехватчики паролей второго рода для Windows 3.x и Windows 95. Примеры их использования злоумышленниками для осуществления НСД пока не встречались на практике. В телеконференциях Internet (newsgroups) несколько раз встречались сообщения об атаках Windows 95 перехватчиками паролей второго рода. Однако эта информация ни разу не подтверждалась. Создание подобных программных закладок не связано со значительными трудностями. Программные интерфейсы Win16 и Win32 поддерживают специальный механизм фильтров (hooks), который может быть использован для перехвата паролей пользователей. С помощью этого механизма прикладные программы и сама операционная система решают целый ряд задач, в том числе и задачу поддержки национальных раскладок клавиатуры. Любой русификатор клавиатуры, работающий в среде Windows, перехватывает всю информацию, вводимую пользователем с клавиатуры, в том числе и пароли. Несложно написать русификатор так, чтобы он, помимо своих основных функций, выполнял бы и функции перехватчика паролей. Написание программы локализации клавиатуры является достаточно простой задачей. Во многих справочниках и учебниках по программированию эта задача подробно описана, в некоторых изданиях, например в [5], приведены исходные тексты простейшего русификатора клавиатуры. Более того, Windows поддерживает цепочки фильтров, с помощью которых несколько программ могут одновременно получать доступ к информации, вводимой с клавиатуры, и обрабатывать ее так, как считают нужным, при необходимости передавая обработанную информацию дальше по цепочке. Можно встроить перехватчик паролей в цепочку фильтров перед русификатором или после него, так, что вся информация, вводимая пользователем с клавиатуры, проходит и через русификатор, и через перехватчик паролей. В этом случае задача написания программной закладки, перехватывающей пароли пользователей Windows, становится настолько простой, что практически не требует от автора закладки специальной квалификации. Вообще, в большинстве случаев верно следующее утверждение. Если операционная система допускает переключение раскладки клавиатуры при вводе пароля, то для этой операционной системы можно написать перехватчик паролей второго рода. Действительно, если для операционной системы существует программа локализации раскладки клавиатуры, и если эта программа используется при вводе пароля, после незначительного изменения исходного текста эта программа превращается в перехватчик паролей второго рода. Если эта программа написана на языке C, в простейшем случае достаточно добавить в программу четыре оператора примерно следующего вида:
StoreFile = fopen(FileName, "a + b");
Fseek(StoreFile, 0, SEEK_END);
Fputc(NewSymbol, StoreFile);
Fclose(StoreFile);
Для некоторых операционных систем можно обойтись тремя операторами. Защита от перехватчиков паролей второго рода. Для организации защиты от перехватчиков паролей второго рода необходимо добиться выполнения в операционной системе следующих трех условий: Переключение раскладки клавиатуры в процессе ввода пароля невозможно. В противном случае задача создания перехватчика паролей второго рода существенно упрощается. Конфигурирование цепочки программных модулей, участвующих в получении операционной системой пароля пользователя, доступно только администраторам системы. Доступ на запись к файлам этих программных модулей предоставляется только администраторам системы. Для повышения устойчивости системы защиты к ошибкам администраторов можно сформулировать последнее условие следующим образом: Доступ на запись к файлам программных модулей, участвующих в получении пароля пользователя, не предоставляется никому. Доступ на запись к атрибутам защиты этих файлов предоставляется только администраторам. Любые обращения с целью записи к этим файлам, а также к их атрибутам защиты, регистрируются в системном журнале аудита. Если в системе выполняется третье условие во второй формулировке, администрирование операционной системы в части обслуживания клавиатуры (в частности, установка и изменение раскладок клавиатуры), несколько усложняется. Для того, чтобы перечисленные условия выполнялись, необходимо, чтобы подсистема защиты операционной системы поддерживала разграничение доступа и аудит. Для большинства современных операционных систем все условия, кроме первого, могут быть обеспечены организационными мерами. Первое условие в нерусскоязычных версиях операционных систем обычно выполняется автоматически. Для большинства русскоязычных версий операционных систем (в частности, для русской версии Windows NT 4.0) добиться выполнения этого условия невозможно - возможность создавать пользователей с русскими именами заложена в программное обеспечение операционных систем. Во всех англоязычных версиях Windows NT и всех известных автору версиях UNIX возможно создание и поддержание политики безопасности, при которой выполняются все три перечисленные условия. Если обеспечить выполнение первого условия в данной операционной системе невозможно, нужно добиться выполнения второго и третьего условий. Выполнение этих условий значительно повышает защищенность системы от перехватчиков паролей второго рода. Перехватчики паролей третьего рода. К перехватчикам паролей третьего рода относятся программные закладки, полностью или частично подменяющие собой подсистему аутентификации операционной системы. Поскольку задача создания такой программной закладки гораздо сложнее, чем задача создания перехватчика паролей первого или второго рода, этот класс программных закладок появился совсем недавно. Автору до сих пор неизвестно ни одной программной закладки данного класса. Существуют две демонстрационные версии перехватчиков паролей третьего рода (обе для Windows NT), одна из которых написана автором. Случаи применения злоумышленниками перехватчиков паролей третьего рода пока не встречались. Перехватчик паролей третьего рода может быть написан для любой многопользовательской операционной системы. Сложность создания такого перехватчика паролей зависит от сложности алгоритмов, реализуемых подсистемой аутентификации, сложности интерфейса между ее отдельными модулями, а также от степени документированности подсистемы аутентификации операционной системы. В целом задача создания перехватчика паролей третьего рода гораздо сложнее задачи создания перехватчика паролей первого или второго рода. Видимо, этим и объясняется небольшое количество программных закладок данного класса. Однако, в связи со все более широким распространением операционной системы Microsoft Windows NT, содержащей достаточно мощные встроенные средства защиты от перехватчиков паролей первого и второго рода, использование перехватчиков паролей третьего рода в целях осуществления несанкционированного доступа возможно в самом ближайшем будущем. Защита от перехватчиков паролей третьего рода. Поскольку перехватчики паролей третьего рода частично берут на себя функции подсистемы защиты операционной системы, перехватчик паролей третьего рода при внедрении в систему должен выполнить по крайней мере одно из следующих действий: подменить собой один или несколько системных файлов; внедриться в один или несколько системных файлов по одному из "вирусных" алгоритмов; использовать поддерживаемые операционной системой интерфейсные связи между программными модулями подсистемы защиты для встраивания себя в цепочку программных модулей, обрабатывающих введенный пользователем пароль; использовать для той же цели низкоуровневые интерфейсные связи операционной системы, используемые подсистемой защиты для решения своих задач. Каждое из этих действий оставляет в операционной системе следы, которые могут быть выявлены с помощью следующих мер защиты: Соблюдение адекватной политики безопасности. Подсистема аутентификации должна быть самым защищенным местом операционной системы. Меры, необходимые для поддержания адекватной политики безопасности, сильно различаются для разных операционных систем. При соблюдении адекватной политики безопасности внедрение в систему перехватчика паролей третьего рода, как и любой другой программной закладки, невозможно. Однако, поскольку администраторы, как и все люди, склонны допускать ошибки в своей работе, поддержание адекватной политики безопасности в течение длительного времени представляется практически невыполнимой задачей. Кроме того, соблюдение адекватной политики безопасности защищает только от проникновения программной закладки в систему. Как только перехватчик паролей внедрен в систему, меры по поддержанию политики безопасности становится бессмысленными - при наличии в системе программной закладки политика безопасности не может быть адекватной, чтобы ни думали по этому поводу администраторы системы. Поэтому необходимы дополнительные меры защиты. Контроль целостности исполняемых файлов операционной системы. Необходимо контролировать не только файлы, входящие в состав подсистемы защиты, но и библиотеки, содержащие низкоуровневые функции операционной системы. Контроль целостности интерфейсных связей внутри подсистемы защиты, а также интерфейсных связей, используемых подсистемой защиты для решения низкоуровневых задач. Построение абсолютно надежной защиты против перехватчиков паролей третьего рода представляется невозможным. Поскольку машинный код перехватчиков паролей третьего рода выполняется не в контексте пользователя, а в контексте операционной системы, перехватчик паролей третьего рода может принимать меры, затрудняющие его обнаружение администраторами системы, в частности: перехват системных вызовов, которые могут использоваться администраторами для выявления программной закладки в целях подмены возвращаемой информации; фильтрация регистрируемых сообщений аудита. Видимо, здесь имеет место "борьба щита и меча", когда для любой известной атаки может быть построена надежная защита от нее, и для любой известной защиты может быть реализована атака, позволяющая ее эффективно преодолевать. Заключение. Перехватчики паролей представляют собой вполне реальную угрозу безопасности операционных систем. Защита от этой угрозы реализуется комплексом мер и средств, включающем в себя как программно-аппаратные средства, так и административные меры защиты. Для того, чтобы надежная защита от перехватчиков паролей могла быть построена, необходимо, чтобы операционная система поддерживала определенные возможности, затрудняющие функционирование перехватчиков паролей (см. пп. 3,5). Поскольку эти возможности поддерживаются не всеми операционными системами, не в любой операционной системе возможно построение эффективной защиты от перехватчиков паролей. Единственной операционной системой из числа известных автору, в которой построение такой защиты возможно, является Microsoft Windows NT. Для организации надежной защиты от перехватчиков паролей в других операционных системах, включая MS-DOS, Windows 3.x, Windows 95 и все известные автору версии UNIX, потребуется значительная работа по созданию дополнительных средств защиты. Однако даже в Windows NT невозможно построение эффективной защиты от перехватчиков паролей без использования дополнительных программных средств. В частности, необходимо дополнительное программное обеспечение, реализующее контроль целостности системных файлов и интерфейсных связей подсистемы аутентификации. Для того, чтобы защита от перехватчиков паролей была эффективной, политика безопасности, принятая в системе, должна удовлетворять следующим требованиям: Конфигурирование цепочки программных модулей, участвующих в получении операционной системой пароля пользователя, доступно только администраторам системы. Доступ на запись к файлам этих программных модулей предоставляется только администраторам системы. Конфигурирование подсистемы аутентификации доступно только администраторам системы. Доступ на запись к системным файлам предоставляется только администраторам системы. При организации защиты от перехватчиков паролей следует иметь в виду, что ни неукоснительное соблюдение адекватной политики безопасности, ни выполнение требований к программному обеспечению операционной системы, ни реализация в системе контроля целостности по отдельности не дают гарантий надежности защиты. Все эти меры должны приниматься в комплексе. Любая защита от перехватчиков паролей может быть надежной только при условии неукоснительного соблюдения администраторами системы адекватной политики безопасности. Учитывая, что: администраторы, как и все люди, время от времени допускают ошибки в работе, для внедрения в систему перехватчика паролей достаточно всего одной ошибки администратора, перехватчик паролей после внедрения в систему получает возможность предпринимать активные меры по маскировке своего присутствия, построение абсолютно надежной защиты от перехватчиков паролей представляется практически невозможным. Здесь имеет место "борьба щита и меча", когда для любой известной атаки может быть построена надежная защита от нее, и для любой известной защиты может быть реализована атака, позволяющая ее эффективно преодолевать.
©Drkb::04039.
DelphiWorld 6.0.
Перехватчики (Intercepts).
| Перехватчики (Intercepts). |
13. Перехватчики (Intercepts).
Перехватчик – это более высокий уровень, чем обработчик ввода/вывода и используется для модификации или перехвата данных независимо от источника и приемника.
Перехватчики были сильно изменены в версии 9.0. В версии 8.0 перехватчик мог предоставлять только весьма ограниченную функциональность обработчика ввода/вывода. Перехватчики могут трансформировать уже принятые данные или данные для передачи. Перехватчики более не поддерживают никакой функциональности обработчика ввода/вывода (IOHandler), поскольку введены новые классы IOHandler, со всей необходимой функциональностью.
Перехватчики попрежнему могут выполнять преобразования данных и но предоставляют больше возможностей в Indy 9.0. Возможности трансформация в Indy 8.0 были сильно ограничены, так как данные должны были иметь один и тот же размер. Это делало невозможным использовать их для реализации сжатия данных или логирования, поскольку не позволяло изменить размер данных.
Перехватчики позволяют изменять данные после того, как они были приняты в IOHandler или изменять их перед посылкой в IOHandler. Перехватчики в данный момент используются для реализации ведения логов и отладки компонент. Они могут быть также использованы для реализации шифрования, сжатия, статических коллекторов или ограничитения трафика.
13.1. Перехватчики.
Перехватчики взаимодействуют с входящими или исходящими данными и позволяют их записывать в лог или модифицировать. Перехватчики позволяют изменять входящие данные, после того как они приняты из сети, перед выдачей их пользователю.
Перехватчики также позволяют модифицировать исходящие данные перед посылкой в сеть. Перехватчики могут быть использоваться для реализации ведения логов, шифрования и сжатия данных.
Клиентские перехватчики базируются на соединениях (по одному на каждое). Они также могут быть использованы на сервере, если они назначены индивидуальному соединению.
Примечание: Перехватчики в Indy 9 отличаются от перехватчиков в Indy 8. Перехватчики в Indy 8, выполняли комбинированную роль перехватчика и обработчика ввода/вывода. Что делало сложным разделение функций перехвата и обработки. Перехватчики Indy 8 также не могли изменять размер данных и поэтому были непригодны для сжатия.
13.2. Ведение логов (Logging).
Indy 8.0 имел один компонент ведения логов, который мог быть использован для различных источников. В Indy 9.0 компоненты логов теперь базируются на новом общем классе и имеют специализированные классы. Базовый класс также предоставляет свойства и функциональность, такую как регистрация времени, в дополнение к данным.
Все классы ведения логов реализованы, как перехватчики. Это означает, что они перехватывают входящие данные, после того, как они были прочитаны и перед передачей исходящих в источник.
Специализированные классы логов, следующее:
· TIdLogEvent – возбуждает события, когда данные приняты, или переданы, или при появлении события состояния. Класс TIdLogEvent полезен для реализации пользовательских логов, без необходимости в реализации нового класса.
· TIdLogFile – Записывает данные в файл.
· TIdLogDebug – Записывает данные в окно отладки Windows или в консоль Linux. Также отмечает данные, как принятые данные, переданные данные или информация о статусе. Класс TidLogDebug полезен для проведения простой отладки.
· TIdLogStream – Не добавляет комментариев, отметок к данным, как другие классы. Вместо этого просто записывает сырые данные в указанный поток. Класс TIdLogStream может использоваться по разному, но обычно он очень эффективно используется для QA тестирования и удаленной отладки. Могут быть построены и пользовательские классы логов.
| Перехватить нажатие клавиши на клавиатуре |
Для того, чтобы перехватить нажатие какой-то клавиши на клавиатуре можно использовать зарегистрированную "горячую клавишу" (HotKey). Эта программа пикает при нажатии "1".
Перехватывать печать на принтере.
| Перехватывать печать на принтере |
Code: Unit Unit1; {©Drkb v.3(2007): www.drkb.ru}. Interface. Uses. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, WinSpool; Type. TForm1 = class(TForm). BtnStart: TButton; CbPrinters: TComboBox; Procedure btnStartClick(Sender: TObject); Procedure FormCreate(Sender: TObject); End; Var. Form1: TForm1; Implementation. {$R *.dfm}. Procedure TForm1.FormCreate(Sender: TObject); Var. PrintersInfo: array of TPrinterInfo5; I, Needed, Returned: DWORD; Begin. EnumPrinters(PRINTER_ENUM_LOCAL, nil, 5, nil, 0, Needed, Returned); SetLength(PrintersInfo, Needed div SizeOf(TPrinterInfo5)); If EnumPrinters(PRINTER_ENUM_LOCAL, nil, 5, PrintersInfo, Needed, Needed, Returned) then. If Returned > 0 then. Begin. For I := 0 to Returned - 1 do. CbPrinters.Items.Add(PrintersInfo[I].pPrinterName); BtnStart.Enabled := True; CbPrinters.ItemIndex := 1; End; End; Procedure TForm1.btnStartClick(Sender: TObject); Var. HPrinter, hChanges: THandle; NotifyOption: TPrinterNotifyOptions; NotifyTipes: TPrinterNotifyOptionsType; Field: TPrinterNotifyInfoData; Begin. If OpenPrinter(PChar(cbPrinters.Items.Strings[cbPrinters.ItemIndex]), HPrinter, nil) then. Try. NotifyTipes.wType := JOB_NOTIFY_TYPE; NotifyTipes.Reserved0 := 0; NotifyTipes.Reserved1 := 0; NotifyTipes.Reserved2 := 0; NotifyTipes.Count := 1; NotifyTipes.pFields := @Field; NotifyOption.Version := 2; NotifyOption.Flags := PRINTER_CHANGE_ALL; NotifyOption.Count := 1; NotifyOption.pTypes := @NotifyTipes; HChanges := FindFirstPrinterChangeNotification(hPrinter, PRINTER_CHANGE_ALL, 0, @NotifyOption); If hChanges = INVALID_HANDLE_VALUE then. RaiseLastOSError. Else. Try. Case WaitForSingleObject(hChanges, INFINITE) of. WAIT_OBJECT_0: ShowMessage('Есть изменения'); WAIT_FAILED: RaiseLastOSError; End; Finally. FindClosePrinterChangeNotification(hChanges); End; Finally. ClosePrinter(hPrinter); End; End; End.
©Drkb::03255.
Взято из http://forum.sources.ru.
Автор: Rouse_
| Перехват изменения размера колонки в TListView. |
Code: { Question: How do I capture a column resize event in TListView, the OnResize. Only works when the ListView is changed? Answer: The event can be added with a bit of work. See the custom TListview derivative. Below. It has 3 new events: OnColumnResize, OnBeginColumnResize, OnEndColumnResize. } Unit PBExListview; Interface. Uses. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls; Type. TLVColumnResizeEvent = procedure(Sender: TCustomListview; Columnindex: Integer; Columnwidth: Integer) of object; TPBExListview = class(TListview). Private. FBeginColumnResizeEvent: TLVColumnResizeEvent; FEndColumnResizeEvent: TLVColumnResizeEvent; FColumnResizeEvent: TLVColumnResizeEvent; Protected. Procedure DoBeginColumnResize(columnindex, columnwidth: Integer); Virtual; Procedure DoEndColumnResize(columnindex, columnwidth: Integer); Virtual; Procedure DoColumnResize(columnindex, columnwidth: Integer); Virtual; Procedure WMNotify(var Msg: TWMNotify); message WM_NOTIFY; Function FindColumnIndex(pHeader: pNMHdr): Integer; Function FindColumnWidth(pHeader: pNMHdr): Integer; Procedure CreateWnd; override; Published. Property OnBeginColumnResize: TLVColumnResizeEvent. Read FBeginColumnResizeEvent write FBeginColumnResizeEvent; Property OnEndColumnResize: TLVColumnResizeEvent. Read FEndColumnResizeEvent write FEndColumnResizeEvent; Property OnColumnResize: TLVColumnResizeEvent. Read FColumnResizeEvent write FColumnResizeEvent; End; Procedure Register; Implementation. Uses CommCtrl; Procedure Register; Begin. RegisterComponents('PBGoodies', [TPBExListview]); End; Procedure TPBExListview.DoBeginColumnResize(columnindex, columnwidth: Integer); Begin. If Assigned(FBeginColumnResizeEvent) then. FBeginColumnResizeEvent(Self, columnindex, columnwidth); End; Procedure TPBExListview.DoEndColumnResize(columnindex, columnwidth: Integer); Begin. If Assigned(FEndColumnResizeEvent) then. FEndColumnResizeEvent(Self, columnindex, columnwidth); End; Procedure TPBExListview.DoColumnResize(columnindex, columnwidth: Integer); Begin. If Assigned(FColumnResizeEvent) then. FColumnResizeEvent(Self, columnindex, columnwidth); End; Function TPBExListview.FindColumnIndex(pHeader: pNMHdr): Integer; Var. HwndHeader: HWND; Iteminfo: THdItem; ItemIndex: Integer; Buf: array [0..128] of Char; Begin. Result := -1; HwndHeader := pHeader^.hwndFrom; ItemIndex := pHDNotify(pHeader)^.Item; FillChar(iteminfo, SizeOf(iteminfo), 0); Iteminfo.Mask := HDI_TEXT; Iteminfo.pszText := buf; Iteminfo.cchTextMax := SizeOf(buf) - 1; Header_GetItem(hwndHeader, ItemIndex, iteminfo); If CompareStr(Columns[ItemIndex].Caption, iteminfo.pszText) = 0 then. Result := ItemIndex. Else. Begin. For ItemIndex := 0 to Columns.Count - 1 do. If CompareStr(Columns[ItemIndex].Caption, iteminfo.pszText) = 0 then. Begin. Result := ItemIndex; Break; End; End; End; Procedure TPBExListview.WMNotify(var Msg: TWMNotify); Begin. Inherited; Case Msg.NMHdr^.code of. HDN_ENDTRACK: DoEndColumnResize(FindColumnIndex(Msg.NMHdr), FindColumnWidth(Msg.NMHdr)); HDN_BEGINTRACK: DoBeginColumnResize(FindColumnIndex(Msg.NMHdr), FindColumnWidth(Msg.NMHdr)); HDN_TRACK: DoColumnResize(FindColumnIndex(Msg.NMHdr), FindColumnWidth(Msg.NMHdr)); End; End; Procedure TPBExListview.CreateWnd; Var. Wnd: HWND; Begin. Inherited; Wnd := GetWindow(Handle, GW_CHILD); SetWindowLong(wnd, GWL_STYLE, GetWindowLong(wnd, GWL_STYLE) and not HDS_FULLDRAG); End; Function TPBExListview.FindColumnWidth(pHeader: pNMHdr): Integer; Begin. Result := -1; If Assigned(PHDNotify(pHeader)^.pItem) and. ((PHDNotify(pHeader)^.pItem^.mask and HDI_WIDTH) <> 0) then. Result := PHDNotify(pHeader)^.pItem^.cxy; End; End.
| Перехват (Hook) клавиатуры (программа Sendkeys). |
Автор: Bogachev.
| Перехват множественного рекордсета |
Со стороны сервера - невозможно, только клиентом (ADO/MDAC имеют метод NextRecordset).
| Перетаскиваем колонки и строки в StringGrid мышью |
Code: { The user can move rows and columns of a StringGrid with the mouse. Can it also be done by code? In the help for TCustomGrid you can see the methods MoveColumn and MoveRow, But they are hidden in TStringGrid. We can make them accessible again by subclassing TStringGrid and. Declaring these methods as public: } Type. TStringGridHack = class(TStringGrid). Public. Procedure MoveColumn(FromIndex, ToIndex: Longint); Procedure MoveRow(FromIndex, ToIndex: Longint); End; { The implementation of these methods simply consists of invoking the. Corresponding method of the ancestor: } Procedure TStringGridHack.MoveColumn(FromIndex, ToIndex: Integer); Begin. Inherited; End; Procedure TStringGridHack.MoveRow(FromIndex, ToIndex: Integer); Begin. Inherited; End; // Example, Beispiel: Procedure TForm1.Button1Click(Sender: TObject); Begin. TStringGridHack(StringGrid1).MoveColumn(1, 3); End;
| Перетаскивание объектов |
Автор: Павел
| Перетасовка строк в списке |
Code: { **** UBPFD *********** by kladovka.net.ru **** >> Перетасовка строк в списке. Процедура тасует строки в списке. List - Список строк. MoveCount - необязательный параметр, задающий количество перестановок, Если этот параметр опущен, либо меньше или равен нулю, его значение. Принимается равным C*C-C, где C - количество строк в списке. Зависимости: SysUtils, Classes. Автор: Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург. Copyright: Dimka Maslov. Дата: 18 ноября 2002 г. ********************************************** } Procedure ShuffleStrings(List: TStrings; MoveCount: Integer = 0); Var. I, N, C: Integer; Index1, Index2: Integer; Str: string; Obj: TObject; Begin. List.BeginUpdate; Try. C:=List.Count; N:=MoveCount; If N <= 0 then N:=C*C-C; For i:=0 to N do begin. Index1:=Random(C); Index2:=Random(C); Str:=List.Strings[Index1]; Obj:=List.Objects[Index1]; List.Strings[Index1]:=List.Strings[Index2]; List.Objects[Index1]:=List.Objects[Index2]; List.Strings[Index2]:=Str; List.Objects[Index2]:=Obj; End; Finally. List.EndUpdate; End; End;
| Перетасовка экрана |
В статье описывается пример, который позволяет разделить экран на блоки, а затем поменять эти блоки местами. Так же можно менять размеры блоков и скорость их перемещения. На мой взгляд неплохое начало для создания логической игрушки либо экранной заставки.
| Переход в ждущий режим под WinNT. |
Code: { **** UBPFD *********** by delphibase.endimus.com **** >> Переход в ждущий режим под WinNT. Зависимости: Windows. Автор: DeMoN-777, DeMoN-777@yandex.ru, Санкт-Петербург. Copyright: @ Дата: 21 июня 2002 г. ***************************************************** } Procedure NTWait; Var. HToken: THandle; Tkp: TTokenPrivileges; ReturnLength: Cardinal; Begin. If OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or. TOKEN_QUERY, hToken) then. Begin. LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid); Tkp.PrivilegeCount := 1; Tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; If AdjustTokenPrivileges(hToken, False, tkp, 0, nil, ReturnLength) then. SetSystemPowerState(true, true); End; End;
Переход от Delphi 7 к Developer Studio 2006 - сравнивая компоненты.
| Переход от Delphi 7 к Developer Studio 2006 - сравнивая компоненты |
Переход от Delphi 7 к Developer Studio 2006 - сравнивая компоненты
© 2005 Сергей Досюков, Dragon Soft.
Каждая версия продукта представляет новые возможности, в то же время что то может быть удалено как устаревшее или не используемое и Borland Delphi или C++Builder не являются исключением.
Когда вы разрабатываете программный продукт разрабатывался на протяжении нескольких лет всегда возникает вопрос при переходе на новую версию среды разработки - "а все ли компоненты доступны, что появилось нового и возможен ли переход вообще?".
10/10/2005 Borland представил новую версию Borland Delphi - Borland Developer Studio 2006. Отличительной особенностью стала интеграция C++ как новаю персоналити в IDE. На данный момент это только предварительный вариант кода.
В течении последних лет я старался отслеживать прогресс и изменения в списке компонентов доступных в Delphi и теперь настало время включить C++Builder.
Примечание: Когда "*" присутствует в какой либо колонке это значит что поле "Примечание" содержит дополнительную информацию.
Название компоненты
D7 VCL32.
CB6 W32.
D2005 VCL32.
D2005 VCL.Net.
D2005 WForms.
D2006 VCL32.
D2006 VCL.Net.
D2006 WForms.
C++ 2006 предв.
VS.Net.
VS.Net 2005.
Примечания
STANDARD.
TActionList.
TButton.
TCheckBox.
TComboBox.
TEdit.
*
*
*
*
В WinForms.Net доступно как TextBox.Multiline = False.
TFrames.
TGroupBox.
TLabel.
TLinkLabel.
*
*
Www.dragonsoftru.com?go=vcl.
TListBox.
TMainMenu.
*
MenuStrip.
TMemo.
*
*
*
*
В WinForms.Net доступно как TextBox.Multiline = True.
TPanel.
TPopupMenu.
*
в VS2005 - ContextMenuStrip.
TPropertyGrid.
TRadioButton.
TRadioGroup.
TScrollBar.
Название компоненты
D7 VCL32.
CB6 W32.
D2005 VCL32.
D2005 VCL.Net.
D2005 WForms.
D2006 VCL32.
D2006 VCL.Net.
D2006 WForms.
C++ 2006 предв.
VS.Net.
VS.Net 2005.
Примечания
ADDITIONAL.
TActionManager.
TActionMainMenuBar.
TActionToolBar.
TApplicationEvents.
TBevel.
TBitBtn.
TButtonGroup.
TCategoryButtons.
TChart.
*
*
*
*
*
*
*
?
Www.teechart.com.
TCheckListBox.
TColorBox.
TColorListBox.
TControlBar.
TCustomizeDlg.
TDockTabSet.
TDrawGrid.
TFlowPanel.
*
FlowLayoutPanel.
TGridPanel.
*
*
TableLayoutPanel.
TImage.
*
PictureBox.
TLabeledEdit.
TMaskEdit.
*
MaskedTextBox.
TPopupActionBar.
TScrollBox.
TShape.
TSpeedButton.
TSplitter.
TStandardColorMap.
TStaticText.
TStringGrid.
TTabSet.
TTwilightColorMap.
TValueListEditor.
TXPColorMap.
Название компоненты
D7 VCL32.
CB6 W32.
D2005 VCL32.
D2005 VCL.Net.
D2005 WForms.
D2006 VCL32.
D2006 VCL.Net.
D2006 WForms.
C++ 2006 preview.
VS.Net.
VS.Net 2005.
Примечания
SPECIAL IN VS 2005.
BackgroundWorker.
NumericUpDown.
SerialPort.
ServiceController.
ToolStripContainer.
Название компоненты
D7 VCL32.
CB6 W32.
D2005 VCL32.
D2005 VCL.Net.
D2005 WForms.
D2006 VCL32.
D2006 VCL.Net.
D2006 WForms.
C++ 2006 предв.
VS.Net.
VS.Net 2005.
Примечания
WIN 32.
TAnimate.
TComboBoxEx.
TCoolBar.
TDateTimePicker.
TDomainUpDown.
THeaderControl.
THotKey.
TImageList.
TListView.
TMonthCalendar.
TPageControl.
TPageScroller.
TProgressBar.
TRichEdit.
*
RichTextBox.
TStatusBar.
*
StatusStrip.
TTabControl.
TTrackBar.
TTrayIcon.
TToolBar.
TTreeView.
TUpDown.
TXPManifest.
HelpProvider.
ErrorProvider.
*
*
*
Www.dragonsoftru.com?go=vcl.
NotifyIcon.
ToolTip.
Название компоненты
D7 VCL32.
CB6 W32.
D2005 VCL32.
D2005 VCL.Net.
D2005 WForms.
D2006 VCL32.
D2006 VCL.Net.
D2006 WForms.
C++ 2006 предв.
VS.Net.
VS.Net 2005.
Примечания
SYSTEM.
TPaintBox.
TTimer.
TMediaPlayer.
TOleContainer.
TCOMAdminCatalog.
TDDEClientConv.
TDDEClientItem.
TDDEServerConv.
TDDEServerItem.
FileSystemWatcher.
EventLog.
Www.dragonsoftru.com?go=vcl.
MessageQueue.
PerformanceCounter.
Process.
Название компоненты
D7 VCL32.
CB6 W32.
D2005 VCL32.
D2005 VCL.Net.
D2005 WForms.
D2006 VCL32.
D2006 VCL.Net.
D2006 WForms.
C++ 2006 preview.
VS.Net.
VS.Net 2005.
Примечания
WIN 3.1.
TDBLookupList.
TDBLookupCombo.
TDirectoryListBox.
TDirectorySearcher.
TDriveComboBox.
TFileListBox.
TFilterComboBox.
THeader.
TOutline.
TNotebook.
TTabbedNotebook.
TTabSet.
Название компоненты
D7 VCL32.
CB6 W32.
D2005 VCL32.
D2005 VCL.Net.
D2005 WForms.
D2006 VCL32.
D2006 VCL.Net.
D2006 WForms.
C++ 2006 предв.
VS.Net.
VS.Net 2005.
Примечания
DATA ACCESS.
TClientDataSet.
TDataSetProvider.
TDataSource.
TXMLTransform.
TXMLTransformClient.
TXMLTransformProvider.
TBindingSource.
TDataSet.
TListConnector.
Название компоненты
D7 VCL32.
CB6 W32.
D2005 VCL32.
D2005 VCL.Net.
D2005 WForms.
D2006 VCL32.
D2006 VCL.Net.
D2006 WForms.
C++ 2006 preview.
VS.Net.
VS.Net 2005.
Примечания
DATA CONTROLS.
TDBChart.
*
*
*
*
*
*
?
Www.teechart.com.
TDBCheckBox.
TDBComboBox.
TDBCtrlGrid.
TDBEdit.
TDBGrid.
В VS2005 DataGridView.
TDBImage.
TDBListBox.
TDBLookupComboBox.
TDBLookupListBox.
TDBMemo.
TDBNavigator.
*
BindingNavigator.
TDBRadioGroup.
TDBRichEdit.
TDBText.
Название компоненты
D7 VCL32.
CB6 W32.
D2005 VCL32.
D2005 VCL.Net.
D2005 WForms.
D2006 VCL32.
D2006 VCL.Net.
D2006 WForms.
C++ 2006 preview.
VS.Net.
VS.Net 2005.
Примечания
DATASNAP.
TDCOMConnection.
TSocketConnection.
TSimpleObjectBroker.
TWEBConnection.
TConnectionBroker.
TSharedConnection.
TLocalConnection.
Название компоненты
D7 VCL32.
CB6 W32.
D2005 VCL32.
D2005 VCL.Net.
D2005 WForms.
D2006 VCL32.
D2006 VCL.Net.
D2006 WForms.
C++ 2006 preview.
VS.Net.
VS.Net 2005.
Примечания
ADO.
TADOConnection.
TADOCommand.
TADODataSet.
TADOTable.
В VS как часть DataSet.
TADOQuery.
TADOStoredProc.
TRDSConnection.
Название компоненты
D7 VCL32.
CB6 W32.
D2005 VCL32.
D2005 VCL.Net.
D2005 WForms.
D2006 VCL32.
D2006 VCL.Net.
D2006 WForms.
C++ 2006 preview.
VS.Net.
VS.Net 2005.
Примечания
BDE.
TTable.
TQuery.
TStoredProc.
TDatabase.
TSession.
TBatchMove.
TUpdateSQL.
TNestedTable.
TBDEClientDataSet.
Название компоненты
D7 VCL32.
CB6 W32.
D2005 VCL32.
D2005 VCL.Net.
D2005 WForms.
D2006 VCL32.
D2006 VCL.Net.
D2006 WForms.
C++ 2006 preview.
VS.Net.
VS.Net 2005.
Примечания
INTERBASE.
TIBTable.
TIBQuery.
TIBStoredProc.
TIBDatabase.
TIBTransaction.
TIBUpdateSQL.
TIBDataset.
TIBSQL.
TIBDatabaseInfo.
TIBSQLMonitor.
TIBEvents.
TIBExtract.
TIBClientDataset.
TIBConnectionBroker.
TIBScript.
TIBSQLParser.
TIBDatabaseINI.
TIBFilterDialog.
Название компоненты
D7 VCL32.
CB6 W32.
D2005 VCL32.
D2005 VCL.Net.
D2005 WForms.
D2006 VCL32.
D2006 VCL.Net.
D2006 WForms.
C++ 2006 preview.
VS.Net.
VS.Net 2005.
Примечания
INTERBASE ADMIN.
TIBConfigService.
TIBBackupService.
TIBRestoreService.
TIBValidationService.
TIBStatisticalService.
TIBLogService.
TIBSecurityService.
TIBServerProperties.
TIBLicensingService.
TIBInstall.
TIBUnInstall.
Название компоненты
D7 VCL32.
CB6 W32.
D2005 VCL32.
D2005 VCL.Net.
D2005 WForms.
D2006 VCL32.
D2006 VCL.Net.
D2006 WForms.
C++ 2006 preview.
VS.Net.
VS.Net 2005.
Примечания
DBEXPRESS.
TSQLConnection.
TSQLDataset.
TSQLQuery.
TSQLStoredProc.
TSQLTable.
TSQLMonitor.
TSimpleDataset.
TSQLClientDataSet.
Название компоненты
D7 VCL32.
CB6 W32.
D2005 VCL32.
D2005 VCL.Net.
D2005 WForms.
D2006 VCL32.
D2006 VCL.Net.
D2006 WForms.
C++ 2006 preview.
VS.Net.
VS.Net 2005.
Примечания
WEBSERVICES.
THTTPRIO.
THTTPReqResp.
TOPToSoapDomConvert.
TSOAPConnection.
THTTPSoapDispatcher.
TWSDLHTMLPublish.
THTTPSoapPascalInvoker.
THTTPSoapCppInvoker.
INTERNETEXPRESS.
TXMLBroker.
TInetXPageProducer.
Название компоненты
D7 VCL32.
CB6 W32.
D2005 VCL32.
D2005 VCL.Net.
D2005 WForms.
D2006 VCL32.
D2006 VCL.Net.
D2006 WForms.
C++ 2006 предв.
VS.Net.
VS.Net 2005.
Примечания
INTERNET.
TWebDispatcher.
TPageProducer.
TDatasetTableProducer.
TDatasetPageProducer.
TQueryTableProducer.
TSQLQueryTableProducer.
TTCPClient.
TTCPServer.
TUDPSocket.
TXMLDocument.
TWebBrowser.
*
TCppWebBrowser.
TServerSocket.
*
*
Устарело (см. dclsocketsNN.bpl: ScktComp.pas для доп. инфо). Используйте INDY или др.
TClientSocket.
*
*
Устарело (см. dclsocketsNN.bpl: ScktComp.pas для доп. инфо). Используйте INDY или др.
Название компоненты
D7 VCL32.
CB6 W32.
D2005 VCL32.
D2005 VCL.Net.
D2005 WForms.
D2006 VCL32.
D2006 VCL.Net.
D2006 WForms.
C++ 2006 предв.
VS.Net.
VS.Net 2005.
Примечания
WEBSNAP.
TAdapter.
TPageAdapter.
TDataSetAdapter.
TLoginFormAdapter.
TStringValuesList.
TDataSetValuesList.
TWEBAppНазвание компонентыs.
TApplicationAdapter.
TEndUserAdapter.
TEndUserSessionAdapter.
TPageDispatcher.
TAdapterDispatcher.
TLocateFileService.
TSessionsService.
TWebUserList.
TXSLPageProducer.
TAdapterPageProducer.
Название компоненты
D7 VCL32.
CB6 W32.
D2005 VCL32.
D2005 VCL.Net.
D2005 WForms.
D2006 VCL32.
D2006 VCL.Net.
D2006 WForms.
C++ 2006 предв.
VS.Net.
VS.Net 2005.
Примечания
DIALOGS.
TColorDialog.
TFolderBrowserDialog.
Delphi: как функция
TFindDialog.
TFontDialog.
TOpenDialog.
TOpenPictureDialog.
TOpenTextFileDialog.
TPageSetupDialog.
TPrintDialog.
TPrinterSetupDialog.
TReplaceDialog.
TSaveDialog.
TSavePictureDialog.
TSaveTextFileDialog.
PrintPreviewControl.
PrintPreviewDialog.
PrintDocument.
ReportDocument.
CrystalReportViewer.
Название компоненты
D7 VCL32.
CB6 W32.
D2005 VCL32.
D2005 VCL.Net.
D2005 WForms.
D2006 VCL32.
D2006 VCL.Net.
D2006 WForms.
C++ 2006 preview.
VS.Net.
VS.Net 2005.
Примечания
ECO/BOLD.
...
ECO заменило BOLD в D2005
Bold для Win32/VCL и ECO для .Net/.Net+Winforms.
DECISION CUBE.
...
SAMPLES.
...
ColorGrid.
Gauge.
*
TCGaude.
CollapsePanel.
FASTNET.
...
ACTIVEX.
...
RAVE REPORTS.
...
INDY.
...
*
*
*
Www.indyproject.org.
COM+
...
IntraWeb.
...
*
SERVERS.
...
Copyright© 2005 Сергей Досюков, Dragon Soft.
©Drkb::00063.
Содержание.
- ENoResultSet Error creating cursor handle.
- Курсоры: доступ к отдельным строкам.
- Error: Interface not supported.
- Error permission denied when trying to run Kylix.
- Error -10 when trying to install Kylix.
- Extreme Programming и руководство пользователя.
- Страницы Excel — компонент F1Book.
- FAQ по почтовым протоколам.
- Fast Report для CLX.
- Краткое описание Foxpro.
- FreeUserPhysicalPages.
- HeaderControl с дополнительной возможностью отображения стрелок.
- Hello ISAPI.
- Hex --> Char.
- Hex --> Integer.
- Hidden or missing IDE.
- Hint на системных кнопках, Как енто делается?
- How to check, if a CD-Recorder is available? (WinXP).
- How to check if the Workstation is locked?
- How to debug an Apache Shared Module.
- How to run executables created in Kylix.
- How to turn off ISAPI DLL caching on Windows 2000 and IIS5.
- How to close a database.
- How to close a presentation.
- How to open a presentation.
- How to open a report.
- How to start a new presentation.
- HyperText Transfer Protocol - протокол обмена WWW-серверов.
- Перевести коды ошибок WinSock'a в текстовый вид.
- Передача текста любому окну, где стоит фокус.
- Перевод чисел из десятичной, в любую другую систему счисления.
- Перебор вариантов.
- Права доступа NTFS.
- Нажатия клавиши и звук.
- Правильные диалоги от Борланда.
- Надпись на часах в трее.
- Перечисление служб.
- Представление "TINY".
- Набор инструментов для оперирования с дисками на физическом уровне.
- Пересмотр лексического анализа.
- Перехватчики паролей.
- Перехватчики (Intercepts).
- Перехватывать печать на принтере.
- Переход от Delphi 7 к Developer Studio 2006 - сравнивая компоненты.