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

Набор компонентов, формы различных видов. В комплекте идут 14 штук, тут вам и звезда и треугольник и форма сообщение вообщем форм хватает.

Установка: тестировалось на 7 версии delphi никаких проблем.

Virus Warning! С этим сообщением, хоть раз в жизни, сталкивался любой пользователь компьютера. Вирмейкеры с упорством плодят все новые и новые разновидности вирусов. Бытует мнение, что избавиться от них можно лишь с помощью сложных и дорогостоящих новейших антивирусных программ. Это не совсем верно - знание принципов действия и способ внедрения вирусов поможет вовремя их обнаружить и локализовать, даже если под рукой не окажется подходящей антивирусной `вакцины`. В этой книге вы найдете обширный материал,посвященный проблеме защиты информации, рассмотренной с обеих сторон баррикад (как от лица вирмейкера, так и создателя антивирусов).

Для воспроизведения видео в Delphi есть компонент TMediaPlayer. Но как быть если необходимо воспроизвести флэш-ролик? Оказывается в Delphi можно воспроизвести Flash ролики. Как же это сделать?

Для начала необходимо импортировать компонент ActiveX: для этого в главном меню выберите Component -> Immport ActiveX Control... Появляется окно. Найдите и выделите в списке Shockwave Flash (Version 1.0). Можно выбрать вкладку на панели инструментов - раздел Palette page. Не будем менять. Нажмите Install... Появится еще одно окно, в котором вам нужно будет выбрать в какой пакет будет установлен компонент. Нажмите ОК. Появится окно с подтверждением. Нажмите YES. И, наконец, появляется сообщение об успешной установке. Нажмите ОК. На экране остается еще одно окно - "Package - dclusr.dpk". Закройте его и подтвердите сохранение.

Компонент установили. Он появится во вкладке ActiveX на панели инструментов.

Для того, чтобы понять как с ним работать напишим простейший плеер. Выложите на форму: TShockwaveFlash(для удобства назовите его просто Flash1), TTrackBar, TOpenDialog, TTimer и 3 кнопки TButton. Измените Caption кнопок на "Открыть", "Воспроизведение", "Стоп".

Изменим следующие свойства OpenDialog'a:
Свойство Filter измените на Флэш-ролики|*.swf;
Свойство DefaultExt на *.swf;

У Timer1 установите свойство Interval на 1.

Теперь напишем обработчик события OnClick для кнопки, которая будет вызывать OpenDialog. Это кнопка с Caption="Открыть":

Код

procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
Flash1.Movie := OpenDialog1.FileName; // укажем путь к файлу
TrackBar1.Max := Flash1.TotalFrames; // установим длинну ролика
end;
end;

По клику на кнопку "Воспроизведение" будем выполнять следующий код:

Код

procedure TForm1.Button2Click(Sender: TObject);
begin
Flash1.Play; // Воспроизвести
end;

А по клику на кнопку "Стоп" будем выполнять следующий код:

Код

procedure TForm1.Button3Click(Sender: TObject);
begin
Flash1.Stop; // Останавливаем воспроизведение
end;

И осталось еще автоматически двигать TrackBar. Для этого и нужен таймер.

Код

procedure TForm1.Timer1Timer(Sender: TObject);
begin
TrackBar1.Position:=Flash1.CurrentFrame;
end;

Вот и все. Полный код программы:

Код

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, ShockwaveFlashObjects_TLB, ComCtrls,
ExtCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
OpenDialog1: TOpenDialog;
TrackBar1: TTrackBar;
Timer1: TTimer;
Flash1: TShockwaveFlash;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
Flash1.Movie := OpenDialog1.FileName;
TrackBar1.Max := Flash1.TotalFrames;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Flash1.Play;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Flash1.Stop;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
TrackBar1.Position:=Flash1.CurrentFrame;
end;

end.

Данная статья предназначена для начинающих программистов, которые никогда не работали с потоками, и хотели бы узнать основы работы с ними. Желательно, чтоб читатель знал основы ООП и имел какой-нибудь опыт работы в Delphi.

Для начала давайте определимся, что под словом "поток" я подразумеваю именно Thread, который еще имеет название "нить". Нередко встречал на форумах мнения, что потоки не нужны вообще, любую программу можно написать так, что она будет замечательно работать и без них. Конечно, если не делать ничего серьёзней "Hello World" это так и есть, но если постепенно набирать опыт, рано или поздно любой начинающий программист упрётся в возможности "плоского" кода, возникнет необходимость распараллелить задачи. А некоторые задачи вообще нельзя реализовать без использования потоков, например работа с сокетами, COM-портом, длительное ожидание каких-либо событий, и т.д.

Всем известно, что Windows система многозадачная. Попросту говоря, это означает, что несколько программ могут работать одновременно под управлением ОС. Все мы открывали диспетчер задач и видели список процессов. Процесс - это экземпляр выполняемого приложения. На самом деле сам по себе он ничего не выполняет, он создаётся при запуске приложения, содержит в себе служебную информацию, через которую система с ним работает, так же ему выделяется необходимая память под код и данные. Для того, чтобы программа заработала, в нём создаётся поток. Любой процесс содержит в себе хотя бы один поток, и именно он отвечает за выполнение кода и получает на это процессорное время. Этим и достигается мнимая параллельность работы программ, или, как её еще называют, псевдопараллельность. Почему мнимая? Да потому, что реально процессор в каждый момент времени может выполнять только один участок кода. Windows раздаёт процессорное время всем потокам в системе по очереди, тем самым создаётся впечатление, что они работают одновременно. Реально работающие параллельно потоки могут быть только на машинах с двумя и более процессорами.

Для создания дополнительных потоков в Delphi существует базовый класс TThread, от него мы и будем наследоваться при реализации своих потоков. Для того, чтобы создать "скелет" нового класса, можно выбрать в меню File - New - Thread Object, Delphi создаст новый модуль с заготовкой этого класса. Я же для наглядности опишу его в модуле формы. Как видите, в этой заготовке добавлен один метод - Execute. Именно его нам и нужно переопределить, код внутри него и будет работать в отдельном потоке. И так, попробуем написать пример - запустим в потоке бесконечный цикл:

Код

TNewThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
end;


var
Form1: TForm1;

implementation

{$R *.dfm}

{ TNewThread }

procedure TNewThread.Execute;
begin
while true do {ничего не делаем};
end;

procedure TForm1.Button1Click(Sender: TObject);
var
NewThread: TNewThread;
begin
NewThread:=TNewThread.Create(true);
NewThread.FreeOnTerminate:=true;
NewThread.Priority:=tpLower;
NewThread.Resume;
end;

Запустите пример на выполнение и нажмите кнопку. Вроде ничего не происходит - форма не зависла, реагирует на перемещения. На самом деле это не так - откройте диспетчер задач и вы увидите, что процессор загружен по-полной. Сейчас в процессе вашего приложения работает два потока - один был создан изначально, при запуске приложения. Второй, который так грузит процессор - мы создали по нажатию кнопки. Итак, давайте разберём, что же означает код в Button1Click:

Код

NewThread:=TNewThread.Create(true);

тут мы создали экземпляр класса TNewThread. Конструктор Create имеет всего один параметр - CreateSuspended типа boolean, который указывает, запустить новый поток сразу после создания (если false), или дождаться команды (если true).

Код

New.FreeOnTerminate := true;

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

Код

NewThread.Priority:=tpLower;

Свойство Priority, если вы еще не догадались из названия, устанавливает приоритет потока. Да да, каждый поток в системе имеет свой приоритет. Если процессорного времени не хватает, система начинает распределять его согласно приоритетам потоков. Свойство Priority может принимать следующие значения:

tpTimeCritical - критический

tpHighest - очень высокий

tpHigher - высокий

tpNormal - средний

tpLower - низкий

tpLowest - очень низкий

tpIdle - поток работает во время простоя системы

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

Код

NewThread.Resume;

Ну и собственно, запуск потока.

Думаю, теперь вам понятно, как создаются потоки. Заметьте, ничего сложного. Но не всё так просто. Казалось бы - пишем любой код внутри метода Execute и всё, а нет, потоки имеют одно неприятное свойство - они ничего не знают друг о друге. И что такого? - спросите вы. А вот что: допустим, вы пытаетесь из другого потока изменить свойство какого-нибудь компонента на форме. Как известно, VCL однопоточна, весь код внутри приложения выполняется последовательно. Допустим, в процессе работы изменились какие-то данные внутри классов VCL, система отбирает время у основного потока, передаёт по кругу остальным потокам и возвращает обратно, при этом выполнение кода продолжается с того места, где приостановилось. Если мы из своего потока что-то меняем, к примеру, на форме, задействуется много механизмов внутри VCL (напомню, выполнение основного потока пока "приостановлено"), соответственно за это время успеют измениться какие-либо данные. И тут вдруг время снова отдаётся основному потоку, он спокойно продолжает своё выполнение, но данные уже изменены! К чему это может привести - предугадать нельзя. Вы можете проверить это тысячу раз, и ничего не произойдёт, а на тысяча первый программа рухнет. И это относится не только к взаимодействию дополнительных потоков с главным, но и к взаимодействию потоков между собой. Писать такие ненадёжные программы конечно нельзя.
Синхронизации потоков
Если вы создали шаблон класса автоматически, то, наверное, заметили комментарий, который дружелюбная Delphi поместила в новый модуль. Он гласит: "Methods and properties of objects in visual components can only be used in a method called using Synchronize". Это значит, что обращение к визуальным компонентам возможно только путём вызова процедуры Synchronize. Давайте рассмотрим пример, но теперь наш поток не будет разогревать процессор впустую, а будет делать что-нибудь полезное, к примеру, прокручивать ProgressBar на форме. В качестве параметра в процедуру Synchronize передаётся метод нашего потока, но сам он передаётся без параметров. Параметры можно передать, добавив поля нужного типа в описание нашего класса. У нас будет одно поле - тот самый прогресс:

Код

TNewThread = class(TThread)
private
Progress: integer;
procedure SetProgress;
protected
procedure Execute; override;
end;
...

procedure TNewThread.Execute;
var
i: integer;
begin
for i:=0 to 100 do
begin
sleep(50);
Progress:=i;
Synchronize(SetProgress);
end;
end;

procedure TNewThread.SetProgress;
begin
Form1.ProgressBar1.Position:=Progress;
end;

Вот теперь ProgressBar двигается, и это вполне безопасно. А безопасно вот почему: процедура Synchronize на время приостанавливает выполнение нашего потока, и передаёт управление главному потоку, т.е. SetProgress выполняется в главном потоке. Это нужно запомнить, потому что некоторые допускают ошибки, выполняя внутри Synchronize длительную работу, при этом, что очевидно, форма зависает на длительное время. Поэтому используйте Synchronize для вывода информации - то самое двигание прогресса, обновления заголовков компонентов и т.д.

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

Надеюсь, вы поняли как работает Synchronize. Но есть еще один довольно удобный способ передать информацию форме - посылка сообщения. Давайте рассмотрим и его. Для этого объявим константу:

Код

const
PROGRESS_POS = WM_USER+1;

В объявление класса формы добавим новый метод, а затем и его реализацию:

Код

TForm1 = class(TForm)
Button1: TButton;
ProgressBar1: TProgressBar;
procedure Button1Click(Sender: TObject);
private
procedure SetProgressPos(var Msg: TMessage); message PROGRESS_POS;
public
{ Public declarations }
end;
...

procedure TForm1.SetProgressPos(var Msg: TMessage);
begin
ProgressBar1.Position:=Msg.LParam;
end;

Теперь мы немного изменим, можно сказать даже упростим, реализацию метода Execute нашего потока:

procedure TNewThread.Execute;
var
i: integer;
begin
for i:=0 to 100 do
begin
sleep(50);
SendMessage(Form1.Handle,PROGRESS_POS,0,i);
end;
end;

Используя функцию SendMessage, мы посылаем окну приложения сообщение, один из параметров которого содержит нужный нам прогресс. Сообщение становится в очередь, и согласно этой очереди будет обработано главным потоком, где и выполнится метод SetProgressPos. Но тут есть один нюанс: SendMessage, как и в случае с Synchronize, приостановит выполнение нашего потока, пока основной поток не обработает сообщение. Если использовать PostMessage этого не произойдёт, наш поток отправит сообщение и продолжит свою работу, а уж когда оно там обработается - неважно. Какую из этих функций использовать - решать вам, всё зависит от задачи.

Вот, в принципе, мы и рассмотрели основные способы работы с компонентами VCL из потоков. А как быть, если в нашей программе не один новый поток, а несколько? И нужно организовать работу с одними и теми же данными? Тут нам на помощь приходят другие способы синхронизации. Один из них мы и рассмотрим. Для его реализации нужно добавить в проект модуль SyncObjs.
Критические секции
Работают они следующим образом: внутри критической секции может работать только один поток, другие ждут его завершения. Чтобы лучше понять, везде приводят сравнение с узкой трубой: представьте, с одной стороны "толпятся" потоки, но в трубу может "пролезть" только один, а когда он "пролезет" - начнёт движение второй, и так по порядку. Еще проще понять это на примере и тем же ProgressBar'ом. Итак, запустите один из примеров, приведённых ранее. Нажмите на кнопку, подождите несколько секунд, а затем нажмите еще раз. Что происходит? ProgressBar начал прыгать. Прыгает потому, что у нас работает не один поток, а два, и каждый из них передаёт разные значения прогресса. Теперь немного переделаем код, в событии onCreate формы создадим критическую секцию:

Код

var
Form1: TForm1;
CriticalSection: TCriticalSection;

...

procedure TForm1.FormCreate(Sender: TObject);
begin
CriticalSection:=TCriticalSection.Create;
end;

У TCriticalSection есть два нужных нам метода, Enter и Leave, соответственно вход и выход из неё. Поместим наш код в критическую секцию:

Код

procedure TNewThread.Execute;
var
i: integer;
begin
CriticalSection.Enter;
for i:=0 to 100 do
begin
sleep(50);
SendMessage(Form1.Handle,PROGRESS_POS,0,i);
end;
CriticalSection.Leave;
end;

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

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

В этой небольшой статье рассмотрены не все способы синхронизации, есть еще события (TEvent), а так же объекты системы, такие как мьютексы (Mutex), семафоры (Semaphore), но они больше подходят для взаимодействия между приложениями. Остальное, что касается использования класса TThread, вы можете узнать самостоятельно, в help'е всё довольно подробно описано. Цель этой статьи - показать начинающим, что не всё так сложно и страшно, главное разобраться, что есть что. И побольше практики - самое главное опыт!

Из приложений Delphi вы можете получить доступ к .MDB-файлам Microsoft Access, используя драйверы ODBC. Delphi действительно может дать все необходимое, но некоторые вещи не столь очевидные. Вот шаги для достижения вашей цели.

Что вам нужно: Первое: проверьте, установлен ли ODBC Administrator (файл ODBCADM.EXE в WINDOWS\SYSTEM, вам также необходим файл DBCINST.DLL для установки новых драйверов и ODBC.DLL). Администратор ODBC должен присутствовать в Панели Управления в виде иконки ODBC. Если у вас его не было, то после установки Delphi он должен появиться. Если вы получаете сообщение типа "Your ODBC is not up-to-date IDAPI needs ODBC greater then 2.0", у вас имеется старая версия администратора и вы должны обновить ее до версии, включенной в поставку Delphi. Проверьте, имеете ли вы доступ к драйверу Access ODBC, установленному в Windows. Вы можете сделать это, щелкнув на "Drivers" в диалоговом окне "Data Sources", появляющемся при запуске ODBC Administrator. Delphi должна в диалоге добавить пункты Access Files (*.mdb) и Access Data (*.mdb), работающие с файлами Access 1.10 и использующие драйвер SIMBA.DLL (имейте в виду, что для данного DLL необходимы также файлы RED110.DLL и SIMADMIN.DLL, устанавливаемые для вас Delphi). Данные файлы должны поставляться с дистрибутивом вашей программы как часть ReportSmith Runtime библиотеки. Если вы хотите работать с файлами Access 2.0 или 2.5, вам необходимо иметь другой набор драйверов от Microsoft. Ключевой файл - MSAJT200.DLL, также необходимы файлы MSJETERR.DLL и MSJETINT.DLL. В США набор ODBC Desktop Drivers, Version 2.0. стоит $10.25. Он также доступен в январском выпуске MSDN, Level 2 (Development Platform) CD4 \ODBC\X86 как часть ODBC 2.1 SDK. Очевидно есть обновление этих драйверов для файлов Access 2.5 на форуме MSACCESS CompuServe. Имейте в виду, что драйвер Access ODBC, поставляемый с некоторыми приложениями Microsoft (например, MS Office) могут использоваться только другими MS-приложениями. К сожалению, они могут сыграть с вами злую шутку: сначала заработать, а потом отказать в совершенно неподходящий момент! Поэтому не обращайте внимания (запретите себе обращать внимание!) на строчку "Access 2.0 for MS Office (*.mdb)" в списке драйверов ODBC Administrator. Вы можете установить новые ODBC драйверы с помощью ODBC Administrator в Панели Управления.

Добавление источника данных ODBC (Data Source): если у вас имеются все необходимые файлы, можете начинать. Представленный здесь пример использует драйвер Access 1.10, обеспечиваемый Delphi. Используя ODBC Administrator, установите источник данных для ваших файлов Access: щелчок на кнопке "Add" в окне "data sources" выведет диалог "Add Data Source", выберите Access Files (*.mdb) (или что-либо подходящее, в зависимости от установленных драйверов). В диалоге "ODBC Microsoft Access Setup" необходимо ввести имя в поле "Data Source Name". В данном примере мы используем "My Test". Введите описание "Data Source" в поле Description. Щелкните на "Select Database" для открытия диалога "Select Database". Перейдите в директорию, где хранятся ваши Access .MDB-файлы и выберите один. Мы выберем файл TEST.MDB в директории C:\DELPROJ\ACCESS. Нажмите OK в диалоге "Setup". Теперь в списке источников данных (Data Sources) должен появиться "My Test" (Access Files *.mdb). Нажмите Close для выхода из ODBC Administrator. Используя этот метод, вы можете установить и другие, необходимые вам, источники данных.

Настройка Borland Database Engine: загрузите теперь Borland Database Engine (BDE) Configuration Utility. На странице "Drivers" щелкните на кнопке New ODBC Driver. Имейте в виду, что это добавит драйвер Access в BDE и полностью отдельное управление дополнительно к драйверам Access в Windows, устанавливаемым при помощи ODBC Administrator. В открывшемся диалоге Add ODBC Driver в верхнем поле редактировании введите ACCESS (или что-то типа этого). BDE автоматически добавит на первое место ODBC_. В combobox, расположенном немного ниже, выберите Access Files (*.mdb). Выберите Data Source в следующем combobox (Default Data Source Name), это должен быть источник данных, который вы установили с помощью ODBC Administration Utility. Здесь можно не беспокоиться о вашем выборе, поскольку позднее это можно изменить (позже вы узнаете как это можно сделать). Нажмите OK. После установки драйвера BDE, вы можете использовать его более чем с одним источником данных ODBC, применяя различные псевдонимы (Alias) для каждого ODBC Data Source. Для установки псевдонима переключитесь на страницу "Aliases" и нажмите на кнопку "New Alias". В диалоговом окне "Add New Alias" введите необходимое имя псевдонима в поле "Alias Name". В нашем примере мы используем MY_TEST (не забывайте, что пробелы в псевдониме недопустимы). В combobox Alias Type выберите имя ODBC-драйвера, который вы только что создали (в нашем случае ODBC_ACCESS). Нажмите OK. Если вы имеете более одного ODBC Data Source, измените параметр ODBC DSN ("DSN" = "Data Source Name") в списке "Parameters" псевдонима на подходящий источник данных ODBC Data Source, как установлено в ODBC Administrator. Имейте в виду, что вы не должны ничего добавлять в параметр Path (путь), так как ODBC Data Source уже имеет эту информацию. Если вы добавляете параметр Path, убедитесь, что путь правильный, в противном случае ничего работать не будет! Теперь сохраните конфигурацию BDE, выбирая пункты меню File|Save, и выходите из Database Engine Configuration Utility.

В Delphi: Создайте новый проект и расположите на форме компоненты Table и DataSource из вкладки Data Access палитры компонентов. Затем из вкладки Data Controls выберите компонент DBGrid и также расположите его на форме. В Table, в Инспекторе Объектов, назначьте свойству DatabaseName псевдоним MY_TEST, установленный нами в BDE Configuration Utility. Теперь спуститесь ниже и раскройте список TableName. Вас попросят зарегистрироваться в базе данных Access MY_TEST. Обратите внимание, что если бюджет не установлен, то User Name и Password можно не заполнять, просто нажмите на кнопку OK. После некоторой паузы раскроется список, содержащий доступные таблицы для ODBC Data Source указанного псевдонима BDE. Выберите TEST. В DataSource, в Инспекторе Объектов, назначьте свойству DataSet таблицу Table1. В DBGrid, также в Инспекторе Объектов, назначьте свойству DataSource значение DataSource1. Возвратитесь к таблице, и в том же Инспекторе Объектов установите свойство Active в True. Данные из таблицы TEST отобразятся в табличной сетке. Это все! Одну вещь все-таки стоит упомянуть: если вы создаете приложение, использующее таблицы Access и запускаете его из-под Delphi IDE, то при попытке изменения данных в таблице(ах) вы получите ошибку. Если же вы запустите скомпилированный .EXE-файл вне Delphi (предварительно Delphi закрыв), то все будет ОК. Сообщения об ошибках ODBC, к несчастью, очень туманные и бывает достаточно трудно понять его источник в вашем приложении, в этом случае проверьте установку ODBC Administrator и BDE Configuration Utility, они также могут помочь понять источник ошибки. Для получения дополнительной информации обратитесь к ODBC 2.0 Programmer's Reference или SDK Guide от Microsoft Press (ISBN 1-55615-658-8, цена в США составляет $24.95). В этом документе вы получите исчерпывающую информацию о возможных ошибках при использовании Access-файлов посредством ODBC. Также здесь вы можете найти рапорты пользователей о найденных ошибках, в том числе и при использовании Delphi. Более того, я выяснил, что большинство описанных проблем возникает при неправильных настройках ODBC, т.е. те шаги, которые я описал выше. Надеюсь, что с развитием технологии доступа к базам данных такие сложности уйдут в прошлое. Кроме того, имейте в виду, что если вам необходимо создать новую таблицу Access 1.10, вы можете воспользоваться Database Desktop, включаемый в поставку Delphi.

Авторы данной технологии Ralph Friedman (CompuServe 100064,3102), Bob Swart и Chris Frizelle.

Взято из Советов по Delphi от Валентина Озерова

--------------------------------------------------------------------------------
Может кто-нибудь, предпочтительно из персонала Borland, ПОЖАЛУЙСТА, дать мне ПОЛНЫЙ рассказ о том, как с помощью Delphi и сопутствующего программного обеспечения получить доступ и работать с базами данных MS Access. Среди прочего, мне необходимо узнать...

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

Драйвер ODBC, предусмотренный для доступа к Access 2.0, разработан только для работы в пределах среды Microsoft Office. Для работы со связкой ODBC/Access в Delphi, вам необходим Microsoft ODBC Desktop Driver kit, part# 273-054-030, доступный через Microsoft Direct за $10.25US (если вы живете не в США, воспользуйтесь службой WINEXT). Он также доступен в январском выпуске MSDN, Level 2 (Development Platform) CD4 \ODBC\X86 как часть ODBC 2.1 SDK. Имейте в виду, что смена драйверов (в частности Desktop Drivers) может негативно сказаться на работе других приложений Microsoft. Для информации (и замечаний) обращайтесь в форум WINEXT.

Также вам необходимы следующие файлы ODBC:

Минимум:

ODBC.DLL 03.10.1994, Версия 2.00.1510

ODBCINST.DLL 03.10.1994, Версия 2.00.1510

ODBCINST.HLP 11.08.1993

ODBCADM.EXE 11.08.1993, Версия 1.02.3129

Рекомендуется:

ODBC.DLL 12.07.1994, Версия 2.10.2401

ODBCINST.DLL 12.07.1994, Версия 2.10.2401

ODBCINST.HLP 12.07.1994

ODBCADM.EXE 12.07.1994, Версия 2.10.2309

Нижеследующие шаги приведут вас к искомой цели:

1. Используя администратора ODBC, установите источник данных (datasource) для вашей базы данных. Не забудьте задать путь к вашему mdb-файлу. Для нашего примера создайте источник с именем MYDSN.
2. Загрузите утилиту BDE Configuration.
3. Выберите пункт "New Driver".
4. Назначьте драйверу имя (в нашем случае ODBC_MYDSN).
5. В выпадающем списке драйверов выберите "Microsoft Access Driver (*.mdb)
6. В выпадающем списке имен выберите MYDSN
7. Перейдите на страницу "Alias" (псевдонимы).
8. Выберите "New Alias" (новый псевдоним).
9. Введите MYDSN в поле имени.
10. Для Alias Type (тип псевдонима) выберите ODBC_MYDSN.
11. На форме Delphi разместите компоненты DataSource, Table, и DBGrid.
12. Установите DBGrid1.DataSource на DataSource1.
13. Установите DataSource1.DataSet на Table1.
14. Установите Table1.DatabaseName на MYDSN.
15. В свойстве TableName компонента Table1 щелкните на стрелочку "вниз" и вы увидите диалог "Login". Нажмите OK и после короткой паузы вы увидите список всех имен ваших таблиц. Выберите одно.
16. Установите свойство Active Table1 в True и данные вашей таблицы появятся в табличной сетке.

--------------------------------------------------------------------------------

Примечание:

С появлением и продвижением микрософтом OLE DB и реализацией в Дельфи ADO (начиная с версии 5.0) работа с MS Access через ODBC перестала быть актуальной. За исключением особых случаев рекомендуется пользоваться именно ADO линейкой компонентов для связи с MS Access

Как отправить письмо через PHP, используя формы, и как при этом устранить возникающие проблемы с кодировкой? Рассмотрим на простом примере, как отправить вопрос через формы на сайте.

У нас будет 3 поля для ввода:

Ваше имя:

* E-mail:

* Вопрос:

Причем "Ваше имя" не является обязательным параметром.
Для простоты и удобства разместим форму и код прогараммы в одном файле. Важно указать кодировку страницы (windows-1251), чтобы далее не возникало проблем с перекодированием из win в koi (ниже)
Итак, приступим. Начало документа стандартное:

Код:

Код

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<title>Отправка письма</title>
<meta content="text/html;charset=windows-1251" http-equiv="Content-Type">
</head>
<body>

Далее идет 2 логические части:
1 - вывод формы
2 - обработка формы и отправка письма

Вначале идет вывод формы.

Для удобства в начале определяем e-mail через переменную $mailto, на который будет отсылаться письмо из формы.
Далее мы определяем, была ли нажата кнопка "отправить".
В конце формы имеется кнопка "отправить", она имеет аттрибуты name="ok" и value="отправить". После нажатия на нее переменная $ok будет иметь значение "отправить". Если кнопка не нажата, то переменная не определена.
Таким образом, выражение if (empty($ok)) означает буквально "если кнопка отправить не была нажата". Функция empty() возвращает true, если переменная не определена, содержит 0 или пустоту.

Код:

PHP - Код

$mailto="name@server.ru";
if (empty($ok))
{

Далее идет вывод формы, если выполнено предыдущее условие if (empty($ok)).
Переменная $PHP_SELF означает, что обработку формы производит текущий файл, т.е. тот же, на кот. расположена форма.

Код:

Код

<h3>Отправьте вопрос автору сайта</h3>
Поля, отмеченные (*), обязательны для заполнения.
<br><br>
<form action="<?echo $PHP_SELF;" method="post">
<table>
<tr>
<td>Ваше имя:</td>
<td> <input type="text" name="username" size="30" maxlength="20"></td>
</tr>
<tr>
<td>* E-mail:</td>
<td><input type="text" name="mailfrom" size="30" maxlength="50"></td>
</tr>
<tr>
<td>* Вопрос:</td>
<td><textarea cols="50" rows="10" name="question"></textarea></td>
</tr>
</table>
<input type="submit" name="ok" value="отправить">
</form>

В противном случае, т.е. если была нажата кнопка, идет обработка формы и отправка письма
Код:

PHP - Код

}
else
{

Далее идет проверка на корректность заполнения поля "E-mail". Любители ругулярных выражений эту проверку поймут. Для остальных немного поясню:
Подразумевается, что e-mail должен быть такого вида:
слово@слово.слово
При этом слово может состоять из всех букв латинского алфавита и цифр и точка может быть не одна. (например слово@слово.слово.слово)
[a-z,0-9] - означает "любая буква латинского алфавита или цифра"
+ - означает, что [a-z,0-9] может встречаться 1 или более раз.

Если введен неправильный e-mail, то в переменную $error записывается ругательное сообщение.
Код:

PHP - Код

if(!preg_match("/^([a-z,0-9])+@([a-z,0-9])+(.([a-z,0-9])+)+$/", $mailfrom))
    {
    $error = "Не верно заполнено поле: <b>E-mail</b><br>";
    }

Если поле "Вопрос" не заполнили, то к переменно $error добавляем еше одно ругательство:
Код:

PHP - Код

if (empty($question))
    {
        $error .= "Не заполнено поле: <b>Ваш вопрос</b><br>
";
    }

Если переменная $error не пустая, то мы ее выводим на экран и немедленно прекращаем дальнейшую обработку с помощью exit
Код:

PHP - Код

if ($error)
    {
        echo $error;
        echo "<br><a href="Java Scripthistory.go(-1)" class="text">Вернуться назад</a>";
        exit;
    }

Ну а если таки $error осталась пустой и exit не сработал, то можно приступать к отправке письма, т.е. главной цели всего этого мероприятия...
Сформируем тему и тело сообщения:

PHP - Код

$subject="Вопрос от $mailfrom";
$body="Имя:
$username

E-mail:
$mailfrom

Комментарии:
$question";

А теперь самое главное, чтоб потом можно было прочитать письмо "по-русски" :) Функция convert_cyr_string перекодирует строку из win в koi (w-win, k-koi) Это необходимо, т.к. все почтовые клиенты по дефалту принимают письма в koi. А у нас вверху страницы стоит charset=windows-1251, поэтому функция грамотно переводит из win в koi Затем с помощью функции mail отправляется письмо на $mailto, указанный в начале файла.
Код:

PHP - Код

$body=convert_cyr_string (stripslashes($body),w,k);
    $subject=convert_cyr_string (stripslashes($subject),w,k);
    $sucess = mail($mailto, $subject, $body, "From: $email X-Mailer: PHP/" . phpversion());

Ну и самое приятное... Если письмо успешно отправлено, то выводим благодарственную надпись и предлагаем вернуться..
Код:

PHP - Код

if ($sucess)
    {
        echo "Спасибо. Ваш вопрос отправлен.<br><br>";
        echo "<a href="Java Scripthistory.go(-1)" class="text">Вернуться назад</a>";
    }

Стандартный конец..
Код:

Код

}

</body>
</html>

P.S. Как наверно понял читатель, нужно выделить и скопировать все зеленые блоки в один файл по порядку и запустить его на сервере
Весь код является полностью проверенным и рабочим.

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

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

Итак, начнем ликбез. Сразу всем вопрос: что делает MySQL во время записи в таблицы типа INSERT или UPDATE? Правильно - БЛОКИРУЕТ ТАБЛИЦЫ и пишет в них данные. Скорость записи и поиска может быть достаточно низкой, поэтому статус таблиц запрещает другим процессам считывать из них данные до окончания операции записи или обновления и снятия блокировки. При этом может получиться так, что во время записи единственного поля в длинные таблицы, ваш MySQL-сервер надолго заблокирует доступ к таблице остальным скриптам.

Например, вы создали таблицу новостей такого типа:

ID - номер, первичный ключ
TEMA - тема новости
MESS - сообщение, сама новость
VIEWS - количество просмотров

При каждом обращении к новостям, скрипт будет выводить саму новость, а потом увеличивать поле VIEWS запросом UPDATE table 'NEWS' set VIEWS=VIEWS+1 where id=ID. При этом количество апдейтов будет довольно высоким. При высокой посещаемости веб-ресурса или при "нападении" на сайт поискового робота (эти ребята страдают многопоточностью и могут запросто повесить ваш сайт своими запросами) несколько одновременных процессов станут пытаться сделать UPDATE и SELECT. При каждом UPDATE таблица будет блокироваться (на это уходит время) и все остальные процессы будут ждать завершения операции. А если таблица достаточно большая? Например, несколько тысяч записей. Ежу понятно, что построится очередь из нескольких десятков скриптов, ожидающих ответа MySQL-сервера. Каждый будет жрать память и держать остальные процессы. В итоге все у вас зависнет и переглючит. Выход: делать вместо одной таблицы несколько. Советую разделять поля по типу их использования. Одну таблицу - только для вывода и редких обновлений или вставок. Другую - для частых обновлений, но редкого вывода. Например, значения счетчика обращений держать отдельно в таблицу вида:

ID - номер, первичный ключ
VIEWS - количество просмотров

Сами новости лучше держать в другой таблице, где нет поля VIEWS. При этом таблица с новостями будет тяжелой (много текста, полей, индексов), а таблица COUNT (счетчик) будет очень легкой и быстрой. Таблица NEWS будет кешироваться и выводиться очень быстро при любых объемах, а таблица COUNT будет быстро обновляться из-за того, что она очень легкая (всего два целочисленных поля). Разделение данных по нескольким таблицам существенно ускоряет работу MySQL-сервера. Гораздо быстрее работают несколько мелких запросов по каждой таблице, чем один длинный запрос по одной или нескольким таблицам. Имейте это в виду, чтобы спать спокойно.

Дальше - круче. Чтобы не блокировать лишний раз свои таблицы используйте при вставках директиву DELAYED. Пример: INSERT DELAYED into STAT (ID,IP,UTIME) values (null,$ip,NOW()). Он позволяет серверу ответвлять поток в режиме ожидания, а саму вставку производить тогда, когда сервер освободится от других запросов или поступит следующий аналогичный INSERT DELAYED. Обычно отложенный метод подходит для любых операций с кумулятивными таблицами (когда в основном идут INSERTы, а данные копятся, а не модифицируются), при которых не особо важно когда именно подействуют изменения - мгновенно или через несколько секунд, минут. Например, если хотите собирать IPадреса своих посетителей, УРЛы, по которым они ходят или страницы, откуда пришли, время. При добавлении с задержкой скрипт отработает почти мгновенно, еще до выполнения операции.

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

При запросах SELECT * FROM таблица скрипт получит все поля данной таблицы. А нужно ли это? Использование * ведет к лишнему расходу ресурсов. Гораздо эффективнее использовать точные названия полей, которые нужны скрипту. Например: SELECT id,name FROM таблица. При таком запросе передача займет меньше времени и понадобится меньше ресурсов. Старайтесь ограничивать вывод при помощи директивы LIMIT. Это также ускоряет вывод.

Поиск по БД идет быстрее если вместо LIKE '%слово%', ставить 'слово%'. Операции с шаблонами регулярных выражений кешируются только в том случае, если в начале отсутствует символ %. Поэтому при построении поисковых запросов с LIKE избегайте начинающих символов %.

При построении таблиц для наиболее используемых полей (при поиске, сортировке и т.д.) обязательно создавайте индексы. Без индексов таблицы будут сильно тормозить. Индексы служат для кеширования и позволяют существенно ускорить вывод данных из таблиц. При этом таблицы будут занимать больше места на диске и в памяти. Но это в наше время не проблема.

Используйте надлежащий тип полей для своих записей. Тип TINYINT занимает 1 байт - самый быстрый. Таблицы с MEDIUMINT быстрее таблиц с INT. Если ставить полям свойство NOT NULL, то в целом их работа будет быстрее. VARCHAR медленее CHAR, поэтому таблицы переменной длины (где есть тип VARCHAR или TEXT) занимают меньше дискового пространства, но работают медленнее.

По своему опыту скажу, что для большинства сайтов подходят изложенные советы по работе с MySQL. Чтобы еще больше ускорить свой сервер, советую частоиспользуемые операции проводить по крону выделенными процессами и писать данные в различные файлы. Например, раз в 20 минут запускать скрипт, который будет создавать файл с новостями. Или например, генерить файл с новостями при их добавлениях или обновлениях. Таким образом, вы экономите на каждом обращении к БД. Интерактивность при этом не теряется, а производительность увеличивается во много раз. Особенно, повторяю, при высокой посещаемости ресурса. Старайтесь отделить интерактивные операции от фоновых. Например, на ПротоПлексе работает один интерактивный движок, но в фоне по заданиям трудятся с десяток различных роботов, которые генерируют часто вызываемые страницы, рассылают письма и т.д. Крупный сайт - это не только то, что вы видите, но и бек-енд (обратная сторона). В фоновом режиме можно быстро и эффективно готовить контент, освобождая основной движок от лишней работы.

В общем, основы должны быть всем понятны. Дробите все на мелочи, будь то запросы, таблицы или операции. Структура БД должна быть такой, чтобы не выполнялось ничего лишнего. Регулярно проводите OPTIMIZE на таблицах с переменной длиной, особенно, если в них идут удаления записей. Тестируйте свои запросы на скорость, упрощайте их.

Часто программисту приходится сталкиваться с задачей написания приложения, работающего в фоновом режиме и не нуждающегося в месте на Панели задач. Если вы посмотрите на правый нижний угол рабочего стола 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 очень облегчает работу с такими программами, как кодировщики музыки, интернет-качалки, файловые утилиты и архиваторы.

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

Команды POP3 состоят из ключевых слов, за некоторыми следует один или более аргументов. Все команды заканчиваются парой CRLF (в Visual Basic константа vbCrLf). Ключевые слова и аргументы состоят из печатаемых ASCII символов. Ключевое слово и аргументы разделены одиночным пробелом. Ключевое слово состоит от 3-х до 4-х символов, а аргумент может быть длиной до 40-ка символов.

Ответы в POP3 состоят из индикатора состояния и ключевого слова, за которым может следовать дополнительная информация. Ответ заканчивается парой CRLF. Существует только два индикатора состояния: "+OK" - положительный и "-ERR" - отрицательный.

Ответы на некоторые команды могут состоять из нескольких строк. В этих случаях каждая строка разделена парой CRLF, а конец ответа заканчивается ASCII символом 46 (".") и парой CRLF.

POP3 сессия состоит из нескольких режимов. Как только соединение с сервером было установлено и сервер отправил приглашение, то сессия переходит в режим AUTHORIZATION (Авторизация). В этом режиме клиент должен идентифицировать себя на сервере. После успешной идентификации сессия переходит в режим TRANSACTION (Передача). В этом режиме клиент запрашивает сервер выполнить определённые команды. Когда клиент отправляет команду QUIT, сессия переходит в режим UPDATE. В этом режиме POP3 сервер освобождает все занятые ресурсы и завершает работу. После этого TCP соединение закрывается.

У POP3 сервера может быть INACTIVITY AUTOLOGOUT таймер. Этот таймер должен быт, по крайней мере, с интервалом 10 минут. Это значит, что если клиент и сервер не взаимодействуют друг с другом, сервер автоматически прерывает соединение и при этом не переходит в режим UPDATE.

Авторизация в протоколе POP3

Как только будет установлено TCP соединение с POP3 сервером, он отправляет приглашение, заканчивающееся парой CRLF, например:

Код

S: +OK POP3 server ready

Теперь POP3 сессия находится в режиме AUTHORIZATION. Клиент должен идентифицировать себя на сервере, используя команды USER и PASS. Сначала надо отправить команду USER, после которой в качестве аргумента следует имя пользователя. Если сервер отвечает положительно, то теперь необходимо отправить команду PASS, за которой следует пароль. Если после отправки команды USER или PASS сервер отвечает негативно, то можно поробовать авторизироваться снова или выйти из сесси с помощью команды QUIT. После успешной авторизации сервер открывает и блокирует maildrop (почтовый ящик). В ответе на команду PASS сервер сообщает сколько сообщений находится в почтовом ящике и передаёт их общий размер. Теперь сессия находится в режиме TRANSACTION. Подведём итоги с командами:

Команда: USER [имя]
Аргументы: [имя] - строка, указывающая имя почтового ящика
Описание: Передаёт серверу имя пользователя.

Возможные ответы:

* +OK name is a valid mailbox
* -ERR never heard of mailbox name

Примеры:

C: USER MonstrVB
S: +OK MonstrVB is a real hoopy frood
...
C: USER MonstrVB
S: -ERR sorry, no mailbox for frated here

Команда: PASS [пароль]
Аргументы: [пароль] - пароль для почтового ящика
Описание: Передаёт серверу пароль почтового ящика.

Возможные ответы:

* +OK maildrop locked and ready
* -ERR invalid password
* -ERR unable to lock maildrop

Примеры:

C: USER MonstrVB
S: +OK MonstrVB is a real hoopy frood
C: PASS mymail
S: +OK MonstrVB's maildrop has 2 messages (320 octets)
...
C: USER MonstrVB
S: +OK MonstrVB is a real hoopy frood
C: PASS mymail
S: -ERR maildrop already locked

Команда: QUIT

Аргументы: нет
Описание: Сервер завершает POP3 сессию и переходит в режим UPDATE.
Возможные ответы:

* +OK

Примеры:

C: QUIT
S: +OK dewey POP3 server signing off


Основные команды (Transaction) протоколе в POP3

После успешной идентификации пользователя на сервере POP3 сессия переходит в режим TRANSACTION, где пользователь может передавать ниже следующие команды. После каждой из таких команд следут ответ сервера. Вот доступные команды в этом режиме:

Команда: STAT

Аргументы: нет

Описание: В ответ на вызов команды сервер выдаёт положительный ответ "+OK", за которым следует количество сообщений в почтовом ящике и их общий размер в символах. Сообщения, которые помечены для удаления не учитываются в ответе сервера.

Возможные ответы:

* +OK n s

Примеры:

C: STAT
S: +OK 2 320


Команда: LIST [сообщение]

Аргументы: [сообщение] - номер сообщения (необязательный аргумент)

Описание: Если был передан аргумент, то сервер выдаёт информацию о указанном сообщении. Если аргумент не был передан, то сервер выдаёт информацию о всех сообщениях, находящихся в почтовом ящике. Сообщения, помеченные для удаления не перечисляются.

Возможные ответы:

* +OK scan listing follows
* -ERR no such message

Примеры:

C: LIST
S: +OK 2 messages (320 octets)
S: 1 120
S: 2 200
S: .
...
C: LIST 2
S: +OK 2 200
...
C: LIST 3
S: -ERR no such message, only 2 messages in maildrop


Команда:RETR [сообщение]

Аргументы: [сообщение] - номер сообщения
Описание: После положительного ответа сервер передаёт содержание сообщения.

Возможные ответы:

* +OK message follows
* -ERR no such message

Примеры:

C: RETR 1
S: +OK 120 octets
S:
S: .


Команда: DELE [ообщение]

Аргументы: [ообщение] - номер сообщения

Описание: POP3 сервер помечает указанное сообщение как удалённое, но не удалет его, пока сессия не перейдёт в редим UPDATE.

Возможные ответы:

* +OK message deleted
* -ERR no such message

Примеры:

C: DELE 1
S: +OK message 1 deleted
...
C: DELE 2
S: -ERR message 2 already deleted


Команда: NOOP

Аргументы: нет

Описание: POP3 сервер ничего не делает и вседа отвечает полжительно.

Возможные ответы:

* +OK

Примеры:

C: NOOP
S: +OK


Команда: RSET

Аргументы: нет

Описание: Если какие - то сообщения были помечены для удаления, то с них снимается эта метка.

Возможные ответы:

* +OK

Примеры:

C: RSET
S: +OK maildrop has 2 messages (320 octets)


Обновление

Когда клиент передаёт команду QUIT в режиме TRANSACTION, то сессия переходит в режим UPDATE. В этом режиме сервер удаляет все сообщения, помеченные для удаления. После этого TCP соединение закрывается.


Дополнительные POP3 команды

Следующие дополнительные команды дают вам большую свободу при работе с сообщениями: Команда: TOP [сообщение] [n] Аргументы: [сообщение] - номер сообщения [n] - положительное число (обязательный аргумент) Описание: Если ответ сервера положительный, то после него он передаёт заголовки сообщения и указанное кол - во строк из тела сообщения. Возможные ответы: +OK top of message follows -ERR no such message Примеры: C: TOP 1 10 S: +OK S: <здесь POP3 сервер передаёт заголовки первого сообщения и первые 10-ть строк из тела сообщения.> S: . ... C: TOP 100 3 S: -ERR no such message Команда: UIDL [сообщение] Аргументы: [сообщение] - номер сообщения (необязательный аргумент). Описание: Если был указан номер сообщения, то сервер выдаёт уникальный идентификатор для этого сообщения. Если аргумент не был передан, то идентификаторы перечисляются для всех сообщений, кроме помеченных для удаления.

Возможные ответы: +OK unique-id listing follows -ERR no such message

Примеры: C: UIDL S: +OK S: 1 whqtswO00WBw418f9t5JxYwZ S: 2 QhdPYR:00WBw1Ph7x7 S: . ... C: UIDL 2 S: +OK 2 QhdPYR:00WBw1Ph7x7 ... C: UIDL 3 S: -ERR no such message, only 2 messages in maildrop


Заключение

Вот пример простого сеанса с POP3 сервером:

Код

S: <создаём новое TCP соединение c POP3 сервером через порт 110>
S: +OK POP3 server ready
C: USER MonstrVB
S: +OK User MonstrVB is exists
C: PASS mymail
S: +OK MonsrVB's maildrop has 2 messages (320 octets)
C: STAT
S: +OK 2 320
C: LIST
S: +OK 2 messages (320 octets)
S: 1 120
S: 2 200
S: .
C: RETR 1
S: +OK 120 octets
S:
S: .
C: DELE 1
S: +OK message 1 deleted
C: RETR 2
S: +OK 200 octets
S:
S: .
C: DELE 2
S: +OK message 2 deleted
C: QUIT
S: +OK dewey POP3 server signing off (maildrop empty)
C: <закрываем соединение>

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

Основные преимущества, благодаря которым OLE активно используется:

* Для вызывающей базы "по барабану" - какой тип вызываемой базы (DBF или SQL)
* Объектами вызываемой базы можно управлять всеми известными методами работы с объектами в 1С (т.е. со справочниками работают методы ВыбратьЭлементы(), ИспользоватьДату() и т.п., с документами - ВыбратьДокументы() и т.п.), соответственно, можно напрямую решить - стоит отрабатывать конкретные объекты базы OLE или пропустить их.

Пример 1. Присоединение к базе 1С через OLE.
БазаОле=СоздатьОбъект("V77.Application"); // Получаем доступ к OLE объекту 1С
Локальная версия (на одного пользователя): V77L.Application
Сетевая версия: V77.Application
Версия SQL: V77S.Application

Далее вместо термина "вызываемая база" будет написано просто "база OLE", а вместо термина "вызывающая база" - "местная база"

Теперь, мы должны знать несколько параметров для запуска базы OLE: Каталог базы, имя пользователя и пароль. Ну, наверное, еще и желание запустить 1С в монопольном режиме :)

Код

КаталогБазыОЛе = "C:\program files\1cv77\МояБаза\";
ПользовательОле = "Администратор";
ПарольОле = "qwerty";
МонопольныйРежимOLE = " /m"; // для немонопольного запуска указать пустую строку!
ЗапускБезЗаставки = 1; // для появления заставки (например, чтобы наблюдать
// процесс запуска базы OLE визуально) поставьте здесь "0"
РезультатПодключения = БазаОле.Initialize ( БазаОле.RMTrade , "/d" +
СокрЛП(КаталогБазыОле) + " /n" + СокрЛП(ПользовательОле)+
" /p" + СокрЛП(ПарольОле) + МонопольныйРежимOLE,
?(ЗапускБезЗаставки = 1,"NO_SPLASH_SHOW",""));
Если РезультатПодключения = 0 Тогда
Предупреждение("Не удалось подключится к указанной базе - проверьте вводные!");
КонецЕсли;

Комментарий: функции СокрЛП() стоят в примере на случай, если пользователь захочет указанные выше переменные сделать в форме диалога, а проблема при этом состоит в том, что в алгоритм программа передаст полное значение реквизита (т.е. допишет в конце значения то количество пробелов, которое необходимо для получения полной длины строки (указана в свойствах реквизита диалога)).

Пример 2. Доступ к объектам базы OLE.

Запомните на будущее как непреложный факт:

1. Из местной базы в базу OLE (и, соответственно, наоборот) напрямую методом присвоения можно перенести только числовые значения, даты и строки ограниченной длины!!! Т.е. местная база поймет прекрасно без дополнительных алгоритмов преобразования полученного значения только указанные типы значений. Кроме того, под ограничением строк подразумевается проблемы с пониманием в местной базе реквизитов объектов базы OLE типа "Строка неограниченной длины". К этому же еще надо добавить и периодические реквизиты. Естественно, под методом присвоения подразумеваются и попытки сравнить объекты разных баз в одном условии (например, в алгоритмах "Если" или "Пока" и т.п.).
2. Есть проблемы при попытке перенести "пустую" дату - OLE может ее конвертировать, например, в 31.12.1899 года и т.п. Поэтому вам лучше заранее выяснить те значения, которые могут появится в местной базе при переносе "пустых" дат, чтобы предусмотреть условия преобразования их в местной базе.

A) Доступ к константам базы OLE:

Код

ЗначениеКонстантыOLE = БазаОле.Константа.ДатаЗапретаРедактирования;

Б) Доступ к справочникам и документам базы OLE (через функцию "CreateObject"):

Код

СпрOLE = БазаОле.CreateObject("Справочник.Фирмы"); // "СоздатьОбъект" в OLE не работает!
ДокOLE = БазаОле.CreateObject("Документ.РасходнаяНакладная");

После создания объекта справочника или документа к ним применимы все методы, касающиеся таких объектов в 1С:

Код

СпрОле.ВыбратьЭлементы();
Пока СпрОле.ПолучитьЭлемент()=1 Цикл
Сообщить(Спр.Наименование);
КонецЦикла;

Заметьте, что если вместо "Сообщить(Спр.Наименование)" вы укажете "Сообщить(Спр.ТекущийЭлемент())", то вместо строкового/числового представления этого элемента программа выдаст вам в окошке сообщение "OLE". Именно это я и имел в виду, когда говорил, что напрямую мало что можно перенести. Т.е. не будут работать следующие методы (ошибки 1С не будет, но и результат работы будет нулевой). Рассмотрим следующий пример:

Код

СпрOLE = БазаОле.CreateObject("Справочник.Фирмы"); // это справочник в базе OLE
Док = СоздатьОбъект("Документ.РасходнаяНакладная"); // а это документ в местной базе
Док.Новый(); // создаем новый документ в местной базе
СпрOLE.НайтиПоКоду(1,0); // спозиционируем в базе OLE
// на фирме с кодом "1".
Док.Фирма = СпрOLE.ТекущийЭлемент(); // такой метод не сработает, т.к. справа от "=" стоит
// объект не местной базы, и местная база 1С его не понимает!

Однако, сработает следующий метод:

Код

Спр = СоздатьОбъект("Справочник.Фирмы"); // создаем объект справочника местной базы
Спр.НайтиПоНаименованию(СпрОле.Наименование,0,0); // Или Спр.найтиПоКоду(СпрОле.Код,0);
// т.е. СпрОле.Код и Спр.наименование
// являются обычными числовыми/строковыми
// значениями, которые понимает местная база!
Док.Фирма = Спр.ТекущийЭлемент(); // Вот теперь все в порядке, т.к. с обоих сторон метода
// стоят объекты только местной базы!

Отсюда вывод: возможность доступа к объектам базы 1С через OLE требуется, в основном, только для определенной задачи - получить доступ к реквизитам определенного элемента справочника или документа. Однако, не забываем, что объекты базы OLE поддерживают все методы работы с ними, в т.ч. и "Новый()", т.е. приведем пример противоположный предыдущему:

Код

ДокОле = CreateObject("Документ.РасходнаяНакладная"); // Создаем документ в базе OLE
ДокОле.Новый();
Спр = СоздатьОбъект("Справочник.Фирмы"); // В местной базе получаем доступ к справочнику
Спр.НайтиПоКоду(1,0); // Находим в местной базе фирму с кодом 1 (если есть)
ДокОле.Фирма = Спр.ТекущийЭлемент(); // такой метод не сработает

Однако, сработает следующий метод:
СпрОле = БазаОле.CreateObject("Справочник.Фирмы"); // создаем объект справочника базы OLE
СпрОле.НайтиПоНаименованию(Спр.Наименование,0,0); // Или СпрОле.найтиПоКоду(Спр.Код,0);
// т.е. Спр.Код и Спр.Наименование являются обычными числовыми/строковыми значениями,
// которые понимает база OLE!
ДокОле.Фирма = СпрОле.ТекущийЭлемент(); // Вот теперь все в порядке, т.к. с обоих сторон
// метода стоят объекты базы OLE!
ДокОле.Записать(); // запишем документ в базе OLE
Если ДокОле.Провести()=0 тогда
Сообщить("Не смогли провести документ!");
КонецЕсли;

В) Доступ к регистрам базы OLE (Не сложнее справочников и документов):

Код

РегОле=БазаOLE.CreateObject("Регистр.ОстаткиТоваров");
РегОле.ВыбратьИтоги();
Пока РегОле.ПолучитьИтог()=1 Цикл // Не забываем, что надо указывать наименование!
Сообщить("Остаток для " + РегОле.Товар.Наименование+ " на складе " +
РегОле.Склад.Наименование + " равен " + РегОле.ОстатокТовара);
КонецЦикла;

Г) Доступ к перечислениям базы OLE (аналогичен константе):
ЗначениеПеречисленияOLE = БазаОле.Перечисление.Булево.НеЗнаю; // :)

Заметьте, что пользы для местной базы от переменной "ЗначениеПеречисленияOLE" особо-то и нет, ведь подобно справочнику и документу перечисление также напрямую недоступно для местной базы. Пожалуй, пример работы с ними может быть следующим (в качестве параметра условия):

Код

СмотретьТолькоВозвратыПоставщикам = 1; // предположим, что это - флажок в форме диалога,
// который мы либо устанавливаем, либо снимаем
ДокОле = БазаОле.CreateObject("Документ.РасходнаяНакладная");
ДокОле.ВыбратьДокументы(НачДата,КонДата); // НачДата и КонДата - также реквизиты формы
// диалога, но база OLE прекрасно их понимает -
// ведь это же даты!
Пока ДокОле.ПолучитьДокумент()=1 Цикл
Если СмотретьТолькоВозвратыПоставщикам = 1 Тогда
Если ДокОле.ПризнакНакладной <> БазаОле.Перечисление.ПризнРасхНакл.ВозвратПоставщику Тогда
Продолжить;
КонецЕсли;
Иначе
Если ДокОле.ПризнакНакладной = БазаОле.Перечисление.ПризнРасхНакл.ВозвратПоставщику Тогда
Продолжить;
КонецЕсли;
КонецЕсли;
Сообщить(ДокОле.Вид() + " № "+ДокОле.НомерДок + " от " + ДокОле.датаДок);
КонецЦикла;

Д) Доступ к счетам базы OLE:
СчтОле=БазаОле.CreateObject("Счет");
СчтОле.НайтиПоКоду("10.5"); // нашли в базе OLE счет 10.5

Е) Доступ к ВидамСубконто базы OLE (аналогичен перечислению):
ВидСубконтоКонтрагентыОле = БазаОле.ВидыСубконто.Контрагенты;

По аналогии со справочниками и документами работает объект "Периодический", план счетов работает по аналогии с ВидомСубконто, ну и далее в том же духе… Отдельную главу посвятим запросу, а сейчас… стоп. Еще пункт забыл!

Ж) Доступ к функциям и процедурам глобального модуля базы OLE!

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

Код

ДатаАктуальностиОле = БазаОле.EvalExpr("ПолучитьДатуТА()");
// Возвращает дату актуальности
ИмяПользователяОле = БазаОле.EvalExpr("ИмяПользователя()");
// возвращает строку
//
// попробуем теперь получить числовое значение НДС у элемента номенклатуры
// через функцию глобального модуля ПроцентНДС(СтавкаНДС) Экспорт!
ТовОле = БазаОле.CreateObject("Справочник.Номенклатура");
ТовОле.ВыбратьЭлементы();
// Найдем элемент справочника (не группа!)
Пока ТовОле.ПолучитьЭлемент()=1 Цикл
Если ТовОле.ЭтоГруппа()=0 Тогда
Прервать;
КонецЕсли;
КонецЦикла;
ЧисловоеЗначениеПроцентаНДСТовараОле = БазаОле.EvalExpr("ПроцентНДС(Перечисление.ЗначенияНДС." +
ТовОле.СтавкаНДС.Идентификатор()+")");

На самом деле, в последней строке примера я исхитрился и забежал немного вперед. Дело в том, что как и запрос (см. отдельную главу), так и EvalExpr() выполняются внутри базы OLE, причем команды передавается им обычной строкой, и поэтому надо долго думать, как передать необходимые ссылки на объекты базы OLE в строке текста местной базы. Так что, всегда есть возможность поломать голову над этим…

Алгоритмы преобразования объектов в "удобоваримый вид" между базами.

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

И еще раз обращу внимание: ОБЪЕКТЫ ОДНОЙ БАЗЫ ПРЕКРАСНО ПОНИМАЮТ ДРУГ ДРУГА, ПРОБЛЕМЫ ВОЗНИКАЮТ ТОЛЬКО ТОГДА, КОГДА ВЫ НАЧИНАЕТЕ СВЯЗЫВАТЬ МЕЖДУ СОБОЙ ОБЪЕКТЫ РАЗНЫХ БАЗ, т.е. команда

Код

ДокОле.Фирма=СпрОле.ТекущийЭлемент();
// где ДокОле - документ базы OLE, а СпрОле - справочник "Фирмы" базы OLE

будет прекрасно работать без ошибок. Не забывайте это, чтобы не перемудрить с алгоритмами!

Итак, повторяюсь, что напрямую перенести, да и просто сравнить можно только даты (причем не "пустые"), числа и строки ограниченной длины. Итак, как же нам сравнить объекты разных баз (не числа, не даты, не строки), т.е. как их преобразовать в эту самую строку/число/дату.

А) Преобразование справочников/документов базы OLE (если есть аналогичные справочники/документы в местной базе). В принципе, преобразование их было уже рассмотрено в примерах выше и сводится к поиску их аналогов в местной базе. Могу еще раз привести пример, заодно с использованием регистров:

Код

// ВыбФирма, НачДата, КонДата, ВыбДокумент - реквизиты диалога в местной базе
// причем они все указаны, т.е. не пустые (чтобы не делать лишних команд в примере)
ДокОле = БазаОле.CreateObject("Документ.РасходнаяНакладная"); // объект базы OLE
Док = СоздатьОбъект("Документ.РасходнаяНакладная"); // а это - его аналог в местной базе
Спр = СоздатьОбъект("Справочник.Фирмы"); // а это - местный справочник фирм
ДокОле.ВыбратьДокументы(НачДата,КонДата);
Пока ДокОле.ПолучитьДокумент()=1 Цикл
// Ищем в местном справочнике фирм аналог фирмы из базы OLE (по коду)…
Если Спр.НайтиПоКоду(ДокОле.Фирма.Код,1)=0 Тогда
Сообщить("Найден документ с неизвестной фирмой! Ее код: " + ДокОле.Фирма.Код);
// На самом деле, она может быть просто не указана :))
Если ДокОле.Фирма.Выбран()=0 Тогда
Сообщить("Извините - она просто не указана! :))");
КонецЕсли;
ИначеЕсли Спр.ТекущийЭлемент()=ВыбФирма Тогда
Сообщить("Найден документ указанной вами фирмы! № "+ДокОле.НомерДок+" от "+ДокОле.ДатаДок);
КонецЕсли;
// Ищем аналог документа в местной базе
Док.НайтиПоНомеру(ДокОле.НомерДок,ДокОле.ДатаДок);
Если Док.Выбран()=1 Тогда
Сообщить("Документ № "+Док.НомерДок + " от " + Док.ДатаДок + " уже есть!");
Если Док.ТекущийДокумент() = ВыбДокумент Тогда
Предупреждение("Приз в студию! Найден указанный вами документ!!!");
КонецЕсли;
Иначе
Сообщить("Документ № "+ДокОле.НомерДок+" от "+ДокОле.ДатаДок+" не найден в базе!");
КонецЕсли;
КонецЦикла;
// А заодно и получим остаток товара в базе OLE:
РегОле = БазаОле.CreateObject("Регистр.ОстаткиТоваров");
ТовОле = БазаОле.CreateObject("Справочник.Номенклатура");
ТовОле.НайтиПоКоду(ВыбТовар.Код,0);
ФрмОле = БазаОле.CreateObject("Справочник.Фирмы");
ФрмОле.НайтиПоКоду(ВыбФирма.Код,0);
ОстатокТовараНаСкладеОле = РегОле.СводныйОстаток(ТовОле.ТекущийЭлемент(),,
ФрмОле.ТекущийЭлемент(),"ОстатокТовара");

Б) Преобразование перечислений и видов субконто (подразумевается, что в обоих базах есть аналогичные перечисления и виды субконто). Вся задача сводится к получению строкового или числового представления перечисления или вида субконто.
Не поймите это как прямую команду воспользоваться функцией Строка() или Число() :)) Нет. Для этого у нас есть обращение к уникальному представлению перечисления и вида субконто - метод Идентификатор() или ЗначениеПоНомеру(). Второй вариант не очень подходит, так как зачастую в разных базах даже перечисления бывают расположены в другом порядке, а вот идентификаторы стараются держать одинаковыми в разных базах. Отсюда вывод, пользуйтесь методом Идентификатор(). Кстати, не путайте вид субконто с самим субконто! Привожу пример преобразования:

Код

// ДокОле - документ базы OLE, и уже спозиционирован на нужном нам документе,
// Док - документ местной базы (например, новый), который мы пытаемся заполнить
// реквизитами из документа базы OLE…
// Будем считать, что реквизиты типа "справочник" мы уже перенесли :)
// Преобразуем перечисление - и не говорите потом - с ума сойти, как оказалось все просто!
Если ПустоеЗначение(ДокОле.ПризнакНакладной.Идентификатор())=0 Тогда
// если не проверим реквизит на пустое значение - нарвемся на ошибку 1С
Док.ПризнакНакладной = Перечисление.ПризнРасхНакл.ЗначениеПоИдентификатору(
ДокОле.ПризнакНакладной.Идентификатор()); // Что и требовалось сделать
КонецЕсли;
// Преобразуем вид субконто
Если ПустоеЗначение(ДокОле.ВидСубконтоСчетаЗатрат.Идентификатор())=0 Тогда
// если не проверим реквизит на пустое значение - нарвемся на ошибку 1С
Док.ВидСубконтоСчетаЗатрат = ВидСубконто.ЗначениеПоИдентификатору(
ДокОле.ВидСубконтоСчетаЗатрат.Идентификатор()); // Что и требовалось сделать
КонецЕсли;

То же самое относится и к плану счетов - принцип у него тот же, что и у вида субконто…

В) Преобразование счетов:

Во многом объект "Счет" аналогичен объекту "Справочник". Отсюда и пляшем:

Код

Док.СчетУчета=СчетПоКоду(ДокОле.СчетУчета.Код); // присвоили документу реквизит счета
Если СчетПоКоду(ДокОле.СчетУчета.Код)=СчетПоКоду("10.5") Тогда
// Это именно счет 10.5 :)
КонецЕсли;
// Я специально оставил в "Если" функцию СчетПоКоду(), т.к. в планах счетов разных баз
// могут быть разные форматы счетов, и просто сравнение кода может привести к
// противоположному результату. (Кстати, и сам СчетПоКоду() тоже может иногда подвести,
// так что, вам решать - каким методом пользоваться…)

Работа с запросами и EvalExpr().

Наконец-то добрались и до запросов. Надо пояснить несколько вещей, касаемых запросов (да и EvalExpr() тоже). Самое главное - компиляция текста OLE-запроса (т.е. разбор всех переменных внутри запроса), как и сами OLE-запросы выполняются внутри базы OLE и поэтому ни одна переменная, ни один реквизит местной базы там недоступны, да и запрос даже не подозревает, что его запускают по OLE из другой базы!!! Поэтому, чтобы правильно составить текст, иногда требуется не только обдумать, как передать параметры запроса в базу OLE, но и обдумать, что нужно добавить в глобальный модуль той самой OLE-базы, чтобы как-то собрать для запросы переменные!

1. Поскольку сам текст запроса и функции EvalExpr() является по сути текстом, а не набором параметров, то напрямую передать ему ссылку на элемент справочника, документ, счет и т.п. нельзя. Исключение может быть составлено для конкретных значений перечислений, видов субконто, констант, планов счетов и т.п.
2. Хоть и многим и так понятно, что я скажу дальше, но я все-таки уточню: при описании переменных в тексте запроса не забывайте, что объекты базы надо указывать напрямую, без всяких префиксов типа "БазаОле".
3. Отрабатывать запрос сложно тем, что ошибки, например, при компиляции напрямую не увидеть. Поэтому начинаем пошагово готовится к отработке запроса в базе OLE.

Вначале допишем в глобальном модуле базы OLE немного строк, которые нам помогут в работе:

Код

//**********************************************************
Перем СписокЗначенийЗапроса[10] Экспорт; // Мы в них "запихнем" значения для запроса
//*********************************************************
Функция СкорректироватьСписок(ИндексМассива,
Действие,
ТипОбъекта = "",
ВидОбъекта = "",
Параметр1 = "",
Параметр2 = "",
Параметр3 = "", // Ну и далее по параметрам, сколько надо
// …………………
Параметр99 = "") Экспорт
ИндексМассива=Число(ИндексМассива);
Если ИндексМассива = 0 Тогда
Возврат -99; // Обышка: Не указали индекс массива ?
КонецЕсли;
Если Действие = 1 Тогда // Очистить список значений
СписокЗначенийЗапроса[ИндексМассива].УдалитьВсе();
Возврат 1;
ИначеЕсли Действие = 2 Тогда // Добавить объект в список
Если ТипОбъекта = "Документ" Тогда
Если ВидОбъекта = "" Тогда
Возврат -99; // Обышка: Передавайте нормальный вид объекта!
КонецЕсли;
Попытка
Док = СоздатьОбъект("Документ."+ВидОбъекта);
Исключение
Возврат -99; // Обышка: Попытка обращения к неверному объекту
КонецПопытки;
Если Док.НайтиПоНомеру(Параметр1,Параметр2)=1 Тогда
СписокЗначенийЗапроса[ИндексМассива].
ДобавитьЗначение(Док.ТекущийДокумент());
Возврат 1; // Нашли документ
Иначе
Возврат 0; // Не нашли документ :(
КонецЕсли;
ИначеЕсли ТипОбъекта = "Справочник" Тогда
Если ВидОбъекта = "" Тогда
Возврат -99; // Обышка: Передавайте нормальный вид объекта!
КонецЕсли;
Попытка
Спр = СоздатьОбъект("Справочник."+ВидОбъекта);
Исключение
Возврат -99; // Обышка: Попытка обращения к неверному объекту
КонецПопытки;
// Параметр1 - Код
// Параметр2 - наименование
// Параметр3 - флаг глобального поиска
Если Спр.НайтиПоКоду(Параметр1,Число(Параметр3))=1 Тогда
СписокЗначенийЗапроса[ИндексМассива].
ДобавитьЗначение(Спр.ТекущийЭлемент());
Возврат 1; // Нашли элемент
ИначеЕсли Спр.НайтиПоНаименованию(Параметр2,Число(Параметр3))=1 Тогда
СписокЗначенийЗапроса[ИндексМассива].
ДобавитьЗначение(Спр.ТекущийЭлемент());
Возврат 1; // Нашли элемент
Иначе
Возврат 0; // Не нашли элемент :(
КонецЕсли;
ИначеЕсли ТипОбъекта = "Счет" Тогда
// Вид объекта - Идентификатор плана счетов
// Параметр1 - Код счета
Попытка
Если ВидОбъекта<>"" Тогда
ИскомыйСчет = СчетПоКоду(Параметр1, ПланСчетов.ЗначениеПоИдентификатору(ВидОбъекта));
Иначе
ИскомыйСчет = СчетПоКоду( Параметр1);
КонецЕсли;
Если ПустоеЗначение(ИскомыйСчет) = 1 Тогда
Возврат 0; // не нашли счет :(
Иначе
СписокЗначенийЗапроса[ИндексМассива].
ДобавитьЗначение(ИскомыйСчет);
Возврат 1; // нашли счет
КонецЕсли;
Исключение
Возврат -99; // Ошибка: Неверный тип объекта
КонецПопытки;
ИначеЕсли Действие = 3 Тогда // Вернуть размер списка
Возврат СписокЗначенийЗапроса[ИндексМассива].РазмерСписка();
Иначе
Возврат -99; // Ошибка: Неверное действие
КонецЕсли;
Возврат -999; // ???
КонецЕсли;
КонецФункции
//**********************************************************
Процедура ПриНачалеРаботыСистемы()
// Данная процедура уже есть в глобальном модуле, просто надо
// дописать в ней несколько строк:
Для Сч=1 По 10 Цикл
СписокЗначенийЗапроса[Сч]=СоздатьОбъект("СписокЗначений");
КонецЦикла;
КонецПроцедуры
//**********************************************************

Теперь начинаем потихоньку писать сам запрос. Что мы имеем:
В форме диалога местной базы несколько реквизитов диалога (либо местные переменные):

* Даты периода (НачДата и КонДата)
* Элементы справочников для фильтрации (ВыбТовар, ВыбФирма, ВыбКлиент, и т.д.)
* Какие-либо флажки (ТолькоЗамерзающийЗимойТовар , ..)

Мы начинаем писать запрос и сразу попадаем в такую ловушку:
ТекстЗапроса = " Период с НачДата по КонДата; ";

Вроде все в порядке, но такой запрос не выполнится в базе OLE, так как там понятия не имеют, что такое НачДата и КонДата :)) Ведь эти переменные действительны только для местной базы! Переписываем запрос заново:

Код

ТекстЗапроса = " Период с '" + НачДата + "' по '" + КонДата + "';
// Будет типа '01.01.02'
// т.е. прямое представление даты, которое всегда поймет любой запрос
| Товар = Регистр.ОстаткиТоваров.Товар;
| Фирма = Регистр.ОстаткиТоваров.Фирма;
| Склад = Регистр.ОстаткиТоваров.Склад;
| Остаток = Регистр.ОстаткиТоваров.Остаток;
| Группировка Товар без групп;
| Группировка Документ;
| Функция НачОст = НачОст(Остаток);
| Функция КонОст = КонОст(Остаток);
| Функция ПрихОст = Приход(Остаток);
| Функция РасхОст = Расход(Остаток);";

Так... Дошли до условий отбора в запросе. Рассмотрим два варианта, когда выбран ВыбТовар:
// 1-й вариант - когда выбран элемент справочника (не группа).
// Самый простой случай - коды товаров совпадают абсолютно
// Вариант 1а.
Если ВыбТовар.Выбран()=1 Тогда
ТекстЗапроса = ТекстЗапроса + "
| Условие (Товар.Код = " +ВыбТовар.Код+");";
КонецЕсли;
// Вариант 1б. Чтоб запрос быстрее был:
// Вначале добавим к запросу переменную в общем списке:
| КодТовара = Регистр.ОстаткиТоваров.Товар.Код;
// А уж потом добавим к запросу условие (такое условие будет выполнятся проще, так как
// запрос при формировании таблицы запроса сразу сформирует отдельную колонку кодов и по
// ней уже будет отбирать, а не будет каждый раз при обработке товаров извлекать из них
// код):
Если ВыбТовар.Выбран()=1 Тогда
ТекстЗапроса = ТекстЗапроса + "
| Условие (КодТовара = " +ВыбТовар.Код+");";
КонецЕсли;

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

Код

| Условие (Товар.ПринадлежитГруппе(КакаяТоГруппа)=1);

И здесь, правда можно проблему решить "двумями путями" :)) Первый пусть - когда мы имеем дело с двухуровне вымсправочником. Тогда проблема группы решается также просто, как и в 1-м варианте:

Код

// Добавляем в списке переменных строку:
| КодРодителя = Регистр.ОстаткиТоваров.Товар.Родитель.Код;
// Далее пишем условие:
Если ВыбТовар.Выбран()=1 Тогда
ТекстЗапроса = ТекстЗапроса + "
| Условие (КодРодителя = " +ВыбТовар.Код+");";
КонецЕсли;
// В качестве домашнего задания - переписать условие по наименоваиню :)))

А если справочник очень даже многоуровневый? Вот для этого мы и используем написанную ранее функцию. Предположим, что список значений запроса с индексом массива " 1 " мы будем использовать для хранения подобных значений (например, хранить в нем группы товаров, клиентов) для хитрых условий. Итак, например, в ВыбТовар у нас указана группа товаров, а в ВыбКлиент - группа клиентов, которым мы товары группы ВыбТовар продавали. Кроме того, мы должны пропустить накладные возвратов поставщикам, и не забыть, что товары надо еще отбирать по флажку ТолькоЗамерзающийЗимойТовар:

Код

// Очистим список значений запроса
Результат = БазаОле.EvalExpr("СкорректироватьСписок(1,1)");
// Закинем в список значений запроса группу товаров (он сам найдет ее в базе OLE)
// И запоминаем (в уме), что этой группе соответствует 1-е значение списка
Результат = БазаОле.EvalExpr("СкорректироватьСписок(1, 2 , ""Справочник"", """ +
Выбтовар.Вид())+ """," + ВыбТовар.Код + ", """ +
ВыбТовар.Наименование + """)");
// Теперь закинем в список значений запроса группу клиентов
// И запоминаем, что этой группе соответствует 2-е значение списка
Результат = БазаОле.EvalExpr("СкорректироватьСписок(1, 2 , ""Справочник"", """ +
ВыбКлиент.Вид())+ """," + ВыбКлиент.Код + ", """ +
ВыбКлиент.Наименование + """)");
// А еще до кучи и фирму из ВыбФирма
// И запоминаем, что этой фирме соответствует 3-е значение списка
Результат = БазаОле.EvalExpr("СкорректироватьСписок(1, 2 , ""Справочник"", """ +
ВыбФирма.Вид())+ """," + ВыбФирма.Код + ", """ +
ВыбФирма.Наименование + """)");
// Теперь формируем текст запроса
ТекстЗапроса = " Период с '"+НачДата+ "' по '"+КонДата+"';
| Товар = Документ.РасходнаяНакладная.Товар;
| Замерзает = Документ.РасходнаяНакладная.Товар.ЗамерзаетЗимой;
| Признак = Документ.РасходнаяНакладная.ПризнакНакладной;
| Фирма = Документ.РасходнаяНакладная.Фирма;
| Клиент = Документ.РасходнаяНакладная.Клиент;
| Количество = Документ.РасходнаяНакладная.Количество;
| СуммаДок = Документ.РасходнаяНакладная.Сумма;
| Группировка Товар без групп;
| Группировка Документ;
| Функция СуммаОтгрузки=Сумма(СуммаДок);
| Условие (Признак<>Перечисление.ПризнРасхНакл.ВозвратПоставщику);
| Условие (Замерзает = " + ТолькоЗамерзающийЗимойТовар + ");
// Внимание! Начинается:
| Условие (Товар.ПринадлежитГруппе(СписокЗначенийЗапроса[1].
ПолучитьЗначение(1))=1);
| Условие (Клиент.ПринадлежитГруппе(СписокЗначенийЗапроса[1].
ПолучитьЗначение(2))=1);
| Условие (Фирма= СписокЗначенийЗапроса[1].ПолучитьЗначение(3));";

Уфф. Вроде все… Остается только запустить запрос:
Запрос = БазаОле.CreateObject("Запрос");
Если Запрос.Выполнить(ТекстЗапроса)=0 Тогда
Предупреждение("Запрос безутешен!");
Возврат;
КонецЕсли;

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

Код

// Всякими правдами/неправдами заполнили список значений (хотя бы через другой запрос :))
// конкретными клиентами…
// Предположим, индекс массива равен "2". Тогда в тексте запроса появится следующее:
| Условие (Клиенты в СписокЗначенийЗапроса[2]);

В этой статье описываются полезные функции и процедуры, помогающие эффективно работать с различными типами данных в системе "1С:Предприятие 7.7".

* Обработка значений
* Форматирование
* Список значений
* Таблица значений
* Таблица
* Период и дата
* Календари и праздники
* Справочники
* Документы
* Предопределённые функции
* Налоговый учёт

Обработка значений в 1С

Код

//функция проверяет, является ли переданный в функцию Символ числом
Функция ЭтоЧисло(Символ) Экспорт
Если (КодСимв(Символ)>=48) И (КодСимв(Символ)<=57) Тогда
Возврат(1);
Иначе
Возврат(0);
КонецЕсли;
КонецФункции

//функция возвращает копейки
Функция гКопейки(Значение) Экспорт
Грн=Цел(Значение);
Коп=Значение-Грн;
Возврат(Коп0);
КонецФункции

//функция возвращает сумму без скидки
Функция гСкидка(Сумма,Скидка) Экспорт
Возврат Сумма*(1-Скидка/100);
КонецФункции

//функция устанавливает новое значение реквизита документа или справочника и задаёт вопрос, если новое значение не соответствует предыдущему
Функция гЗначение(Ко,Атрибут,Значение) Экспорт
Знач1=Ко.ПолучитьАтрибут(Атрибут);
Знач2=Значение;
//проверка
Если Не(ТипЗначенияСтр(Знач1)=ТипЗначенияСтр(Знач2)) Тогда
//несоответствие типов
Возврат(0);
ИначеЕсли Не(ТипЗначенияСтр(Знач2)="Число") И (ПустоеЗначение(Знач2)=1) Тогда
//пустое новое значение
Возврат(0);
КонецЕсли;
//реквизит
Если Метаданные.Документ(Ко.Вид()).Выбран()=1 Тогда
//документ
Если Метаданные.Документ(Ко.Вид()).РеквизитШапки(Атрибут).Выбран()=1 Тогда
Ж=Метаданные.Документ(Ко.Вид()).РеквизитШапки(Атрибут);
Имя=Ж.Представление();
ИначеЕсли Метаданные.Документ(Ко.Вид()).РеквизитТабличнойЧасти(Атрибут).
Выбран()=1 Тогда
Ж=Метаданные.Документ(Ко.Вид()).РеквизитТабличнойЧасти(Атрибут);
Имя=Ж.Представление()+" (строка "+Ко.НомерСтроки+")";
Иначе
Ж=Метаданные.ОбщийРеквизитДокумента(Атрибут);
Имя=Ж.Представление();
КонецЕсли;
ИначеЕсли Метаданные.Справочник(Ко.Вид()).Выбран()=1 Тогда
//справочник
Ж=Метаданные.Справочник(Ко.Вид()).Реквизит(Атрибут);
Имя=Ж.Представление();
Если ПустаяСтрока(Имя)=1 Тогда
Имя=Атрибут;
КонецЕсли;
КонецЕсли;
//форматирование
Если ТипЗначенияСтр(Знач2)="Строка" Тогда
Знач1=СокрЛП(Знач1);
Знач2=СокрЛП(Знач2);
ИначеЕсли ТипЗначенияСтр(Знач2)="Число" Тогда
Знач2=Окр(Знач2,Ж.Точность);
КонецЕсли;
//проверка
Если Знач1=Знач2 Тогда
Возврат(0);
КонецЕсли;
//установка значения
Если ПустоеЗначение(Знач1)=0 Тогда
Текст=
"Атрибут: "+Имя+"
|
|Старое значение: "+СимволТабуляции+Знач1+"
|Новое значение: "+СимволТабуляции+Знач2+"
|
|Установить новое значение?";
Если Вопрос(Текст,"Да+Нет")="Нет" Тогда
Возврат(0)
КонецЕсли;
КонецЕсли;
//значение
Ко.УстановитьАтрибут(Атрибут,Знач2);
Возврат(1);
КонецФункции

Форматирование данных в 1С

Код

//форматирование числа
Функция гЧисло(Значение,Знаки=2) Экспорт
Ответ=Формат(Значение,"Ч18."+Знаки);
Возврат СокрЛП(Ответ);
КонецФункции

//функция убирает лишние пробелы
Функция гСжатьПробелы(аТекст) Экспорт
Текст=СокрЛП(аТекст);
//пробелы
Замена=Формат(" ","С5");
Для й=1 По 4 Цикл
Знак=Сред(Замена,й);
Текст=СтрЗаменить(Текст,Знак," ");
КонецЦикла;
//
Возврат СокрЛП(Текст);
КонецФункции

//функция возвращает переданную строку, в которой первая буква устанавливается в верхнем или в нижнем регистре
Функция гБуква(Текст,ФлагНрег=0) Экспорт
Буква=Лев(Текст,1);
Если ФлагНрег=0 Тогда
Буква=ВРег(Буква);
Иначе
Буква=НРег(Буква);
КонецЕсли;
Возврат(Буква+Сред(Текст,2));
КонецФункции

/функция возвращает представление переданного документа
Функция гПредставлениеДокумента(Д) Экспорт
Возврат Д.ПредставлениеВида()+" "+СокрЛП(Д.НомерДок)+" ("+Д.ДатаДок+")";
КонецФункции

//процедура выдаёт сообщение при проведении документа
Процедура гСообщить(Ко,Текст,НомерСтроки=0,Символ="!") Экспорт
//сигнал
Если Ко.Ошибка=0 Тогда
Сигнал();
КонецЕсли;
//документ
Документ=""+Ко.ДатаДок+" "+Ко.ПредставлениеВида()+" "+СокрЛП(Ко.НомерДок);
//номер строки
Если НомерСтроки>0 Тогда
Документ=Документ+" (строка "+НомерСтроки+")";
КонецЕсли;
//сообщение
Сообщить(Документ+": "+Текст,Символ);
КонецПроцедуры

Список значений в 1С

Код

//процедура выполняется при добавлении нового значения в интерактивный список значений
Процедура сзДобавить(Список,Тип,Вид,Длина,Точность,Подсказка) Экспорт
//тип
Если (Тип="Справочник") Или (Тип="Документ") Тогда
Тип=Тип+"."+Вид;
КонецЕсли;
//значение
Если Список.ТекущаяСтрока()=0 Тогда
Значение="";
Иначе
Значение=Список.ПолучитьЗначение(Список.ТекущаяСтрока());
КонецЕсли;
//выбор
Если ВвестиЗначение(Значение,Подсказка,Тип,Длина,Точность)=1 Тогда
Список.ДобавитьЗначение(Значение);
КонецЕсли;
КонецПроцедуры

//процедура выполняется для изменения значения интерактивного списка значений
Процедура сзИзменить(Список) Экспорт
Позиция=Список.ТекущаяСтрока();
Если Позиция=0 Тогда
Возврат;
КонецЕсли;
//
Значение=Список.ПолучитьЗначение(Список.ТекущаяСтрока());
Тип=ТипЗначенияСтр(Значение);
Если (Тип="Справочник") Или (Тип="Документ") Тогда
Тип=Тип+"."+Значение.Вид();
Подсказка=Значение.Вид();
Иначе
Подсказка=Тип;
КонецЕсли;
Если ВвестиЗначение(Значение,Подсказка,Тип)=1 Тогда
Список.УстановитьЗначение(Позиция,Значение);
КонецЕсли;
КонецПроцедуры

//процедура выполняется при удалении значения из интерактивного списка значений
Процедура сзУдалить(Список) Экспорт
Если Список.ТекущаяСтрока()>0 Тогда
Список.УдалитьЗначение(Список.ТекущаяСтрока());
КонецЕсли;
КонецПроцедуры

//процедура изменяет позицию значения интерактивного списка значений
Процедура сзСдвинуть(Список,Количество) Экспорт
Если (Количество>0) И (Список.ТекущаяСтрока()=Список.РазмерСписка()) Тогда
Количество=1-Список.РазмерСписка();
ИначеЕсли (Количество<0) И (Список.ТекущаяСтрока()=1) Тогда
Количество=Список.РазмерСписка()-1;
КонецЕсли;
Список.СдвинутьЗначение(Количество,Список.ТекущаяСтрока());
КонецПроцедуры

//функция проверяет наличие в списке значений с пометками хотя бы одного помеченного значения
Функция сзПометка(Список) Экспорт
Для i=1 По Список.РазмерСписка() Цикл
Если Список.Пометка(i)=1 Тогда
Возврат(1);
КонецЕсли;
КонецЦикла;
//нет пометок
Возврат(0);
КонецФункции

//функция помечает или снимает пометку для всех значений списка
Процедура сзПометить(Список,Флаг) Экспорт
Для й=1 По Список.РазмерСписка() Цикл
Список.Пометка(й,Флаг);
КонецЦикла;
КонецПроцедуры

//процедура оставляет в списке значений заданное количество значений
Процедура сзОбрезать(Список,Размер) Экспорт
Если Список.РазмерСписка()>Размер Тогда
Количество=Список.РазмерСписка()-Размер;
Список.УдалитьЗначение(Размер+1,Количество);
КонецЕсли;
КонецПроцедуры

//функция выгружает значения колонки таблицы значений в список значений
Функция сзКолонка(М,Колонка) Экспорт
Список=СоздатьОбъект("СписокЗначений");
//
В=СоздатьОбъект("ТаблицаЗначений");
М.Выгрузить(В,,,Колонка);
В.Свернуть(Колонка,);
В.Выгрузить(Список,,,Колонка);
Возврат(Список);
КонецФункции

//процедура преобразует строку со значениями в список значений
Процедура сзПарсить(Список,Текст) Экспорт
Если ПустаяСтрока(Текст)=0 Тогда
Если Найти(Текст,"=")=0 Тогда
//делитель - Запятая
Значение=СтрЗаменить(СокрЛП(Текст),",",Симв(34)+","+Симв(34));
Значение=Симв(34)+Значение+Симв(34);
Список.ИзСтрокиСРазделителями(Значение);
Иначе
//делитель - Точка с запятой
Текст=СтрЗаменить(Текст,";",РазделительСтрок);
Для й=1 По Текст.КоличествоСтрок() Цикл
Стр=Текст.ПолучитьСтроку(й);
Если ПустаяСтрока(Стр)=0 Тогда
Позиция=Найти(Стр,"=");
Если Позиция>0 Тогда
Идентификатор=Лев(Стр,Позиция-1);
Значение=Сред(Стр,Позиция+1);
Список.Установить(СокрЛП(Идентификатор),СокрЛП(Значение));
Иначе
Список.ДобавитьЗначение(СокрЛП(Стр));
КонецЕсли;
КонецЕсли;
КонецЦикла;
КонецЕсли;
КонецЕсли;
КонецПроцедуры

//процедура позиционирует строку списка значений на заданном значении
Процедура сзУстановить(Список,Значение) Экспорт
Позиция=Список.НайтиЗначение(Значение);
Если Позиция>0 Тогда
Список.ТекущаяСтрока(Позиция);
КонецЕсли;
КонецПроцедуры

Таблица значений в 1С

Код

//процедура сдвигает строку в таблице значений;
//если сдвигается последняя строка вниз, то строка становится первой;
//если сдвигается первая строка вверх, то строка перемещается в конец таблицы значений
Процедура Количество=1-М.КоличествоСтрок();
ИначеЕсли (Количество<0) И (М.ТекущаяСтрока()=1) Тогда
Количество=М.КоличествоСтрок()-1;
КонецЕсли;
М.СдвинутьСтроку(Количество,М.ТекущаяСтрока())());
КонецПроцедуры

//процедура обнуляет значения таблицы значений вниз от заданной строки и вправо от заданной колонки
Процедура тзОбнулить(М,НомерСтр,НомерКол) Экспорт
Для i=НомерСтр По М.КоличествоСтрок() Цикл
Для j=НомерКол По М.КоличествоКолонок() Цикл
М.УстановитьЗначение(i,j,0);
КонецЦикла;
КонецЦикла;
КонецПроцедуры

//процедура удаляет строку в интерактивной таблице значений> Процедура тзУдалитьСтроку(М) Экспорт
//запоминание текущей строки
ТекСтрока=М.ТекущаяСтрока()-1;
//удаление
М.УдалитьСтроку();
//позиционирование
Если М.КоличествоСтрок()>0 Тогда
ТекСтрока=Мин(ТекСтрока,М.КоличествоСтрок());
М.ТекущаяСтрока(ТекСтрока);
КонецЕсли;
КонецПроцедуры

//процедура находит документ с заданным номером в таблице значений с документами
Процедура гЖурнал_Найти(М) Экспорт
НомерДок=0;
Если ВвестиЧисло(НомерДок,"Номер документа",5,0)=1 Тогда
//поиск по номеру в выборке
Если М.НайтиЗначение(НомерДок,,"Номер")=0 Тогда
Предупреждение("Документ № "+НомерДок+" не найден");
Возврат;
КонецЕсли;
//поиск документа
Список=СоздатьОбъект("СписокЗначений");
М.ВыбратьСтроки();
Пока М.ПолучитьСтроку()=1 Цикл
Если М.Номер=НомерДок Тогда
Список.ДобавитьЗначение(М.ТекущийДокумент);
КонецЕсли;
КонецЦикла;
//выбор
Значение="";
Если Список.РазмерСписка()=1 Тогда
Значение=Список.ПолучитьЗначение(1);
ИначеЕсли Список.ВыбратьЗначение(Значение,"Выбор документа")=0 Тогда
Возврат;
КонецЕсли;
//позиционирование
НомерСтр=0;
М.НайтиЗначение(Значение,НомерСтр,"ТекущийДокумент");
М.ТекущаяСтрока(НомерСтр);
КонецЕсли;
КонецПроцедуры

Таблица или печатная форма в 1С

Код

//установление автоширины колонок таблицы
Процедура гАвтоШиринаКолонок(Таб,НачКол,НачСтр) Экспорт
Для НомерКол=НачКол По Таб.ШиринаТаблицы() Цикл
МаксШирина=0;
Для НомерСтр=НачСтр По Таб.ВысотаТаблицы() Цикл
ТекШирина=СтрДлина(Таб.Область(НомерСтр,НомерКол).Текст);
МаксШирина=Макс(МаксШирина,ТекШирина);
КонецЦикла;
Таб.Область(,НомерКол).ШиринаСтолбца(МаксШирина+2);
КонецЦикла;
КонецПроцедуры

Периоды и даты в 1С

Код

//функция проверяет, равен ли месяцу интервал между заданными датами
Функция ЭтоМесяц(ДатаН,ДатаК) Экспорт
Если Не(ДатаН=НачМесяца(ДатаН)) Тогда
Возврат(0);
ИначеЕсли Не(ДатаК=КонМесяца(ДатаК)) Тогда
Возврат(0);
ИначеЕсли ДатаН=НачМесяца(ДатаК) Тогда
Возврат(1);
Иначе
Возврат(0);
КонецЕсли;
КонецФункции

//функция возвращает количество полных месяцев между датами
Функция гМесяцев(ДатаН,ДатаК) Экспорт
Если ДатаН<ДатаК Тогда
ТекДата=НачМесяца(ДатаН);
Значение=1;
Пока ТекДата<НачМесяца(ДатаК) Цикл
ТекДата=ДобавитьМесяц(ТекДата,1);
Значение=Значение+1;
КонецЦикла;
Возврат(Значение);
Иначе
Возврат(0);
КонецЕсли;
КонецФункции

//функция определяет порядковый номер месяца в квартале
Функция гМесяцКвартала(ДатаДок) Экспорт
НачМесяц=ДатаМесяц(НачКвартала(ДатаДок));
КонМесяц=ДатаМесяц(ДатаДок);
Возврат(КонМесяц-НачМесяц+1);
КонецФункции

//функция определяет порядковый номер квартала по дате
Функция гДатаКвартал(аДата) Экспорт
Возврат ДатаМесяц(КонКвартала(аДата))/3;
КонецФункции

Календари и праздники в 1С

Код

//ф//функция возвращает дату, находящуюся на определённом интервале дней от заданной даты, без учёта выходных;
//например, используется для определения конечной даты действия счёта-фактуры
Функция an class="color-blue">гСрокДействия(ДатаДок,Период,Вид="Основной") Экспорт
К=СоздатьОбъект("Календарь."+Вид);
К.УчитыватьПраздники(1);
Если К.Автозаполнение(ДатаДок,ДобавитьМесяц(ДатаДок+Период,1))=1 Тогда
Возврат К.ПолучитьДату(ДатаДок,Период);
КонецЕсли;
КонецФункции

//функция определяет количество рабочих дней в интервале дат
Функция гРабочиеДни(ДатаН,ДатаК,Вид="Основной") Экспорт
К=СоздатьОбъект("Календарь."+Вид);
К.УчитыватьПраздники(1);
Если К.Автозаполнение(ДатаН,ДатаК)=1 Тогда
Возврат К.Дней(ДатаН,ДатаК);
КонецЕсли;
КонецФункции

//функция определяет количество праздничных дней в интервале дат
Функция гПраздники(ДатаН,ДатаК) Экспорт
Кол=0;
//
П=СоздатьОбъект("Праздники");
П.ВыбратьДаты(ДатаН,ДатаК);
Пока П.СледующаяДата()=1 Цикл
Если НомерДняНедели(П.Дата)<6 Тогда
Кол=Кол+1;
КонецЕсли;
КонецЦикла;
//
Возврат(Кол);
КонецФункции

Справочники в 1С

Код

//функция возвращает элемент заданного справочника по значению реквизита "Счет"
Функция сНайтиПоСчету(Счет,Справочник,Реквизит="Счет") Экспорт
С=СоздатьОбъект("Справочник."+Справочник);
Если С.НайтиПоРеквизиту(Реквизит,Счет,1)=1 Тогда
Возврат С.ТекущийЭлемент();
Иначе
Возврат ПолучитьПустоеЗначение("Справочник."+Справочник);
КонецЕсли;
КонецФункции

//функция возвращает элемент заданного справочника по полному коду элемента
Функция сНайтиПоКоду(Справочник,Код) Экспорт
С=СоздатьОбъект("Справочник."+Справочник);
Если С.НайтиПоКоду(Код,2)=1 Тогда
Возврат С.ТекущийЭлемент();
Иначе
Возврат ПолучитьПустоеЗначение("Справочник."+Справочник);
КонецЕсли;
КонецФункции

//функция возвращает элемент заданного справочника по
//наименованию
//если элемент отсутствует в справочнике, то создаётся новый
Функция сНайтиПоНаименованию(Справочник,Наименование) Экспорт
С=СоздатьОбъект("Справочник."+Справочник);
Если С.НайтиПоНаименованию(Наименование,0,1)=0 Тогда
С.Новый();
С.Наименование=Наименование;
С.Записать();
Сообщить("Справочник "+Справочник+": Новый элемент "+Наименование);
КонецЕсли;
Возврат(С.ТекущийЭлемент());
КонецФункции

//процедура удаляет заданный элемент справочника
Процедура гЭлемент_Удалить(Элемент,Флаг) Экспорт
С=СоздатьОбъект("Справочник."+Элемент.Вид());
С.НайтиЭлемент(Элемент);
С.Удалить(Флаг);
КонецПроцедуры

//функция возвращает строку вида "Иванов И.И." из переданной в функцию строки вида "Иванов Иван Иванович"
Функция гФио_Получить(Значение)
Стр=гФорматС(Значение);
Стр=СтрЗаменить(Стр," ",РазделительСтрок);
Если СтрКоличествоСтрок(Стр)=1 Тогда
Фио=СокрЛП(Стр);
ИначеЕсли СтрКоличествоСтрок(Стр)=2 Тогда
СтрФ=СтрПолучитьСтроку(Стр,1);
СтрИ=СтрПолучитьСтроку(Стр,2);
Фио=СокрЛП(СтрФ)+" "+Лев(СокрЛП(СтрИ),1)+".";
Иначе
СтрО=СтрПолучитьСтроку(Стр,СтрКоличествоСтрок(Стр));
СтрИ=СтрПолучитьСтроку(Стр,СтрКоличествоСтрок(Стр-1));
СтрФ="";
Для й=1 По СтрКоличествоСтрок(Стр)-2 Цикл
СтрФ=СтрФ+" "+СтрПолучитьСтроку(Стр,й);
КонецЦикла;
Фио=СокрЛП(СтрФ)+" "+Лев(СокрЛП(СтрИ),1)+"."+Лев(СокрЛП(СтрО),1)+".";
КонецЕсли;
Возврат(Фио);
КонецФункции

//функция открывает подбор из справочника и предоставляет пользователю выбор из элементов фиксированной группы
Функция сПодборРодитель(Ко,Родитель,Элемент,Заголовок="")
Экспорт
Ко.ОткрытьПодбор("Справочник."+Родитель.Вид(),"ДляВыбора",,0);
Ко.КонтекстПодбора.ИспользоватьРодителя(Родитель,0);
Ко.КонтекстПодбора.ИерархическийСписок(1,0);
//текущий элемент
Если Элемент.Выбран()=1 Тогда
Ко.КонтекстПодбора.АктивизироватьОбъект(Элемент);
КонецЕсли;
//заголовок
Если ПустаяСтрока(Заголовок)=0 Тогда
Ко.КонтекстПодбора.Форма.Заголовок(Заголовок,0);
КонецЕсли;
//отмена стандартной обработки
Возврат(0);
КонецФункции

Документы в 1С

Код

//удаление ведущих нолей в номере документа
Функция гНомерДок(Значение) Экспорт
Текст=СокрЛП(Значение);
Текст=СтрЗаменить(Текст," ","");
Текст=СтрЗаменить(Текст,"_","-");
Если Константа.ФлагНомерОсн=0 Тогда
Возврат(Текст);
ИначеЕсли Текст="0" Тогда
Возврат(Текст);
КонецЕсли;
//префикс
Префикс="";
Для i=1 По СтрЧислоВхождений(Текст,"-") Цикл
Позиция=Найти(Текст,"-");
Префикс=Префикс+Лев(Текст,Позиция);
Текст=Сред(Текст,Позиция+1);
КонецЦикла;
//удаление нолей
ФлагЧисло=0;
Номер="";
Для i=1 По СтрДлина(Текст) Цикл
Символ=Сред(Текст,i,1);
Если ЭтоЧисло(Символ)=0 Тогда
Номер=Номер+Символ;
ИначеЕсли Не(Число(Символ)=0) Тогда
Номер=Номер+Символ;
ФлагЧисло=1;
ИначеЕсли ФлагЧисло=1 Тогда
Номер=Номер+Символ;
КонецЕсли;
КонецЦикла;
//
Возврат(Префикс+Номер);
КонецФункции

//функция возвращает числовой номер документа без префикса
Функция гНомерБезПрефикса(Значение) Экспорт
Номер=гНомерДок(Значение);
Позиция=Найти(Значение,"-");
Номер=Сред(Номер,Позиция+1);
Возврат(Номер);
КонецФункции

//функция создаёт таблицу значений документов заданного вида по одному клиенту и даёт выбрать один документ
Функция гДокументКлиента(Значение,Клиент,ВидДокумента) Экспорт
Если Клиент.Выбран()=0 Тогда
Предупреждение("Не выбран Контрагент!");
Возврат(0);
КонецЕсли;
//таблица
М=СоздатьОбъект("ТаблицаЗначений");
М.НоваяКолонка("Дата","Дата",,,,10);
М.НоваяКолонка("Док","Строка",,,"Документ",50);
М.НоваяКолонка("Сумма","Число",,,,18,"Ч015.2");
М.НоваяКолонка("Документ","Документ");
М.ВидимостьКолонки("Документ",0);
//документы
Д=СоздатьОбъект("Документ");
Д.ВыбратьПоЗначению(,,"Клиент",Клиент);
Пока Д.ПолучитьДокумент()=1 Цикл
Состояние(""+Д.ДатаДок);
Если Не(Д.Вид()=ВидДокумента) Тогда
Продолжить;
КонецЕсли;
//
М.НоваяСтрока();
М.Документ=Д.ТекущийДокумент();
М.Дата=Д.ДатаДок;
М.Док=Д.ПредставлениеВида()+" "+СокрЛП(Д.НомерДок);
//сумма
Ж=Метаданные.Документ(Д.Вид());
Если Ж.РеквизитТабличнойЧасти("ВалСумма").Выбран()=1 Тогда
М.Сумма=Д.Итог("ВалСумма");
ИначеЕсли Ж.РеквизитТабличнойЧасти("СуммаС").Выбран()=1 Тогда
М.Сумма=Д.Итог("СуммаС");
ИначеЕсли Ж.РеквизитТабличнойЧасти("Сумма").Выбран()=1 Тогда
М.Сумма=Д.Итог("Сумма");
КонецЕсли;
КонецЦикла;
//проверка
Если М.КоличествоСтрок()=0 Тогда
Предупреждение("Документы не найдены!");
Возврат(0);
КонецЕсли;
//строка по умолчанию
НомерСтр=0;
Если М.НайтиЗначение(Значение,НомерСтр,"Документ")=0 Тогда
НомерСтр=М.КоличествоСтрок();
КонецЕсли;
//выбор
Заголовок=Метаданные.Документ(ВидДокумента).Представление()+": "+Клиент.Наименование;
Если М.ВыбратьСтроку(НомерСтр,Заголовок)=1 Тогда
Значение=М.ПолучитьЗначение(НомерСтр,"Документ");
Возврат(1);
Иначе
Возврат(0);
КонецЕсли;
КонецФункции

Предопределённые функции и процедуры в 1С

Код

Процедура ОбработкаЯчейкиТаблицы(Значение,Флаг,Таблица,Адрес)
Перем Ответ;
Перем Ко;
Если ПустоеЗначение(Значение)=1 Тогда
Предупреждение("Невозможно обработать значение ячейки!");
ИначеЕсли ТипЗначенияСтр(Значение)="Документ" Тогда
Если гПользователь.ФлагСписок=0 Тогда
Флаг=1;
Иначе
А=СоздатьОбъект("СписокЗначений");
А.ДобавитьЗначение(0,"Открыть документ");
А.ДобавитьЗначение(1,"Открыть в журнале документов");
Если А.ВыбратьЗначение(Ответ,,,,1)=1 Тогда
Если Ответ=0 Тогда
Флаг=1;
Иначе
Журнал=Метаданные.Документ(Значение.Вид()).Журнал.
Идентификатор;
ОткрытьФорму("Журнал."+Журнал+".Основная",Ко);
Ко.АктивизироватьОбъект(Значение);
КонецЕсли;
КонецЕсли;
КонецЕсли;
ИначеЕсли ТипЗначенияСтр(Значение)="Справочник" Тогда
Если гПользователь.ФлагСписок=0 Тогда
Флаг=1;
Иначе
А=СоздатьОбъект("СписокЗначений");
А.ДобавитьЗначение(0,"Открыть элемент");
А.ДобавитьЗначение(1,"Открыть в списке справочника");
Если А.ВыбратьЗначение(Ответ,,,,1)=1 Тогда
Если Ответ=0 Тогда
Флаг=1;
Иначе
Журнал=Метаданные.Справочник(Значение.Вид()).ОсновнаяФорма;
ОткрытьФорму("Справочник."+Значение.Вид()+"."+Журнал,Ко);
Ко.АктивизироватьОбъект(Значение);
КонецЕсли;
КонецЕсли;
КонецЕсли;
ИначеЕсли ТипЗначенияСтр(Значение)="СписокЗначений" Тогда
//расшифровка - СписокЗначений
Кнопка=Значение.Получить("Кнопка");
Если Число(Кнопка)=0 Тогда
Значение.СортироватьПоПредставлению();
//обработка - Ячейка
Представление="";
А=СоздатьОбъект("СписокЗначений");
Для i=1 По Значение.РазмерСписка() Цикл
Отчет=Значение.ПолучитьЗначение(i,Представление);
Если ПустаяСтрока(Отчет)=1 Тогда
Продолжить;
ИначеЕсли Лев(Представление,4)="Меню" Тогда
//элемент контекстного меню в ячейке
Позиция=Найти(Отчет,"|");
Если Позиция=0 Тогда
Представление=Метаданные.Отчет(Отчет).Представление();
Иначе
Добавка=Сред(Отчет,Позиция+1);
Отчет=Лев(Отчет,Позиция-1);
Представление=Метаданные.Отчет(Отчет).Представление()+": "+Добавка;
КонецЕсли;
А.ДобавитьЗначение(Отчет,Представление);
КонецЕсли;
КонецЦикла;
//контекстное меню в ячейке
Если А.РазмерСписка()>0 Тогда
Если А.ВыбратьЗначение(Ответ,,,,1)=1 Тогда
Значение.Выгрузить(гПакет);
гПакет.Установить("Таблица","");
ОткрытьФормуМодально("Отчет."+Ответ,1+гПользователь.ФлагОтчет);
КонецЕсли;
КонецЕсли;
Иначе
//обработка - Кнопка
Значение.Выгрузить(гПакет);
гПакет.Установить("Таблица",Таблица);
Отчет=Значение.Получить("Отчет");
ОткрытьФормуМодально("Отчет."+Отчет,Кнопка);
гПакет.Установить("Таблица","");
КонецЕсли;
ИначеЕсли ТипЗначенияСтр(Значение)="Строка" Тогда
Если ВРег(Лев(СокрЛП(Значение),6))="ССЫЛКА" Тогда
СтрокаЗапуска=СокрЛП(Сред(Значение,7));
ЗапуститьПриложение(СтрокаЗапуска);
Иначе
Флаг=1;
КонецЕсли;
Иначе
//расшифровка - Стандартная обработка ячейки
Флаг=1;
КонецЕсли;
КонецПроцедуры

Налоговый учёт и первое событие в 1С

Код

//функция определяет сумму первого события за период по заданным остаткам на начало и конец периода
Функция гПервоеСобытие(НачД,НачК,КонД,КонК) Экспорт
//первое событие
СуммаД=Макс(КонД-НачД,0);
СуммаК=Макс(КонК-НачК,0);
//сумма
Возврат(СуммаД+СуммаК);
КонецФункции

Резюме

В статье описаны функции и процедуры, используемые в программе "1С:Предприятие 7.7" для работы со справочниками, документами, списками значений, таблицами значений и с прочими агрегатными типами данных. Образцы практического применения описанных средств Вы сможете найти в статьях "Отчёты для 1С" и "Обработки для 1С".

Источник публикации

В данной статье рассмотрены принципы, помогающие компилятору 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 для конфигурирования и прочего (там объем и скорость уже не критичны).