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

З.Ы. Скрипт нужно разместить в отдельном файле, например thumb.php

PHP - Код

//Ф-ия возвращает уменьшенную копию изображения. 
//И вызывается в фомате
//thumb.php?id=путь_к_рисунку, так же можно задать размеры,
// или только высоту, тогда
//картинка уменьшится сохранив пропорции. Скрипт понимает 
//такие форматы изображения как GIF,JPEG,PNG
//а возвращает в формате JPEG.Из HTML вызывать ф-ию нужно
// так <img src=thumb.php?id=путь_к_рисунку>
// список параметров thumb(путь_к_рисунку, ширина,высота)
function thumb($path,$x,$y=0)
{
$t=getimagesize ($path) or die('Unknown type of image');
$with=$t[0];
$height=$t[1];
switch ($t[2])
{
case 1:
$type='GIF';
$img=imagecreatefromgif($path);
break;
case 2:
$type='JPEG';
$img=imagecreatefromjpeg($path);
break;
case 3:
$type='PNG';
$img=imagecreatefrompng($path);
break;
}
if($y==0)
{$y=$x*($height/$with);}

header("Content-type: image/".$type);
$thumb=imagecreate($x,$y);
imagecopyresized($thumb,$img,0,0,0,0,$x,$y,$with,$height);
$thumb=imagejpeg($thumb);
return $thumb;
}
if($id)
{
echo thumb($id,200);
}

Часто программисту приходится сталкиваться с задачей написания приложения, работающего в фоновом режиме и не нуждающегося в месте на Панели задач. Если вы посмотрите на правый нижний угол рабочего стола windows, то наверняка найдете там приложения, для которых эта проблема решена: часы, переключатель раскладок клавиатуры, регулятор громкости и т. п. Ясно, что, как бы вы не увеличивали и не уменьшали формы своего приложения, попасть туда обычным путем не удастся. Способ для этого предоставляет shell api.

Те картинки, которые находятся на system tray — это действительно просто картинки, а не свернутые окна. Они управляются и располагаются панелью system tray. Она же берет на себя еще две функции: показ подсказки для каждого из значков и оповещение приложения, создавшего значок, обо всех перемещениях мыши над ним.

Весь api system tray состоит из 1 (одной) функции:

Код:

Код

function shell_notifyicon(dwmessage: dword;
ipdata: pnotifylcondata): bool; pnotifylcondata = tnotifylcondata; tnotifylcondata = record
cbsize: dword;
wnd: hwnd;
uid: uint;
uflags: uint;
ucallbackmessage: uint;
hlcon: hicon;
sztip: array [0..63] of ansichar;
end;

Параметр dwmessage определяет одну из операций: nim_add означает добавление значка в область, nim_delete — удаление, nim_modify — изменение.

Ход операции зависит от того, какие поля структуры tnotifyicondata будут заполнены.

Обязательным для заполнения является поле cbsize — там содержится размер структуры. Поле wnd должно содержать дескриптор окна, которое будет оповещаться о событиях, связанных со значком.

Идентификатор сообщения windows, которое вы хотите получать от системы о перемещениях мыши над значком, запишите в поле ucallbackmessage. Если вы хотите, чтобы при этих перемещениях над вашим значком показывалась подсказка, то задайте ее текст в поле sztip. В поле uid задается номер значка — каждое приложение может поместить на system tray сколько угодно значков. Дальнейшие операции вы будете производить, задавая этот номер. Дескриптор помещаемого значка должен быть задан в поле hicon. Здесь вы можете задать значок, связанный с вашим приложением, или загрузить свой — из ресурсов.

Примечание
Изменить главный значок приложения можно в диалоговом окне project/ options на странице application. Он будет доступен через свойство application.icon. Тут же можно отредактировать и строку для подсказки — свойство application.title.

Наконец, в поле uflags вы должны сообщить системе, что именно вы от нее хотите, или, другими словами, какие из полей hicon, ucallbackmessage и sztip вы на самом деле заполнили. В этом поле предусмотрена комбинация трех флагов: nif_icon, nif_message и nif_tip. Вы можете заполнить, скажем, поле sztip, но если вы при этом не установили флаг nif_tip, созданный вами значок не будет иметь строки с подсказкой.

Два приведенных ниже метода иллюстрируют сказанное. Первый из них создает значок на system tray, а второй — уничтожает его.

Код:

Код

const wm_mytraynotify = wmjjser + 123;
procedure tforml.createtraylcon(n:integer);
var nidata : tnotifyicondata;
begin
with nidata do
begin
cbsize := sizeof{tnotifyicondata) ;
wnd := self.handle;
uid := n;
ufiags := nif_icon or nif_message or nifjtip;
ucallbackmessage := wm_mytraynotify;
hicon := application.icon.handle;
sztip := 'this is traylcon example';
end;
shell_notifyicon(nim_add, @nidata);
end;
procedure tforml.deletetraylcon(n:integer);
var nidata : tnotifylcondata; begin
with nidata do
begin
cbsize := sizeof(tnotifylcondata);
wnd := self.handle; uid := n; end;
shell_notifyicon(nim_delete, @nidata);
end;

Примечание
he забывайте уничтожать созданные вами значки на system tray. Это не делается автоматически даже при закрытии приложения. Значок будет удален только после перезагрузки системы.

Сообщение, задаваемое в поле ucallbackmessage, по сути дела является единственной ниточкой, связывающей вас со значком после его создания. Оно объединяет в себе несколько сообщений. Когда к вам пришло такое сообщение (в примере, рассмотренном выше, оно имеет идентификатор wm_mytraynotify), поля в переданной в обработчик структуре типа tmessage распределены так. Параметр wparam содержит номер значка (тот самый, что задавался в поле uid при его создании), а параметр lparam — идентификатор сообщения от мыши, вроде wm_mousemove, wm_lbuttondown и т. п. К сожалению, остальная информация из этих сообщений теряется.

Координаты мыши в момент события придется узнать, вызвав функцию api getcursorpos:

Код:

Код

procedure tforml.wmicon(var msg: tmessage);
var p : tpoint; begin case msg.lparam of
wm_lbuttondown:
begin
getcursorpos(p);
setforegroundwindow(application.mainform.handle); popupmenul.popup(p.x, p.y);
end;
wm_lbuttonup :
end;
end;

Обратите внимание, что при показе всплывающего меню недостаточно просто вызвать метод popup. При этом нужно вынести главную форму приложения на передний план, в противном случае она не получит сообщений от меню.

Теперь решим еще две задачи. Во-первых, как сделать, чтобы приложение минимизировалось не на Панель задач (taskbar), а на system tray? И более того — как сразу запустить его в минимизированном виде, а показывать главную форму только по наступлении определенного события (приходу почты, наступлению определенного времени и т. п.).

Ответ на первый вопрос очевиден. Если минимизировать не только окно главной формы приложения (application.mainform.handle), но и окно приложения (application.handle), то приложение полностью исчезнет "с экранов радаров". В этот самый момент нужно создать значок на панели system tray. В его всплывающем меню должен быть пункт, при выборе которого оба окна восстанавливаются, а значок удаляется.

Чтобы приложение запустилось сразу в минимизированном виде и без главной формы, следует к вышесказанному добавить установку свойства application.showmainform в значение false. Здесь возникает одна сложность — если главная форма создавалась в невидимом состоянии, ее компоненты будут также созданы невидимыми. Поэтому при первом ее показе установим их свойство visible в значение true. Чтобы не повторять это дважды, установим флаг — глобальную переменную shownonce:

Код:

Код

procedure tforml.hidemainform;
begin
appiication.showmainform := false;
showwindow(application.handle, sw_hide);
showwindow(application.mainform.handle, sw_hide);
end;

procedure tforml.restoremainform;
var i,j : integer;
begin
appiication.showmainform := true;
showwindow(application.handle, sw_restore); showwindow(application.mainform.handle, sw_restore);
if not shownonce then begin
for i := 0 to application.mainform.componentcount -1 do if application.mainform.components[i] is twincontrol then with application.mainform.components[i] as twincontrol do if visible then
begin
showwindow(handle, sw_showdefault);
for j := 0 to componentcount -1 do if components[j] is twincontrol then
showwindow((components[j] as twincontrol).handle, sw_showdefault);
end;
shownonce := true;
end;
end;

procedure tforml.wmsyscommand(var msg: tmessage);
begin inherited;
if (msg.wparam=sc_minimize) then
begin
hidemainform; createtraylcon(l) ;
end;
end;

procedure tforml.fileopenltemlclick(sender: tobject); begin
restoremainform;
deletetraylcon(l);
end;

Теперь у вас в руках полноценный набор средств для работы с панелью system tray.

В заключение необходимо добавить, что все описанное реализуется не в операционной системе, а в оболочке ОС — Проводнике (explorer). В принципе, и windows nt 4/2000, и windows 95/98 допускают замену оболочки ОС на другие, например dashboard или lightstep. Там функции панели system tray могут быть не реализованы или реализованы через другие api. Впрочем, случаи замены оболочки достаточно редки.

Графический интерфейс операционной системы Windows поддерживает копирование (перенос) файлов при помощи мыши. Это реализуется технологией Drag and Drop. Если ваша программа много работает с файлами, то можно облегчить процесс открытия файлов. Метод Drag and Drop позволяет отказаться от стандартной схемы открытия файлов при помощи диалогов открытия файлов.

Используя Drag'n'Drop вы можете перенести мышью объект рабочего стола (проводника) на форму программы и этот объект будет найден и обработан. Технология Drag and Drop поддерживает следующие объекты: файлы, папки, ярлыки, ссылки интернет и др. Функция Drag'n'Drop является родной функцией проводника (Windows Explorer),
то есть она поддерживается не операционной системой, оболочкой. Поэтому, если вы пользуетесь другой оболочкой (напр. DesqView), то поддержка Drag and Drop не гарантируется.

Реализация

Для того, чтобы реализовать этот метод на Delphi, необходимо:

1) Подключить модуль ShellApi в секции Uses в Unit1 формы.
2) Затем в Unit1, найти оператор private и выше него добавить следующие строки:

Код

...
protected
Procedure WMDropFiles(var Msg: TMessage); message wm_DropFiles;
...

3) Добавить в Unit1 процедуру WMDropFiles и ввести её тело:

Код

Procedure TForm1.WMDropFiles(var Msg: TMessage);
var
Filename: array[0 .. 256] of Char;
FileStr: string;
begin
{ Получаем имя первого файла }
DragQueryFile( THandle(Msg.WParam), 0, Filename, sizeof(Filename) ) ;
{ Открываем его }
FileStr:=LowerCase(StrPas(FileName));
{ Подсветка окна }
FlashWindow(Form1.Handle,true);
{ Отдаем сообщение о завершении процесса }
DragFinish(THandle(Msg.WParam));
...
{Здесь вы можете ввести код работы с файлом}
...
end;

4) Чтобы форма могла принимать объекты, необходимо в обработчик события OnCreate, записать:

Код

DragAcceptFiles(Handle, True);

Заключение

Технология Drag and Drop очень облегчает работу с такими программами, как кодировщики музыки, интернет-качалки, файловые утилиты и архиваторы.

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

Данное решение может быть не самым быстрым, однако на поверку оно оказывается быстрее остальных, обнаруженных мною в Интернете (может вам повезет больше). Более того, представьте, что действительное значение какого-либо поля равно 4.509375354, а значение поиска равно 7, в этом случае утилита засчитает "попадание". Утилита удобна также тем, что она за один проход производит поиск более, чем в одном поле.

Это удобно, если у Вас имеются, к примеру, два поля с адресами. Это моя первая "серьезная" разработка, так как первое, с чем я столкнулся, изучая Delphi, стала необходимость включения процедуры поиска в любое приложение, работающее с базой данных. А так как поиск - вещь тоже сугубо специфическая, как и любое приложение, то мне пришлось побороть свой страх перед "крутым программированием" и попробовать написать свой поисковый механизм, удовлетворивший меня (и, надеюсь, других) своей скоростью и возможностью "мульти"-поиска по нескольким полям.

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

Код

unit Finder;

interface

uses DB, DBTables, SysUtils;

function GrabMemoFieldAsPChar(TheField : TMemoField): PChar;
function DoFindIn(TheField : TField; SFor : String): Boolean;
function FindIt(TheTable : TDataSet; TheFields : array of integer;

SearchBackward : Boolean; Beginning : Boolean; SFor : String): Boolean;
{применение функции FindIt -

if FindIt(NotesSearchT,
[NotesSearchT.FieldByName('Leadman').Index],
False, True, SearchText.Text) then DoSomething; }

implementation

function GrabMemoFieldAsPChar(TheField : TMemoField): PChar;
begin
with TBlobStream.Create(TheField, bmRead) do

begin
GetMem(Result, Size + 1);
FillChar(Result^, Size + 1, #0);
Read(Result^, Size);
Free;
end;
end;

function DoFindIn(TheField : TField; SFor : String): Boolean;
var

PChForMemo : PChar;
begin
Result := False;
case TheField.DataType of

ftString :
begin
if (Pos(SFor, UpperCase(TheField.AsString)) > 0) then
Result := True;
end;
ftInteger :
begin
if (Pos(SFor, TheField.AsString) > 0) then Result := True;
end;
ftBoolean :
begin
if SFor = UpperCase(TheField.AsString) then
Result := True;
end;
ftFloat :
begin
if (Pos(SFor, TheField.AsString) > 0) then Result := True;
end;
ftCurrency :
begin
if (Pos(SFor, TheField.AsString) > 0) then Result := True;
end;
ftDate .. ftDateTime :
begin
if (Pos(SFor, TheField.AsString) > 0) then Result := True;
end;
ftMemo :
begin
SFor[Ord(SFor[0]) + 1] := #0;
PChForMemo := GrabMemoFieldAsPChar(TMemoField(TheField));
StrUpper(PChForMemo);
if not (StrPos( PChForMemo, @SFor[1] ) = nil) then Result :=
True; FreeMem(PChForMemo, StrLen(PChForMemo + 1));
end;
end;
end;

function FindIt(TheTable : TDataSet; TheFields : array of integer;

SearchBackward : Boolean; Beginning : Boolean; SFor : String): Boolean;
var

i, HighTheFields, LowTheFields : integer;
BM : TBookmark;
begin
TheTable.DisableControls;
BM := TheTable.GetBookmark;
try
LowTheFields := Low(TheFields);
HighTheFields := High(TheFields);
SFor := UpperCase(SFor);
Result := False;
if Beginning then TheTable.First;
if SearchBackward then

begin
TheTable.Prior;
while not TheTable.BOF do
begin
for i := LowTheFields to HighTheFields do
begin
if DoFindIn(TheTable.Fields[TheFields[i]], SFor) then
begin
Result := True;
Break;
end;
end;
if Result then Break else TheTable.Prior;
end;
end else
begin
TheTable.Next;
while not TheTable.EOF do
begin
for i := LowTheFields to HighTheFields do
begin
if DoFindIn(TheTable.Fields[TheFields[i]], SFor) then
begin
Result := True;
Break;
end;
end;
if Result then Break else TheTable.Next;
end;
end;
finally
TheTable.EnableControls;
if not Result then

TheTable.GotoBookmark(BM);
TheTable.FreeBookmark(BM);
end;

end;

end.

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

Компилятор Delphi относится к разряду оптимизирующих. Но насколько качественно проводится оптимизация? Как «помочь» компилятору создать более быстрый код? Давайте разберемся с этим на экспериментах.

Оптимизация константных выражений

Пример 1:

Код

const
z = 15616;
...
var
a,b: integer;
...
a := $abcd6123;
b := z+a;
....

С точки зрения оптимизации код можно упростить еще на этапе компиляции до

Код

b:=15616+$abcd6123;

или того проще:

b:=$ABCD9E23;

Но написанный выше листинг преобразуется в

Код

mov eax, $abcd6123
lea ebx, [eax + $00003D00]

С одной стороны компилятор не «сообразил», что значение переменной «a» можно преобразовать в константу и сложить с другой константой (которая, заметим, подставлена именно как константа) на этапе компиляции, с другой стороны был применен весьма хитрый трюк с LEA (об этом ниже). Тем не менее, код

Код

mov ebx, $ABCD9E23

в любом случае быстрее и короче.

Пример 2:

Код

...
b:=random(maxint); // b – заведомо не константа !
a:=$abcd6123;
if b>a then b:=a;
...

Скомпилированный код будет выглядеть

Код

mov eax, $7fffffff // MaxInt
call @RandInt
mov ebx,eax
mov eax, $abcd6123
cmp eax, ebx
jnl +$02
...

А ведь значение, присвоенной переменной «а» являлось константой и наш пример можно было бы переписать как:

Код

b:=random(maxint);
a:=$abcd6123;
if b>$abcd6123 then b:= $abcd6123;

Пример 3:

Код

...
a:=$abcd6123;
b:=$abc34233;
c:=b-a;
...

После компиляции получаем:

Код

mov eax, $abcd6123
mov ebx, $abc34233
mov ebx, edx
sub ebx, eax

Т.е. компилятор преобразовал код так, как он был написан, а ведь можно было бы просто записать:

Код

mov ebx, $fff5e110
т.е. c:= $fff5e110;

Оптимизация алгебраических выражений

Пример 4:

Код

...
var
a,b,c,d: integer;
p: pointer;
begin
p:=nil;
a:=0;
...
{далее по коду эти присвоения не используются}

После компиляции эти переменные будут удалены, причем с предупреждением

Код

Value assigned to ... never used

Пример 5:

Код

...
a:=0;
b:=a;
showmessage(inttostr(b));
...

Код скомпилируется как есть! Таким образом мы обманули компилятор псевдо использованием переменных. Delphi не исправляет нашей «кривости», поэтому эта задача ложится исключительно на плечи программиста.

Пример 6:

Код

...
b:=random(maxint);
a:=b;
func(a,b);
a:=a+1;
func(a,b);
...

Данный код можно оптимизировать до

Код

...
b:=random(maxint);
func(b,b);
a:=b+1;
func(a,b);
...

И этого Delphi за нас не сделает.

Пример 7:

Код

...
c:=a div b;
c:=a*b;
...

В данном примере первую строчку можно безболезненно удалить, что Delphi делать умеет.

Пример 8:

Код

if ((a*b)<$3d00) and (a*b)>0)) then ...

В данном случае можно избавится от одной операции умножения, присвоив значение выражения a*b временной переменной. Анализ ассемблерного листинга показывает, что компилятор именно так и поступает. Тем не менее, поменяв второе подвыражение на ((b*a)>0), компилятор принимает выражения за разные и генерирует умножение для обоих случаев, не смотря на то, что результат одинаков.

Оптимизация арифметических операций

Сложение и вычитание

Применение инструкции LEA вместо ADD позволяет производить сумму 3х операндов (двух переменных и одной константы) за один такт. Трюк заключается в том представление ближних указателей эквивалентно их фактическому значению, поэтому результат, возвращенный LEA равен сумме ее операндов. При возможности Delphi производит такую замену.

Деление

Операция деления требует гораздо больше тактов процессора, нежели умножение, поэтому замена деления на умножение может значительно ускорить работу. Существуют формулы, позволяющие выполнять такое преобразование. Тем не менее, Delphi не использует такую оптимизацию. Деление на степень двойки можно заменять сдвигом вправо на n бит, но даже в этом случае получаем следующий код:

Код

mov esi,edi
sar esi,1
jns +$03
adc esi, $00

Здесь учитывается особенность самой операции div – округление в большую сторону. Поэтому, если можно пренебрегать округлением, используйте c:=a shr 1 вместо с:=a div 2.

Умножение

Умножение на степень двойки можно заменять сдвигами битов. Delphi заменяет умножение сдвигами при умножении на 4,8,16 итд. При умножении на 2 производится суммированием переменной с собой.

Умножать на 3,5,6,7,8,10 и т. д. можно и без операции умножения – расписав выражение по формуле (a shl n)+a, где n – показатель степени двойки. Например, при умножении на 3 n=1. Delphi при возможности прибегает к этому трюку. Заметим, операнд LEA умеет умножать регистр на 2,4,8, что также при возможности используется компилятором. Например, умножение на 3 преобразуется в инструкцию

Код

lea esi, [ebx + ebx*2]

Оптимизация case of

Анализ скомпилированного кода показывает, что Delphi проводит утрамбовку дерева. Т.е. значения case сортируются и выбор нужного элемента производится при помощи двоичного поиска.

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

Оптимизация циклов

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

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

Вынесение инвариантного кода за пределы цикла – не выносится. Наиболее распространенный недочет – условие цикла записывается как:

Код

for i:=0 to memo1.lines.count – 1 do...

Delphi будет при каждой итерации вызывать метод count, вычитать из результата 1 и потом уже сверять. Настоятельно рекомендуется переписывать подобный код как

Код

lin := .lines.count – 1;
for i:=0 to lin do...

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

Замена циклов с предусловием на циклы с постусловием – производится. Циклы с постусловием имеют главное преимущество над другими видами циклов (с предусловием и с условием в середине) – они содержат всего одно ветвление. Delphi производит такую замену.

Замена инкремента на декремент – не производится. Более того, даже декрементный цикл компилируется в неоптимальный код, т.к. не используется флаг ZF. Вместо этого происходит сравнивание значения регистра с 0.

Удаление ветвлений – не производится.

Вывод:

1. Не используйте переменные для временного хранения констант или обязательно объявляйте «магические» числа как const, либо подставляйте в код непосредственные значения

2. Неиспользуемыми объявлениями и присвоениями можно безболезненно пренебрегать – Delphi умеет их вычищать.

3. Внимательно следите за использованием переменных, в частности лишним присвоениям их значений друг другу. Такого рода оптимизации Delphi делать не умеет.

4. Используйте свернутые математические выражения. (например, (3*a - a) /2 упрощается до a). Delphi не умеет упрощать математические выражения. (Да и что говорить, даже MathCAD не всегда грамотно умеет делать такие преобразования).

5. Не используйте конструкции типа a:=10*sin(45*pi/180); Delphi не вычислит эту константу на этапе компиляции, напротив, будет послушно вызывать sin и pi по ходу выполнения программы! В случае, если угол является переменной, по крайней мере pi можно заменить константой 3,1415...

6. Delphi прекрасно справляется с выражениями, полностью составленных из констант – они вычисляются на этапе компиляции.

7. Внимательно следите за условиями и их границами. Компилятор Delphi не умеет обнаруживать заведомо ложных условий. Также он не умеет удалять заведомо лишние условия. Например, (a>0) and (a<15616) and (a<>0)

8. Если в условии несколько раз проверяется одно и тоже выражение, следите, чтобы оно было выражено во всех конструкциях одинаково. В противном случае скомпилированный код будет не оптимален. Например, if ((a*b)>0) and ((a*b)<1024) then... При перестановке во втором случае b*a смысл выражения не изменится, но код будет иметь уже на одну операцию умножения, а две. Можно временно присвоить проверяемое выражение временной переменной, а затем уже проверять полученное значение.

9. Сообщение «Combining signed and unsigned types – widened both operands» сообщает не только о потенциальной ошибке – также вследствие преобразования мы теряем производительность. Например, z – объявлена как ineteger. условие if z>$abcd6123 then z:= $abcd6123; несмотря на его правильность вызовет данное предупреждение. Сгенерированный код будет, выполнять преобразования величин до 64-х бит, и дальнейшее уже сравнение 64-х битных операндов. Если изменить тип z на cardinal, мы избавимся от предупреждения и получим 3 строки кода, вместо 8 !

10. Delphi умеет оптимизировать сложение, умножение и частично деление. При делении на степень двойки, если не важно округление до большего, рекомендуется пользоваться shr 1 вместо div 2.

11. В case of при возможности используйте элементы, расположенные в арифметической прогрессии. Тем не менее, даже при невыполнении данного условия мы получим качественный код после утрамбовки дерева.

12. Выносите инвариантный код за тело цикла. Наиболее частая ошибка – for i:=1 to length(str) do... Дело в том, что при каждой итерации будет вызываться функция length, что пагубно скажется на производительности. Рекомендуется длину строки заранее присвоить переменной. Также не включайте в тело цикла код, заведомо не зависящий от изменения итерационной переменной.

Сравнивая Delphi с компиляторами Visual C++, WATCOM, Borland C++ (тестирование данных компиляторов приведено в [1]) приходим к выводу, что Delphi по своим оптимизирующим свойствам аналогичен Borland C++ (а кто сомневался? ;) ). Учитывая, что Borland C++ по итогам сравнения оказался последним, делаем несложный вывод. Весьма печален и тот факт, что большинство кода VCL написано с точки зрения «красоты» кода, а не его оптимальности с точки зрения скорости. Например, не соблюдается правило 12.

Главное о чем стоит упомянуть это, что ваш хранитель экрана будет работать в фоновом режиме и он не должен мешать работе других запущенных программ. Поэтому сам хранитель должен быть как можно меньшего объема. Для уменьшения объема файла в описанной ниже программе не используется визуальные компоненты Delphi, включение хотя бы одного из них приведет к увеличению размера файла свыше 200кб, а так, описанная ниже программа, имеет размер всего 20кб!!!

Технически, хранитель экрана является нормальным EXE файлом (с расширением .SCR), который управляется через командные параметры строки. Например, если пользователь хочет изменить параметры вашего хранителя, Windows выполняет его с параметром "-c" в командной строке. Поэтому начать создание вашего хранителя экрана следует с создания примерно следующей функции:

Код

Procedure RunScreenSaver;
Var S : String;
Begin
S := ParamStr(1);
If (Length(S) > 1) Then Begin
Delete(S,1,1); { delete first char - usally "/" or "-" }
S[1] := UpCase(S[1]);
End;
LoadSettings; { load settings from registry }
If (S = 'C') Then RunSettings
Else If (S = 'P') Then RunPreview
Else If (S = 'A') Then RunSetPassword
Else RunFullScreen;
End;

Поскольку нам нужно создавать небольшое окно предварительного просмотра и полноэкранное окно, их лучше объединить используя единственный класс окна. Следуя правилам хорошего тона, нам также нужно использовать многочисленные нити. Дело в том, что, во-первых, хранитель не должен переставать работать даже если что-то "тяжелое" случилось, и во-вторых, нам не нужно использовать таймер.
Процедура для запуска хранителя на полном экране - приблизительно такова:

Код

Procedure RunFullScreen;
Var
R : TRect;
Msg : TMsg;
Dummy : Integer;
Foreground : hWnd;
Begin
IsPreview := False; MoveCounter := 3;
Foreground := GetForegroundWindow;
While (ShowCursor(False) > 0) do ;
GetWindowRect(GetDesktopWindow,R);
CreateScreenSaverWindow(R.Right-R.Left,R.Bottom-R.Top,0);
CreateThread(nil,0,@PreviewThreadProc,nil,0,Dummy);
SystemParametersInfo(spi_ScreenSaverRunning,1,@Dummy,0);
While GetMessage(Msg,0,0,0) do Begin
TranslateMessage(Msg);
DispatchMessage(Msg);
End;
SystemParametersInfo(spi_ScreenSaverRunning,0,@Dummy,0);
ShowCursor(True);
SetForegroundWindow(Foreground);
End;

Во-первых, мы проинициализировали некоторые глобальные переменные (описанные далее), затем прячем курсор мыши и создаем окно хранителя экрана. Имейте в виду, что важно уведомлять Windows, что это - хранителя экрана через SystemParametersInfo (это выводит из строя Ctrl-Alt-Del чтобы нельзя было вернуться в Windows не введя пароль). Создание окна хранителя:

Код

Function CreateScreenSaverWindow(Width,Height : Integer;
ParentWindow : hWnd) : hWnd;
Var WC : TWndClass;
Begin
With WC do Begin
Style := cs_ParentDC;
lpfnWndProc := @PreviewWndProc;
cbClsExtra := 0; cbWndExtra := 0; hIcon := 0; hCursor := 0;
hbrBackground := 0; lpszMenuName := nil;
lpszClassName := 'MyDelphiScreenSaverClass';
hInstance := System.hInstance;
end;
RegisterClass(WC);
If (ParentWindow 0) Then
Result := CreateWindow('MyDelphiScreenSaverClass','MySaver',
ws_Child Or ws_Visible or ws_Disabled,0,0,
Width,Height,ParentWindow,0,hInstance,nil)
Else Begin
Result := CreateWindow('MyDelphiScreenSaverClass','MySaver',
ws_Visible or ws_Popup,0,0,Width,Height, 0,0,hInstance,nil);
SetWindowPos(Result,hwnd_TopMost,0,0,0,0,swp_NoMove or swp_NoSize or swp_NoRedraw);
End;
PreviewWindow := Result;
End;

Теперь окна созданы используя вызовы API. Я удалил проверку ошибки, но обычно все проходит хорошо, особенно в этом типе приложения.
Теперь Вы можете погадать, как мы получим handle родительского окна предварительного просмотра ? В действительности, это совсем просто: Windows просто передает handle в командной строке, когда это нужно. Таким образом:

Код

Procedure RunPreview;
Var
R : TRect;
PreviewWindow : hWnd;
Msg : TMsg;
Dummy : Integer;
Begin
IsPreview := True;
PreviewWindow := StrToInt(ParamStr(2));
GetWindowRect(PreviewWindow,R);
CreateScreenSaverWindow(R.Right-R.Left,R.Bottom-R.Top,PreviewWindow);
CreateThread(nil,0,@PreviewThreadProc,nil,0,Dummy);
While GetMessage(Msg,0,0,0) do Begin
TranslateMessage(Msg); DispatchMessage(Msg);
End;
End;

Как Вы видите, window handle является вторым параметром (после "-p").
Чтобы "выполнять" хранителя экрана - нам нужна нить. Это создается с вышеуказанным CreateThread. Процедура нити выглядит примерно так:

Код

Function PreviewThreadProc(Data : Integer) : Integer; StdCall;
Var R : TRect;
Begin
Result := 0; Randomize;
GetWindowRect(PreviewWindow,R);
MaxX := R.Right-R.Left; MaxY := R.Bottom-R.Top;
ShowWindow(PreviewWindow,sw_Show); UpdateWindow(PreviewWindow);
Repeat
InvalidateRect(PreviewWindow,nil,False);
Sleep(30);
Until QuitSaver;
PostMessage(PreviewWindow,wm_Destroy,0,0);
End;

Нить просто заставляет обновляться изображения в нашем окне, спит на некоторое время, и обновляет изображения снова. А Windows будет посылать сообщение WM_PAINT на наше окно (не в нить !). Для того, чтобы оперировать этим сообщением, нам нужна процедура:

Код

Function PreviewWndProc(Window : hWnd; Msg,WParam,
LParam : Integer): Integer; StdCall;
Begin
Result := 0;
Case Msg of
wm_NCCreate : Result := 1;
wm_Destroy : PostQuitMessage(0);
wm_Paint : DrawSingleBox; { paint something }
wm_KeyDown : QuitSaver := AskPassword;
wm_LButtonDown, wm_MButtonDown, wm_RButtonDown, wm_MouseMove :
Begin
If (Not IsPreview) Then Begin
Dec(MoveCounter);
If (MoveCounter <= 0) Then QuitSaver := AskPassword;
End;
End;
Else Result := DefWindowProc(Window,Msg,WParam,LParam);
End;
End;

Если мышь перемещается, кнопка нажала, мы спрашиваем у пользователя пароль:

Код

Function AskPassword : Boolean;
Var
Key : hKey;
D1,D2 : Integer; { two dummies }
Value : Integer;
Lib : THandle;
F : TVSSPFunc;
Begin
Result := True;
If (RegOpenKeyEx(hKey_Current_User,'Control Panel\Desktop',0,
Key_Read,Key) = Error_Success) Then
Begin
D2 := SizeOf(Value);
If (RegQueryValueEx(Key,'ScreenSaveUsePassword',nil,@D1,
@Value,@D2) = Error_Success) Then
Begin
If (Value 0) Then Begin
Lib := LoadLibrary('PASSWORD.CPL');
If (Lib > 32) Then Begin
@F := GetProcAddress(Lib,'VerifyScreenSavePwd');
ShowCursor(True);
If (@F nil) Then Result := F(PreviewWindow);
ShowCursor(False);
MoveCounter := 3; { reset again if password was wrong }
FreeLibrary(Lib);
End;
End;
End;
RegCloseKey(Key);
End;
End;

Это также демонстрирует использование registry на уровне API. Также имейте в виду как мы динамически загружаем функции пароля, используюя LoadLibrary. Запомните тип функции?
TVSSFunc ОПРЕДЕЛЕН как:

Код

Type
TVSSPFunc = Function(Parent : hWnd) : Bool; StdCall;

Теперь почти все готово, кроме диалога конфигурации. Это запросто:

Код

Procedure RunSettings;
Var Result : Integer;
Begin
Result := DialogBox(hInstance,'SaverSettingsDlg',0,@SettingsDlgProc);
If (Result = idOK) Then SaveSettings;
End;

Трудная часть -это создать диалоговый сценарий (запомните: мы не используем здесь Delphi формы!). Я сделал это, используя 16-битовую Resource Workshop (остался еще от Turbo Pascal для Windows). Я сохранил файл как сценарий (текст), и скомпилированный это с BRCC32:

Код

SaverSettingsDlg DIALOG 70, 130, 166, 75
STYLE WS_POPUP | WS_DLGFRAME | WS_SYSMENU
CAPTION "Settings for Boxes"
FONT 8, "MS Sans Serif"
BEGIN
DEFPUSHBUTTON "OK", 5, 115, 6, 46, 16
PUSHBUTTON "Cancel", 6, 115, 28, 46, 16
CTEXT "Box &Color:", 3, 2, 30, 39, 9
COMBOBOX 4, 4, 40, 104, 50, CBS_DROPDOWNLIST | CBS_HASSTRINGS
CTEXT "Box &Type:", 1, 4, 3, 36, 9
COMBOBOX 2, 5, 12, 103, 50, CBS_DROPDOWNLIST | CBS_HASSTRINGS
LTEXT "Boxes Screen Saver for Win32 Copyright (c) 1996 Jani
Jдrvinen.", 7, 4, 57, 103, 16,
WS_CHILD | WS_VISIBLE | WS_GROUP
END

Почти также легко сделать диалоговое меню:

Код

Function SettingsDlgProc(Window : hWnd; Msg,WParam,LParam : Integer): Integer; StdCall;
Var S : String;
Begin
Result := 0;
Case Msg of
wm_InitDialog : Begin
{ initialize the dialog box }
Result := 0;
End;
wm_Command : Begin
If (LoWord(WParam) = 5) Then EndDialog(Window,idOK)
Else If (LoWord(WParam) = 6) Then EndDialog(Window,idCancel);
End;
wm_Close : DestroyWindow(Window);
wm_Destroy : PostQuitMessage(0);
Else Result := 0;
End;
End;

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

Код

Procedure SaveSettings;
Var
Key : hKey;
Dummy : Integer;
Begin
If (RegCreateKeyEx(hKey_Current_User,
'Software\SilverStream\SSBoxes',
0,nil,Reg_Option_Non_Volatile,
Key_All_Access,nil,Key,
@Dummy) = Error_Success) Then Begin
RegSetValueEx(Key,'RoundedRectangles',0,Reg_Binary,
@RoundedRectangles,SizeOf(Boolean));
RegSetValueEx(Key,'SolidColors',0,Reg_Binary, @SolidColors,SizeOf(Boolean));
RegCloseKey(Key);
End;
End;

Загружаем параметры так:

Код

Procedure LoadSettings;
Var
Key : hKey;
D1,D2 : Integer; { two dummies }
Value : Boolean;
Begin
If (RegOpenKeyEx(hKey_Current_User,
'Software\SilverStream\SSBoxes',0,
Key_Read,
Key) = Error_Success) Then Begin
D2 := SizeOf(Value);
If (RegQueryValueEx(Key,'RoundedRectangles',nil,@D1,
@Value, @D2) = Error_Success) Then
Begin
RoundedRectangles := Value;
End;
If (RegQueryValueEx(Key,'SolidColors',nil,@D1,
@Value,@D2) = Error_Success) Then
Begin
SolidColors := Value;
End;
RegCloseKey(Key);
End;
End;

Легко? Нам также нужно позволить пользователю, установить пароль. Я честно не знаю почему это оставлено разработчику приложений ! Тем не менее:

Код

Procedure RunSetPassword;
Var
Lib : THandle;
F : TPCPAFunc;
Begin
Lib := LoadLibrary('MPR.DLL');
If (Lib > 32) Then Begin
@F := GetProcAddress(Lib,'PwdChangePasswordA');
If (@F nil) Then F('SCRSAVE',StrToInt(ParamStr(2)),0,0);
FreeLibrary(Lib);
End;
End;

Мы динамически загружаем (недокументированную) библиотеку MPR.DLL, которая имеет функцию, чтобы установить пароль хранителя экрана, так что нам не нужно беспокоиться об этом.
TPCPAFund ОПРЕДЕЛЕН как:

Код

Type
TPCPAFunc = Function(A : PChar; Parent : hWnd; B,C : Integer) : Integer; StdCall;

(Не спрашивайте меня что за параметры B и C ! :-)
Теперь единственная вещь, которую нам нужно рассмотреть, - самая странная часть: создание графики. Я не великий ГУРУ графики, так что Вы не увидите затеняющие многоугольники, вращающиеся в реальном времени. Я только сделал некоторые ящики.

Код

Procedure DrawSingleBox;
Var
PaintDC : hDC;
Info : TPaintStruct;
OldBrush : hBrush;
X,Y : Integer;
Color : LongInt;
Begin
PaintDC := BeginPaint(PreviewWindow,Info);
X := Random(MaxX); Y := Random(MaxY);
If SolidColors Then
Color := GetNearestColor(PaintDC,RGB(Random(255),Random(255),Random(255)))
Else Color := RGB(Random(255),Random(255),Random(255));
OldBrush := SelectObject(PaintDC,CreateSolidBrush(Color));
If RoundedRectangles Then
RoundRect(PaintDC,X,Y,X+Random(MaxX-X),Y+Random(MaxY-Y),20,20)
Else Rectangle(PaintDC,X,Y,X+Random(MaxX-X),Y+Random(MaxY-Y));
DeleteObject(SelectObject(PaintDC,OldBrush));
EndPaint(PreviewWindow,Info);
End;

И последнее - глобальные переменные:

Код

Var
IsPreview : Boolean;
MoveCounter : Integer;
QuitSaver : Boolean;
PreviewWindow : hWnd;
MaxX,MaxY : Integer;
RoundedRectangles : Boolean;
SolidColors : Boolean;

Затем исходная программа проекта (.dpr). Красива, а!?

Код

program MySaverIsGreat;
uses
windows, messages, Utility; { defines all routines }
{$R SETTINGS.RES}
begin
RunScreenSaver;
end.

Ох, чуть не забыл! Если, Вы используете SysUtils в вашем проекте (например фуекцию StrToInt) вы получите EXE-файл больше чем обещанный в 20k. :) Если Вы хотите все же иметь20k, надо как-то обойтись без SysUtils, например самому написать собственную StrToInt процедуру.
Если все же очень трудно обойтись без использования Delphi-форм, то можно поступить как в случае с вводом пароля: форму изменения параметров хранителя сохранить в виде DLL и динамически ее загружать при необходимости. Т.о. будет маленький и шустрый файл самого хранителя экрана и довеска DLL для конфигурирования и прочего (там объем и скорость уже не критичны).

В статье продемонстрированы программные методы экспортирования данных из программы "1С:Предприятие 7.7".

Экспорт данных из 1С в Текстовой файл TXT, CSV

Код

//сохранение данных таблицы значений в текстовой файл
//аргументы: М - таблица значений
Процедура ВыполнитьЭкспорт(М)
Т=СоздатьОбъект("Текст");
//выборка
М.ВыбратьСтроки();
Пока М.ПолучитьСтроку()=1 Цикл
Состояние("Экспорт: "+
Цел(М.НомерСтроки/М.КоличествоСтрок()0)+"%");
тФирма=М.Фирма.ПолныйКод();
тТовар=М.Товар.ПолныйКод();
тСклад=М.Склад.ПолныйКод();
тКоличество=М.Количество;
Т.ДобавитьСтроку("Фирма="+тФирма+";Товар="+тТовар+";Склад="+тСклад+
";Количество="+тКоличество+";");
КонецЦикла;
//файл
Файл="export"+Формат(ДатаК,"Д ГГГГММДД")+".csv";
Т.Записать(Файл);
Сообщить("Файл с данными сохранен в каталоге
экспортной БД: "+КаталогИБ()+Файл);
КонецПроцедуры

Экспорт данных из 1С в файл dBase формата DBF

Код

//процедура записывает данные об использовании
отчёта в файл dBase формата DBF
Процедура гЗаписатьСтатистикуИспользованияОтчета(ИдентификаторОтчета) Экспорт
//путь к файлу; имя файла не должно превышать 8 знаков
Путь=КаталогИБ()+"Stat.dbf";
//создание нового файла
Б=СоздатьОбъект("XBase");
Если ФС.СуществуетФайл(Путь)=0 Тогда
//добавление полей
Б.ДобавитьПоле("REPORT","S",100,0);
Б.ДобавитьПоле("USER","S",50,0);
Б.ДобавитьПоле("DATE","D",10,0);
Б.ДобавитьПоле("TIME","S",5,0);
//создание файла
Б.СоздатьФайл(Путь);
Б.ЗакрытьФайл();
КонецЕсли;
//открытие файла
Б.ОткрытьФайл(Путь);
Если Б.Открыта()=0 Тогда
Сообщить("Не удалось открыть файл DBF","!");
Возврат;
КонецЕсли;
//добавление записи
Б.Добавить();
Б.Date=ТекущаяДата();
Б.Time=ТекущееВремя();
Б.Report=СокрЛП(ИдентификаторОтчета);
Б.User=гПользователь.Наименование;
Б.Записать();
//закрытие файла
Б.ЗакрытьФайл();
КонецПроцедуры

Экспорт данных из 1С на лист MS Excel

Код

//функция создаёт новую книгу в MS Excel и выгружает табличную часть заданного документа
Процедура гМногострочка_Экспортировать(Док) Экспорт
//документ
Д=СоздатьОбъект("Документ");
Д.НайтиДокумент(Док);
//приложение
Оле=СоздатьОбъект("Excel.Application");
Если ФлагВидимость=1 Тогда
Оле.Visible=1;
КонецЕсли;
Книга=Оле.Workbooks().Add();
Книга.Windows(1).Caption=Д.ПредставлениеВида()+" "+СокрЛП(Д.НомерДок);
Лист=Книга.Activesheet;
//шапка
Колонка=0;
Для i=1 По Метаданные.Документ(Д.Вид()).РеквизитТабличнойЧасти() Цикл
Ж=Метаданные.Документ(Д.Вид()).РеквизитТабличнойЧасти(i);
//колонка
Колонка=Колонка+1;
Ячейка=Лист.Cells(1,Колонка);
//текст
Ячейка.Value=Ж.Идентификатор;
//форматирование
Ячейка.Font.Bold=1;
Если Ж.Тип="Число" Тогда
Попытка
Лист.Columns(Колонка).NumberFormat="# ##0.00";
Исключение
Лист.Columns(Колонка).NumberFormat="# ##0,00";
КонецПопытки;
КонецЕсли;
КонецЦикла;
//строки
Д.ВыбратьСтроки();
Пока Д.ПолучитьСтроку()=1 Цикл
Лист.Range("A"+Число(Д.НомерСтроки+1)).Select();
Колонка=0;
//многострочка
Для i=1 По Метаданные.Документ(Д.Вид()).РеквизитТабличнойЧасти() Цикл
Ж=Метаданные.Документ(Д.Вид()).РеквизитТабличнойЧасти(i);
Колонка=Колонка+1;
//значение
Значение=Д.ПолучитьАтрибут(Ж.Идентификатор);
Лист.Cells(Д.НомерСтроки+1,Колонка).Value=СокрЛП(Значение);
КонецЦикла;
КонецЦикла;
//авто подбор ширины
Лист.Cells.EntireColumn.AutoFit();
//закрепление области
Лист.Range("A2").Select();
Оле.ActiveWindow.FreezePanes=1;
Оле.Visible=1;
КонецПроцедуры

Управление MS Word из 1С

Методы работы с MS Word через OLE активно использованы в конфигурации "Договоры". Для определения числового кода текстовых констант MS Word использована обработка "Константы VBA".

* Конфигурация "Договоры"
* Универсальная обработка "Константы VBA"

Код

//поиск текста в открытом документе MS Word
Функция Текст_Найти(Оле,аТекст)
Текст=СокрЛП(аТекст);
//поиск
Оле.Selection.Find.ClearFormatting();
Оле.Selection.Find.Text=Текст;
Оле.Selection.Find.MatchCase=0;
Оле.Selection.Find.MatchWholeWord=0;
Оле.Selection.Find.MatchWildcards=0;
Оле.Selection.Find.MatchSoundsLike=0;
Оле.Selection.Find.MatchAllWordForms=0;
Оле.Selection.Find.Forward=1;
Оле.Selection.Find.Wrap=wdFindContinue;
Оле.Selection.Find.Format=0;
Ответ=Оле.Selection.Find.Execute();
//найден
Если Оле.Selection.Find.Found()=0 Тогда
Сообщить("Текст не найден: "+Текст);
Возврат(0);
Иначе
Возврат(1);
КонецЕсли;
КонецФункции

//поиск и замена текста в документе MS Word
Процедура Договор_Заменить()
//путь
Если ФС.ВыбратьФайл(0,Файл,Каталог,"Открыть старый файл","Файлы MS Word|*.doc")=0 Тогда
Возврат;
КонецЕсли;
//приложение
Оле=СоздатьОбъект("Word.Application");
Оле.Documents.Open(Каталог+Файл,,1);
//переход курсора в начало текста
Оле.Selection.HomeKey(wdStory);
//замена Номер договора
Если Текст_Найти(Оле,"ДОГОВОР")=1 Тогда
Оле.Selection.EndKey(wdLine,wdCharacter);
Оле.Selection.TypeText("ДОГОВОР № "+гНомерДок(НомерДок));
КонецЕсли;
//замена Дата договора
Если Текст_Найти(Оле,Константа.ГодСтарый)=1 Тогда
Оле.Selection.MoveLeft(wdWord,3);
Оле.Selection.EndKey(wdLine,wdCharacter);
Оле.Selection.TypeText(ДатаДоговора());
КонецЕсли;
//переход курсора в начало текста
Оле.Selection.HomeKey(wdStory);
Оле.Visible=1;
//предупреждение
Предупреждение("Создание нового договора копированием старого выполнено.");
КонецПроцедуры

Экспорт данных в файл формата XML

Код

//процедура выгружает элементы справочника "Физические лица" в файл формата XML
Процедура Лица_Выгрузить()
//справочник
С=СоздатьОбъект("Справочник.Лица");
//анализатор
Анализатор=СоздатьОбъект("AddIn.XMLParser");
Корень=Анализатор.СоздатьДокумент();
//данные
Данные=Корень.СоздатьПодчиненныйЭлемент("Данные");
Данные.УстановитьАтрибут("Дата",ТекущаяДата());
Данные.УстановитьАтрибут("Время",ТекущееВремя());
Данные.УстановитьАтрибут("Автор",гПользователь.Наименование);
//наполнение
Группа=Данные;
С.ВыбратьЭлементы();
Пока С.ПолучитьЭлемент()=1 Цикл
Если С.ЭтоГруппа()=1 Тогда
Группа=Данные.СоздатьПодчиненныйЭлемент(С.Наименование);
Иначе
Э=Группа.СоздатьПодчиненныйЭлемент("Лицо");
Э.Значение=С.Код;
Э.УстановитьАтрибут("Наименование",С.Наименование);
КонецЕсли;
КонецЦикла;
//запись
Корень.Записать("C:\People.xml");
Предупреждение("ОК");
КонецПроцедуры

Управление MS Outlook из 1С

Код

//создать новое сообщение из 1С в MS Outlook
Процедура Письмо_Создать()
//приложение
Попытка
Оле=CreateObject("Outlook.Application");
ЕстьОшибка=0;
Исключение
Предупреждение("Не удалось создать письмо в MS Outlook!");
ЕстьОшибка=1;
КонецПопытки;
//адрес
Адрес=СокрЛП(Лицо.АдресЭ);
//письмо
Если ЕстьОшибка=0 Тогда
//Outlook
Письмо=Оле.CreateItem(0);
Письмо.Subject=Клиент.Наименование+?(Лицо.Выбран()=0,"",", "+Лицо.Наименование);
Письмо.Body=гЛицо(Лицо);
Если ПустаяСтрока(Адрес)=0 Тогда
Письмо.Recipients.Add(Адрес);
КонецЕсли;
Если ПустаяСтрока(Путь)=0 Тогда
Письмо.Attachments.Add(Путь);
КонецЕсли;
Письмо.Display();
Иначе
//тема
Тема=Клиент.Наименование;
Если Лицо.Выбран()=1 Тогда
Тема=Тема+", "+Лицо.Наименование+"&body="+СокрЛП(Лицо.Имя);
КонецЕсли;
ЗапуститьПриложение("mailto:"+Адрес+"?subject="+Тема);
КонецЕсли;
КонецПроцедуры

//создать запись в календаре событий
Процедура Календарь_Создать()
//приложение
Попытка
Оле=CreateObject("Outlook.Application");
Исключение
Предупреждение("Не удалось создать запись в календаре событий в MS Outlook!");
Возврат;
КонецПопытки;
//задача
Задача=Оле.CreateItem(1);
Задача.Subject="Название встречи";
Задача.Start="01.11.2007 15:00:00";
Задача.End="01.11.2007 16:00:00";
Задача.Body="Описание встречи";
Задача.Location="Место встречи";
Задача.ReminderMinutesBeforeStart=30;
Задача.BusyStatus=0;
Задача.MeetingStatus=0;
Задача.Sensitivity=2;
Задача.Save();
КонецПроцедуры

//создать новую задачу из 1С в MS Outlook
Процедура Задача_Создать()
//приложение
Попытка
Оле=CreateObject("Outlook.Application");
Исключение
Предупреждение("Не удалось создать задачу в MS Outlook!");
Возврат;
КонецПопытки;
//задача
Задача=Оле.CreateItem(3);
Задача.Subject=Клиент.Наименование;
Задача.StartDate=ДатаДок+Константа.Фирма.ПериодСобытие;
Задача.Display();
Если Лицо.Выбран()=1 Тогда
Задача.Body=
""+Лицо.Наименование+"
|"+гЛицо(Лицо)+"
|"+СокрЛП(Лицо.Должность)+"
|моб. "+СокрЛП(Лицо.ТелефонМ)+"
|гор. "+СокрЛП(Лицо.ТелефонГ);
КонецЕсли;
КонецПроцедуры
Запустить из 1С страницу Интернет, отправить электронное почтовое сообщение

//создание почтового сообщения в ассоциированном почтовом клиенте с заданным электронным адресом
Процедура гКнопкаПочта(Значение) Экспорт
Если ПустаяСтрока(Значение)=0 Тогда
ЗапуститьПриложение("mailto:"+СокрЛП(Значение));
КонецЕсли;
КонецПроцедуры

//открытие страницы Интернет по заданному адресу в ассоциированном Интернет-браузере
Процедура гКнопкаИнтернет(Значение) Экспорт
Если ПустаяСтрока(Значение)=0 Тогда
ЗапуститьПриложение(СокрЛП(Значение));
КонецЕсли;
КонецПроцедуры

Давайте определимся с номенклатурой. Поле - это ячейка в таблице. Запись - набор из полей. Так вот, существуют разные типы полей - обычные, индексные и ключевые. Обычные поля - просто данные. Индексное поле - поле, по которому данные сортируются. Ключевое - поле, значение которого уникально. В общем-то четкого разделения нет. Ведь программа базы данных может сортировать таблицу и по обычным полям, а индексное поле может быть также уникальным.

В BDE достаточно логично поределена структура построения полей и их типов. Для этого имеются классы TxxxDef (три икса здесь обозначают подстановку, а то мало ли что Вы подумаете ;)), произведенные ото абстрактного базового класса TNamedItem. В компоненте TTable имеются и соответствующие свойства

TIndexDefs
TFieldDefs

Как и следовало предполагать, эти свойства содержат в себе определения индексных и обычных полей. Здесь нет свойства типа TKeyDefs, потому что в таблицах типа Парадокс индексные поля могут быть сами по себе уникальны. За счет этих свойств и задаются параметры таблицы, ее сетка. Создание таблицы довершает метод CreateTable.

Теории было много, теперь практика. Вот пример, честно скажу, взятый их Хелпа и перекомментированный автором (то есть мной).

Код

if (!Table1->Exists) // Don't overwrite an existing table
{
Table1->Active = false; // Компонент TTable должен быть отключен.

// Опишем параметры таблицы.
Table1->DatabaseName = "BCDEMOS";//это по желанию
Table1->TableType = ttParadox; //как обычно, Парадокс.
Table1->TableName = "CustInfo";//имя создаваемой таблицы.

// Опишем поля и их типы.
Table1->FieldDefs->Clear();
TFieldDef *pNewDef = Table1->FieldDefs->AddFieldDef();
pNewDef->Name = "Field1";// имя, обычной строкой.
pNewDef->DataType = ftInteger;//то, о чем я говорил.
//установим, является ли поле обязательным
pNewDef->Required = true;
//еще одно поле.
pNewDef = Table1->FieldDefs->AddFieldDef();
pNewDef->Name = "Field2";
pNewDef->DataType = ftString;
//определим размер поля.
pNewDef->Size = 30;
// Теперь взялись за индексы
Table1->IndexDefs->Clear();
/* Первый индекс безымянный, поскольку это основной индекс Парадокса. */
Table1->IndexDefs->Add("","Field1", TIndexOptions() <<ixPrimary << ixUnique);
Table1->IndexDefs->Add("Fld2Index","Field2", TIndexOptions() << ixCaseInsensitive);

// Ну и наконец, создаем таблицу.

Table1->CreateTable();

Это все еще объяснять и объяснять. Но, я надеюсь, общая логика понятна.

Может кому пригодится...

---

Описание основных портов

21 – ФТП пртокол, может использоваться если открыт анонимный доступ или стоит кривая версия софта (WU 2.6.0 (1) War FTPd и тд)
23 – Телнет протокол. Используеться для входа в систему с удалённого компьютера. Так же может показать версию ОС.
25 – Протокол для отправки почты, может использоваться в основном когда стоит кривая версия sendmail (самое распространённое) так же имеют место команды EXPN и VRFY которые могут дать взломщику некторую дополнительную информацию.
53 – Показывает установлен ли DNS. Может использоваться для так называемого DNS Spoofing. Т.е. подменой объекта ДНС.
79 – Это Finger. При должном везении и ошибках в программном обеспечении можно получить список всех пользователей залогиненых в систему.
80 – WWW Сервер. показывает присутствует ли WWW сервер на машине. Использовать можно для проверки на ЦГИ скрипты, так же показывает версию и название программного обеспечения установленного на машине.
110 – POP протокол для просмотра почтовых сообщений. Может использоваться при кривой версии ПО как например всем известный QPOP.
111 – Sun RPC. Может использоваться при наличии ответа на команду rpcinfo -d |grep bind - ypbind tcp и тд.
119 – NNTP. Проткол для чтения и отправки новостей в новостные группы, используеться так же при наличии ошибок в ПО
139 – NETBIOS. Пртокол для работы с локальной сетью. Может использовать для сканирования на расшаренные ресурсы и получение информации о сети.
443 – HTTPS, SSL. Тоже самое что и HTTP но использует безопасный протокол.
513 – rlogin. Если у хоста есть запись в файле .rlogin то вы коннектитесь на удалённый хост без использования логина и пароля.
Описание всех портов

1=TCP-MUX - TCP Port Service Multiplexer
2=COMPRESSNET - Management Utility
3=COMPRESSNET - Compression Process
5=RJE - Remote Job Entry
7=ECHO - Echo
9=DISCARD - Discard
11=SYSSTAT - System Status
13=DAYTIME - Daytime
15=NETSTAT - Network Status
17=QOTD - Quote of the Day
18=MSP - Message Send Protocol
19=CHARGEN - Character Generator
20=FTP-DATA - File Transfer Protocol [Default Data]
21=FTP - File Transfer Protocol [Control]
22=SSH - SSH (Secure Shell) Remote Login Protocol
23=TELNET - Telnet
24=PMS - Private Mail System
25=SMTP - Simple Mail Transfer Protocol
27=NSW-FE - NSW User System FE
29=MSG-ICP - Messege ICP
31=MSG-AUTH - Messege Authentication
33=DSP - Display Support Protocol
35=PPS - Private Printer Server
37=TIME - Time
38=RAP - Route Access Protocol
39=RLP - Resource Location Protocol
41=GRAPHICS - Graphics
42=NAMESERVER - Host Name Server
43=WHOIS - Who Is
44=MPM-FLAGS - MPM FLAGS Protocol
45=MPM - Message Processing Module [recv]
46=MPM-SND - MPM [default send]
47=NI-FTP - NI FTP (File Transfer Protocol)
48=AUDITD - Digital Audit Daemon
49=BBN-LOGIN - Login Host Protocol (TACACS)
50=RE-MAIL-CK - Remote Mail Checking Protocol
51=LA-MAINT - IMP Logical Address Maintenance
52=XNS-TIME - XNS Time Protocol
53=DOMAIN - Domain Name Server
54=XNS-CH - XNS Clearinghouse
55=ISI-GL - ISI Graphics Language
56=XNS-AUTH - XNS Authentication
57=MTP - Private terminal access
58=XNS-MAIL - XNS Mail
59=PFS - Private File System
60=Unassigned
61=NI-MAIL - NI MAIL
62=ACAS - ACA Services
63=WHOIS++ - whois++
64=COVIA - Communications Integrator (CI)
65=TACACS-DS - TACACS-Database Service
66=SQL*NET - Oracle SQL*NET
67=BOOTPS - Bootstrap Protocol Server
68=BOOTPC - Bootstrap Protocol Client
69=TFTP - Trivial File Transfer Protocol
70=GOPHER - Gopher
71=NETRJS-1 - Remote Job Service
72=NETRJS-2 - Remote Job Service
73=NETRJS-3 - Remote Job Service
74=NETRJS-4 - Remote Job Service
75=PDOS - Private dial out service
76=DEOS - Distributed External Object Store
77=RJE - Private RJE (Remote Job Entry) service
78=VETTCP - vettcp
79=FINGER - Finger
80=WWW-HTTP - World Wide Web HTTP (Hyper Text Transfer Protocol)
81=HOSTS2-NS - HOSTS2 Name Server
82=XFER - XFER Utility
83=MIT-ML-DEV - MIT ML Device
84=CTF - Common Trace Facility
85=MIT-ML-DEV - MIT ML Device
86=MFCOBOL - Micro Focus Cobol
87=LINK - Private terminal link
88=KERBEROS - Kerberos
89=SU-MIT-TG - SU/MIT Telnet Gateway
90=DNSIX - DNSIX Securit Attribute Token Map
91=MIT-DOV - MIT Dover Spooler
92=NPP - Network Printing Protocol
93=DCP - Device Control Protocol
94=OBJCALL - Tivoli Object Dispatcher
95=SUPDUP - SUPDUP
96=DIXIE - DIXIE Protocol Specification
97=SWIFT-RVF - Swift Remote Virtural File Protocol
98=TACNEWS - TAC News
99=METAGRAM - Metagram Relay
100=NEWACCT - [unauthorized use]
101=HOSTNAMES - NIC Host Name Server
102=ISO-TSAP - ISO-TSAP Class 0
103=X400 - x400
104=X400-SND - x400-snd
105=CSNET-NS - Mailbox Name Nameserver
106=3COM-TSMUX - 3COM-TSMUX
107=RTELNET - Remote Telnet Service
108=SNAGAS - SNA Gateway Access Server
109=POP - Post Office Protocol - Version 2
110=POP3 - Post Office Protocol - Version 3
111=SUNRPC - SUN Remote Procedure Call
112=MCIDAS - McIDAS Data Transmission Protocol
113=IDENT - Authentication Service
114=AUDIONEWS - Audio News Multicast
115=SFTP - Simple File Transfer Protocol
116=ANSANOTIFY - ANSA REX Notify
117=UUCP-PATH - UUCP Path Service
118=SQLSERV - SQL Services
119=NNTP - Network News Transfer Protocol
120=CFDPTKT - CFDPTKT
121=ERPC - Encore Expedited Remote Pro.Call
122=SMAKYNET - SMAKYNET
123=NTP - Network Time Protocol
124=ANSATRADER - ANSA REX Trader
125=LOCUS-MAP - Locus PC-Interface Net Map Ser
126=UNITARY - Unisys Unitary Login
127=LOCUS-CON - Locus PC-Interface Conn Server
128=GSS-XLICEN - GSS X License Verification
129=PWDGEN - Password Generator Protocol
130=CISCO-FNA - cisco FNATIVE
131=CISCO-TNA - cisco TNATIVE
132=CISCO-SYS - cisco SYSMAINT
133=STATSRV - Statistics Service
134=INGRES-NET - INGRES-NET Service
135=RPC-LOCATOR - RPC (Remote Procedure Call) Location Service
136=PROFILE - PROFILE Naming System
137=NETBIOS-NS - NETBIOS Name Service
138=NETBIOS-DGM - NETBIOS Datagram Service
139=NETBIOS-SSN - NETBIOS Session Service
140=EMFIS-DATA - EMFIS Data Service
141=EMFIS-CNTL - EMFIS Control Service
142=BL-IDM - Britton-Lee IDM
143=IMAP - Interim Mail Access Protocol v2
144=NEWS - NewS
145=UAAC - UAAC Protocol
146=ISO-TP0 - ISO-IP0
147=ISO-IP - ISO-IP
148=CRONUS - CRONUS-SUPPORT
149=AED-512 - AED 512 Emulation Service
150=SQL-NET - SQL-NET
151=HEMS - HEMS
152=BFTP - Background File Transfer Program
153=SGMP - SGMP
154=NETSC-PROD - NETSC
155=NETSC-DEV - NETSC
156=SQLSRV - SQL Service
157=KNET-CMP - KNET/VM Command/Message Protocol
158=PCMAIL-SRV - PCMail Server
159=NSS-ROUTING - NSS-Routing
160=SGMP-TRAPS - SGMP-TRAPS
161=SNMP - SNMP (Simple Network Management Protocol)
162=SNMPTRAP - SNMPTRAP (Simple Network Management Protocol)
163=CMIP-MAN - CMIP/TCP Manager
164=CMIP-AGENT - CMIP/TCP Agent
165=XNS-COURIER - Xerox
166=S-NET - Sirius Systems
167=NAMP - NAMP
168=RSVD - RSVD
169=SEND - SEND
170=PRINT-SRV - Network PostScript
171=MULTIPLEX - Network Innovations Multiplex
172=CL/1 - Network Innovations CL/1
173=XYPLEX-MUX - Xyplex
174=MAILQ - MAILQ
175=VMNET - VMNET
176=GENRAD-MUX - GENRAD-MUX
177=XDMCP - X Display Manager Control Protocol
178=NEXTSTEP - NextStep Window Server
179=BGP - Border Gateway Protocol
180=RIS - Intergraph
181=UNIFY - Unify
182=AUDIT - Unisys Audit SITP
183=OCBINDER - OCBinder
184=OCSERVER - OCServer
185=REMOTE-KIS - Remote-KIS
186=KIS - KIS Protocol
187=ACI - Application Communication Interface
188=MUMPS - Plus Five's MUMPS
189=QFT - Queued File Transport
190=GACP - Gateway Access Control Protocol
191=PROSPERO - Prospero Directory Service
192=OSU-NMS - OSU Network Monitoring System
193=SRMP - Spider Remote Monitoring Protocol
194=IRC - Internet Relay Chat Protocol
195=DN6-NLM-AUD - DNSIX Network Level Module Audit
196=DN6-SMM-RED - DNSIX Session Mgt Module Audit Redir
197=DLS - Directory Location Service
198=DLS-MON - Directory Location Service Monitor
199=SMUX - SMUX
200=SRC - IBM System Resource Controller
201=AT-RTMP - AppleTalk Routing Maintenance
202=AT-NBP - AppleTalk Name Binding
203=AT-3 - AppleTalk Unused
204=AT-ECHO - AppleTalk Echo
205=AT-5 - AppleTalk Unused
206=AT-ZIS - AppleTalk Zone Information
207=AT-7 - AppleTalk Unused
208=AT-8 - AppleTalk Unused
209=QMTP - The Quick Mail Transfer Protocol
210=Z39.50 - ANSI Z39.50
211=914C/G - Texas Instruments 914C/G Terminal
212=ANET - ATEXSSTR
213=IPX - IPX
214=VMPWSCS - VM PWSCS
215=SOFTPC - Insignia Solutions
216=CAILIC - Computer Associates Int'l License Server
217=DBASE - dBASE Unix
218=MPP - Netix Message Posting Protocol
219=UARPS - Unisys ARPs
220=IMAP3 - Interactive Mail Access Protocol v3
221=FLN-SPX - Berkeley rlogind with SPX auth
222=RSH-SPX - Berkeley rshd with SPX auth
223=CDC - Certificate Distribution Center
242=DIRECT -
243=SUR-MEAS - Survey Measurement
244=DAYNA -
245=LINK - LINK
246=DSP3270 - Display Systems Protocol
247=SUBNTBCST_TFTP -
248=BHFHS -
256=RAP -
257=SET - Secure Electronic Transaction
258=YAK-CHAT - Yak Winsock Personal Chat
259=ESRO-GEN - Efficient Short Remote Operations
260=OPENPORT -
261=NSIIOPS - IIOP Name Service Over TLS/SSL
262=ARCISDMS -
263=HDAP -
264=BGMP -
280=HTTP-MGMT -
281=PERSONAL-LINK -
282=CABLEPORT-AX - Cable Port A/X
308=NOVASTORBAKCUP - Novastor Backup
309=ENTRUSTTIME -
310=BHMDS -
311=ASIP-WEBADMIN - Appleshare IP Webadmin
312=VSLMP -
313=MAGENTA-LOGIC -
314=OPALIS-ROBOT -
315=DPSI -
316=DECAUTH -
317=ZANNET -
321=PIP -
344=PDAP - Prospero Data Access Protocol
345=PAWSERV - Perf Analysis Workbench
346=ZSERV - Zebra server
347=FATSERV - Fatmen Server
348=CSI-SGWP - Cabletron Management Protocol
349=MFTP -
350=MATIP-TYPE-A - MATIP Type A
351=MATIP-TYPE-B - MATIP Type B or bhoetty
352=DTAG-STE-SB - DTAG, or bhoedap4
353=NDSAUTH -
354=BH611 -
355=DATEX-ASN -
356=CLOANTO-NET-1 - Cloanto Net 1
357=BHEVENT -
358=SHRINKWRAP -
359=TENEBRIS_NTS - Tenebris Network Trace Service
360=SCOI2ODIALOG -
361=SEMANTIX -
362=SRSSEND - SRS Send
363=RSVP_TUNNEL -
364=AURORA-CMGR -
365=DTK - Deception Tool Kit
366=ODMR -
367=MORTGAGEWARE -
368=QBIKGDP -
369=RPC2PORTMAP -
370=CODAAUTH2 -
371=CLEARCASE - Clearcase
372=ULISTSERV - Unix Listserv
373=LEGENT-1 - Legent Corporation
374=LEGENT-2 - Legent Corporation
375=HASSLE - Hassle
376=NIP - Amiga Envoy Network Inquiry Proto
377=TNETOS - NEC Corporation
378=DSETOS - NEC Corporation
379=IS99C - TIA/EIA/IS-99 modem client
380=IS99S - TIA/EIA/IS-99 modem server
381=HP-COLLECTOR - HP Performance Data Collector
382=HP-MANAGED-NODE - HP Performance Data Managed Node
383=HP-ALARM-MGR - HP Performance Data Alarm Manager
384=ARNS - A Remote Network Server System
385=IBM-APP - IBM Application 386=ASA - ASA Message Router Object Def.
387=AURP - Appletalk Update-Based Routing Pro.
388=UNIDATA-LDM - Unidata LDM Version 4
389=LDAP - Lightweight Directory Access Protocol
390=UIS - UIS
391=SYNOTICS-RELAY - SynOptics SNMP Relay Port
392=SYNOTICS-BROKER - SynOptics Port Broker Port
393=DIS - Data Interpretation System
394=EMBL-NDT - EMBL Nucleic Data Transfer
395=NETCP - NETscout Control Protocol
396=NETWARE-IP - Novell Netware over IP
397=MPTN - Multi Protocol Trans. Net.
398=KRYPTOLAN - Kryptolan
399=ISO-TSAP-C2 - ISO Transport Class 2 Non-Control over TCP
400=WORK-SOL - Workstation Solutions
401=UPS - Uninterruptible Power Supply
402=GENIE - Genie Protocol
403=DECAP - decap
404=NCED - nced
405=NCLD - ncld
406=IMSP - Interactive Mail Support Protocol
407=TIMBUKTU - Timbuktu
408=PRM-SM - Prospero Resource Manager Sys. Man.
409=PRM-NM - Prospero Resource Manager Node Man.
410=DECLADEBUG - DECLadebug Remote Debug Protocol
411=RMT - Remote MT Protocol
412=SYNOPTICS-TRAP - Trap Convention Port
413=SMSP - SMSP
414=INFOSEEK - InfoSeek
415=BNET - BNet
416=SILVERPLATTER - Silverplatter
417=ONMUX - Onmux
418=HYPER-G - Hyper-G
419=ARIEL1 - Ariel
420=SMPTE - SMPTE
421=ARIEL2 - Ariel
422=ARIEL3 - Ariel
423=OPC-JOB-START - IBM Operations Planning and Control Start
424=OPC-JOB-TRACK - IBM Operations Planning and Control Track
425=ICAD-EL - ICAD
426=SMARTSDP - smartsdp
427=SVRLOC - Server Location
428=OCS_CMU - OCS_CMU
429=OCS_AMU - OCS_AMU
430=UTMPSD - UTMPSD
431=UTMPCD - UTMPCD
432=IASD - IASD
433=NNSP - NNSP
434=MOBILEIP-AGENT - MobileIP-Agent
435=MOBILIP-MN - MobilIP-MN
436=DNA-CML - DNA-CML
437=COMSCM - comscm
438=DSFGW - dsfgw
439=DASP - dasp
440=SGCP - sgcp
441=DECVMS-SYSMGT - decvms-sysmgt
442=CVC_HOSTD - cvc_hostd
443=HTTPS - HTTPS (Hyper Text Transfer Protocol Secure) - SSL (Secure
Socket Layer)
444=SNPP - Simple Network Paging Protocol
445=MICROSOFT-DS - Microsoft-DS
446=DDM-RDB - DDM-RDB
447=DDM-DFM - DDM-RFM
448=DDM-BYTE - DDM-BYTE
449=AS-SERVERMAP - AS Server Mapper
450=TSERVER - TServer
451=SFS-SMP-NET - Cray Network Semaphore server
452=SFS-CONFIG - Cray SFS config server
453=CREATIVESERVER - CreativeServer
454=CONTENTSERVER - ContentServer
455=CREATIVEPARTNR - CreativePartnr
456=MACON-TCP - macon-tcp
457=SCOHELP - scohelp
458=APPLEQTC - Apple Quick Time
459=AMPR-RCMD - ampr-rcmd
460=SKRONK - skronk
461=DATASURFSRV - DataRampSrv
462=DATASURFSRVSEC - DataRampSrvSec
463=ALPES - alpes
464=KPASSWD - kpasswd
465=SSMTP - ssmtp
466=DIGITAL-VRC - digital-vrc
467=MYLEX-MAPD - mylex-mapd
468=PHOTURIS - proturis
469=RCP - Radio Control Protocol
470=SCX-PROXY - scx-proxy
471=MONDEX - Mondex
472=LJK-LOGIN - ljk-login
473=HYBRID-POP - hybrid-pop
474=TN-TL-W1 - tn-tl-w1
475=TCPNETHASPSRV - tcpnethaspsrv
476=TN-TL-FD1 - tn-tl-fd1
477=SS7NS - ss7ns
478=SPSC - spsc
479=IAFSERVER - iafserver
480=IAFDBASE - iafdbase
481=PH - Ph service
482=BGS-NSI - bgs-nsi
483=ULPNET - ulpnet
484=INTEGRA-SME - Integra Software Management Environment
485=POWERBURST - Air Soft Power Burst
486=AVIAN - avian
487=SAFT - saft
488=GSS-HTTP - gss-http
489=NEST-PROTOCOL - nest-protocol
490=MICOM-PFS - micom-pfs
491=GO-LOGIN - go-login
492=TICF-1 - Transport Independent Convergence for FNA
493=TICF-2 - Transport Independent Convergence for FNA
494=POV-RAY - POV-Ray
495=INTECOURIER -
496=PIM-RP-DISC -
497=DANTZ -
498=SIAM -
499=ISO-ILL - ISO ILL Protocol
500=ISAKMP -
501=STMF -
502=ASA-APPL-PROTO -
503=INTRINSA -
504=CITADEL -
505=MAILBOX-LM -
506=OHIMSRV -
507=CRS -

[pagebreak]

508=XVTTP -
509=SNARE -
510=FCP - FirstClass Protocol
511=PASSGO -
512=EXEC - Remote Process Execution
513=LOGIN - Remote Login via Telnet;
514=SHELL - Automatic Remote Process Execution
515=PRINTER - Printer Spooler
516=VIDEOTEX -
517=TALK -
518=NTALK -
519=UTIME - Unix Time
520=EFS - Extended File Server
521=RIPNG -
522=ULP -
523=IBM-DB2 -
524=NCP -
525=TIMED - Time Server 526=TEMPO - newdate
527=STX - Stock IXChange
528=CUSTIX - Customer IXChange
529=IRC-SERV -
530=COURIER - rpc
531=CONFERENCE - chat
532=NETNEWS - readnews
533=NETWALL - Emergency Broadcasts
534=MM-ADMIN - MegaMedia Admin
535=IIOP -
536=OPALIS-RDV -
537=NMSP - Networked Media Streaming Protocol
538=GDOMAP -
539=APERTUS-LDP - Apertus Technologies Load Determination
540=UUCP - UUCPD (Unix to Unix Copy)
541=UUCP-RLOGIN - uucp (Unix to Unix Copy) - rlogin (Remote Login)
542=COMMERCE -
543=KLOGIN -
544=KSHELL - krcmd
545=APPLEQTCSRVR - Apple qtcsrvr
546=DHCP-CLIENT - DHCP (Dynamic Host Configuration Protocol) Client
547=DHCP-SERVER - DHCP (Dynamic Host Configuration Protocol) Server
548=AFPOVERTCP - AFP over TCP
549=IDFP -
550=NEW-RWHO - new-who
551=CYBERCASH - CyberCash
552=DEVICESHARE - deviceshare
553=PIRP - pirp
554=RTSP - Real Time Stream Control Protocol
555=DSF -
556=REMOTEFS - rfs (Remote File System) server
557=OPENVMS-SYSIPC - openvms-sysipc
558=SDNSKMP - SDNSKMP
559=TEEDTAP - TEEDTAP
560=RMONITOR - rmonitord
561=MONITOR -
562=CHSHELL - chcmd
563=SNEWS - snews
564=9PFS - plan 9 file service
565=WHOAMI - whoami
566=STREETTALK - streettalk
567=BANYAN-RPC - banyan-rpc
568=MS-SHUTTLE - Microsoft Shuttle
569=MS-ROME - Microsoft Rome
570=METER - demon
571=METER - udemon
572=SONAR - sonar
573=BANYAN-VIP - banyan-vip
574=FTP-AGENT - FTP Software Agent System
575=VEMMI - VEMMI
576=IPCD -
577=VNAS -
578=IPDD -
579=DECBSRV -
580=SNTP-HEARTBEAT -
581=BDP - Bundle Discovery Protocol
582=SCC-SECURITY -
583=PHILIPS-VC - PHilips Video-Conferencing
584=KEYSERVER -
585=IMAP4-SSL - IMAP4+SSL
586=PASSWORD-CHG -
587=SUBMISSION -
588=CAL -
589=EYELINK -
590=TNS-CML -
591=HTTP-ALT - FileMaker, Inc. - HTTP Alternate
592=EUDORA-SET -
593=HTTP-RPC-EPMAP - HTTP RPC Ep Map
594=TPIP -
595=CAB-PROTOCOL -
596=SMSD -
597=PTCNAMESERVICE - PTC Name Service
598=SCO-WEBSRVRMG3 - SCO Web Server Manager 3
599=ACP - Aeolon Core Protocol
600=IPCSERVER - Sun IPC server
606=URM - Cray Unified Resource Manager
607=NQS - nqs
608=SIFT-UFT - Sender-Initiated/Unsolicited File Transfer
609=NPMP-TRAP - npmp-trap
610=NPMP-LOCAL - npmp-local
611=NPMP-GUI - npmp-gui
628=QMQP - Qmail Quick Mail Queueing
633=SERVSTAT - Service Status update (Sterling Software)
634=GINAD - ginad
635=MOUNT - NFS Mount Service
636=LDAPSSL - LDAP Over SSL
640=PCNFS - PC-NFS DOS Authentication
650=BWNFS - BW-NFS DOS Authentication
666=DOOM - doom Id Software
674=PORT
704=ELCSD - errlog copy/server daemon
709=ENTRUSTMANAGER - EntrustManager
729=NETVIEWDM1 - IBM NetView DM/6000 Server/Client
730=NETVIEWDM2 - IBM NetView DM/6000 send/tcp
731=NETVIEWDM3 - IBM NetView DM/6000 receive/tcp
737=SOMETIMES-RPC2 - Rusersd on my OpenBSD Box
740=NETCP - NETscout Control Protocol
741=NETGW - netGW
742=NETRCS - Network based Rev. Cont. Sys.
744=FLEXLM - Flexible License Manager
747=FUJITSU-DEV - Fujitsu Device Control
748=RIS-CM - Russell Info Sci Calendar Manager
749=KERBEROS-ADM - kerberos administration
750=KERBEROS-SEC -
751=KERBEROS_MASTER -
752=QRH -
753=RRH -
754=KBR5_PROP -
758=NLOGIN -
759=CON -
760=NS -
761=RXE -
762=QUOTAD -
763=CYCLESERV -
764=OMSERV -
765=WEBSTER -
767=PHONEBOOK - phone
769=VID -
770=CADLOCK -
771=RTIP -
772=CYCLESERV2 -
773=SUBMIT -
774=RPASSWD -
775=ENTOMB -
776=WPAGES -
780=WPGS -
781=HP-COLLECTOR - HP Performance Data Collector
782=HP-MANAGED-NODE - HP Performance Data Managed Node
783=HP-ALARM-MGR - HP Performance Data Alarm Manager
786=CONCERT - Concert
799=CONTROLIT -
800=MDBS_DAEMON -
801=DEVICE -
808=PORT
871=SUPFILESRV = SUP Server
888=CDDATABASE - CDDataBase
901=PORT
911=Dark Shadow
989=FTPS-DATA - FTP Over TLS/SSL
990=FTP Control TLS/SSL
992=TELNETS - telnet protocol over TLS/SSL
993=IMAPS - Imap4 protocol over TLS/SSL
995=POP3S - Pop3 (Post Office Protocol) over TLS/SSL
996=VSINET - vsinet
997=MAITRD -
998=BUSBOY -
999=PUPROUTER -
1000=CADLOCK -
1001=Silence
1008=UFSD - UFSD
1010=Doly-Trojan
1011=Doly-Trojan
1012=Doly-Trojan
1015=Doly-Trojan
1023=RESERVED - Reserved
1024=OLD_FINGER - old_finger
1025=LISTEN - listen
1026=NTERM - nterm
1027=NT
1028=NT
1029=NT
1030=IAD1 - BBN IAD
1031=IAD2 - BBN IAD
1032=IAD3 - BBN IAD
1033=NT
1034=NT
1035=NT
1036=NT
1037=NT
1038=NT
1039=NT
1040=NT
1041=NT
1042=Bla
1043=NT
1044=NT
1045=Rasmin
1046=NT
1047=NT
1048=NT
1049=NT
1058=NIM - nim
1059=NIMREG - nimreg
1067=INSTL_BOOTS - Installation Bootstrap Proto. Serv.
1068=INSTL_BOOTC - Installation Bootstrap Proto. Cli.
1080=SOCKS - Socks
1083=ANSOFT-LM-1 - Anasoft License Manager
1084=ANSOFT-LM-2 - Anasoft License Manager
1090=Xtreme
1103=XAUDIO - Xaserver
1109=KPOP - kpop
1110=NFSD-STATUS - Cluster Status Info
1112=MSQL - Mini-SQL Server
1127=SUPFILEDBG - SUP Debugging
1155=NFA - Network File Access
1167=PHONE - Conference Calling
1170=Psyber Stream Server, Streaming Audio trojan, Voice
1178=SKKSERV - SKK (Kanji Input)
1212=LUPA - lupa
1222=NERV - SNI R&D network
1234=Ultors Trojan
1241=MSG - Remote Message Server
1243=BackDoor-G, SubSeven, SubSeven Apocalypse
1245=Voodoo Doll
1248=HERMES - Multi Media Conferencing
1269=Mavericks Matrix
1330=PORT
1346=ALTA-ANA-LM - Alta Analytics License Manager
1347=BBN-MMC - Multi Media Conferencing
1348=BBN-MMX - Multi Media Conferencing
1349=SBOOK - Registration Network Protocol
1350=EDITBENCH - Registration Network Protocol
1351=EQUATIONBUILDER - Digital Tool Works (MIT)
1352=LOTUSNOTE - Lotus Note
1353=RELIEF - Relief Consulting
1354=RIGHTBRAIN - RightBrain Software
1355=INTUITIVE EDGE - Intuitive Edge
1356=CUILLAMARTIN - CuillaMartin Company
1357=PEGBOARD - Electronic PegBoard
1358=CONNLCLI - CONNLCLI
1359=FTSRV - FTSRV
1360=MIMER - MIMER
1361=LINX - LinX
1362=TIMEFLIES - TimeFlies
1363=NDM-REQUESTER - Network DataMover Requester
1364=NDM-SERVER - Network DataMover Server
1365=ADAPT-SNA - Network Software Associates
1366=NETWARE-CSP - Novell NetWare Comm Service Platform
1367=DCS - DCS
1368=SCREENCAST - ScreenCast
1369=GV-US - GlobalView to Unix Shell
1370=US-GV - Unix Shell to GlobalView
1371=FC-CLI - Fujitsu Config Protocol
1372=FC-SER - Fujitsu Config Protocol
1373=CHROMAGRAFX - Chromagrafx
1374=MOLLY - EPI Software Systems
1375=BYTEX - Bytex
1376=IBM-PPS - IBM Person to Person Software
1377=CICHLID - Cichlid License Manager
1378=ELAN - Elan License Manager
1379=DBREPORTER - Integrity Solutions
1380=TELESIS-LICMAN - Telesis Network License Manager
1381=APPLE-LICMAN - Apple Network License Manager
1382=UDT_OS -
1383=GWHA - GW Hannaway Network License Manager
1384=OS-LICMAN - Objective Solutions License Manager
1385=ATEX_ELMD - Atex Publishing License Manager
1386=CHECKSUM - CheckSum License Manager
1387=CADSI-LM - Computer Aided Design Software Inc LM
1388=OBJECTIVE-DBC - Objective Solutions DataBase Cache
1389=ICLPV-DM - Document Manager
1390=ICLPV-SC - Storage Controller
1391=ICLPV-SAS - Storage Access Server
1392=ICLPV-PM - Print Manager
1393=ICLPV-NLS - Network Log Server
1394=ICLPV-NLC - Network Log Client
1395=ICLPV-WSM - PC Workstation Manager software
1396=DVL-ACTIVEMAIL - DVL Active Mail
1397=AUDIO-ACTIVMAIL - Audio Active Mail
1398=VIDEO-ACTIVMAIL - Video Active Mail
1399=CADKEY-LICMAN - Cadkey License Manager
1400=CADKEY-TABLET - Cadkey Tablet Daemon
1401=GOLDLEAF-LICMAN - Goldleaf License Manager
1402=PRM-SM-NP - Prospero Resource Manager
1403=PRM-NM-NP - Prospero Resource Manager
1404=IGI-LM - Infinite Graphics License Manager
1405=IBM-RES - IBM Remote Execution Starter
1406=NETLABS-LM - NetLabs License Manager
1407=DBSA-LM - DBSA License Manager
1408=SOPHIA-LM - Sophia License Manager
1409=HERE-LM - Here License Manager
1410=HIQ - HiQ License Manager
1411=AF - AudioFile
1412=INNOSYS - InnoSys
1413=INNOSYS-ACL - Innosys-ACL
1414=IBM-MQSERIES - IBM MQSeries
1415=DBSTAR - DBStar
1416=NOVELL-LU6.2 - Novell LU6.2
1417=TIMBUKTU-SRV1 - Timbuktu Service 1 Port
1418=TIMBUKTU-SRV2 - Timbuktu Service 2 Port
1419=TIMBUKTU-SRV3 - Timbuktu Service 3 Port
1420=TIMBUKTU-SRV4 - Timbuktu Service 4 Port
1421=GANDALF-LM - Gandalf License Manager
1422=AUTODESK-LM - Autodesk License Manager
1423=ESSBASE - Essbase Arbor Software
1424=HYBRID - Hybrid Encryption Protocol
1425=ZION-LM - Zion Software License Manager
1426=SAIS - Satellite-data Acquisition System 1
1427=MLOADD - mloadd monitoring tool
1428=INFORMATIK-LM - Informatik License Manager
1429=NMS - Hypercom NMS
1430=TPDU - Hypercom TPDU
1431=RGTP - Reverse Gossip Transport
1432=BLUEBERRY-LM - Blueberry Software License Manager
1433=MS-SQL-S - Microsoft-SQL-Server
1434=MS-SQL-M - Microsoft-SQL-Monitor
1435=IBM-CICS - IBM CICS
1436=SAISM - Satellite-data Acquisition System 2
1437=TABULA - Tabula
1438=EICON-SERVER - Eicon Security Agent/Server
1439=EICON-X25 - Eicon X25/SNA Gateway
1440=EICON-SLP - Eicon Service Location Protocol
1441=CADIS-1 - Cadis License Management
1442=CADIS-2 - Cadis License Management
1443=IES-LM - Integrated Engineering Software
1444=MARCAM-LM - Marcam License Management
1445=PROXIMA-LM - Proxima License Manager
1446=ORA-LM - Optical Research Associates License Manager
1447=APRI-LM - Applied Parallel Research LM
1448=OC-LM - OpenConnect License Manager
1449=PEPORT - PEport
1450=DWF - Tandem Distributed Workbench Facility
1451=INFOMAN - IBM Information Management
1452=GTEGSC-LM - GTE Government Systems License Man
1453=GENIE-LM - Genie License Manager
1454=INTERHDL_ELMD - interHDL License Manager
1455=ESL-LM - ESL License Manager
1456=DCA - DCA
1457=VALISYS-LM - Valisys License Manager
1458=NRCABQ-LM - Nichols Research Corp.
1459=PROSHARE1 - Proshare Notebook Application
1460=PROSHARE2 - Proshare Notebook Application
1461=IBM_WRLESS_LAN - IBM Wireless LAN
1462=WORLD-LM - World License Manager
1463=NUCLEUS - Nucleus
1464=MSL_LMD - MSL License Manager
1465=PIPES - Pipes Platform
1466=OCEANSOFT-LM - Ocean Software License Manager
1467=CSDMBASE - CSDMBASE
1468=CSDM - CSDM
1469=AAL-LM - Active Analysis Limited License Manager
1470=UAIACT - Universal Analytics
1471=CSDMBASE - csdmbase
1472=CSDM - csdm
1473=OPENMATH - OpenMath
1474=TELEFINDER - Telefinder
1475=TALIGENT-LM - Taligent License Manager
1476=CLVM-CFG - clvm-cfg
1477=MS-SNA-SERVER - ms-sna-server
1478=MS-SNA-BASE - ms-sna-base
1479=DBEREGISTER - dberegister
1480=PACERFORUM - PacerForum
1481=AIRS - AIRS
1482=MITEKSYS-LM - Miteksys License Manager
1483=AFS - AFS License Manager
1484=CONFLUENT - Confluent License Manager
1485=LANSOURCE - LANSource
1486=NMS_TOPO_SERV - nms_topo_serv
1487=LOCALINFOSRVR - LocalInfoSrvr
1488=DOCSTOR - DocStor
1489=DMDOCBROKER - dmdocbroker
1490=INSITU-CONF - insitu-conf
1491=ANYNETGATEWAY - anynetgateway
1492=STONE-DESIGN-1 - stone-design-1
1493=NETMAP_LM - netmap_lm
1494=ICA - ica
1495=CVC - cvc
1496=LIBERTY-LM - liberty-lm
1497=RFX-LM - rfx-lm
1498=WATCOM-SQL - Watcom-SQL
1499=FHC - Federico Heinz Consultora
1500=VLSI-LM - VLSI License Manager
1501=SAISCM - Satellite-data Acquisition System 3
1502=SHIVADISCOVERY - Shiva
1503=IMTC-MCS - Databeam
1504=EVB-ELM - EVB Software Engineering License Manager 1505=FUNKPROXY - Funk Software Inc.
1506=UTCD - Universal Time daemon (utcd)
1507=SYMPLEX - symplex
1508=DIAGMOND - diagmond
1509=ROBCAD-LM - Robcad Ltd. License Manager
1510=MVX-LM - Midland Valley Exploration Ltd. Lic. Man.
1511=3L-L1 - 3l-l1
1512=WINS - Microsoft's Windows Internet Name Service
1513=FUJITSU-DTC - Fujitsu Systems Business of America Inc
1514=FUJITSU-DTCNS - Fujitsu Systems Business of America Inc
1515=IFOR-PROTOCOL - ifor-protocol
1516=VPAD - Virtual Places Audio data
1517=VPAC - Virtual Places Audio control
1518=VPVD - Virtual Places Video data
1519=VPVC - Virtual Places Video control
1520=ATM-ZIP-OFFICE - atm zip office
1521=NCUBE-LM - nCube License Manager
1522=RNA-LM - Ricardo North America License Manager
1523=CICHILD-LM - cichild
1524=INGRESLOCK - ingres
1525=PROSPERO-NP - Prospero Directory Service non-priv
1526=PDAP-NP - Prospero Data Access Prot non-priv
1527=TLISRV - oracle
1528=MCIAUTOREG - micautoreg
1529=COAUTHOR - oracle
1530=RAP-SERVICE - rap-service
1531=RAP-LISTEN - rap-listen
1532=MIROCONNECT - miroconnect
1533=VIRTUAL-PLACES - Virtual Places Software
1534=MICROMUSE-LM - micromuse-lm
1535=AMPR-INFO - ampr-info
1536=AMPR-INTER - ampr-inter
1537=SDSC-LM - isi-lm
1538=3DS-LM - 3ds-lm
1539=INTELLISTOR-LM - Intellistor License Manager
1540=RDS - rds
1541=RDS2 - rds2
1542=GRIDGEN-ELMD - gridgen-elmd
1543=SIMBA-CS - simba-cs
1544=ASPECLMD - aspeclmd
1545=VISTIUM-SHARE - vistium-share
1546=ABBACCURAY - abbaccuray
1547=LAPLINK - laplink
1548=AXON-LM - Axon License Manager
1549=SHIVAHOSE - Shiva Hose
1550=3M-IMAGE-LM - Image Storage license manager 3M Company
1551=HECMTL-DB - HECMTL-DB
1552=PCIARRAY - pciarray
1553=SNA-CS - sna-cs
1554=CACI-LM - CACI Products Company License Manager
1555=LIVELAN - livelan
1556=ASHWIN - AshWin CI Tecnologies
1557=ARBORTEXT-LM - ArborText License Manager
1558=XINGMPEG - xingmpeg
1559=WEB2HOST - web2host
1560=ASCI-VAL - asci-val
1561=FACILITYVIEW - facilityview
1562=PCONNECTMGR - pconnectmgr
1563=CADABRA-LM - Cadabra License Manager
1564=PAY-PER-VIEW - Pay-Per-View
1565=WINDDLB - WinDD
1566=CORELVIDEO - CORELVIDEO
1567=JLICELMD - jlicelmd
1568=TSSPMAP - tsspmap
1569=ETS - ets
1570=ORBIXD - orbixd
1571=RDB-DBS-DISP - Oracle Remote Data Base
1572=CHIP-LM - Chipcom License Manager
1573=ITSCOMM-NS - itscomm-ns
1574=MVEL-LM - mvel-lm
1575=ORACLENAMES - oraclenames
1576=MOLDFLOW-LM - moldflow-lm
1577=HYPERCUBE-LM - hypercube-lm
1578=JACOBUS-LM - Jacobus License Manager
1579=IOC-SEA-LM - ioc-sea-lm
1580=TN-TL-R1 - tn-tl-r1
1581=VMF-MSG-PORT - vmf-msg-port
1582=TAMS-LM - Toshiba America Medical Systems
1583=SIMBAEXPRESS - simbaexpress
1584=TN-TL-FD2 - tn-tl-fd2
1585=INTV - intv
1586=IBM-ABTACT - ibm-abtact
1587=PRA_ELMD - pra_elmd
1588=TRIQUEST-LM - triquest-lm
1589=VQP - VQP
1590=GEMINI-LM - gemini-lm
1591=NCPM-PM - ncpm-pm
1592=COMMONSPACE - commonspace
1593=MAINSOFT-LM - mainsoft-lm
1594=SIXTRAK - sixtrak
1595=RADIO - radio
1596=RADIO-SM - radio-sm
1597=ORBPLUS-IIOP - orbplus-iiop
1598=PICKNFS - picknfs
1599=SIMBASERVICES - simbaservices
1600=ISSD -
1601=AAS - aas
1602=INSPECT - inspect
1603=PICODBC - pickodbc
1604=ICABROWSER - icabrowser
1605=SLP - Salutation Manager (Salutation Protocol)
1606=SLM-API - Salutation Manager (SLM-API)
1607=STT - stt
1608=SMART-LM - Smart Corp. License Manager
1609=ISYSG-LM - isysg-lm
1610=TAURUS-WH - taurus-wh
1611=ILL - Inter Library Loan
1612=NETBILL-TRANS - NetBill Transaction Server
1613=NETBILL-KEYREP - NetBill Key Repository
1614=NETBILL-CRED - NetBill Credential Server
1615=NETBILL-AUTH - NetBill Authorization Server
1616=NETBILL-PROD - NetBill Product Server
1617=NIMROD-AGENT - Nimrod Inter-Agent Communication
1618=SKYTELNET - skytelne
1619=XS-OPENBACKUP - xs-openbackup
1620=FAXPORTWINPORT - faxportwinport
1621=SOFTDATAPHONE - softdataphone
1622=ONTIME - ontime
1623=JALEOSND - jaleosnd
1624=UDP-SR-PORT - udp-sr-port
1625=SVS-OMAGENT - svs-omagent
1636=CNCP - CableNet Control Protocol
1637=CNAP - CableNet Admin Protocol
1638=CNIP - CableNet Info Protocol
1639=CERT-INITIATOR - cert-initiator
1640=CERT-RESPONDER - cert-responder
1641=INVISION - InVision
1642=ISIS-AM - isis-am
1643=ISIS-AMBC - isis-ambc
1644=SAISEH - Satellite-data Acquisition System 4
1645=DATAMETRICS - datametrics
1646=SA-MSG-PORT - sa-msg-port
1647=RSAP - rsap
1648=CONCURRENT-LM - concurrent-lm
1649=INSPECT - inspect
1650=NKD -
1651=SHIVA_CONFSRVR - shiva_confsrvr
1652=XNMP - xnmp
1653=ALPHATECH-LM - alphatech-lm
1654=STARGATEALERTS - stargatealerts
1655=DEC-MBADMIN - dec-mbadmin
1656=DEC-MBADMIN-H - dec-mbadmin-h 1657=FUJITSU-MMPDC - fujitsu-mmpdc
1658=SIXNETUDR - sixnetudr
1659=SG-LM - Silicon Grail License Manager
1660=SKIP-MC-GIKREQ - skip-mc-gikreq
1661=NETVIEW-AIX-1 - netview-aix-1
1662=NETVIEW-AIX-2 - netview-aix-2
1663=NETVIEW-AIX-3 - netview-aix-3
1664=NETVIEW-AIX-4 - netview-aix-4
1665=NETVIEW-AIX-5 - netview-aix-5
1666=NETVIEW-AIX-6 - netview-aix-6
1667=NETVIEW-AIX-7 - netview-aix-7
1668=NETVIEW-AIX-8 - netview-aix-8
1669=NETVIEW-AIX-9 - netview-aix-9
1670=NETVIEW-AIX-10 - netview-aix-10
1671=NETVIEW-AIX-11 - netview-aix-11
1672=NETVIEW-AIX-12 - netview-aix-12
1673=PROSHARE-MC-1 - Intel Proshare Multicast
1674=PROSHARE-MC-2 - Intel Proshare Multicast
1675=PDP - Pacific Data Products
1676=NEFCOMM1 - netcomm1
1677=GROUPWISE - groupwise
1723=PPTP - pptp
1807=SpySender
1812=RADIUS - RADIUS Authentication Protocol
1813=RADACCT - RADIUS Accounting Protocol
1827=PCM - PCM Agent
1981=Shockrave
1986=LICENSEDAEMON - cisco license management
1987=TR-RSRB-P1 - cisco RSRB Priority 1 port
1988=TR-RSRB-P2 - cisco RSRB Priority 2 port
1989=MSHNET - MHSnet system
1990=STUN-P1 - cisco STUN Priority 1 port
1991=STUN-P2 - cisco STUN Priority 2 port
1992=IPSENDMSG - IPsendmsg
1993=SNMP-TCP-PORT - cisco SNMP TCP port
1994=STUN-PORT - cisco serial tunnel port
1995=PERF-PORT - cisco perf port
1996=TR-RSRB-PORT - cisco Remote SRB port
1997=GDP-PORT - cisco Gateway Discovery Protocol
1998=X25-SVC-PORT - cisco X.25 service (XOT)
1999=TCP-ID-PORT - cisco identification port
2000=CALLBOOK -
2001=DC -
2002=GLOBE -
2003=CFINGER - cfinger
2004=MAILBOX -
2005=BERKNET -
2006=INVOKATOR -
2007=DECTALK -
2008=CONF -
2009=NEWS -
2010=SEARCH -
2011=RAID-CC - raid
2012=TTYINFO -
2013=RAID-AM -
2014=TROFF -
2015=CYPRESS -
2016=BOOTSERVER -
2017=CYPRESS-STAT -
2018=TERMINALDB -
2019=WHOSOCKAMI -
2020=XINUPAGESERVER -
2021=SERVEXEC -
2022=DOWN -
2023=XINUEXPANSION3 -
2024=XINUEXPANSION4 -
2025=ELLPACK -
2026=SCRABBLE -
2027=SHADOWSERVER -
2028=SUBMITSERVER -
2030=DEVICE2 -
2032=BLACKBOARD -
2033=GLOGGER -
2034=SCOREMGR -
2035=IMSLDOC -
2038=OBJECTMANAGER -
2040=LAM -
2041=INTERBASE -
2042=ISIS - isis
2043=ISIS-BCAST - isis-bcast
2044=RIMSL -
2045=CDFUNC -
2046=SDFUNC -
2047=DLS -
2048=DLS-MONITOR - dls-monitor
2064=DISTRIB-NETASSHOLES - A group of lamers working on a closed-source
client for solving the RSA cryptographic challenge

[pagebreak]

2065=DLSRPN - Data Link Switch Read Port Number
2067=DLSWPN - Data Link Switch Write Port Number
2080=Wingate Winsock Redirector Service
2103=ZEPHYR-CLT - Zephyr Serv-HM Conncetion
2104=Zephyr Host Manager
2105=EKLOGIN - Kerberos (v4) Encrypted RLogin
2106=EKSHELL - Kerberos (v4) Encrypted RShell
2108=RKINIT - Kerberos (v4) Remote Initialization
2111=KX - X Over Kerberos
2112=KIP - IP Over Kerberos
2115=Bugs
2120=KAUTH - Remote kauth
2140=Deep Throat, The Invasor
2155=Illusion Mailer
2201=ATS - Advanced Training System Program
2221=UNREG-AB1 - Allen-Bradley unregistered port
2222=UNREG-AB2 - Allen-Bradley unregistered port
2223=INREG-AB3 - Allen-Bradley unregistered port
2232=IVS-VIDEO - IVS Video default
2241=IVSD - IVS Daemon
2283=HVL Rat5
2301=CIM - Compaq Insight Manager
2307=PEHELP - pehelp
2401=CVSPSERVER - CVS Network Server
2430=VENUS -
2431=VENUS-SE -
2432=CODASRV -
2433=CODASRV-SE -
2500=RTSSERV - Resource Tracking system server
2501=RTSCLIENT - Resource Tracking system client
2564=HP-3000-TELNET - HP 3000 NS/VT block mode telnet
2565=Striker
2583=WinCrash
2592=NETREK[GAME] - netrek[game]
2600=Digital Rootbeer
2601=ZEBRA - Zebra VTY
2602=RIPD - RIPd VTY
2603=RIPNGD - RIPngd VTY
2604=OSPFD - OSPFd VTY
2605=BGPD - BGPd VTY
2627=WEBSTER -
2638=Sybase Database
2700=TQDATA - tqdata
2766=LISTEN - System V Listener Port
2784=WWW-DEV - world wide web - development
2800=Phineas Phucker
2989=(UDP) - RAT
3000=UNKNOWN - Unknown Service
3001=NESSUSD - Nessus Security Scanner
3005=DESLOGIN - Encrypted Symmetric Telnet
3006=DESLOGIND -
3024=WinCrash
3049=NSWS -
3064=DISTRIB-NET-PROXY - Stupid closed source distrib.net proxy
3086=SJ3 - SJ3 (Kanji Input)
3128=RingZero -
3129=Masters Paradise -
3130=SQUID-IPC -
3141=VMODEM - VMODEM
3150=Deep Throat, The Invasor
3155=HTTP Proxy
3264=CCMAIL - cc:mail/lotus
3295=PORT
3306=MYSQL
3333=DEC-NOTES - DEC Notes
3421=BMAP - Bull Apprise portmapper
3454=MIRA - Apple Remote Access Protocol
3455=PRSVP - RSVP Port
3456=VAT - VAT default data
3457=VAT-CONTROL - VAT default control
3459=Eclipse 2000
3700=Portal of Doom
3791=Eclypse
3801=(UDP) - Eclypse
3871=PORT
3900=UDT_OS - Unidata UDT OS
3905=PORT
3908=PORT
3920=PORT
3921=PORT
3922=PORT
3923=PORT
3925=PORT
3975=PORT
3984=MAPPER-NODEMGR - MAPPER network node manager
3985=MAPPER-MAPETHD - MAPPER TCP/IP server
3986=MAPPER-WS_ETHD - MAPPER workstation server
3996=PORT
4000=UNKNOWN - Unknown Service
4001=PORT
4008=NETCHEQUE - NetCheque accounting
4045=LOCKD - NFS Lock Daemon
4092=WinCrash
4132=NUTS_DEM - NUTS Daemon
4133=NUTS_BOOTP - NUTS Bootp Server
4321=RWHOIS - Remote Who Is
4333=MSQL - Mini SQL Server
4343=UNICALL - UNICALL
4444=NV-VIDEO - NV Video default
4500=SAE-URN - sae-urn
4501=URN-X-CDCHOICE - urn-x-cdchoice
4557=FAX - fax
4559=HYLAFAX - HylaFAX cli-svr Protocol
4567=File Nail
4590=ICQTrojan
4672=RFA - remote file access server
4899=RAdmin - Remote Administrator
5000=UNKNOWN - Unknown Service
5001=COMMPLEX-LINK -
5002=RFE - radio free ethernet
5003=CLARIS-FMPRO - Claris FileMaker Pro
5004=AVT-PROFILE-1 - avt-profile-1
5005=AVT-PROFILE-2 - avt-profile-2
5010=TELELPATHSTART - TelepathStart
5011=TELELPATHATTACK - TelepathAttack
5031=NetMetro
5050=MMCC - multimedia conference control tool
5075=IISADMIN = IIS Administration Web Site
5145=RMONITOR_SECURE -
5190=AOL - America-Online
5191=AOL-1 - AmericaOnline1
5192=AOL-2 - AmericaOnline2
5193=AOL-3 - AmericaOnline3
5232=SGI-DGL - SGI Distributed Graphics
5236=PADL2SIM
5300=HACL-HB - HA Cluster Heartbeat
5301=HACL-GS - HA Cluster General Services
5302=HACL-CFG - HA Cluster Configuration
5303=HACL-PROBE - HA Cluster Probing
5304=HACL-LOCAL
5305=HACL-TEST
5308=CFENGINE -
5321=Firehotcker
5376=MS FTP
5400=Blade Runner, Back Construction
5401=Blade Runner, Back Construction
5402=Blade Runner, Back Construction
5432=POSTGRES - Postgres Database Server
5500=Hotline Server
5510=SECUREIDPROP - ACE/Server Services
5512=Illusion Maker
5520=SDLOG - ACE/Server Services
5530=SDSERV - ACE/Server Services
5540=SDXAUTHD - ACE/Server Services
5550=Xtcp
5555=ServeMe
5556=Bo
5557=Bo
5569=Robo-Hack
5631=PCANYWHEREDATA -
5632=PCANYWHERESTAT -
5650=MS FTP PORT
5680=CANNA - Canna (Jap Input)
5713=PROSHAREAUDIO - proshare conf audio
5714=PROSHAREVIDEO - proshare conf video
5715=PROSHAREDATA - proshare conf data
5716=PROSHAREREQUEST - proshare conf request
5717=PROSHARENOTIFY - proshare conf notify
5742=WinCrash
5800=VNC - Virtual Network Computing
5801=VNC - Virtual Network Computing
5858=NETREK[GAME] - netrek[game]
5900=VNC - Virtual Network Computing
5901=VNC-1 - Virtual Network Computing Display
5902=VNC-2 - Virtual Network Computing Display
5977=NCD-PREF-TCP - NCD Preferences
5978=NCD-DIAG-TCP - NCD Diagnostics
5979=NCD-CONF-TCP - NCD Configuration
5997=NCD-PREF - NCD Preferences Telnet
5998=NCD-DIAG - NCD Diagnostics Telnet
5999=NCD-CONF - NCD Configuration Telnet
6000=X11 - X Window System
6001=X11:1 - X Window Server
6002=X11:2 - X Window Server
6003=X11:3 - X Window Server
6004=X11:4 - X Window Server
6005=X11:5 - X Window Server
6006=X11:6 - X Window Server
6007=X11:7 - X Window Server
6008=X11:8 - X Window Server
6009=X11:9 - X Window Server
6110=SOFTCM - HP SoftBench CM
6111=SPC - HP SoftBench Sub-Process Control
6112=DTSPCD - dtspcd
6141=META-CORP - Meta Corporation License Manager
6142=ASPENTEC-LM - Aspen Technology License Manager
6143=WATERSHED-LM - Watershed License Manager
6144=STATSCI1-LM - StatSci License Manager - 1
6145=STATSCI2-LM - StatSci License Manager - 2
6146=LONEWOLF-LM - Lone Wolf Systems License Manager
6147=MONTAGE-LM - Montage License Manager
6148=RICARDO-LM - Ricardo North America License Manager
6149=TAL-POD - tal-pod
6400=The Thing
6455=SKIP-CERT-RECV - SKIP Certificate Receive
6456=SKIP-CERT-SEND - SKIP Certificate Send
6558=XDSXDM -
6660=IRC-SERV - irc-serv
6661=IRC-SERV - irc-serv
6662=IRC-SERV - irc-serv
6663=IRC-SERV - irc-serv
6664=IRC-SERV - irc-serv
6665=IRC-SERV - irc-serv
6666=IRC-SERV - irc-serv
6667=IRC - irc
6668=IRC - irc
6669=Vampyre
6670=DeepThroat
6671=IRC-SERV - irc-serv
6771=DeepThroat
6776=BackDoor-G, SubSeven
6912=flowers Heep
6939=Indoctrination
6969=ACMSODA - acmsoda
6970=GateCrasher, Priority, IRC 3
7000=AFSSERV - file server itself
7001=UNKNOWN - Unknown Service
7002=UNKNOWN - Unknown Service
7003=AFS3-VLSERVER - volume location database
7004=AFS3-KASERVER - AFS/Kerberos authentication service
7005=AFS3-VOLSER - volume managment server
7006=AFS3-ERRORS - error interpretation service
7007=AFS3-BOS - basic overseer process
7008=AFS3-UPDATE - server-to-server updater
7009=AFS3-RMTSYS - remote cache manager service
7010=UPS-ONLINET - onlinet uninterruptable power supplies
7100=FONT-SERVICE - X Font Service
7120=IISADMIN = IIS Administration Web Site
7121=VIRPROT-LM - Virtual Prototypes License Manager
7200=FODMS - FODMS FLIP
7201=DLIP - DLIP
7300=NetMonitor
7301=NetMonitor
7306=NetMonitor
7307=NetMonitor
7308=NetMonitor
7309=NetMonitor
7326=ICB - Internet Citizen's Band
7648=CUCME-1 - CucMe live video/Audio Server
7649=CUCME-2 - CucMe live video/Audio Server
7650=CUCME-3 - CucMe live video/Audio Server
7651=CUCME-4 - CucMe live video/Audio Server
7770=IRC
7777=CBT - cbt
7789=Back Door Setup, ICKiller
8000=Generic - Shared service port
8001=Generic - Shared service port
8002=Generic - Shared service port
8003=Generic - Shared service port
8004=Generic - Shared service port
8005=Generic - Shared service port
8006=Generic - Shared service port
8007=Generic - Shared service port
8008=Generic - Shared service port
8009=Generic - Shared service port
8010=Generic - Shared service port
8080=Generic - Shared service port
8081=Generic - Shared service port
8082=Generic - Shared service port
8083=Generic - Shared service port
8084=Generic - Shared service port
8085=Generic - Shared service port
8086=Generic - Shared service port
8087=Generic - Shared service port
8088=Generic - Shared service port
8100=Generic - Shared service port
8101=Generic - Shared service port
8102=Generic - Shared service port
8103=Generic - Shared service port
8104=Generic - Shared service port
8105=Generic - Shared service port
8106=Generic - Shared service port
8107=Generic - Shared service port
8108=Generic - Shared service port
8109=Generic - Shared service port
8110=Generic - Shared service port
8181=Generic - Shared service port
8383=Generic - Shared service port
8450=NPMP - npmp
8765=Ultraseek
8807=DEMOS NNTP
8888=SiteScope - SiteScope Remote Server Monitoring
8892=SEOSLOAD - eTrust ACX
9000=UNKNOWN - Unknown Service
9001=UNKNOWN
9010=SERVICE
9090=ZEUS-ADMIN - Zeus Admin Server
9095=SERVICE
9100=JETDIRECT - HP JetDirect Card
9200=WAP - Wireless Application Protocol
9201=WAP - Wireless Application Protocol
9202=WAP - Wireless Application Protocol
9203=WAP - Wireless Application Protocol
9400=InCommand
9535=MAN -
9872=Portal of Doom
9873=Portal of Doom
9874=Portal of Doom
9875=Portal of Doom
9876=SD - Session Director
9989=iNi-Killer
9998=DEMOS SMTP
9999=DISTINCT - distinct
10005=STEL - Secure Telnet
10067=(UDP) - Portal of Doom
10080=AMANDA - Amanda Backup Util
10082=AMANDA-IDX - Amanda Indexing
10083=AMIDXTAPE - Amanda Tape Indexing
10101=BrainSpy
10167=(UDP) - Portal of Doom
10520=Acid Shivers
10607=Coma
11000=Senna Spy
11223=Progenic trojan
11371=PKSD - PGP Pub. Key Server
12067=Gjamer
12223=Hackґ99 KeyLogger
12345=NB - NetBus
12346=GabanBus, NetBus, X-bill
12361=Whack-a-mole
12362=Whack-a-mole
12631=Whackjob
13000=Senna Spy
13326=CROSSFIRE[GAME] - crossfire[game]
16660=Stacheldraht Master Serverd
16969=Priority
17007=ISODE-DUA -
17300=Kuang2 The Virus
18000=BIIMENU - Beckman Instruments Inc.
20000=Millennium
20001=Millennium backdoor
20005=BTX - Xcept4
20034=Netbus 2 Pro
20203=Logged
21544=Girlfriend
21845=WEBPHONE - webphoned 21846=INFO SERVER - info server
21847=CONNECT SERVER - connect server
22222=Prosiak
22273=WNN6 - Wnn6 (Jap. Input)
22289=WNN6_CN - Wnn6 (Chi. Input)
22305=WNN6_KR - Wnn6 (Kor. Input)
22321=WNN6_TW - Wnn6 (Tai. Input)
23456=Evil FTP, Ugly FTP , Whack Job
23476=Donald Dick
23477=Donald Dick
24326=Netscape Server
25000=ICL-TWOBASE1 - icl-twobase1
25001=ICL-TWOBASE2 - icl-twobase2
25002=ICL-TWOBASE3 - icl-twobase3
25003=ICL-TWOBASE4 - icl-twobase4
25004=ICL-TWOBASE5 - icl-twobase5
25005=ICL-TWOBASE6 - icl-twobase6
25006=ICL-TWOBASE7 - icl-twobase7
25007=ICL-TWOBASE8 - icl-twobase8
25008=ICL-TWOBASE9 - icl-twobase9
25009=ICL-TWOBASE10 - icl-twobase10
26000=QUAKEXX
26001=QUAKEXX
26002=QUAKEXX
26208=WNN6_DS - Wnn6 (Dserver)
26274=(UDP) - Delta Source
27119=QUAKEXX
27444=TRINOO_BCAST - Trinoo Attack Tool
27500=QUAKEXX
27501=QUAKEXX
27502=QUAKEXX
27665=TRINOO_MASTER - Trinoo Attack Tool
27910=QUAKEXX
27911=QUAKEXX
27912=QUAKEXX
27913=QUAKEXX
27920=QUAKEXX
27960=QUAKE3SERVER - Quake 3 Arena Server
29891=(UDP) - The Unexplained
29970=PORT
30029=AOL Trojan
30100=NetSphere
30101=Netsphere
30102=NetSphere
30303=Sockets de Troie
30999=Kuang2
31335=TRINOO_REGISTER - Trinoo Attack Tool
31336=Whack
31337=BO - BackOrifice
31338=NetSpy DK
31457=TETRINET (Tetris GAME)
31666=BO Whack
31785=HackґaґTack
31787=HackґaґTack
31788=HackґaґTack
31789=HackґaґTack (udp)
31791=HackґaґTack (udp)
31792=HackґaґTack
32000=Generic - Shared service port
33333=Prosiak
33911=Spirit 2001a
34324=BigGluck, TN
40193=NetWare
40412=The Spy
40421=Agent 40421, Masters Paradise
40422=Masters Paradise
40423=Masters Paradise
40426=Masters Paradise
43188=REACHOUT -
44333=WinRoute
47262=(UDP) - Delta Source
47557=DBBROWSE - Databeam Corporation
50505=Sockets de Troie
50766=Fore , Schwindler
53001=Remote Window Shutdown
54320=BO 2K
54321=SchoolBus
60000=Deep Throat
61466=TeleCommando
65000=Devil
65301=PCANYWHERE -

Один из примеров создания текстового компонента с трехмерной декоративной контурной рамкой (для создания компонента потребовалось около получаса. Он демонстрирует только принцип получения рамки. Я не стал колдовать над свойствами типа ParentFont..., т.к. это заняло бы еще немало времени и места).

---

Код

unit IDSLabel;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,

ExtCtrls;

type
TIDSLabel = class(TBevel)
private
{ Private declarations }
FAlignment : TAlignment;
FCaption : String;
FFont : TFont;
FOffset : Byte;

FOn : TNotifyEvent;

procedure SetAlignment( taIn : TAlignment );
procedure SetCaption( const strIn : String);
procedure SetFont( fntNew : TFont );
procedure SetOffset( bOffNew : Byte );
protected
{ Protected declarations }
constructor Create( compOwn : TComponent ); override;
destructor Destroy; override;
procedure Paint; override;
public
{ Public declarations }
published
{ Published declarations }
property Alignment : TAlignment read FAlignment write SetAlignment default taLeftJustify;
property Caption : String read FCaption write SetCaption;
property Font : TFont read FFont write SetFont;
property Offset : Byte read FOffset write SetOffset;

property On : TNotifyEvent read FOn write FOn;
end;

implementation

constructor TIDSLabel.Create;
begin

inherited Create(compOwn);

FFont := TFont.Create;
with compOwn as TForm do
FFont.Assign(Font);

Offset := 4;
Height := 15;
end;

destructor TIDSLabel.Destroy;
begin

FFont.Free;

inherited Destroy;
end;

procedure TIDSLabel.Paint;
var

wXPos, wYPos : Word;
begin

{Рисуем рамку}
inherited Paint;

{Назначаем шрифт}
Canvas.Font.Assign(Font);

{Вычисляем вертикальную позицию}
wYPos := (Height - Canvas.TextHeight(Caption)) div 2;

{Вычисляем горизонтальную позицию}
wXPos := Offset;
case Alignment of
taRightJustify: wXPos := Width - Canvas.TextWidth(Caption) - Offset;
taCenter: wXPos := (Width - Canvas.TextWidth(Caption)) div 2;
end;
Canvas.Brush := Parent.Brush;
Canvas.TextOut(wXPos,wYPos,Caption);

end;

procedure TIDSLabel.SetAlignment;
begin

FAlignment := taIn;
Invalidate;
end;

procedure TIDSLabel.SetCaption;
begin
FCaption := strIn;


if Assigned(FOn) then
FOn(Self);


Invalidate;
end;

procedure TIDSLabel.SetFont;
begin

FFont.Assign(fntNew);
Invalidate;
end;

procedure TIDSLabel.SetOffset;
begin

FOffset := bOffNew;
Invalidate;
end;

end.

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

---

Данное решение может быть не самым быстрым, однако на поверку оно оказывается быстрее остальных, обнаруженных мною в Интернете (может вам повезет больше). Более того, представьте, что действительное значение какого-либо поля равно 4.509375354, а значение поиска равно 7, в этом случае утилита засчитает "попадание". Утилита удобна также тем, что она за один проход производит поиск более, чем в одном поле.

Это удобно, если у Вас имеются, к примеру, два поля с адресами. Это моя первая "серьезная" разработка, так как первое, с чем я столкнулся, изучая Delphi, стала необходимость включения процедуры поиска в любое приложение, работающее с базой данных. А так как поиск - вещь тоже сугубо специфическая, как и любое приложение, то мне пришлось побороть свой страх перед "крутым программированием" и попробовать написать свой поисковый механизм, удовлетворивший меня (и, надеюсь, других) своей скоростью и возможностью "мульти"-поиска по нескольким полям.

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

Код

unit Finder;

interface

uses DB, DBTables, SysUtils;

function GrabMemoFieldAsPChar(TheField : TMemoField): PChar;
function DoFindIn(TheField : TField; SFor : String): Boolean;
function FindIt(TheTable : TDataSet; TheFields : array of integer;

SearchBackward : Boolean; Beginning : Boolean; SFor : String): Boolean;
{применение функции FindIt -

if FindIt(NotesSearchT,
[NotesSearchT.FieldByName('Leadman').Index],
False, True, SearchText.Text) then DoSomething; }

implementation

function GrabMemoFieldAsPChar(TheField : TMemoField): PChar;
begin
with TBlobStream.Create(TheField, bmRead) do

begin
GetMem(Result, Size + 1);
FillChar(Result^, Size + 1, #0);
Read(Result^, Size);
Free;
end;
end;

function DoFindIn(TheField : TField; SFor : String): Boolean;
var

PChForMemo : PChar;
begin
Result := False;
case TheField.DataType of

ftString :
begin
if (Pos(SFor, UpperCase(TheField.AsString)) > 0) then
Result := True;
end;
ftInteger :
begin
if (Pos(SFor, TheField.AsString) > 0) then Result := True;
end;
ftBoolean :
begin
if SFor = UpperCase(TheField.AsString) then
Result := True;
end;
ftFloat :
begin
if (Pos(SFor, TheField.AsString) > 0) then Result := True;
end;
ftCurrency :
begin
if (Pos(SFor, TheField.AsString) > 0) then Result := True;
end;
ftDate .. ftDateTime :
begin
if (Pos(SFor, TheField.AsString) > 0) then Result := True;
end;
ftMemo :
begin
SFor[Ord(SFor[0]) + 1] := #0;
PChForMemo := GrabMemoFieldAsPChar(TMemoField(TheField));
StrUpper(PChForMemo);
if not (StrPos( PChForMemo, @SFor[1] ) = nil) then Result :=
True; FreeMem(PChForMemo, StrLen(PChForMemo + 1));
end;
end;
end;

function FindIt(TheTable : TDataSet; TheFields : array of integer;

SearchBackward : Boolean; Beginning : Boolean; SFor : String): Boolean;
var

i, HighTheFields, LowTheFields : integer;
BM : TBookmark;
begin
TheTable.DisableControls;
BM := TheTable.GetBookmark;
try
LowTheFields := Low(TheFields);
HighTheFields := High(TheFields);
SFor := UpperCase(SFor);
Result := False;
if Beginning then TheTable.First;
if SearchBackward then

begin
TheTable.Prior;
while not TheTable.BOF do
begin
for i := LowTheFields to HighTheFields do
begin
if DoFindIn(TheTable.Fields[TheFields[i]], SFor) then
begin
Result := True;
Break;
end;
end;
if Result then Break else TheTable.Prior;
end;
end else
begin
TheTable.Next;
while not TheTable.EOF do
begin
for i := LowTheFields to HighTheFields do
begin
if DoFindIn(TheTable.Fields[TheFields[i]], SFor) then
begin
Result := True;
Break;
end;
end;
if Result then Break else TheTable.Next;
end;
end;
finally
TheTable.EnableControls;
if not Result then

TheTable.GotoBookmark(BM);
TheTable.FreeBookmark(BM);
end;

end;

end.

Интересно, есть ли технология преобразования Wave-формата в обычный набор звуковых данных? К примеру, мне необходимо удалить заголовок и механизм (метод) сжатия, которые могут компилироваться и сохраняться вместе с Wave-файлами.

---

Код

unit LinearSystem;

interface

{============== Тип, описывающий формат WAV ==================}
type WAVHeader = record

nChannels : Word;
nBitsPerSample : LongInt;
nSamplesPerSec : LongInt;
nAvgBytesPerSec : LongInt;
RIFFSize : LongInt;
fmtSize : LongInt;
formatTag : Word;
nBlockAlign : LongInt;
DataSize : LongInt;
end;

{============== Поток данных сэмпла ========================}
const MaxN = 300; { максимальное значение величины сэмпла }
type SampleIndex = 0 .. MaxN+3;
type DataStream = array[ SampleIndex ] of Real;

var N : SampleIndex;

{============== Переменные сопровождения ======================}
type Observation = record

Name : String[40]; {Имя данного сопровождения}
yyy : DataStream; {Массив указателей на данные}
WAV : WAVHeader; {Спецификация WAV для сопровождения}
Last : SampleIndex; {Последний доступный индекс yyy}
MinO, MaxO : Real; {Диапазон значений yyy}
end;

var K0R, K1R, K2R, K3R : Observation;

K0B, K1B, K2B, K3B : Observation;

{================== Переменные имени файла ===================}
var StandardDatabase : String[ 80 ];

BaseFileName : String[ 80 ];
StandardOutput : String[ 80 ];
StandardInput : String[ 80 ];

{=============== Объявления процедур ==================}
procedure ReadWAVFile (var Ki, Kj : Observation);
procedure WriteWAVFile (var Ki, Kj : Observation);
procedure ScaleData (var Kk : Observation);
procedure InitAllSignals;
procedure InitLinearSystem;


implementation
{$R *.DFM}
uses VarGraph, SysUtils;

{================== Стандартный формат WAV-файла ===================}
const MaxDataSize : LongInt = (MaxN+1)*2*2;
const MaxRIFFSize : LongInt = (MaxN+1)*2*2+36;
const StandardWAV : WAVHeader = (

nChannels : Word(2);
nBitsPerSample : LongInt(16);
nSamplesPerSec : LongInt(8000);
nAvgBytesPerSec : LongInt(32000);
RIFFSize : LongInt((MaxN+1)*2*2+36);
fmtSize : LongInt(16);
formatTag : Word(1);
nBlockAlign : LongInt(4);
DataSize : LongInt((MaxN+1)*2*2)
);


{================== Сканирование переменных сопровождения ===================}


procedure ScaleData(var Kk : Observation);
var I : SampleIndex;
begin


{Инициализация переменных сканирования}
Kk.MaxO := Kk.yyy[0];
Kk.MinO := Kk.yyy[0];


{Сканирование для получения максимального и минимального значения}
for I := 1 to Kk.Last do
begin
if Kk.MaxO < Kk.yyy[I] then Kk.MaxO := Kk.yyy[I];
if Kk.MinO > Kk.yyy[I] then Kk.MinO := Kk.yyy[I];
end;
end; { ScaleData }

procedure ScaleAllData;
begin

ScaleData(K0R);
ScaleData(K0B);
ScaleData(K1R);
ScaleData(K1B);
ScaleData(K2R);
ScaleData(K2B);
ScaleData(K3R);
ScaleData(K3B);
end; {ScaleAllData}

{================== Считывание/запись WAV-данных ===================}

VAR InFile, : file of Byte;

type Tag = (F0, T1, M1);
type FudgeNum = record

case X:Tag of
F0 : (chrs : array[0..3] of Byte);
T1 : (lint : LongInt);
M1 : (up,dn: Integer);
end;
var ChunkSize : FudgeNum;

procedure WriteChunkName(Name:String);
var i : Integer;

MM : Byte;
begin

for i := 1 to 4 do
begin
MM := ord(Name[i]);
write(,MM);
end;
end; {WriteChunkName}

procedure WriteChunkSize(LL:Longint);
var I : integer;
begin

ChunkSize.x:=T1;
ChunkSize.lint:=LL;
ChunkSize.x:=F0;
for I := 0 to 3 do Write(,ChunkSize.chrs[I]);
end;

procedure WriteChunkWord(WW:Word);
var I : integer;
begin

ChunkSize.x:=T1;
ChunkSize.up:=WW;
ChunkSize.x:=M1;
for I := 0 to 1 do Write(,ChunkSize.chrs[I]);
end; {WriteChunkWord}

procedure WriteOneDataBlock(var Ki, Kj : Observation);
var I : Integer;
begin

ChunkSize.x:=M1;
with Ki.WAV do
begin
case nChannels of
1:if nBitsPerSample=16
then begin {1..2 Помещаем в буфер одноканальный 16-битный сэмпл}
ChunkSize.up := trunc(Ki.yyy[N]+0.5);
if N<=Ki.Last do WriteOneDataBlock(Ki,Kj); {помещаем 4 байта и увеличиваем счетчик N}


{Освобождаем буфер файла}
CloseFile( );
end; {WriteWAVFile}

procedure InitSpecs;
begin
end; { InitSpecs }

procedure InitSignals(var Kk : Observation);
var J : Integer;
begin

for J := 0 to MaxN do Kk.yyy[J] := 0.0;
Kk.MinO := 0.0;
Kk.MaxO := 0.0;
Kk.Last := MaxN;
end; {InitSignals}

procedure InitAllSignals;
begin
InitSignals(K0R);
InitSignals(K0B);
InitSignals(K1R);
InitSignals(K1B);
InitSignals(K2R);
InitSignals(K2B);
InitSignals(K3R);
InitSignals(K3B);
end; {InitAllSignals}

[pagebreak]

Код

var ChunkName : string[4];

procedure ReadChunkName;
var I : integer;

MM : Byte;
begin

ChunkName[0]:=chr(4);
for I := 1 to 4 do
begin
Read(InFile,MM);
ChunkName[I]:=chr(MM);
end;
end; {ReadChunkName}

procedure ReadChunkSize;
var I : integer;

MM : Byte;
begin

ChunkSize.x := F0;
ChunkSize.lint := 0;
for I := 0 to 3 do
begin
Read(InFile,MM);
ChunkSize.chrs[I]:=MM;
end;
ChunkSize.x := T1;
end; {ReadChunkSize}

procedure ReadOneDataBlock(var Ki,Kj:Observation);
var I : Integer;
begin

if N<=MaxN then
begin
ReadChunkSize; {получаем 4 байта данных}
ChunkSize.x:=M1;
with Ki.WAV do
case nChannels of
1:if nBitsPerSample=16
then begin {1..2 Помещаем в буфер одноканальный 16-битный сэмпл}
Ki.yyy[N] :=1.0*ChunkSize.up;
if N<=MaxN then begin {LastN := N;}
Ki.Last := N;
if Ki.WAV.nChannels=2 then Kj.Last := N;
end
else begin {LastN := MaxN;}
Ki.Last := MaxN;
if Ki.WAV.nChannels=2 then Kj.Last := MaxN;

end;
end;
end; {ReadOneDataBlock}

procedure ReadWAVFile(var Ki, Kj :Observation);
var MM : Byte;

I : Integer;
OK : Boolean;
NoDataYet : Boolean;
DataYet : Boolean;
nDataBytes : LongInt;
begin

if FileExists(StandardInput)
then
with Ki.WAV do
begin { Вызов диалога открытия файла }
OK := True; {если не изменится где-нибудь ниже}
{Приготовления для чтения файла данных}
AssignFile(InFile, StandardInput); { Файл, выбранный в диалоговом окне }
Reset( InFile );


{Считываем ChunkName "RIFF"}
ReadChunkName;
if ChunkName<>'RIFF' then OK := False;


{Считываем ChunkSize}
ReadChunkSize;
RIFFSize := ChunkSize.lint; {должно быть 18,678}


{Считываем ChunkName "WAVE"}
ReadChunkName;
if ChunkName<>'WAVE' then OK := False;


{Считываем ChunkName "fmt_"}
ReadChunkName;
if ChunkName<>'fmt ' then OK := False;


{Считываем ChunkSize}
ReadChunkSize;
fmtSize := ChunkSize.lint; {должно быть 18}


{Считываем formatTag, nChannels}
ReadChunkSize;
ChunkSize.x := M1;
formatTag := ChunkSize.up;
nChannels := ChunkSize.dn;


{Считываем nSamplesPerSec}
ReadChunkSize;
nSamplesPerSec := ChunkSize.lint;


{Считываем nAvgBytesPerSec}
ReadChunkSize;
nAvgBytesPerSec := ChunkSize.lint;


{Считываем nBlockAlign}
ChunkSize.x := F0;
ChunkSize.lint := 0;
for I := 0 to 3 do
begin Read(InFile,MM);
ChunkSize.chrs[I]:=MM;
end;
ChunkSize.x := M1;
nBlockAlign := ChunkSize.up;


{Считываем nBitsPerSample}
nBitsPerSample := ChunkSize.dn;
for I := 17 to fmtSize do Read(InFile,MM);


NoDataYet := True;
while NoDataYet do
begin
{Считываем метку блока данных "data"}
ReadChunkName;


{Считываем DataSize}
ReadChunkSize;
DataSize := ChunkSize.lint;


if ChunkName<>'data' then
begin
for I := 1 to DataSize do {пропуск данных, не относящихся к набору звуковых данных}
Read(InFile,MM);
end
else NoDataYet := False;
end;


nDataBytes := DataSize;
{Наконец, начинаем считывать данные для байтов nDataBytes}
if nDataBytes>0 then DataYet := True;
N:=0; {чтение с первой позиции}
while DataYet do
begin
ReadOneDataBlock(Ki,Kj); {получаем 4 байта}
nDataBytes := nDataBytes-4;
if nDataBytes<=4 then DataYet := False;
end;


ScaleData(Ki);
if Ki.WAV.nChannels=2
then begin Kj.WAV := Ki.WAV;
ScaleData(Kj);
end;
{Освобождаем буфер файла}
CloseFile( InFile );
end
else begin
InitSpecs;{файл не существует}
InitSignals(Ki);{обнуляем массив "Ki"}
InitSignals(Kj);{обнуляем массив "Kj"}
end;
end; { ReadWAVFile }



{================= Операции с набором данных ====================}

const MaxNumberOfDataBaseItems = 360;
type SignalDirectoryIndex = 0 .. MaxNumberOfDataBaseItems;

VAR DataBaseFile : file of Observation;

LastDataBaseItem : LongInt; {Номер текущего элемента набора данных}
ItemNameS : array[SignalDirectoryIndex] of String[40];

procedure GetDatabaseItem( Kk : Observation; N : LongInt );
begin

if N<=LastDataBaseItem
then begin
Seek(DataBaseFile, N);
Read(DataBaseFile, Kk);
end
else InitSignals(Kk);
end; {GetDatabaseItem}
procedure PutDatabaseItem( Kk : Observation; N : LongInt );
begin

if N<=LastDataBaseItem
then begin
Seek(DataBaseFile, N);
Write(DataBaseFile, Kk);
LastDataBaseItem := LastDataBaseItem+1;
end
else while LastDataBaseItem<=N do
begin
Seek(DataBaseFile, LastDataBaseItem);
Write(DataBaseFile, Kk);
LastDataBaseItem := LastDataBaseItem+1;
end
else ReportError(1); {Попытка чтения MaxNumberOfDataBaseItems}
end; {PutDatabaseItem}

procedure InitDataBase;
begin

LastDataBaseItem := 0;
if FileExists(StandardDataBase)
then
begin
Assign(DataBaseFile,StandardDataBase);
Reset(DataBaseFile);
while not EOF(DataBaseFile) do
begin
GetDataBaseItem(K0R, LastDataBaseItem);
ItemNameS[LastDataBaseItem] := K0R.Name;
LastDataBaseItem := LastDataBaseItem+1;
end;
if EOF(DataBaseFile)
then if LastDataBaseItem>0
then LastDataBaseItem := LastDataBaseItem-1;
end;
end; {InitDataBase}

function FindDataBaseName( Nstg : String ):LongInt;
var ThisOne : LongInt;
begin

ThisOne := 0;
FindDataBaseName := -1;
while ThisOne

Данный модуль позволяет читать и записывать файлы формата Unix.

Код

unit StreamFile;

interface

Uses

SysUtils;

Procedure AssignStreamFile (var F : Text ; Filename : String);

implementation

Const

BufferSize = 128;

Type

TStreamBuffer = Array [1..High (Integer)] of Char;
TStreamBufferPointer = ^TStreamBuffer;


TStreamFileRecord = Record
Case Integer Of
1:
(
Filehandle : Integer;
Buffer : TStreamBufferPointer;
BufferOffset : Integer;
ReadCount : Integer;
);
2:
(
Dummy : Array [1 .. 32] Of Char
)
End;


Function StreamFileOpen (var F : TTextRec) : Integer;

Var
Status : Integer;
Begin
With TStreamFileRecord (F.UserData) Do
Begin
GetMem (Buffer, BufferSize);
Case F.Mode Of
fmInput:
FileHandle := FileOpen (StrPas (F.Name), fmShareDenyNone);
fmOutput:
FileHandle := FileCreate (StrPas (F.Name));
fmInOut:
Begin
FileHandle := FileOpen (StrPas (F.Name), fmShareDenyNone Or
fmOpenWrite or fmOpenRead);

If FileHandle <> -1 Then
status := FileSeek (FileHandle, 0, 2); { Перемещаемся в конец файла. }
F.Mode := fmOutput;
End;
End;
BufferOffset := 0;
ReadCount := 0;
F.BufEnd := 0; { В этом месте подразумеваем что мы достигли конца файла (eof). }
If FileHandle = -1 Then
Result := -1
Else
Result := 0;
End;
End;

Function StreamFileInOut (var F : TTextRec) : Integer;

Procedure Read (var Data : TStreamFileRecord);
Procedure CopyData;
Begin
While (F.BufEnd < Sizeof (F.Buffer) - 2)
And (Data.BufferOffset <= Data.ReadCount)
And (Data.Buffer [Data.BufferOffset] <> #10) Do
Begin
F.Buffer [F.BufEnd] := Data.Buffer^ [Data.BufferOffset];
Inc (Data.BufferOffset);
Inc (F.BufEnd);
End;
If Data.Buffer [Data.BufferOffset] = #10 Then
Begin
F.Buffer [F.BufEnd] := #13;
Inc (F.BufEnd);
F.Buffer [F.BufEnd] := #10;
Inc (F.BufEnd);
Inc (Data.BufferOffset);
End;
End;


Begin


F.BufEnd := 0;
F.BufPos := 0;
F.Buffer := '';
Repeat
Begin
If (Data.ReadCount = 0) Or (Data.BufferOffset > Data.ReadCount) Then
Begin
Data.BufferOffset := 1;
Data.ReadCount := FileRead (Data.FileHandle, Data.Buffer^, BufferSize);
End;
CopyData;
End Until (Data.ReadCount = 0)
Or (F.BufEnd >= Sizeof (F.Buffer) - 2);
Result := 0;
End;


Procedure Write (var Data : TStreamFileRecord);
Var
Status : Integer;
Destination : Integer;
II : Integer;
Begin
With TStreamFileRecord (F.UserData) Do
Begin
Destination := 0;
For II := 0 To F.BufPos - 1 Do
Begin
If F.Buffer [II] <> #13 Then
Begin
Inc (Destination);
Buffer^[Destination] := F.Buffer [II];
End;
End;
Status := FileWrite (FileHandle, Buffer^, Destination);
F.BufPos := 0;
Result := 0;
End;
End;
Begin
Case F.Mode Of
fmInput:
Read (TStreamFileRecord (F.UserData));
fmOutput:
Write (TStreamFileRecord (F.UserData));
End;
End;

Function StreamFileFlush (var F : TTextRec) : Integer;

Begin
Result := 0;
End;

Function StreamFileClose (var F : TTextRec) : Integer;

Begin
With TStreamFileRecord (F.UserData) Do
Begin
FreeMem (Buffer);
FileClose (FileHandle);
End;
Result := 0;
End;

Procedure AssignStreamFile (var F : Text ; Filename : String);

Begin
With TTextRec (F) Do
Begin
Mode := fmClosed;
BufPtr := @Buffer;
BufSize := Sizeof (Buffer);
OpenFunc := @StreamFileOpen;
InOutFunc := @StreamFileInOut;
FlushFunc := @StreamFileFlush;
CloseFunc := @StreamFileClose;
StrPLCopy (Name, FileName, Sizeof(Name) - 1);
End;
End;
end.